home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / 30TURUTL / FPRIMS.PAS < prev    next >
Pascal/Delphi Source File  |  1985-02-16  |  6KB  |  268 lines
  1. CONST
  2.   MAXPAT=MAXSTR;
  3.   CLOSIZE=1;
  4.   CLOSURE=STAR;
  5.   BOL=PERCENT;
  6.   EOL=DOLLAR;
  7.   ANY=QUESTION;
  8.   CCL=LBRACK;
  9.   CCLEND=RBRACK;
  10.   NEGATE=CARET;
  11.   NCCL=EXCLAM;
  12.   LITCHAR=67;
  13.  
  14. FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
  15.   DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
  16. FUNCTION AMATCH(VAR LIN:XSTRING;OFFSET:INTEGER;
  17.   VAR PAT:XSTRING; J:INTEGER):INTEGER;FORWARD;
  18. FUNCTION MATCH(VAR LIN,PAT:XSTRING):BOOLEAN;FORWARD;
  19. FUNCTION MAKEPAT;
  20. VAR
  21.   I,J,LASTJ,LJ:INTEGER;
  22.   DONE,JUNK:BOOLEAN;
  23.  
  24. FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
  25.   VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
  26. VAR
  27.   JSTART:INTEGER;
  28.   JUNK:BOOLEAN;
  29.  
  30. PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
  31.   VAR I:INTEGER; VAR DEST:XSTRING;
  32.   VAR J:INTEGER; MAXSET:INTEGER);
  33. CONST ESCAPE=ATSIGN;
  34. VAR K:INTEGER;
  35. JUNK:BOOLEAN;
  36.  
  37. FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
  38. BEGIN
  39.   IF(S[I]<>ESCAPE) THEN
  40.     ESC:=S[I]
  41.   ELSE IF (S[I+1]=ENDSTR) THEN
  42.     ESC:=ESCAPE
  43.   ELSE BEGIN
  44.     I:=I+1;
  45.     IF (S[I]=ORD('N')) THEN
  46.       ESC:=NEWLINE
  47.     ELSE IF (S[I]=ORD('T')) THEN
  48.       ESC:=TAB
  49.     ELSE
  50.       ESC:=S[I]
  51.     END
  52. END;
  53.  
  54. BEGIN
  55.   WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
  56.     IF(SRC[I]=ESCAPE)THEN
  57.       JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
  58.     ELSE IF (SRC[I]<>DASH) THEN
  59.       JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
  60.     ELSE IF (J<=1) OR (SRC[I+1]=ENDSTR) THEN
  61.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
  62.     ELSE IF (ISALPHANUM(SRC[I-1]))
  63.       AND (ISALPHANUM(SRC[I+1]))
  64.       AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
  65.         FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
  66.           JUNK:=ADDSTR(K,DEST,J,MAXSET);
  67.             I:=I+1
  68.     END
  69.     ELSE
  70.       JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
  71.     I:=I+1
  72.   END
  73. END;
  74.  
  75. BEGIN
  76.   I:=I+1;
  77.   IF(ARG[I]=NEGATE) THEN BEGIN
  78.     JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
  79.     I:=I+1
  80.   END
  81.   ELSE
  82.     JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
  83.   JSTART:=J;
  84.   JUNK:=ADDSTR(0,PAT,J,MAXPAT);
  85.   DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
  86.   PAT[JSTART]:=J-JSTART-1;
  87.   GETCCL:=(ARG[I]=CCLEND)
  88. END;
  89.  
  90. PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
  91.   LASTJ:INTEGER);
  92. VAR
  93.   JP,JT:INTEGER;
  94.   JUNK:BOOLEAN;
  95. BEGIN
  96.   FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
  97.     JT:=JP+CLOSIZE;
  98.     JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
  99.   END;
  100.   J:=J+CLOSIZE;
  101.   PAT[LASTJ]:=CLOSURE
  102. END;
  103.  
  104. BEGIN
  105.   J:=1;
  106.   I:=START;
  107.   LASTJ:=1;
  108.   DONE:=FALSE;
  109.   WHILE(NOT DONE) AND (ARG[I]<>DELIM)
  110.     AND (ARG[I]<>ENDSTR) DO BEGIN
  111.       LJ:=J;
  112.       IF(ARG[I]=ANY) THEN
  113.         JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
  114.       ELSE IF (ARG[I]=BOL) AND (I=START) THEN
  115.         JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
  116.       ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
  117.         JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
  118.       ELSE IF (ARG[I]=CCL) THEN
  119.         DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
  120.       ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
  121.         LJ:=LASTJ;
  122.         IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
  123.           DONE:=TRUE
  124.         ELSE
  125.           STCLOSE(PAT,J,LASTJ)
  126.       END
  127.       ELSE BEGIN
  128.         JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
  129.         JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
  130.       END;
  131.       LASTJ:=LJ;
  132.       IF(NOT DONE) THEN
  133.         I:=I+1
  134.     END;
  135.     IF(DONE) OR (ARG[I]<>DELIM) THEN
  136.       MAKEPAT:=0
  137.     ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
  138.       MAKEPAT:=0
  139.     ELSE
  140.       MAKEPAT:=I
  141.   END;
  142.   
  143.  
  144. FUNCTION AMATCH;
  145.  
  146.  
  147. VAR I,K:INTEGER;
  148.    DONE:BOOLEAN;
  149.  
  150.  
  151. FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
  152.   VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
  153. VAR
  154.   ADVANCE:-1..1;
  155.  
  156.  
  157. FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
  158.   OFFSET:INTEGER):BOOLEAN;
  159. VAR
  160.   I:INTEGER;
  161. BEGIN
  162.   LOCATE:=FALSE;
  163.   I:=OFFSET+PAT[OFFSET];
  164.   WHILE(I>OFFSET) DO
  165.     IF(C=PAT[I]) THEN BEGIN
  166.       LOCATE :=TRUE;
  167.       I:=OFFSET
  168.     END
  169.     ELSE
  170.       I:=I-1
  171. END;BEGIN
  172.   ADVANCE:=-1;
  173.   IF(LIN[I]=ENDSTR) THEN
  174.     OMATCH:=FALSE
  175.   ELSE IF (NOT( PAT[J] IN
  176.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  177.      ERROR('IN OMATCH:CAN''T HAPPEN')
  178.   ELSE
  179.     CASE PAT[J] OF
  180.     LITCHAR:
  181.       IF (LIN[I]=PAT[J+1]) THEN
  182.         ADVANCE:=1;
  183.     BOL:
  184.       IF (I=1) THEN
  185.         ADVANCE:=0;
  186.     ANY:
  187.       IF (LIN[I]<>NEWLINE) THEN
  188.         ADVANCE:=1;
  189.     EOL:
  190.       IF(LIN[I]=NEWLINE) THEN
  191.         ADVANCE:=0;
  192.     CCL:
  193.       IF(LOCATE(LIN[I],PAT,J+1)) THEN
  194.         ADVANCE:=1;
  195.     NCCL:
  196.       IF(LIN[I]<>NEWLINE)
  197.         AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
  198.           ADVANCE:=1
  199.         END;
  200.     IF(ADVANCE>=0) THEN BEGIN
  201.       I:=I+ADVANCE;
  202.       OMATCH:=TRUE
  203.     END
  204.     ELSE
  205.       OMATCH:=FALSE
  206.   END;
  207.   
  208. FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
  209. BEGIN
  210.   IF(NOT (PAT[N] IN
  211.    [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
  212.     ERROR('IN PATSIZE:CAN''T HAPPEN')
  213.   ELSE
  214.     CASE PAT[N] OF
  215.       LITCHAR:PATSIZE:=2;
  216.       BOL,EOL,ANY:PATSIZE:=1;
  217.       CCL,NCCL:PATSIZE:=PAT[N+1]+2;
  218.       CLOSURE:PATSIZE:=CLOSIZE
  219.     END
  220. END;
  221.  
  222. BEGIN
  223.   DONE:=FALSE;
  224.   WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
  225.     IF(PAT[J]=CLOSURE) THEN BEGIN
  226.       J:=J+PATSIZE(PAT,J);
  227.       I:=OFFSET;
  228.       WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
  229.         IF (NOT OMATCH(LIN,I,PAT,J)) THEN
  230.           DONE:=TRUE;
  231.       DONE:=FALSE;
  232.       WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
  233.         K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
  234.         IF(K>0) THEN
  235.           DONE:=TRUE
  236.         ELSE
  237.           I:=I-1
  238.       END;
  239.       OFFSET:=K;
  240.       DONE:=TRUE
  241.     END
  242.     ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
  243.       THEN BEGIN
  244.       OFFSET :=0;
  245.       DONE:=TRUE
  246.     END
  247.     ELSE
  248.       J:=J+PATSIZE(PAT,J);
  249.   AMATCH:=OFFSET
  250. END;
  251. FUNCTION MATCH;
  252.  
  253. VAR
  254.   I,POS:INTEGER;
  255.  
  256.   
  257.                                                                                
  258. BEGIN
  259.   POS:=0;
  260.   I:=1;
  261.   WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
  262.     POS:=AMATCH(LIN,I,PAT,1);
  263.     I:=I+1
  264.   END;
  265.   MATCH:=(POS>0)
  266. END;
  267.  
  268.