Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/comp/mided2.lst
There are no other files named mided2.lst in the archive.
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 1
DSK:MIDED2.SIM 18-MAR- 1979 4:17
00030 OPTIONS(/l/e); COMMENT DISPLAY EDITOR. SEE
SIM013 W LINE 30 EXTERNAL SWITCH ALREADY SPECIFIED, IGNORED
00060 VISTA.MAN for explanations on the routines used in this program;
00090 COMMENT Copyright (c) Swedish National Defense Research Institute;
00120 COMMENT%IF callmac;
00150 EXTERNAL PROCEDURE vtmcur, vtsynk, vtisng;
00180 COMMENT%IFEND CALLMAC;
00210 EXTERNAL PROCEDURE outche, tshift, pgcopy;
00240 EXTERNAL INTEGER PROCEDURE iondx, vdlno;
00270 EXTERNAL TEXT PROCEDURE conc, front, litenbokstav, storbokstav,
00300 rest, inline, frontstrip, scanto, from, upto, today, filspc,
00330 compress, skip, maketext;
00360 EXTERNAL CHARACTER PROCEDURE findtrigger, fetchar;
00390 EXTERNAL INTEGER PROCEDURE search, scanint;
00420 EXTERNAL INTEGER PROCEDURE sscan;
00450 EXTERNAL REF (infile) PROCEDURE findinfile;
00480 EXTERNAL REF (outfile) PROCEDURE findoutfile;
00510 EXTERNAL CHARACTER PROCEDURE getch;
00540 EXTERNAL INTEGER PROCEDURE trmop, gettab, checkint;
00570 EXTERNAL BOOLEAN PROCEDURE puttext, numbered, dotypeout, bokstav;
00600 EXTERNAL PROCEDURE depchar, outstring, forceout, echo, abort, exit;
00630 EXTERNAL PROCEDURE outchr, run, vdccin, vdccout;
00660 EXTERNAL BOOLEAN PROCEDURE meny;
00690 EXTERNAL CLASS termty;
00720 COMMENT%IF CALLMAC;
00750 EXTERNAL CLASS mmista, mided1;
00780 mided1 CLASS mided2;
SIM052 W LINE 780 ILLEGAL SWITCH SETTING
00810 COMMENT%IFNOT CALLMAC
00840 EXTERNAL CLASS mvista, vided1;
00870 COMMENT%IFNOT CALLMAC
00900 vided1 CLASS vided2;
00930 COMMENT%IFEND CALLMAC;
B1 00960 BEGIN
00990 vided1x CLASS vided2x;
01020 VIRTUAL: PROCEDURE stop_editing;
B2 01050 BEGIN
01080 TEXT defaultheader;
01110 INTEGER startpage; ! used when backuping for restart;
01140 CHARACTER comstartchar; ! starts VIDED command sequence;
1141
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 2
DSK:MIDED2.SIM 18-MAR- 1979 4:17
01170 PROCEDURE adjust_date(line); TEXT line;
01200 COMMENT The first line of the first page of a text file contains a
01230 date of last revision, which is updated with each edit on the file;
B3 01260 BEGIN
01290 INTEGER datepos, pos, filpos;
01320 INTEGER after_first_date;
01350 TEXT todaytext;
01380 datepos:= rightmargin-33; IF datepos < 1 THEN datepos:= 1;
01410 IF arg[3] = "NUL:NUL" THEN ! No input file, wholly new file;
B4 01440 BEGIN
01470 line.setpos(datepos); filpos:= datepos-12;
01500 puttext(line,today);
E4 01530 END ELSE
B5 01560 BEGIN ! Find existing creation and revision dates on top line;
01590 pos:= 5;
01620 loop: line.setpos(pos); scanto(line,'-'); pos:= line.pos;
01650 IF pos + 7 > line.length THEN
B6 01680 BEGIN IF after_first_date = 0 THEN GOTO out;
01710 datepos:= line.strip.length;
01740 IF datepos + 23 > line.length THEN GOTO out;
01770 line.setpos(datepos+3); puttext(line,copy(IF swedish
01800 THEN "Reviderad: " ELSE "Revised: "));
01830 puttext(line,todaytext);
01860 GOTO out;
E6 01890 END;
01920 line.setpos(pos-5);
01950 IF NOT digit(line.getchar) THEN GOTO loop;
01980 IF NOT digit(line.getchar) THEN GOTO loop;
02010 IF NOT digit(line.getchar) THEN GOTO loop;
02040 IF NOT digit(line.getchar) THEN GOTO loop;
02070 line.getchar;
02100 IF NOT digit(line.getchar) THEN GOTO loop;
02130 IF NOT digit(line.getchar) THEN GOTO loop;
02160 IF line.getchar NE '-' THEN GOTO loop;
02190 IF NOT digit(line.getchar) THEN GOTO loop;
02220 IF NOT digit(line.getchar) THEN GOTO loop;
02250 IF after_first_date = 0 THEN
B7 02280 BEGIN
02310 todaytext:- today; filpos:= line.pos - 22;
02340 IF(line.sub(line.pos-10,10) = todaytext) THEN GOTO out;
02370 after_first_date:= pos:= line.pos;
02400 GOTO loop;
E7 02430 END;
02460 line.setpos(line.pos-10); puttext(line,todaytext);
E5 02490 END;
02520 out:
02550 COMMENT set file name in front of date;
02580 IF filpos > 1 THEN line.sub(filpos,12):= filspc(IF
02610 tmpoutfile THEN editin ELSE editout, 8R001100 000001);
E3 02640 END;
2641
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 3
DSK:MIDED2.SIM 18-MAR- 1979 4:17
02670 PROCEDURE initialload;
B8 02700 BEGIN COMMENT input the first lines of a new page from the text
02730 file being edited;
02760 INTEGER i;
02790 !z_t(11); IF endpage AND NOT nooutput THEN addff:=TRUE;
02820 IF addff AND out_pagenumber = 1 THEN out_pagenumber:= 2;
02850 endpage:= FALSE;
02880 FOR i:= 0 STEP 1 UNTIL heightm1 DO
B9 02910 BEGIN
02940 call(p_editin_inimage);
02970 screen(i):= editin_image_strip;
E9 03000 END;
03009 IF increment NE 0 AND last_line_number < 0 THEN
03012 last_line_number:= vdlno(screen[0]) - 1;
03030 IF pageheader THEN
B10 03060 BEGIN IF NOT nooutput THEN check_page_number(TRUE) ELSE
B11 03090 BEGIN
03120 IF out_pagenumber > 1 AND top_fill <= 0 THEN
03150 check_page_number(TRUE);
E11 03180 END;
E10 03210 END;
03240 sub_page_number:= 1;
03270 home_the_cursor; !z_t(-11);
E8 03300 END;
3301
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 4
DSK:MIDED2.SIM 18-MAR- 1979 4:17
03330 PROCEDURE check_page_number(fullcheck); BOOLEAN fullcheck;
B12 03360 BEGIN COMMENT When editing a text file (with /p setting), each new
03390 page is given a header with a page number. If a header with a page
03420 number exists, no new header is created;
03450 TEXT top_line, newnum; BOOLEAN bad_header;
03480 INTEGER numstart, found_number, pagewordlength;
03510 pagewordlength:= 4;
03540 IF upto(screen[0],defaultheader.length) =
03570 defaultheader THEN GOTO addheader;
03600 IF upto(screen[0],46) = page_end_marker THEN GOTO addheader;
03630 find_page: ! Find digits preceded by "PAGE" or "SID" ("SID" =
03660 "PAGE" in Swedish);
03690 line_model:= screen(0);
03720 top_line:- storbokstav(line_model); top_line.setpos(1);
03750 numstart:= search(top_line,page_word)+1;
03780 IF numstart > top_line.length THEN
B13 03810 BEGIN ! "PAGE" not found, look for "SID";
03840 top_line.setpos(1);
03870 numstart:= search(top_line,sid_word);
03900 pagewordlength:= sid_word.length;
E13 03930 END;
03960 IF numstart > top_line.length THEN GOTO addheader;
03990 COMMENT "PAGE" or "SID" has been found;
04020 numstart:= numstart+pagewordlength;
04050 top_line:- screen[0]; top_line.setpos(numstart);
04080 WHILE top_line.more DO
B14 04110 BEGIN IF NOT digit(top_line.getchar) THEN GOTO out;
E14 04140 END;
04170 out:
04200 found_number:= scanint(
04230 top_line.sub(numstart,top_line.pos-numstart));
04260 IF found_number NE out_pagenumber THEN
B15 04290 BEGIN COMMENT change the page number on the top line;
04320 newnum:- blanks(9); newnum.putint(out_pagenumber);
04350 newnum:- frontstrip(newnum);
04380 COMMENT very clumsy code in the next statement. Can be done in a
04410 more efficient manner;
04440 screen[0]:= conc(top_line.sub(1,numstart-1),
04470 newnum,from(top_line,top_line.pos-1)," ").sub(1,width);
E15 04500 END;
04530 IF FALSE THEN addheader:
B16 04560 BEGIN COMMENT No header with page number found;
04590 IF NOT fullcheck OR out_pagenumber = 1 THEN GOTO exit;
04620 IF bad_header THEN
B17 04650 BEGIN
04680 top_line:- screen[0];
04710 IF increment > 0 THEN top_line:- from(top_line,9);
04740 top_line:= defaultheader;
E17 04770 END ELSE
B18 04800 BEGIN COMMENT add lines for header;
04830 home_the_cursor; addlines(
04860 IF sub_header == NOTEXT THEN 2 ELSE 3,FALSE,FALSE,TRUE);
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 4-1
DSK:MIDED2.SIM 18-MAR- 1979 4:17
04890 IF backuping AND pagenumber = startpage+1 THEN
04920 badscreen:= TRUE;
04950 top_line:- screen[0];
04980 IF increment > 0 THEN top_line:- from(top_line,9);
05010 top_line:= header;
05040 IF sub_header =/= NOTEXT THEN
B19 05070 BEGIN COMMENT Add subheader;
05100 top_line:- screen[1];
05130 IF increment > 0 THEN top_line:- from(top_line,9);
05160 top_line:= sub_header;
E19 05190 END;
05220 bad_header:= TRUE;
E18 05250 END;
05280 GOTO find_page;
E16 05310 END;
05340 exit: line_model:= NOTEXT;
E12 05370 END;
5371
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 5
DSK:MIDED2.SIM 18-MAR- 1979 4:17
05400 PROCEDURE append_page;
05430 COMMENT Convert two pages into one page by appending the next page
05460 at the end of the current page, &A VIDED command;
B20 05490 BEGIN INTEGER i, startfill;
05520 startfill:= written_lines+1;
05550 move_the_cursor_to(0,heightm1); OPTIONS(/-W);
05580 FOR startfill:= startfill STEP -1 UNTIL height-4 DO
B21 05610 BEGIN
05640 outchr(terminalout,linefeed,1);
05670 call(p_scroll);
E21 05700 END;
05730 endpage:= FALSE;
05760 FOR i:= startfill STEP 1 UNTIL startfill+2 DO
B22 05790 BEGIN move_the_cursor_to(0,i);
05820 call(p_editin_inimage); outtext(editin_image_strip);
E22 05850 END; OPTIONS(/W);
05880 IF pageheader AND NOT endpage THEN
B23 05910 BEGIN COMMENT Check if this page has a proper header;
05940 line_model:= screen(startfill); storbokstav(line_model);
05970 line_model.setpos(1);
06000 IF search(line_model,page_word) <
06030 line_model.length THEN GOTO hasheader;
06060 line_model.setpos(1);
06090 IF search(line_model,sid_word) >=
06120 line_model.length THEN GOTO afterheader;
06150 hasheader:
06180 i:= IF screen(startfill+1).strip.length <= first_text_pos
06210 THEN 1 ELSE
06240 IF screen(startfill+2).strip.length <= first_text_pos
06270 THEN 2 ELSE 0;
06300 IF i > 0 THEN
B24 06330 BEGIN move_the_cursor_to(0,startfill);
06360 header:= IF increment NE 0 THEN from(screen[startfill],9)
06390 ELSE screen[startfill];
06420 IF i = 2 THEN sub_header:- copy(IF increment = 0 THEN
06450 screen[startfill+1] ELSE from(screen[startfill+1],9));
06480 IF startfill + top_fill >= 1 THEN
B25 06510 BEGIN endpage:= TRUE;
06540 removelines(i); startfill:= startfill-i;
06570 endpage:= FALSE;
E25 06600 END;
E24 06630 END;
06660 afterheader: line_model:= NOTEXT;
E23 06690 END;
06720 startfill:= startfill+3;
06750 FOR i:= startfill STEP 1 UNTIL heightm1 DO
B26 06780 BEGIN move_the_cursor_to(0,i);
06810 call(p_editin_inimage);
06840 outtext(editin_image_strip);
E26 06870 END;
06900 home_the_cursor;
06930 pagenumber:= pagenumber+1; command_done:= TRUE;
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 5-1
DSK:MIDED2.SIM 18-MAR- 1979 4:17
E20 06960 END;
6961
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 6
DSK:MIDED2.SIM 18-MAR- 1979 4:17
06990 PROCEDURE removeline; ! User has pushed Delete Line key;
B27 07020 BEGIN INTEGER i; TEXT t;
07050 t:- screen[q_verticalpos]; t:= NOTEXT;
07080 FOR i:= q_verticalpos+1 STEP 1 UNTIL heightm1 DO
07110 screen[i-1]:- screen[i];
07140 screen[heightm1]:- t;
07170 q_horizontalpos:= 0;
E27 07200 END;
07230
07260 PROCEDURE removelines(number); INTEGER number;
07290 COMMENT &K VIDED command removes lines from the screen;
B28 07320 BEGIN
07350 INTEGER i, vpos, hpos, startline;
07380 !z_t(12); startline:= vpos:= q_verticalpos;
07410 hpos:= q_horizontalpos;
07440 IF NOT line_erasable THEN save_lengthes;
07470 IF hpos > 0 THEN
B29 07500 BEGIN COMMENT Blank the rest of the line at which the &K command
07530 was given;
07560 make_blank(width-hpos);
07590 COMMENT One (partial) line has been removed (blanked);
07620 number:= number-1; startline:= startline+1;
07650 IF number > 0 AND startline > heightm1 THEN
B30 07680 BEGIN call(p_scroll);
07710 startline:= startline-1;
07740 vpos:= vpos-1;
E30 07770 END;
E29 07800 END;
07830 IF number > 0 THEN
B31 07860 BEGIN
07890 IF number <= heightm1 - startline THEN
B32 07920 BEGIN COMMENT All lines to be removed are inside the screen;
07950 shift(startline+number,startline,height-startline-number);
07980 IF deleteline =/= NOTEXT
08010 COMMENT Only if deleteline is faster at terminal;
08040 AND number*deleteline.length < 52*(height-number-vpos) THEN
B33 08070 BEGIN move_the_cursor_to(0,startline);
08100 FOR i:= 1 STEP 1 UNTIL number DO
B34 08130 BEGIN outstring(terminalout,deleteline);
E34 08160 END;
E33 08190 END ELSE restore_lines(startline,heightm1-number);
08220 startline:= height-number;
E32 08250 END ELSE
B35 08280 BEGIN COMMENT Some lines below the screen are to be removed;
08310 move_the_cursor_to(0,startline);
08340 FOR i:= number - height + startline
08370 STEP -1 UNTIL 1 DO
B36 08400 BEGIN move_the_cursor_to(0,startline);
08430 cover_length:= 0;
08460 call(p_one_more_line_please);
E36 08490 END;
08520 IF NOT line_erasable THEN screen_length(startline):=
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 6-1
DSK:MIDED2.SIM 18-MAR- 1979 4:17
08550 screen(startline).strip.length;
E35 08580 END;
08610 FOR i:= startline STEP 1 UNTIL heightm1 DO
B37 08640 BEGIN COMMENT Input lines to fill empty space;
08670 move_the_cursor_to(0,i);
08700 screen(i):= NOTEXT;
08730 IF NOT line_erasable THEN cover_length:= screen_length(i);
08760 call(p_one_more_line_please);
E37 08790 END;
E31 08820 END;
08850 synchronize(hpos,vpos); command_done:= TRUE; !z_t(-12);
E28 08880 END;
8881
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 7
DSK:MIDED2.SIM 18-MAR- 1979 4:17
08910 PROCEDURE numberlines(number);
08940 INTEGER number;
08970 IF increment >= 0 THEN
B38 09000 BEGIN COMMENT renumber "number" lines beginning at current;
09030 INTEGER first, last, steg, vpos;
09060 vpos:= q_verticalpos;
09090 move_the_cursor_to(0,vpos);
09120 first:= vdlno(screen[vpos]); IF first <= 0 THEN GOTO out;
09150 IF number <= 1 OR vpos + number > height
09180 THEN number:= height-vpos;
09210 IF number <= 2 THEN GOTO out;
09240 last:= vdlno(screen[vpos+number-1]); IF last < 0 THEN GOTO out;
09270 steg:= (last-first)//(number-1);
09300 IF steg < 1 THEN steg:= 1;
09330 last:= vpos+number-2;
09360 WHILE q_verticalpos < last DO
B39 09390 BEGIN move_the_cursor_to(0,q_verticalpos+1);
09420 first:= first+steg;
09450 outtext(make_five_digits(first));
E39 09480 END;
09510 out: move_the_cursor_to(0,vpos); command_done:= TRUE;
E38 09540 END;
9541
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 8
DSK:MIDED2.SIM 18-MAR- 1979 4:17
09570 PROCEDURE z_scroll(steps); INTEGER steps;
09600 COMMENT &Z VIDED command, scrolls screen and inputs lines;
B40 09630 BEGIN INTEGER i, hpos, vpos; TEXT exchanger;
09660 hpos:= q_horizontalpos; vpos:= q_verticalpos-steps;
09690 IF vpos < 0 OR vpos > heightm1 THEN
B41 09720 BEGIN hpos:= vpos:= 0;
E41 09750 END;
B42 09780 IF steps > 0 THEN BEGIN
09810 printing:= terminaltype NE tandberg;
09840 move_the_cursor_to(0,heightm1);
09870 FOR i:= 1 STEP 1 UNTIL steps DO
B43 09900 BEGIN outchr(terminalout,linefeed,1);
09930 call(p_scroll);
E43 09960 END;
B44 E42 09990 END ELSE IF steps < 0 THEN BEGIN
10020 printing:= insertline =/= NOTEXT;
B45 10050 FOR i:= -1 STEP -1 UNTIL steps DO BEGIN
10080 IF top_fill < 0 THEN GOTO scrolled;
10110 IF printing THEN home_the_cursor;
10140 push_line(screen[heightm1]);
10170 shift(0,1,heightm1);
10200 exchanger:- top_of_page(top_fill);
10230 top_of_page(top_fill):- screen(0);
10260 screen(0):- exchanger; top_fill:= top_fill-1;
B46 10290 IF printing THEN BEGIN
10320 outstring(terminalout,insertline);
10350 outstring(terminalout,screen(0).strip);
E46 10380 END;
E45 10410 END of loop;
E44 10440 END of steps < 0;
10470
B47 10500 IF FALSE THEN scrolled: BEGIN
10530 warning("Could not scroll that many lines. "
10560 "Use &-PT, &-0PT or &L.",NOTEXT);
10590 hpos:= vpos:= 0;
E47 10620 END;
10650
B48 10680 IF NOT printing THEN BEGIN
10710 q_horizontalpos:= hpos; q_verticalpos:= vpos;
10740 printing:= TRUE; restore_screen(vpos,showdefault);
E48 10770 END ELSE synchronize(hpos,vpos);
10800 command_done:= TRUE;
E40 10830 END;
10831
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 9
DSK:MIDED2.SIM 18-MAR- 1979 4:17
10860 PROCEDURE removechar;
B49 10890 BEGIN ! User has pushed remove char key;
10920 screen[q_verticalpos].setpos(q_horizontalpos+1);
10950 tshift(screen[q_verticalpos],1);
E49 10980 END;
11010
11040 PROCEDURE removechars(number); INTEGER number;
B50 11070 BEGIN COMMENT &D VIDED command, removes chars from line;
11100 INTEGER hpos, vpos, coverlength, i;
11130 TEXT thisline, thisstripped;
11160 IF number = 0 THEN number:= 1;
11190 hpos:= q_horizontalpos; vpos:= q_verticalpos;
11220 IF number > width-hpos THEN number:= width-hpos;
11250 thisline:- screen(q_verticalpos);
11280 IF deletechar =/= NOTEXT ! terminal has delete char function;
11310 COMMENT only if faster;
11340 AND deletechar.length*number < 52-hpos THEN
B51 11370 BEGIN
11400 thisline.setpos(hpos+1); tshift(thisline,number);
11430 FOR i:= 1 STEP 1 UNTIL number DO
B52 11460 BEGIN outstring(terminalout,deletechar);
E52 11490 END;
E51 11520 END ELSE
B53 11550 BEGIN ! No delchar on this terminal;
11580 thisstripped:- thisline.strip;
11610 coverlength:= thisstripped.length-hpos-number;
11640 IF coverlength > 0 THEN
11670 outtext(thisline.sub(hpos+1+number,coverlength));
11700 FOR i:= 1 STEP 1 UNTIL number DO
11730 outchar(' ');
11760 move_the_cursor_to(hpos,vpos);
E53 11790 END;
11820 command_done:= TRUE;
E50 11850 END;
11851
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 10
DSK:MIDED2.SIM 18-MAR- 1979 4:17
11880 PROCEDURE removeword;
B54 11910 BEGIN COMMENT &W VIDED command removes last written word;
11940 INTEGER vertpos, horpos, coverlength, wordpos, wordlength;
11970 TEXT thisline, thisstripped;
12000 vertpos:= q_verticalpos; horpos:= q_horizontalpos;
12030 loop:
12060 thisline:- screen(vertpos);
12090 thisstripped:- thisline.sub(1,horpos).strip;
12120 IF thisstripped.length = 0 AND vertpos > 0 THEN
B55 12150 BEGIN vertpos:= vertpos-1; horpos:= width;
12180 GOTO loop;
E55 12210 END;
12240 FOR wordpos:= thisstripped.length STEP -1 UNTIL 1 DO
12270 IF thisstripped.sub(wordpos,1) = " " THEN GOTO out;
12300 out: wordlength:= thisstripped.length-wordpos;
12330 move_the_cursor_to(wordpos,vertpos);
12360 make_blank(wordlength);
12390 move_the_cursor_to(wordpos,vertpos); command_done:= TRUE;
E54 12420 END;
12421
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 11
DSK:MIDED2.SIM 18-MAR- 1979 4:17
12450 PROCEDURE search_for(qname,commandchar,showlines);
12480 COMMENT &S and &N VIDED commands, searches for key in text file;
12510 TEXT qname; CHARACTER commandchar; INTEGER showlines;
B56 12540 BEGIN INTEGER hpos, vpos, scrolltimes, screentop;
12570
12600 ! PROCEDURE reorder_screen;
12630 ! IF screentop NE 0 THEN
12660 ! BEGIN INTEGER i;! TEXT array screen_copy[0:heightm1];
12690 ! FOR i:= 0 STEP 1 UNTIL heightm1 DO
12720 ! screen_copy[i]:- screen[i];
12750 ! FOR i:= 0 STEP 1 UNTIL heightm1 DO
12780 ! BEGIN screen[i]:- screen_copy[screentop];
12810 ! screentop:= screentop+1;
12840 ! IF screentop > heightm1 THEN screentop:= 0;
12870 ! END;
12900 ! screentop:= 0;
12930 ! END;
12960
12990 COMMENT the optimized algorithm below was written by Mats Wallin;
13020 PROCEDURE reorder_screen;
B57 13050 IF screentop NE 0 THEN BEGIN
13080 INTEGER i, j, k; TEXT t;
13110
13140 i:= height; j:= screentop; k:= mod(i,j);
B58 13170 WHILE k NE 0 DO BEGIN
13200 i:= j; j:= k; k:= mod(i,j);
E58 13230 END;
13260 ! nu inneh}ller j mgd av i o j;
B59 13290 FOR i:= j - 1 STEP -1 UNTIL 0 DO BEGIN
13320 j:= i + screentop; k:= i; t:- screen[i];
B60 13350 WHILE i NE j DO BEGIN
13380 screen[k]:- screen[j];
13410 k:= j; j:= j + screentop;
13440 IF j > heightm1 THEN j:= j - height;
E60 13470 END;
13500 screen[k]:- t;
E59 13530 END;
13560 screentop:= 0;
E57 13590 END;
13620
13650 !z_t(13); hpos:= q_horizontalpos+1; vpos:= q_verticalpos;
13680 storbokstav(qname); ! storbokstav key to find up-low-case
13710 equivalents;
13740 pfound:= FALSE;
13770 scan_screen:
13800 line_model:= screen(vpos); storbokstav(line_model);
13830 line_model.setpos(hpos+1);
13860 hpos:= search(line_model,qname); ! Search first line;
13890 IF hpos <= width THEN GOTO found;
13920 FOR vpos:= vpos+1 STEP 1 UNTIL heightm1 DO
B61 13950 BEGIN ! Search lines on the screen;
13980 line_model:= screen(vpos);
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 11-1
DSK:MIDED2.SIM 18-MAR- 1979 4:17
14010 storbokstav(line_model);
14040 line_model.setpos(1);
14070 hpos:= search(line_model,qname);
14100 IF hpos <= width THEN GOTO found;
E61 14130 END;
14160 IF commandchar = 'S' THEN GOTO out;
14190 COMMENT &S command stops, &N command searches after end of screen;
14220 IF q_display_output THEN
B62 14250 BEGIN COMMENT Silent search;
14280 cancel_display;
14310 terminalout.outtext("Searching for """);
14340 terminalout.outtext(qname); terminalout.outtext(""".");
14370 terminalout.outimage;
14400 IF psearch THEN
B63 14430 BEGIN terminalout.outtext("And for pages lacking");
14460 terminalout.outint(pbottom,3); terminalout.outtext(" lines.");
14490 terminalout.outimage;
E63 14520 END;
E62 14550 END;
14580 vpos:= heightm1; move_the_cursor_to(0,vpos);
14610 printing:= FALSE; screentop:= 0;
14640 WHILE NOT editin.endfile OR lower_lines =/= NONE DO
B64 14670 BEGIN
14700 IF pfound THEN
B65 14730 BEGIN hpos:= 1; GOTO found;
E65 14760 END;
14790 IF endpage AND lower_lines == NONE THEN
B66 14820 BEGIN reorder_screen;
14850 printpage; initialload; vpos:= 0; hpos:= 0;
14880 GOTO scan_screen;
E66 14910 END;
14940 ! the code below is faster than to call(p_scroll);
14970 first_scroll_line:- screen[screentop];
15000 call(p_write); screen[screentop]:- first_scroll_line;
15014 IF NOT pageheader THEN GOTO nomark;
B67 15022 IF NOT videdp THEN BEGIN
15032 IF top_fill + height + 1 = warningheight THEN GOTO mark ELSE
15038 GOTO nomark;
E67 15054 END;
15056 IF top_fill+height+1 < warningheight THEN GOTO nomark;
15058 IF videdpcount = warningheight THEN
15062 mark: first_scroll_line:= page_end_marker ELSE
B68 15090 BEGIN
15120 nomark: call(p_editin_inimage);
15150 first_scroll_line:= editin_image_strip;
E68 15180 END;
15210 screentop:= screentop+1; IF screentop > heightm1
15240 THEN screentop:= 0;
15270 line_model:= first_scroll_line; storbokstav(line_model);
15300 line_model.setpos(1);
15330 hpos:= search(line_model,qname); ! Search again;
15360 IF hpos <= width THEN GOTO found;
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 11-2
DSK:MIDED2.SIM 18-MAR- 1979 4:17
E64 15390 END;
15420 warning("Cannot find SEARCH text.",NOTEXT); reorder_screen;
15450 IF NOT q_display_output THEN
B69 15480 BEGIN resume_display; restore_screen(0,showlines*3);
E69 15510 END;
15540 home_the_cursor;
15570 IF FALSE THEN found:
B70 15600 BEGIN reorder_screen;
15630 IF NOT q_display_output THEN
B71 15660 BEGIN
15690 IF showlines > height THEN showlines:= height;
15720 IF NOT pfound THEN
15750 scrolltimes:= showlines//3 + vpos - heightm1;
15780 IF scrolltimes > 0 THEN
B72 15810 BEGIN move_the_cursor_to(0,heightm1);
15840 vpos:= vpos-scrolltimes;
15870 FOR scrolltimes:= scrolltimes STEP -1 UNTIL 1 DO
15900 call(p_scroll);
E72 15930 END;
15960 resume_display; restore_screen(vpos,showlines);
E71 15990 END;
16020 move_the_cursor_to(hpos-1,vpos);
E70 16050 END;
16080 out: printing:= TRUE; line_model:= NOTEXT;
16110 command_done:= TRUE; !z_t(-13);
E56 16140 END;
16141
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 12
DSK:MIDED2.SIM 18-MAR- 1979 4:17
16170 PROCEDURE blank_front;
16200 COMMENT &U VIDED command blanks initial part of line;
B73 16230 BEGIN INTEGER hpos, vpos;
16260 hpos:= q_horizontalpos; vpos:= q_verticalpos;
16290 move_the_cursor_to(0,vpos);
16320 make_blank(hpos);
16350 move_the_cursor_to(0,vpos); command_done:= TRUE;
E73 16380 END;
16381
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 13
DSK:MIDED2.SIM 18-MAR- 1979 4:17
16410 PROCEDURE settab(position,modechar);
16440 CHARACTER modechar; INTEGER position;
16470 COMMENT &T VIDED commands;
B74 16500 BEGIN INTEGER i;
16530 IF modechar = 'S' OR modechar = 's' THEN ! &TS command;
16560 tab_position(position):= TRUE ELSE
16590 IF modechar = 'C' OR modechar = 'c' THEN ! &TC command;
16620 tab_position(position):= FALSE ELSE
B75 16650 BEGIN COMMENT &TZ or &TR VIDED commands;
16680 FOR i:= 1 STEP 1 UNTIL width DO tab_position(i):= FALSE;
16710 IF modechar = 'R' OR modechar = 'r' THEN
B76 16740 BEGIN
16770 tab_position(leftmargin):= TRUE;
16800 FOR i:= 8 STEP 8 UNTIL width DO tab_position(i):= TRUE;
E76 16830 END;
E75 16860 END; command_done:= TRUE;
E74 16890 END;
16891
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 14
DSK:MIDED2.SIM 18-MAR- 1979 4:17
16920 PROCEDURE margset(secondchar,margpos);
16950 COMMENT &M VIDED commands, setting margins;
16980 CHARACTER secondchar; INTEGER margpos;
B77 17010 BEGIN
17040 IF margpos >= widthm1 THEN margpos:= widthm1-1 ELSE
17070 IF margpos < 0 THEN margpos:= 0;
17100 IF secondchar = 'R' OR secondchar = 'r' THEN
17130 rightmargin:= margpos ELSE
17160 IF secondchar = 'L' OR secondchar = 'l' THEN
B78 17190 BEGIN
17220 IF margpos < first_text_pos THEN
B79 17250 BEGIN warning(
17280 "Left margin must be >= 8 for line numbered file.",NOTEXT);
17310 margpos:= 8;
E79 17340 END;
17370 leftmargin:= margpos;
E78 17400 END;
17430 better:
17460 IF rightmargin > widthm1 THEN rightmargin:= widthm1;
17490 margin_width:= rightmargin-leftmargin;
17520 IF margin_width <= 0 THEN
B80 17550 BEGIN warning("Illegal margin values.",NOTEXT);
17580 leftmargin:= IF widthm1 > 8 THEN 8 ELSE widthm1-1;
17610 rightmargin:= 68;
17640 GOTO better;
E80 17670 END; command_done:= TRUE;
E77 17700 END;
17701
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 15
DSK:MIDED2.SIM 18-MAR- 1979 4:17
17730 PROCEDURE justify(lines,evenmargin,compacting);
17760 INTEGER lines; BOOLEAN evenmargin, compacting;
B81 17790 BEGIN COMMENT &JU, &FI AND &FC VIDED commands;
17820 TEXT longline, printline; CHARACTER divchar;
17850 INTEGER last_line_in, printcount, vpos, divpos, line_number;
17880 INTEGER hpos, part_length, leftmark, divtry;
17910 CHARACTER dash; BOOLEAN justar;
17940
17970 INTEGER rest_of_blanks, blankno, spaces, odd;
18000 TEXT t;
18001
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 16
DSK:MIDED2.SIM 18-MAR- 1979 4:17
18030 PROCEDURE justin(curline,curcol);
18060 INTEGER curline, curcol;
18090 COMMENT This procedure takes words from screen, replaces
18120 several consecutive blanks with one blank and puts the
18150 result in the text variable longline;
18180 IF compacting THEN
B82 18210 BEGIN t:-screen[curline];
18240 t.setpos(curcol+1);
B83 18270 WHILE skip(t,' ') =/= NOTEXT DO BEGIN
18300 puttext(longline,scanto(t,' '));
18330 longline.setpos(longline.pos+1);
E83 18360 END;
18390 longline.setpos(longline.pos-1);
E82 18420 END ELSE puttext(longline,frontstrip(screen[curline]
18450 .sub(curcol+1,screen_length[curline]-curcol)));
18480
18510 PROCEDURE justout;
18540 COMMENT This procedure outputs words on the screen and
18570 fills with enough blanks between the words to get a
18600 smooth right margin;
B84 18630 BEGIN blankno:=0;
18660 t:-scanto(printline,' ');
B85 18690 WHILE printline.more DO BEGIN
18720 blankno:=blankno+1;
18750 t:-scanto(printline,' ');
E85 18780 END;
18810 printline.setpos(1);
18840 rest_of_blanks:=rightmargin-
18870 q_horizontalpos-printline.length+blankno;
18900 t:-scanto(printline,' ');
18930 outtext(t);
18960 odd:=mod(printcount,2);
B86 18990 FOR blankno:=blankno STEP -1 UNTIL 1 DO BEGIN
19020 spaces:=(rest_of_blanks-odd)//blankno+odd;
19050 outtext(line_model.sub(1,spaces));
19080 t:-scanto(printline,' ');
19110 outtext(t);
19140 rest_of_blanks:=rest_of_blanks-spaces;
E86 19170 END;
E84 19200 END;
19201
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 17
DSK:MIDED2.SIM 18-MAR- 1979 4:17
19230 PROCEDURE putline;
B87 19260 BEGIN COMMENT output one line of justified text;
19290 !z_t(14); printcount:= printcount+1;
19320 IF printcount <= lines THEN
B88 19350 BEGIN
19380 IF printcount = 1 THEN
B89 19410 BEGIN IF hpos < leftmargin THEN
19440 outtext(line_model.sub(1,leftmargin-hpos));
E89 19470 END ELSE
19500 outtext(line_model.sub(1,leftmargin-leftmark+1));
19530 IF printline =/= longline AND evenmargin THEN justout ELSE
19560 outtext(printline);
19590 make_blank(width-q_horizontalpos);
E88 19620 END ELSE
B90 19650 BEGIN
19680 addlines(1,TRUE,FALSE,FALSE);
19710 move_the_cursor_to(leftmargin,vpos);
19740 IF printline =/= longline AND evenmargin THEN justout ELSE
19770 outtext(printline);
E90 19800 END;
19830 IF vpos = heightm1 THEN
B91 19860 BEGIN move_the_cursor_to(0,heightm1);
19890 outchr(terminalout,linefeed,1);
19920 call(p_scroll);
19950 move_the_cursor_to(leftmark-1,heightm1);
E91 19980 END ELSE
B92 20010 BEGIN vpos:= vpos+1;
20040 move_the_cursor_to(first_text_pos,vpos);
E92 20070 END;
20100 part_length:= margin_width; !z_t(-14);
E87 20130 END of putline;
20131
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 18
DSK:MIDED2.SIM 18-MAR- 1979 4:17
20160 COMMENT Main part of the justify procedure
20190 (&JU &FC &FI VIDED commands);
20220 !z_t(15); vpos:= q_verticalpos; save_lengthes;
20250 leftmark:= first_text_pos+1;
20280 IF q_horizontalpos >= rightmargin OR q_horizontalpos < leftmark-1
20310 THEN move_the_cursor_to(leftmark-1,vpos);
20340 hpos:= q_horizontalpos;
20370 IF dot = fill THEN
B93 20400 BEGIN IF lines = 0 THEN lines:= 1;
E93 20430 END;
20460 IF lines = 0 THEN
B94 20490 BEGIN COMMENT user did not give any size of area to be justify,
20520 justify to next blank line or line beginning with a dot;
20550 IF vpos < heightm1 THEN
B95 20580 BEGIN IF screen_length[vpos] = 0 THEN
B96 20610 BEGIN vpos:= vpos+1; hpos:= 0; move_the_cursor_to(0,vpos);
E96 20640 END;
E95 20670 END;
20700 FOR last_line_in:= vpos STEP 1 UNTIL heightm1 DO
B97 20730 BEGIN
20760 IF last_line_in NE vpos THEN
B98 20790 BEGIN
20820 IF fetchar(screen[last_line_in],leftmark) = dot
20850 THEN GOTO last_found;
E98 20880 END;
20910 IF screen_length[last_line_in] <= leftmark-1 THEN GOTO
20940 last_found;
E97 20970 END;
21000 last_line_in:= height;
21030 last_found: last_line_in:= last_line_in-1;
E94 21060 END ELSE
B99 21090 BEGIN last_line_in:= vpos+lines-1;
21120 IF last_line_in > heightm1 THEN last_line_in:= heightm1;
E99 21150 END;
21180 lines:= last_line_in-vpos+1;
21210
21240 IF lines > 0 THEN
B100 21270 BEGIN
21300 COMMENT We now know how many lines to justify, create a long
21330 text in which to store the entire text to be justified;
21360 longline:- blanks(width*(lines)+1);
21390 COMMENT Put first line into this long buffer;
21420 IF screen_length(vpos) > hpos THEN
B101 21450 BEGIN justar:= TRUE; justin(vpos,hpos);
E101 21480 END;
21510 COMMENT scan through lines to be included in paragraph;
21540 FOR line_number:= vpos+1 STEP 1 UNTIL last_line_in DO
B102 21570 BEGIN dash:= 'N';
21600 IF fetchar(screen[line_number-1],
21630 screen_length[line_number-1]) = '-' AND
21660 bokstav(fetchar(screen[line_number-1],
21690 screen_length[line_number-1]-1)) THEN
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 18-1
DSK:MIDED2.SIM 18-MAR- 1979 4:17
B103 21720 BEGIN
21750 divtry:= IF screen_length[line_number-1] > 20 THEN
21780 20 ELSE screen_length[line_number-1];
21810 WHILE dash NE 'R' AND dash NE 'K' AND dash NE 'S' DO
B104 21840 BEGIN
21870 dash:= warning(screen[line_number-1].sub(screen_length
21900 [line_number-1]-divtry+1,divtry),
21930 "Action on dash: Remove, Keep, Split?").getchar;
21960 IF dash EQ ' ' THEN dash:= 'R';
E104 21990 END;
E103 22020 END;
22050 IF fetchar(screen[line_number],1) = '*' THEN
B105 22080 BEGIN COMMENT do not include page_end_marker in text;
22110 IF screen[line_number].strip = page_end_marker THEN
22140 GOTO loop;
E105 22170 END;
22200 COMMENT space between words on successive lines;
22230 IF justar THEN
B106 22260 BEGIN
22290 IF dash = 'R' THEN
22320 longline.setpos(longline.pos-1) ELSE
22350 IF dash NE 'K' AND
22380 (screen_length(line_number-1) < width OR
22410 fetchar(screen[line_number],1) = ' ') THEN
22440 longline.setpos(longline.pos+1);
E106 22470 END;
22500 divtry:= IF leftmark <= 1 THEN leftmark ELSE
22530 IF vdlno(screen[line_number]) >= 0 THEN leftmark ELSE 1;
22560 IF screen_length[line_number] >= divtry THEN
B107 22590 BEGIN justar:= TRUE;
22620 justin(line_number,divtry-1);
E107 22650 END ELSE justar:= FALSE;
22680 loop:
E102 22710 END;
22740 part_length:= rightmargin-hpos;
22770 IF part_length > margin_width THEN
22800 part_length:= margin_width;
22830 longline:- longline.sub(1,longline.pos);
22860
B108 22890 IF NOT compacting THEN BEGIN
22920 COMMENT warn the user if longline contains three or
22950 more succesive blanks - may be a table destroyed
22980 by mistake!;
23010 longline.setpos(1); IF search(longline,line_model.sub(1,3))
23040 < longline.length THEN
B109 23070 BEGIN divchar:= warning("Funny text. "
23100 "Answer Y if you want the &FI command to be done.",
23130 NOTEXT).getchar;
23160 IF divchar NE 'Y' AND divchar NE 'y' THEN GOTO endjustify;
23190 command_done:= FALSE;
E109 23220 END;
E108 23250 END;
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 18-2
DSK:MIDED2.SIM 18-MAR- 1979 4:17
23280 COMMENT split the combined text into suitable line segments to
23310 output on succesive lines;
23340 WHILE longline.length > part_length DO
B110 23370 BEGIN COMMENT find space to divide line at;
23400 FOR divtry:= part_length//2+1,1 DO
23430 FOR divpos:= part_length+1 STEP -1 UNTIL divtry DO
B111 23460 BEGIN
23490 divchar:= fetchar(longline,divpos);
23520 ! First try to divide at space. If this does not
23550 work, try to divide at non-letter nor digit;
23580 IF (IF divtry NE 1 THEN divchar = ' ' OR divchar = '-'
23610 ELSE NOT bokstav(divchar) AND NOT digit(divchar))
23640 THEN
B112 23670 BEGIN
23700 IF divchar = ' ' OR divpos <= part_length THEN
B113 23730 BEGIN
23760 IF divtry = 1 THEN GOTO divide;
23790 IF NOT digit(fetchar(longline,divpos-1)) THEN GOTO
23820 divide;
23850 IF NOT digit(fetchar(longline,divpos+1)) THEN GOTO
23880 divide;
E113 23910 END;
E112 23940 END;
E111 23970 END;
24000 divpos:= part_length; divchar:= fill;
24030 divide:
B114 24060 BEGIN
24090 printline:- longline.sub(1,divpos-
24120 (IF divchar = ' ' THEN 1 ELSE 0));
24150 longline:-
24180 longline.sub(divpos+1,longline.length-divpos);
E114 24210 END;
24240 putline;
E110 24270 END;
24300 COMMENT output last line of paragraph;
24330 IF longline =/= NOTEXT THEN
B115 24360 BEGIN printline:- longline; putline;
E115 24390 END;
E100 24420 END;
24450 COMMENT IF paragraph became shorter, remove the extra lines;
24480 move_the_cursor_to(0,q_verticalpos);
24510 IF printcount < lines THEN
24540 removelines(lines-printcount)
24570 ELSE IF printcount > lines AND insertline == NOTEXT THEN
B116 24600 BEGIN
24630 restore_lines(vpos,heightm1);
24660 move_the_cursor_to(0,vpos);
E116 24690 END;
24720 command_done:= TRUE;
24750 endjustify: !z_t(-15);
E81 24780 END;
24781
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 19
DSK:MIDED2.SIM 18-MAR- 1979 4:17
24810 PROCEDURE control_c;
B117 24840 BEGIN COMMENT action of &c vided command;
24870 INTEGER hor, vert; CHARACTER c;
24900 hor:= q_horizontalpos; vert:= q_verticalpos;
24930 synchronize(0,heightm1); ! Cursor down to bottom of screen;
24960 terminalout.outimage;
24990 terminalout.outtext("To continue type CONT");
25020 terminalout.outimage;
25050 IF arg[24] =/= NOTEXT THEN
B118 25080 BEGIN c:= warning("Are you sure??? ","Answer yes or No"
25110 ).getchar;
25140 IF c = 'Y' THEN
B119 25170 BEGIN restore_trmops; run(arg[24],1);
E119 25200 END;
E118 25230 END ELSE
B120 25260 BEGIN restore_trmops; exit(0);
25290 COMMENT user has typed continue or reenter-proceed. Set switches
25320 and restore screen; set_tty_tab;
E120 25350 END;
25380 q_horizontalpos:= hor; q_verticalpos:= vert;
25410 restore_screen(q_verticalpos, 998);
E117 25440 END;
25470
25500 PROCEDURE restore_trmops;
B121 25530 BEGIN
25560 vdccout; echon;
25590 command_done:= TRUE;
E121 25620 END;
25621
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 20
DSK:MIDED2.SIM 18-MAR- 1979 4:17
25650 PROCEDURE position_tab(tabcharhandling); BOOLEAN tabcharhandling;
25680 COMMENT User has input a horizontal tab <HT> character. Move to the
25710 next tabulator point;
B122 25740 BEGIN
25770 INTEGER i;
25800 INTEGER hpos, vpos;
25830 hpos:= q_horizontalpos; vpos:= q_verticalpos;
25860 IF terminaltype = newelite OR terminaltype = newkthelite THEN
25890 q_horizontalpos:= (q_horizontalpos+8)//8*8;
25920 IF tabcharhandling AND
25950 (terminaltype = minitec OR terminaltype = 0) THEN
B123 25980 BEGIN
26010 synchronize(0,vpos);
26040 hpos:= hpos+8; IF hpos > width THEN
26070 restore_screen(q_verticalpos, 998) ELSE
26100 outtext(screen(vpos).sub(1,hpos));
26130 hpos:= hpos-8;
E123 26160 END;
26190 FOR i:= hpos+1 STEP 1 UNTIL widthm1 DO
26220 IF tab_position(i) THEN GOTO out;
26250 i:= widthm1; IF terminaltype >= elite AND
26280 terminaltype <= newkthelite THEN synchronize(i,vpos);
26310
26340 out: move_the_cursor_to(i,vpos);
E122 26370 END;
26371
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 21
DSK:MIDED2.SIM 18-MAR- 1979 4:17
26400 PROCEDURE pagedivide;
B124 26430 BEGIN COMMENT &PI VIDED command to split pages;
26460 INTEGER vpos, i;
26490 !z_t(16); vpos:= q_verticalpos;
26520 cancel_display;
26550 COMMENT split in the middle of a line;
26580 IF q_horizontalpos > 0 THEN
B125 26610 BEGIN addlines(1,TRUE,FALSE,TRUE); vpos:= vpos+1;
E125 26640 END;
26670 COMMENT remove page_end_marker before splitting;
26700 FOR i:= vpos STEP 1 UNTIL heightm1 DO
B126 26730 BEGIN
26760 IF screen[i].strip = page_end_marker THEN
B127 26790 BEGIN
26820 move_the_cursor_to(0,i); removelines(1);
26850 move_the_cursor_to(0,vpos);
E127 26880 END;
E126 26910 END;
26940 COMMENT Scroll out lines to previous page;
26970 move_the_cursor_to(0,heightm1);
27000 printing:= FALSE;
27030 FOR i:= 1 STEP 1 UNTIL vpos DO
B128 27060 BEGIN call(p_scroll);
27090 move_the_cursor_to(0,heightm1);
E128 27120 END;
27150 printing:= TRUE;
27180 COMMENT Output previous page to the output text file;
27210 empty_top_of_page; IF NOT nooutput THEN addff:= TRUE;
27240 IF out_pagenumber = 1 THEN out_pagenumber:= 2;
27270 sub_page_number:= 1;
27300 IF pageheader THEN check_page_number(TRUE);
27330 home_the_cursor; resume_display;
27360 restore_screen(0,showdefault); command_done:= TRUE; !z_t(-16);
E124 27390 END;
27391
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 22
DSK:MIDED2.SIM 18-MAR- 1979 4:17
27420 PROCEDURE skippage; COMMENT fast skip past full page;
27450 IF NOT editin.endfile THEN
B129 27480 BEGIN INTEGER breakchar;
27510 IF endpage AND NOT nooutput THEN addff:= TRUE;
27540 IF addff AND out_pagenumber = 1 THEN out_pagenumber:= 2;
27570 endpage:= FALSE;
27600 IF ((pageheader AND NOT merrygoround)
B130 27630 OR (addff AND NOT inhibit_ff)) AND NOT nooutput THEN BEGIN
27660 call(p_editin_inimage);
27690 screen[0]:= editin_image_strip;
27720 IF pageheader AND NOT merrygoround THEN
27750 check_page_number(FALSE);
27780 output_line:- screen[0]; call(p_true_write);
B131 E130 27810 END ELSE BEGIN
27840 IF addff AND NOT nooutput
27870 THEN out_pagenumber:= out_pagenumber+1;
27900 addff:= inhibit_ff:= FALSE;
E131 27930 END;
27960
27990 pgcopy(editin,IF nooutput THEN NONE ELSE editout,
28020 numbered_infile); last_line_number:= -1;
28050
28080 inhibit_ff:= endpage:= NOT editin.endfile;
28110
E129 28140 END of procedure skippage;
28170
28200 PROCEDURE newpages(number, findend, findeof);
28230 INTEGER number; BOOLEAN findend; ! findend = &PnE command;
28260 BOOLEAN findeof; ! find end of file;
28290 COMMENT &P, &PnE, &PF and &PnN VIDED commands, move to given page;
B132 28320 BEGIN INTEGER i; BOOLEAN addpage; CHARACTER c;
28350 BOOLEAN nofastskip; ! do not use skippage procedure;
28380 !z_t(17);
28410 nofastskip:= findeof OR (numbered_infile EQV increment = 0);
28440 IF backuping THEN
B133 28470 BEGIN q_display_output:= FALSE; addpage:= TRUE;
E133 28500 END ELSE
28530 cancel_display; IF number < 0 THEN number:= 0;
28560 COMMENT notify user before time consuming action;
28590 IF number > 1 THEN forceout(terminalout);
28620 COMMENT output and input "number" pages;
28650 FOR i:= 0 STEP 1 UNTIL number DO
B134 28680 BEGIN
28710 IF i > 0 THEN
B135 28740 BEGIN
28770 pagenumber:= pagenumber+1;
28800 IF i = 1 OR nofastskip THEN printpage ELSE skippage;
28830 IF out_pagenumber = 1 THEN out_pagenumber:= 2;
28860
28890 IF NOT addpage AND editin.endfile THEN
B136 28920 BEGIN
28950 INSPECT terminalout DO INSPECT terminalin DO
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 22-1
DSK:MIDED2.SIM 18-MAR- 1979 4:17
B137 28980 BEGIN
29010 IF NOT q_echoenabled THEN echon;
29040 outtext("No such page? Shall we?"); outimage;
29070 loop: outtext("1 Add a new page"); outimage;
29100 outtext("2 Finish the editing"); outimage;
29130 inimage; c:= inchar;
29160 IF c = '1' THEN addpage:= TRUE ELSE
29190 IF c = '2' THEN stop_editing ELSE
B138 29220 BEGIN outtext("Answer 1 or 2"); outimage;
29250 GOTO loop;
E138 29280 END;
E137 29310 END;
E136 29340 END;
29370 IF i = number OR nofastskip THEN initialload;
29400 IF NOT nooutput THEN addff:= TRUE;
E135 29430 END of IF i > 0;
29460 IF findeof OR i = number THEN
B139 29490 BEGIN
29520 IF i = number THEN home_the_cursor;
29550 IF number = 0 THEN findtop; ! &P0 or &P0E command;
29580 IF findend OR findeof THEN ! &PnE or &PF command;
B140 29610 BEGIN
29640 move_the_cursor_to(0,heightm1);
29670 printing:= FALSE;
29700 WHILE (NOT endpage AND NOT editin.endfile)
29730 OR lower_lines =/= NONE DO call(p_scroll);
29760 printing:= TRUE;
29790 IF findeof AND editin.endfile THEN GOTO ready;
E140 29820 END;
E139 29850 END;
E134 29880 END;
29910 ready:
29940 IF backuping THEN q_display_output:= TRUE ELSE
B141 29970 BEGIN resume_display; restore_screen(q_verticalpos, showdefault);
E141 30000 END;
30030 command_done:= TRUE; !z_t(-17);
E132 30060 END;
30061
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 23
DSK:MIDED2.SIM 18-MAR- 1979 4:17
30090 PROCEDURE findtop;
30120 COMMENT move screen to the top of the current page;
B142 30150 BEGIN INTEGER i, start, stop;
30180 TEXT exchanger;
30210 start:= heightm1; stop:= heightm1-top_fill;
30240 IF stop < 0 THEN stop:= 0;
30270 FOR i:= start STEP -1 UNTIL stop DO
30300 push_line(screen[i]);
30330 FOR top_fill:= top_fill STEP -1 UNTIL height DO
30360 push_line(top_of_page[top_fill]);
30390 IF top_fill > heightm1 THEN top_fill:= heightm1;
30420 stop:= heightm1-top_fill-1;
30450 FOR i:= 0 STEP 1 UNTIL stop DO
30480 exchange_lines(heightm1-i,heightm1-i-top_fill-1);
30510 FOR i:= 0 STEP 1 UNTIL top_fill DO
B143 30540 BEGIN exchanger:- screen(i);
30570 screen[i]:- top_of_page[i];
30600 top_of_page[i]:- exchanger;
E143 30630 END;
30660 top_fill:= -1;
E142 30690 END;
30691
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 24
DSK:MIDED2.SIM 18-MAR- 1979 4:17
30720 PROCEDURE finalwrite;
30750 COMMENT &E VIDED command, input and output the rest of
30780 the pages and print final message;
B144 30810 BEGIN
30840 INTEGER i; BOOLEAN numberchange;
30870 numberchange:= numbered_infile EQV increment = 0;
30900 printpage;
30930 IF NOT nooutput THEN
30960 WHILE NOT editin.endfile DO
B145 30990 BEGIN
B146 31020 IF numberchange THEN BEGIN
31050 initialload; IF NOT nooutput THEN addff:= TRUE;
31080 printpage;
B147 E146 31110 END ELSE BEGIN
31140 skippage;
E147 31170 END;
E145 31200 END;
31230 synchronize(0,2); command_done:= TRUE;
31260
E144 31290 END;
31291
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 25
DSK:MIDED2.SIM 18-MAR- 1979 4:17
31320 PROCEDURE set_tty_tab;
B148 31350 BEGIN COMMENT set TRMOP .TTY TAB setting to govern monitor handling
31380 of <HT> characters;
31410 vdccin;
31440 IF terminaltype = volker414h
31470 THEN trmop(8r2021,terminalout,0);
31500 ttytab:= IF terminaltype = minitec THEN 0 ELSE 1;
31530 trmop(8R2005,terminalout,ttytab);
31560 trmop(8R2006,terminalout,1); !.TTY FORM;
31590 trmop(8R2025,terminalout,0); !.TTY BLANKS;
31620 normaltext;
E148 31650 END;
31651
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 26
DSK:MIDED2.SIM 18-MAR- 1979 4:17
31680 COMMENT Main part of the class VIDED2, initialize variables;
31710 control_d:= char(4); control_f:= char(6);
31740 comstartchar:= IF terminaltype = elite3025 THEN 'p'
31770 ELSE IF terminaltype = vt52 OR terminaltype = vt100 THEN 'P'
31800 ELSE IF terminaltype = tandberg THEN char(14)
31830 ELSE IF terminaltype = volker414h THEN 'A' ELSE control_f;
31860 control_v:= char(22);
31890 control_u:=IF terminaltype = cdc71310s THEN char(1) ELSE char(21);
31920 control_w:= char(23);
31950 top_size:= pageheight;
31980 FOR top_fill:= top_size STEP -1 UNTIL 0 DO
32010 top_of_page[top_fill]:- blanks(width);
E2 32040 END of vided2x;
E1 32070 END of vided2;
SWITCHES CHANGED FROM DEFAULT:
-A NO CHECK OF ARRAY INDEX
-D NO SYMBOL TABLE GENERATED FOR DEBUG
E EXTERNAL CLASS/PROCEDURE
-Q NO CHECK OF QUALIFICATION
-W NO WARNINGS GENERATED
ERRORS DETECTED:
4 TYPE W MESSAGES
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 27
DSK:MIDED2.SIM 18-MAR- 1979 4:17 LINE NUMBER TABLE
960 000205 3540 000777 5880 001556 8220 002317 10170 003024
1020 000206 3600 001017 5940 001564 8250 002323 10200 003036
1380 000207 3630 001036 5970 001601 8310 002324 10230 003045
1410 000220 3720 001047 6000 001605 8340 002333 10260 003057
1470 000233 3750 001057 6060 001617 8400 002347 10290 003066
1500 000241 3780 001066 6090 001622 8430 002356 10320 003070
1530 000261 3840 001073 6150 001634 8460 002360 10350 003074
1590 000262 3870 001076 6300 001674 8490 002362 10410 003106
1620 000264 3900 001104 6330 001677 8520 002363 10500 003107
1650 000300 3960 001110 6360 001706 8610 002402 10530 003112
1680 000306 4020 001115 6420 001736 8670 002414 10590 003125
1710 000311 4050 001117 6480 001773 8700 002423 10680 003127
1740 000316 4080 001131 6510 002000 8730 002434 10710 003132
1770 000324 4110 001135 6540 002001 8760 002444 10740 003136
1830 000356 4140 001146 6570 002011 8790 002447 10770 003147
1860 000371 4170 001147 6660 002013 8850 002450 10800 003157
1920 000372 4260 001171 6720 002020 8880 002461 10830 003161
1950 000376 4320 001175 6750 002022 8910 002462 10860 003162
1980 000407 4350 001205 6780 002034 8970 002462 10920 003162
2010 000420 4440 001211 6810 002043 9060 002470 10950 003173
2040 000431 4530 001267 6840 002046 9090 002473 10980 003203
2070 000442 4590 001272 6870 002055 9120 002502 11040 003204
2100 000445 4620 001303 6900 002056 9150 002521 11160 003204
2130 000456 4680 001305 6930 002060 9210 002541 11190 003211
2160 000467 4710 001313 6960 002063 9240 002547 11220 003216
2190 000474 4740 001324 6990 002064 9270 002570 11250 003225
2220 000505 4770 001331 7050 002064 9300 002576 11280 003234
2250 000516 4830 001332 7080 002077 9330 002603 11400 003254
2310 000521 4890 001355 7110 002113 9360 002607 11430 003263
2340 000530 4950 001371 7140 002130 9390 002613 11460 003274
2370 000544 4980 001400 7170 002137 9420 002624 11490 003300
2400 000550 5010 001411 7200 002140 9450 002626 11520 003301
2460 000551 5040 001416 7260 002141 9480 002645 11580 003302
2520 000571 5100 001423 7380 002141 9510 002646 11610 003306
2640 000632 5130 001431 7410 002145 9540 002657 11640 003313
2670 000633 5160 001442 7440 002147 9570 002662 11700 003337
2790 000633 5220 001447 7470 002153 9660 002662 11730 003350
2820 000641 5280 001450 7560 002156 9690 002670 11760 003356
2850 000653 5340 001451 7620 002165 9720 002703 11820 003365
2880 000655 5370 001456 7650 002167 9780 002705 11850 003367
2940 000666 5400 001457 7680 002203 9810 002710 11880 003370
2970 000671 5520 001457 7710 002205 9840 002716 12000 003370
3000 000702 5550 001463 7740 002206 9870 002726 12030 003375
3009 000703 5580 001473 7830 002207 9900 002737 12090 003404
3030 000732 5640 001506 7890 002212 9930 002744 12120 003414
3060 000735 5670 001513 7950 002217 9960 002747 12150 003430
3120 000746 5700 001516 7980 002234 9990 002750 12180 003434
3240 000767 5730 001517 8070 002260 10020 002754 12240 003435
3270 000772 5760 001521 8100 002267 10050 002763 12270 003447
3300 000774 5790 001534 8130 002300 10080 002773 12300 003462
3330 000775 5820 001543 8160 002304 10110 002777 12330 003466
3510 000775 5850 001555 8190 002305 10140 003003 12360 003475
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 27-1
DSK:MIDED2.SIM 18-MAR- 1979 4:17 LINE NUMBER TABLE
12390 003502 14850 004105 16920 004572 19320 005257 21750 006031
12420 003513 14880 004113 17040 004572 19380 005262 21810 006052
12450 003514 14970 004114 17070 004602 19410 005265 21870 006072
12510 003514 15000 004123 17100 004606 19470 005315 21960 006134
13050 003515 15014 004134 17160 004625 19500 005316 21990 006141
13140 003523 15022 004137 17220 004640 19530 005342 22050 006142
13170 003535 15032 004141 17250 004644 19560 005360 22110 006155
13200 003540 15038 004152 17310 004657 19590 005367 22230 006173
13230 003550 15056 004153 17370 004661 19620 005376 22290 006175
13290 003551 15058 004162 17430 004664 19680 005377 22320 006205
13320 003563 15120 004175 17490 004675 19710 005412 22350 006206
13350 003600 15150 004200 17520 004702 19740 005423 22500 006250
13380 003603 15210 004205 17550 004705 19770 005441 22560 006273
13410 003616 15270 004213 17580 004720 19800 005450 22590 006302
13440 003623 15300 004224 17610 004733 19830 005450 22620 006303
13470 003632 15330 004230 17640 004735 19860 005455 22650 006313
13500 003633 15360 004236 17670 004736 19890 005465 22680 006315
13530 003642 15390 004242 17700 004740 19920 005472 22740 006316
13560 003643 15420 004243 17730 004741 19950 005475 22770 006322
13590 003645 15450 004260 17760 004741 19980 005507 22830 006330
13650 003650 15480 004263 18180 004742 20010 005510 22890 006337
13680 003656 15540 004275 18210 004745 20040 005512 23010 006341
13740 003661 15570 004277 18240 004755 20100 005523 23070 006361
13770 003663 15600 004302 18270 004761 20130 005527 23160 006403
13800 003674 15630 004304 18300 004772 20220 005530 23190 006416
13830 003700 15690 004307 18330 005016 20250 005535 23340 006420
13860 003705 15720 004314 18360 005024 20280 005541 23400 006424
13890 003713 15780 004324 18390 005025 20340 005567 23430 006436
13920 003717 15810 004327 18420 005033 20370 005572 23490 006450
13980 003730 15840 004337 18450 005073 20400 005576 23580 006455
14010 003741 15870 004342 18510 005074 20460 005603 23700 006507
14040 003745 15900 004352 18630 005074 20550 005606 23760 006522
14070 003751 15960 004356 18660 005076 20580 005612 23790 006525
14100 003757 16020 004367 18690 005106 20610 005620 23850 006540
14130 003763 16080 004377 18720 005113 20700 005631 23970 006553
14160 003764 16110 004405 18750 005114 20760 005643 24000 006555
14220 003767 16140 004407 18780 005124 20820 005646 24090 006562
14280 003772 16170 004410 18810 005125 20910 005662 24150 006577
14310 003774 16260 004410 18840 005131 20970 005673 24240 006610
14340 004000 16290 004415 18900 005143 21000 005674 24270 006612
14370 004010 16320 004424 18930 005153 21030 005677 24330 006613
14400 004013 16350 004431 18960 005162 21060 005700 24360 006617
14430 004016 16380 004442 18990 005167 21090 005701 24480 006623
14460 004021 16410 004443 19020 005201 21120 005705 24510 006633
14490 004032 16530 004443 19050 005207 21180 005713 24570 006644
14580 004035 16590 004464 19080 005230 21240 005717 24630 006661
14610 004047 16680 004505 19110 005240 21360 005722 24660 006671
14640 004052 16710 004525 19140 005247 21420 005731 24720 006700
14700 004066 16770 004540 19170 005253 21450 005740 24750 006702
14730 004070 16800 004546 19200 005254 21540 005750 24810 006703
14790 004073 16860 004567 19230 005255 21570 005762 24900 006703
14820 004103 16890 004571 19290 005255 21600 005764 24930 006710
DECsystem-20 SIMULA %4A(310) 25-JAN- 1981 18:37 PAGE 27-2
DSK:MIDED2.SIM 18-MAR- 1979 4:17 LINE NUMBER TABLE
24960 006720 27330 007432 29670 010073 31860 010571
24990 006723 27360 007436 29700 010075 31890 010573
25020 006727 27390 007450 29730 010114 31920 010602
25050 006732 27420 007451 29760 010117 31950 010604
25080 006743 27450 007451 29790 010121 31980 010607
25140 006765 27510 007460 29880 010130 32010 010620
25170 006770 27540 007466 29910 010131 32040 010631
25230 007010 27570 007500 29970 010137 32070 010634
25260 007011 27600 007502 30030 010152 32070 010636
25320 007015 27660 007515 30060 010154 32071 010641
25380 007017 27690 007517 30090 010155 0 000000
25410 007024 27720 007530 30210 010155
25440 007034 27780 007542 30240 010163
25500 007035 27810 007553 30270 010167
25560 007035 27840 007554 30300 010200
25590 007040 27900 007562 30330 010222
25620 007042 27990 007565 30360 010235
25650 007043 28020 007601 30390 010257
25830 007043 28080 007603 30420 010265
25860 007050 28140 007611 30450 010272
25920 007070 28200 007614 30480 010302
26010 007105 28410 007614 30510 010317
26040 007114 28440 007624 30540 010330
26070 007132 28470 007626 30570 010337
26100 007133 28500 007631 30600 010351
26130 007157 28530 007632 30630 010357
26190 007162 28590 007640 30660 010360
26220 007175 28650 007646 30690 010362
26250 007204 28710 007656 30720 010363
26340 007231 28770 007661 30870 010363
26370 007240 28800 007663 30900 010372
26400 007241 28830 007677 30930 010374
26490 007241 28890 007705 31020 010404
26520 007244 28950 007714 31050 010406
26580 007246 28950 007721 31080 010414
26610 007252 29010 007726 31110 010416
26700 007266 29040 007733 31140 010417
26760 007300 29070 007740 31200 010421
26820 007316 29100 007745 31230 010422
26850 007332 29130 007752 31290 010433
26910 007341 29160 007760 31320 010434
26970 007342 29190 007765 31410 010434
27000 007352 29220 010000 31440 010435
27030 007354 29250 010005 31500 010453
27060 007365 29310 010011 31530 010464
27090 007370 29370 010021 31560 010476
27120 007400 29400 010032 31590 010510
27150 007401 29460 010036 31620 010522
27210 007403 29520 010045 31650 010524
27240 007411 29550 010052 31710 010525
27270 007417 29580 010057 31710 010527