Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0135/vista.sim
There are 6 other files named vista.sim in the archive. Click here to see a list.
00010	OPTIONS(/e/l); COMMENT package for control of display terminals;
00020	COMMENT COMMENT%IF SIMULATION marks places to be modified to put
00030	vista as a sublcass to simulation;
00040	COMMENT COMMENT%IF MVISTA marks places to give simplified
00050	minivista for use by VIDED package;
00060	EXTERNAL CHARACTER PROCEDURE getch, fetchar;
00070	EXTERNAL PROCEDURE depchar, outstring, forceout;
00080	EXTERNAL PROCEDURE echo, abort, outchr;
00090	EXTERNAL INTEGER PROCEDURE trmop, gettab, checkint;
00100	COMMENT%IFNOT MVISTA;
00110	EXTERNAL INTEGER PROCEDURE checkreal;
00120	COMMENT%IFNOT SIMULATION;
00130	CLASS vista
00140	COMMENT%IF MVISTA
00150	CLASS mvista
00160	COMMENT%IFEND MVISTA
00170	COMMENT%IF SIMULATION
00180	Simulation CLASS vistas
00190	COMMENT%IFEND SIMULATION;
00200	(width, height, terminalin, terminalout, q_echoenabled,
00210	terminaltype, extraterminal,  extraparameters);
00220	VALUE extraterminal;
00230	INTEGER width, height; ! Screen dimensions or less;
00240	BOOLEAN q_echoenabled; ! TRUE = monitor echo, FALSE = program echo;
00250	INTEGER terminaltype; ! Number of terminal type, 0 for not given;
00260	REF (printfile) terminalout; ! To the terminal, usually sysout;
00270	REF (infile) terminalin; ! From the terminal, usually sysin;
00280	TEXT extraterminal; ! Text name of additional terminal type;
00290	TEXT extraparameters; ! Cursor control codes for this terminal type;
00300	
     	
00310	
00320	
00330	
00340	
00350	
00360	NOT HIDDEN PROTECTED q_echoenabled, q_display_output, terminalin,
00370	terminalout, synka, terminaloutimage, cpunumber, vt52, minitec,
00380	elite, kthelite, infoton, newelite, newkthelite, teletec, sattelite,
00390	tandberg, beehive, cdc71310s, cdc71310p,
00400	get_char_from_screen, scrollallow, echon, echoff,
00410	q_gotchar, cancel_display, extraparameters, synchronize,  allow_cr,
00420	home_the_cursor, set_char_on_screen, erasescreen, outchar,
00430	outimage, outtext, make_blank, insingle, move_the_cursor_to,
00440	blank_the_screen, stopblink, startblink, bell, q_verticalpos,
00450	q_horizontalpos, up, down, left, right, altmode, restorechar,
00460	carriagereturn, linefeed, home, fill, null, tab, formfeed, verttab,
00470	terminaltype, screen, badscreen, controlchar, addaltmode, height,
00480	heightm1, width, widthm1, resume_display;
00490	COMMENT%IF MVISTA pointers for efficient CALL sequencing
00500	NOT HIDDEN PROTECTED q_insingle, p_q_insingle, p_insingle;
00510	COMMENT%IFNOT MVISTA;
00520	NOT HIDDEN PROTECTED stop_blink, start_blink, cause_real_time_delay,
00530	restore_the_whole_screen, blank_line, displaying, outint, outfrac,
00540	outreal, outfix, restore_one_char, inreal, inint, inimage, inyes,
00550	inword, verticalpos, horizontalpos, echoenabled, delayer;
00560	COMMENT%IFEND MVISTA;
00570	COMMENT%IF SIMULATION
00580	NOT HIDDEN Linkage, Link, Head, Process, Time, Current, Passivate,
00590	Wait, Hold , Cancel, Accum, Main;
00600	COMMENT%IFEND SIMULATION;
00610	
     	
00620	
00630	COMMENT%IF MVISTA COMMENT VIDED special kind of screen restore
00640	NOT HIDDEN PROTECTED restore_the_whole_screen;
00650	COMMENT%IF MVISTA
00660	VIRTUAL: PROCEDURE restore_the_whole_screen;
00670	COMMENT%IFEND MVISTA;
00680	BEGIN
00690	BOOLEAN scrollallow; ! Allow <LF> to scroll the screen;
00700	BOOLEAN direct_cursor_adressing; ! Move cursor that way;
00710	BOOLEAN allow_cr; ! Allow sending of <CR> code to the terminal;
00720	BOOLEAN synka; ! Cursor may be at wrong place on terminal screen;
00730	INTEGER cpunumber; ! From monitor tables;
00740	INTEGER vt52; ! code for DEC VT52 terminal type;
00750	INTEGER minitec; ! code for TEC minitec terminal type;
00760	INTEGER elite; ! code for elite 2500 with auto-<LF> at <CR>;
00770	INTEGER kthelite; ! code for elite 2500 without auto-<LF> at <CR>;
00780	INTEGER infoton; ! code for infoton vista terminal type;
00790	INTEGER newelite; ! code for elite 1500 with auto-<LF> at <CR>;
00800	INTEGER newkthelite; ! code for elite 1500 without auto-<LF> at <CR>;
00810	INTEGER teletec; ! code for TEC teletec terminal type;
00820	INTEGER sattelite; ! code for INFOTON vistar sattelite;
00830	INTEGER tandberg; ! code for TANDBERG TDV 2000 terminal type;
00840	INTEGER beehive; ! code for minibee and BEEHIVE B 100 terminals;
00850	INTEGER cdc71310s; ! CDC 713-10 terminals, scroll mode;
00860	INTEGER cdc71310p; ! CDC 713-10 terminals, page mode;
00870	CHARACTER up, left, right, down; ! cursor movement codes;
00880	CHARACTER formfeed; ! ASCII character;
00890	CHARACTER home; ! code to move cursor to upper left screen corner;
00900	! ON CDC 713-10, this code moves to the lower left screen corner;
00910	CHARACTER carriagereturn; ! ASCII character;
00920	CHARACTER altmode; ! ASCII ESCAPE character, decimal 27;
00930	CHARACTER restorechar; ! code which, when given from terminal,
00940	causes screen to be restored (usually = altmode);
00950	CHARACTER linefeed; ! ASCII character;
00960	CHARACTER verttab; ! ASCII vertical tab character;
00970	CHARACTER null; ! ASCII character with decimal 0 value;
00980	CHARACTER tab; ! ASCII horizontal tab (HT) character;
00990	CHARACTER q_gotchar; ! Character inputted from the terminal;
01000	CHARACTER startblink; ! Code to start blinking on terminal screen;
01010	CHARACTER bell; ! ASCII character;
01020	CHARACTER stopblink; ! Code to stop blinking on terminal screen;
01030	CHARACTER fill; ! Character with decimal value 127, RUB OUT code;
01040	BOOLEAN addaltmode; ! Terminal control codes to be preceded by ESC;
01050	INTEGER maxterminals; ! 1 more than highest terminal type number;
01060	CHARACTER erasescreen; ! Code to make the whole screen blank;
01070	CHARACTER address_screen; ! Code to start direct cursor adressing;
01080	INTEGER q_verticalpos; ! Current cursor position vertically;
01090	INTEGER q_horizontalpos; ! Current cursor position horizontally;
01100	INTEGER widthm1; ! One less than screen width;
01110	INTEGER heightm1; ! One less than screen height;
01120	TEXT ARRAY screen[0:height-1]; ! Internal copy of screen contents;
01130	TEXT leftimage; ! Image with left code in first position;
01140	TEXT elitecursors; ! Direct cursor adress table for elite terminals;
01150	TEXT terminaloutimage; ! image of terminal output file;
01160	BOOLEAN q_display_output; ! Screen is to be output to the terminal;
01170	BOOLEAN badscreen; ! Terminal screen may be jumbled;
01180	BOOLEAN controlchar; ! Last input char was terminal control code;
01190	BOOLEAN ttyqz; ! Local for QZ computer centre;
01200	BOOLEAN ttyzq; ! Local for QZ computer centre;
01210	REF (printfile) termline; ! Terminal output file;
01220	COMMENT%IF MVISTA
01230	REF (q_insingle) p_q_insingle; ! CALLing class faster than       ;
01240	COMMENT%IF MVISTA
01250	REF (insingle) p_insingle; !     procedure call;
01260	COMMENT%IFEND MVISTA;
01270	COMMENT%IFNOT MVISTA;
01280	CHARACTER delayer;
01290	COMMENT%IFEND MVISTA;
     
01300	COMMENT%IFNOT mvista;
01310	
01320	INTEGER PROCEDURE horizontalpos; horizontalpos:= q_horizontalpos;
01330	COMMENT to stop users changing the internal variable with
01340	the current horizontal cursor position;
01350	
01360	INTEGER PROCEDURE verticalpos; verticalpos:= q_verticalpos;
01370	COMMENT current vertical cursor position;
01380	
01390	BOOLEAN PROCEDURE echoenabled; echoenabled:= q_echoenabled;
01400	COMMENT to stop users changing the internal variable telling
01410	if input chars are echoed by the program or the monitor;
01420	
01430	BOOLEAN PROCEDURE displaying; displaying:= q_display_output;
01440	COMMENT to stop users chaning the internal variable telling
01450	if picture is to be displayed on the terminal screen;
01460	
01470	COMMENT%IFEND mvista;
     
01480	PROCEDURE echon;
01490	BEGIN COMMENT to start monitor echoing of input characters;
01500	  !z_t(1); !z_t(-2); q_echoenabled:= TRUE;
01510	  IF q_display_output THEN echo(terminalin,4);
01520	END;
01530	
01540	PROCEDURE echoff;
01550	BEGIN COMMENT to start program echoing of input characters;
01560	  !z_t(-1); !z_t(2); q_echoenabled:= FALSE;
01570	  IF q_display_output THEN echo(terminalin,2);
01580	END;
     
01590	PROCEDURE resume_display;
01600	COMMENT to start displaying the picture on the terminal screen;
01610	IF NOT q_display_output THEN
01620	BEGIN !z_t(3); !z_t(-4); q_display_output:= TRUE;
01630	  restore_the_whole_screen;
01640	  echo(terminalin,IF q_echoenabled THEN 4 ELSE 2);
01650	END;
01660	
01670	PROCEDURE cancel_display;
01680	COMMENT to stop displaying the picture on the terminal screen;
01690	IF q_display_output THEN
01700	BEGIN !z_t(-3); !z_t(4); IF addaltmode THEN
01710	  COMMENT erase screen;
01720	  outchr(termline,altmode,1); outchr(termline,home,1);
01730	  IF addaltmode THEN outchr(termline,altmode,1);
01740	  outchr(termline,erasescreen,1);
01750	  forceout(terminalout);
01760	  q_display_output:= FALSE;
01770	  echo(terminalin,4);
01780	END;
     
01790	COMMENT%IFNOT MVISTA;
01800	PROCEDURE cause_real_time_delay(number_of_fillers);
01810	  COMMENT: Causes a moving picture on the screen to move slower by
01820	  outputting a number_of_fillers. Example: If the speed of the
01830	  terminal is 240 characters/second, then cause_real_time_delay(120)
01840	  will cause a 0.5 seconds delay;
01850	INTEGER number_of_fillers;
01860	IF q_display_output THEN
01870	outchr(termline,delayer,number_of_fillers);
01880	COMMENT%IFEND MVISTA;
     
01890	CHARACTER PROCEDURE get_char_from_screen(h, v);
01900	  COMMENT: If (h,v) indicates a position on the screen, then the
01910	  character in that position is returned. If (h, v) indicates a
01920	  position outside the screen, then char(0) is returned;
01930	INTEGER h, v;
01940	IF v >= 0 AND v <= height THEN
01950	BEGIN
01960	  get_char_from_screen:= fetchar(screen(v),h+1);
01970	END;
     
01980	COMMENT%IFNOT MVISTA;
01990	
02000	PROCEDURE start_blink;
02010	  COMMENT will start blinking screen text and output a a space on
02020	  the screen;
02030	BEGIN COMMENT on infoton terminals, blinking text is between start
02040	  blink and stop blink codes on the screen. On most other terminals,
02050	  blinking text is text sent between sending start blink and stop
02060	  blink codes to the terminal;
02070	  IF terminaltype = infoton OR terminaltype = cdc71310s
02080	  OR terminaltype = cdc71310p THEN
02090	  outchar(startblink) ELSE outchar(' ');
02100	  IF terminaltype = minitec OR terminaltype = beehive THEN
02110	  BEGIN outchr(termline,altmode,1);
02120	    outchr(termline,startblink,1);
02130	  END ELSE IF terminaltype >= elite
02140	  AND terminaltype <= newkthelite
02150	  THEN outchr(termline,startblink,1);
02160	  outchr(termline,bell,1);
02170	END;
02180	COMMENT%IFEND MVISTA;
     
02190	COMMENT%IFNOT MVISTA;
02200	
02210	PROCEDURE stop_blink;
02220	  COMMENT will stop blinking screen text and output a a space on the
02230	  screen;
02240	BEGIN
02250	  IF terminaltype = infoton OR terminaltype = cdc71310s
02260	  OR terminaltype = cdc71310p THEN
02270	  outchar(stopblink) ELSE outchar(' ');
02280	  IF terminaltype = minitec OR terminaltype = beehive THEN
02290	  BEGIN outchr(terminalout,altmode,1);
02300	    outchr(terminalout,stopblink,1);
02310	  END ELSE IF terminaltype >= elite
02320	  AND terminaltype <= newkthelite
02330	  THEN synchronize(q_horizontalpos,q_verticalpos);
02340	END;
02350	COMMENT%IFEND MVISTA;
     
02360	PROCEDURE synchronize(hnew, vnew);
02370	  COMMENT: If there is a risk that the program does not know where
02380	  the cursor is on the screen, then this procedure will anyway for
02390	  sure move the cursor to the position (hnew, vnew);
02400	INTEGER hnew, vnew;
02410	IF q_display_output THEN
02420	BEGIN
02430	  IF NOT direct_cursor_adressing THEN local_home_the_cursor;
02440	  move_the_cursor_to(hnew,vnew);
02450	END;
     
02460	COMMENT%IFNOT MVISTA;
02470	PROCEDURE restore_the_whole_screen;
02480	  COMMENT: If the picture of the screen has been destroyed, then a
02490	  call to this procedure will make the picture on the screen equal
02500	  to the internal picture in the program;
02510	IF q_display_output THEN
02520	INSPECT terminalout DO
02530	BEGIN
02540	  INTEGER h, v, hold, vold;
02550	  hold:= q_horizontalpos; vold:= q_verticalpos;
02560	  echo(terminalin,IF q_echoenabled THEN 4 ELSE 2);
02570	  home_the_cursor; breakoutimage;
02580	  IF addaltmode THEN outchr(termline,altmode,1);
02590	  outchr(termline,erasescreen ,1);
02600	  q_horizontalpos:= q_verticalpos:= 0;
02610	  FOR v:= 0 STEP 1 UNTIL heightm1 DO
02620	  BEGIN
02630	    IF screen[v].strip =/= NOTEXT THEN
02640	    BEGIN
02650	      IF allow_cr THEN outchr(terminalout,carriagereturn,1)
02660	      ELSE home_the_cursor;
02670	      move_the_cursor_to(0,v); breakoutimage;
02680	      outstring(terminalout,screen[v].strip);
02690	    END;
02700	  END;
02710	  synchronize(hold,vold);
02720	END;
02730	COMMENT%IFEND MVISTA;
     
02740	PROCEDURE true_outchr(c); CHARACTER c;
02750	BEGIN
02760	  COMMENT at the QZ computer centre, certain national characters are
02770	  sometimes converted by the monitor before transmitting them to the
02780	  terminal. This will cause errors if these characters are used for
02790	  direct cursor adressing. This procedure makes the inverse
02800	  conversion first, so that the correct code will be output;
02810	  IF ttyqz THEN
02820	  BEGIN IF ttyzq THEN
02830	    BEGIN
02840	      IF c = char(00035) THEN c:= char(124) ELSE
02850	      IF c = char(00036) THEN c:= char(126) ELSE
02860	      IF c = char(00064) THEN c:= char(92) ELSE
02870	      IF c = char(00091) THEN c:= char(35) ELSE
02880	      IF c = char(00092) THEN c:= char(64) ELSE
02890	      IF c = char(00093) THEN c:= char(36) ELSE
02900	      IF c = char(00096) THEN c:= char(91) ELSE
02910	      IF c = char(00124) THEN c:= char(96) ELSE
02920	      IF c = char(00126) THEN c:= char(93);
02930	    END ELSE
02940	    BEGIN
02950	      IF c = char(00035) THEN c:= char(91) ELSE
02960	      IF c = char(00036) THEN c:= char(93) ELSE
02970	      IF c = char(00064) THEN c:= char(92) ELSE
02980	      IF c = char(00091) THEN c:= char(35) ELSE
02990	      IF c = char(00092) THEN c:= char(64) ELSE
03000	      IF c = char(00093) THEN c:= char(36) ELSE
03010	      IF c = char(00096) THEN c:= char(124) ELSE
03020	      IF c = char(00124) THEN c:= char(96);
03030	    END;
03040	  END ELSE IF ttyzq THEN
03050	  BEGIN
03060	    IF c = char(00035) THEN c:= char(96) ELSE
03070	    IF c = char(00036) THEN c:= char(126) ELSE
03080	    IF c = char(00096) THEN c:= char(35) ELSE
03090	    IF c = char(00126) THEN c:= char(36);
03100	  END;
03110	  outchr(termline,c,1);
03120	END of procedure true_outchr;
     
03130	PROCEDURE move_the_cursor_to(horiz, vertic);
03140	  COMMENT: Will move the cursor to the position(horiz, vertic) on
03150	  the screen;
03160	INTEGER horiz, vertic;
03170	BEGIN
03180	  INTEGER i;
03190	  !z_t(5);
03200	  COMMENT%IFNOT MVISTA;
03210	  IF q_display_output THEN
03220	  COMMENT%IFEND MVISTA;
03230	  BEGIN
03240	    COMMENT%IFNOT MVISTA;
03250	    IF badscreen THEN
03260	    BEGIN badscreen:= FALSE; restore_the_whole_screen;
03270	    END;
03280	    COMMENT%IFEND MVISTA;
03290	    IF direct_cursor_adressing THEN
03300	    BEGIN
03310	      IF terminaltype = vt52 OR terminaltype = beehive THEN
03320	      BEGIN
03330	        outchr(termline,altmode,1);
03340	        outchr(termline,address_screen,1);
03350	        true_outchr(char(8r040+vertic));
03360	        true_outchr(char(8r040+horiz));
03370	      END ELSE IF terminaltype = minitec THEN
03380	      BEGIN
03390	        outchr(termline,altmode,1);
03400	        outchr(termline,address_screen,1);
03410	        true_outchr(char(127-horiz));
03420	        true_outchr(char(127-vertic));
03430	      END ELSE IF terminaltype >= elite
03440	      AND terminaltype <= kthelite THEN
03450	      BEGIN
03460	        outchr(termline,address_screen,1);
03470	        true_outchr(fetchar(elitecursors,horiz+1));
03480	        true_outchr(fetchar(elitecursors,vertic+1));
03490	      END ELSE IF terminaltype = newelite
03500	      OR terminaltype = newkthelite THEN
03510	      BEGIN
03520	        outchr(termline,address_screen,1);
03530	        true_outchr(char(8r040+horiz));
03540	        true_outchr(char(8r040+vertic));
03550	      END;
03560	      GOTO moved;
03570	    END;
03580	    IF terminaltype = tandberg THEN
03590	    BEGIN COMMENT TANDBERG TDV 2000 is funny on last screen line;
03600	      IF q_verticalpos = heightm1 AND vertic < heightm1 THEN
03610	      BEGIN outchr(termline,home,1);
03620	        q_horizontalpos:= q_verticalpos:= 0;
03630	      END;
03640	    END;
03650	    IF horiz < q_horizontalpos//2 THEN
03660	    BEGIN
03670	      q_horizontalpos:= 0;
03680	      IF allow_cr AND vertic > q_verticalpos//2 THEN
03690	      outchr(termline,carriagereturn,1) ELSE
03700	      BEGIN
03710	        IF addaltmode THEN outchr(terminalout,altmode,1)
03720	        ELSE outchr(terminalout,home,1);
03730	        outchr(termline,home,1);
03740	        IF terminaltype = cdc71310s THEN q_verticalpos:= heightm1
03750	        ELSE q_verticalpos:= 0;
03760	      END;
03770	    END;
03780	    IF addaltmode THEN
03790	    BEGIN
03800	      FOR i:= horiz+1 STEP 1 UNTIL q_horizontalpos DO
03810	      BEGIN outchr(termline,altmode,1);
03820	        outchr(termline,left,1);
03830	      END;
03840	      FOR i:= q_horizontalpos+1 STEP 1 UNTIL horiz DO
03850	      BEGIN outchr(termline,altmode,1);
03860	        outchr(termline,right,1);
03870	      END;
03880	      FOR i:= vertic+1 STEP 1 UNTIL q_verticalpos DO
03890	      BEGIN outchr(termline,altmode,1);
03900	        outchr(termline,up,1);
03910	      END;
03920	      FOR i:= q_verticalpos+1 STEP 1 UNTIL vertic DO
03930	      BEGIN outchr(termline,altmode,1);
03940	        outchr(termline,down,1);
03950	      END;
03960	    END ELSE
03970	    BEGIN
03980	      outchr(termline,right,horiz-q_horizontalpos);
03990	      outchr(termline,left,q_horizontalpos-horiz);
04000	      outchr(termline,down,vertic-q_verticalpos);
04010	      outchr(termline,up,q_verticalpos-vertic);
04020	    END;
04030	  END;
04040	  moved:
04050	  q_horizontalpos:= horiz; q_verticalpos:= vertic;
04060	  !z_t(-5);
04070	END;
     
04080	PROCEDURE set_char_on_screen(setchar,horiz,vertic);
04090	  COMMENT: Will output the character "setchar" onto the position
04100	  (horiz,vertic) on the screen;
04110	CHARACTER setchar; INTEGER horiz, vertic;
04120	BEGIN
04130	  move_the_cursor_to(horiz, vertic);
04140	  BEGIN
04150	    IF setchar = fill THEN setchar:= ' ' ELSE
04160	    IF setchar < ' ' THEN setchar:= ' ';
04170	    IF q_display_output THEN
04180	    BEGIN outchr(termline,setchar,1);
04190	      IF addaltmode THEN outchr(termline,altmode,1);
04200	      outchr(termline,left,1);
04210	    END;
04220	    depchar(screen[q_verticalpos],q_horizontalpos+1,setchar);
04230	  END;
04240	  IF q_horizontalpos = width THEN
04250	  BEGIN
04260	    synchronize(0,q_verticalpos+1);
04270	  END;
04280	END;
     
04290	PROCEDURE outchar(setchar);
04300	  COMMENT  Will output the character "setchar" onto the place where
04310	  the cursor is on the screen. Thereafter, the cursor is advanced to
04320	  the position after the outputted character;
04330	CHARACTER setchar;
04340	BEGIN
04350	  BEGIN
04360	    IF setchar = fill THEN setchar:= ' ' ELSE
04370	    IF setchar < ' ' THEN
04380	    BEGIN
04390	      IF terminaltype <= 2 THEN !infoton or vt52;
04400	      BEGIN
04410	        IF setchar NE startblink AND setchar NE stopblink
04420	        THEN setchar:= ' ' ELSE outchr(termline,bell,1);
04430	      END ELSE setchar:= ' ';
04440	    END;
04450	    IF q_display_output THEN outchr(termline,setchar,1);
04460	    depchar(screen[q_verticalpos],q_horizontalpos+1,setchar);
04470	  END;
04480	  q_horizontalpos:= q_horizontalpos+1;
04490	  IF q_horizontalpos = width THEN
04500	  BEGIN
04510	    synchronize(0,q_verticalpos+1);
04520	  END;
04530	END;
     
04540	COMMENT%IFNOT MVISTA;
04550	PROCEDURE blank_line(v); INTEGER v;
04560	COMMENT will make  line v blank on the screen;
04570	BEGIN
04580	  INTEGER blank_field;
04590	  blank_field:= screen(v).strip.length+1;
04600	  move_the_cursor_to(0,v); screen(v):= NOTEXT;
04610	  IF q_display_output THEN
04620	  BEGIN
04630	    outchr(termline,' ',blank_field);
04640	    IF allow_cr THEN outchr(termline,carriagereturn,1)
04650	    ELSE synchronize(0,v);
04660	  END;
04670	END;
04680	COMMENT%IFEND MVISTA;
     
04690	PROCEDURE outimage;
04700	  COMMENT: Will output any characters in the terminalout.image
04710	  buffer and will then move the cursor to the beginning of the
04720	  next line on the screen;
04730	INSPECT terminalout DO
04740	BEGIN
04750	  CHARACTER lastout;
04760	  IF q_display_output THEN
04770	  BEGIN
04780	    IF allow_cr AND terminaltype NE tandberg THEN
04790	    BEGIN outchr(terminalout,carriagereturn,1);
04800	      outchr(terminalout,linefeed,1);
04810	    END ELSE
04820	    BEGIN
04830	      move_the_cursor_to(0,q_verticalpos+1);
04840	      q_verticalpos:= q_verticalpos-1;
04850	    END;
04860	  END;
04870	  IF allow_cr OR NOT q_display_output THEN
04880	  q_verticalpos:= q_verticalpos+1;
04890	  IF q_verticalpos >= height THEN q_verticalpos:=
04900	  q_verticalpos-height;
04910	  q_horizontalpos:= 0;
04920	END;
     
04930	PROCEDURE outtext(t);
04940	COMMENT: Will output a text string onto the screen;
04950	NAME t; TEXT t;
04955	IF t.length+q_horizontalpos <= screen[q_verticalpos].length THEN
04960	BEGIN TEXT screenpart; ! part of screen to which t is to be output;
04970	  !z_t(6);
04980	  screenpart:- screen[q_verticalpos].
04990	  sub(q_horizontalpos+1,t.length);
05000	  screenpart:= t;
05010	  COMMENT%IFNOT MVISTA;
05020	  IF q_display_output THEN
05030	  COMMENT%IFEND MVISTA;
05040	  BEGIN
05050	    outstring(terminalout,screenpart);
05060	  END;
05070	  q_horizontalpos:= q_horizontalpos+t.length;
05080	  COMMENT%IFNOT MVISTA;
05090	  IF q_horizontalpos > widthm1 THEN
05100	  move_the_cursor_to(0,q_verticalpos);
05110	  COMMENT%IFEND MVISTA;
05120	  !z_t(-6);
05130	END;
     
05140	PROCEDURE make_blank(size); INTEGER size;
05150	  COMMENT will make part of the screen blank, beginning at the
05160	  current cursor position, and continuing size characters;
05170	BEGIN
05180	  TEXT notblankpart;
05190	  notblankpart:- screen[q_verticalpos]
05200	  .sub(q_horizontalpos+1,size).strip;
05210	  notblankpart:= NOTEXT;
05220	  IF q_display_output THEN
05230	  BEGIN
05240	    outchr(termline,' ',notblankpart.length);
05250	  END;
05260	  q_horizontalpos:= q_horizontalpos+notblankpart.length;
05270	END;
     
05280	COMMENT%IFNOT MVISTA;
05290	PROCEDURE outfix(a,i,j); REAL a; INTEGER i, j;
05300	COMMENT similar to SIMULA outfix procedure;
05310	BEGIN
05320	  TEXT t;
05330	  t:- screen[q_verticalpos].sub(q_horizontalpos+1,j);
05340	  t.putfix(a,i);
05350	  IF q_display_output THEN
05360	  outstring(terminalout,t);
05370	  q_horizontalpos:= q_horizontalpos+j;
05380	  IF q_horizontalpos > widthm1 THEN
05390	  move_the_cursor_to(0,q_verticalpos);
05400	END;
05410	COMMENT%IFEND MVISTA;
     
05420	COMMENT%IFNOT MVISTA;
05430	PROCEDURE outreal(a,i,j); REAL a; INTEGER i, j;
05440	COMMENT similar to SIMULA outreal procedure;
05450	BEGIN
05460	  TEXT t;
05470	  t:- screen[q_verticalpos].sub(q_horizontalpos+1,j);
05480	  t.putreal(a,i);
05490	  IF q_display_output THEN
05500	  outstring(terminalout,t);
05510	  q_horizontalpos:= q_horizontalpos+j;
05520	  IF q_horizontalpos > widthm1 THEN
05530	  move_the_cursor_to(0,q_verticalpos);
05540	END;
05550	COMMENT%IFEND MVISTA;
     
05560	COMMENT%IFNOT MVISTA;
05570	PROCEDURE outfrac(a,i,j); INTEGER a, i, j;
05580	COMMENT similar to SIMULA outfrac procedure;
05590	BEGIN
05600	  TEXT t;
05610	  t:- screen[q_verticalpos].sub(q_horizontalpos+1,j);
05620	  t.putfrac(a,i);
05630	  IF q_display_output THEN
05640	  outstring(terminalout,t);
05650	  q_horizontalpos:= q_horizontalpos+j;
05660	  IF q_horizontalpos > widthm1 THEN
05670	  move_the_cursor_to(0,q_verticalpos);
05680	END;
05690	COMMENT%IFEND MVISTA;
     
05700	COMMENT%IFNOT MVISTA;
05710	PROCEDURE outint(i,j); INTEGER i, j;
05720	COMMENT similar to SIMULA outint procedure;
05730	BEGIN
05740	  TEXT t;
05750	  t:- screen[q_verticalpos].sub(q_horizontalpos+1,j);
05760	  t.putint(i);
05770	  IF q_display_output THEN
05780	  outstring(terminalout,t);
05790	  q_horizontalpos:= q_horizontalpos+j;
05800	  IF q_horizontalpos > widthm1 THEN
05810	  move_the_cursor_to(0,q_verticalpos);
05820	END;
05830	COMMENT%IFEND MVISTA;
     
05840	COMMENT%IFNOT MVISTA;
05850	PROCEDURE restore_one_char(horiz,vertic);
05860	  COMMENT: Will restore the character in the position (horiz,
05870	  vertic) to what the program believes is in that position on
05880	  the screen;
05890	INTEGER horiz, vertic;
05900	IF horiz >= 0 AND horiz < width AND vertic >= 0 AND
05910	vertic < height AND q_display_output THEN
05920	set_char_on_screen(get_char_from_screen(horiz,vertic),
05930	horiz,vertic);
05940	COMMENT%IFEND MVISTA;
     
05950	COMMENT%IF mvista
05960	CLASS q_insingle
05970	COMMENT%IFNOT mvista;
05980	PROCEDURE p_q_insingle
05990	(echo)
06000	COMMENT%IFEND MVISTA;
06010	;
06020	  COMMENT: Will input one character from the terminal without
06030	  waiting for a carriage return. Can also input "left"=^Z,
06040	  which cannot be input with inimage;
06050	COMMENT%IFNOT MVISTA;
06060	BOOLEAN echo;
06070	COMMENT%IFEND MVISTA;
06080	BEGIN
06090	  COMMENT%IF MVISTA
06100	  loop: detach;
06110	  COMMENT%IFNOT MVISTA;
06120	  IF NOT q_display_output THEN
06130	  abort("VISTA input without picture showing");
06140	  COMMENT%IFEND MVISTA;
06150	  q_gotchar:= getch;
06160	  IF q_gotchar = fill THEN
06170	  BEGIN
06180	    IF q_horizontalpos > 0 THEN
06190	    BEGIN
06200	      set_char_on_screen(' ',q_horizontalpos-1,
06210	      q_verticalpos);
06220	    END;
06230	  END;
06240	  IF
06250	  COMMENT%IFNOT MVISTA;
06260	  echo AND
06270	  COMMENT%IFEND MVISTA;
06280	  NOT q_echoenabled THEN
06290	  BEGIN IF q_gotchar = tab THEN q_gotchar:= ' ';
06300	    IF terminaltype NE tandberg THEN
06310	    outchr(termline,q_gotchar,1) ELSE
06320	    outchr(termline,
06330	    IF q_gotchar = linefeed AND q_horizontalpos < heightm1 THEN
06340	    down ELSE q_gotchar,1);
06350	  END;
06360	  COMMENT%IF MVISTA
06370	  GOTO loop;
06380	END;
     
06390	COMMENT%IFNOT MVISTA;
06400	CHARACTER PROCEDURE insingle(echo);
06410	BOOLEAN echo;
06420	COMMENT%IFEND MVISTA;
06430	COMMENT%IF MVISTA
06440	CLASS insingle;
06450	COMMENT%IFEND MVISTA;
06460	BEGIN
06470	COMMENT%IF MVISTA
06480	  mainloop: detach;
06490	  COMMENT%IFEND MVISTA;
06500	  !z_t(7);forceout(terminalout);
06510	  COMMENT%IF MVISTA
06520	  call(p_q_insingle);
06530	  COMMENT%IFNOT MVISTA;
06540	  p_q_insingle(echo);
06550	  COMMENT%IFEND MVISTA;
06560	  controlchar:= IF q_gotchar < ' ' THEN TRUE ELSE
06570	  IF q_gotchar = fill THEN TRUE ELSE FALSE;
06580	  IF terminaltype = infoton THEN
06590	  BEGIN
06600	    IF controlchar THEN
06610	    BEGIN IF q_gotchar = startblink OR q_gotchar = stopblink
06620	      THEN controlchar:= FALSE;
06630	    END;
06640	  END;
06650	  IF addaltmode THEN
06660	  BEGIN IF q_gotchar = altmode THEN
06670	    BEGIN
06680	      COMMENT%IF mvista
06690	      call(p_q_insingle);
06700	      COMMENT%IFNOT mvista;
06710	      p_q_insingle(echo);
06720	      COMMENT%IFEND MVISTA;
06730	      controlchar:= TRUE;
06740	    END;
06750	  END;
06760	  COMMENT%IFNOT MVISTA;
06770	  IF q_gotchar = restorechar OR q_gotchar = formfeed THEN
06780	  restore_the_whole_screen;
06790	  insingle:= q_gotchar;
06800	  COMMENT%IFEND MVISTA;
06810	  COMMENT%IFNOT MVISTA;
06820	  IF echo THEN
06830	  COMMENT%IFEND MVISTA;
06840	  BEGIN
06850	    IF NOT controlchar THEN
06860	    BEGIN COMMENT to be stored in screen;
06870	      depchar(screen[q_verticalpos],q_horizontalpos+1,
06880	      q_gotchar);
06890	      q_horizontalpos:= q_horizontalpos+1;
06900	      IF q_horizontalpos >= width THEN
06910	      BEGIN ! wrap cursor around at screen borders;
06920	        IF q_verticalpos < heightm1 THEN
06930	        synchronize(0,q_verticalpos+1) ELSE
06940	        COMMENT%IFNOT MVISTA;
06950	        IF scrollallow THEN
06960	        COMMENT%IFEND MVISTA;
06970	        BEGIN outchr(termline,linefeed,1);
06980	          synchronize(0,heightm1); badscreen:= TRUE;
06990	          COMMENT unwanted scrolling of screen has occured;
07000	        END
07010	        COMMENT%IFNOT MVISTA
07020	        ELSE synchronize(widthm1,heightm1);
07030	        COMMENT%IFEND MVISTA;
07040	      END;
07050	    END ELSE
07060	    BEGIN COMMENT not to be stored on the screen;
07070	      BEGIN COMMENT not printable AND echo;
07080	        IF q_gotchar = linefeed THEN
07090	        BEGIN
07100	          IF q_verticalpos < heightm1 THEN
07110	          BEGIN IF allow_cr THEN
07120	            BEGIN q_verticalpos:= q_verticalpos+1;
07130	              IF q_echoenabled THEN
07140	              BEGIN
07150	                IF terminaltype = tandberg THEN
07160	                BEGIN
07170	                  screen(q_verticalpos).sub(q_horizontalpos+1,
07180	                  width-q_horizontalpos):= NOTEXT;
07190	                END;
07200	              END;
07210	            END ELSE
07220	            synchronize(q_horizontalpos,q_verticalpos+1);
07230	          END
07240	          COMMENT%IFNOT MVISTA
07250	          ELSE
07260	          BEGIN
07270	            IF NOT scrollallow THEN restore_the_whole_screen;
07280	          END;
07290	          COMMENT%IFEND MVISTA;
07300	        END ELSE
07310	        IF q_gotchar = carriagereturn THEN
07320	        q_horizontalpos:= 0 ELSE
07330	        IF q_gotchar = up THEN
07340	        BEGIN IF q_verticalpos = 0 THEN
07350	          synchronize(q_horizontalpos,heightm1)
07360	          ELSE
07370	          BEGIN
07380	            IF terminaltype = tandberg THEN
07390	            BEGIN IF q_verticalpos = heightm1 THEN synka:= TRUE;
07400	            END;
07410	            q_verticalpos:= q_verticalpos-1;
07420	          END;
07430	        END ELSE
07440	        IF q_gotchar = down THEN
07450	        BEGIN IF q_verticalpos >= heightm1 THEN
07460	          synchronize(q_horizontalpos,0) ELSE
07470	          q_verticalpos:= q_verticalpos+1;
07480	        END ELSE
07490	        IF q_gotchar = left THEN
07500	        BEGIN IF q_horizontalpos = 0 THEN
07510	          synchronize(widthm1,q_verticalpos) ELSE
07520	          q_horizontalpos:= q_horizontalpos-1;
07530	        END ELSE
07540	        IF q_gotchar = right THEN
07550	        BEGIN IF q_horizontalpos >= widthm1 THEN
07560	          synchronize(0,q_verticalpos) ELSE
07570	          q_horizontalpos:= q_horizontalpos+1;
07580	        END ELSE
07590	        IF q_gotchar = home THEN
07600	        BEGIN q_horizontalpos:= 0;
07610	          IF terminaltype = cdc71310s THEN q_verticalpos:= heightm1
07620	          ELSE q_verticalpos:= 0;
07630	        END;
07640	        IF synka THEN
07650	        BEGIN IF (IF q_echoenabled THEN NOT trmop(8R0001,sysout,1) =
07660	          1 !=type ahead from the terminal has occured;
07670	          ELSE TRUE) THEN
07680	          BEGIN synka:= FALSE;
07690	            IF q_echoenabled THEN
07700	            synchronize(q_horizontalpos, q_verticalpos) ELSE
07710	            restore_the_whole_screen;
07720	          END;
07730	        END;
07740	      END not printable, but echo;;
07750	    END;
07760	  END;
07770	  !z_t(-7);
07780	  COMMENT%IF MVISTA
07790	  GOTO mainloop;
07800	  COMMENT%IFEND MVISTA;
07810	END;
     
07820	COMMENT%IFNOT MVISTA;
07830	PROCEDURE inimage;
07840	  COMMENT: Will input a line of text from the terminal into
07850	  the buffer terminalin.image;
07860	BEGIN
07870	  TEXT stripimage; CHARACTER c;
07880	  IF NOT q_display_output THEN
07890	  abort("VISTA input without picture showing");
07900	  readagain: forceout(terminalout);
07910	  IF q_echoenabled THEN terminalin.inimage ELSE
07920	  BEGIN
07930	    terminalin.image:= NOTEXT; terminalin.image.setpos(1);
07940	    loop: c:= insingle(TRUE);
07950	    IF c EQ carriagereturn OR c EQ null THEN GOTO
07960	    loop;
07970	    IF c EQ linefeed THEN GOTO out;
07980	    IF c = fill THEN
07990	    BEGIN
08000	      IF terminalin.pos > 1 THEN
08010	      BEGIN
08020	        terminalin.setpos(terminalin.pos-1);
08030	        depchar(terminalin.image,terminalin.pos,' ');
08040	      END;
08050	      GOTO loop;
08060	    END;
08070	    terminalin.image.putchar(c);
08080	    IF c EQ altmode OR c EQ formfeed OR c EQ verttab
08090	    THEN GOTO out;
08100	    GOTO loop;
08110	    out: terminalin.image.setpos(1);
08120	  END;
08130	  IF terminalin.endfile THEN
08140	  BEGIN
08150	    terminalin.close; terminalin:- NEW infile("*");
08160	    terminalin.open(copy(leftimage));
08170	  END;
08180	  IF q_echoenabled THEN
08190	  BEGIN
08200	    c:= fetchar(terminalin.image,1);
08210	    IF c = restorechar OR c = formfeed THEN
08220	    BEGIN
08230	      restore_the_whole_screen;
08240	      GOTO readagain;
08250	    END;
08260	    stripimage:- terminalin.image.strip;
08270	    IF stripimage.length > 0 THEN
08280	    FOR q_horizontalpos:= q_horizontalpos, q_horizontalpos+1
08290	    WHILE stripimage.more DO
08300	    BEGIN
08310	      depchar(screen[q_verticalpos],q_horizontalpos+1,
08320	      stripimage.getchar);
08330	      IF q_horizontalpos = width THEN
08340	      BEGIN
08350	        q_horizontalpos:= 0;
08360	        q_verticalpos:= q_verticalpos+1;
08370	      END;
08380	    END;
08390	    synchronize(q_horizontalpos, q_verticalpos);
08400	  END;
08410	END;
08420	COMMENT%IFEND MVISTA;
     
08430	COMMENT%IFNOT MVISTA;
08440	INTEGER PROCEDURE inint;
08450	COMMENT: Will search for and read an integer from the terminal;
08460	BEGIN
08470	  INTEGER vold, hold;
08480	  IF NOT q_display_output THEN
08490	  abort("VISTA input without picture showing");
08500	  forceout(terminalout);
08510	  vold:= q_verticalpos; hold:= q_horizontalpos; inimage;
08520	  WHILE checkint(terminalin.image) <= 0 DO
08530	  BEGIN
08540	    move_the_cursor(terminalin.image.strip.length+hold,
08550	    vold);
08560	    WHILE q_horizontalpos > hold DO
08570	    BEGIN
08580	      set_char_on_screen('?',q_horizontalpos-1,vold);
08590	    END;
08600	    move_the_cursor_to(hold,vold);
08610	    inimage;
08620	  END;
08630	  inint:= terminalin.image.getint;
08640	  synchronize(q_horizontalpos, q_verticalpos);
08650	END of inint;
08660	COMMENT%IFEND MVISTA;
     
08670	COMMENT%IFNOT MVISTA;
08680	REAL PROCEDURE inreal;
08690	COMMENT: Will search for and read an real from the terminal;
08700	BEGIN
08710	  INTEGER vold, hold;
08720	  IF NOT q_display_output THEN
08730	  abort("VISTA input without picture showing");
08740	  forceout(terminalout);
08750	  vold:= q_verticalpos; hold:= q_horizontalpos; inimage;
08760	  WHILE checkreal(terminalin.image) <= 0 DO
08770	  BEGIN
08780	    move_the_cursor(terminalin.image.strip.length+hold,
08790	    vold);
08800	    WHILE q_horizontalpos > hold DO
08810	    BEGIN
08820	      set_char_on_screen('?',q_horizontalpos-1,vold);
08830	    END;
08840	    move_the_cursor_to(hold,vold);
08850	    inimage;
08860	  END;
08870	  inreal:= terminalin.image.getreal;
08880	  synchronize(q_horizontalpos, q_verticalpos);
08890	END of inreal;
08900	COMMENT%IFEND MVISTA;
     
08910	COMMENT%IFNOT MVISTA;
08920	TEXT PROCEDURE inword;
08930	  COMMENT: Will search for and read a word from the terminal.
08940	  A word is any seqeuence of non-blank characters;
08950	BEGIN
08960	  INTEGER vold;
08970	  IF NOT q_display_output THEN
08980	  abort("VISTA input without picture showing");
08990	  forceout(terminalout);
09000	  vold:= q_verticalpos;
09010	  WHILE
09020	  terminalin.image.sub(terminalin.pos,
09030	  terminalin.length-terminalin.pos+1).strip.length = 0 DO
09040	  BEGIN
09050	    inimage; move_the_cursor(0,vold);
09060	  END;
09070	  WHILE terminalin.image.getchar NE ' ' AND
09080	  terminalin.image.more
09090	  DO;
09100	  inword:-
09110	  copy(terminalin.image.sub(1,terminalin.image.pos-2));
09120	  synchronize(q_horizontalpos, q_verticalpos);
09130	END;
09140	COMMENT%IFEND MVISTA;
     
09150	COMMENT%IFNOT MVISTA;
09160	BOOLEAN PROCEDURE inyes;
09170	  COMMENT: Will search for either "yes" or "no" in input from
09180	  the terminal and return TRUE if "yes" is found, FALSE if
09190	  "no" is found;
09200	BEGIN
09210	  TEXT answer; CHARACTER c; INTEGER vold;
09220	  IF NOT q_display_output THEN
09230	  abort("VISTA input without picture showing");
09240	  forceout(terminalout);
09250	  vold:= q_verticalpos-1;
09260	  tryagain:
09270	  inimage; answer:- terminalin.image.strip;
09280	  WHILE TRUE DO
09290	  BEGIN
09300	    c:= IF answer.more THEN answer.getchar ELSE
09310	    char(0);
09320	    IF c \= ' ' THEN
09330	    BEGIN
09340	      IF c = 'y' OR c = 'Y' THEN inyes:= TRUE ELSE
09350	      IF c = 'n' OR c = 'N' THEN inyes:= FALSE ELSE
09360	      BEGIN
09370	        synchronize(0,vold);
09380	        outtext(
09390	        "You answered neither yes nor NO. Try again."
09400	        );
09410	        outimage;
09420	        GOTO tryagain;
09430	      END;
09440	      GOTO out;
09450	    END;
09460	  END;
09470	  out: terminalin.setpos(terminalin.length+1);
09480	  synchronize(q_horizontalpos,q_verticalpos);
09490	END;
09500	COMMENT%IFEND MVISTA;
     
09510	PROCEDURE local_home_the_cursor;
09520	  COMMENT: Will move the cursor to the position (0,0),
09530	  the upper left corner of the screen, on CDC 71310 to
09540	  the lower left corner;
09550	BEGIN
09560	  IF q_display_output THEN
09570	  BEGIN
09580	    IF addaltmode THEN outchr(termline,altmode,1) ELSE
09590	    outchr(termline,home,1);
09600	    outchr(termline,home,1);
09610	  END;
09620	  q_verticalpos:= q_horizontalpos:= 0;
09630	  IF terminaltype = cdc71310s THEN q_verticalpos:= heightm1;
09640	END;
     
09650	PROCEDURE home_the_cursor;
09660	  COMMENT: Will move the cursor to the position (0,0),
09670	  the upper left corner of the screen;
09680	BEGIN
09690	  IF q_display_output THEN
09700	  BEGIN
09710	    IF addaltmode THEN outchr(termline,altmode,1) ELSE
09720	    outchr(termline,home,1);
09730	    outchr(termline,home,1);
09740	    IF terminaltype = cdc71310s THEN outchr(termline,up,heightm1);
09750	  END;
09760	  q_verticalpos:= q_horizontalpos:= 0;
09770	END;
     
09780	PROCEDURE blank_the_screen;
09790	COMMENT: Will make the whole screen blank.;
09800	BEGIN
09810	  INTEGER h, v;
09820	  FOR v:= 0 STEP 1 UNTIL heightm1 DO
09830	  screen[v]:= NOTEXT;
09840	  IF q_display_output THEN
09850	  BEGIN
09860	    home_the_cursor;
09870	    IF addaltmode THEN outchr(termline,altmode,1);
09880	    outchr(termline,erasescreen,1);
09890	    home_the_cursor;
09900	    echo(terminalin,IF q_echoenabled THEN 4 ELSE 2);
09910	  END;
09920	END;
     
09930	COMMENT Execution of the CLASS VISTA starts here with initialization
09940	of local variables;
09950	COMMENT%IF mvista
09960	p_q_insingle:- NEW q_insingle;
09970	COMMENT%IF mvista
09980	p_insingle:- NEW insingle;
09990	COMMENT%IFEND mvista;
10000	trmop(8r2017,termline,0); !.TTY FILL 0, please monitor no fill chars;
10010	terminaloutimage:- terminalout.image;
10020	maxterminals:= 14; infoton:= 1; vt52:= 2;
10030	minitec:= 3; elite:= 4; kthelite:= 5;
10040	newelite:= 6; newkthelite:= 7; teletec:= 8;
10050	sattelite:= 9; tandberg:= 10; beehive:= 11; cdc71310s:= 12;
10060	cdc71310p:= 13;
10070	cpunumber:= gettab(8r11,8r20); ! Get CPU number from monitor tables;
10080	IF cpunumber = 522 !QZ computer centre in Stockholm; THEN
10090	BEGIN
10100	  ttyqz:= trmop(8r1777,termline,1) = 1 !.TTY QZ = TRUE;;
10110	  ttyzq:= trmop(8r1776,termline,1) = 1 !.TTY ZQ = TRUE;;
10120	END;
10130	IF sysout.image.length < width THEN sysout.image:-
10140	blanks(width);
10150	IF sysin.image.length < width THEN sysin.image:-
10160	blanks(width);
10170	IF terminalout =/= sysout THEN termline:- terminalout;
10180	restorechar:= altmode:= char(27); linefeed:= char(10);
10190	bell:= char(7); verttab:= char(11); null:= char(0);
10195	COMMENT%IFNOT MVISTA;
10196	delayer:=
10197	COMMENT%IFEND MVISTA;
10200	fill:= char(127); tab:= char(9); carriagereturn:= char(13);
10220	formfeed:= char(12);
     
10230	INSPECT terminalout DO INSPECT terminalin DO
10240	BEGIN CHARACTER c;
10250	  IF terminaltype = 0 THEN
10260	  asktype:
10270	  BEGIN ! Ask the terminal user about terminal type;
10280	    again: outchr(termline,formfeed,1); outimage; outimage;
10290	    IF FALSE THEN bad:
10300	    BEGIN
10310	      outtext("I cannot cope with your terminal specification."
10320	      ); outimage;
10330	    END;
10340	    outtext("Input number of terminal type:");
10350	    outimage;
10360	    outtext(" 1 = INFOTON VISTA STANDARD"); outimage;
10370	    outtext(" 2 = DEC VT52 (May not yet work)"); outimage;
10380	    outtext(" 3 = MINITEC 2402"); outimage;
10390	    outtext(" 4 = ELITE 2500 WITH AUTO-LF FEATURE"); outimage;
10400	    outtext(" 5 = ELITE 2500 WITHOUT AUTO-LF FEATURE");
10410	    outimage;
10420	    outtext(" 6 = ELITE 1520 WITH AUTO-LF FEATURE"); outimage;
10430	    outtext(" 7 = ELITE 1520 WITHOUT AUTO-LF FEATURE");
10440	    outimage;
10450	    outtext(" 8 = TELETEC"); outimage;
10460	    outtext(" 9 = VISTAR SATTELITE"); outimage;
10470	    outtext("10 = TANDBERG TDV 2000"); outimage;
10480	    outtext("11 = BEEHIVE B 100"); outimage;
10490	    outtext("12 = CDC 713-10 SCROLL MODE"); outimage;
10500	    outtext("13 = CDC 713-10 PAGE MODE"); outimage;
10510	    IF extraparameters =/= NOTEXT THEN
10520	    BEGIN outint(maxterminals,2);
10530	      outtext(" = "); outtext(extraterminal); outimage;
10540	      maxterminals:= maxterminals+1;
10550	    END;
10560	    outtext(" 0 = Other kind of display terminal"); outimage;
10570	    outimage;
10580	    outtext(
10590	    "Input negative number for direct cursor adressing");
10600	    outimage; outtext("(Faster but does not always work.)");
10610	    outimage;
     
10620	    terminalin.inimage; lastitem;
10630	    IF checkint(terminalin.image) NE 1 THEN
10640	    BEGIN
10650	      outtext("Integer input expected."); outimage;
10660	      terminalin.image.setpos(0); GOTO again;
10670	    END;
10680	    terminalin.image.setpos(1);
10690	    terminaltype:= terminalin.image.getint;
10700	  END;
10710	  direct_cursor_addressing:= terminaltype < 0;
10720	  IF direct_cursor_addressing
10730	  THEN terminaltype:= -terminaltype;
10740	  IF terminaltype >= maxterminals THEN
10750	  BEGIN
10760	    outtext("Can only handle terminals of type 0 to");
10770	    outint(maxterminals-1,2); outimage;
10780	    GOTO bad;
10790	  END;
     
10800	  zeroterminal: IF terminaltype = 0 THEN
10810	  BEGIN
10820	    terminaltype:= maxterminals-1;
10830	    outtext(
10840	    "Push the following keys in sequence on your terminal:"
10850	    ); outimage;
10860	    outtext(
10870	    "Cursor down, cursor up, cursor right, cursor left,");
10880	    outimage;
10890	    outtext("cursor home, erase screen, carriage return.");
10900	    outimage;
10910	    extraparameters:- blanks(20);
10920	    loop: c:= getch; IF c NE carriagereturn THEN
10930	    BEGIN extraparameters.putchar(c); GOTO loop;
10940	    END;
10950	    extraparameters:-
10960	    extraparameters.sub(1,extraparameters.pos-1);
10970	    c:= getch; IF extraparameters = NOTEXT THEN GOTO bad;
10980	  END;
     
10990	  IF terminaltype >= maxterminals-1
11000	  AND extraparameters =/= NOTEXT THEN
11010	  BEGIN
11020	    CHARACTER PROCEDURE find;
11030	    BEGIN IF NOT extraparameters.more THEN GOTO bad;
11040	      c:= extraparameters.getchar;
11050	      IF c = altmode THEN
11060	      BEGIN addaltmode:= TRUE;
11070	        IF NOT extraparameters.more THEN GOTO bad;
11080	        c:= extraparameters.getchar;
11090	      END;
11100	      find:= c;
11110	    END;
11120	    extraparameters.setpos(1);
11130	    down:= find; up:= find; right:= find; left:= find;
11140	    home:= find; erasescreen:= find;
11150	  END ELSE
     
11160	  IF terminaltype = infoton OR terminaltype = sattelite THEN
11170	  BEGIN COMMENT Infoton Vista Standard or VISTAR Sattelite;
11180	    direct_cursor_adressing:= FALSE;
11190	    allow_cr:= TRUE;
11200	    trmop(8r2006,terminalout,1); ! .TTY FORM;
11210	    IF terminaltype = infoton THEN
11220	    BEGIN
11230	      startblink:= char(31); stopblink:= char(15);
11240	    END ELSE startblink:= stopblink:= ' ';
11250	    up:= char(28); down:= char(29); right:= char(25);
11260	    left:= char(26);
11270	    home:= char(8);
11280	    erasescreen:= char(12);
11290	  END ELSE IF terminaltype = vt52 THEN
11300	  BEGIN COMMENT VT52;
11310	    outtext("Maybe down and up, left and right are reversed?");
11320	    outimage;
11330	    address_screen:= 'Y';
11340	    startblink:= stopblink:= char(0);
11350	    allow_cr:= TRUE;
11360	    COMMENT does not work on VT52;
11370	    addaltmode:= TRUE;
11380	    ! maybe just the opposite in the line below?;
11390	    down:= 'A'; up:= 'B'; left:= 'C'; right:= 'D';
11400	    home:= 'H'; erasescreen:= 'J';
11410	  END ELSE IF terminaltype = minitec OR terminaltype = teletec
11420	  THEN
11430	  BEGIN COMMENT minitec 2402 or teletec;
11440	    trmop(8r2006,terminalout,1); ! .TTY FORM;
11450	    allow_cr:= TRUE;
11460	    IF terminaltype = minitec THEN
11470	    BEGIN
11480	      address_screen:= 'F';
11490	      startblink:= char(16r42); stopblink:= char(16r53);
11500	      erasescreen:= char(28);
11510	    END ELSE erasescreen:= char(12);
11520	    up:= char(11); down:= char(10); right:= char(31);
11530	    left:= char(8); home:= char(30);
11540	  END ELSE IF terminaltype = elite OR terminaltype = kthelite
11550	  THEN
11560	  BEGIN
11570	    !until I can get it working;
11580	    allow_cr:= terminaltype = kthelite;
11590	    IF direct_cursor_adressing THEN
11600	    BEGIN elitecursors:- copy("`abcdefghijklmnop"
11610	      "qrstuvwxyz{|}~5@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ !""#"
11620	      "$%&'()*+,-./");
11630	      depchar(elitecursors,32,fill);
11640	      address_screen:= formfeed;
11650	    END;
11660	    up:= char(26); down:= char(10);
11670	    right:= char(28); left:= char(8);
11680	    home:= char(2); erasescreen:= char(31);
11690	    startblink:= char(14);
11700	    stopblink:= ' '; !in reality = home;
11710	  END ELSE IF terminaltype = newelite OR terminaltype =
11720	  newkthelite
11730	  THEN
11740	  BEGIN
11750	    !until I can get it working;
11760	    allow_cr:= terminaltype = newkthelite;
11770	    IF direct_cursor_adressing THEN
11780	    BEGIN elitecursors:- copy("`abcdefghijklmnop"
11790	      "qrstuvwxyz{|}~5@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ !""#"
11800	      "$%&'()*+,-./");
11810	      depchar(elitecursors,32,fill);
11820	      address_screen:= char(30);
11830	    END;
11840	    up:= char(31); down:= char(10);
11850	    right:= char(28); left:= char(8);
11860	    home:= char(25); erasescreen:= char(12);
11870	    startblink:= char(14);
11880	    stopblink:= ' '; !in reality = home;
11890	  END ELSE IF terminaltype = tandberg THEN
11900	  BEGIN
11910	    trmop(8R2005,termline,1);!.TTY TAB;
11920	    tab:= char(30);
11930	    up:= char(28); down:= char(11); left:= char(8);
11940	    right:= char(9);
11950	    home:= char(29); erasescreen:= char(25);
11960	    allow_cr:= TRUE;
11970	  END ELSE IF terminaltype = beehive THEN
11980	  BEGIN
11990	    allow_cr:= TRUE; addaltmode:= TRUE;
12000	    up:= 'A'; down:= 'B'; left:= 'D'; right:= 'C';
12010	    home:= 'H'; erasescreen:= 'E';
12020	    startblink:= 'l'; stopblink:= 'm';
12030	    address_screen:= 'F';
12040	  END ELSE IF terminaltype = cdc71310s OR
12050	  terminaltype = cdc71310p THEN
12060	  BEGIN
12070	    up:= char(26); down:= linefeed;
12080	    left:= char(8); right:= char(21);
12090	    startblink:= char(14); stopblink:= char(15);
12100	    home:= char(25); ! lower left corner for cdc71310s;
12110	    erasescreen:= char(24);
12120	    allow_cr:= TRUE;
12130	    COMMENT%IFNOT MVISTA;
12140	    delayer:= char(0);
12150	    COMMENT%IFEND MVISTA;
12160	  END;
12170	
12180	  q_display_output:= TRUE;
12190	  echo(terminalin,IF q_echoenabled THEN 4 ELSE 2);
12200	  leftimage:- blanks(terminalin.length);
12210	  depchar(leftimage,1,left);
12220	  terminalout.linesperpage(-1);
12230	  trmop(8r2010,terminalout,1); ! .TTY NO CRLF;
12240	  !chartypes[rank(home)]:= 1; !chartypes[rank(tab)]:= 2;
12250	  !chartypes[rank(formfeed)]:= 4;
12260	  !chartypes[rank(carriagereturn)]:= 5;
12270	  !chartypes[15]:= 6; COMMENT control-O;
12280	  !chartypes[rank(right)]:= 7; !chartypes[rank(left)]:= 8;
12290	  !chartypes[rank(up)]:= 9; !chartypes[rank(down)]:= 10;
12300	  !chartypes[rank(linefeed)]:= 3;
12310	  widthm1:= width-1; heightm1:= height-1;
12320	  FOR q_verticalpos:= heightm1 STEP -1 UNTIL 0 DO
12330	  screen[q_verticalpos]:- blanks(width);
12340	  blank_the_screen;
12350	END;
12360	END of CLASS VISTA;