Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/06/mided1.sim
There are 2 other files named mided1.sim in the archive. Click here to see a list.
00040 OPTIONS(/l/e); COMMENT DISPLAY EDITOR.
00080 See VISTA.MAN for explanations on the routines called by this program,
00120 taken from the class mvista;
00160 COMMENT Copyright (c) Swedish National Defense Research Institute;
00200 COMMENT%IF CALLMAC;
00240 EXTERNAL PROCEDURE vtmcur, vtsynk, vtisng;
00280 COMMENT%IFEND CALLMAC;
00320 EXTERNAL PROCEDURE outche, tshift, pgcopy;
00360 EXTERNAL INTEGER PROCEDURE iondx, vdlno;
00400 EXTERNAL TEXT PROCEDURE conc, front, storbokstav, litenbokstav,
00440 compress, rest, inline, frontstrip, scanto, from, upto, maketext;
00480 EXTERNAL CHARACTER PROCEDURE findtrigger, fetchar, getch;
00520 EXTERNAL INTEGER PROCEDURE search, scanint, sscan, checkint;
00560 EXTERNAL REF (infile) PROCEDURE findinfile;
00600 EXTERNAL REF (outfile) PROCEDURE findoutfile;
00640 EXTERNAL INTEGER PROCEDURE trmop, gettab;
00680 EXTERNAL BOOLEAN PROCEDURE puttext, numbered, dotypeout;
00720 EXTERNAL PROCEDURE depchar, outstring, forceout, echo;
00760 EXTERNAL PROCEDURE outchr, abort, exit;
00800 EXTERNAL BOOLEAN PROCEDURE meny;
00840 EXTERNAL CLASS termty;
00880
00920 COMMENT%IF CALLMAC;
00960 EXTERNAL CLASS mmista;
01000 mmista CLASS mided1;
01040 COMMENT%IFNOT CALLMAC
01080 EXTERNAL CLASS mvista;
01120 COMMENT%IFNOT CALLMAC
01160 mvista CLASS vided1;
01200 COMMENT%IFEND CALLMAC;
01240 BEGIN
01280
01320 CLASS qregister(qwidth, qheight, qname);
01360 INTEGER qwidth, qheight; TEXT qname;
01400 BEGIN
01440 COMMENT qregister is a class containing segments
01480 of text which the user has stored away for
01520 insertion in other places in his text. A qregister
01560 is a square of text, with a width
01600 (characters/line) and height (number of lines).
01640
01680 Qregister is a separately compiled class, since
01720 the class should be available outside the body of
01760 VIDED1 and VIDED2 in the preamble of the VIDED
01800 program, so that a user can retain qregister
01840 contents between successive editings of different
01880 or the same text;
01920
01960 TEXT ARRAY lines[0:qheight-1];
02000 REF (qregister) next_qregister;
02040 END;
02080
02120 INTEGER last_line_number; ! When creating line-numbered files,
02160 number of last line which has been output to the output file;
02200 INTEGER line_number; ! temporary line number value;
02240 INTEGER largest_line_number; ! Largest line number yet created;
02280 INTEGER increment; ! between new line-numbered lines;
02300 BOOLEAN videdp; ! count lines in VIDEDP fashion;
02320 BOOLEAN numbered_infile; ! input file had line numbers;
02360 BOOLEAN backuping; ! Auto-backup in progress;
02400 BOOLEAN merrygoround; ! Either auto-backup or moving to earlier page;
02440 BOOLEAN swedish, tmpoutfile;
02480 REF (infile) editin; ! Input file to be edited;
02520 REF (outfile) editout; ! Output file from editing;
02560 INTEGER showdefault; ! how many lines to show on screen;
02600 INTEGER pageheight; ! plus height = number of lines kept in core;
02660 INTEGER warningheight; ! before page-end-warning;
02680 INTEGER leftmargin, rightmargin; ! used when justifying
02720 paragraphs;
02760 BOOLEAN pageheader; ! Put header and number on new pages;
02800 TEXT command; ! Text of user &command during editing;
02840 TEXT belowcommand; ! Screen text below user &command;
02880 INTEGER keys; ! Max dimension of the arrays below;
02920 COMMENT the arrays below contain handling of switches in
02960 the initial command to VIDED giving file names etc:
03000 For a description of these arrays, see the large comment
03040 in the beginning of the file SCAN.SIM;
03080 TEXT ARRAY arg, key, ini(1:27); ! User switch.ini and file creation
03120 commands;
03160 CHARACTER dot; ! this character in pos 1 of line stops &JU, &FI;
03200
03240 mvistax CLASS vided1x;
03280 BEGIN
03320 INTEGER sub_page_number; ! too large pages divided into;
03360 INTEGER ARRAY screen_length[0:height-1]; ! when overwriting
03400 part of the screen with corrected text, this array keeps the old
03440 line lengthes to know how much has to be overwritten;
03480 TEXT ARRAY top_of_page[0:pageheight]; ! lines which have rolled
03520 out on top of the screen but have not yet been output;
03560 INTEGER top_size; ! Number of lines in "top_of_page";
03600 INTEGER top_fill; ! Number of lines currently in "top_of_page";
03640 INTEGER ttytab; ! Value of monitor TRMOP .TTY TAB settings,
03680 governs the handling of <HT> characters at terminal output;
03720 INTEGER pagenumber; ! Count of input page number;
03760 INTEGER debugslow; ! When this variable is nonzero, the program can
03800 be artificially slowed down to create the kind of bugs which only
03840 occur with a heavily loaded computer;
03880 INTEGER out_pagenumber; ! Count of output page number;
03920 INTEGER first_text_pos;! 8 for numbered, 0 for other files;
03960 INTEGER pbottom; ! Unwanted size of blank area in &nPS command;
04000 CHARACTER control_f, control_d, control_v, control_u, control_w;
04040 ! What is input when the terminal user pushes CONTROL plus
04080 one of the letters f, d, v, u or w;
04120 BOOLEAN ARRAY tab_position[0:width]; ! tabs set by user;
04160 INTEGER margin_width; ! rightmargin-leftmargin;
04200 INTEGER cover_length; ! cover old text at end of line;
04240 BOOLEAN first_input_line; ! true when only one line has been input
04280 from the input text file;
04320 BOOLEAN nooutput; ! During &_ monitor command;
04360 BOOLEAN long_line_warned; ! user has been warned about too long
04400 input lines;
04440 BOOLEAN addff; ! Add <form feed> before next output line;
04480 BOOLEAN inhibit_ff; ! form feed has been copied;
04520 BOOLEAN after_addff; ! Outputting second line of a page;
04560 BOOLEAN endpage; ! Last line of a page has been read from file;
04600 BOOLEAN verybadscreen; ! Terminal screen must be restored from the
04640 computer;
04680 BOOLEAN printing; ! New input lines to be printed on terminal;
04720 BOOLEAN emptyscroll; ! Scroll in blank lines at bottom of screen;
04760 BOOLEAN psearch; ! TRUE during &nPS command execution;
04800 BOOLEAN pfound; ! TRUE when large blank bottom found during &nPS;
04840 BOOLEAN command_done; ! VIDED command correctly done;
04880 REF (qregister) qregisters; ! See description of &Q editor
04920 command;
04960 TEXT editin_image_strip; ! Stripped text of last line from the input
05000 text file;
05040 TEXT other_editin_image; ! Extra image to be used sometimes;
05080 TEXT line_model; ! Extra line, often blank, for use sometimes;
05120 TEXT editout_image; ! Image of output text file;
05160 TEXT header; ! Header at top of each page;
05200 TEXT sub_header; ! Subheader = line below header;
05240 TEXT page_word; ! Contains the word "PAGE";
05280 TEXT sid_word; ! Contains the word "SID", swedish for "PAGE";
05320 TEXT sixdigits; ! Used to produce line number text segments;
05360 TEXT page_end_marker; ! Funny text warning user of end-of-page;
05400 TEXT output_line; ! Line to be output to output text file;
05440 TEXT first_scroll_line; ! Top-of-page-line to be scrolled out;
05480 COMMENT REF-variables below used to get faster execution by using
05520 the CALL procedure instead of ordinary PROCEDURE invokings;
05560 REF (one_more_line_please) p_one_more_line_please;
05600 REF (scroll) p_scroll;
05640 REF (editin_true_inimage) p_editin_true_inimage;
05680 REF (true_write) p_true_write;
05720 REF (write) p_write;
05760 REF (editin_inimage) p_editin_inimage;
05800 REF (lower_line) lower_lines;
05840 PROCEDURE blankterminal;
05880 BEGIN IF addaltmode AND NOT homesingle
05920 THEN outchr(terminalout,altmode,1);
05960 outchr(terminalout,home,1);
06000 IF addaltmode AND NOT clearsingle
06040 THEN outchr(terminalout,altmode,1);
06080 outchr(terminalout,erasescreen,1);
06120 outchr(terminalout,delayer,10);
06160 END;
06200
06240 TEXT PROCEDURE make_five_digits(i);
06280 INTEGER i;
06320 BEGIN COMMENT prepars text in line-number-field of output line;
06360 sixdigits.putint(i+100000);
06400 make_five_digits:- sixdigits.sub(2,5);
06440 IF i > largest_line_number THEN largest_line_number:= i;
06480 END;
06520
06560 INTEGER PROCEDURE checksum;
06600 BEGIN COMMENT makes a checksum of what is shown on the screen;
06640 INTEGER i, sum;
06680 FOR i:=1 STEP 1 UNTIL height DO
06720 BEGIN
06760 sum:= sum + i * rank(fetchar(screen[i-1],i+13));
06800 END;
06840 checksum:= sum;
06880 END;
06920 TEXT PROCEDURE warning(message, line2);
06960 VALUE message, line2; TEXT message, line2;
07000 BEGIN INTEGER hpos, vpos, sl0;
07040 hpos:= q_horizontalpos; vpos:= q_verticalpos;
07080 dotypeout(terminalout); home_the_cursor; specialtext;
07120 INSPECT terminalin DO INSPECT terminalout DO
07160 BEGIN command_done:= TRUE; ! since one warning is enough;
07200 IF message.length >= widthm1-14 THEN message:-
07240 message.sub(1,widthm1-15); IF line2.length >= widthm1 THEN
07280 line2:- line2.sub(1,widthm1);
07320 outtext("?VIDED - ");
07360 outtext(message); outtext(" ");
07400 sl0:= image.pos-1; breakoutimage; outimage;
07440 outtext(IF line2 == NOTEXT THEN
07480 "To continue push RETURN. " ELSE line2); breakoutimage;
07520 inimage; storbokstav(terminalin.image.sub(1,10));
07560 warning:- terminalin.image;
07600 END;
07640 normaltext;
07680 IF q_display_output THEN
07720 BEGIN
07760 home_the_cursor; outtext(screen[0].sub(1,sl0));
07800 move_the_cursor_to(0,1); outtext(screen[1].sub(1,
07840 IF line2 == NOTEXT THEN 39 ELSE line2.length));
07880 END;
07920 move_the_cursor_to(hpos,vpos);
07960 END;
08000 REF (qregister) PROCEDURE find_qregister(qname);
08040 TEXT qname;
08080 BEGIN COMMENT find the latest qregister with a given name;
08120 COMMENT See description of the "Q" VIDED command;
08160 REF (qregister) scanner;
08200 storbokstav(qname);
08240 scanner:- qregisters;
08280 WHILE scanner =/= NONE DO
08320 BEGIN IF scanner.qname EQ qname THEN GOTO out;
08360 scanner:- scanner.next_qregister;
08400 END;
08440 out: find_qregister:- scanner;
08480 END;
08520
08560 TEXT PROCEDURE pop_line;
08600 COMMENT get a line from stack of lines pushed below screen;
08640 INSPECT lower_lines WHEN lower_line DO
08680 BEGIN pop_line:- linetext; lower_lines:- next_lower_line;
08720 END;
08722 INTEGER PROCEDURE videdpcount;
08724 BEGIN INTEGER line, count; CHARACTER two; TEXT t;
08726 FOR line:= -heightm1 step 1 until top_fill DO
08727 BEGIN
08728 t:- IF line <= 0 THEN screen(-line) ELSE top_of_page(line);
08731 IF fetchar(t,1) NE '.' THEN count:= count+2
08732 ELSE BEGIN
08734 two:= fetchar(t,2);
08736 IF two NE '&' AND two NE '_' AND two NE '+' THEN
08737 BEGIN
08738 count:= count +
08741 (IF two = 'u' OR two = 'U' OR two = 'L' or two = 'l' THEN
08742 1 ELSE 2);
08744 END;
08746 END;
08748 END;
08750 videdpcount:= count//2+1;
08752 END;
08760 CLASS lower_line(linetext);
08800 TEXT linetext;
08840 BEGIN COMMENT Text of line which has been pushed below the screen;
08880 REF (lower_line) next_lower_line;
08920 next_lower_line:- lower_lines;
08960 lower_lines:- THIS lower_line;
09000 END;
09040
09080 PROCEDURE push_line(l); NAME l; TEXT l;
09120 BEGIN COMMENT push a line to stack of lines below screen;
09160 IF upto(l,46) = page_end_marker THEN GOTO out;
09200 IF lower_lines =/= NONE THEN NEW lower_line(l) ELSE
09240 IF NOT (editin.endfile OR endpage)
09280 THEN NEW lower_line(l) ELSE
09320 BEGIN
09360 IF increment <= 0 THEN
09400 BEGIN
09440 IF l.strip =/= NOTEXT THEN NEW lower_line(l);
09480 END ELSE IF from(l,6).strip =/= NOTEXT
09520 THEN NEW lower_line(l);
09560 END;
09600 out: l:- blanks(width);
09640 END;
09680 PROCEDURE get_register(reg); REF (qregister) reg;
09720 COMMENT action of the &G VIDED command. Find a qregister, puts its
09760 contents on top of square on screen equal to the qregister size;
09800 INSPECT reg DO
09840 BEGIN
09880 INTEGER i, orghpos, hpos, vpos, coverlength, putlength;
09920 INTEGER maxwidth, maxheight, boxwidth, boxheight;
09960 TEXT coverpart;
10000 orghpos:= q_horizontalpos;
10040 IF increment > 0 THEN
10080 BEGIN COMMENT do not restore line numbers;
10120 IF qwidth = width-8 AND q_horizontalpos = 0 THEN
10160 move_the_cursor_to(8,q_verticalpos);
10200 END;
10240 hpos:= q_horizontalpos; vpos:= q_verticalpos;
10280 maxwidth:= width-hpos;
10320 maxheight:= height-vpos;
10360 boxwidth:= IF maxwidth < qwidth THEN maxwidth ELSE qwidth;
10400 boxheight:= (IF maxheight < qheight THEN maxheight ELSE
10440 qheight)-1;
10480 FOR i:= 0 STEP 1 UNTIL boxheight DO
10520 BEGIN
10560 move_the_cursor_to(hpos,vpos+i);
10600 coverpart:- lines(i).sub(1,boxwidth);
10640 putlength:= coverpart.strip.length;
10680 coverlength:= screen(q_verticalpos).sub(hpos+1,boxwidth)
10720 .strip.length;
10760 IF line_erasable AND (terminaltype NE i200 OR hpos = 0)
10800 AND boxwidth + hpos >= width THEN
10840 BEGIN outstring(terminalout,eraseeol);
10880 IF putlength < coverlength THEN screen(q_verticalpos).
10920 sub(hpos+1+putlength,coverlength-putlength):= NOTEXT;
10960 END ELSE IF putlength < coverlength
11000 THEN putlength:= coverlength;
11040 outtext(coverpart.sub(1,putlength));
11080 END;
11120 move_the_cursor_to(orghpos,vpos);
11160 command_done:= TRUE;
11200 END;
11240 PROCEDURE put_register(qname,box_width, box_height);
11280 TEXT qname; INTEGER box_width, box_height;
11320 BEGIN COMMENT action of the &Q VIDED command;
11360 INTEGER hpos, vpos, maxwidth, maxheight, i;
11400 IF box_width= 0 THEN
11440 BEGIN
11480 hpos:= IF q_horizontalpos=0 AND increment > 0
11520 THEN 8 ELSE q_horizontalpos;
11560 box_width:= width;
11600 END ELSE hpos:= q_horizontalpos;
11640 IF box_height = 0 THEN box_height:= height;
11680 storbokstav(qname);
11720 vpos:= q_verticalpos;
11760 maxheight:= height-vpos; maxwidth:= width-hpos;
11800 IF box_width > maxwidth THEN box_width:= maxwidth;
11840 IF box_height > maxheight THEN box_height:= maxheight;
11880 INSPECT NEW qregister(box_width, box_height, qname) DO
11920 BEGIN
11960 next_qregister:- qregisters; qregisters:- THIS qregister;
12000 FOR i:= 1 STEP 1 UNTIL box_height DO
12040 lines(i-1):- copy(screen[vpos+i-1].sub(hpos+1,box_width));
12080 command_done:= TRUE;
12120 END;
12160 END;
12200 PROCEDURE restore_the_whole_screen;
12240 restore_screen(q_verticalpos, 998);
12280
12320 PROCEDURE restore_screen(startline, showlines);
12360 INTEGER startline, showlines;
12400 COMMENT: If the picture of the screen has been destroyed, then a
12440 call to this procedure will make the picture on the screen equal to
12480 the internal picture in the program. Used by the &R VIDED command;
12520 COMMENT negative showlines gives no initial blanking;
12560 IF q_display_output THEN
12600 BEGIN TEXT strippedline; INTEGER first, last;
12640 BOOLEAN donotblank;
12680 IF showlines < 0 THEN
12720 BEGIN showlines:= -showlines; donotblank:= TRUE;
12760 END;
12800 IF showlines >= height THEN showlines:= showlines*3;
12840 last:= showlines//3; first:= startline-showlines+last+1;
12880 last:= last+startline;
12920 IF last > heightm1 THEN last:= heightm1;
12960 IF first < 0 THEN first:= 0;
13000 IF last-first+1 < showlines THEN
13040 BEGIN
13080 last:= first+showlines-1;
13120 IF last > heightm1 THEN last:= heightm1;
13160 END;
13200 INSPECT terminalout DO
13240 BEGIN
13280 INTEGER h, v, hold, vold, vp;
13320 badscreen:= verybadscreen:= FALSE; ! We are making it good again;
13360 hold:= q_horizontalpos; vold:= q_verticalpos;
13400 home_the_cursor;
13440 BEGIN ! Blank the screen;
13480 IF NOT donotblank THEN blankterminal;
13520 END;
13560 IF terminaltype = cdc71310s THEN home_the_cursor;
13600 q_horizontalpos:= q_verticalpos:= 0;
13640 FOR vp:= 0 STEP 1 UNTIL heightm1 DO
13680 FOR v:= startline+vp,startline-vp-1 DO
13720 BEGIN
13760 IF v >= first THEN
13800 BEGIN
13840 IF v <= last THEN
13880 BEGIN
13920 strippedline:- screen[v];
13960 IF NOT donotblank OR line_erasable THEN
14000 strippedline:- strippedline.strip;
14040 IF donotblank OR strippedline =/= NOTEXT THEN
14080 BEGIN
14120 move_the_cursor_to(0,v);
14160 IF line_erasable THEN outstring(terminalout,eraseeol);
14200 outstring(terminalout,strippedline);
14240 outchr(terminalout,carriagereturn,1);
14280 END;
14320 END;
14360 END;
14400 END;
14440 forceout(terminalout); dotypeout(terminalout);
14480 synchronize(hold,vold);
14520 END;
14560 END;
14600 PROCEDURE save_lengthes;
14640 COMMENT Save the lengthes of non-blank lines on the screen to know
14680 how much must later be restored;
14720 BEGIN INTEGER i;
14760 FOR i:= 0 STEP 1 UNTIL heightm1 DO
14800 screen_length[i]:= screen[i].strip.length;
14840 END;
14880 PROCEDURE exchange_lines(l1,l2);
14920 INTEGER l1, l2;
14960 BEGIN TEXT firstline;
15000 firstline:- screen(l1);
15040 screen(l1):- screen(l2);
15080 screen(l2):- firstline;
15120 END;
15160 CLASS one_more_line_please;
15200 COMMENT Get a line from the input file;
15240 BEGIN INTEGER new_length;
15280 detachloop: detach;
15320 !z_t(8); call(p_editin_inimage);
15360 IF printing THEN
15400 BEGIN
15440 new_length:= editin_image_strip.length;
15480 IF line_erasable THEN
15520 outstring(terminalout,eraseeol)
15560 ELSE IF new_length < cover_length
15600 THEN new_length:= cover_length;
15640 outtext(editin.image.sub(1,new_length));
15680 move_the_cursor_to(0,q_verticalpos);
15720 END ELSE screen(q_verticalpos):= editin_image_strip;
15760 !z_t(-8);
15800 GOTO detachloop;
15840 END;
15880 PROCEDURE shift(frompos, topos, steps);
15920 INTEGER frompos, topos, steps;
15960 COMMENT shift part of the screen downwards, e.g. to get space for
16000 new lines created by &L or &J VIDED commands;
16040 BEGIN INTEGER i;
16080 steps:= steps-1;
16120 IF frompos > topos THEN
16160 BEGIN
16200 FOR i:= 0 STEP 1 UNTIL steps DO
16240 exchange_lines(topos+i,frompos+i);
16280 END ELSE
16320 BEGIN
16360 FOR i:= steps STEP -1 UNTIL 0 DO
16400 exchange_lines(topos+i,frompos+i);
16440 END;
16480 END of shift;
16520 PROCEDURE restore_lines(first,last);
16560 INTEGER first, last;
16600 COMMENT make the terminal screen contents equal to the internal
16640 screen contents for lines [first,last] of the screen;
16680 IF q_display_output THEN
16720 BEGIN
16760 INTEGER i, maxlength;
16800 maxlength:= 1000;
16840 FOR i:= first STEP 1 UNTIL last DO
16880 BEGIN
16920 IF maxlength < width THEN outchr(terminalout,linefeed,1)
16960 ELSE synchronize(0,i);
17000 maxlength:= screen(i).strip.length;
17040 IF line_erasable THEN
17080 outstring(terminalout,eraseeol)
17120 ELSE IF maxlength < screen_length(i) THEN
17160 maxlength:= screen_length(i);
17200 outstring(terminalout,screen(i).sub(1,maxlength));
17240 outchr(terminalout,carriagereturn,1);
17280 END;
17320 home_the_cursor;
17360 END;
17400 CLASS editin_true_inimage;
17440 COMMENT input a line from the input text file;
17480 BEGIN TEXT part; INTEGER current_line_number;
17520 detachloop: detach;
17560 INSPECT editin DO
17600 BEGIN
17640 IF first_input_line THEN first_input_line:= FALSE
17680 ELSE inimage;
17720 IF endfile THEN image.sub(1,2):= NOTEXT;
17760 part:- scanto(image,tab);
17800 IF image.more THEN
17840 BEGIN COMMENT there was a tab;
17880 IF other_editin_image == NOTEXT THEN
17920 other_editin_image:- blanks(image.length) ELSE
17960 BEGIN other_editin_image:= NOTEXT;
18000 other_editin_image.setpos(1);
18040 END;
18080 IF numbered_infile THEN
18120 BEGIN IF increment = 0 THEN
18160 BEGIN IF part.length = 5 THEN
18200 BEGIN COMMENT remove line number; COMMENT Code only
18240 executed when removing line numbers from a file;
18280 IF vdlno(part) >= 0 THEN GOTO after_put;
18320 END of part.length = 5;
18360 END of increment = 0;
18400 END;
18440 loop:
18480 puttext(other_editin_image,part);
18520 other_editin_image.setpos
18560 (other_editin_image.pos+8
18600 -mod(other_editin_image.pos-1,8));
18640 after_put:
18680 IF image.more THEN
18720 BEGIN
18760 part:- scanto(image,tab);
18800 IF NOT image.more THEN part:- part.strip;
18840 GOTO loop;
18880 END;
18920 part:- image; image:- other_editin_image;
18960 other_editin_image:- part;
19000 END;
19040 image.setpos(1);
19080 END;
19120 GOTO detachloop;
19160 END;
19200 CLASS true_write;
19240 BEGIN COMMENT Output of a line to the output text file;
19280 detachloop: detach;
19320 IF NOT backuping AND upto(output_line,46) = page_end_marker THEN
19360 BEGIN output_line:= NOTEXT; GOTO fastout;
19400 END;
19440 output_line:- output_line.strip;
19480 IF after_addff THEN
19520 BEGIN after_addff:= FALSE;
19560 IF pageheader THEN
19600 sub_header:- IF addff THEN NOTEXT ELSE
19640 copy(IF increment <= 0 THEN output_line ELSE
19680 from(output_line,9));
19720 END;
19760 IF increment NE 0 THEN
19800 BEGIN
19840 IF addff THEN
19880 BEGIN
19920 IF pageheader THEN header:= from(output_line,9);
19960 after_addff:= TRUE;
20000 IF inhibit_ff THEN inhibit_ff:= FALSE ELSE BEGIN
20040 editout.image.setpos(6); editout.outchar(carriagereturn);
20080 editout.outchar(formfeed);
20120 editout.breakoutimage;
20160 END;
20200 addff:= FALSE;
20240 out_pagenumber:= out_pagenumber+1;
20280 END;
20320 line_number:= vdlno(output_line);
20360 IF line_number >= 0 THEN
20400 BEGIN
20440 last_line_number:= line_number;
20480 IF output_line.length = 5 THEN GOTO goodnumbered;
20520 IF output_line.length >= 8 THEN
20560 BEGIN IF output_line.sub(6,3) = " " THEN
20600 GOTO goodnumbered;
20640 END;
20680 END;
20720 IF output_line.length > 8 THEN
20760 BEGIN
20800 IF output_line.sub(1,8) = " " THEN
20840 output_line:- output_line.sub(9,output_line.length-8);
20880 END;
20920 COMMENT the line had no correct line number;
20960 last_line_number:= last_line_number+increment;
21000 editout.outtext(make_five_digits(last_line_number));
21040 editout.outchar(tab); editout.outtext(output_line);
21080 IF FALSE THEN goodnumbered:
21120 BEGIN
21160 editout.outtext(output_line.sub(1,5));
21200 editout.outchar(tab);
21240 IF output_line.length >= 8 THEN
21280 editout.outtext(from(output_line,9));
21320 END;
21360 editout.outimage; output_line:= NOTEXT;
21400 END ELSE
21440 BEGIN COMMENT the output file should NOT
21480 be line numbered;
21520 IF addff THEN BEGIN
21560 IF inhibit_ff THEN editout.image:- output_line
21600 ELSE BEGIN
21640 editout.outchar(formfeed); editout.outtext(output_line);
21680 END;
21720 IF pageheader THEN header:= output_line; after_addff:= TRUE;
21760 editout.outimage; output_line:= NOTEXT;
21800 out_pagenumber:= out_pagenumber+1; addff:= FALSE;
21840 IF inhibit_ff THEN BEGIN
21880 inhibit_ff:= FALSE; editout.image:- editout_image;
21920 END;
21960 END ELSE
22000 BEGIN
22040 editout.image:- output_line;
22080 editout.outimage;
22120 editout.image:- editout_image;
22160 END;
22200 END;
22240 fastout:
22280 GOTO detachloop;
22320 END;
22360 CLASS write;
22400 BEGIN
22440 TEXT exchanger;
22480 detachloop: detach;
22520 IF upto(first_scroll_line,46) = page_end_marker THEN
22560 BEGIN first_scroll_line:= NOTEXT;
22600 GOTO detachloop;
22640 END;
22680 IF top_fill = top_size THEN empty_top_of_page;
22720 IF NOT nooutput THEN
22760 BEGIN
22800 top_fill:= top_fill+1;
22840 exchanger:- top_of_page[top_fill];
22880 top_of_page[top_fill]:- first_scroll_line;
22920 first_scroll_line:- exchanger;
22960 END ELSE first_scroll_line:= NOTEXT;
23000 GOTO detachloop;
23040 END of CLASS write;
23080 PROCEDURE empty_top_of_page;
23120 COMMENT move lines which previously have been scrolled out
23160 above the top of the screen from an internal buffer
23200 "top_of_page" to the output text file;
23240 BEGIN
23280 INTEGER top_bottom;
23320 sub_page_number:= sub_page_number+1;
23360 FOR top_bottom:= 0 STEP 1 UNTIL top_fill DO
23400 BEGIN
23440 output_line:- top_of_page[top_bottom]; call(p_true_write);
23480 END;
23520 top_fill:= -1;
23560 END;
23600 CLASS scroll;
23640 BEGIN COMMENT scroll screen, top line out, new bottom line in;
23680 INTEGER i;
23720 detachloop: detach;
23760 !z_t(9); first_scroll_line:- screen(0); call(p_write);
23800 FOR i:= 1 STEP 1 UNTIL heightm1 DO
23840 screen(i-1):- screen(i);
23880 screen(heightm1):- first_scroll_line;
23920 IF NOT pageheader OR backuping THEN GOTO nomark;
23939 IF NOT videdp THEN BEGIN
23949 IF top_fill+height+1 = warningheight
23962 THEN GOTO mark ELSE GOTO nomark;
23972 END;
23979 IF top_fill+height+1 < warningheight THEN GOTO nomark;
23986 IF videdpcount = warningheight THEN
24000 BEGIN
24040 mark: IF printing THEN
24080 BEGIN synchronize(0,q_verticalpos);
24120 outtext(page_end_marker);
24160 synchronize(0,q_verticalpos);
24200 END ELSE screen[heightm1]:= page_end_marker;
24240 END ELSE
24280 nomark: IF NOT emptyscroll THEN
24320 BEGIN cover_length:= 0;
24360 call(p_one_more_line_please);
24400 END;
24440 !z_t(-9);
24480 GOTO detachloop;
24520 END;
24560 PROCEDURE addline;
24600 COMMENT User has pushed the INSERT LINE key;
24640 BEGIN
24680 push_line(screen[heightm1]);
24720 shift(q_verticalpos,q_verticalpos+1,heightm1-q_verticalpos);
24760 q_horizontalpos:= 0;
24800 END;
24840
24880 PROCEDURE addlines(number, printing, leftjustify, restorebelow);
24920 COMMENT Action of &L VIDED command, new lines are inserted
24960 and existing lines pushed downwards;
25000 INTEGER number; BOOLEAN printing, leftjustify, restorebelow;
25040 BEGIN INTEGER sink, vpos, hpos, emptysink, leftm, vpos_number;
25080 INTEGER i, addpos; TEXT firstpart, high_line, strip_model;
25120 INTEGER high_number, low_bord_number, add_increment;
25160 BOOLEAN badnumber;
25200 !z_t(10); vpos:= q_verticalpos; hpos:= q_horizontalpos;
25240 firstpart:- screen(vpos).sub(1,hpos);
25280 IF increment > 0 THEN
25320 BEGIN
25360 leftm:= leftmargin-8;
25400 IF vpos > 0 THEN high_line:- screen[vpos-1]
25440 ELSE IF top_fill >= 0
25480 THEN high_line:- top_of_page[top_fill];
25520 low_bord_number:= vdlno(high_line);
25560 IF low_bord_number < 0 THEN low_bord_number:= last_line_number;
25600 high_number:= vdlno(screen[vpos]);
25640 IF high_number < 0 THEN BEGIN
25680 badnumber:= TRUE;
25720 high_number:= low_bord_number+(number+1)*increment;
25760 END;
25800 add_increment:=
25840 entier((high_number-low_bord_number)/(number+1));
25880 IF add_increment < 1 THEN add_increment:= 1;
25920 END ELSE leftm:= leftmargin;
25960 IF NOT line_erasable THEN
26000 BEGIN IF printing THEN save_lengthes;
26040 END;
26080 sink:= number; emptysink:= sink+vpos-height;
26120 IF emptysink < 0 THEN emptysink:= 0;
26160 sink:= sink-emptysink;
26200 FOR i:= 1 STEP 1 UNTIL sink DO
26240 push_line(screen(height-i));
26280 FOR i:= 1 STEP 1 UNTIL emptysink DO
26320 BEGIN
26360 IF increment > 0 THEN
26400 BEGIN
26440 high_number:= high_number-add_increment;
26480 IF high_number < 1 THEN BEGIN
26520 high_number:= 1; badnumber:= TRUE;
26560 END;
26600 line_model.sub(1,5):= make_five_digits(high_number);
26640 END;
26680 push_line(line_model);
26720 END;
26760 line_model.sub(1,5):= NOTEXT;
26800 shift(vpos,vpos+sink,height-vpos-sink);
26840 IF increment > 0 THEN
26880 BEGIN
26920 FOR i:= 1 STEP 1 UNTIL sink DO
26960 BEGIN
27000 high_number:= high_number-add_increment;
27040 IF high_number < 1 THEN BEGIN
27080 high_number:= 1; badnumber:= TRUE;
27120 END;
27160 screen(vpos+sink-i).sub(1,5):=
27200 make_five_digits(high_number);
27240 END;
27280 END;
27320 screen(vpos).sub(1,firstpart.length):= firstpart;
27360 IF increment <= 0 THEN firstpart:= NOTEXT ELSE
27400 BEGIN
27440 vpos_number:= high_number-1;
27480 IF vpos_number < 1 THEN vpos_number:= 1;
27520 IF firstpart =/= NOTEXT THEN
27560 BEGIN
27600 screen(vpos).sub(1,5):= make_five_digits(vpos_number);
27640 END;
27680 high_number:= vdlno(firstpart);
27720 IF high_number < 0 THEN high_number:= largest_line_number;
27760 firstpart:= NOTEXT;
27800 IF firstpart.length >= 5 THEN firstpart.sub(1,5):=
27840 make_five_digits(high_number+1);
27880 END;
27920 IF leftjustify AND firstpart =/= NOTEXT THEN
27960 BEGIN firstpart:- firstpart.main;
28000 IF increment > 0 THEN
28040 firstpart:- from(firstpart,9);
28080 line_model:= frontstrip(firstpart);
28120 strip_model:- line_model.strip;
28160 IF strip_model.length <= firstpart.length - leftm THEN
28200 BEGIN
28240 firstpart.sub(1,leftm):= NOTEXT;
28280 from(firstpart,leftm+1):= strip_model;
28320 END;
28360 line_model:= NOTEXT;
28400 END;
28440 IF increment NE 0 THEN BEGIN ! update above line numbers?;
28480 i:= vpos-1;
28520 WHILE vpos_number <= low_bord_number DO BEGIN
28560 IF high_line == NOTEXT THEN GOTO stopnumber;
28600 vpos_number:= vpos_number-1;
28640 IF vpos_number < 1 THEN GOTO stopnumber;
28680 firstpart:- make_five_digits(vpos_number);
28720 IF i >= 0 AND printing THEN BEGIN
28760 move_the_cursor_to(0,i);
28800 outtext(firstpart);
28840 END ELSE high_line.sub(1,5):= firstpart;
28880 i:= i-1; ! backup one line more;
28920 IF top_fill+i < -1 THEN BEGIN
28960 high_line:- NOTEXT; low_bord_number:= last_line_number;
29000 END ELSE BEGIN
29040 high_line:- IF i >= 0 THEN screen[i] ELSE
29080 top_of_page[top_fill+i+1];
29120 low_bord_number:= vdlno(high_line);
29160 END;
29200 IF low_bord_number < 0 THEN GOTO stopnumber;
29240 END;
29280 IF badnumber THEN stopnumber:
29320 warning("Line numbers may be out of sequence",NOTEXT);
29360 END of increment NE 0;
29400
29440 IF printing THEN
29480 BEGIN
29520 IF insertline =/= NOTEXT
29560 COMMENT Will insertline be faster?;
29600 AND ((sink*insertline.length < 52*(heightm1-vpos-sink))
29640 OR NOT restorebelow) THEN
29680 BEGIN
29720 IF vpos < heightm1 THEN
29760 BEGIN move_the_cursor_to(0,vpos);
29800 FOR i:= 1 STEP 1 UNTIL sink DO
29840 BEGIN outstring(terminalout,insertline);
29880 END;
29920 END;
29960 IF hpos > 0 THEN restore_lines(vpos,vpos);
30000 i:= number+vpos;
30040 IF increment NE 0 AND vpos < heightm1 THEN
30080 BEGIN IF i > heightm1 THEN i:= heightm1;
30120 restore_lines(vpos,i);
30160 END ELSE
30200 IF i <= heightm1 THEN restore_lines(i,i);
30240 END ELSE restore_lines(vpos,IF restorebelow THEN heightm1
30280 ELSE vpos);
30320 move_the_cursor_to(hpos,vpos);
30360 END;
30400 command_done:= TRUE; !z_t(-10);
30440 END;
30480 TEXT PROCEDURE to_continue;
30520 COMMENT restore the screen after user has pushed the
30560 carriage return key;
30600 INSPECT terminalin DO INSPECT terminalout DO
30640 BEGIN
30680 outimage;
30720 outtext("To continue push RETURN:"); breakoutimage;
30760 inimage; to_continue:- copy(terminalin.image.strip);
30800 restore_screen(q_verticalpos, 998);
30840 END;
30880 CLASS editin_inimage;
30920 BEGIN COMMENT input of one line from the input text file;
30960 INTEGER divpos, mindiv;
31000 detachloop: detach;
31040 IF lower_lines == NONE THEN
31080 BEGIN
31120 IF endpage OR editin.endfile THEN
31160 BEGIN COMMENT Input a fictitious blank line;
31200 editin.image:= NOTEXT;
31240 editin_image_strip:- NOTEXT;
31280 END ELSE
31320 BEGIN COMMENT there are more lines to be read;
31360 call(p_editin_true_inimage);
31400 editin_image_strip:- editin.image.strip;
31440 IF NOT endpage AND NOT editin.endfile THEN
31480 BEGIN COMMENT Was this last line of a page?;
31520 IF editin_image_strip =/= NOTEXT THEN
31560 BEGIN
31600 IF fetchar(editin_image_strip,
31640 editin_image_strip.length) = formfeed THEN
31680 BEGIN endpage:= TRUE; IF psearch THEN BEGIN
31720 IF (IF videdp THEN videdpcount ELSE top_fill +
31739 heightm1) + pbottom < warningheight THEN pfound:=
31769 TRUE;
31801 END;
31840 editin_image.setpos(editin_image_strip.length);
31880 editin_image.putchar(' ');
31920 editin_image_strip:- editin_image_strip.sub(1,
31960 editin_image_strip.length-1).strip;
32000 END of formfeed found;
32040 END of not empty line;
32080 END of was this last line;
32120 END of more lines to be read;
32160 END ELSE
32200 BEGIN editin.image:= pop_line;
32240 editin_image_strip:- editin.image.strip;
32280 END;
32320 IF editin_image_strip.length > width THEN
32360 BEGIN COMMENT split too long input lines into two lines;
32400 IF NOT long_line_warned THEN
32440 INSPECT terminalout DO
32480 BEGIN long_line_warned:= TRUE;
32520 breakoutimage;
32560 blankterminal;
32600 outtext("Input text contains lines longer than");
32640 outint(width,3); outtext(" characters."); outimage;
32680 outtext(
32720 "Such long lines will be split. No further warnings.");
32760 outimage;
32800 outtext(
32840 "Type CONTROL-C to keep the old file! Your text"
32880 " may be destroyed!"); outimage;
32920 to_continue;
32960 END;
33000 mindiv:= editin_image_strip.length-widthm1;
33040 FOR divpos:= widthm1 STEP -1 UNTIL mindiv DO
33080 BEGIN COMMENT split the line at a space character;
33120 IF fetchar(editin_image_strip,divpos) = ' '
33160 THEN GOTO blankfound;
33200 END;
33240 divpos:= width;
33280 blankfound:
33320 editin_image_strip.setpos(divpos);
33360 NEW lower_line(copy(rest(editin_image_strip)));
33400 rest(editin_image_strip):= NOTEXT;
33440 editin_image_strip:- front(editin_image_strip);
33480 END;
33520 IF increment > 0 THEN
33560 BEGIN COMMENT check line number of line numbered file;
33600 divpos:= vdlno(editin_image_strip); IF divpos >= 0 THEN
33640 BEGIN
33680 IF largest_line_number < divpos THEN
33720 largest_line_number:= divpos;
33760 END ELSE IF editin_image_strip == NOTEXT THEN
33800 BEGIN
33840 editin_image_strip:- editin.image.sub(1,5);
33880 largest_line_number:= largest_line_number+increment;
33920 editin_image_strip:= make_five_digits(
33960 largest_line_number);
34000 END;
34040 END;
34080 GOTO detachloop;
34120 END;
34160 PROCEDURE center_line(left); INTEGER left;
34200 BEGIN TEXT start, body, newline; INTEGER leftpos; CHARACTER c;
34240 IF left < 0 THEN left:= leftmargin;
34280 body:- screen[q_verticalpos]; body.setpos(1);
34320 IF body.getchar = '.' THEN
34360 BEGIN
34400 c:= body.getchar;
34440 WHILE digit(c) AND body.more DO c:= body.getchar;
34480 start:- front(body);
34520 body:- rest(body);
34560 END;
34600 body:- frontstrip(body).strip;
34640 leftpos:=
34680 (left+(rightmargin-left-body.length)//2+1);
34720 IF leftpos + body.length < width AND
34760 leftpos > start.length THEN
34800 BEGIN
34840 newline:- line_model; newline.sub(1,start.length):= start;
34880 newline.setpos(leftpos);
34920 puttext(newline,body);
34960 move_the_cursor_to(0,q_verticalpos);
35000 outstring(terminalout,newline);
35040 outchr(terminalout,carriagereturn,1);
35080 move_the_cursor_to(0,q_verticalpos);
35120 line_model:- screen[q_verticalpos];
35160 line_model:= NOTEXT;
35200 screen[q_verticalpos]:- newline;
35240 command_done:= TRUE;
35280 END;
35320 END;
35360 PROCEDURE case_shift(char); CHARACTER char;
35400 BEGIN
35440 TEXT body; INTEGER hpos;
35480 hpos:= q_horizontalpos;
35520 body:- from(screen[q_verticalpos],q_horizontalpos+1).strip;
35560 IF char = 'U' OR char = 'u' THEN storbokstav(body)
35600 ELSE litenbokstav(body);
35640 outstring(terminalout,body);
35680 q_horizontalpos:= q_horizontalpos+body.length;
35720 move_the_cursor_to(hpos,q_verticalpos);
35760 command_done:= TRUE;
35800 END;
35840 PROCEDURE charinsert; ! User has pushed insert char key;
35880 BEGIN TEXT thisline; INTEGER length;
35920 screen[q_verticalpos].setpos(q_horizontalpos+1);
35960 tshift(screen[q_verticalpos],-1);
36000 END;
36040
36080 PROCEDURE insert(qname,inserted); TEXT qname; BOOLEAN inserted;
36120 BEGIN COMMENT &I command of VIDED;
36160 INTEGER striplength, hpos, vpos, mindiv, divpos;
36200 TEXT lastpart, stripline, longline;
36240 hpos:= q_horizontalpos; vpos:= q_verticalpos;
36280 stripline:- screen(vpos).strip;
36320 striplength:= stripline.length;
36360 IF striplength + qname.length < width THEN
36400 BEGIN COMMENT New line not longer than screen width;
36440 IF striplength > hpos THEN lastpart:- copy(screen(vpos).
36480 sub(hpos+1,striplength-hpos));
36520 outtext(qname);
36560 IF inserted THEN q_display_output:= FALSE;
36600 outtext(lastpart);
36640 IF inserted THEN BEGIN
36680 q_display_output:= TRUE; q_horizontalpos:= hpos+qname.length;
36720 END ELSE move_the_cursor_to(hpos+qname.length,vpos);
36760 END ELSE
36800 BEGIN COMMENT New line has to be split into two lines on
36840 the screen, since it is longer than the screen width;
36880 longline:- conc(stripline.sub(1,hpos),qname,
36920 stripline.sub(hpos+1,striplength-hpos));
36960 mindiv:= longline.length-width;
37000 FOR divpos:= widthm1 STEP -1 UNTIL mindiv DO
37040 BEGIN IF fetchar(longline,divpos) = ' '
37080 THEN GOTO blankfound;
37120 END;
37160 divpos:= width;
37200 blankfound: move_the_cursor_to(0,vpos);
37240 outtext(longline.sub(1,divpos));
37280 make_blank(width-divpos);
37320 IF vpos = heightm1 THEN
37360 BEGIN
37400 move_the_cursor_to(0,vpos);
37440 outchr(terminalout,linefeed,1);
37480 call(p_scroll);
37520 vpos:= vpos-1;
37560 move_the_cursor_to(first_text_pos,heightm1);
37600 END ELSE move_the_cursor_to(first_text_pos,vpos+1);
37640 addlines(1,TRUE,FALSE,TRUE);
37680 outtext(longline.sub(divpos+1,longline.length-divpos));
37720 hpos:= hpos+qname.length;
37760 IF hpos < divpos THEN
37800 move_the_cursor_to(hpos,vpos) ELSE
37840 move_the_cursor_to(hpos-divpos,vpos+1);
37880 END;
37920 command_done:= TRUE;
37960 END of insert;
38000 INTEGER PROCEDURE written_lines;
38040 COMMENT VIDED strips blank lines from the bottom of the page
38080 when outputting a page to the output text file. This procedure
38120 finds how many non-blank lines there are to output;
38160 BEGIN TEXT check_line; INTEGER i, print_height;
38200 IF lower_lines == NONE AND (endpage OR editin.endfile) THEN
38240 BEGIN
38280 FOR print_height:= heightm1 STEP -1 UNTIL 0 DO
38320 BEGIN
38360 check_line:- screen(print_height);
38400 IF increment > 0 THEN check_line:- from(check_line,6);
38440 IF check_line.strip =/= NOTEXT THEN GOTO out;
38480 END;
38520 print_height:= -1;
38560 out:
38600 END ELSE print_height:= heightm1;
38640 written_lines:= print_height;
38680 END;
38720 PROCEDURE printpage;
38760 BEGIN COMMENT Output a page to the output text file;
38800 INTEGER i, print_height, breakchar;
38840 empty_top_of_page;
38880 print_height:= written_lines;
38920 IF NOT nooutput THEN
38960 FOR i:= 0 STEP 1 UNTIL print_height DO
39000 BEGIN
39040 output_line:- screen[i]; call(p_true_write);
39080 END;
39120 COMMENT Output lines which have been pushed below the screen;
39160 WHILE NOT lower_lines == NONE DO
39200 BEGIN output_line:- pop_line;
39240 IF NOT nooutput THEN call(p_true_write);
39280 END;
39320
39360 COMMENT Output lines which have not yet been read from the
39400 input text file;
39440 IF NOT endpage AND NOT editin.endfile THEN BEGIN
39480 IF numbered_infile EQV increment = 0 THEN BEGIN
39520 GOTO get_a_line;
39560 WHILE NOT endpage AND NOT editin.endfile DO BEGIN
39600 output_line:- editin_image_strip;
39640 IF NOT nooutput THEN call(p_true_write);
39680 get_a_line:
39720 call(p_editin_inimage);
39760 END;
39800 END ELSE BEGIN ! no line number conversion;
39840 pgcopy(editin,IF nooutput THEN NONE ELSE editout,
39880 numbered_infile); last_line_number:= -1;
39920 inhibit_ff:= endpage:= NOT editin.endfile;
39960 END;
40000 END of output of not yet read input file lines;
40040 END of procedure printpage;
40080 COMMENT Main body of the CLASS VIDED1: initialization
40120 of certain variables;
40160 allow_cr:= TRUE;
40200 sixdigits:- blanks(10).sub(5,6);
40240 p_one_more_line_please:- NEW one_more_line_please;
40280 p_editin_true_inimage:- NEW editin_true_inimage;
40320 p_true_write:- NEW true_write;
40360 p_write:- NEW write;
40400 p_editin_inimage:- NEW editin_inimage;
40440 p_scroll:- NEW scroll;
40480 page_end_marker:- copy(
40520 "***??? END OF PAGE *** USE &PI COMMAND ***???");
40560 IF page_end_marker.length > widthm1 THEN page_end_marker:-
40600 page_end_marker.sub(1,widthm1);
40640 END of vided1x;
40680 END of vided1;