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;
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,ibrk,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 
           β IF ibrk ≠ ff THEN putlin(iline)
             ELSE IF pages THEN WHILE line MOD lines DO putlin(NULL);
             iline ← INPUT(ichn,linbrk);
           END;
 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;  iline←NULL; ibrk←ff;  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"