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;