Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/comp/videdc.sim
There are 2 other files named videdc.sim in the archive. Click here to see a list.
00030 BEGIN COMMENT VIDED output in columns producer; OPTIONS(/l);
00060 EXTERNAL TEXT PROCEDURE rest, inline, scanto, conc, upcase, compress;
00090 EXTERNAL PROCEDURE filist, outchr;
00120 EXTERNAL CHARACTER PROCEDURE insinglechar;
00150 EXTERNAL INTEGER PROCEDURE scan, search, scanint;
00180
00210 TEXT ARRAY key, arg(1:6);
00240 INTEGER keydim, columns, endedpages, outline, cursorcolumn;
00270 INTEGER horizontalpos, bignum, breakchar;
00300 REF (column) firstcolumn, lastcolumn;
00330 REF (outfile) editout;
00360 CHARACTER linefeed, carriagereturn, escape, formfeed, tab, control_z;
00375 CHARACTER vt, sethmi, setvmi;
00390 BOOLEAN pageready, notabs, startformfeed, diablo;
00420
00450 PROCEDURE initialize; BEGIN
00480 outtext("%VIDEDC VERSION 1 IS HERE"); outimage;
00510 key(1):- copy("/O"); ! actually empty key;
00540 key(2):- copy("="); ! infile;
00570 key(3):- copy("/D"); ! /DIABLO;
00600 key(4):- copy("/TE"); ! /TERMINET;
00630 key(5):- copy("/C"); ! /COLUMNS:n;
00660 key(6):- copy("/TA"); ! /TABS, do not simulate tabs with spaces;
00690 keydim:= 6;
00720 cursorcolumn:= 1; bignum:= 999999999;
00750 linefeed:= char(10); carriagereturn:= char(13); control_z:= char(26);
00780 escape:= char(27); formfeed:= char(12); tab:= char(9);
00795 sethmi:= char(31); setvmi:= char(30); vt:= char(11);
00810 END;
00840
00870 PROCEDURE read_command; BEGIN
00900 TEXT coltxt;
00930 WHILE scan(inline("*",sysin),keydim,arg,key,1) NE 0 DO
00960 BEGIN
00990 outtext("? Multiple keywords."); outimage;
01020 END;
01035 diablo:= arg(3) =/= NOTEXT;
01050 coltxt:- arg(5); coltxt.setpos(1);
01080 scanto(coltxt,':'); coltxt:- rest(coltxt);
01110 WHILE coltxt.pos = 1 DO BEGIN
01140 columns:= scanint(coltxt);
01170 IF coltxt.pos = 1 THEN
01200 coltxt:- copy(inline("Input no of columns: ",sysin));
01230 END;
01260 END;
01290
01320 PROCEDURE create_columns; BEGIN
01350 INTEGER colno; REF (column) nextcol;
01380 nextcol:- lastcolumn:- NEW column(columns,NONE);
01410 FOR colno:= columns-1 STEP -1 UNTIL 1 DO nextcol:-
01440 NEW column(colno,nextcol);
01470 firstcolumn:- lastcolumn.nextcolumn:- nextcol;
01500 END;
01530
01560 PROCEDURE process_text; BEGIN
01590 editout:- NEW outfile(arg(1));
01620 IF editout == NONE THEN
01650 BEGIN outtext("Cannot open output file."); outimage; GOTO start;
01680 END;
01710 editout.open(NOTEXT);
01740 resume(firstcolumn);
01770 END;
01800
01830 PROCEDURE finalize; BEGIN
01860 firstcolumn.close; ! will close all columns recursively;
01890 editout.close;
01920 END;
01950 CLASS column(columnnumber,nextcolumn);
01980 INTEGER columnnumber; REF (column) nextcolumn;
02010 BEGIN
02040 REF (infile) editin;
02070 INTEGER currentpage, nextpage, line, tabposition;
02100 BOOLEAN endofpage, virtualpage;
02130 CHARACTER inch;
02160
02190 PROCEDURE close; BEGIN
02220 editin.close; IF columnnumber NE columns THEN nextcolumn.close;
02250 END;
02280
02310 PROCEDURE shiftcolumn; BEGIN
02340 IF notabs THEN BEGIN
02370 IF horizontalpos > tabposition THEN BEGIN
02400 outtext("Too long line enters column no:");
02430 outint(columnnumber,2); outimage;
02460 outchr(editout,carriagereturn,1); horizontalpos:= 0;
02490 END;
02520 outchr(editout,' ',tabposition-horizontalpos);
02550 horizontalpos:= tabposition;
02580 END ELSE outchr(editout,tab,columnnumber-cursorcolumn);
02610 cursorcolumn:= columnnumber;
02640 END;
02670
02700 INTEGER PROCEDURE minline;
02730 IF columnnumber = columns THEN minline:= line
02760 ELSE BEGIN
02790 INTEGER min;
02820 min:= nextcolumn.minline;
02850 minline:= IF min < line THEN min ELSE line;
02880 END;
02910
02940 PROCEDURE changecolumn;
02970 BEGIN INTEGER miniline;
03000 loop: IF columnnumber >= columns THEN BEGIN
03030 outchr(editout,carriagereturn,1);
03060 cursorcolumn:= 1; horizontalpos:= 0;
03090 END;
03120 resume(nextcolumn);
03150 IF columnnumber = 1 THEN BEGIN
03180 miniline:= minline; IF miniline >= 10000 THEN GOTO out;
03210 IF outline < miniline THEN BEGIN
03240 IF diablo THEN
03270 BEGIN outline:= outline+1; outchr(editout,escape,1);
03300 outchr(editout,'U',1);
03330 END ELSE BEGIN
03360 outline:= outline+2; outchr(editout,linefeed,1);
03390 END;
03420 END;
03450 END of columnumber = 1;
03480 IF line > outline AND endedpages < columns THEN GOTO loop;
03510 out:
03540 END of changecolumn;
03570
03600 editin:- NEW infile(arg(2));
03630 IF editin == NONE THEN BEGIN
03660 outtext("Cannot open input file."); outimage; GOTO start;
03690 END;
03720 endofpage:= TRUE; endedpages:= endedpages+1; detach;
03750 IF arg(6) == NOTEXT THEN BEGIN
03780 notabs:= TRUE;
03810 IF columnnumber = 1 THEN BEGIN
03840 outtext("Input tab positions for all except "
03870 "the first column:"); outimage;
03900 END ELSE tabposition:= inint;
03930 IF columnnumber = columns THEN sysin.setpos(0);
03960 resume(nextcolumn);
03990 END;
04020 editin.open(NOTEXT); currentpage:= 1;
04050 IF columnnumber = 1 THEN BEGIN
04080 IF insinglechar(editin) = formfeed THEN startformfeed:= TRUE
04110 ELSE BEGIN
04140 editin.close; editin.open(NOTEXT);
04170 END;
04200 END ELSE IF startformfeed THEN insinglechar(editin);
04230 IF FALSE THEN BEGIN
04260 newpage: IF NOT virtualpage THEN currentpage:= currentpage+1;
04290 WHILE (IF columnnumber = 1 THEN endedpages < columns ELSE
04320 NOT pageready) DO changecolumn;
04350 END;
04380 IF columnnumber = 1 THEN
04410 BEGIN outimage; outtext("Give page numbers from input file:");
04440 pageready:= TRUE;
04470 outimage; inimage;
04500 outline:= cursorcolumn:= 1; horizontalpos:= 0;
04530 outchr(editout,formfeed,1); outchr(editout,carriagereturn,1);
04560 END;
04590 IF sysin.endfile THEN detach;
04620
04650 IF FALSE THEN endfilefound: BEGIN
04680 outtext("No such page as:"); outint(nextpage,4);
04710 outtext(". Input new page numbers from faulty number.");
04740 outimage; sysin.setpos(0);
04770 END;
04800
04830 nextpage:= inint; IF nextpage < 0 THEN detach ELSE
04839 IF nextpage > 0 THEN BEGIN
04860 IF currentpage > nextpage THEN BEGIN
04890 editin.close; editin.open(NOTEXT); currentpage:= 1;
04920 IF startformfeed THEN insinglechar(editin);
04950 END;
04980 FOR currentpage:= currentpage+1 STEP 1 UNTIL nextpage DO BEGIN
05010 IF editin.endfile THEN GOTO endfilefound;
05040 skippage: filist(editin,NONE,bignum,breakchar);
05070 IF breakchar = -1 THEN GOTO endfilefound;
05075 IF breakchar NE rank(formfeed) THEN BEGIN
05080 IF NOT diablo OR breakchar NE rank(escape) THEN GOTO skippage;
05085 inch:= insinglechar(editin);
05090 IF inch = sethmi OR inch = setvmi OR inch = tab OR inch = vt
05092 THEN ! next is diablo control; insinglechar(editin);
05094 GOTO skippage;
05095 END;
05100 END;
05108 virtualpage:= FALSE; currentpage:= nextpage;
05115 END ELSE virtualpage:= TRUE;
05160 resume(nextcolumn); pageready:= FALSE;
05190 endofpage:= FALSE; endedpages:= endedpages-1; line:= 0;
05198 resume(nextcolumn);
05205 IF virtualpage THEN GOTO pageend;
05220
05250 WHILE TRUE DO BEGIN
05280 BEGIN
05310 inch:= insinglechar(editin);
05340 IF inch = formfeed OR inch = control_z THEN pageend: BEGIN
05370 endofpage:= TRUE; endedpages:= endedpages+1; line:= 10000;
05400 GOTO newpage;
05430 END ELSE
05460 IF inch = carriagereturn THEN changecolumn
05490 ELSE IF inch = linefeed THEN BEGIN
05520 line:= line+2; IF line > outline THEN changecolumn;
05550 END ELSE IF inch = escape THEN BEGIN
05580 inch:= insinglechar(editin);
05610 IF inch = 'U' AND diablo THEN BEGIN
05640 line:= line+1; IF line > outline THEN changecolumn;
05670 END ELSE BEGIN
05700 IF cursorcolumn < columnnumber THEN shiftcolumn;
05730 outchr(editout,escape,1); outchr(editout,inch,1);
05740 IF diablo AND (inch = tab or inch = vt or inch = sethmi or
05744 inch = setvmi) THEN ! diablo control; BEGIN
05754 inch:= insinglechar(editin);
05757 outchr(editout,inch,1);
05759 END;
05760 END;
05790 END ELSE BEGIN
05820 IF cursorcolumn < columnnumber THEN shiftcolumn;
05850 outchr(editout,inch,1); horizontalpos:= horizontalpos+1;
05880 END;
05910 END;
05940 END OF while loop;
05970 END of CLASS column;
06000
06030 COMMENT main program starts here;
06060
06090 start:
06120 initialize;
06150 read_command;
06180 create_columns;
06210 process_text;
06240 finalize;
06270 END of VIDEDC;