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 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 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