Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/sources/vided.sim
There is 1 other file named vided.sim in the archive. Click here to see a list.
00010 OPTIONS(/l); COMMENT DISPLAY EDITOR. See
00020 VISTA.MAN for explanations on the routines used in this program;
00030 COMMENT The Author and the Swedish National Defense Research
00040 Institute take no responsibility for errors in this program or other
00050 files connected with it;
00060 BEGIN
00070
00080 COMMENT COMMENT%IF VIDTIM marks additions to output everything
00090 input from the user terminal onto a log file;
00100 COMMENT COMMENT%IF FQC marks additions to enable the use of
00110 FQC for frequency counting on VIDED;
00120 COMMENT COMMENT%IF DEBUGTERMINAL marks additions to allow separate
00130 debug and editing terminals;
00140 COMMENT COMMENT%IF DEBUGSLOW marks additions to create artificial
00150 slowness to debug behaviour on a heavily loaded machine;
00160
00170 COMMENT all the external procedures below are described in the
00180 DECsystem-10 SIMULA Language Handbook part 3;
00190 EXTERNAL TEXT PROCEDURE tmpin, conc, front, storbokstav, upcase,
00200 compress, rest, filspc, inline, frontstrip, scanto, from, upto,
00210 today, tmpnam;
00220 EXTERNAL CHARACTER PROCEDURE findtrigger, fetchar;
00230 EXTERNAL INTEGER PROCEDURE search, scanint, rename;
00240 EXTERNAL INTEGER PROCEDURE scan;
00250 EXTERNAL REF (infile) PROCEDURE findinfile;
00260 EXTERNAL REF (outfile) PROCEDURE findoutfile;
00270 EXTERNAL CHARACTER PROCEDURE getch;
00280 EXTERNAL INTEGER PROCEDURE trmop, gettab, checkint;
00290 EXTERNAL BOOLEAN PROCEDURE puttext, numbered, tmpout, rescan,
00300 dotypeout;
00310 EXTERNAL PROCEDURE depchar, outstring, forceout, echo, abort, exit,
00320 outchr;
00330 COMMENT%IF debugslow
00340 EXTERNAL PROCEDURE sleep;
00350 COMMENT%IFEND debugslow;
00360 EXTERNAL CLASS mvista, qregister=vided0;
00370 EXTERNAL CLASS vided1, vided2;
00380 COMMENT%IF debugterminal - when debugging with a separate debug
00390 REF (infile) newsysin; ! terminal for SIMDDT i/o and another;
00400 COMMENT%IF debugterminal terminal for the VIDED editing
00410 REF(outfile) newsysout;
00420 COMMENT%IFEND debugterminal;
00430 COMMENT%IF VIDTIM
00440 REF (outfile) vidtim; ! File for log of input from terminal;
00450 COMMENT%IFEND VIDTIM;
00460
00470 REF (infile) editin; ! Input text file to be edited;
00480 REF (outfile) editout; ! Output file after editing;
00490 REF (qregister) q_qregisters; ! See &Q and &G VIDED commands;
00500 INTEGER terminaltype; ! Number of user terminal type;
00510 INTEGER absterminaltype; ! Absolute value of this number;
00520 INTEGER height; ! Number of lines on the screen;
00530 INTEGER width; ! Number of characters in a line on the screen;
00540 INTEGER pageheight; ! Number of lines in a page;
00550 INTEGER bad_line_count; ! Count of bad lines;
00560 INTEGER leftmargin; ! Initial value for left margin;
00570 INTEGER rightmargin; ! Initial value for right margin;
00580 INTEGER increment; ! Increment for line numbered files, 0 for
00590 nonnumbered files;
00600 COMMENT%IF debugterminal
00610 BOOLEAN debug; ! Debugging with separate terminal for SIMDDT;
00620 COMMENT%IFEND debugterminal;
00630 BOOLEAN numbered_infile; ! Input file was line-numbered;
00640 BOOLEAN tmpoutfile; ! Output file has temporary file name;
00650 BOOLEAN pageheader; ! Put headers and page numbers on top of each
00660 page;
00670 BOOLEAN synka; ! Synchronization needed of cursor;
00680 COMMENT the arrays below contain handling of switches in
00690 the initial command to VIDED giving file names etc:
00700 For a description of these arrays, see the large comment
00710 in the beginning of the file SCAN.SIM;
00720 TEXT ARRAY key, arg, ini, default[1:13];
00730 TEXT command; ! Command given by the user when starting VIDED;
00740 TEXT belowcommand; ! 1) Messages to and from the TMP:EDS file, which
00750 remembers which file to edit between edit sessions,
00760 2) The text below a VIDED command on the screen, to be restored when
00770 the command is ready;
00780 TEXT infilename;
00790 TEXT outfilename;
00800 TEXT inprotect; ! Protection code on input file;
00810 TEXT indevice; ! Device of input file;
00820 TEXT inspec; ! Input file specification;
00830 TEXT temparg; ! Temporary text;
00840 BOOLEAN otherppn; ! Input file from other PPN than your own;
00850 CHARACTER dot; ! % for .GNO files, otherwise a dot;
00860
00870 PROCEDURE overwritewarning(t); TEXT t;
00880 BEGIN
00890 outtext("%VIDED - You are overwriting a file: ");
00900 outtext(temparg);
00910 outtext(". To continue push RETURN."); outimage; inimage;
00920 END;
00930
00940 BOOLEAN PROCEDURE helptype(heightm1,helpprint);
00950 INTEGER heightm1; BOOLEAN helpprint;
00960 COMMENT Action of &H VIDED command requesting the printing of a help
00970 text;
00980 BEGIN REF (infile) helpfile;
00990 INTEGER count; BOOLEAN limitfound; TEXT helpborder;
01000 helpborder:- copy("VIDED EDITING COMMANDS");
01010 COMMENT Switch these two for higher efficiency if VIDED.HLP
01020 is in the HLP: area;
01030 helpfile:- findinfile("VIDED.HLP[106,346]");
01040 IF helpfile == NONE THEN helpfile:- findinfile("HLP:VIDED.HLP");
01050 INSPECT helpfile DO
01060 BEGIN
01070 open(blanks(80)); inimage;
01080 WHILE NOT helpfile.endfile DO
01090 BEGIN
01100 COMMENT Different part of help file printed depending
01110 on when this procedure is called;
01120 IF NOT limitfound THEN
01130 BEGIN
01140 limitfound:= search(image,helpborder) <= 60;
01150 IF limitfound THEN helpprint:= NOT helpprint;
01160 END;
01170 IF helpprint THEN
01180 BEGIN
01190 sysout.image:= image; sysout.outimage;
01200 count:= count+1;
01210 IF count = heightm1 THEN
01220 BEGIN sysout.outtext("To continue push RETURN.");
01230 sysout.breakoutimage;
01240 sysin.inimage; count:= 0;
01250 outchr(sysout,char(13),1); !carriage return;
01260 outchr(sysout,' ',25); outchr(sysout,char(13),1);
01270 END;
01280 END;
01290 inimage;
01300 END;
01310 helptype:= TRUE;
01320 close;
01330 END;
01340 END;
01350
01360 topstart: !z_t(18); COMMENT Start of execution here;
01370 COMMENT%IF VIDTIM
01380 vidtim:- new outfile("VIDTIM *");
01390 COMMENT%IF VIDTIM
01400 !vidtim vidtim.open(notext);
01410 COMMENT%IFEND VIDTIM;
01420
01430 dot:= '.';
01440 outtext("[VIDED DISPLAY TERMINAL EDITOR VERSION 2A IS HERE]");
01450 outimage;
01460 key[1]:-copy("/DEFAULT:");
01470 key[2]:-copy("/T:");
01480 key[3]:-copy("=");
01490 key[4]:- copy("/DEBUG");
01500 key[5]:- copy("/H");
01510 key[6]:- copy("/N");
01520 key[7]:- copy("/-N");
01530 key[8]:- copy("/MP:");
01540 key[9]:- copy("/ML:");
01550 key[10]:- copy("/MR:");
01560 key[11]:- copy("/P");
01570 key[12]:- copy("/-P");
01580 key[13]:- copy("/L:");
01590
01600 INSPECT findinfile("SWITCH.INI") DO
01610 BEGIN COMMENT The SWITCH.INI file may contain personal default
01620 settings, e.g. telling VIDED what kind of terminal you are using;
01630 open(blanks(130));
01640 WHILE NOT endfile DO
01650 BEGIN
01660 inimage;
01670 storbokstav(image);
01680 IF image.sub(1,5) = "VIDED" THEN
01690 BEGIN
01700 IF scan(from(image,7),13,ini,key,1) NE 0 THEN
01710 BEGIN outtext("? Multiple keywords"
01720 " in SWITCH.INI:");
01730 outtext(image.strip);
01740 outimage;
01750 END;
01760 END;
01770 END;
01780 close;
01790 END;
01800 start:
01810 IF rescan THEN
01820 INSPECT sysin DO
01830 BEGIN COMMENT Reread line invoking VIDED;
01840 inimage;
01850 IF scanto(image,'-').length < image.length THEN
01860 BEGIN
01870 command:- rest(image);
01880 IF scan(command,13,arg,key,1) NE 0 THEN
01890 GOTO multiple ELSE GOTO gotparameters;
01900 END;
01910 END;
01920
01930 COMMENT Scan and interpret switches in input command;
01940 restart: WHILE scan(inline("*",sysin),13,arg,key,1) NE 0 DO
01950 BEGIN
01960 multiple: outtext("? Multiple keywords:");
01970 outtext(sysin.image.strip);
01980 outtext("please try again.");
01990 outimage;
02000 END;
02010
02020 gotparameters:
02030 IF arg[1] = "?" OR arg[5] =/= NOTEXT THEN
02040 BEGIN COMMENT type help text to the user;
02050 echo(sysin,2); ! no echo;
02060 IF NOT helptype(15,TRUE) THEN
02070 BEGIN outtext("Cannot find VIDED.HLP"); outimage;
02080 END;
02090 echo(sysin,4); ! echo again;
02100 GOTO start;
02110 END;
02120 BEGIN INTEGER i;
02130 COMMENT Use default settings from the SWITCH.INI file;
02140 FOR i:= 1 STEP 1 UNTIL 12 DO
02150 BEGIN IF arg[i] == NOTEXT THEN arg[i]:- ini[i];
02160 END;
02170 END;
02180
02190 COMMENT If the user gave no input file name, look for
02200 previously used file name in TMP:EDS;
02210 IF arg[1] = " " THEN
02220 BEGIN
02230 belowcommand:- tmpin("EDS",FALSE);
02240 belowcommand:- scanto(belowcommand,char(13)).strip;
02250 belowcommand:- scanto(belowcommand,char(10)).strip;
02260 scanto(belowcommand,' '); arg[1]:- rest(belowcommand);
02270 END;
02280
02290 editin:- findinfile(arg[1]);
02300 IF editin =/= NONE THEN
02310 BEGIN
02320 IF arg[3] =/= NOTEXT THEN
02330 overwritewarning(arg[1]) ELSE
02340 BEGIN
02350 arg[3]:- arg[1];
02360 tmpoutfile:= TRUE;
02370 END;
02380 END ELSE IF arg[3] == NOTEXT THEN arg[3]:- copy("NUL:NUL");
02390 IF arg[1] NE arg[3] THEN editin:- findinfile(arg[3]);
02400 IF editin == NONE THEN
02410 BEGIN outtext("?CANNOT FIND INPUT FILE: "); outtext(arg[3]);
02420 outimage; GOTO start;
02430 END;
02440
02450 editin.open(blanks(IF width < 140 THEN 140 ELSE width));
02460
02470 COMMENT find and interpret input file specification;
02480 inspec:- filspc(editin,8R121101 000001);
02490 scanto(inspec,':');
02500 indevice:- inspec.sub(1,inspec.pos-1);
02510 scanto(inspec,'['); IF inspec.more THEN
02520 BEGIN otherppn:= TRUE;
02530 END;
02540 inspec.setpos(1); scanto(inspec,'<');
02550 inprotect:- from(inspec,inspec.pos-1);
02560
02570 IF tmpoutfile THEN
02580 BEGIN COMMENT Use temporary name on the output file;
02590 IF otherppn THEN
02600 BEGIN COMMENT Input file not on the user PPN, put output file
02610 there;
02620 temparg:- arg[1];
02630 temparg.setpos(1); scanto(temparg,'[');
02640 IF temparg.more THEN
02650 BEGIN temparg.setpos(temparg.pos-1);
02660 scanto(temparg,']'):= NOTEXT;
02670 temparg.sub(temparg.pos-3,2):= "[,";
02680 END ELSE temparg:- conc(temparg,"[,]");
02690 arg[1]:- temparg;
02700 tmpoutfile:= FALSE;
02710 IF findinfile(temparg) =/= NONE THEN
02720 overwritewarning(temparg);
02730 END ELSE
02740 BEGIN
02750 arg[1]:- tmpnam("VID");
02760 IF findinfile(tmpnam("PIP")) =/= NONE THEN
02770 BEGIN outtext("?VIDED - You must delete the file """);
02780 outtext(tmpnam("PIP")); outtext(""" first.");
02790 outimage; outimage;
02800 GOTO stopedit;
02810 END;
02820 END;
02830 END;
02840
02850 COMMENT Read first line to check for line numbers;
02860 editin.inimage;
02870 numbered_infile:= numbered;
02880 IF arg[6] =/= NOTEXT THEN
02890 BEGIN
02900 increment:= scanint(arg[5]);
02910 IF increment > 1100000 THEN increment:= 0;
02920 END;
02930 IF numbered_infile AND increment = 0 THEN increment:= 10;
02940 IF arg[7] =/= NOTEXT THEN increment:= 0;
02950
02960 temparg:- arg[1];
02970 IF tmpoutfile THEN
02980 BEGIN COMMENT Create name of backup file;
02990 inspec.setpos(1); scanto(inspec,'.');
03000 IF inspec.more THEN
03010 BEGIN IF fetchar(inspec,inspec.pos) = 'Q' OR inspec.getchar = 'q'
03020 THEN
03030 BEGIN outtext("?VIDED - Cannot handle input file with '.Q': ");
03040 outtext(inspec); outimage;
03050 GOTO start;
03060 END;
03070 END;
03080
03090 IF fetchar(inprotect,2) > '2' THEN
03100 BEGIN outtext("?VIDED - Cannot overwrite file: ");
03110 outtext(inspec); outimage; exit(0); GOTO start;
03120 END;
03130
03140 COMMENT Set protection of temporary output file;
03150 temparg.setpos(1);
03160 IF scanto(temparg, '<').length >= temparg.length THEN
03170 BEGIN COMMENT no protection given by the user;
03180 temparg:- conc(temparg,"<077>");
03190 END;
03200
03210 COMMENT Set device for temporary output file;
03220 temparg.setpos(1); IF scanto(temparg,
03230 ':').length >= temparg.length THEN
03240 BEGIN COMMENT no device given by the user;
03250 temparg:- conc(indevice,temparg);
03260 END;
03270 END;
03280
03290 COMMENT Numbered outfile?;
03300 IF increment > 0 THEN temparg:- conc(temparg,"/NUMBERED");
03310
03320 editout:- findoutfile(temparg);
03330 arg[1]:- temparg;
03340 IF editout == NONE THEN
03350 BEGIN outtext("?VIDED - CANNOT OPEN OUTPUT FILE: "); outtext(arg[1]);
03360 outimage; exit(0);
03370 GOTO start;
03380 END;
03390
03400 COMMENT Find user given or default parameters;
03410 terminaltype:= scanint(arg[2]);
03420 COMMENT%IF debugterminal
03430 debug:= arg[4] =/= NOTEXT;
03440 COMMENT%IFEND debugterminal;
03450
03460 IF arg[8] =/= NOTEXT THEN pageheight:= scanint(arg[8]) ELSE
03470 pageheight:= 56;
03480 IF arg[9] =/= NOTEXT THEN leftmargin:= scanint(arg[9]) ELSE
03490 leftmargin:= IF increment = 0 THEN 5 ELSE 13;
03500 IF arg[10] =/= NOTEXT THEN rightmargin:= scanint(arg[10]) ELSE
03510 rightmargin:= IF increment = 0 THEN 68 ELSE 76;
03520 IF increment > 0 AND leftmargin < 8 THEN leftmargin:= 8;
03530 COMMENT ask user about terminal type if not known;
03540 WHILE terminaltype > 12 OR terminaltype < -12 DO
03550 BEGIN
03560 outimage;
03570 outtext("Input type of terminal:"); outimage;
03580 outtext("1 INFOTON VISTA WITH 20 LINES SCREEN"); outimage;
03590 outtext("2 DEC VT52 (Not yet tested)"); outimage;
03600 outtext("3 MINITEC"); outimage;
03610 outtext(
03620 "4 ELITE 2500 WITH AUTO-LF FUNCTION (Not yet tested)");
03630 outimage;
03640 outtext(
03650 "5 ELITE 2500 WITHOUT AUTO-LF FUNCTION (Not yet tested)"
03660 ); outimage;
03670 outtext("6 ELITE 1520 WITH AUTO-LF FEATURE"); outimage;
03680 outtext("7 ELITE 1520 WITHOUT AUTO-LF FEATURE"); outimage;
03690 outtext("8 TELETEC"); outimage;
03700 outtext("9 INFOTON VISTAR SATTELITE"); outimage;
03710 outtext("10 TANDBERG TDV 2000"); outimage;
03720 outtext("11 BEEHIVE B 100"); outimage;
03730 outtext("12 CDC 713-10"); outimage;
03740 outtext("99 INFOTON VISTA WITH 24 LINES SCREEN"); outimage;
03750 outtext("0 Other kind of terminal (probably not working)");
03760 outimage;
03770 outimage;
03780 outtext("Negative terminal number may"
03790 " give direct cursor adressing,");
03800 outimage; outtext("which is faster"
03810 " but does not always work."); outimage;
03820
03830 outchar('*'); breakoutimage;
03840 INSPECT sysin DO
03850 BEGIN inimage; terminaltype:= scanint(image);
03860 END;
03870 END;
03880
03890 absterminaltype:= IF terminaltype < 0 THEN -terminaltype
03900 ELSE terminaltype;
03910 IF absterminaltype = 99 THEN terminaltype:= 1;
03920 IF absterminaltype = 2 THEN width:= 80 ELSE width:= 79;
03930 IF terminaltype = 0 THEN
03940 BEGIN outimage;
03950 outtext("Input terminal screen width: "); breakoutimage;
03960 inimage; width:= inint-1;
03970 END;
03980 IF arg[13] =/= NOTEXT THEN height:= scanint(arg[13]) ELSE
03990 IF terminaltype = 0 OR terminaltype = 11 OR terminaltype = 12 THEN
04000 BEGIN
04010 outtext("Input terminal screen height: "); breakoutimage;
04020 inimage; height:= inint;
04030 END ELSE height:= IF absterminaltype = 1 THEN 20 ELSE 24;
04040
04050 COMMENT Open output text file for edited results;
04060 editout.open(blanks(IF increment = 0 THEN width ELSE width+8));
04070
04080 COMMENT%IF debugterminal
04090 IF debug THEN
04100 BEGIN
04110 newsysin:- NEW infile("sysin *");
04120 COMMENT%IF debugterminal
04130 newsysout:- NEW outfile("sysout *");
04140 COMMENT%IF debugterminal
04150 newsysin.open(blanks(80));
04160 COMMENT%IF debugterminal
04170 newsysout.open(blanks(80))
04180 END ELSE
04190 BEGIN
04200 newsysin:- sysin;
04210 COMMENT%IF debugterminal
04220 newsysout:- sysout
04230 END;
04240 COMMENT%IFEND debugterminal;
04250
04260 COMMENT Write VIDED command and file name onto TMP:EDS;
04270 belowcommand:- blanks(width);
04280 IF tmpoutfile THEN outfilename:- arg[3] ELSE
04290 BEGIN
04300 outfilename:- arg[1]; outfilename.setpos(1);
04310 outfilename:- scanto(outfilename,'/');
04320 END;
04330 puttext(belowcommand,"VIDED ");
04340 puttext(belowcommand,outfilename);
04350 belowcommand.putchar(char(10)); ! line feed;
04360 tmpout("EDS",copy(belowcommand.strip));
04370 belowcommand.setpos(belowcommand.pos-1);
04380 belowcommand.putchar(char(32));
04390
04400 COMMENT Shall VIDED produce headers and page numbers?;
04410 IF arg[11] =/= NOTEXT THEN pageheader:= TRUE ELSE
04420 BEGIN
04430 TEXT extension;
04440 outfilename.setpos(1); scanto(outfilename,'.');
04450 extension:- rest(outfilename); extension:- upto(extension,4);
04460 storbokstav(extension);
04470 IF extension = "GNO" THEN dot:= '%';
04480 IF arg[12] =/= NOTEXT THEN pageheader:= FALSE ELSE
04490 BEGIN COMMENT these extensions give no page numbers;
04500 pageheader:=
04510 extension NE "INI" AND
04520 extension NE "SIM" AND
04530 extension NE "ALG" AND
04540 extension NE "B10" AND
04550 extension NE "B11" AND
04560 extension NE "BAS" AND
04570 extension NE "BLI" AND
04580 extension NE "CCL" AND
04590 extension NE "MIC" AND
04600 extension NE "FOR" AND
04610 extension NE "OVH" AND
04620 extension NE "F4" AND
04630 extension NE "GNO" AND
04640 extension NE "LAP" AND
04650 extension NE "LOG" AND
04660 extension NE "LST" AND
04670 extension NE "MAC" AND
04680 extension NE "P11" AND
04690 extension NE "PL1" AND
04700 extension NE "RNO" AND
04710 extension NE "RNM" AND
04720 extension NE "RNH" AND
04730 extension NE "RNP" AND
04740 extension NE "SNO" AND
04750 extension NE "SRC" AND
04760 extension NE "TEC";
04770 END; END;
04780
04790 COMMENT Get access to the editing facilities in vided1 and vided2;
04800 !z_t(-18); vided2(width, height,
04810 COMMENT%IF debugterminal
04820 newsysin, newsysout, NOT debug,
04830 COMMENT%IFNOT debugterminal;
04840 sysin, sysout, TRUE,
04850 COMMENT%IFEND debugterminal;
04860 terminaltype, NOTEXT, NOTEXT, pageheader, increment, editout,
04870 editin, command, belowcommand, arg, numbered_infile, pageheight,
04880 leftmargin, rightmargin, q_qregisters, tmpoutfile, dot)
04890 BEGIN
04900
04910 TEXT old_search_string; ! &S& and &N& makes the same search
04920 as previous search command;
04930 TEXT dashblank; ! Used by &- command;
04940 PROCEDURE help;
04950 BEGIN COMMENT &H VIDED command;
04960 IF addaltmode THEN outchr(terminalout,altmode,1);
04970 outchr(terminalout,erasescreen,1);
04980 IF NOT helptype(heightm1,FALSE) THEN
04990 warning("Cannot find VIDED.HLP");
05000 to_continue;
05010 END;
05020 PROCEDURE avstava;
05030 COMMENT &- VIDED command;
05040 IF q_verticalpos > 0 THEN
05050 BEGIN
05060 IF q_horizontalpos > 0 THEN
05070 BEGIN IF
05080 get_char_from_screen(q_horizontalpos-1,q_verticalpos)
05090 = '-'
05100 THEN GOTO dash_is_there;
05110 END;
05120 IF get_char_from_screen(q_horizontalpos,q_verticalpos) = '-'
05130 THEN
05140 BEGIN move_the_cursor_to(q_horizontalpos+1,q_verticalpos);
05150 GOTO dash_is_there;
05160 END;
05170 insert(dashblank);
05180 IF FALSE THEN dash_is_there: insert(dashblank.sub(2,1));
05190 move_the_cursor_to(left_margin,q_verticalpos-1);
05200 justify(0,TRUE);
05210 END ELSE warning("&- Not possible on top line of screen.");
05220 PROCEDURE print_status;
05230 COMMENT &O VIDED command;
05240 INSPECT sysin DO INSPECT sysout DO
05250 BEGIN
05260 REF (qregister) current_q;
05270 TEXT qname; INTEGER i;
05280 IF addaltmode THEN outchar(altmode);
05290 outchar(erasescreen);
05300 outtext("VIDED STATUS INFORMATION:"); outimage;
05310 outtext("You are editing page no"); outint(pagenumber,4);
05320 outtext("(input),"); outint(out_pagenumber,4);
05330 outtext("(output)."); outimage;
05340 outtext("Screen is showing line no.");
05350 outint(top_fill+2,3); outtext(" -");
05360 outint(top_fill+2+heightm1,3); outtext(" of current page.");
05370 outimage;
05380 outtext("Page height ="); outint(pageheight,3);
05390 outchar('.');
05400 IF pageheader THEN
05410 BEGIN
05420 outtext(" Title and subtitle of previous page:");
05430 outimage; outtext(header); outimage;
05440 outtext(sub_header);
05450 END;
05460 outimage;
05470 outtext("Current cursor position, horizontal =");
05480 outint(q_horizontalpos,3);
05490 outtext(", vertical ="); outint(q_verticalpos,3);
05500 outchar('.'); outimage;
05510 outtext("Input file """); outtext(arg[3]);
05520 outtext(""", "); IF tmpoutfile THEN outtext("temporary ");
05530 outtext("output file """); outtext(arg[1]);
05540 outtext(""".");
05550 outimage;
05560 IF tmpoutfile THEN
05570 BEGIN
05580 outtext("Output file will be renamed to """);
05590 outtext(arg[3]); outtext("""."); outimage;
05600 END;
05610 outtext("You are ");
05620 IF NOT endpage OR NOT lower_lines == NONE THEN
05630 outtext("not ");
05640 outtext("at the end of a page.");
05650 outimage; outtext("You are ");
05660 IF NOT editin.endfile OR NOT lower_lines == NONE
05670 THEN outtext("not ");
05680 outtext("at the end of the file.");
05690 outimage;
05700 outtext("Left margin ="); outint(left_margin,3);
05710 outtext(" Right margin ="); outint(right_margin,3);
05720 outimage;
05730 IF qregisters == NONE THEN
05740 BEGIN outtext("You have no Q-registers."); outimage;
05750 to_continue;
05760 END ELSE
05770 BEGIN
05780 IF NOT q_echoenabled THEN echon;
05790 qlist:
05800 outtext("Width Height Q-register name"); outimage;
05810 current_q:- qregisters;
05820 WHILE current_q =/= NONE DO
05830 BEGIN
05840 outint(current_q.qwidth,4);
05850 outint(current_q.qheight,7); image.setpos(16);
05860 outtext(current_q.qname); outimage;
05870 current_q:- current_q.next_qregister;
05880 END;
05890 again:
05900 outtext(
05910 "If you want to see the contents of a Q-register,");
05920 outtext(" then type its name:"); outimage;
05930 inimage; qname:- storbokstav(sysin.image.strip);
05940 IF qname =/= NOTEXT THEN
05950 INSPECT find_qregister(qname) DO
05960 BEGIN
05970 FOR i:= 1 STEP 1 UNTIL qheight DO
05980 BEGIN outtext(lines(i-1)); outimage;
05990 END;
06000 GOTO again;
06010 END OTHERWISE
06020 BEGIN outtext("?VIDED - There is no such Q-register.");
06030 outimage; GOTO qlist;
06040 END;
06050 restore_screen(q_verticalpos);
06060 END;
06070 END;
06080 PROCEDURE getcommand;
06090 COMMENT Interpret VIDED command, this procedure is called when the
06100 user has typed <ALTMODE> or <CONTROL-F> to start a VIDED command;
06110 BEGIN BOOLEAN stoptime; ! Time to exit from "getcommand";
06120 BOOLEAN anytextparameter; ! Interpreting the part of a VIDED
06130 command such as &Q or &S which has a text parameter;
06140 BOOLEAN type_ahead; ! The user has done type_ahead;
06150 CHARACTER commandchar; ! First nonnumeric character after &;
06160 CHARACTER oldchar; ! Screen character overwritten by command
06170 character;
06180 CHARACTER secondchar; ! Second character in VIDED command;
06190 INTEGER hstart; ! Horizontal pos of &;
06200 INTEGER vstart; ! Vertical pos of &;
06210 INTEGER arg1; ! First numerical parameter to the command;
06220 INTEGER arg2; ! Second numerical parameter to the command;
06230 INTEGER leading_number; ! Number given by the user before the
06240 command character, e.g. in &13V;
06250 TEXT qname; ! Value of text parameter to VIDED command;
06260 INTEGER PROCEDURE intin;
06270 COMMENT read integer parameter to VIDED command;
06280 IF leading_number NE -1 THEN
06290 BEGIN intin:= leading_number; leading_number:= -1;
06300 END ELSE
06310 BEGIN
06320 INTEGER startpos;
06330 startpos:= command.pos;
06340 WHILE digit(nextchar) DO;
06350 IF q_gotchar = carriagereturn THEN
06360 command.putchar(q_gotchar);
06370 IF startpos+1 >= command.pos THEN intin:=
06380 (IF commandchar = char(0) THEN -1 ELSE IF commandchar = 'M'
06390 THEN hstart ELSE IF commandchar = 'F' THEN 0 ELSE IF
06400 commandchar = 'T' THEN -2 ELSE 1)
06410 ELSE intin:=
06420 command.sub(startpos,command.pos-startpos-1).getint;
06430 END;
06440 PROCEDURE restore_command;
06450 COMMENT When the user has ended a VIDED command, the screen is
06460 restored to what it was below the command before it was typed;
06470 BEGIN
06480 IF q_gotchar = carriagereturn THEN
06490 call(p_insingle);
06500 COMMENT%IF VIDTIM
06510 outchr(vidtim,q_gotchar,1);
06520 COMMENT%ENDIF VIDTIM;
06530 COMMENT%IF debugslow
06540 IF debugslow > 0 THEN sleep(debugslow);
06550 COMMENT%IFEND debugslow;
06560 IF q_gotchar = linefeed THEN
06570 BEGIN IF vstart >= heightm1 THEN
06580 BEGIN call(p_scroll);
06590 vstart:= vstart-1;
06600 verybadscreen:= type_ahead;
06610 END;
06620 END;
06630 IF terminaltype = tandberg THEN
06640 outchr(terminalout,char(15),1);
06650 synchronize(hstart,vstart);
06660 outtext(front(belowcommand));
06670 move_the_cursor_to(hstart,vstart);
06680 END;
06690 CHARACTER PROCEDURE nextchar;
06700 BEGIN COMMENT Input of one character in a VIDED command;
06710 IF stoptime THEN
06720 BEGIN
06730 IF badscreen THEN verybadscreen:= TRUE;
06740 GOTO endcommand;
06750 END;
06760 stoptime:= q_horizontalpos = widthm1;
06770 start: oldchar:=
06780 get_char_from_screen(q_horizontalpos,q_verticalpos);
06790 call(p_insingle); nextchar:= q_gotchar;
06800 COMMENT%IF VIDTIM
06810 outchr(vidtim,q_gotchar,1);
06820 COMMENT%IFEND VIDTIM;
06830 COMMENT%IF debugslow
06840 IF debugslow > 0 THEN sleep(debugslow);
06850 COMMENT%IFEND debugslow;
06860 IF q_gotchar = fill THEN
06870 BEGIN
06880 IF command.pos > 3 THEN
06890 BEGIN
06900 outchar(fetchar(belowcommand,belowcommand.pos-1));
06910 move_the_cursor_to(q_horizontalpos-1,q_verticalpos);
06920 command.setpos(command.pos-1);
06930 belowcommand.setpos(belowcommand.pos-1);
06940 GOTO start;
06950 END ELSE
06960 BEGIN commandchar:= char(0); GOTO endcommand;
06970 END;
06980 END ELSE
06990 IF q_gotchar = control_u THEN ! erase command;
07000 BEGIN commandchar:= char(0); GOTO endcommand;
07010 END ELSE
07020 BEGIN
07030 IF q_gotchar < ' ' THEN
07040 BEGIN
07050 IF q_gotchar = altmode THEN
07060 outchr(terminalout,fill,1);
07070 IF q_gotchar NE carriagereturn AND
07080 anytextparameter THEN GOTO endcommand;
07090 END;
07100 IF q_gotchar NE carriagereturn AND q_gotchar NE linefeed
07110 THEN
07120 BEGIN
07130 belowcommand.putchar(oldchar);
07140 command.putchar(q_gotchar);
07150 END;
07160 END;
07170 END;
07180 COMMENT body of PROCEDURE getcommand; !z_t(19);
07190 hstart:= q_horizontalpos; vstart:= q_verticalpos;
07200 command:= "&"; command.setpos(2);
07205 IF q_horizontalpos > widthm1 then goto getout;
07210 belowcommand:=
07220 screen(q_verticalpos).sub(q_horizontalpos+1,1);
07230 belowcommand.setpos(2);
07240 type_ahead:= trmop(8R0001,sysout,1) = 1 !=type ahead;;
07250 echoff; synchronize(hstart,vstart);
07260 outchar('&');
07270 IF hstart >= widthm1 THEN GOTO endcommand;
07280 leading_number:= -1;
07290 leading_number:= intin;
07300 commandchar:= q_gotchar;
07310 COMMENT upcase commandchar;
07320 IF commandchar >= 'a' THEN
07330 commandchar:= char(rank(commandchar)-32);
07340
07350 COMMENT test for each possible first command character;
07360 IF commandchar = 'R' THEN
07370 BEGIN restore_command;
07380 restore_screen(vstart);
07390 END ELSE IF commandchar = 'W' THEN
07400 BEGIN restore_command; removeword;
07410 END ELSE IF commandchar = '-' THEN
07420 BEGIN restore_command; avstava;
07430 END ELSE IF commandchar = 'X' THEN
07440 BEGIN restore_command;
07450 arg1:= screen(vstart).strip.length;
07460 IF arg1 > widthm1 THEN arg1:= widthm1;
07470 move_the_cursor_to(arg1,vstart);
07480 END ELSE IF commandchar = 'O' THEN
07490 BEGIN restore_command; print_status;
07500 END ELSE IF commandchar = 'U' THEN
07510 BEGIN restore_command; blank_front;
07520 END ELSE IF commandchar = 'E' THEN
07530 BEGIN restore_command; forceout(sysout); GOTO stopedit;
07540 END ELSE IF commandchar = 'C' THEN
07550 BEGIN restore_command; control_c;
07560 END ELSE IF commandchar = 'V' THEN
07570 BEGIN arg1:= IF leading_number = -1 THEN 1 ELSE
07580 leading_number;
07590 IF arg1 > line_model.length THEN arg1:= 0;
07600 restore_command; insert(line_model.sub(1,arg1));
07610 move_the_cursor_to(hstart,vstart);
07620 END ELSE IF commandchar = 'T' THEN
07630 BEGIN arg1:= intin; restore_command;
07640 IF arg1 > widthm1 THEN arg1:= widthm1;
07650 IF q_gotchar > ' ' AND q_gotchar NE 'T' AND q_gotchar NE 't'
07660 THEN settab(IF arg1 = -2 THEN hstart ELSE arg1,q_gotchar)
07670 ELSE IF arg1 = -2 THEN position_tab(FALSE) ELSE
07680 move_the_cursor_to(arg1,vstart);
07690 END ELSE IF commandchar = 'L' THEN
07700 BEGIN arg1:= intin; restore_command;
07710 addlines(arg1,TRUE,q_gotchar = 'D' OR q_gotchar = 'd');
07720 END ELSE IF commandchar = 'M' THEN
07730 BEGIN secondchar:= nextchar;
07740 arg1:= intin; restore_command;
07750 margset(secondchar,arg1);
07760 END ELSE IF commandchar = 'J' THEN
07770 BEGIN arg1:= IF leading_number = -1 THEN
07780 0 ELSE leading_number; restore_command;
07790 justify(arg1,TRUE);
07800 END ELSE IF commandchar = 'F' THEN
07810 BEGIN arg1:= intin; restore_command;
07820 justify(arg1,FALSE);
07830 END ELSE IF commandchar = 'Z' THEN
07840 BEGIN arg1:= intin; restore_command; z_scroll(arg1);
07850 END ELSE IF commandchar = 'D' THEN
07860 BEGIN arg1:= IF leading_number = -1 THEN 1 ELSE leading_number;
07870 restore_command; removechars(arg1);
07880 END ELSE IF commandchar = 'K' THEN
07890 BEGIN arg1:= IF leading_number = -1 THEN 1 ELSE leading_number;
07900 restore_command; removelines(arg1);
07910 END ELSE IF commandchar = 'H' THEN
07920 BEGIN restore_command; help;
07930 END ELSE IF commandchar = 'P' THEN
07940 BEGIN arg1:= intin; restore_command;
07950 IF q_gotchar = 'A' OR q_gotchar = 'a' THEN
07960 BEGIN
07970 IF NOT endpage THEN newpages(0,TRUE);
07980 append_page;
07990 END
08000 ELSE IF q_gotchar = 'I' OR q_gotchar = 'i' THEN pagedivide
08010 ELSE IF q_gotchar = 'E' OR q_gotchar = 'e'
08020 THEN newpages(arg1,TRUE)
08030 ELSE IF q_gotchar = 'N' OR q_gotchar = 'n' THEN
08040 BEGIN arg1:= arg1-pagenumber; IF arg1 < 0
08050 THEN warning("That page has already been passed.")
08060 ELSE newpages(arg1,FALSE);
08070 END
08080 ELSE IF q_gotchar = 's' OR q_gotchar = 'S' THEN
08090 search_for(page_end_marker,'N') ELSE newpages(arg1,FALSE);
08100 END ELSE IF commandchar = 'Q' THEN
08110 BEGIN
08120 arg2:= -1; anytextparameter:= TRUE;
08130 WHILE letter(nextchar) OR digit(q_gotchar) DO;
08140 IF command.pos > (IF q_gotchar = carriagereturn THEN 3 ELSE 4)
08150 THEN qname:- copy(command.sub(3,command.pos-
08160 (IF q_gotchar = carriagereturn THEN 3 ELSE 4)));
08170 anytextparameter:= FALSE;
08180 arg1:= intin;
08190 IF q_gotchar >= ' ' THEN arg2:= intin ELSE
08200 BEGIN arg2:= arg1; arg1:= 0;
08210 END;
08220 restore_command;
08230 qregistercall:
08240 IF qname = NOTEXT THEN
08250 qname:- warning( "You gave no qregister name.")
08260 ELSE put_register(qname,arg1,arg2);
08270 END ELSE IF commandchar = 'A' THEN
08280 BEGIN
08290 arg1:= intin; arg2:= intin; restore_command;
08300 IF arg1 < width AND arg2 < height THEN
08310 move_the_cursor_to(arg1,arg2);
08320 END ELSE IF commandchar = 'G' THEN
08330 BEGIN
08340 WHILE letter(nextchar) OR digit(q_gotchar) DO;
08350 IF q_gotchar = carriagereturn THEN
08360 command.setpos(command.pos+1);
08370 IF command.pos > 4 THEN
08380 qname:- copy(command.sub(3,command.pos-4));
08390 restore_command; get_register(qname);
08400 END ELSE IF commandchar = 'I' OR commandchar = 'S' OR
08410 commandchar = 'N' THEN
08420 BEGIN
08430 anytextparameter:= TRUE; WHILE TRUE DO nextchar;
08440 END ELSE
08450 endcommand:
08460 BEGIN COMMENT handling of end of &I, &Q, &S and &N commands,
08470 that is some of the commands taking nonnumerical parameters,
08480 also handling of some ununderstandable commands;
08490 restore_command;
08500 IF commandchar = 'I' THEN
08510 BEGIN COMMENT &I<qname>& command;
08520 IF command.pos > 3 THEN
08530 qname:- command.sub(3,command.pos-3);
08540 insert(qname);
08550 END ELSE IF commandchar = 'S' OR commandchar = 'N' THEN
08560 BEGIN COMMENT &S<qname>& and &N<qname>& command;
08570 IF command.pos > 3 THEN
08580 qname:- command.sub(3,command.pos-3);
08590 IF qname = NOTEXT THEN qname:- old_search_string
08600 ELSE old_search_string:- copy(qname);
08610 search_for(qname,commandchar);
08620 END ELSE
08630 IF commandchar = 'Q' THEN
08640 BEGIN COMMENT &Q<qname>& command;
08650 IF arg2 < 0 THEN
08660 BEGIN arg2:= arg1; arg1:= 0;
08670 END;
08680 IF qname == NOTEXT
08690 AND command.pos > 3 THEN
08700 qname:- copy(command.sub(3,command.pos-3));
08710 GOTO qregistercall;
08720 END;
08730 END;
08740 COMMENT End of the handling a VIDED command, ignore type ahead
08750 made by the user during the performance of the action of the
08760 VIDED command, and restore the screen if there was too much type
08770 ahead before the beginning of the handling of the VIDED command;
08780 IF NOT q_echoenabled THEN
08790 BEGIN WHILE trmop(8R0001,sysout,1) = 1 !=type ahead; DO getch;
08800 IF verybadscreen THEN
08810 BEGIN restore_screen(q_verticalpos);
08820 verybadscreen:= badscreen:= FALSE;
08830 END ELSE echon;
08840 END;
08850 getout: !z_t(-19);
08860 END of getcommand;
08870 PROCEDURE edit;
08880 COMMENT This procedures contains a loop with one step for every
08890 character typed by the user which is to be included in the text
08900 being edited. (Not characters in the inputting of VIDED commands
08910 preceded by ESCAPE or CONTROL-F). The procedure checks if the
08920 character is a single character command like CONTROL-U and
08930 performs the appropriate action;
08940 BEGIN INTEGER vpos, hpos; COMMENT pos before last character read;
08950 WHILE TRUE DO
08960 BEGIN
08970 vpos:= q_verticalpos; hpos:= q_horizontalpos;
08980 IF hpos > right_margin THEN
08990 BEGIN COMMENT program echo at end of line to get proper
09000 handling of too long input lines from the terminal;
09010 IF q_echoenabled THEN
09020 BEGIN IF trmop(8R0001,sysout,1) = 1 !=type ahead; THEN
09030 BEGIN echoff; synchronize(hpos,vpos);
09040 END;
09050 END;
09060 END;
09070 call(p_insingle); COMMENT read one character;
09080 IF NOT q_echoenabled THEN
09090 BEGIN COMMENT shall we restore echoing if no type ahead?;
09100 IF q_horizontalpos < right_margin THEN
09110 BEGIN
09120 IF NOT trmop(8R0001,sysout,1) = 1 !=type ahead; THEN echon;
09130 END;
09140 END;
09150 COMMENT%IF VIDTIM
09160 outchr(vidtim,q_gotchar,1);
09170 COMMENT%IFEND VIDTIM;
09180 COMMENT%IF debugslow
09190 IF debugslow > 0 THEN sleep(debugslow);
09200 COMMENT%IFEND debugslow;
09210 IF controlchar THEN
09220 BEGIN COMMENT character < 32 or > 126;
09230 IF q_gotchar NE carriagereturn THEN
09240 BEGIN
09250 IF q_gotchar = linefeed THEN
09260 BEGIN
09270 IF vpos >= heightm1 THEN
09280 BEGIN
09290 emptyscroll:= TRUE; call(p_scroll);
09300 emptyscroll:= FALSE;
09310 END;
09320 END ELSE
09330 BEGIN
09340 IF q_gotchar = altmode THEN
09350 BEGIN
09360 IF terminaltype = minitec OR terminaltype = tandberg
09370 THEN outchr(terminalout,fill,2);
09380 getcommand;
09390 END ELSE IF q_gotchar = control_f THEN getcommand
09400 ELSE IF q_gotchar = tab THEN position_tab(TRUE)
09410 ELSE IF q_gotchar = fill THEN
09420 BEGIN COMMENT RUB OUT;
09430 IF hpos = 0 AND vpos > 0 THEN
09440 BEGIN COMMENT RUB OUT at beginning of line goes back
09450 to end of previous line;
09460 vpos:= vpos-1;
09470 hpos:= screen(vpos).strip.length;
09480 IF hpos > widthm1 THEN hpos:= widthm1;
09490 move_the_cursor_to(hpos,vpos);
09500 END;
09510 END ELSE IF q_gotchar = control_u THEN
09520 blank_front
09530 ELSE IF q_gotchar = control_d THEN
09540 removechars(1) ELSE IF q_gotchar = control_v THEN
09550 BEGIN insert(line_model.sub(1,1));
09560 move_the_cursor_to(hpos,vpos);
09570 END ELSE IF q_gotchar = control_w THEN
09580 BEGIN IF terminaltype = infoton THEN
09590 removeword;
09600 END;
09610 END;
09620 END;
09630 END ELSE
09640 BEGIN COMMENT NOT controlchar;
09650 IF badscreen THEN COMMENT LF at bottom of a page;
09660 BEGIN emptyscroll:= TRUE; call(p_scroll);
09670 emptyscroll:= badscreen:= FALSE;
09680 END;
09690 END;
09700 END;
09710 END;
09720 PROCEDURE stop_editing;
09730 BEGIN GOTO stopedit;
09740 END;
09750 PROCEDURE startmic;
09760 BEGIN COMMENT close edit text files;
09770 IF NOT tmpoutfile THEN
09780 BEGIN editin.close; editout.close;
09790 END ELSE
09800 BEGIN COMMENT delete old backup file, rename input file to
09810 backup extension, rename output file to the name of the input
09820 file;
09830 TEXT bakfilename; CHARACTER c;
09840 bakfilename:- copy(inspec);
09850 COMMENT backup file takes extension beginning with .Q;
09860 scanto(bakfilename,'.');
09870 c:= fetchar(bakfilename,bakfilename.pos);
09880 IF c NE '[' AND c NE '<' THEN
09890 bakfilename.putchar('Q') ELSE
09900 bakfilename:- conc(front(bakfilename),"Q",rest(bakfilename));
09910 depchar(bakfilename,bakfilename.length-3,'0');
09920
09930 outimage;
09940 IF rename(bakfilename,NOTEXT,FALSE) > 0 THEN
09950 BEGIN COMMENT Old backup file could not be deleted;
09960 outtext("?VIDED - CANNOT DELETE FILE: ");
09970 outtext(bakfilename);
09980 outimage;
09990 editin.close; editout.close;
10000 END ELSE
10010 BEGIN
10020 outtext(" INPUT FILE WILL BE RENAMED TO: ");
10030 outtext(bakfilename); outimage;
10040 IF rename(editin,bakfilename,TRUE) >= 0 THEN
10050 BEGIN COMMENT input file could not be renamed to backup
10060 name;
10070 outtext("?VIDED - CANNOT RENAME INPUT FILE: ");
10080 outtext(inspec); editout.close;
10090 END ELSE
10100 BEGIN
10110 IF rename(editout,inspec,TRUE) >= 0 THEN
10120 BEGIN COMMENT temporary output file could not be renamed
10130 to the name of the input file;
10140 outtext("?VIDED - CANNOT RENAME OUTPUT FILE: ");
10150 outtext(arg[1]);
10160 END;
10170 END;
10180 END;
10190 sysout.outimage;
10200 END;
10210 END;
10220 COMMENT start of execution;
10230 IF terminaltype = tandberg THEN control_f:= char(14);
10240 dashblank:- copy("- ");
10250 edit; COMMENT start of editing;
10260 stopedit:
10270 COMMENT Save q-registers for continued editing;
10280 q_qregisters:- qregisters;
10290 IF NOT q_echoenabled THEN echon;
10300 END;
10310 stopedit:
10320 COMMENT remember initial parameter settings at continued execution;
10330 BEGIN INTEGER i;
10340 FOR i:= 1 STEP 1 UNTIL 12 DO
10350 BEGIN
10360 IF arg[i] =/= NOTEXT THEN
10370 BEGIN ini[i]:- arg[i]; arg[i]:- NOTEXT;
10380 ini[i].setpos(1);
10390 END;
10400 ini[1]:- ini[3]:- NOTEXT;
10410 tmpoutfile:= FALSE;
10420 COMMENT%IF VIDTIM
10430 vidtim.close;
10440 COMMENT%IFEND VIDTIM;
10450 COMMENT%IF FQC
10460 Goto totalstop;
10470 COMMENT%IFEND FQC;
10480 exit(0);
10490 GOTO topstart;
10500 END;
10510 END;
10520 totalstop:
10530 END;