{$A-}
PROGRAM CHAPTER5;
{$I TOOLU.PAS}
CONST
  MAXPAT=MAXSTR;
  CLOSIZE=1;
  CLOSURE=STAR;
  BOL=PERCENT;
  EOL=DOLLAR;
  ANY=QUESTION;
  CCL=LBRACK;
  CCLEND=RBRACK;
  NEGATE=CARET;
  NCCL=EXCLAM;
  LITCHAR=67;

var cmdptr:file;
FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
  DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
  
FUNCTION AMATCH(VAR LIN:XSTRING;OFFSET:INTEGER;
  VAR PAT:XSTRING; J:INTEGER):INTEGER;FORWARD;
FUNCTION MATCH(VAR LIN,PAT:XSTRING):BOOLEAN;FORWARD;

FUNCTION MAKEPAT;
VAR
  I,J,LASTJ,LJ:INTEGER;
  DONE,JUNK:BOOLEAN;

FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
  VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
VAR
  JSTART:INTEGER;
  JUNK:BOOLEAN;

PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
  VAR I:INTEGER; VAR DEST:XSTRING;
  VAR J:INTEGER; MAXSET:INTEGER);
CONST ESCAPE=ATSIGN;
VAR K:INTEGER;
JUNK:BOOLEAN;

FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
BEGIN
  IF(S[I]<>ESCAPE) THEN
    ESC:=S[I]
  ELSE IF (S[I+1]=ENDSTR) THEN
    ESC:=ESCAPE
  ELSE BEGIN
    I:=I+1;
    IF (S[I]=ORD('N')) THEN
      ESC:=NEWLINE
    ELSE IF (S[I]=ORD('T')) THEN
      ESC:=TAB
    ELSE
      ESC:=S[I]
    END
END;

BEGIN
  WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
    IF(SRC[I]=ESCAPE)THEN
      JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
    ELSE IF (SRC[I]<>DASH) THEN
      JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
    ELSE IF (J<=1) OR (SRC[I+1]=ENDSTR) THEN
      JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
    ELSE IF (ISALPHANUM(SRC[I-1]))
      AND (ISALPHANUM(SRC[I+1]))
      AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
        FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
          JUNK:=ADDSTR(K,DEST,J,MAXSET);
            I:=I+1
    END
    ELSE
      JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
    I:=I+1
  END
END;

BEGIN
  I:=I+1;
  IF(ARG[I]=NEGATE) THEN BEGIN
    JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
    I:=I+1
  END
  ELSE
    JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
  JSTART:=J;
  JUNK:=ADDSTR(0,PAT,J,MAXPAT);
  DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
  PAT[JSTART]:=J-JSTART-1;
  GETCCL:=(ARG[I]=CCLEND)
END;

PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
  LASTJ:INTEGER);
VAR
  JP,JT:INTEGER;
  JUNK:BOOLEAN;
BEGIN
  FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
    JT:=JP+CLOSIZE;
    JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
  END;
  J:=J+CLOSIZE;
  PAT[LASTJ]:=CLOSURE
END;
 
BEGIN
  J:=1;
  I:=START;
  LASTJ:=1;
  DONE:=FALSE;
  WHILE(NOT DONE) AND (ARG[I]<>DELIM)
    AND (ARG[I]<>ENDSTR) DO BEGIN
      LJ:=J;
      IF(ARG[I]=ANY) THEN
        JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
      ELSE IF (ARG[I]=BOL) AND (I=START) THEN
        JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
      ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
        JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
      ELSE IF (ARG[I]=CCL) THEN
        DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
      ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
        LJ:=LASTJ;
        IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
          DONE:=TRUE
        ELSE
          STCLOSE(PAT,J,LASTJ)
      END
      ELSE BEGIN
        JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
        JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
      END;
      LASTJ:=LJ;
      IF(NOT DONE) THEN
        I:=I+1
    END;
    IF(DONE) OR (ARG[I]<>DELIM) THEN
      MAKEPAT:=0
    ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
      MAKEPAT:=0
    ELSE
      MAKEPAT:=I
  END;
  

FUNCTION AMATCH;


VAR I,K:INTEGER;
   DONE:BOOLEAN;


FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
  VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
VAR
  ADVANCE:-1..1;


FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
  OFFSET:INTEGER):BOOLEAN;
VAR
  I:INTEGER;
BEGIN
  LOCATE:=FALSE;
  I:=OFFSET+PAT[OFFSET];
  WHILE(I>OFFSET) DO
    IF(C=PAT[I]) THEN BEGIN
      LOCATE :=TRUE;
      I:=OFFSET
    END
    ELSE
      I:=I-1
END;BEGIN
  ADVANCE:=-1;
  IF(LIN[I]=ENDSTR) THEN
    OMATCH:=FALSE
  ELSE IF (NOT( PAT[J] IN
   [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
     ERROR('IN OMATCH:CAN''T HAPPEN')
  ELSE
    CASE PAT[J] OF
    LITCHAR:
      IF (LIN[I]=PAT[J+1]) THEN
        ADVANCE:=1;
    BOL:
      IF (I=1) THEN
        ADVANCE:=0;
    ANY:
      IF (LIN[I]<>NEWLINE) THEN
        ADVANCE:=1;
    EOL:
      IF(LIN[I]=NEWLINE) THEN
        ADVANCE:=0;
    CCL:
      IF(LOCATE(LIN[I],PAT,J+1)) THEN
        ADVANCE:=1;
    NCCL:
      IF(LIN[I]<>NEWLINE)
        AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
          ADVANCE:=1
        END;
    IF(ADVANCE>=0) THEN BEGIN
      I:=I+ADVANCE;
      OMATCH:=TRUE
    END
    ELSE
      OMATCH:=FALSE
  END;
  
FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
BEGIN
  IF(NOT (PAT[N] IN
   [LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
    ERROR('IN PATSIZE:CAN''T HAPPEN')
  ELSE
    CASE PAT[N] OF
      LITCHAR:PATSIZE:=2;
      BOL,EOL,ANY:PATSIZE:=1;
      CCL,NCCL:PATSIZE:=PAT[N+1]+2;
      CLOSURE:PATSIZE:=CLOSIZE
    END
END;

BEGIN
  DONE:=FALSE;
  WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
    IF(PAT[J]=CLOSURE) THEN BEGIN
      J:=J+PATSIZE(PAT,J);
      I:=OFFSET;
      WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
        IF (NOT OMATCH(LIN,I,PAT,J)) THEN
          DONE:=TRUE;
      DONE:=FALSE;
      WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
        K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
        IF(K>0) THEN
          DONE:=TRUE
        ELSE
          I:=I-1
      END;
      OFFSET:=K;
      DONE:=TRUE
    END
    ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
      THEN BEGIN
      OFFSET :=0;
      DONE:=TRUE
    END
    ELSE
      J:=J+PATSIZE(PAT,J);
  AMATCH:=OFFSET
END;
FUNCTION MATCH;

VAR
  I,POS:INTEGER;

  
                                                                               
BEGIN
  POS:=0;
  I:=1;
  WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
    POS:=AMATCH(LIN,I,PAT,1);
    I:=I+1
  END;
  MATCH:=(POS>0)
END;




PROCEDURE FIND;
  
VAR
  ARG,LIN,PAT:XSTRING;

FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;

  

BEGIN
  GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
END;


BEGIN
  IF(NOT GETARG(2,ARG,MAXSTR))THEN
    ERROR('USAGE:FIND PATTERN');
  IF (NOT GETPAT(ARG,PAT)) THEN
    ERROR('FIND:ILLEGAL PATTERN');
  WHILE(GETLINE(LIN,STDIN,MAXSTR))DO
    IF (MATCH(LIN,PAT))THEN
      PUTSTR(LIN,STDOUT)
END;
 
PROCEDURE CHANGE;
CONST
  DITTO=255;
VAR
  LIN,PAT,SUB,ARG:XSTRING;

FUNCTION GETPAT(VAR ARG,PAT:XSTRING):BOOLEAN;

  

BEGIN
  GETPAT:=(MAKEPAT(ARG,1,ENDSTR,PAT)>0)
END;
FUNCTION GETSUB(VAR ARG,SUB:XSTRING):BOOLEAN;

FUNCTION MAKESUB(VAR ARG:XSTRING; FROM:INTEGER;
  DELIM:CHARACTER; VAR SUB:XSTRING):INTEGER;
VAR I,J:INTEGER;
   JUNK:BOOLEAN;
BEGIN
  J:=1;
  I:=FROM;
  WHILE (ARG[I]<>DELIM) AND (ARG[I]<>ENDSTR) DO BEGIN
    IF(ARG[I]=ORD('&')) THEN
      JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT)
    ELSE
      JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT);
    I:=I+1
  END;
  IF (ARG[I]<>DELIM) THEN
    MAKESUB:=0
  ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT)) THEN
    MAKESUB:=0
  ELSE
    MAKESUB:=I
END;

BEGIN
  GETSUB:=(MAKESUB(ARG,1,ENDSTR,SUB)>0)
END;

PROCEDURE SUBLINE(VAR LIN,PAT,SUB:XSTRING);
VAR
  I, LASTM, M:INTEGER;
  JUNK:BOOLEAN;


PROCEDURE PUTSUB(VAR LIN:XSTRING; S1,S2:INTEGER;
  VAR SUB:XSTRING);
VAR
  I,J:INTEGER;
  JUNK:BOOLEAN;
BEGIN
  I:=1;
  WHILE (SUB[I]<>ENDSTR) DO BEGIN
    IF(SUB[I]=DITTO) THEN
      FOR J:=S1 TO S2-1 DO
        PUTC(LIN[J])
      ELSE
        PUTC(SUB[I]);
      I:=I+1
  END
END;

BEGIN
  LASTM:=0;
  I:=1;
  WHILE(LIN[I]<>ENDSTR) DO BEGIN
    M:=AMATCH(LIN,I,PAT,1);
    IF (M>0) AND (LASTM<>M) THEN BEGIN
      PUTSUB(LIN,I,M,SUB);
      LASTM:=M
    END;
    IF (M=0) OR (M=I) THEN BEGIN
      PUTC(LIN[I]);
      I:=I+1
    END
    ELSE
      I:=M
    END
END;

BEGIN
  IF(NOT GETARG(2,ARG,MAXSTR)) THEN
    ERROR('USAGE:CHANGE FROM [TO]');
  IF (NOT GETPAT(ARG,PAT)) THEN
    ERROR('CHANGE:ILLEGAL "FROM" PATTERN');
  IF (NOT GETARG(3,ARG,MAXSTR)) THEN
    ARG[1]:=ENDSTR;
  IF(NOT GETSUB(ARG,SUB)) THEN
    ERROR('CHANGE:ILLEGAL "TO" STRING');
  WHILE (GETLINE(LIN,STDIN,MAXSTR)) DO
    SUBLINE(LIN,PAT,SUB)
END;

PROCEDURE COMMAND;
VAR I:INTEGER;XS:XSTRING;B:BOOLEAN;
    S:PACKED ARRAY[1..3]OF CHAR;
BEGIN
  B:=GETARG(1,XS,MAXSTR);
  IF (B=TRUE)THEN BEGIN
    for i:=1 to 3 do if islower(xs[i])then s[i]:=chr(xs[i]-32)
    else s[i]:=chr(xs[i]);
  END
  ELSE {BDOS(0,0)} HALT; {N.J.R}
  IF (S='CHA')THEN CHANGE
  ELSE IF (S='FIN')THEN FIND
END;

BEGIN
  COMMAND;
  ENDCMD;assign(cmdptr,'SHELL.COM');execute(cmdptr)
END.