Google
 

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;