Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/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;