Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/vista.sim
There are 6 other files named vista.sim in the archive. Click here to see a list.
00040 COMMENT* package for control of display terminals*; OPTIONS(/l/e);
00080 COMMENT%IFNOT MACRO;
00120 COMMENT COMMENT%IF SIMULATION marks places to be modified to put
00160 vista as a subclass to simulation;
00200 COMMENT COMMENT%IF MVISTA marks places to give simplified
00240 minivista for use by VIDED package;
00280 COMMENT COMMENT%IF MACRO generates MACRO-10 program code defining
00285 global variables only;
00288 COMMENT COMMENT%IF CALLMAC generates SIMULA code calling MACRO
00289 versions of some procedures;
00290
00295 COMMENT%IF MACRO
00299 UNIVERSAL MVID
00303 .DIRECTIVE .NOBIN
00307 SALL
00311
00315 DEFINE WORD(X)<
00319 X==LOC
00323 LOC==LOC+1>
00327 SYN WORD,INTEGER
00331 SYN WORD,BOOLEAN
00335 SYN WORD,CHARACTER
00339 SYN WORD,REF
00343 SYN WORD,ARRAY
00347 DEFINE TEXT(X)<
00351 X==LOC
00355 LOC==LOC+2>
00359
00363 LOC==2
00367 COMMENT%IFNOT MACRO;
00374
00387 EXTERNAL CHARACTER PROCEDURE getch, fetchar;
00400 EXTERNAL PROCEDURE depchar, outstring, forceout;
00440 EXTERNAL PROCEDURE echo, abort, outchr;
00480 EXTERNAL INTEGER PROCEDURE trmop, gettab, checkint;
00520 EXTERNAL BOOLEAN PROCEDURE meny;
00560 EXTERNAL TEXT PROCEDURE storbokstav, scanto;
00600 EXTERNAL CLASS termty;
00601 COMMENT%IF CALLMAC
00602 EXTERNAL PROCEDURE movcur;
00603 COMMENT%IFEND CALLMAC;
00640 COMMENT%IFNOT MVISTA;
00680 EXTERNAL BOOLEAN PROCEDURE tmpout;
00720 EXTERNAL TEXT PROCEDURE tmpin;
00760 EXTERNAL INTEGER PROCEDURE checkreal;
01320
01360 COMMENT%IFNOT SIMULATION;
01400 CLASS vista
01440 COMMENT%IF MVISTA
01454 COMMENT%IF CALLMAC
01467 CLASS mmista;
01474 COMMENT%IFNOT CALLMAC
01480 CLASS mvista;
01500 COMMENT%IFEND CALLMAC
01520 COMMENT%IF MVISTA
01560 BEGIN
01600 CLASS mvistax
01640 COMMENT%IFEND MVISTA
01680 COMMENT%IF SIMULATION
01720 Simulation CLASS vistas
01760 COMMENT%IFEND SIMULATION;
01800 (width, height, terminalin, terminalout, q_echoenabled,
01840 terminaltype
01880 COMMENT%IFNOT MVISTA;
01920 , extraterminal, extraparameters);
01940 COMMENT%IFNOT MVISTA;
01960 VALUE extraterminal;
02000 COMMENT%IFNOT MACRO;
02040 COMMENT%IF MVISTA
02080 );
02120 COMMENT%IFEND MVISTA;
02140 COMMENT%IFEND MACRO;
02160 INTEGER width; ! Screen width or less;
02180 INTEGER height; ! Screen height or less;
02190 COMMENT%IFNOT MACRO;
02200 REF (infile) terminalin; ! From the terminal, usually sysin;
02240 REF (printfile) terminalout; ! To the terminal, usually sysout;
02320 BOOLEAN q_echoenabled; ! TRUE = monitor echo, FALSE = program echo;
02360 COMMENT%IF MACRO
02374 REF termin
02387 REF termout
02400 BOOLEAN qechoenabled
02420 COMMENT%IFNOT MACRO;
02440 INTEGER terminaltype; ! Number of terminal type, 0 for not given;
02454 COMMENT%IF MACRO
02467 INTEGER trmtyp
02474 COMMENT%IFEND MACRO;
02480 COMMENT%IFNOT MVISTA;
02520 TEXT extraterminal; ! Text name of additional terminal type;
02560 TEXT extraparameters; ! Cursor control codes for this terminal type;
02600 COMMENT%IFEND MVISTA;
02640 COMMENT%IFNOT MACRO;
02680 NOT HIDDEN PROTECTED q_echoenabled, q_display_output, terminalin,
02720 terminalout, synka, cpunumber, vt52, minitec,
02760 elite, kthelite, infoton, newelite, newkthelite, teletec, sattelite,
02800 tandberg, beehive, cdc71310s, cdc71310p, elite3025,
02840 elite1521, volkerd404, volkerd414, buginfoton, lowintens, highintens,
02880 otherdisplay, i200,
02920 get_char_from_screen, scrollallow, echon, echoff, unknownchar,
02960 q_gotchar, cancel_display, extraparameters, synchronize, allow_cr,
03000 home_the_cursor, set_char_on_screen, erasescreen, outchar,
03040 outimage, outtext, make_blank, insingle, move_the_cursor_to,
03080 blank_the_screen, stopblink, startblink, bell, q_verticalpos,
03120 eraseline, line_erasable, deleteline, insertline, line_insertable,
03160 q_horizontalpos, up, down, left, right, altmode, restorechar,
03200 carriagereturn, linefeed, home, fill, null, tab, formfeed, verttab,
03240 terminaltype, screen, badscreen, controlchar, addaltmode, height,
03280 heightm1, width, widthm1, resume_display, halfaltmode, delayer;
03320 COMMENT%IF MVISTA pointers for efficient CALL sequencing
03360 NOT HIDDEN PROTECTED q_insingle, p_q_insingle, p_insingle,
03400 direct_cursor_addressing, leftimage;
03440 COMMENT%IFNOT MVISTA;
03480 NOT HIDDEN PROTECTED stop_blink, start_blink, cause_real_time_delay,
03520 restore_the_whole_screen, blank_line, displaying, outint, outfrac,
03560 outreal, outfix, restore_one_char, inreal, inint, inimage, inyes,
03600 inword, verticalpos, horizontalpos, echoenabled, terminaloutimage;
03640 COMMENT%IFEND MVISTA;
03680 COMMENT%IF SIMULATION
03720 NOT HIDDEN Linkage, Link, Head, Process, Time, Current, Passivate,
03760 Wait, Hold , Cancel, Accum, Main;
03800 COMMENT%IFEND SIMULATION;
03840
03880 COMMENT%IF MVISTA COMMENT VIDED special kind of screen restore
03920 NOT HIDDEN PROTECTED restore_the_whole_screen;
03960 COMMENT%IF MVISTA
04000 VIRTUAL: PROCEDURE restore_the_whole_screen;
04040 COMMENT%IFEND MVISTA;
04080 BEGIN
04120 COMMENT%IFEND MACRO;
04160 BOOLEAN scrollallow; ! Allow <LF> to scroll the screen;
04200 COMMENT%IFNOT MACRO;
04240 BOOLEAN direct_cursor_addressing; ! Move cursor that way;
04280 BOOLEAN allow_cr; ! Allow sending of <CR> code to the terminal;
04320 COMMENT%IF MACRO
04360 BOOLEAN directcursoraddressing; !
04400 BOOLEAN allowcr;
04440 COMMENT%IFEND MACRO;
04480 BOOLEAN synka; ! Cursor may be at wrong place on terminal screen;
04520 BOOLEAN unknownchar; ! Last read character was untreated char < ' ';
04560 INTEGER cpunumber; ! From monitor tables;
04600 INTEGER vt52; ! code for DEC VT52 terminal type;
04640 INTEGER minitec; ! code for TEC minitec terminal type;
04680 INTEGER elite; ! code for elite 2500 with auto-<LF> at <CR>;
04720 INTEGER kthelite; ! code for elite 2500 without auto-<LF> at <CR>;
04760 INTEGER infoton; ! code for infoton vista terminal type;
04800 INTEGER newelite; ! code for elite 1500 with auto-<LF> at <CR>;
04840 INTEGER newkthelite; ! code for elite 1500 without auto-<LF> at <CR>;
04880 INTEGER teletec; ! code for TEC teletec terminal type;
04920 INTEGER sattelite; ! code for INFOTON vistar sattelite;
04960 INTEGER tandberg; ! code for TANDBERG TDV 2000 terminal type;
05000 INTEGER beehive; ! code for minibee and BEEHIVE B 100 terminals;
05020 COMMENT%IFNOT MACRO;
05040 INTEGER cdc71310s; ! CDC 713-10 terminals, scroll mode;
05080 INTEGER cdc71310p; ! CDC 713-10 terminals, page mode;
05088 COMMENT%IF MACRO
05096 INTEGER cdc73s
05104 INTEGER cdc73p
05112 COMMENT%IFEND MACRO;
05120 INTEGER elite3025; ! Datamedia Elite 3025 terminal;
05160 INTEGER elite1521; ! Datamedia Elite 1521 terminal;
05180 COMMENT%IFNOT MACRO;
05200 INTEGER volkerd404; ! Volker D 404 terminal;
05240 INTEGER volkerd414; ! Volker D 414 terminal;
05248 COMMENT%IF MACRO
05256 INTEGER vc404
05264 INTEGER vc414
05272 COMMENT%IFEND MACRO;
05280 INTEGER buginfoton; ! Infoton without erase line feature;
05320 INTEGER i200; ! Infoton I 200 terminal;
05360 INTEGER otherdisplay; ! Unknown display terminal;
05400 INTEGER maxterminals; ! 1 more than highest terminal type number;
05440 COMMENT%IFNOT MACRO;
05480 INTEGER q_verticalpos; ! Current cursor position vertically;
05520 INTEGER q_horizontalpos; ! Current cursor position horizontally;
05560 COMMENT%IF MACRO
05600 INTEGER qverticalpos; !
05640 INTEGER qhorizontalpos;
05680 COMMENT%IFEND MACRO;
05720 INTEGER widthm1; ! One less than screen width;
05760 INTEGER heightm1; ! One less than screen height;
05780
05800 CHARACTER lowintens; ! change to low intensity on screen;
05840 CHARACTER highintens; ! change to high intensity on screen;
05859 CHARACTER up; ! cursor up;
05869 CHARACTER left; ! cursor left;
05875 CHARACTER right; ! cursor right;
05883 CHARACTER down; ! cursor movement codes;
05920 CHARACTER formfeed; ! ASCII character;
05960 CHARACTER eraseline; ! Erases rest of line on some terminals;
06000 CHARACTER delayer;
06040 CHARACTER home; ! code to move cursor to upper left screen corner;
06080 COMMENT* ON CDC 713-10, this code moves to lower left corner*;
06120 CHARACTER carriagereturn; ! ASCII character;
06160 CHARACTER altmode; ! ASCII ESCAPE character, decimal 27;
06200 CHARACTER restorechar; ! code which, when given from terminal
06240 ;! causes screen to be restored (usually = altmode);
06280 CHARACTER linefeed; ! ASCII character;
06320 CHARACTER verttab; ! ASCII vertical tab character;
06360 CHARACTER null; ! ASCII character with decimal 0 value;
06400 CHARACTER tab; ! ASCII horizontal tab (HT) character;
06440 COMMENT%IFNOT MACRO;
06480 CHARACTER q_gotchar; ! Character inputted from the terminal;
06520 COMMENT%IF MACRO
06560 CHARACTER qgotchar;
06600 COMMENT%IFEND MACRO;
06640 CHARACTER startblink; ! Code to start blinking on terminal screen;
06680 CHARACTER bell; ! ASCII character;
06720 CHARACTER stopblink; ! Code to stop blinking on terminal screen;
06760 CHARACTER fill; ! Character with decimal value 127, RUB OUT code;
06800 CHARACTER erasescreen; ! Code to make the whole screen blank;
06840 COMMENT%IFNOT MACRO;
06880 CHARACTER address_screen; ! Code to start direct cursor addressing;
06920
06960 BOOLEAN line_erasable; ! True if eraseline is effective;
07000 BOOLEAN line_insertable; ! IF deleteline&insertline works;
07040 COMMENT%IF MACRO
07080 CHARACTER addressscreen; !
07120
07160 BOOLEAN lineerasable; !
07200 BOOLEAN lineinsertable; !
07240 COMMENT%IFEND MACRO;
07280 BOOLEAN addaltmode; ! Terminal control codes to be preceded by ESC;
07320 BOOLEAN halfaltmode; ! Inhibits addaltmode for left and down
07360 ;! and down, since these are sometimes = bs and lf;
07400 COMMENT%IFNOT MACRO;
07440 BOOLEAN q_display_output; ! Screen is to be output to the terminal;
07480 COMMENT%IF MACRO
07520 BOOLEAN qdisplayoutput;
07560 COMMENT%IFEND MACRO;
07600 BOOLEAN badscreen; ! Terminal screen may be jumbled;
07640 BOOLEAN controlchar; ! Last input char was terminal control code;
07680 BOOLEAN ttyqz; ! Local for QZ computer centre;
07720 BOOLEAN ttyzq; ! Local for QZ computer centre;
07760
07800 TEXT deleteline; ! Removes line, scrolls rest of screen up;
07840 TEXT insertline; ! Adds blank line, scroll rest down;
07880 TEXT leftimage; ! Image with left code in first position;
07920 TEXT elitecursors; ! Direct cursor adress table for elite terminals;
07940 COMMENT%IFNOT MVISTA;
07960 TEXT terminaloutimage; ! image of terminalout file class;
08000 COMMENT%IF MVISTA
08040 TEXT extraparameters;
08060
08080 COMMENT%IF MACRO
08120 ARRAY screen ; ! TEXT ARRAY screen[0:height-1];
08160 COMMENT%IFNOT MACRO;
08200 TEXT ARRAY screen[0:height-1]; ! Internal copy of screen contents;
08280 COMMENT%IF MVISTA
08320 REF (q_insingle) p_q_insingle; ! CALLing class faster than ;
08360 COMMENT%IF MVISTA
08400 REF (insingle) p_insingle; ! procedure call;
08440 COMMENT%IFEND MVISTA;
08480 COMMENT%IF MACRO
08560 REF pqinsingle; !
08600 REF pinsingle;
08640 COMMENT%IF MACRO
08642 END
08644 COMMENT%IFNOT MACRO;
08680 COMMENT%IFNOT mvista;
08720
08760 INTEGER PROCEDURE horizontalpos; horizontalpos:= q_horizontalpos;
08800 COMMENT to stop users changing the internal variable with
08840 the current horizontal cursor position;
08880
08920 INTEGER PROCEDURE verticalpos; verticalpos:= q_verticalpos;
08960 COMMENT current vertical cursor position;
09000
09040 BOOLEAN PROCEDURE echoenabled; echoenabled:= q_echoenabled;
09080 COMMENT to stop users changing the internal variable telling
09120 if input chars are echoed by the program or the monitor;
09160
09200 BOOLEAN PROCEDURE displaying; displaying:= q_display_output;
09240 COMMENT to stop users chaning the internal variable telling
09280 if picture is to be displayed on the terminal screen;
09320
09360 COMMENT%IFEND mvista;
09400 PROCEDURE echon;
09440 BEGIN COMMENT to start monitor echoing of input characters;
09480 !z_t(1); !z_t(-2); q_echoenabled:= TRUE;
09520 IF q_display_output THEN echo(terminalin,4);
09560 END;
09600
09640 PROCEDURE echoff;
09680 BEGIN COMMENT to start program echoing of input characters;
09720 !z_t(-1); !z_t(2); q_echoenabled:= FALSE;
09760 IF q_display_output THEN echo(terminalin,2);
09800 END;
09840 PROCEDURE resume_display;
09880 COMMENT to start displaying the picture on the terminal screen;
09920 IF NOT q_display_output THEN
09960 BEGIN !z_t(3); !z_t(-4); q_display_output:= TRUE;
10000 COMMENT%IFNOT MVISTA;
10040 restore_the_whole_screen;
10080 COMMENT%ENDIF MVISTA;
10120 echo(terminalin,IF q_echoenabled THEN 4 ELSE 2);
10160 END;
10200
10240 PROCEDURE cancel_display;
10280 COMMENT to stop displaying the picture on the terminal screen;
10320 IF q_display_output THEN
10360 BEGIN !z_t(-3); !z_t(4); COMMENT erase screen;
10400 IF addaltmode THEN outchr(terminalout,altmode,1);
10440 outchr(terminalout,home,1);
10480 IF addaltmode THEN outchr(terminalout,altmode,1);
10520 outchr(terminalout,erasescreen,1); outchr(terminalout,delayer,10);
10560 forceout(terminalout);
10600 q_display_output:= FALSE;
10640 echo(terminalin,4);
10680 END;
10720 COMMENT%IFNOT MVISTA;
10760 PROCEDURE cause_real_time_delay(number_of_fillers);
10800 COMMENT: Causes a moving picture on the screen to move slower by
10840 outputting a number_of_fillers. Example: If the speed of the
10880 terminal is 240 characters/second, then cause_real_time_delay(120)
10920 will cause a 0.5 seconds delay;
10960 INTEGER number_of_fillers;
11000 IF q_display_output THEN
11040 outchr(terminalout,delayer,number_of_fillers);
11080 COMMENT%IFEND MVISTA;
11120 CHARACTER PROCEDURE get_char_from_screen(h, v);
11160 COMMENT: If (h,v) indicates a position on the screen, then the
11200 character in that position is returned. If (h, v) indicates a
11240 position outside the screen, then char(0) is returned;
11280 INTEGER h, v;
11320 IF v >= 0 AND v <= height THEN
11360 BEGIN
11400 get_char_from_screen:= fetchar(screen(v),h+1);
11440 END;
11480 COMMENT%IFNOT MVISTA;
11520
11560 PROCEDURE start_blink;
11600 COMMENT will start blinking screen text and output a a space on
11640 the screen;
11680 BEGIN COMMENT on infoton terminals, blinking text is between start
11720 blink and stop blink codes on the screen. On most other terminals,
11760 blinking text is text sent between sending start blink and stop
11800 blink codes to the terminal;
11840 IF terminaltype = infoton OR terminaltype = cdc71310s
11880 OR terminaltype = cdc71310p THEN
11920 outchar(startblink) ELSE outchar(' ');
11960 IF terminaltype = minitec OR terminaltype = beehive
12000 OR terminaltype = elite3025 THEN
12040 BEGIN outchr(terminalout,altmode,1);
12080 IF terminaltype = elite3025 THEN outchr(sysout,'O',1);
12120 outchr(terminalout,startblink,1);
12160 END ELSE IF terminaltype >= elite
12200 AND terminaltype <= newkthelite
12240 THEN outchr(terminalout,startblink,1);
12280 outchr(terminalout,bell,1);
12320 END;
12360 COMMENT%IFEND MVISTA;
12400 COMMENT%IFNOT MVISTA;
12440
12480 PROCEDURE stop_blink;
12520 COMMENT will stop blinking screen text and output a a space on the
12560 screen;
12600 BEGIN
12640 IF terminaltype = infoton OR terminaltype = cdc71310s
12680 OR terminaltype = cdc71310p THEN
12720 outchar(stopblink) ELSE outchar(' ');
12760 IF terminaltype = minitec OR terminaltype = beehive
12800 OR terminaltype = elite3025 THEN
12840 BEGIN outchr(terminalout,altmode,1);
12880 IF terminaltype = elite3025 THEN outchr(sysout,'O',1);
12920 outchr(terminalout,stopblink,1);
12960 END ELSE IF terminaltype >= elite
13000 AND terminaltype <= newkthelite
13040 THEN synchronize(q_horizontalpos,q_verticalpos);
13080 END;
13120 COMMENT%IFEND MVISTA;
13160 PROCEDURE synchronize(hnew, vnew);
13200 COMMENT: If there is a risk that the program does not know where
13240 the cursor is on the screen, then this procedure will anyway for
13280 sure move the cursor to the position (hnew, vnew);
13320 INTEGER hnew, vnew;
13360 IF q_display_output THEN
13400 BEGIN
13440 IF NOT direct_cursor_addressing THEN local_home_the_cursor;
13480 move_the_cursor_to(hnew,vnew);
13520 END;
13560 COMMENT%IFNOT MVISTA;
13600 PROCEDURE restore_the_whole_screen;
13640 COMMENT: If the picture of the screen has been destroyed, then a
13680 call to this procedure will make the picture on the screen equal
13720 to the internal picture in the program;
13760 IF q_display_output THEN
13800 INSPECT terminalout DO
13840 BEGIN
13880 INTEGER h, v, hold, vold;
13920 hold:= q_horizontalpos; vold:= q_verticalpos;
13960 echo(terminalin,IF q_echoenabled THEN 4 ELSE 2);
14000 home_the_cursor; breakoutimage;
14040 IF addaltmode THEN outchr(terminalout,altmode,1);
14080 outchr(terminalout,erasescreen ,1); outchr(terminalout,delayer,10);
14120 q_horizontalpos:= q_verticalpos:= 0;
14160 FOR v:= 0 STEP 1 UNTIL heightm1 DO
14200 BEGIN
14240 IF screen[v].strip =/= NOTEXT THEN
14280 BEGIN
14320 IF allow_cr THEN outchr(terminalout,carriagereturn,1)
14360 ELSE home_the_cursor;
14400 move_the_cursor_to(0,v); breakoutimage;
14440 outstring(terminalout,screen[v].strip);
14480 END;
14520 END;
14560 synchronize(hold,vold);
14600 END;
14640 COMMENT%IFEND MVISTA;
14660 COMMENT%IFNOT CALLMAC;
14680 PROCEDURE true_outchr(c); CHARACTER c;
14720 BEGIN
14760 COMMENT at the QZ computer centre, certain national characters are
14800 sometimes converted by the monitor before transmitting them to the
14840 terminal. This will cause errors if these characters are used for
14880 direct cursor addressing. This procedure makes the inverse
14920 conversion first, so that the correct code will be output;
14960 IF ttyqz THEN
15000 BEGIN IF ttyzq THEN
15040 BEGIN
15080 IF c = char(00035) THEN c:= char(124) ELSE
15120 IF c = char(00036) THEN c:= char(126) ELSE
15160 IF c = char(00064) THEN c:= char(92) ELSE
15200 IF c = char(00091) THEN c:= char(35) ELSE
15240 IF c = char(00092) THEN c:= char(64) ELSE
15280 IF c = char(00093) THEN c:= char(36) ELSE
15320 IF c = char(00096) THEN c:= char(91) ELSE
15360 IF c = char(00124) THEN c:= char(96) ELSE
15400 IF c = char(00126) THEN c:= char(93);
15440 END ELSE
15480 BEGIN
15520 IF c = char(00035) THEN c:= char(91) ELSE
15560 IF c = char(00036) THEN c:= char(93) ELSE
15600 IF c = char(00064) THEN c:= char(92) ELSE
15640 IF c = char(00091) THEN c:= char(35) ELSE
15680 IF c = char(00092) THEN c:= char(64) ELSE
15720 IF c = char(00093) THEN c:= char(36) ELSE
15760 IF c = char(00096) THEN c:= char(124) ELSE
15800 IF c = char(00124) THEN c:= char(96);
15840 END;
15880 END ELSE IF ttyzq THEN
15920 BEGIN
15960 IF c = char(00035) THEN c:= char(96) ELSE
16000 IF c = char(00036) THEN c:= char(126) ELSE
16040 IF c = char(00096) THEN c:= char(35) ELSE
16080 IF c = char(00126) THEN c:= char(36);
16120 END;
16160 outchr(terminalout,c,1);
16200 END of procedure true_outchr;
16210 COMMENT%IFEND CALLMAC;
16240 PROCEDURE move_the_cursor_to(horiz, vertic);
16280 COMMENT: Will move the cursor to the position(horiz, vertic) on
16320 the screen;
16360 INTEGER horiz, vertic;
16410 COMMENT%IF CALLMAC
16416 movcur(cpunumber,horiz,vertic);
16422 COMMENT%IFNOT CALLMAC;
16428 BEGIN
16440 INTEGER i;
16480 !z_t(5);
16520 IF q_display_output THEN
16560 BEGIN
16600 COMMENT%IFNOT MVISTA;
16640 IF badscreen THEN
16680 BEGIN badscreen:= FALSE; restore_the_whole_screen;
16720 END;
16760 COMMENT%IFEND MVISTA;
16800 IF direct_cursor_addressing THEN
16840 BEGIN
16880 IF terminaltype = minitec THEN
16920 BEGIN
16960 outchr(terminalout,altmode,1);
17000 outchr(terminalout,address_screen,1);
17040 true_outchr(char(127-horiz));
17080 true_outchr(char(127-vertic));
17120 END ELSE IF terminaltype >= elite
17160 AND terminaltype <= kthelite THEN
17200 BEGIN
17240 outchr(terminalout,address_screen,1);
17280 true_outchr(fetchar(elitecursors,horiz+1));
17320 true_outchr(fetchar(elitecursors,vertic+1));
17360 END ELSE IF terminaltype = newelite
17400 OR terminaltype = newkthelite OR terminaltype = elite1521
17440 OR terminaltype = i200 THEN
17480 BEGIN
17520 outchr(terminalout,address_screen,1);
17560 true_outchr(char(8r040+horiz));
17600 true_outchr(char(8r040+vertic));
17640 END ELSE
17680 BEGIN
17720 IF addaltmode THEN outchr(terminalout,altmode,1);
17760 outchr(terminalout,address_screen,1);
17800 true_outchr(char(8r040+vertic));
17840 true_outchr(char(8r040+horiz));
17880 END;
17920 GOTO moved;
17960 END;
18000 IF terminaltype = tandberg THEN
18040 BEGIN COMMENT TANDBERG TDV 2000 is funny on last screen line;
18080 IF q_verticalpos = heightm1 AND vertic < heightm1 THEN
18120 BEGIN outchr(terminalout,home,1);
18160 q_horizontalpos:= q_verticalpos:= 0;
18200 END;
18240 END;
18280 IF horiz < q_horizontalpos//2 THEN
18320 BEGIN
18360 q_horizontalpos:= 0;
18400 IF allow_cr AND vertic > q_verticalpos//2 THEN
18440 outchr(terminalout,carriagereturn,1) ELSE
18480 BEGIN
18520 IF addaltmode THEN outchr(terminalout,altmode,1)
18560 ELSE outchr(terminalout,home,1);
18600 outchr(terminalout,home,1);
18640 IF terminaltype = cdc71310s THEN q_verticalpos:= heightm1
18680 ELSE q_verticalpos:= 0;
18720 END;
18760 END;
18800 IF addaltmode THEN
18840 BEGIN
18880 FOR i:= horiz+1 STEP 1 UNTIL q_horizontalpos DO
18920 BEGIN IF NOT halfaltmode THEN outchr(terminalout,altmode,1);
18960 outchr(terminalout,left,1);
19000 END;
19040 FOR i:= q_horizontalpos+1 STEP 1 UNTIL horiz DO
19080 BEGIN outchr(terminalout,altmode,1);
19120 outchr(terminalout,right,1);
19160 END;
19200 FOR i:= vertic+1 STEP 1 UNTIL q_verticalpos DO
19240 BEGIN outchr(terminalout,altmode,1);
19280 outchr(terminalout,up,1);
19320 END;
19360 FOR i:= q_verticalpos+1 STEP 1 UNTIL vertic DO
19400 BEGIN IF NOT halfaltmode THEN outchr(terminalout,altmode,1);
19440 outchr(terminalout,down,1);
19480 END;
19520 END ELSE
19560 BEGIN
19600 outchr(terminalout,right,horiz-q_horizontalpos);
19640 outchr(terminalout,left,q_horizontalpos-horiz);
19680 outchr(terminalout,down,vertic-q_verticalpos);
19720 outchr(terminalout,up,q_verticalpos-vertic);
19760 END;
19800 END;
19840 moved:
19880 q_horizontalpos:= horiz; q_verticalpos:= vertic;
19920 !z_t(-5);
19960 END;
19962 COMMENT%IFEND CALLMAC;
20000 PROCEDURE set_char_on_screen(setchar,horiz,vertic);
20040 COMMENT: Will output the character "setchar" onto the position
20080 (horiz,vertic) on the screen;
20120 CHARACTER setchar; INTEGER horiz, vertic;
20160 BEGIN
20200 move_the_cursor_to(horiz, vertic);
20240 BEGIN
20280 IF setchar = fill THEN setchar:= ' ' ELSE
20320 IF setchar < ' ' THEN setchar:= ' ';
20360 IF q_display_output THEN
20400 BEGIN outchr(terminalout,setchar,1);
20440 IF addaltmode THEN
20480 BEGIN IF NOT halfaltmode THEN
20520 outchr(terminalout,altmode,1);
20560 END;
20600 outchr(terminalout,left,1);
20640 END;
20680 depchar(screen[q_verticalpos],q_horizontalpos+1,setchar);
20720 END;
20760 IF q_horizontalpos = width THEN
20800 BEGIN
20840 synchronize(0,q_verticalpos+1);
20880 END;
20920 END;
20960 PROCEDURE outchar(setchar);
21000 COMMENT Will output the character "setchar" onto the place where
21040 the cursor is on the screen. Thereafter, the cursor is advanced to
21080 the position after the outputted character;
21120 CHARACTER setchar;
21160 BEGIN
21200 BEGIN
21240 IF setchar = fill THEN setchar:= ' ' ELSE
21280 IF setchar < ' ' THEN
21320 BEGIN
21360 IF terminaltype <= 2 THEN !infoton or vt52;
21400 BEGIN
21440 IF setchar NE startblink AND setchar NE stopblink
21480 THEN setchar:= ' ' ELSE outchr(terminalout,bell,1);
21520 END ELSE setchar:= ' ';
21560 END;
21600 IF q_display_output THEN outchr(terminalout,setchar,1);
21640 depchar(screen[q_verticalpos],q_horizontalpos+1,setchar);
21680 END;
21720 q_horizontalpos:= q_horizontalpos+1;
21760 IF q_horizontalpos = width THEN
21800 BEGIN
21840 synchronize(0,q_verticalpos+1);
21880 END;
21920 END;
21960 COMMENT%IFNOT MVISTA;
22000 PROCEDURE blank_line(v); INTEGER v;
22040 COMMENT will make line v blank on the screen;
22080 BEGIN
22120 move_the_cursor_to(0,v);
22160 IF q_display_output THEN
22200 BEGIN
22240 IF line_erasable THEN
22280 BEGIN IF addaltmode THEN outchr(sysout,altmode,1);
22320 outchr(sysout,eraseline,1);
22360 END ELSE
22400 BEGIN INTEGER blank_field;
22440 blank_field:= screen(v).strip.length+1;
22480 outchr(terminalout,' ',blank_field);
22520 IF allow_cr THEN outchr(terminalout,carriagereturn,1)
22560 ELSE synchronize(0,v);
22600 END;
22640 END;
22680 screen(v):= NOTEXT;
22720 END;
22760 COMMENT%IFEND MVISTA;
22800 PROCEDURE outimage;
22840 COMMENT: Will output any characters in the terminalout.image
22880 buffer and will then move the cursor to the beginning of the
22920 next line on the screen;
22960 INSPECT terminalout DO
23000 BEGIN
23040 CHARACTER lastout;
23080 IF q_display_output THEN
23120 BEGIN
23160 IF allow_cr AND terminaltype NE tandberg THEN
23200 BEGIN outchr(terminalout,carriagereturn,1);
23240 outchr(terminalout,linefeed,1);
23280 END ELSE
23320 BEGIN
23360 move_the_cursor_to(0,q_verticalpos+1);
23400 q_verticalpos:= q_verticalpos-1;
23440 END;
23480 END;
23520 IF allow_cr OR NOT q_display_output THEN
23560 q_verticalpos:= q_verticalpos+1;
23600 IF q_verticalpos >= height THEN q_verticalpos:=
23640 q_verticalpos-height;
23680 q_horizontalpos:= 0;
23700 forceout(terminalout);
23720 END;
23760 PROCEDURE outtext(tt); NAME tt; TEXT tt;
23800 COMMENT: Will output a text string onto the screen;
23840 BEGIN TEXT screenpart;
23880 ! screenpart is part of screen to which t is to be output;
23920 IF tt.length+q_horizontalpos <=width THEN
23960 BEGIN
24000 !z_t(6);
24040 screenpart:- screen[q_verticalpos].
24080 sub(q_horizontalpos+1,tt.length);
24120 screenpart:= tt;
24160 COMMENT%IFNOT MVISTA;
24200 IF q_display_output THEN
24240 COMMENT%IFEND MVISTA;
24280 BEGIN
24320 outstring(terminalout,screenpart);
24360 END;
24400 q_horizontalpos:= q_horizontalpos+tt.length;
24440 COMMENT%IFNOT MVISTA;
24480 IF q_horizontalpos > widthm1 THEN
24520 move_the_cursor_to(0,q_verticalpos);
24560 COMMENT%IFEND MVISTA;
24600 !z_t(-6);
24640 END;
24680 END;
24720 PROCEDURE make_blank(size); INTEGER size;
24760 COMMENT will make part of the screen blank, beginning at the
24800 current cursor position, and continuing size characters;
24840 BEGIN
24880 TEXT notblankpart;
24920 notblankpart:- screen[q_verticalpos]
24960 .sub(q_horizontalpos+1,size).strip;
25000 notblankpart:= NOTEXT;
25040 IF q_display_output THEN
25080 BEGIN
25120 IF (IF line_erasable THEN
25160 size + q_horizontalpos >= width ELSE FALSE) THEN
25200 BEGIN IF terminaltype = i200 THEN
25240 BEGIN IF q_horizontalpos > 0 THEN GOTO blankit;
25280 END; ! since erase line blanks the whole line;
25320 IF addaltmode THEN outchr(sysout,altmode,1);
25360 outchr(sysout,eraseline,1);
25400 END ELSE blankit: outchr(terminalout,' ',notblankpart.length);
25440 END;
25480 q_horizontalpos:= q_horizontalpos+notblankpart.length;
25520 END;
25560 COMMENT%IFNOT MVISTA;
25600 PROCEDURE outfix(a,i,j); REAL a; INTEGER i, j;
25640 COMMENT similar to SIMULA outfix procedure;
25680 BEGIN
25720 TEXT t;
25760 t:- screen[q_verticalpos].sub(q_horizontalpos+1,j);
25800 t.putfix(a,i);
25840 IF q_display_output THEN
25880 outstring(terminalout,t);
25920 q_horizontalpos:= q_horizontalpos+j;
25960 IF q_horizontalpos > widthm1 THEN
26000 move_the_cursor_to(0,q_verticalpos);
26040 END;
26080 COMMENT%IFEND MVISTA;
26120 COMMENT%IFNOT MVISTA;
26160 PROCEDURE outreal(a,i,j); REAL a; INTEGER i, j;
26200 COMMENT similar to SIMULA outreal procedure;
26240 BEGIN
26280 TEXT t;
26320 t:- screen[q_verticalpos].sub(q_horizontalpos+1,j);
26360 t.putreal(a,i);
26400 IF q_display_output THEN
26440 outstring(terminalout,t);
26480 q_horizontalpos:= q_horizontalpos+j;
26520 IF q_horizontalpos > widthm1 THEN
26560 move_the_cursor_to(0,q_verticalpos);
26600 END;
26640 COMMENT%IFEND MVISTA;
26680 COMMENT%IFNOT MVISTA;
26720 PROCEDURE outfrac(a,i,j); INTEGER a, i, j;
26760 COMMENT similar to SIMULA outfrac procedure;
26800 BEGIN
26840 TEXT t;
26880 t:- screen[q_verticalpos].sub(q_horizontalpos+1,j);
26920 t.putfrac(a,i);
26960 IF q_display_output THEN
27000 outstring(terminalout,t);
27040 q_horizontalpos:= q_horizontalpos+j;
27080 IF q_horizontalpos > widthm1 THEN
27120 move_the_cursor_to(0,q_verticalpos);
27160 END;
27200 COMMENT%IFEND MVISTA;
27240 COMMENT%IFNOT MVISTA;
27280 PROCEDURE outint(i,j); INTEGER i, j;
27320 COMMENT similar to SIMULA outint procedure;
27360 BEGIN
27400 TEXT t;
27440 t:- screen[q_verticalpos].sub(q_horizontalpos+1,j);
27480 t.putint(i);
27520 IF q_display_output THEN
27560 outstring(terminalout,t);
27600 q_horizontalpos:= q_horizontalpos+j;
27640 IF q_horizontalpos > widthm1 THEN
27680 move_the_cursor_to(0,q_verticalpos);
27720 END;
27760 COMMENT%IFEND MVISTA;
27800 COMMENT%IFNOT MVISTA;
27840 PROCEDURE restore_one_char(horiz,vertic);
27880 COMMENT: Will restore the character in the position (horiz,
27920 vertic) to what the program believes is in that position on
27960 the screen;
28000 INTEGER horiz, vertic;
28040 IF horiz >= 0 AND horiz < width AND vertic >= 0 AND
28080 vertic < height AND q_display_output THEN
28120 set_char_on_screen(get_char_from_screen(horiz,vertic),
28160 horiz,vertic);
28200 COMMENT%IFEND MVISTA;
28240 COMMENT%IF mvista
28280 CLASS q_insingle
28320 COMMENT%IFNOT mvista;
28360 PROCEDURE p_q_insingle
28400 (echo)
28440 COMMENT%IFEND MVISTA;
28480 ;
28520 COMMENT: Will input one character from the terminal without
28560 waiting for a carriage return. Can also input "left"=^Z,
28600 which cannot be input with inimage;
28640 COMMENT%IFNOT MVISTA;
28680 BOOLEAN echo;
28720 COMMENT%IFEND MVISTA;
28760 BEGIN
28800 COMMENT%IF MVISTA
28840 loop: detach;
28880 COMMENT%IFNOT MVISTA;
28920 IF NOT q_display_output THEN
28960 abort("VISTA input without picture showing");
29000 COMMENT%IFEND MVISTA;
29040 q_gotchar:= getch;
29080 IF q_gotchar = fill THEN
29120 BEGIN
29160 IF q_horizontalpos > 0 THEN
29200 BEGIN
29240 set_char_on_screen(' ',q_horizontalpos-1,
29280 q_verticalpos);
29320 END;
29360 END;
29400 IF
29440 COMMENT%IFNOT MVISTA;
29480 echo AND
29520 COMMENT%IFEND MVISTA;
29560 NOT q_echoenabled THEN
29600 BEGIN IF q_gotchar = tab THEN q_gotchar:= ' ';
29640 IF terminaltype NE tandberg THEN
29680 outchr(terminalout,q_gotchar,1) ELSE
29720 outchr(terminalout,
29760 IF q_gotchar = linefeed AND q_horizontalpos < heightm1 THEN
29800 down ELSE q_gotchar,1);
29840 END;
29880 COMMENT%IF MVISTA
29920 GOTO loop;
29960 COMMENT%IFEND MVISTA;
30000 END;
30040 COMMENT%IFNOT MVISTA;
30080 CHARACTER PROCEDURE insingle(echo);
30120 BOOLEAN echo;
30160 COMMENT%IFEND MVISTA;
30200 COMMENT%IF MVISTA
30240 CLASS insingle;
30280 COMMENT%IFEND MVISTA;
30320 BEGIN
30360 COMMENT%IF MVISTA
30400 mainloop: detach;
30440 COMMENT%IFEND MVISTA;
30480 !z_t(7);forceout(terminalout);
30520 COMMENT%IF MVISTA
30560 call(p_q_insingle);
30600 COMMENT%IFNOT MVISTA;
30640 p_q_insingle(echo);
30680 COMMENT%IFEND MVISTA;
30720 controlchar:= IF q_gotchar < ' ' THEN TRUE ELSE
30760 IF q_gotchar = fill THEN TRUE ELSE FALSE;
30800 IF terminaltype = infoton THEN
30840 BEGIN
30880 IF controlchar THEN
30920 BEGIN IF q_gotchar = startblink OR q_gotchar = stopblink
30960 THEN controlchar:= FALSE;
31000 END;
31040 END;
31080 IF addaltmode THEN
31120 BEGIN IF q_gotchar = altmode THEN
31160 BEGIN
31200 COMMENT%IF mvista
31240 call(p_q_insingle);
31280 COMMENT%IFNOT mvista;
31320 p_q_insingle(echo);
31360 COMMENT%IFEND MVISTA;
31400 controlchar:= TRUE;
31440 END;
31480 END;
31520 COMMENT%IFNOT MVISTA;
31560 IF q_gotchar = restorechar OR q_gotchar = formfeed THEN
31600 restore_the_whole_screen;
31640 insingle:= q_gotchar;
31680 COMMENT%IFEND MVISTA;
31720 COMMENT%IFNOT MVISTA;
31760 IF echo THEN
31800 COMMENT%IFEND MVISTA;
31840 BEGIN
31880 IF NOT controlchar THEN
31920 BEGIN COMMENT to be stored in screen;
31960 depchar(screen[q_verticalpos],q_horizontalpos+1,
32000 q_gotchar);
32040 q_horizontalpos:= q_horizontalpos+1;
32080 IF q_horizontalpos >= width THEN
32120 BEGIN ! wrap cursor around at screen borders;
32160 IF q_verticalpos < heightm1 THEN
32200 synchronize(0,q_verticalpos+1) ELSE
32240 COMMENT%IFNOT MVISTA;
32280 IF scrollallow THEN
32320 COMMENT%IFEND MVISTA;
32360 BEGIN outchr(terminalout,linefeed,1);
32400 synchronize(0,heightm1); badscreen:= TRUE;
32440 COMMENT unwanted scrolling of screen has occured;
32480 END
32520 COMMENT%IFNOT MVISTA
32560 ELSE synchronize(widthm1,heightm1);
32600 COMMENT%IFEND MVISTA;
32640 END;
32680 END ELSE
32720 BEGIN COMMENT not to be stored on the screen;
32760 BEGIN COMMENT not printable AND echo;
32800 unknownchar:= FALSE;
32840 IF q_gotchar = linefeed THEN
32880 BEGIN
32920 IF q_verticalpos < heightm1 THEN
32960 BEGIN IF allow_cr THEN
33000 BEGIN q_verticalpos:= q_verticalpos+1;
33040 IF q_echoenabled THEN
33080 BEGIN
33120 IF terminaltype = tandberg THEN
33160 BEGIN
33200 screen(q_verticalpos).sub(q_horizontalpos+1,
33240 width-q_horizontalpos):= NOTEXT;
33280 END;
33320 END;
33360 END ELSE
33400 synchronize(q_horizontalpos,q_verticalpos+1);
33440 END
33480 COMMENT%IFNOT MVISTA
33520 ELSE
33560 BEGIN
33600 IF NOT scrollallow THEN restore_the_whole_screen;
33640 END;
33680 COMMENT%IFEND MVISTA;
33720 END ELSE
33760 IF q_gotchar = carriagereturn THEN
33800 q_horizontalpos:= 0 ELSE
33840 IF q_gotchar = up THEN
33880 BEGIN IF q_verticalpos = 0 THEN
33920 synchronize(q_horizontalpos,heightm1)
33960 ELSE
34000 BEGIN
34040 IF terminaltype = tandberg THEN
34080 BEGIN IF q_verticalpos = heightm1 THEN synka:= TRUE;
34120 END;
34160 q_verticalpos:= q_verticalpos-1;
34200 END;
34240 END ELSE
34280 IF q_gotchar = down THEN
34320 BEGIN IF q_verticalpos >= heightm1 THEN
34360 synchronize(q_horizontalpos,0) ELSE
34400 q_verticalpos:= q_verticalpos+1;
34440 END ELSE
34480 IF q_gotchar = left THEN
34520 BEGIN IF q_horizontalpos = 0 THEN
34560 synchronize(widthm1,q_verticalpos) ELSE
34600 q_horizontalpos:= q_horizontalpos-1;
34640 END ELSE
34680 IF q_gotchar = right THEN
34720 BEGIN IF q_horizontalpos >= widthm1 THEN
34760 synchronize(0,q_verticalpos) ELSE
34800 q_horizontalpos:= q_horizontalpos+1;
34840 END ELSE
34880 IF q_gotchar = home THEN
34920 BEGIN q_horizontalpos:= 0;
34960 IF terminaltype = cdc71310s THEN q_verticalpos:= heightm1
35000 ELSE q_verticalpos:= 0;
35040 END ELSE
35080 IF q_gotchar = eraseline THEN
35120 BEGIN
35160 IF line_erasable THEN screen[q_verticalpos].
35200 sub(q_horizontalpos+1, widthm1-q_horizontalpos):= NOTEXT;
35240 END ELSE unknownchar:= TRUE;
35280 IF synka THEN
35320 BEGIN IF (IF q_echoenabled THEN NOT trmop(8R0001,sysout,1) =
35360 1 !=type ahead from the terminal has occured;
35400 ELSE TRUE) THEN
35440 BEGIN synka:= FALSE;
35480 IF q_echoenabled THEN
35520 synchronize(q_horizontalpos, q_verticalpos) ELSE
35560 restore_the_whole_screen;
35600 END;
35640 END;
35680 END not printable, but echo;;
35720 END;
35760 END;
35800 !z_t(-7);
35840 COMMENT%IF MVISTA
35880 GOTO mainloop;
35920 COMMENT%IFEND MVISTA;
35960 END;
36000 COMMENT%IFNOT MVISTA;
36040 PROCEDURE inimage;
36080 COMMENT: Will input a line of text from the terminal into
36120 the buffer terminalin.image;
36160 BEGIN
36200 TEXT stripimage; CHARACTER c;
36240 IF NOT q_display_output THEN
36280 abort("VISTA input without picture showing");
36320 readagain: forceout(terminalout);
36360 BEGIN
36400 terminalin.image:= NOTEXT; terminalin.image.setpos(1);
36440 loop: c:= insingle(TRUE);
36480 IF c EQ carriagereturn OR c EQ null THEN GOTO
36520 loop;
36560 IF c EQ linefeed THEN GOTO out;
36600 IF c = fill THEN
36640 BEGIN
36680 IF terminalin.pos > 1 THEN
36720 BEGIN
36760 terminalin.setpos(terminalin.pos-1);
36800 depchar(terminalin.image,terminalin.pos,' ');
36840 END;
36880 GOTO loop;
36920 END;
36960 terminalin.image.putchar(c);
37000 IF c EQ altmode OR c EQ formfeed OR c EQ verttab
37040 THEN GOTO out;
37080 GOTO loop;
37120 out: terminalin.image.setpos(1);
37160 END;
37200 IF terminalin.endfile THEN
37240 BEGIN
37280 terminalin.close; terminalin:- NEW infile("*");
37320 terminalin.open(copy(leftimage));
37360 END;
37400 END;
37440 COMMENT%IFEND MVISTA;
37480 COMMENT%IFNOT MVISTA;
37520 INTEGER PROCEDURE inint;
37560 COMMENT: Will search for and read an integer from the terminal;
37600 BEGIN
37640 INTEGER vold, hold;
37680 IF NOT q_display_output THEN
37720 abort("VISTA input without picture showing");
37760 forceout(terminalout);
37800 vold:= q_verticalpos; hold:= q_horizontalpos; inimage;
37840 WHILE checkint(terminalin.image) <= 0 DO
37880 BEGIN
37920 move_the_cursor_to(terminalin.image.strip.length+hold,
37960 vold);
38000 WHILE q_horizontalpos > hold DO
38040 BEGIN
38080 set_char_on_screen('?',q_horizontalpos-1,vold);
38120 END;
38160 move_the_cursor_to(hold,vold);
38200 inimage;
38240 END;
38280 inint:= terminalin.image.getint;
38320 synchronize(q_horizontalpos, q_verticalpos);
38360 END of inint;
38400 COMMENT%IFEND MVISTA;
38440 COMMENT%IFNOT MVISTA;
38480 REAL PROCEDURE inreal;
38520 COMMENT: Will search for and read an real from the terminal;
38560 BEGIN
38600 INTEGER vold, hold;
38640 IF NOT q_display_output THEN
38680 abort("VISTA input without picture showing");
38720 forceout(terminalout);
38760 vold:= q_verticalpos; hold:= q_horizontalpos; inimage;
38800 WHILE checkreal(terminalin.image) <= 0 DO
38840 BEGIN
38880 move_the_cursor_to(terminalin.image.strip.length+hold,
38920 vold);
38960 WHILE q_horizontalpos > hold DO
39000 BEGIN
39040 set_char_on_screen('?',q_horizontalpos-1,vold);
39080 END;
39120 move_the_cursor_to(hold,vold);
39160 inimage;
39200 END;
39240 inreal:= terminalin.image.getreal;
39280 synchronize(q_horizontalpos, q_verticalpos);
39320 END of inreal;
39360 COMMENT%IFEND MVISTA;
39400 COMMENT%IFNOT MVISTA;
39440 TEXT PROCEDURE inword;
39480 COMMENT: Will search for and read a word from the terminal.
39520 A word is any seqeuence of non-blank characters;
39560 BEGIN
39600 INTEGER vold;
39640 IF NOT q_display_output THEN
39680 abort("VISTA input without picture showing");
39720 forceout(terminalout);
39760 vold:= q_verticalpos;
39800 WHILE
39840 terminalin.image.sub(terminalin.pos,
39880 terminalin.length-terminalin.pos+1).strip.length = 0 DO
39920 BEGIN
39960 inimage; move_the_cursor_to(0,vold);
40000 END;
40040 WHILE terminalin.image.getchar NE ' ' AND
40080 terminalin.image.more
40120 DO;
40160 inword:-
40200 copy(terminalin.image.sub(1,terminalin.image.pos-2));
40240 synchronize(q_horizontalpos, q_verticalpos);
40280 END;
40320 COMMENT%IFEND MVISTA;
40360 COMMENT%IFNOT MVISTA;
40400 BOOLEAN PROCEDURE inyes;
40440 COMMENT: Will search for either "yes" or "no" in input from
40480 the terminal and return TRUE if "yes" is found, FALSE if
40520 "no" is found;
40560 BEGIN
40600 TEXT answer; CHARACTER c; INTEGER vold;
40640 IF NOT q_display_output THEN
40680 abort("VISTA input without picture showing");
40720 forceout(terminalout);
40760 vold:= q_verticalpos-1;
40800 tryagain:
40840 inimage; answer:- terminalin.image.strip;
40880 WHILE TRUE DO
40920 BEGIN
40960 c:= IF answer.more THEN answer.getchar ELSE
41000 char(0);
41040 IF c \= ' ' THEN
41080 BEGIN
41120 IF c = 'y' OR c = 'Y' THEN inyes:= TRUE ELSE
41160 IF c = 'n' OR c = 'N' THEN inyes:= FALSE ELSE
41200 BEGIN
41240 synchronize(0,vold);
41280 outtext(
41320 "You answered neither yes nor NO. Try again."
41360 );
41400 outimage;
41440 GOTO tryagain;
41480 END;
41520 GOTO out;
41560 END;
41600 END;
41640 out: terminalin.setpos(terminalin.length+1);
41680 synchronize(q_horizontalpos,q_verticalpos);
41720 END;
41760 COMMENT%IFEND MVISTA;
41800 PROCEDURE local_home_the_cursor;
41840 COMMENT: Will move the cursor to the position (0,0),
41880 the upper left corner of the screen, on CDC 71310 to
41920 the lower left corner;
41960 BEGIN
42000 IF q_display_output THEN
42040 BEGIN
42080 IF addaltmode THEN outchr(terminalout,altmode,1) ELSE
42120 outchr(terminalout,home,1);
42160 outchr(terminalout,home,1);
42200 END;
42240 q_verticalpos:= q_horizontalpos:= 0;
42280 IF terminaltype = cdc71310s THEN q_verticalpos:= heightm1;
42320 END;
42360 PROCEDURE home_the_cursor;
42400 COMMENT: Will move the cursor to the position (0,0),
42440 the upper left corner of the screen;
42480 BEGIN
42520 IF q_display_output THEN
42560 BEGIN
42600 IF addaltmode THEN outchr(terminalout,altmode,1) ELSE
42640 outchr(terminalout,home,1);
42680 outchr(terminalout,home,1);
42720 IF terminaltype = cdc71310s THEN outchr(terminalout,up,heightm1);
42760 END;
42800 q_verticalpos:= q_horizontalpos:= 0;
42840 END;
42880 PROCEDURE blank_the_screen;
42920 COMMENT: Will make the whole screen blank.;
42960 BEGIN
43000 INTEGER h, v;
43040 FOR v:= 0 STEP 1 UNTIL heightm1 DO
43080 screen[v]:= NOTEXT;
43120 IF q_display_output THEN
43160 BEGIN
43200 home_the_cursor;
43240 IF addaltmode THEN outchr(terminalout,altmode,1);
43280 outchr(terminalout,erasescreen,1); outchr(terminalout,delayer,10);
43320 home_the_cursor;
43360 echo(terminalin,IF q_echoenabled THEN 4 ELSE 2);
43400 END;
43440 END;
43480 COMMENT Execution of the CLASS VISTA starts here with initialization
43520 of local variables;
43560 COMMENT%IF mvista
43600 p_q_insingle:- NEW q_insingle;
43640 COMMENT%IF mvista
43680 p_insingle:- NEW insingle;
43780 COMMENT%IFNOT mvista;
43800 terminaloutimage:- terminalout.image;
43820 COMMENT%IFEND mvista;
43830 trmop(8r2017,terminalout,0); !.TTY FILL 0, please monitor no fill
43832 chars;
43840 allow_cr:= TRUE; infoton:= 1; vt52:= 2;
43880 minitec:= 3; elite:= 4; kthelite:= 5;
43920 newelite:= 6; newkthelite:= 7; teletec:= 8;
43960 sattelite:= 9; tandberg:= 10; beehive:= 11; cdc71310s:= 12;
44000 cdc71310p:= 13; elite3025:= 14; elite1521:= 15;
44040 volkerd404:= 16; volkerd414:= 17; buginfoton:= 18;
44080 i200:= 19;
44120
44160 cpunumber:= gettab(8r11,8r20); ! Get CPU number from monitor tables;
44200 IF cpunumber = 1215 !QZ computer centre in Stockholm; THEN
44240 BEGIN
44280 ttyqz:= trmop(8r1777,terminalout,1) = 1 !.TTY QZ = TRUE;;
44320 ttyzq:= trmop(8r1776,terminalout,1) = 1 !.TTY ZQ = TRUE;;
44360 END;
44400 IF sysout.image.length < width THEN sysout.image:-
44440 blanks(width);
44480 IF sysin.image.length < width THEN sysin.image:-
44520 blanks(width);
44600 restorechar:= altmode:= char(27); linefeed:= char(10);
44640 bell:= char(7); verttab:= char(11); null:= char(0);
44680 delayer:=
44720 fill:= char(127); tab:= char(9); carriagereturn:= char(13);
44760 formfeed:= char(12);
44800 INSPECT terminalout DO INSPECT terminalin DO
44840 BEGIN CHARACTER c; TEXT typec; BOOLEAN tmpfound;
44880 IF FALSE THEN bad:
44920 BEGIN
44960 outtext("I cannot cope with your terminal specification."
45000 ); outimage; terminaltype:= 0;
45040 END;
45080 COMMENT%IFNOT MVISTA;
45120 IF terminaltype = 0 THEN
45160 asktype:
45200 INSPECT NEW termty DO
45240 BEGIN
45280 otherdisplay:= termtype;
45320 IF extraterminal =/= NOTEXT THEN
45360 BEGIN termtype:= termtype+1;
45400 tr[termtype]:- storbokstav(extraterminal);
45440 END;
45480 maxterminals:= termtype+1;
45520 typec:- tmpin("TRM",FALSE); ! TMP:TRM may give terminal type;
45560 IF typec =/= NOTEXT THEN
45600 BEGIN typec:- scanto(typec,carriagereturn);
45640 tmpfound:= TRUE;
45680 END ELSE
45720 BEGIN
45760 ! Ask the terminal user about terminal type;
45800 again: outchr(terminalout,formfeed,1); outimage; outimage;
45840 asktype2:
45880 type_menu; IF extraterminal =/= NOTEXT THEN
45920 BEGIN outtext(extraterminal); outtext(", ");
45960 END;
46000 outtext("(Other) display."); outimage; outtext(
46040 "Switches: /DCA or /-DCA = Direct Cursor Adressing,"
46080 "/ALF or /-ALF = Auto LF"); outimage;
46120 inloop: outchr(sysout,'*',1); forceout(sysout);
46160 inimage; typec:- sysin.image.strip;
46200 IF typec == NOTEXT THEN GOTO inloop;
46240 END;
46280 typec:- storbokstav(typec);
46320 IF NOT tmpfound THEN tmpout("TRM",typec);
46360 ts:- scanto(typec,'/');
46400 IF NOT meny(ts,terminaltype,tr,maxterminals-1) THEN
46440 BEGIN outtext(IF terminaltype = -1 THEN
46480 "Your answer was ambiguous!" ELSE
46520 "The computer did not understand!"); outimage;
46560 GOTO asktype2;
46600 END;
46640 sysin.setpos(0);
46680 END of asktype;
46720 COMMENT%IFEND MVISTA;
46760 zeroterminal: IF terminaltype = 0 OR
46800 terminaltype = otherdisplay THEN
46840 BEGIN
46880 terminaltype:= otherdisplay;
46920 outtext(
46960 "Push the following keys in sequence on your terminal:"
47000 ); outimage;
47040 outtext(
47080 "Cursor down, cursor up, cursor right, cursor left,");
47120 outimage;
47160 outtext("cursor home, erase screen, carriage return.");
47200 outimage;
47240 extraparameters:- blanks(20);
47280 loop: c:= getch; IF c NE carriagereturn THEN
47320 BEGIN extraparameters.putchar(c); GOTO loop;
47360 END;
47400 extraparameters:-
47440 extraparameters.sub(1,extraparameters.pos-1);
47480 c:= getch; IF extraparameters = NOTEXT THEN GOTO bad;
47520 terminaltype:= maxterminals-1;
47560 END;
47600 IF terminaltype = maxterminals-1
47640 AND extraparameters =/= NOTEXT THEN
47680 BEGIN
47720 CHARACTER PROCEDURE find;
47760 BEGIN IF NOT extraparameters.more THEN GOTO bad;
47800 c:= extraparameters.getchar;
47840 IF c = altmode THEN
47880 BEGIN addaltmode:= TRUE;
47920 IF NOT extraparameters.more THEN GOTO bad;
47960 c:= extraparameters.getchar;
48000 END ELSE IF addaltmode THEN halfaltmode:= TRUE;
48040 find:= c;
48080 END;
48120 extraparameters.setpos(1);
48160 down:= find; up:= find; right:= find; left:= find;
48200 home:= find; erasescreen:= find;
48240 END ELSE
48280 IF terminaltype = infoton OR terminaltype = sattelite
48320 OR terminaltype = buginfoton THEN
48360 BEGIN COMMENT Infoton Vista Standard or VISTAR Sattelite;
48400 IF terminaltype NE buginfoton THEN
48440 BEGIN line_erasable:= TRUE; eraseline:= char(11);
48480 END;
48520 trmop(8r2006,terminalout,1); ! .TTY FORM;
48560 IF terminaltype = infoton THEN
48600 BEGIN
48640 startblink:= char(31); stopblink:= char(15);
48680 END ELSE startblink:= stopblink:= ' ';
48720 up:= char(28); down:= char(29); right:= char(25);
48760 left:= char(26); home:= char(8); erasescreen:= char(12);
48800 END ELSE IF terminaltype = vt52 THEN
48840 BEGIN COMMENT VT52;
48880 outtext("Maybe down and up, left and right are reversed?");
48920 outimage;
48960 address_screen:= 'Y';
49000 startblink:= stopblink:= char(0);
49040 COMMENT does not work on VT52;
49080 addaltmode:= TRUE;
49120 ! maybe just the opposite in the line below?;
49160 down:= 'A'; up:= 'B'; left:= 'C'; right:= 'D';
49200 home:= 'H'; erasescreen:= 'J';
49240 END ELSE IF terminaltype = minitec OR terminaltype = teletec
49280 THEN
49320 BEGIN COMMENT minitec 2402 or teletec;
49360 trmop(8r2006,terminalout,1); ! .TTY FORM;
49400 IF terminaltype = minitec THEN
49440 BEGIN
49480 address_screen:= 'F';
49520 startblink:= char(16r42); stopblink:= char(16r53);
49560 erasescreen:= char(28);
49600 END ELSE erasescreen:= char(12);
49640 up:= char(11); down:= char(10); right:= char(31);
49680 left:= char(8); home:= char(30);
49720 END ELSE IF terminaltype = elite OR terminaltype = kthelite
49760 THEN
49800 BEGIN
49840 BEGIN elitecursors:- copy("`abcdefghijklmnop"
49880 "qrstuvwxyz{|}~5@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ !""#"
49920 "$%&'()*+,-./");
49960 depchar(elitecursors,32,fill);
50000 address_screen:= formfeed;
50040 COMMENT%IFNOT MVISTA;
50080 trmop(8R2006,sysout,1); ! Since address_screen=ff;
50120 COMMENT%IFEND MVISTA;
50160 END;
50200 up:= char(26); down:= char(10);
50240 right:= char(28); left:= char(8);
50280 home:= char(2); erasescreen:= char(31);
50320 startblink:= char(14);
50360 stopblink:= ' '; !in reality = home;
50400 END ELSE IF terminaltype = newelite OR terminaltype =
50440 newkthelite OR terminaltype = elite1521 THEN
50480 BEGIN
50520 IF terminaltype = elite1521 THEN
50560 BEGIN lowintens:= char(4); highintens:= char(24);
50600 END;
50640 address_screen:= char(30);
50680 up:= char(31); down:= char(10);
50720 right:= char(28); left:= char(8);
50760 home:= char(25); erasescreen:= char(12);
50800 startblink:= char(14);
50840 stopblink:= ' '; !in reality = home;
50880 line_erasable:= TRUE; eraseline:= char(29);
50920 END ELSE IF terminaltype = tandberg THEN
50960 BEGIN
51000 highintens:= char(15);
51040 lowintens:= char(14);
51080 trmop(8R2005,terminalout,1);!.TTY TAB;
51120 tab:= char(30);
51160 up:= char(28); down:= char(11); left:= char(8);
51200 right:= char(9);
51240 home:= char(29); erasescreen:= char(25);
51280 END ELSE IF terminaltype = beehive THEN
51320 BEGIN
51360 addaltmode:= TRUE;
51400 up:= 'A'; down:= 'B'; left:= 'D'; right:= 'C';
51440 home:= 'H'; erasescreen:= 'E';
51480 startblink:= 'l'; stopblink:= 'm';
51520 address_screen:= 'F';
51560 END ELSE IF terminaltype = cdc71310s OR
51600 terminaltype = cdc71310p THEN
51640 BEGIN
51680 up:= char(26); down:= linefeed;
51720 left:= char(8); right:= char(21);
51760 startblink:= char(14); stopblink:= char(15);
51800 home:= char(25); ! lower left corner for cdc71310s;
51840 erasescreen:= char(24);
51880 delayer:= char(0);
51920 END ELSE IF terminaltype = elite3025 THEN
51960 BEGIN
52000 highintens:= char(49); lowintens:= char(48);
52040 startblink:= char(16r34); stopblink:= char(16r30);
52080 line_erasable:= TRUE;
52120 addaltmode:= halfaltmode:= TRUE;
52160 up:= 'A'; down:= linefeed; right:= 'C';
52200 left:= char(8); home:= 'H';
52240 erasescreen:= 'J'; eraseline:= 'K';
52280 ! line_insertable:= TRUE; ! not yet working;
52320 deleteline:- blanks(5);
52360 deleteline.putchar(altmode); deleteline.putchar('P');
52400 deleteline.putchar(up); deleteline.putchar(altmode);
52440 deleteline.putchar('Q'); ! wrong, dont know;
52480 insertline:- copy(deleteline);
52520 insertline.setpos(3); insertline.putchar(down);
52560 address_screen:= 'Y';
52600 END ELSE
52640 IF terminaltype = i200 THEN
52680 BEGIN
52720 home:= char(26); up:= char(28); down:= char(29);
52760 left:= char(8); right:= char(25);
52800 erasescreen:= formfeed;
52840 ! not eraseline always blanks the whole line;
52880 line_erasable:= TRUE; eraseline:= char(11);
52920 address_screen:= char(23);
52960 END ELSE
53000 IF terminaltype = volkerd404 THEN
53040 BEGIN
53080 home:= char(25);
53120 up:= char(26); down:= linefeed;
53160 left:= char(8); right:= char(21);
53200 eraseline:= char(22); erasescreen:= char(24);
53240 line_erasable:= TRUE;
53280 address_screen:= char(16);
53320 END ELSE GOTO bad;
53360
53400 COMMENT%IFNOT MVISTA;
53440 IF NOT typec.more THEN ! no / in user given terminal type;
53480 BEGIN typec:- storbokstav(extraparameters);
53520 GOTO scanslash;
53560 END;
53600 WHILE typec.pos + 2 <= typec.length DO
53640 BEGIN leftimage:- typec.sub(typec.pos,3);
53680 IF leftimage = "DCA" THEN direct_cursor_addressing:= TRUE
53720 ELSE IF leftimage = "-DC" THEN direct_cursor_addressing:= FALSE
53760 ELSE IF leftimage = "ALF" THEN allow_cr:= FALSE
53800 ELSE IF leftimage = "-AL" THEN allow_cr:= TRUE;
53840 scanslash: scanto(typec,'/');
53880 END;
53920 COMMENT%IFEND MVISTA;
53960
54000 q_display_output:= TRUE;
54040 echo(terminalin,IF q_echoenabled THEN 4 ELSE 2);
54080 leftimage:- blanks(terminalin.length);
54120 depchar(leftimage,1,left);
54160 terminalout.linesperpage(-1);
54200 trmop(8r2010,terminalout,1); ! .TTY NO CRLF;
54240 widthm1:= width-1; heightm1:= height-1;
54280 FOR q_verticalpos:= heightm1 STEP -1 UNTIL 0 DO
54320 screen[q_verticalpos]:- blanks(width);
54360 blank_the_screen;
54400 END;
54440 COMMENT%IF MVISTA
54480 END OF CLASS mvistax;
54520 END OF CLASS vista;