Software Tools in Pascal (Part 4 of 6)
sources-request at genrad.UUCP
sources-request at genrad.UUCP
Sat Jul 13 22:36:50 AEST 1985
Mod.sources: Volume 2, Issue 10
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 04 of 06:'
echo 'x - ckglob.pascal'
sed 's/^X//' > ckglob.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ CkGlob -- if global prefix, mark lines to be affected }
Xsegment CkGlob;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
Xfunction CkGlob;
Xvar
X n: Integer;
X gFlag: Boolean;
X temp: StringType;
Xbegin
X if (lin[i] <> GCMD) and (lin[i] <> XCMD) then
X status := ENDDATA
X else begin
X gFlag := (lin[i] = GCMD);
X i := i + 1;
X if (OptPat(lin, i) = ERR) then
X status := ERR
X else if (Default(1, lastLn, status) <> ERR) then begin
X i := i + 1; { mark affected lines }
X for n := line1 to line2 do begin
X GetTxt(n, temp);
X PutMark(n, (Match(temp, pat) = gFlag))
X end;
X for n := 1 to line1-1 do { erase other marks }
X PutMark(n, false);
X for n := line2+1 to lastLn do
X PutMark(n, false);
X status := OK
X end
X end;
X CkGlob := status
Xend;
/
echo 'x - define.pascal'
sed 's/^X//' > define.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Define -- simple string replacement macro processor }
Xprogram Define;
X%include swtools
X%include defdef
X%include defvar
X%include defproc
X{ InitDef -- initialize variables for define }
Xprocedure InitDef;
Xbegin
X CvtSST('define', defName);
X bp := 0; { push back buffer pointer }
X InitHash
Xend;
Xbegin
X ToolInit;
X null[1] := ENDSTR;
X InitDef;
X Install(defName, null, DEFTYPE);
X while (GetTok(token, MAXTOK) <> ENDFILE) do
X if (not IsLetter(token[1])) then
X PutStr(token, STDOUT)
X else if (not Lookup(token, defn, tokType)) then
X PutStr(token, STDOUT) { undefined }
X else if (tokType = DEFTYPE) then begin { defn }
X GetDef(token, MAXTOK, defn, MAXDEF);
X Install(token, defn, MACTYPE)
X end
X else
X PBStr(defn) { push back replacement string }
Xend.
/
echo 'x - dodash.pascal'
sed 's/^X//' > dodash.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoDash -- expand set at src(i) into dest(j), stop at delim }
Xsegment DoDash;
X%include swtools
X%include patdef
Xprocedure DoDash;
Xvar
X k: CharType;
X junk: Boolean;
Xbegin
X while (src[i] <> delim) and (src[i] <> ENDSTR) do begin
X if (src[i] = ESCAPE) then
X junk := AddStr(Esc(src,i), dest, j, maxSet)
X else if (src[i] <> DASH) then
X junk := AddStr(src[i], dest, j, maxSet)
X else if (j <= 1) or (src[i+1] = ENDSTR) then
X junk := AddStr(DASH, dest, j, maxSet) { literal -}
X else if IsAlphaNum(src[i-1]) and
X IsAlphaNum(src[i+1]) and
X (src[i-1] <= src[i+1]) then begin
X for k := Succ(src[i-1]) to src[i+1] do
X { the following obscenity is due to EBCDIC "holes" }
X if IsAlphaNum(k) then begin
X junk := AddStr(k, dest, j, maxSet);
X end;
X i := i + 1
X end
X else
X junk := AddStr(DASH, dest, j, maxSet);
X i := i + 1
X end
Xend;
/
echo 'x - dooption.pascal'
sed 's/^X//' > dooption.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoOption -- build options for the swtools editor }
Xsegment DoOption;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
Xdef
X optionFlags: set of promptFlag..numFlag;
Xvalue
X optionFlags := [];
Xfunction DoOption;
Xvar
X optSel: promptFlag..numFlag;
X setting: Boolean;
Xbegin
X DoOption := OK; { error handling done here }
X i := i + 1;
X if (lin[i] = NEWLINE) or (lin[i+1] = NEWLINE) then
X Message('Bad option string')
X else begin
X if lin[i+1] in [LETS, BIGS] then setting := true
X else if lin[i+1] in [LETC, BIGC] then setting := false
X else begin
X Message('You must [s]et or [c]lear the option');
X return
X end;
X case lin[i] of
X LETP, BIGP:
X optSel := promptFlag;
X LETM, BIGM:
X optSel := noMetaFlag;
X LETV, BIGV:
X optSel := verboseFlag;
X LETN, BIGN:
X optSel := numFlag
X otherwise
X begin
X Message('You gave an illegal option');
X Message('available options are:');
X Message('ps/pc: turn on/off prompting');
X Message('vs/vc: turn on/off verbose mode');
X Message('ns/nc: turn on/off line numbers');
X Message('ms/mc: turn on/off stupid matching');
X return
X end
X end;
X if setting then
X optionFlags := optionFlags + [optSel]
X else
X optionFlags := optionFlags - [optSel]
X end
Xend;
Xfunction OptIsOn;
Xbegin
X if flag in optionFlags then OptIsOn := true
X else OptIsOn := false
Xend;
/
echo 'x - doread.pascal'
sed 's/^X//' > doread.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoRead -- read "fil" after line n }
Xsegment DoRead;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoRead;
Xvar
X count: Integer;
X t: Boolean;
X stat: STCode;
X fd: FileDesc;
X inLine: StringType;
Xbegin
X fd := FOpen(fil, IOREAD);
X if (fd = IOERROR) then
X stat := ERR
X else begin
X curLn := n;
X stat := OK;
X count := 0;
X repeat
X t := GetLine(inLine, fd, MAXSTR);
X if (t) then begin
X stat := PutTxt(inLine);
X if (stat <> ERR) then
X count := count + 1
X end
X until (stat <> OK) or (t = false);
X FClose(fd);
X PutDec(count, 1);
X PutC(NEWLINE);
X end;
X DoRead := stat
Xend;
/
echo 'x - dosub.pascal'
sed 's/^X//' > dosub.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ DoSub -- Select substring }
Xsegment DoSub;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoSub;
Xvar
X ap, fc, k, nc: Integer;
X temp1, temp2: StringType;
Xbegin
X if (j - i >= 3) then begin
X if (j - i < 4) then
X nc := MAXTOK
X else begin
X CsCopy(evalStk, argStk[i+4], temp1);
X k := 1;
X nc := Expr(temp1, k)
X end {if};
X CsCopy(evalStk, argStk[i+3], temp1); { origin }
X ap := argStk[i+2]; { target string }
X k := 1;
X fc := ap + Expr(temp1, k) - 1; { first char }
X CsCopy(evalStk, ap, temp2);
X if (fc >= ap) and (fc < ap + StrLength(temp2)) then begin
X CsCopy(evalStk, fc, temp1);
X for k := fc + Min(nc, StrLength(temp1))-1 downto fc do
X PutBack(evalStk[k])
X end {if}
X end {if}
Xend {DoSub};
/
echo 'x - expand.pascal'
sed 's/^X//' > expand.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Expand -- Expand a file by a specified factor }
Xprogram Expand;
X%include swtools
Xconst maxWidth = 2000;
Xvar
X arguments: StringType;
X outBuffer: array [1..maxWidth] of Char;
X inPtr: Integer;
X anchor: Integer;
X i: Integer;
X factor: Integer;
X index: Integer;
X j: Integer;
Xbegin
X ToolInit;
X index := 1;
X if GetArg(1, arguments, MAXSTR) then begin
X factor := CToI(arguments, index);
X if factor = 0 then
X Error('Argument to Expand should be numeric, > 0');
X end
X else
X factor := 1;
X while true do begin
X inPtr := 1;
X { read an input line, expanding on the fly }
X while (GetC(outBuffer[inPtr]) <> ENDFILE) do begin
X if outBuffer[inPtr] = NEWLINE then leave;
X anchor := inPtr;
X for j := 1 to factor - 1 do begin
X inPtr := inPtr + 1;
X outBuffer[inPtr] := outBuffer[anchor];
X end; {for}
X inPtr := inPtr + 1;
X end; {while}
X if outBuffer[inPtr] = ENDFILE then leave;
X { output expanded array twice }
X for j := 1 to factor do
X for i := 1 to inPtr do
X PutC(outBuffer[i]);
X end; {while}
Xend. {Expand}
/
echo 'x - fopen.pascal'
sed 's/^X//' > fopen.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ FOpen -- open a file }
Xsegment FOpen;
X%include swtools
X%include cms
X%include ioref
Xfunction FOpen;
Xvar
X returnCode: Integer;
X cmsString: String(MAXSTR);
X sName: String(MAXSTR);
X f: FileDesc;
X i: 1..MAXSTR;
X fixedName: StringType;
Xbegin
X if mode = IOREAD then begin
X cmsString := 'STATE ';
X for i := 1 TO StrLength(name) do
X if name[i] in [NEWLINE, PERIOD] then
X cmsString := cmsString || Str(' ')
X else
X cmsString := cmsString || Str(name[i]);
X Cms(cmsString, returnCode);
X if returnCode <> 0 then begin
X FOpen := IOERROR;
X return
X end;
X end;
X i := 1;
X if (not GetFid(Name, i, fixedName)) then
X Error('Bad file name');
X CvtSTS(fixedName, sName);
X f := FDAlloc;
X if f = IOERROR then
X Error('Out of file descriptors')
X else begin
X openList[f].mode := mode;
X if mode = IOREAD then
X Reset(openList[f].fileVar, 'name=' || sName)
X else begin
X Remove(fixedName);
X ReWrite(openList[f].fileVar, 'name=' || sName);
X end;
X if ERRORIO then begin
X openList[f].mode := IOAVAIL;
X f := IOERROR;
X ERRORIO := false;
X end
X end;
X FOpen := f
Xend;
/
echo 'x - getdef.pascal'
sed 's/^X//' > getdef.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetDef -- get name and definition }
Xsegment GetDef;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure GetDef;
Xvar
X i, nlPar: Integer;
X c: CharType;
Xbegin
X token[1] := ENDSTR; { in case of bad input }
X defn[1] := ENDSTR;
X if (GetPBC(c) <> LPAREN) then
X Message('define: missing left paren')
X else if (not IsLetter(GetTok(token, tokSize))) then
X Message('define: non-alphanumeric name')
X else if (GetPBC(c) <> COMMA) then
X Message('define: missing comma in define')
X else begin { got '(name,' so far }
X while (GetPBC(c) = BLANK) do
X ; { skip leading blanks }
X PutBack(c); { went one too far }
X nlPar := 0;
X i := 1;
X while (nlPar >= 0) do begin
X defn[i] := GetPBC(c);
X if (i >= defSize) then
X Error('define: definition too long')
X else if (c = ENDFILE) then
X Error('define: missing right paren')
X else if (c = LPAREN) then
X nlPar := nlPar + 1
X else if (c = RPAREN) then
X nlPar := nlPar - 1;
X { else normal char in defn[i] }
X i := i + 1
X end;
X defn[i-1] := ENDSTR
X end
Xend;
/
echo 'x - getfid.pascal'
sed 's/^X//' > getfid.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetFid -- convert a string into a file name }
Xsegment GetFid;
X%include swtools
X%include ioref
Xfunction GetFid;
Xvar
X nameIndex: 1..MAXSTR;
X temp: StringType;
X fMode: StringType;
X fType: StringType;
X i: 0..MAXSTR;
X j: 0..MAXSTR;
Xbegin
X SCopy(line, idx, temp, 1);
X for nameIndex := 1 to StrLength(temp) do
X if (not (line[nameIndex] in
X [DOLLAR, LETA..LETZ, BIGA..BIGZ, DIG0..DIG9, BLANK])) then
X temp[nameIndex] := BLANK;
X i := GetWord(temp, 1, fileName);
X if i = 0 then begin
X GetFid := false;
X return;
X end;
X j := GetWord(temp, i, fType);
X if j = 0 then begin
X CvtSST('TEMP', fType);
X CvtSST('*', fMode);
X end
X else begin
X j := GetWord(temp, j, fMode);
X if j = 0 then
X CvtSST('*', fMode);
X end;
X i := StrLength(fileName);
X fileName[i+1] := PERIOD;
X SCopy(fType, 1, fileName, i + 2);
X i := StrLength(fileName);
X fileName[i+1] := PERIOD;
X SCopy(fMode, 1, fileName, i + 2);
X getFid := true;
Xend;
/
echo 'x - getfn.pascal'
sed 's/^X//' > getfn.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetFn -- get file name from lin[i] .... }
Xsegment GetFn;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetFn;
Xvar
X k: Integer;
X stat: STCode;
Xbegin
X stat := ERR;
X if (lin[i+1] = BLANK) then begin
X Scopy(lin, i+2, fil, 1);
X if fil[StrLength(fil)] = NEWLINE then
X fil[StrLength(fil)] := ENDSTR;
X stat := OK
X end
X else if (lin[i+1] = NEWLINE) and (saveFile[1] <> ENDSTR) then begin
X Scopy(saveFile, 1, fil, 1);
X stat := OK
X end;
X if (stat = OK) and (saveFile[1] = ENDSTR) then
X Scopy(fil, 1, saveFile, 1); { save if no old one }
X k := 1;
X if stat = Ok then
X if (not GetFid(saveFile, k, saveFile)) then
X stat := ERR;
X GetFn := stat
Xend;
/
echo 'x - getline.pascal'
sed 's/^X//' > getline.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetLine-- put string out on file }
Xsegment GetLine;
X%include swtools
X%include ioref
Xref termInput: Boolean;
Xfunction GetKeyBoard(var str: StringType; maxSize: Integer): Boolean;
X forward;
Xfunction GetLine;
Xvar
X i: Integer;
Xbegin
X if (fd < STDIN) or (fd > MAXOPEN) or
X (openList[fd].mode <> IOREAD) then
X Error('Getline with unopen or bad fd')
X else if (fd = STDIN) and (termInput) then
X GetLine := GetKeyBoard(str, maxSize)
X else begin
X i := 1;
X GetLine := false;
X if Eof(openList[fd].fileVar) then begin
X str[1] := NEWLINE;
X str[2] := ENDSTR;
X return;
X end;
X Readln(openList[fd].fileVar, str);
X i := maxSize;
X while (i > 0) do begin
X if (str[i] <> BLANK) then leave;
X i := i - 1
X end;
X str[i+1] := NEWLINE;
X str[i+2] := ENDSTR;
X GetLine := true
X end
Xend;
Xfunction GetKeyBoard;
Xvar
X i: Integer;
Xbegin
X ReadLn(openList[STDIN].fileVar, str);
X if Eof(openList[STDIN].fileVar) then begin
X TermIn(openList[STDIN].fileVar);
X i := 0
X end
X else begin
X i := maxSize;
X while (i > 0) do begin
X if str[i] <> BLANK then leave;
X i := i - 1
X end
X end;
X str[i + 1] := NEWLINE;
X str[i + 2] := ENDSTR;
X if (str[1] = ATSIGN) and (str[2] = NEWLINE) then
X GetKeyBoard := false
X else
X GetKeyBoard := true
Xend;
/
echo 'x - getlist.pascal'
sed 's/^X//' > getlist.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetList -- Get list of line numbers at lin[i], increment i }
Xsegment GetList;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetList;
Xvar
X num: Integer;
X done: Boolean;
Xbegin
X line2 := 0;
X nLines := 0;
X done := (GetOne(lin, i, num, status) <> OK);
X if done and (lin[i] = COMMA) then begin
X done := false;
X num := 1
X end; {if}
X while (not done) do begin
X line1 := line2;
X line2 := num;
X nLines := nLines + 1;
X if (lin[i] = SEMICOL) then
X curLn := num;
X if (lin[i] = COMMA) or (lin[i] = SEMICOL) then begin
X i := i + 1;
X done := (GetOne(lin, i, num, status) <> OK);
X if done then begin
X num := lastLn;
X done := false
X end {if}
X end
X else
X done := true
X end;
X nLines := Min(nLines, 2);
X if (nLines = 0) then
X line2 := curLn;
X if (nLines <= 1) then
X line1 := line2;
X if (status <> ERR) then
X status := OK;
X GetList := status
Xend;
/
echo 'x - getnum.pascal'
sed 's/^X//' > getnum.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetNum -- get single line number component }
Xsegment GetNum;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction GetNum;
Xbegin
X status := OK;
X SkipBl(lin, i);
X if (IsDigit(lin[i])) then begin
X num := CToI(lin, i);
X i := i - 1 { move back, to be advanced at end }
X end
X else if (lin[i] = PLUS) or (lin[i] = MINUS) then begin
X num := curLn;
X i := i - 1; {don't eat the plus or minus sign}
X end
X else if (lin[i] = CURLINE) then
X num := curLn
X else if (lin[i] = LASTLINE) then
X num := lastLn
X else if (lin[i] = SCAN) or (lin[i] = BACKSCAN) then begin
X if (OptPat(lin,i) = ERR) then { build pattern }
X status := ERR
X else
X status := PatScan(lin[i], num)
X end
X else
X status := ENDDATA;
X if (status = OK) then
X i := i + 1; { advance to next character }
X GetNum := status
Xend;
/
echo 'x - getone.pascal'
sed 's/^X//' > getone.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetOne -- get one line number expression }
Xsegment GetOne;
X%include swtools
X%include editcons
X%include edittype
X%include editref
X%include editproc
Xfunction GetOne;
Xvar
X iStart, mul, pNum: Integer;
Xbegin
X iStart := i;
X num := 0;
X if (GetNum(lin, i, num, status) = OK) then { 1st term }
X repeat { + or - terms }
X SkipBl(lin, i);
X if (lin[i] <> PLUS) and (lin[i] <> MINUS) then
X status := ENDDATA
X else begin
X if (lin[i] = PLUS) then
X mul := 1
X else
X mul := -1;
X i := i + 1;
X if (GetNum(lin, i, pNum, status) = OK) then
X num := num + mul * pNum;
X if (status = ENDDATA) then
X status := ERR
X end
X until (status <> OK);
X if (num < 0) or (num > lastLn) then
X status := ERR;
X if (status <> ERR) then begin
X if (i <= iStart) then
X status := ENDDATA
X else
X status := OK
X end;
X GetOne := status
Xend;
/
echo 'x - getpat.pascal'
sed 's/^X//' > getpat.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ GetPat -- get pattern from lin, increment i }
Xsegment GetPat;
X%include swtools
X%include patdef
Xfunction GetPat;
Xbegin
X GetPat := (MakePat(arg, 1, ENDSTR, pat) > 0)
Xend;
/
echo 'x - install.pascal'
sed 's/^X//' > install.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Install -- add name, definition and type to table }
Xsegment Install;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure Install;
Xvar
X h, dlen, nlen: Integer;
X p: NDPtr;
Xbegin
X nlen := StrLength(name) + 1; { 1 for ENDSTR }
X dlen := StrLength(defn) + 1;
X if (nextTab + nlen + dlen > MAXCHARS) then begin
X PutStr(name, STDERR);
X Error(': too many definitions')
X end
X else begin
X h := Hash(name);
X new(p);
X p->.nextPtr := hashTab[h];
X hashTab[h] := p;
X p->.name := nextTab;
X SCCopy(name, ndTable, nextTab);
X nextTab := nextTab + nlen;
X p->.defn := nextTab;
X SCCopy(defn, ndTable, nextTab);
X nextTab := nextTab + dlen;
X p->.kind := t
X end
Xend;
/
echo 'x - kopy.pascal'
sed 's/^X//' > kopy.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Kopy -- move line1 thru line2 after line3 }
Xsegment Kopy;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Kopy;
Xvar
X i: Integer;
X curSave, lastSave: Integer;
X tempLine: StringType;
Xbegin
X if (line1 <= 0) or ((line3 >= line1) and (line3 < line2)) then
X Kopy := ERR
X else begin
X curSave := curLn;
X lastSave := lastLn;
X curLn := lastLn;
X for i := line1 to line2 do begin
X GetTxt(i, tempLine);
X if PutTxt(tempLine) = ERR then begin
X curLn := curSave;
X lastLn := lastSave;
X Kopy := ERR;
X return
X end
X end; {if}
X BlkMove(lastSave+1, lastSave+1+line2-line1, line3);
X if (line3 > line1) then
X curLn := line3
X else
X curLn := line3 + (line2 - line1 + 1);
X Kopy := OK
X end
Xend;
/
echo 'x - makesub.pascal'
sed 's/^X//' > makesub.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ MakeSub -- make substitution string from arg into sub }
Xsegment MakeSub;
X%include swtools
X%include patdef
X%include subdef
X%include metadef
Xvalue
X nullMetaTable := MetaTableType(
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0),
X MetaElementType(0,0));
Xfunction MakeSub;
Xvar
X k: Integer;
X i, j: Integer;
X l: Integer;
X junk: Boolean;
Xbegin
X j := 1;
X i := from;
X k := from;
X while (arg[k] <> delim) and (k <= (MAXSTR - 2)) do
X if (arg[k] = NEWLINE) or (arg[k] = ENDSTR) then begin
X arg[k] := delim;
X arg[k+1] := NEWLINE;
X arg[k+2] := ENDSTR;
X end
X else
X k := k + 1;
X while (arg[i] <> delim) and (arg[i] <> ENDSTR) do begin
X if (arg[i] = AMPER) then begin
X junk := AddStr(DITTO, sub, j, MAXPAT);
X { &n handler for meta brackets }
X if (arg[i+1] in [DIG0..DIG9]) then begin
X i := i + 1;
X junk := AddStr(Chr(Ord(arg[i]) - Ord(DIG0)),
X sub, j, MAXPAT)
X end
X end
X else
X junk := AddStr(Esc(arg,i), sub, j, MAXPAT);
X i := i + 1
X end;
X if (arg[i] <> delim) then { missing delim }
X MakeSub := 0
X else if (not AddStr(ENDSTR, sub, j, MAXPAT)) then
X MakeSub := 0
X else
X MakeSub := i
Xend;
/
echo 'x - mputstr.pascal'
sed 's/^X//' > mputstr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ MPutStr -- put meta'd string out on file }
Xsegment MPutStr;
X%include swtools
X%include ioref
Xprocedure MPutStr;
Xvar
X i: Integer;
X j: integer;
X len: Integer;
X outString: StringType;
Xbegin
X i := 1;
X j := 1;
X len := StrLength(str);
X while i <= len do begin
X if str[i] = DOLLAR then begin
X i := i + 1;
X if (str[i] = BIGN) or (str[i] = LETN) then begin
X if j = 1 then WriteLn(openList[fd].fileVar,' ')
X else WriteLn(openList[fd].fileVar,
X outString:j-1);
X j := 1
X end
X else if (str[i] = BIGE) or (str[i] = LETE) then
X return
X else
X i := i - 1
X end else
X if str[i] = NEWLINE then begin
X if j = 1 then WriteLn(openList[fd].fileVar,' ')
X else WriteLn(openList[fd].fileVar, outString:j-1);
X j := 1;
X end {then}
X else begin
X outString[j] := str[i];
X j := j + 1;
X end; {if}
X i := i + 1
X end; {while}
X if j <> 1 then write(openList[fd].fileVar, outString:j-1);
Xend; {MPutStr}
/
echo 'x - omatch.pascal'
sed 's/^X//' > omatch.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ OMatch -- match one pattern element at pat[j] }
Xsegment OMatch;
X%include swtools
X%include matchdef
X%include patdef
X%include metadef
Xfunction OMatch;
Xvar
X advance: -1..1;
X mIndex: Integer;
Xbegin
X advance := -1;
X if (lin[i] = ENDSTR) then
X OMatch := false
X else
X case pat[j] of
X LITCHAR:
X if (lin[i] = pat[j+1]) then
X advance := 1;
X BOM:
X if (metaStackPointer <= 9) and
X (metaIndex <= 9) then begin
X metaStack[metaStackPointer] := metaIndex;
X metaTable[metaIndex].first := i;
X metaIndex := metaIndex + 1;
X metaStackPointer := metaStackPointer + 1;
X advance := 0
X end
X else
X Error('OMatch/meta: can''t happen');
X EOM:
X if (metaStackPointer >= 1) then begin
X metaStackPointer := metaStackPointer - 1;
X mIndex := metaStack[metaStackPointer];
X metaTable[mIndex].last := i;
X advance := 0
X end
X else
X Error('OMatch/meta/EOM can''t happen');
X BOL:
X if (i = 1) then
X advance := 0;
X ANY:
X if (lin[i] <> NEWLINE) then
X advance := 1;
X EOL:
X if (lin[i] = NEWLINE) then
X advance := 0;
X CCL:
X if (Locate(lin[i], pat, j+1)) then
X advance := 1;
X NCCL:
X if (lin[i] <> NEWLINE) and
X (not Locate(lin[i], pat, j+1)) then
X advance := 1
X otherwise
X Error('in omatch: can''t happen')
X end;
X if (advance >= 0) then begin
X i := i + advance;
X OMatch := true
X end
X else
X OMatch := false
Xend;
/
echo 'x - onerror.pascal'
sed 's/^X//' > onerror.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ OnError -- intercept pascalvs run-time errors }
Xsegment OnError;
Xdef ERRORIO: Boolean;
Xdef ATTENTION: Boolean;
Xdef OUTOFSPACE: Boolean;
Xvalue
X ERRORIO := false;
X ATTENTION := false;
X OUTOFSPACE := false;
X%include onerror
Xprocedure OnError;
Xvar
X statementNumber: String(10);
X procName: String(10);
X errorNo: String(10);
Xbegin
X if (FERROR in [41..53,75..78]) then begin
X ERRORIO := true;
X FACTION := [];
X end
X else if FERROR = 30 then begin
X ATTENTION := true;
X FACTION := [];
X end
X else if (FERROR = 64) and (not OUTOFSPACE) then begin
X OUTOFSPACE := true;
X FACTION := []
X end
X else if FERROR = 36 then begin
X FACTION := [XUMSG,XTRACE,XHALT];
X WriteStr(statementNumber, FSTMTNO:5);
X WriteStr(procName, FPROCNAME:8);
X WriteStr(errorNo, FERROR:5);
X FRETMSG := 'SWTOOLS ASSERT FAILURE: RID=' || PROCNAME||
X '; S#=' || statementNumber ||
X '; EID' || errorNo || ';';
X end
X else begin
X FACTION := [XUMSG,XTRACE];
X WriteStr(statementNumber, FSTMTNO:5);
X WriteStr(procName, FPROCNAME:8);
X WriteStr(errorNo, FERROR: 5);
X FRETMSG := '***SWTOOLS error: RID=' || procName
X || '; S#=' || statementNumber ||
X '; EID=' || errorNo || ';';
X end
Xend;
/
echo 'x - rot.pascal'
sed 's/^X//' > rot.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Rot -- Rotate a file 90 degrees clockwise }
Xprogram Rot;
X%include swtools
Xconst
X maxWidth = 2000;
X maxHeight = 130;
Xvar
X buffers: array [1..maxHeight] of array
X [1..maxWidth] of Char;
X i: Integer;
X j: Integer;
X maxReadWidth: Integer;
X maxReadHeight: Integer;
Xbegin
X ToolInit;
X i := 1;
X j := 1;
X maxReadWidth := 0;
X while (GetC(buffers[i,j]) <> ENDFILE) do begin
X if (buffers[i,j] = NEWLINE) then begin
X maxReadWidth := Max(maxReadWidth,j);
X for j := j to maxWidth do
X buffers[i,j] := BLANK;
X j := 1;
X i := i + 1;
X end
X else
X j := j + 1;
X if (i > maxHeight) or (j > maxWidth) then begin
X Message('input file too big');
X leave
X end
X end;
X maxReadHeight := i - 1;
X for i := 1 to maxReadWidth do begin
X for j := maxReadHeight downto 1 do
X PutC (buffers[j,i]);
X PutC (NEWLINE)
X end;
Xend.
/
echo 'x - subst.pascal'
sed 's/^X//' > subst.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SubSt -- substitute "sub" for occurrences of pattern }
Xsegment SubSt;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
X%include subdef
Xfunction SubSt;
Xvar
X new, old: StringType;
X j, k, lastm, line, m: Integer;
X stat: STCode;
X done, subbed, junk: Boolean;
Xbegin
X if (glob) then
X stat := OK
X else
X stat := ERR;
X done := (line1 <= 0);
X line := line1;
X while (not done) and (line <= line2) do begin
X j := 1;
X subbed := false;
X GetTxt(line, old);
X lastm := 0;
X k := 1;
X while (old[k] <> ENDSTR) do begin
X if (gFlag) or (not subbed) then
X m := AMatch(old, k, pat, 1)
X else
X m := 0;
X if (m > 0) and (lastm <> m) then begin
X { replace matched text }
X subbed := true;
X CatSub(old, k, m, sub, new, j, MAXSTR);
X lastm := m
X end;
X if (m = 0) or (m = k) then begin
X { no match or null match }
X junk := AddStr(old[k], new, j, MAXSTR);
X k := k + 1
X end
X else
X { skip matched text }
X k := m
X end;
X if (subbed) then begin
X if (not AddStr(ENDSTR, new, j, MAXSTR)) then begin
X stat := ERR;
X done := true
X end
X else begin
X stat := LnDelete(line, line, stat);
X stat := PutTxt(new);
X line2 := line2 + curLn - line;
X line := curLn;
X if (stat = ERR) then
X done := true
X else
X stat := OK
X end
X end;
X line := line + 1
X end;
X SubSt := stat
Xend;
/
echo 'x - sw.pascal'
sed 's/^X//' > sw.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ SW[edit] -- main routine for text editor }
Xprogram SW;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
Xvar
X curSave, i: Integer;
X status: STCode;
X more: Boolean;
X argIndex: Integer;
Xdef line1: Integer; { first line number }
Xdef line2: Integer; { second line number }
Xdef nLines: Integer; { # lines in buffer }
Xdef curLn: Integer; { current line: value of dot }
Xdef lastLn: Integer; { last line: value of $ }
Xdef pat: StringType; { pattern }
Xdef lin: StringType; { input line }
Xdef saveFile: StringType; { file name }
Xvalue
X line1 := 0;
X line2 := 0;
X nLines := 0;
Xbegin
X ToolInit;
X SetBuf;
X pat[1] := ENDSTR;
X saveFile[1] := ENDSTR;
X i := 1;
X for argIndex := 1 to Nargs do
X if GetArg(argIndex, lin, MAXSTR) then begin
X SCopy (lin, 1, saveFile, i);
X i := StrLength(saveFile) + 2;
X saveFile[i-1] := BLANK
X end;
X i := 1;
X if saveFile[1] <> ENDSTR then
X if (not GetFid(saveFile, i, saveFile)) then
X saveFile[1] := ENDSTR;
X if saveFile[1] <> ENDSTR then
X if (DoRead(0, saveFile) = ERR) then
X Message('Cannot open input file');
X if (OptIsOn(promptFlag)) then begin
X PutC(COLON);
X PutC(NEWLINE)
X end;
X more := GetLine(lin, STDIN, MAXSTR);
X while (more) do begin
X i := 1;
X curSave := curLn;
X if (GetList(lin, i, Status) = OK) then begin
X if (CKGlob(lin, i, status) = OK) then
X status := DoGlob(lin, i, curSave, status)
X else if (status <> ERR) then
X status := DoCmd(lin, i, false, status)
X { else error - do nothing }
X end;
X if (status = ERR) then begin
X Message('eh?');
X curLn := Min(curSave, lastLn)
X end
X else if (status = ENDDATA) then
X more := false;
X { else ok }
X if (more) then begin
X if OptIsOn(promptFlag) then begin
X PutC(COLON);
X PutC(NEWLINE)
X end;
X more := GetLine(lin, STDIN, MAXSTR)
X end
X end;
X ClrBuf
Xend.
/
echo 'x - swtr.pascal'
sed 's/^X//' > swtr.pascal << '/'
X{
X Copyright (c) 1981
X By: Bell Telephone Laboratories, Inc. and
X Whitesmiths, Ltd.,
X
X This software is derived from the book
X "Software Tools In Pascal", by
X Brian W. Kernighan and P.J. Plauger
X Addison-Wesley, 1981
X ISBN 0-201-10342-7
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Translit -- map characters }
Xprogram SWTr;
X%include swtools
X%include patdef
Xvar
X arg, fromSet, toSet: StringType;
X c: CharType;
X i, lastTo: 0..MAXSTR;
X allBut, squash: Boolean;
X{ XIndex -- conditionally invert value from strindex }
Xfunction XIndex (var inSet: StringType; c: CharType;
X allBut: Boolean; lastTo: Integer): Integer;
Xbegin
X if (c = ENDFILE) then
X XIndex := 0
X else if (not allBut) then
X XIndex := StrIndex(inSet,c)
X else if (StrIndex(inSet,c) > 0) then
X XIndex := 0
X else
X XIndex := lastTo + 1
Xend;
Xbegin
X ToolInit;
X if (not GetArg(1, arg, MAXSTR)) then
X Error('usage: translit from to');
X allBut := (arg[1] = NEGATE);
X if allBut then
X i := 2
X else
X i := 1;
X if (not MakeSet(arg, i, fromSet, MaxStr)) then
X Error('translit: "from" set too large');
X if (not GetArg(2,arg, MAXSTR)) then
X toSet[1] := ENDSTR
X else if (not MakeSet(arg, 1, toSet, MAXSTR)) then
X Error('translit: "to" set too large')
X else if (StrLength(fromSet) < StrLength(toSet)) then
X Error('Translit: "from" shorter than "to"');
X lastTo := StrLength(toSet);
X squash := (StrLength(fromSet) > lastTo) or (allBut);
X repeat
X i := XIndex(fromSet, GetC(c), allBut, lastTo);
X if (squash) and (i >= lastTo) and (lastTo > 0) then begin
X PutC(toSet[lastTo]);
X repeat
X i := XIndex(fromSet, GetC(c), allBut, lastTo)
X until (i < lastTo)
X end;
X if (c <> ENDFILE) then begin
X if (i > 0) and (lastTo > 0) then { translate }
X PutC(toSet[i])
X else if (i = 0) then { copy }
X PutC(c)
X { else delete (don't print) }
X end
X until (c = ENDFILE)
Xend;
/
echo 'x - unique.pascal'
sed 's/^X//' > unique.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ Unique -- strip adjacent duplicate lines in a file }
Xprogram Unique;
X%include swtools
Xvar
X buffer: array [0..1] of StringType;
X bufNum: 0..1;
X sameRecCount: Integer;
X counts: Boolean;
X lastRec: StringType;
Xbegin
X ToolInit;
X buffer[1,1] := ENDSTR;
X buffer[0,1] := NEWLINE; { just so's they're different }
X lastRec := buffer[1];
X counts := NArgs > 0;
X bufNum := 0;
X sameRecCount := 0;
X while(GetLine(buffer[bufNum], STDIN, MAXSTR)) do begin
X if (not Equal(buffer[0], buffer[1])) then begin
X if counts and (sameRecCount <> 0) then begin
X PutDec(sameRecCount, 6);
X PutC(BLANK)
X end;
X if sameRecCount <> 0 then
X PutStr(lastRec, STDOUT);
X lastRec := buffer[bufNum];
X sameRecCount := 1
X end
X else
X sameRecCount := sameRecCount + 1;
X bufNum := (1 - bufNum)
X end;
X if sameRecCount <> 0 then begin
X if counts then begin
X PutDec(sameRecCount, 6);
X PutC(BLANK)
X end;
X PutStr(lastRec, STDOUT)
X end
Xend.
/
echo 'x - unrotate.pascal'
sed 's/^X//' > unrotate.pascal << '/'
X{
X Copyright (c) 1982
X By: Chris Lewis
X
X Right is hereby granted to freely distribute or duplicate this
X software, providing distribution or duplication is not for profit
X or other commerical gain and that this copyright notice remains
X intact.
X}
X{ UnRotate -- Unrotate lines rotated by first half of KWIC }
XProgram UnRotate;
X%include swtools
Xconst
X MAXOUT = 80;
X MIDDLE = 40;
X FOLD = DOLLAR;
Xvar
X inBuf, outBuf: StringType;
X tempFile2: FileDesc;
X i, j, f: Integer;
Xbegin
X ToolInit;
X tempFile2 := STDIN;
X while (GetLine(inBuf, tempFile2, MAXSTR)) do begin
X for i := 1 to MAXOUT -1 do
X outBuf[i] := BLANK;
X f := StrIndex(inBuf, FOLD);
X j := MIDDLE - 1;
X for i := StrLength(inBuf)-1 downto f+1 do begin
X outBuf[j] := inBuf[i];
X j := j - 1;
X if (j <= 0) then
X j := MAXOUT - 1
X end;
X j := MIDDLE + 3;
X for i := 1 to f-1 do begin
X outBuf[j] := inBuf[i];
X j := j mod (MAXOUT - 1) + 1
X end;
X for j := 1 to MAXOUT - 1 do
X if (outBuf[j] <> BLANK) then
X i := j;
X outBuf[i+1] := ENDSTR;
X PutStr(outBuf, STDOUT);
X PutC(NEWLINE)
X end
Xend;
/
echo 'Part 04 of pack.out complete.'
exit
More information about the Mod.sources
mailing list