perm filename CRAMM.SAI[PAT,LMM]2 blob
sn#058039 filedate 1973-08-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "cram"
C00004 00003 λ SETUP
C00006 00004 λ OCMD
C00015 00005 λ XCMD
C00017 ENDMK
C⊗;
BEGIN "cram"
COMMENT cram 4 pages onto an XGP page;
REQUIRE 4000 STRING_SPACE;
DEFINE INT="integer",STR = "string", REA = "real",
BOOL = "boolean", ARR = "array",
cr = "'15", lf = "'12", bl = "'40",
crlf = "cr & lf", ff = "'14",
TT = "true", F = "false",
! = "comment", β = "begin", ∂ = "datum",
λ = "procedure",
CHOP = "fudge ← LOP", SAY = "outstr",
TIL = "step 1 until", TH = " FOR 1";
INT fudge, flg, brk;
DEFINE ichn = "1", ochn = "2";
DEFINE linbrk = "1"; ! break table;
INT i, j, k, l, m, n; STR s, t, u, v; REA w, x, y, z;
! variables;
STR ifile, iline, ofile;
INT iflg, ieof, ibrk, oflg, oeof, obrk, iibrk;
STR title, header;
INT page, line, col; ! indices for output array;
INT pages;
INT cmd;
! XGP parameters;
DEFINE cols = 2; ! number of columns/page;
DEFINE linlen = "1536"; ! length of xgp scanline;
DEFINE margin = "150"; ! right margin;
DEFINE xpglen = "75"; ! lines/page;
DEFINE lines = "(xpglen)%pages";
λ SETUP;
β say("type ? for help" &crlf);
header ← title ← ifile ← NULL;
ofile ← "XXCRAM.RPG";
pages ← 2;
SETBREAK(linbrk,ff&lf,NULL,"ias");
END;
λ QMCMD;
β cmd ← 0;
say("COMMANDS ARE:
? print this list
D display current parameter values
I<file> set input file
O<file> output to file, default is XXCRAM.RPG
Q quit to monitor
X exit to COPY and put out the last file written
X<file> same as I<file>, O, X.
"&" I="&ifile&crlf & " O="&ofile&crlf);
END;
λ ICMD;
β cmd ← 0; ifile ← iline;
OPEN(ichn,"DSK",0,11,0,256,iibrk,ieof);
LOOKUP(ichn,ifile,iflg); IF iflg THEN say("sorry, lookup failed" & crlf);
END;
λ QCMD; β cmd ← 0; fudge ← CALL(0,"EXIT"); END;
λ OCMD;
β STR ARR outpg[0:xpglen]; STR colskp;
STR λ XGPSKIP (int COL);
β n←((linlen-margin)%cols)*col+margin;
RETURN(('177&'1&'40)&(n%'200)&(n MOD '200));
END;
λ PUTOUT; β FOR j ← 0 TIL xpglen-1 DO
β OUT(ochn,outpg[j]); OUT(ochn,crlf); END;
col ← page ← line ← 0;
OUT(ochn,ff);
END;
λ PUTLIN (str LIN);
β IF line ≥ xpglen THEN
β line←0; IF (col←col+1)=cols THEN PUTOUT; colskp←xgpskip(col); END;
IF lin[1 to 1]="(" THEN lin←('177&'1&'1)&lin&('177&'1&'0);
outpg[line]←IF col THEN outpg[line]&colskp&lin ELSE lin;
line←line+1;
END;
λ PGSOUT; WHILE ¬ieof DO putlin(INPUT(ichn,linbrk));
cmd ← 0;
IF iline THEN ofile ← iline;
OPEN(ochn,"DSK",0,0,11,0,obrk,oeof); ENTER(ochn,ofile,oflg);
IF oflg THEN β say("sorry, enter failed" & crlf); RETURN END;
line←page←col←0; colskp←xgpskip(col);
PGSOUT;
WHILE line < xpglen DO putlin(null);
PUTOUT; CLOSE(ochn);CLOSE(ichn);
END;
λ XCMD;
β cmd ← 0;
IF iline THEN β icmd; iline ← NULL; ocmd END;
PTOSTR(0,"XG /FONT=FIX13/FONT#1=NGB25 " & ofile);
qcmd
END;
! MAIN PROGRAM -- initialize and dispatch;
setup;
WHILE TT DO
β "dispatch"
say("*");
iline ← INCHWL;
cmd ← LOP(iline); ! get a character;
IF cmd = "I" ∨ cmd = "i" THEN icmd;
IF cmd = "O" ∨ cmd = "o" THEN ocmd;
IF cmd = "Q" ∨ cmd = "q" THEN qcmd;
IF cmd = "X" ∨ cmd = "x" THEN xcmd;
IF cmd = "?" THEN qmcmd;
IF cmd THEN say("?? type ? for help")
END "dispatch";
END "cram"