perm filename PUB3.SAI[XGP,TES] blob
sn#027197 filedate 1973-02-22 generic text, type T, neo UTF8
00100 BEGIN "PUB3"
00200
00300 COMMENT
00400 THIRD PASS OF PUB FOR XGP OUTPUT
00500
00600 A REVISION OF THE OLD "DOXAP" PROGRAM
00700
00800 RICHARD JOHNSSON - 29-JAN-73
00900
01000 WAITING ADDED BY P. KARLTON - 2-FEB-73
01100 ;
01200 REQUIRE "BAYSAI.SAI[A700LE03" SOURCE!FILE;
01300 REQUIRE 4096 STRING!SPACE;
01400
01500 DEFINE
01600 FF="'14";
01700
01800 DEFINE
01900 MAINBRK="1",
02000 LINBRK="2",
02100 ONECHAR="3",
02200 XGPNUM(N)="(N LSH -7)&N"; ! A NUMBER IN TWO 7-BIT CHARS;
02300
02400 DEFINE BCL="('177&'26)",
02500 ECL="('177&'25)",
02600 SETA="('177&'10)",
02700 SETB="('177&'11)",
02800 USEA="('177&'14)",
02900 USEB="('177&'15)",
03000 WAITA="('177&'12)",
03100 WAITB="('177&'13)",
03200 VERT="('177&'1)",
03300 TOPM="('177&'3)",
03400 BOTM="('177&'4)",
03500 NUML="('177&'5)",
03600 JWID="('177&'16)",
03700 JPAD="('177&'17)",
03800 XTAB="('177&'30)",
03900 XRUB="('177&'177)",
04000 XVSB="('177&'20)",
04100 LFTM="('177&'2)",
04200 XBJY="('177&'32)",
04300 XBJN="('177&'33)",
04400 XQTE="('177&'34)";
04500
04600 INTEGER
04700 INCHN,OUTCHN,EOF,BRCHR,CC,
04800 FILE,EXT,PPN;
04900
05000 STRING LINE,INFILE,OUTFILE,PPNSTR;
05100
05200 EXTERNAL INTEGER RPGSW;
05300
05400 STRING PROCEDURE RPGFILE;
05500 BEGIN "RPGFILE"
05600 DEFINE PJOB="CALL(0,""PJOB"")";
05700 INTEGER CHAN;
05800 RPGSW←FALSE;
05900 SETFORMAT(-3,0);
06000 OPEN(CHAN←GETCHAN,"DSK",0,1,0,50,ZILCH,ZILCH);
06100 LOOKUP(CHAN,CVS(PJOB)&"PB3.TMP",DUM);
06200 IF DUM THEN BEGIN RELEASE(CHAN); RETURN(NULL) END;
06300 SDUM←INPUT(CHAN,1);
06400 RENAME(CHAN,NULL,0,DUM);
06500 RELEASE(CHAN);
06600 RETURN(SDUM);
06700 END "RPGFILE";
00100 PROCEDURE PROCESSLINE;
00200 BEGIN "PROCESSLINE"
00300 STRING OUTBUF;
00400 INTEGER NUM,CMD;
00500 OUT(OUTCHN,LINE);
00600 IF (LINE←INPUT(INCHN,ONECHAR)) = CC THEN
00700 BEGIN OUT(OUTCHN,CC); RETURN END;
00800 OUTBUF←BCL;
00900 LINE←INPUT(INCHN,LINBRK);
01000 DO ! UNTIL END OF LINE;
01100 BEGIN "DECODE"
01200 CMD←LOP(LINE);
01300 CASE CMD-"A" OF
01400 BEGIN
01500 BEGIN "A" ! A=VERTICAL SPACTING;
01600 NUM ← INTSCAN(LINE,ZILCH);
01700 ZILCH←LOP(LINE);
01800 OUTBUF ← OUTBUF & VERT & XGPNUM(NUM);
01900 END "A";
02000 BEGIN "B" ! B=TOP MARGIN;
02100 NUM ← INTSCAN(LINE,ZILCH);
02200 ZILCH←LOP(LINE);
02300 OUTBUF ← OUTBUF & TOPM & XGPNUM(NUM);
02400 END "B";
02500 BEGIN "C" ! C=BOTTOM MARGIN;
02600 NUM ← INTSCAN(LINE,ZILCH);
02700 ZILCH←LOP(LINE);
02800 OUTBUF ← OUTBUF & BOTM & XGPNUM(NUM);
02900 END "C";
03000 BEGIN "D" ! D=NUMBER OF LINES;
03100 NUM ← INTSCAN(LINE,ZILCH);
03200 ZILCH←LOP(LINE);
03300 OUTBUF ← OUTBUF & NUML & XGPNUM(NUM);
03400 END "D";
03500 BEGIN "E" ! E=USE A KSET;
03600 OUTBUF ← OUTBUF & USEA;
03700 END "E";
03800 BEGIN "F" ! F=USE B KSET;
03900 OUTBUF ← OUTBUF & USEB;
04000 END "F";
04100 BEGIN "G" ! G=JWIDTH;
04200 NUM ← INTSCAN(LINE,ZILCH);
04300 ZILCH←LOP(LINE);
04400 OUTBUF ← OUTBUF & JWID & XGPNUM(NUM);
04500 END "G";
04600 BEGIN "H" ! H=JPAD(JMAX);
04700 NUM ← INTSCAN(LINE,ZILCH);
04800 ZILCH←LOP(LINE);
04900 OUTBUF ← OUTBUF & JPAD & XGPNUM(NUM);
05000 END "H";
05100 BEGIN "I" ! I=XTAB;
05200 USERERR(0,1,"XTABS IN AN XGP COMMAND LINE ARE MEANINGLESS."&CRLF&OUTBUF&LF&LINE);
05300 NUM←INTSCAN(LINE,ZILCH);
05400 ZILCH←LOP(LINE);
05500 END "I";
05600 BEGIN "J" ! J=CHANGE CONTROL CHARACTER;
05700 ZILCH←LOP(LINE);
05800 CC←LINE; LINE←LINE[2 TO INF]; ! BECAUSE OF SAIL BUG;
05900 SETBREAK(MAINBRK,CC,NULL,"INS");
06000 END "J";
06100 BEGIN "K" ! K=CHANGE NON-JUSTIFYING BLANK CHARACTER;
06200 ZILCH←LOP(LINE);
06300 ZILCH←LOP(LINE);
06400 END "K";
06500 BEGIN "L" ! L=VARIABLE SIZE BLANK;
06600 USERERR(0,1,"XVSB IN AN XGP COMMAND LINE IS MEANINGLESS."&CRLF&OUTBUF&LF&LINE);
06700 NUM←INTSCAN(LINE,ZILCH);
06800 ZILCH←LOP(LINE);
06900 END "L";
07000 BEGIN "M" ! M=LEFT MARGIN;
07100 NUM←INTSCAN(LINE,ZILCH);
07200 ZILCH←LOP(LINE);
07300 OUTBUF←OUTBUF & LFTM & XGPNUM(NUM);
07400 END "M";
07500 BEGIN "N" ! N=BJUSTIFY=YES;
07600 OUTBUF←OUTBUF&XBJY;
07700 END "N";
07800 BEGIN "O" ! O=BJUSTIFY=NO;
07900 OUTBUF←OUTBUF&XBJN;
08000 END "O";
08100 BEGIN "P" ! P=QUOTE NEXT CHARACTER;
08200 USERERR(0,1,"XQUOTE IN COMMAND LINE IS MEANINGLESS."&CRLF&OUTBUF&LF&LINE);
08300 ZILCH←LOP(LINE);
08400 END "P";
08500 BEGIN "Q" ! Q=SET AKSET;
08600 NUM←INTSCAN(LINE,ZILCH);
08700 ZILCH←LOP(LINE);
08800 OUTBUF ← OUTBUF & SETA & NUM;
08900 END "Q";
09000 BEGIN "R" ! R=SET BKSET;
09100 NUM←INTSCAN(LINE,ZILCH);
09200 ZILCH←LOP(LINE);
09300 OUTBUF←OUTBUF&SETB#
09400 END "R";
09405 BEGIN "S" ! S=WAIT FOR AKSET;
09410 OUTBUF←OUTBUF&WAITA;
09415 END "S";
09420 BEGIN "T" ! T=WAIT FOR BKSET;
09425 OUTBUF←OUTBUF&WAITB;
09430 END "T";
09500 END; ! OF CASE;
09600
09700 SZILCH←SCAN(LINE,MAINBRK,ZILCH);
09800
09900 END "DECODE" UNTIL LENGTH(LINE)=0;
10000
10100 OUT(OUTCHN,OUTBUF&ECL);
10200 OUTBUF←NULL;
10300 END "PROCESSLINE";
00100 OPEN(OUTCHN←GETCHAN,"DSK",0,0,3,0,ZILCH,ZILCH);
00200 OPEN(INCHN←GETCHAN,"DSK",1 LSH 18,3,0,200,BRCHR,EOF);
00300
00400 WHILE TRUE DO
00500 BEGINCON(LKUP)
00600 IF NOT RPGSW THEN OUTCHR("*");
00700 INFILE←IF RPGSW THEN RPGFILE ELSE INCHWL;
00800 FILE←CVFIL(INFILE,EXT,PPN);
00900 IF FILE=0 THEN CONTINUE(LKUP);
01000 LOOKUP(INCHN,INFILE,DUM);
01100 IF DUM THEN BEGIN OUTSTR("CANNOT LOOKUP "&INFILE&CRLF&CRLF); CONTINUE(LKUP) END;
01200 ENTER(OUTCHN,INFILE,ZILCH);
01300 DONE;
01400 ENDCON(LKUP);
01500
01600 CC←'26;
01700
01800 SETBREAK(MAINBRK,CC,NULL,"INS");
01900 SETBREAK(LINBRK,LF,CR,"IS");
02000 SETBREAK(ONECHAR,NULL,NULL,"XR");
02100
02200 OUTSTR("P U B P A S S T H R E E ---"&CRLF);
02300
02400 LINE←INPUT(INCHN,MAINBRK);
02500
02600 WHILE TRUE DO
02700 BEGIN "MAIN"
02800 WHILE BRCHR=0 DO
02900 BEGIN
03000 OUT(OUTCHN,LINE);
03100 IF EOF THEN DONE;
03200 LINE←INPUT(INCHN,MAINBRK);
03300 END;
03400 IF EOF THEN DONE;
03500 PROCESSLINE;
03600 LINE←INPUT(INCHN,MAINBRK);
03700 END "MAIN";
03800
03900 RELEASE(INCHN); RELEASE(OUTCHN);
04000
04100 OUTSTR(INFILE&" WRITTEN"&CRLF);
04200 START!CODE
04300 CALLI 1,'12;
04400 END;
04500 END "PUB3"