PROC VIRTERM;
# TITLE VIRTERM - VIRTUAL TERMINAL INTERFACE. #
BEGIN # VIRTERM #
#
*** VIRTERM - VIRTUAL TERMINAL INTERFACE.
*
* *VIRTERM* PROVIDES VIRTUAL TERMINAL OBJECT ROUTINES TO MAP
* TO AND FROM TERMINAL-INDEPENDENT APPLICATION REQUESTS AND
* TERMINAL-DEPENDENT CODE SEQUENCES.
*
* PROC VIRTERM
*
* ENTRY OBJECT ROUTINE CALLED.
*
* EXIT OBJECT ROUTINE EXECUTED.
*
* COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
#
DEF LISTCON #1#; # LIST COMDECKS #
*IFCALL SINGLE,COMFSGL
*IFCALL ONLY,COMFONL
*IFCALL MULTI,COMFMLT
*IFCALL EDITOR,COMFFSE
# START OF CODE SEQUENCE CONDITIONALLY PRODUCED BY MODIFY UTILITY #
*NIFCALL EDITOR,COMFTIO
*IF UNDEF,EDITOR
DEF EDITORVDT #0#; # STANDALONE VERSION OF VIRTERM #
DEF IOBEGIN(XXX) #BEGIN#; # BEGIN COMPOUND STATEMENT #
DEF IOEND #END#; # END COMPOUND STATEMENT #
DEF IORET #RETURN;#; # RETURN FROM SUBPROGRAM #
DEF SINGLE #1#; # SINGLE-USER VERSION #
DEF MULTI #0#; # NOT MULTI-USER #
CONTROL PRESET;
*ENDIF
*IF UNDEF,QTRM
DEF QTRMV #0#; # NOT QTRM VERSION #
*ELSE
DEF QTRMV #1#; # QTRM VERSION #
*ENDIF
# END OF CODE SEQUENCE CONDITIONALLY PRODUCED BY MODIFY UTILITY #
CONTROL EJECT;
CONTROL IFEQ MULTI,1; # IF MULTI USER FSE VIRTERM #
XREF ARRAY RENTSTK [1:MAXREENT] P(1); # SUBROUTINE STACK #
BEGIN # ARRAY RENTSTK #
ITEM RSTK I; # STACK WORD #
END # ARRAY RENTSTK #
XREF ITEM RSTKPTR I; # STACK POINTER #
CONTROL FI; # END OF IF MULTI USER FSE #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
ARRAY TDUFET [0:0] P(5); # FET TO READ ZZZZTRM FILE #
BEGIN
ITEM TDUNAME C(00,00,07) = ["ZZZZTRM"]; # FILE NAME #
ITEM TDUCODE U(00,42,18) = [1]; # STATUS CODE #
ITEM TDUFET1 U(01,00,42) = [0]; # FET + 1 #
ITEM TDUFIRST U(01,42,18) = [0]; # FIRST #
ITEM TDUFET2 U(02,00,42) = [0]; # FET + 2 #
ITEM TDUIN U(02,42,18) = [0]; # IN #
ITEM TDUFET3 U(03,00,42) = [0]; # FET + 3 #
ITEM TDUOUT U(03,42,18) = [0]; # OUT #
ITEM TDUFET4 U(04,00,42) = [0]; # FET + 4 #
ITEM TDULIMIT U(04,42,18) = [0]; # LIMIT #
END
DEF TDUBUFFLEN #O"301"#; # *TDU* BUFFER LENGTH #
ARRAY TDUBUF [0:0] P(TDUBUFFLEN);; # *TDU* BUFFER #
BASED ARRAY TEMPSTORE [0:0] P(1);
BEGIN # USED TO MOVE *TDU* TABLE #
ITEM TEMPWORD U; # WORD #
END
ARRAY T3270RTA [0:63] P(1);
BEGIN # 3270 RELATIVE TO ABSOLUTE #
ITEM RTA3270 U(00,00,60) = [
X"20", X"41", X"42", X"43", X"44", X"45", X"46", X"47",
X"48", X"49", X"5B", X"2E", X"3C", X"28", X"2B", X"21",
X"26", X"4A", X"4B", X"4C", X"4D", X"4E", X"4F", X"50",
X"51", X"52", X"5D", X"24", X"2A", X"29", X"3B", X"5E",
X"2D", X"2F", X"53", X"54", X"55", X"56", X"57", X"58",
X"59", X"5A", X"7C", X"2C", X"25", X"5F", X"3E", X"3F",
X"30", X"31", X"32", X"33", X"34", X"35", X"36", X"37",
X"38", X"39", X"3A", X"23", X"40", X"27", X"3D", X"22" ];
END
ARRAY T3270ATR [0:127] P(1);
BEGIN # 3270 ABSOLUTE TO RELATIVE #
ITEM ATR3270 U(00,00,60) = [
X"00", X"00", X"00", X"00", X"00", X"00", X"00", X"00", # 00-07 #
X"00", X"00", X"00", X"00", X"00", X"00", X"00", X"00", # 08-0F #
X"00", X"00", X"00", X"00", X"00", X"00", X"00", X"00", # 10-17 #
X"00", X"00", X"00", X"00", X"00", X"00", X"00", X"00", # 18-1F #
X"00", X"0F", X"3F", X"3B", X"1B", X"2C", X"10", X"3D", # 20-27 #
X"0D", X"1D", X"1C", X"0E", X"2B", X"20", X"0B", X"21", # 28-2F #
X"30", X"31", X"32", X"33", X"34", X"35", X"36", X"37", # 30-30 #
X"38", X"39", X"3A", X"1E", X"0C", X"3E", X"2E", X"2F", # 38-3F #
X"3C", X"01", X"02", X"03", X"04", X"05", X"06", X"07", # 40-40 #
X"08", X"09", X"11", X"12", X"13", X"14", X"15", X"16", # 48-4F #
X"17", X"18", X"19", X"22", X"23", X"24", X"25", X"26", # 50-50 #
X"27", X"28", X"29", X"0A", X"00", X"1A", X"1F", X"2D", # 58-5F #
X"00", X"00", X"00", X"00", X"00", X"00", X"00", X"00", # 60-60 #
X"00", X"00", X"00", X"00", X"00", X"00", X"00", X"00", # 68-6F #
X"00", X"00", X"00", X"00", X"00", X"00", X"00", X"00", # 70-70 #
X"00", X"00", X"00", X"00", X"2A", X"00", X"00", X"00" ]; # 78-7F #
END
CONTROL FI; # END OF NOT MULTI USER FSE #
CONTROL EJECT;
XDEF
BEGIN
*CALL COMFXVT
*IF DEF,QTRM
PROC VDTWTO; # WRITE ONE WORD OF OUTPUT #
*ENDIF
END
XREF
BEGIN
*IF DEF,QTRM
PROC PF; # GET PERMANENT FILE #
PROC SCRCCK; # VALIDATE TERMINAL CAPSULE #
PROC SCRLCP; # LOAD TERMINAL CAPSULE #
PROC SCRUGD; # UNLOAD GROUP DIRECTORY #
PROC SFDQUE; # QTRM DEQUEUE #
PROC SFNQUE; # QTRM ENQUEUE #
PROC VDTGTO; # GET TERMINAL ORDINAL #
*ENDIF
*IF DEF,DEBUG
PROC VDTDMP$; # DUMP OUTPUT TO XXXDUMP #
*ENDIF
PROC VDTGSL; # GET OS SCREEN LINE MODE #
PROC VDTGTA; # GET *TDU* TABLE ADDRESS #
PROC VDTRDO; # READ ONE WORD OF INPUT #
PROC VDTRD$; # READ FILE TO CIO BUFFER #
PROC VDTREO$; # READ WORD FROM CIO BUFFER #
PROC VDTWRR$; # WRITE END OF RECORD #
*IF UNDEF,QTRM
PROC VDTWTO; # WRITE ONE WORD OF OUTPUT #
*ENDIF
PROC VDTWTC; # WRITE ONE LINE OF OUTPUT #
END
CONTROL IFEQ EDITORVDT,0;
XREF
BEGIN
PROC VDTABT$; # ABORT THE CALLING ROUTINE #
PROC VDTCLO; # DO WRITER ON OUTPUT FET #
PROC VDTMSG$; # MESSAGE MACRO #
END
CONTROL FI;
*IF UNDEF,QTRM
CONTROL IFEQ SINGLE,1;
CONTROL IFEQ EDITORVDT,1;
XREF
BEGIN
PROC VDTCLO; # DO WRITER ON OUTPUT FET #
PROC VDTPRT$; # PROMPT ON/OFF #
END
CONTROL FI;
CONTROL FI;
*ENDIF
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
XREF
BEGIN
PROC VDTRWD; # REWIND FILE #
END
CONTROL FI;
CONTROL EJECT;
DEF XPARENTOUT #O"00070000000000000000"#; # XPARENT OUTPUT #
*CALL COMFVDT
# COMMON DATA BLOCK #
*IFCALL EDITOR,COMFDS1
*IFCALL EDITOR,COMFVD2
*IFCALL EDITOR,COMFDS2
*NIFCALL EDITOR,COMFVD1
*NIFCALL EDITOR,COMFVD2
*NIFCALL EDITOR,COMFVD3
CONTROL IFEQ SINGLE,1;
CONTROL IFEQ EDITORVDT,1;
ARRAY ENABLEMMSG [0:3] P(1); # ENABLE MULTI-MSG TRANSPARENT #
BEGIN
ITEM MULTIMSG I = [ # TERMDEF CODES #
O"0016 4070 4001 4071 4011", # XPT CHAR, UPPER BITS 2500D #
O"4072 4304 4073 4015 4074", # LOWER BITS 2500D, CR DEL #
O"4000 4105 4377 4106 4001", # NO TIMEOUT, R.O. DEL, M-MSG #
O"4064 4001 0000 0000 0000" ]; # START TRANSPARENT #
END
ARRAY DISABLMMSG [0:3] P(1); # DISABLE MULTI-MSG TRANSPARENT #
BEGIN
ITEM SINGLEMSG I = [ # TERMDEF CODES #
O"0016 4070 4001 4071 4011", # XPT CHAR, UPPER BITS 2500D #
O"4072 4304 4073 4015 4074", # LOWER BITS 2500D, CR DEL #
O"4000 4105 4377 4106 4000", # NO TIMEOUT, R.O. DEL, S-MSG #
O"4064 4000 0000 0000 0000" ]; # END TRANSPARENT #
END
CONTROL FI;
CONTROL FI;
CONTROL EJECT;
CONTROL IFEQ EDITORVDT,0; # PROCEDURES NOT NEEDED BY FSE #
PROC VDTBOI(ORDINAL);
# TITLE VDTBOI - BEGINNING OF INPUT. #
BEGIN # VDTBOI #
#
** VDTBOI - BEGINNING OF INPUT.
*
* THIS PROCEDURES PROVIDES THE ABILITY TO START AND MONITOR
* INPUT SEQUENCES. IT IS IDENTICAL TO PROCEDURE *VDTPPI* EX-
* CEPT THAT IT RETURNS AN ORDINAL.
*
* PROC VDTBOI(ORDINAL)
*
* EXIT ORDINAL = 0, IF TRANSPARENT INPUT RECEIVED OK.
* = NON ZERO, IF TYPEAHEAD.
*
* CALLS VDTPPI.
*
* USES VTORDN.
#
ITEM ORDINAL I; # VTORDN #
VDTPPI; # PRE-PROCESS INPUT #
IF VTINPDATA EQ 0 THEN VTORDN = 1; # NULL TYPEAHEAD #
ORDINAL = VTORDN;
END # VDTBOI #
CONTROL EJECT;
PROC VDTBOX(ORDINAL);
# TITLE VDTBOX - OUTPUT LINE DRAWING CHARACTER. #
BEGIN # VDTBOX #
#
** VDTBOX - OUTPUT LINE DRAWING CHARACTER.
*
* THIS PROCEDURE OUTPUTS LINE DRAWING CHARACTERS BY ORDINAL.
*
* PROC VDTBOX(ORDINAL)
*
* CALLS VDCTRL.
#
ITEM ORDINAL I; # LINE DRAWING CHARACTER ORDINAL #
IF ORDINAL GQ 0 AND ORDINAL LQ 11 THEN
BEGIN # IF VALID ORDINAL #
VDCTRL(OUT"LDFHORIZON" + ORDINAL + (13 * (BOXWEIGHT - 1)));
END
END # VDTBOX #
CONTROL EJECT;
PROC VDTCAA(NEWMASK);
# TITLE VDTCAA - CHANGE ALL ATTRIBUTES. #
BEGIN # VDTCAA #
#
** VDTCAA - CHANGE ALL ATTRIBUTES.
*
* THIS PROCEDURE CHANGES THE CURRENT ATTRIBUTE MASK.
*
* PROC VDTCAA(NEWMASK)
#
ITEM NEWMASK U; # NEW ATTRIBUTE MASK #
ATTRIBMASK[0] = NEWMASK; # SET NEW ATTRIBUTE MASK #
END # VDTCAA #
*IF DEF,ECHO
CONTROL EJECT;
PROC VDTCLR;
# TITLE VDTCLR - CLEAR TO END OF SCREEN. #
BEGIN # VDTCLR #
#
** VDTCLR - CLEAR TO END OF SCREEN.
*
* THIS PROCEDURE CLEARS THE SCREEN FROM THE CURRENT CURSOR
* POSITION TO THE END OF THE SCREEN AND POSITIONS THE CURSOR
* TO THE HOME POSITION.
*
* PROC VDTCLR
*
* EXIT VTXCUR = 0.
* VTYCUR = 0 OR VTYMAX.
*
* CALLS VDCTRL, VDTBOO, VDTHOM.
#
VDTBOO; # BEGIN OUTPUT SEQUENCE #
VDCTRL(OUT"CLREOS"); # CLEAR TO END OF SCREEN #
VDTHOM; # POSITION CURSOR TO HOME #
END # VDTCLR #
CONTROL EJECT;
PROC VDTCUD;
# TITLE VDTCUD - MOVE CURSOR DOWN ONE POSITION. #
BEGIN # VDTCUD #
#
** VDTCUD - MOVE CURSOR DOWN ONE POSITION.
*
* THIS PROCEDURE MOVES THE CURSOR DOWN ONE POSITION.
*
* PROC VDTCUD
*
* EXIT VTYCUR AND VTXCUR ADJUSTED IF NECESSARY.
*
* CALLS VDCTRL.
*
* USES VTXCUR, VTYCUR.
*
* NOTES IF MOVING THE CURSOR DOWN ONE POSITON WILL CAUSE
* THE TERMINAL TO SCROLL, OR THE CURSOR TO GO HOME
* (OR IF THE CURSOR WILL STOP) THIS IS A NOOP.
#
IF VTYCUR EQ VTYMAX THEN
BEGIN # IF PRESENTLY ON LAST LINE #
IF TABDWNCRSR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF NOT STOP, SCROLL OR HOME #
VTYCUR = 0; # CURSOR WILL MOVE TO FIRST LINE #
IF TABDWNCRSR[0] EQ CURSORMOVE"SPIRAL" THEN VTXCUR = VTXCUR + 1;
VDCTRL(OUT"CURSORDOWN"); # MOVE CURSOR DOWN #
END
END
ELSE
BEGIN # NOT YET AT BOTTOM OF SCREEN #
VTYCUR = VTYCUR + 1; # ADJUST POSITION #
VDCTRL(OUT"CURSORDOWN"); # MOVE CURSOR DOWN #
END
END # VDTCUD #
CONTROL EJECT;
PROC VDTCUL;
# TITLE VDTCUL - MOVE CURSOR LEFT ONE POSITION. #
BEGIN # VDTCUL #
#
** VDTCUL - MOVE CURSOR LEFT ONE POSITION.
*
* THIS PROCEDURE MOVES THE CURSOR LEFT ONE POSITION.
*
* PROC VDTCUL
*
* EXIT VTXCUR AND VTYCUR ADJUSTED IF NECESSARY.
*
* CALLS VDCTRL, VDTCUU.
*
* USES VTXCUR, VTYCUR.
*
* NOTES IF MOVING THE CURSOR LEFT ONE POSITON WILL CAUSE
* THE TERMINAL TO SCROLL, OR THE CURSOR TO GO HOME
* (OR IF THE CURSOR WILL STOP) THIS IS A NOOP.
#
IF VTXCUR EQ 0 THEN
BEGIN # IF PRESENTLY IN FIRST COLUMN #
IF TABLEFTCUR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF NOT STOP, SCROLL OR HOME #
VTYCUR = VTYMAX; # CURSOR MOVES TO LAST COLUMN #
IF TABLEFTCUR[0] EQ CURSORMOVE"SPIRAL" THEN VTYCUR = VTYCUR - 1;
VDCTRL(OUT"CURSORLEFT"); # MOVE CURSOR LEFT #
END
END
ELSE
BEGIN # NOT YET AT LEFT SIDE OF SCREEN #
VTXCUR = VTXCUR - 1; # ADJUST POSITION #
VDCTRL(OUT"CURSORLEFT"); # MOVE CURSOR LEFT #
END
END # VDTCUL #
CONTROL EJECT;
PROC VDTCUR;
# TITLE VDTCUR - MOVE CURSOR RIGHT ONE POSITION. #
BEGIN # VDTCUR #
#
** VDTCUR - MOVE CURSOR RIGHT ONE POSITION.
*
* THIS PROCEDURE MOVES THE CURSOR RIGHT ONE POSITION.
*
* PROC VDTCUR
*
* EXIT VTXCUR AND VTYCUR ADJUSTED IF NECESSARY.
*
* CALLS VDCTRL.
*
* USES VTXCUR, VTYCUR.
*
* NOTES IF MOVING THE CURSOR RIGHT ONE POSITON WILL CAUSE
* THE TERMINAL TO SCROLL, OR THE CURSOR TO GO HOME
* (OR IF THE CURSOR WILL STOP) THIS IS A NOOP.
#
IF VTXCUR EQ VTXMAX THEN
BEGIN # IF PRESENTLY IN LAST COLUMN #
IF TABRGHTCUR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF NOT STOP, SCROLL OR HOME #
VTYCUR = 0; # CURSOR MOVES TO FIRST COLUMN #
IF TABRGHTCUR[0] EQ CURSORMOVE"SPIRAL" THEN VTYCUR = VTYCUR + 1;
VDCTRL(OUT"CURSORIGHT"); # MOVE CURSOR RIGHT #
END
END
ELSE
BEGIN # NOT AT RIGHT SIDE OF SCREEN #
VTXCUR = VTXCUR + 1; # ADJUST POSITION #
VDCTRL(OUT"CURSORIGHT"); # MOVE CURSOR RIGHT #
END
END # VDTCUR #
CONTROL EJECT;
PROC VDTCUU;
# TITLE VDTCUU - MOVE CURSOR UP ONE POSITION. #
BEGIN # VDTCUU #
#
** VDTCUU - MOVE CURSOR UP ONE POSTION.
*
* THIS PROCEDURE MOVES THE CURSOR UP ONE POSITION.
*
* PROC VDTCUU
*
* EXIT VTYCUR AND VTXCUR ADJUSTED IF NECESSARY.
*
* CALLS VDCTRL.
*
* USES VTXCUR, VTYCUR
*
* NOTES IF MOVING THE CURSOR UP ONE POSITON WILL CAUSE
* THE TERMINAL TO SCROLL, OR THE CURSOR TO GO HOME
* (OR IF THE CURSOR WILL STOP) THIS IS A NOOP.
#
IF VTYCUR EQ 0 THEN
BEGIN # IF PRESENTLY ON FIRST LINE #
IF TABUPCURSR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF NOT STOP, SCROLL OR HOME #
VTYCUR = VTYMAX; # CURSOR WILL MOVE TO LAST LINE #
IF TABUPCURSR[0] EQ CURSORMOVE"SPIRAL" THEN VTXCUR = VTXCUR - 1;
VDCTRL(OUT"CURSORUP"); # MOVE CURSOR UP #
END
END
ELSE
BEGIN # NOT YET AT TOP OF SCREEN #
VTYCUR = VTYCUR - 1; # ADJUST POSITION #
VDCTRL(OUT"CURSORUP"); # MOVE CURSOR UP #
END
END # VDTCUU #
CONTROL EJECT;
PROC VDTDEC;
# TITLE VDTDEC - DELETE ONE CHARACTER. #
BEGIN # VDTDEC #
#
** VDTDEC - DELETE ONE CHARACTER.
*
* THIS PROCEDURE DELETES ONE CHARACTER FROM THE TEXT ON THE SCREEN
* SHIFTING EXISTING TEXT THAT WAS TO THE RIGHT OF THE CHARACTER ONE
* POSITION TO THE LEFT.
*
* PROC VDTDEC
*
* CALLS VDCTRL.
#
VDCTRL(OUT"DELETECHAR"); # DELETE CHARACTER #
END # VDTDEC #
CONTROL EJECT;
PROC VDTDEL;
# TITLE VDTDEL - DELETE ONE LINE. #
BEGIN # VDTDEL #
#
** VDTDEL - DELETE ONE LINE.
*
* THIS PROCEDURE DELETES THE LINE THAT THE CURSOR IS ON AND
* MOVES THE REMAINING LINES BELOW THE DELETED AREA UP ONE,
* POSITIONING THE CURSOR TO THE START OF THE LINE.
*
* PROC VDTDEL
*
* CALLS VDCTRL, VDMOVE.
*
* USES VTXCUR.
#
VDCTRL(OUT"DELINECURL"); # DELETE LINE, CURSOR LEFT #
IF NUMBERBYTE EQ 0 THEN
BEGIN # IF NO FUNCTION AVAILABLE #
VDCTRL(OUT"DELETELINE"); # DELETE LINE #
IF NUMBERBYTE NQ 0 AND VTXCUR NQ 0 THEN
BEGIN # IF POSITION NEEDS UPDATE #
VTXCUR = 0; # CLEAR X POSITION #
VDMOVE(VTXCUR,VTYCUR); # POSITION CURSOR #
END
END
ELSE
BEGIN # FUNCTION AVAILABLE #
VTXCUR = 0; # CLEAR X POSITION #
END
END # VDTDEL #
*ENDIF
CONTROL EJECT;
PROC VDTDRW(WEIGHT);
# TITLE VDTDRW - SET LINE DRAWING CHARACTER SET. #
BEGIN # VDTDRW #
#
** VDTDRW - SET LINE DRAWING CHARACTER SET.
*
* THIS PROCEDURE SETS OR CLEARS THE LINE DRAWING CHARACTER SET FOR
* THOSE TERMINALS THAT HAVE A LINE DRAWING CHARACTER SET.
*
* PROC VDTDRW(WEIGHT)
*
* ENTRY BOXWEIGHT = CURRENT LINE DRAWING WEIGHT.
* WEIGHT = REQUESTED LINE DRAWING WEIGHT.
* = 0, IF TURNING OFF LINE DRAWING.
* = 1, IF FINE LINE DRAWING REQUESTED.
* = 2, IF MEDIUM LINE DRAWING REQUESTED.
* = 3, IF BOLD LINE DRAWING REQUESTED.
*
* EXIT BOXWEIGHT = CURRENT LINE DRAWING WEIGHT.
*
* CALLS VDCTRL.
#
ITEM WEIGHT I; # LINE DRAWING WEIGHT #
IF WEIGHT GQ 0 AND WEIGHT LQ 3 AND WEIGHT NQ BOXWEIGHT THEN
BEGIN # IF VALID CHANGE REQUESTED #
IF BOXWEIGHT GR 0 THEN
BEGIN # IF LINE DRAWING IS ON #
VDCTRL(OUT"LDFINEOFF"+((BOXWEIGHT-1)*13));
END
IF WEIGHT GR 0 THEN
BEGIN # IF NEW WEIGHT REQUESTED #
VDCTRL(OUT"LDFINEON"+((WEIGHT-1)*13));
END
BOXWEIGHT = WEIGHT; # SAVE NEW BOX WEIGHT #
END
END # VDTDRW #
*IF DEF,ECHO
CONTROL EJECT;
PROC VDTEOI;
# TITLE VDTEOI - END OF INFORMATION. #
BEGIN # VDTEOI #
#
** VDTEOI - END OF INFORMATION.
*
* THIS PROCEDURE SENDS AN END OF INFORMATION BYTE.
*
* PROC VDTEOI
*
* CALLS VDTOUT.
#
VDTOUT(X"00"); # END OF INFORMATION BYTE #
END # VDTEOI #
CONTROL EJECT;
PROC VDTERC;
# TITLE VDTERC - ERASE CHARACTER. #
BEGIN # VDTERC #
#
** VDTERC - ERASE CHARACTER.
*
* THIS PROCEDURE MOVES THE CURSOR LEFT ONE POSITION AND
* CLEARS THE (UNPROTECTED) CHARACTER IN THAT POSITION.
*
* PROC VDTERC
*
* EXIT VTXCUR AND VTYCUR ADJUSTED IF NECESSARY.
*
* CALLS VDCTRL.
#
VDCTRL(OUT"ERASECHAR");
VTXCUR = VTXCUR - 1;
IF VTXCUR LS 0 THEN
BEGIN # IF OFF LEFT SIDE OF SCREEN #
IF TABLEFTCHR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTXCUR = VTXMAX; # CURSOR IS IN LAST COLUMN #
IF TABLEFTCHR[0] EQ CURSORMOVE"SPIRAL" THEN VTYCUR = VTYCUR - 1;
END
ELSE
BEGIN # CURSOR HAS STOPPED AT LEFT #
VTXCUR = 0; # CURSOR IS IN FIRST COLUMN #
END
END
END # VDTERC #
CONTROL EJECT;
PROC VDTERL;
# TITLE VDTERL - ERASE LINE. #
BEGIN # VDTERL #
#
** VDTERL - ERASE LINE.
*
* THIS PROCEDURE ERASES THE UNPROTECTED AREAS OF THE ACTIVE LINE.
*
* PROC VDTERL
*
* EXIT VTXCUR = 0.
*
* CALLS VDTCLL, VDCTRL, VDMOVE.
*
* USES VTXCUR.
#
VDCTRL(OUT"ERASELNECL"); # ERASE LINE, CURSOR LEFT #
IF NUMBERBYTE EQ 0 THEN
BEGIN # IF NO FUNCTION AVAILABLE #
IF VTXCUR NQ 0 THEN
BEGIN # IF NOT AT START OF LINE #
VTXCUR = 0; # SET X POSITION #
VDMOVE(VTXCUR,VTYCUR); # POSITION CURSOR #
END
VDCTRL(OUT"ERASELINE"); # ERASE LINE #
IF NUMBERBYTE EQ 0 THEN
BEGIN # IF NO FUNCTION AVAILABLE #
VDTCLL(VTXCUR,VTYCUR); # CLEAR LINE #
END
END
ELSE
BEGIN
VTXCUR = 0; # CLEAR X POSITION #
END
END # VDTERL #
*ENDIF
CONTROL EJECT;
PROC VDTGTF(WORD,INDEX);
# TITLE VDTGTF - GET TERMINAL ATTRIBUTE FLAGS. #
BEGIN # VDTGTF #
#
** VDTGTF - GET TERMINAL ATTRIBUTE FLAGS.
*
* THIS PROCEDURE RETURNS *TDU* TERMINAL ATTRIBUTE FLAGS.
*
* PROC VDTGTF(WORD,INDEX)
*
* EXIT WORD = TERMINAL ATTRIBUTE WORD FROM *TDU* TABLE.
#
ITEM WORD U; # TERMINAL ATTRIBUTE WORD #
ITEM INDEX I; # INDEX INTO *TDU* TABLE #
WORD = TABHEADONE[INDEX]; # RETURN WORD FROM TABLE #
END # VDTGTF #
*IF DEF,ECHO
CONTROL EJECT;
PROC VDTINC;
# TITLE VDTINC - INSERT ONE SPACE CHARACTER. #
BEGIN # VDTINC #
#
** VDTINC - INSERT ONE SPACE CHARACTER.
*
* THIS PROCEDURE INSERTS ONE BLANK CHARACTER INTO THE TEXT ON THE
* SCREEN, SHIFTING EXISTING TEXT PAST THE CURSOR ONE POSITION TO
* THE RIGHT.
*
* PROC VDTINC
*
* CALLS VDCTRL.
#
VDCTRL(OUT"INSERTCHAR"); # INSERT CHARACTER #
END # VDTINC #
CONTROL EJECT;
PROC VDTINL;
# TITLE VDTINL - INSERT ONE BLANK LINE. #
BEGIN # VDTINL #
#
** VDTINL - INSERT ONE BLANK LINE.
*
* THIS PROCEDURE INSERTS A BLANK LINE, MOVING THE LINE THAT
* THE CURSOR IS ON AND ALL FOLLOWING LINES DOWN ONE, POS-
* TIONING THE CURSOR TO THE START OF THE LINE.
*
* PROC VDTINL
*
* CALLS VDCTRL, VDMOVE.
*
* USES VTXCUR.
#
VDCTRL(OUT"INSLNECURL"); # INSERT LINE, CURSOR LEFT #
IF NUMBERBYTE EQ 0 THEN
BEGIN # IF NO FUNCTION AVAILABLE #
VDCTRL(OUT"INSERTLINE"); # INSERT LINE #
IF NUMBERBYTE NQ 0 AND VTXCUR NQ 0 THEN
BEGIN # IF POSITION NEEDS UPDATE #
VTXCUR = 0; # CLEAR X POSITION #
VDMOVE(VTXCUR,VTYCUR); # POSITION CURSOR #
END
END
ELSE
BEGIN # FUNCTION AVAILABLE #
VTXCUR = 0; # CLEAR X POSITION #
END
END # VDTINL #
*ENDIF
CONTROL EJECT;
PROC VDTINP(ORDINAL,COLUMN,LINE,CHAR,N);
# TITLE VDTINP - IDENTIFY NEXT VIRTUAL INPUT EVENT. #
BEGIN # VDTINP #
#
** VDTINP - IDENTIFY NEXT VIRTUAL INPUT EVENT.
*
* THIS PROCEDURE INDENTIFIES THE NEXT VIRTUAL TERMINAL INPUT
* EVENT. THIS REQUIRES THAT *VDTBOI* MUST BE CALLED FIRST TO
* SET UP FOR INPUT EVENTS.
*
* PROC VDTINP(ORDINAL,COLUMN,LINE,CHAR,N)
*
* ENTRY VTINCR = RESIDUAL CURSOR INCREMENT.
* VTXMAX = NUMBER OF COLUMNS ON SCREEN.
* VTYMAX = NUMBER OF LINES ON SCREEN.
*
* EXIT ORDINAL = EVENT CATEGORY.
* CHAR = DATA CHARACTER, OR FUNCTION ORDINAL.
* COLUMN = COLUMN CURSOR POSITION.
* LINE = LINE CURSOR POSITION.
* N = INCREMENTAL CURSOR MOVEMENT.
*
* CALLS VDTIINP.
#
ITEM ORDINAL I; # EVENT CATEGORY #
ITEM COLUMN I; # COLUMN POSITION #
ITEM LINE I; # LINE POSITION #
ITEM CHAR I; # DATA CHARACTER #
ITEM N I; # INCREMENTAL CURSOR MOVEMENT #
VDTIINP; # PERFORM INPUT SEQUENCE #
ORDINAL = VTORDN;
COLUMN = VTXCUR;
LINE = VTYCUR;
CHAR = VTCHAR;
N = VTDELT;
END # VDTINP #
CONTROL EJECT;
PROC VDTPRO(ORD);
# TITLE VDTPRO - SET PROTECTION. #
BEGIN # VDTPRO #
#
** VDTPRO - SET PROTECTION.
*
* THIS PROCEDURE ISSUES OUTPUT SEQUENCES DEALING WITH PROTECT.
*
* PROC VDTPRO(ORD)
*
* ENTRY ORD = OUTPUT SEQUENCE ORDINAL FOR PROTECT
* ALL, BEGIN DISPLAY OR END DISPLAY.
*
* EXIT REQUESTED SEQUENCE ISSUED.
*
* CALLS VDCTRL.
#
ITEM ORD I; # OUTPUT SEQUENCE ORDINAL #
VDCTRL(ORD); # ISSUE REQUESTED SEQUENCE #
END # VDTPRO #
CONTROL EJECT;
PROC VDTPSU;
# TITLE VDTPSU - PSEUDO UNDERLINE. #
BEGIN # VDTPSU #
#
** VDTPSU - PSEUDO UNDERLINE.
*
* THIS PROCEDURE ALLOWS INPUT FIELDS TO BE SEEN ON DUMB TERMINALS
* BY TURNING THE BLANK AREA OF AN INPUT FIELD INTO UNDERSCORES.
*
* PROC VDTPSU
*
* ENTRY VTPSUNDACT = TRUE, IF PSEUDO UNDERLINING.
*
* EXIT BLANK OR UNDERSCORE OUTPUT AS NECESSARY.
#
IF VTPSUNDACT[0] THEN
BEGIN # IF PSEUDO UNDERLINING #
VDTCHR(O"0137");
END
ELSE
BEGIN # JUST A BLANK #
VDTCHR(O"0040");
END
END # VDTPSU #
*IF DEF,ECHO
CONTROL EJECT;
PROC VDTRES;
# TITLE VDTRES - RESET. #
BEGIN # VDTRES #
#
** VDTRES - RESET.
*
* THIS PROCEDURE ISSUES A RESET SEQUENCE.
*
* PROC VDTRES
*
* CALLS VDCTRL.
#
VDCTRL(OUT"RESET"); # ISSUE RESET SEQUENCE #
END # VDTRES #
CONTROL EJECT;
PROC VDTRET;
# TITLE VDTRET - RETURN. #
BEGIN # VDTRET #
#
** VDTRET - RETURN.
*
* THIS PROCEDURE ISSUES A RETURN SEQUENCE.
*
* PROC VDTRET
*
* CALLS VDCTRL.
#
VDCTRL(OUT"RET");
END # VDTRET #
CONTROL EJECT;
PROC VDTTAB;
# TITLE VDTTAB - TAB FORWARD. #
BEGIN # VDTTAB #
#
** VDTTAB - TAB FORWARD.
*
* THIS PROCEDURE MOVES THE CURSOR TO THE NEXT TAB POSITION OR
* UNPROTECTED FIELD.
*
* PROC VDTTAB
*
* CALLS VDCTRL.
*
* NOTES THE INTERNAL CURSOR POSITION IS INCORRECT AFTER
* A TAB FUNCTION SO PROCEDURE VDTCOR MUST BE CALLED.
#
VDCTRL(OUT"TABFORWARD"); # TAB FORWARD #
END # VDTTAB #
CONTROL EJECT;
PROC VDTTBB;
# TITLE VDTTBB - TAB BACKWARD. #
BEGIN # VDTTBB #
#
** VDTTBB - TAB BACKWARD.
*
* THIS PROCEDURE MOVES THE CURSOR TO THE PREVIOUS TAB POSITION
* OR UNPROTECTED FIELD.
*
* PROC VDTTBB
*
* CALLS VDCTRL.
*
* NOTES THE INTERNAL CURSOR POSITION IS INCORRECT AFTER
* A TAB FUNCTION SO PROCEDURE VDTCOR MUST BE CALLED.
#
VDCTRL(OUT"TABACKWARD"); # TAB BACKWARD #
END # VDTTBB #
*ENDIF
CONTROL FI; # END OF SFORM ONLY PROCEDURES #
CONTROL EJECT; # VDTTFF USED BY SFORM AND FSE #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
PROC VDTTFF(OUTORD,COUNT);
# TITLE VDTTFF - TEST FOR OUTPUT FUNCTION. #
BEGIN # VDTTFF #
#
** VDTTFF - TEST FOR OUTPUT FUNCTION.
*
* THIS PROCEDURE TESTS FOR A *TDU* DEFINED OUTPUT FUNCTION FOR A
* GIVEN ORDINAL.
*
* PROC VDTTFF(OUTORD,COUNT)
*
* ENTRY OUTORD = THE *TDU* OUPUT ORDINAL TO BE CHECKED.
*
* EXIT COUNT = THE NUMBER OF BYTES IN THE SEQUENCE.
#
ITEM OUTORD I; # *TDU* OUTPUT ORDINAL #
ITEM COUNT I; # BTYE COUNT FOR SEQUENCE #
ITEM TDUOFFSET I; # *TDU* OFFSET FOR SEQUENCE #
ITEM CHARINDEX I; # CHARACTER INDEX INTO WORD #
ITEM WORDINDEX I; # WORD INDEX INTP *TDU* TABLE #
IF OUTORD GR OUT"RESERVED" AND OUTORD LS OUT"LASTOUT" THEN
BEGIN # IF LEGAL OUTPUT ORDINAL #
WORDINDEX = OUTORD / 5; # GET OFFSET FOR ORDINAL #
CHARINDEX = 12 * (OUTORD - (WORDINDEX * 5));
TDUOFFSET = B<CHARINDEX,12>TABFULLWRD[WORDINDEX];
IF CHARINDEX NQ 48 THEN
BEGIN # IF NEXT BYTE IS IN SAME WORD #
COUNT = B<CHARINDEX+12,12>TABFULLWRD[WORDINDEX];
END
ELSE
BEGIN # GET BYTE FROM NEXT WORD #
COUNT = B<0,12>TABFULLWRD[WORDINDEX+1];
END
COUNT = COUNT - TDUOFFSET; # CALCULATE NUMBER OF BYTES #
IF COUNT LS 0 THEN COUNT = 0; # IF NEGATIVE COUNT, RETURN ZERO #
END
ELSE
BEGIN # IF ILLEGAL ORDINAL #
COUNT = 0; # RETURN ZERO COUNT #
END
END # VDTTFF #
CONTROL FI; # END OF IF NOT MULTI USER FSE #
CONTROL EJECT; # FSE USED PROCEDURE VDTAPS #
CONTROL IFEQ EDITORVDT,1; # IF EDITOR VERSION OF VIRTERM #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
PROC VDTAPS(NAME,STRING,LENGTH,STAT);
# TITLE VDTAPS - GET APPLICATION STRING FROM *TDU* TABLE. #
BEGIN # VDTAPS #
#
** VDTAPS - GET APPLICATION STRING FROM *TDU* TABLE.
*
* THIS PROCEDURE GETS THE NEXT APPLICATION STRING FROM THE
* *TDU* TABLE.
*
* PROC VDTAPS(NAME,STRING,LENGTH,STAT)
*
* ENTRY NAME = NAME OF APPLICATION STRING REQUESTED.
* TDUINDEX = WORD COUNT READ SO FAR OF *TDU* TABLE.
* TDURESID = RESIDENT *TDU* TABLE FLAG.
*
* EXIT STRING = APPLICATION STRING (SEVEN BIT FORMAT).
* LENGTH = NUMBER OF CHARACTERS IN STRING.
* STAT = 0, IF NO ERROR.
* = 1, IF NO STRING.
* TDUINDEX = UPDATED.
*
* CALLS VDGETW.
*
* USES TDUINDEX.
#
ITEM NAME C(7); # NAME OF STRING #
ARRAY STRING [0:0] P(1);
BEGIN # APPLICATION STRING #
ITEM STRINGWORD U; # WORD #
END
ITEM LENGTH I; # NUMBER OF CHARACTERS #
ITEM STAT I; # STATUS RETURNED #
ITEM FOUND B; # FLAG #
ITEM COUNTER I; # COUNTER #
ITEM COUNTER2 I; # COUNTER2 #
ITEM COUNTER3 I; # COUNTER3 #
ITEM WORD U; # WORD FROM *TDU* TABLE #
ARRAY WORDEXP [0:0] P(1); # EXPANDED *TDU* TABLE WORD #
BEGIN
ITEM WORDFULL U(00,00,60); # FULL WORD #
ITEM WORDNAME C(00,00,07); # APPLICATION STRING NAME #
ITEM WORDCOUNT I(00,42,18); # CHARACTER COUNT #
END
STAT = 0;
IF TDUINDEX[0] GQ TABSTRINIT[0] THEN
BEGIN # IF PAST APPLICATION STRINGS #
STAT = 1; # NO MORE STRINGS #
END
ELSE
BEGIN
IF TDUINDEX[0] LS TABSTRAPPS THEN
BEGIN # IF NOT AT APPLICATION STRINGS #
COUNTER2 = TABSTRAPPS[0] - TDUINDEX[0];
FOR COUNTER = 0 STEP 1 UNTIL COUNTER2 - 1 DO
BEGIN # SKIP TO APPLICATION STRINGS #
VDGETW(WORD,STAT);
END
END
IF STAT EQ 0 THEN
BEGIN # IF NOT END OF TABLE #
FOUND = FALSE; # NOT FOUND YET #
FOR COUNTER = 0 STEP 1 WHILE STAT EQ 0 AND NOT FOUND DO
BEGIN
VDGETW(WORD,STAT); # GET APPLICATION STRING NAME #
WORDFULL = WORD;
IF WORDCOUNT[0] EQ 0 THEN
BEGIN # IF END OF APPLICATION STRINGS #
STAT = 1;
END
IF STAT EQ 0 THEN
BEGIN # IF NOT END OF TABLE #
COUNTER3 = (WORDCOUNT[0] + 7) / 8;
IF WORDNAME[0] NQ NAME THEN
BEGIN # IF NO MATCH ON NAME #
FOR COUNTER2 = 0 STEP 1 UNTIL COUNTER3 - 1 DO
BEGIN
VDGETW(WORD,STAT); # SKIP THROUGH STRING #
END
END
ELSE
BEGIN # IF NAME MATCHES #
FOR COUNTER2 = 0 STEP 1 UNTIL COUNTER3 - 1 DO
BEGIN
VDGETW(WORD,STAT); # GET WORD FROM *TDU* TABLE #
STRINGWORD[COUNTER2] = WORD;
END
LENGTH = WORDCOUNT[0];
FOUND = TRUE; # FOUND IT #
END
END
END
END
END
END # VDTAPS #
CONTROL FI; # END OF NOT MULTI USER FSE #
CONTROL FI; # END OF IF EDITOR VIRTERM #
CONTROL EJECT; # SFORM USED PROCEDURE VDTAPS #
CONTROL IFEQ EDITORVDT,1; # IF EDITOR VIRTERM #
CONTROL IFEQ EDITORVDT,0; # IF NOT EDITOR VIRTERM #
PROC VDTAPS(NAME,STRING,LENGTH,STAT);
# TITLE VDTAPS - GET APPLICATION STRING FROM *TDU* TABLE. #
BEGIN # VDTAPS #
#
** VDTAPS - GET APPLICATION STRING FROM *TDU* TABLE.
*
* THIS PROCEDURE GETS THE NEXT APPLICATION STRING FROM THE
* *TDU* TABLE.
*
* PROC VDTAPS(NAME,STRING,LENGTH,STAT)
*
* ENTRY NAME = NAME OF APPLICATION STRING REQUESTED.
* TDUINDEX = WORD COUNT READ SO FAR OF *TDU* TABLE.
* TDURESID = RESIDENT *TDU* TABLE FLAG.
*
* EXIT STRING = APPLICATION STRING (8/12 FORMAT).
* LENGTH = NUMBER OF CHARACTERS IN STRING.
* STAT = 0, IF NO ERROR.
* = 1, IF NO STRING.
* TDUINDEX = UPDATED.
*
* CALLS VDGETW.
*
* USES TDUINDEX.
#
ITEM NAME C(7); # NAME OF STRING #
ARRAY STRING [0:0] P(1);
BEGIN # APPLICATION STRING #
ITEM STRINGWORD U; # WORD #
END
ITEM LENGTH I; # NUMBER OF CHARACTERS #
ITEM STAT I; # STATUS RETURNED #
ITEM FOUND B; # FLAG #
ITEM COUNTER I; # COUNTER #
ITEM COUNTER2 I; # COUNTER2 #
ITEM COUNTER3 I; # COUNTER3 #
ITEM WORD U; # WORD FROM *TDU* TABLE #
ARRAY WORDEXP [0:0] P(1); # EXPANDED *TDU* TABLE WORD #
BEGIN
ITEM WORDFULL U(00,00,60); # FULL WORD #
ITEM WORDNAME C(00,00,07); # APPLICATION STRING NAME #
ITEM WORDCOUNT I(00,42,18); # CHARACTER COUNT #
END
STAT = 0;
IF TDUINDEX[0] GQ TABSTRINIT[0] THEN
BEGIN # IF PAST APPLICATION STRINGS #
STAT = 1; # NO MORE STRINGS #
END
ELSE
BEGIN # NOT PAST APPLICATION STRINGS #
IF TDUINDEX[0] LS TABSTRAPPS THEN
BEGIN # IF NOT AT APPLICATION STRINGS #
COUNTER2 = TABSTRAPPS[0] - TDUINDEX[0];
FOR COUNTER = 0 STEP 1 UNTIL COUNTER2 - 1 DO
BEGIN # SKIP TO APPLICATION STRINGS #
VDGETW(WORD,STAT);
END
END
IF STAT EQ 0 THEN
BEGIN # IF NOT END OF TABLE #
FOUND = FALSE; # NOT FOUND YET #
FOR COUNTER = 0 STEP 1 WHILE STAT EQ 0 AND NOT FOUND DO
BEGIN
VDGETW(WORD,STAT); # GET APPLICATION STRING NAME #
WORDFULL = WORD;
IF WORDCOUNT[0] EQ 0 THEN
BEGIN # IF END OF APPLICATION STRINGS #
STAT = 1;
END
IF STAT EQ 0 THEN
BEGIN # IF NOT END OF TABLE #
COUNTER3 = (WORDCOUNT[0] + 7) / 8;
IF WORDNAME[0] NQ NAME THEN
BEGIN # IF NO MATCH ON NAME #
FOR COUNTER2 = 0 STEP 1 UNTIL COUNTER3 - 1 DO
BEGIN
VDGETW(WORD,STAT); # SKIP THROUGH STRING #
END
END
ELSE
BEGIN # IF NAME MATCHES #
FOR COUNTER2 = 0 STEP 1 UNTIL COUNTER3 - 1 DO
BEGIN
VDGETW(WORD,STAT); # GET WORD FROM *TDU* TABLE #
B<0,12>STRINGWORD[COUNTER2] = B<4,7>WORD;
B<12,12>STRINGWORD[COUNTER2] = B<11,7>WORD;
B<24,12>STRINGWORD[COUNTER2] = B<18,7>WORD;
B<36,12>STRINGWORD[COUNTER2] = B<25,7>WORD;
B<48,12>STRINGWORD[COUNTER2] = B<32,7>WORD;
END
LENGTH = WORDCOUNT[0];
FOUND = TRUE; # FOUND IT #
END
END
END
END
END
END # VDTAPS #
CONTROL FI; # END OF IF EDITOR #
CONTROL FI; # END OF IF NOT EDITOR #
CONTROL EJECT;
PROC VDTBEL;
# TITLE VDTBEL - RING THE BELL. #
IOBEGIN(VDTBEL)
#
** VDTBEL - RING THE BELL.
*
* THIS PROCEDURE SOUNDS THE AUDIBLE ALARM.
*
* PROC VDTBEL
*
* CALLS VDCTRL.
#
VDCTRL(OUT"RINGBELL"); # RING THE BELL #
IOEND # VDTBELL #
CONTROL EJECT;
PROC VDTBOO;
# TITLE VDTBOO - BEGINNING OF OUTPUT SEQUENCE. #
IOBEGIN(VDTBOO)
#
** VDTBOO - BEGINNING OF OUTPUT SEQUENCE.
*
* THIS PROCEDURE IS CALLED TO START EACH OUTPUT SEQUENCE.
*
* PROC VDTBOO
*
* CALLS VDCTRL.
*
* NOTES TO PROTECT USERS FROM THEMSELVES THE CONTROL
* SEQUENCE TO TURN OFF INSERT MODE IS ISSUED.
#
VTINSMODE[0] = FALSE; # INSERT MODE IS FALSE #
VDCTRL(OUT"INSRTMDOFF"); # TURN OFF INSERT MODE #
VDCTRL(OUT"BEGINOUT"); # BEGIN OUTPUT SEQUENCE #
CONTROL IFEQ EDITORVDT,0; # IF NOT EDITOR VIRTERM #
VDCTRL(OUT"BEGINDIS"); # OUTPUT BEGIN DISPLAY #
IF NUMBERBYTE NQ 0 THEN
BEGIN # IF A SEQUENCE WAS SENT #
ATTRIBMASK = O"6001"; # PROTECT ATTRIBUTE IS ON #
END
CONTROL FI; # END OF IF NOT EDITOR #
IOEND # VDTBOO #
CONTROL EJECT;
PROC VDTCHR(CHAR);
# TITLE VDTCHR - OUTPUT ONE BYTE OF TEXT. #
IOBEGIN(VDTCHR)
#
** VDTCHR - OUTPUT ONE 12 BIT BYTE.
*
* THIS PROCEDURE OUTPUTS A CHARACTER.
*
* PROC VDTCHR(CHAR)
*
* ENTRY CHAR = 12 BIT BYTE OF DATA.
*
* EXIT VTXCUR AND VTYCUR ADJUSTED AS NECESSARY.
*
* CALLS VDTOUT.
*
* USES VTCHAR, VTXCUR, VTYCUR.
*
* NOTES IF THE MOVEMENT OF THE CURSOR THAT WILL OCCUR WHEN
* THE CHARACTER IS OUTPUT WILL CAUSE THE TERMINAL TO
* SCROLL THEN THE CHARACTER WILL NOT BE OUTPUT.
#
ITEM CHAR I; # OUTPUT BYTE #
VTCHAR = CHAR;
# END OF NON-REENTRANT PARAMETER USAGE #
IF VTXCUR EQ VTXMAX THEN
BEGIN # IF PRESENTLY IN LAST COLUMN #
IF VTYCUR EQ VTYMAX THEN
BEGIN # IF PRESENTLY ON LAST LINE #
IF TABLASTPOS[0] NQ CURSORMOVE"SCROLL" THEN
BEGIN # IF TERMINAL WILL NOT SCROLL #
VDTOUT(VTCHAR); # OUTPUT CHARACTER #
IF TABLASTPOS[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTXCUR = 0;
IF TABLASTPOS[0] EQ CURSORMOVE"SPIRAL" THEN VTYCUR = 0;
END
END
END
ELSE
BEGIN # NOT YET AT BOTTOM OF SCREEN #
VDTOUT(VTCHAR); # OUTPUT CHARACTER #
IF TABRGHTCHR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTXCUR = 0;
IF TABRGHTCHR[0] EQ CURSORMOVE"SPIRAL" THEN VTYCUR = VTYCUR + 1;
END
END
END
ELSE
BEGIN # NOT YET AT LAST COLUMN #
VDTOUT(VTCHAR); # OUTPUT CHARACTER #
VTXCUR = VTXCUR + 1; # ADJUST POSITION #
END
IOEND # VDTCHR #
CONTROL EJECT;
PROC VDTCLL(XX,YY);
# TITLE VDTCLL - CLEAR TO END OF LINE. #
IOBEGIN(VDTCLL)
#
** VDTCLL - CLEAR TO END OF LINE.
*
* THIS PROCEDURE ERASES ALL CHARACTERS FROM THE COLUMN XX TO THE
* END OF THE LINE FOR LINE YY.
*
* PROC VDTCLL(XX,YY)
*
* ENTRY XX = X COORDINATE TO CLEAR FROM.
* YY = Y COORDINATE OF LINE TO CLEAR.
*
* EXIT VTXCUR UPDATED.
* VTYCUR UPDATED.
* LINE CLEARED.
*
* USES VTHOLD, VTXCUR, VTYCUR.
*
* CALLS VDCTRL, VDMOVE, VDTCHR, VDTOUT.
#
ITEM XX I; # X CORDINATE #
ITEM YY I; # Y CORDINATE #
# START OF NON-REENTRANT PARAMETER USAGE #
IF VTXCUR NQ XX OR VTYCUR NQ YY THEN
BEGIN
VTXCUR = XX;
VTYCUR = YY;
# END OF NON-REENTRANT PARAMETER USAGE #
VDMOVE(VTXCUR,VTYCUR); # POSITION CURSOR #
END
CONTROL IFEQ EDITORVDT,1; # IF EDITOR VERSION OF VIRTERM #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
#
* FSE USES THE LAST CHARACTER POSITION OF EACH LINE AS THE FIELD
* ATTRIBUTE FOR THE NEXT LINE ON A BLOCK MODE TERMINAL. TO PRE-
* VENT THIS ATTRIBUTE CHARACTER FROM BEING OVERWRITTEN BY THE
* NORMAL CLEAR-TO-END-OF-LINE SEQUENCE, A SPECIAL SEQUENCE IS
* GENERATED THAT ONLY CLEARS UP TO, BUT NOT INCLUDING THE LAST
* POSITION OF THE LINE.
#
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TERMINAL #
IF VTXCUR NQ VTXMAX THEN
BEGIN # IF NOT ALREADY AT END OF LINE #
VTI = (VTYCUR * (VTXMAX + 1)) + VTXMAX;
VDTOUT(X"14"); # REPEAT TO ADDRESS #
VDTOUT(RTA3270[B<48,6>VTI]); # OUTPUT BYTE 1 OF ADDRESS #
VDTOUT(RTA3270[B<54,6>VTI]); # OUTPUT BYTE 2 OF ADDRESS #
VDTOUT(X"00"); # REPEAT (NULL CHARACTER) #
VDMOVE(VTXCUR,VTYCUR); # REPOSITION CURSOR #
END
IORET
END
CONTROL FI; # END OF IF NOT MULTI FSE #
CONTROL FI; # END OF IF EDITOR VIRTERM #
VDCTRL(OUT"CLREOL"); # CLEAR TO END OF LINE #
IF NUMBERBYTE EQ 0 THEN
BEGIN # IF NO FUNCTION AVAILABLE #
FOR VTI = VTXCUR STEP 1 UNTIL VTXMAX - 1 DO
BEGIN # UNTIL END OF LINE #
VDTOUT(X"20"); # OUTPUT BLANK #
END
CONTROL IFEQ EDITORVDT,1; # IF EDITOR VERSION OF VIRTERM #
VTHOLD = VTXCUR; # SAVE X COORDINATE #
VTI = VTYCUR;
CONTROL FI; # END OF IF EDITOR VIRTERM #
VTXCUR = VTXMAX; # CURSOR IS AT EDGE OF SCREEN #
VDTCHR(X"20"); # OUTPUT CHARACTER WITH CHECK #
CONTROL IFEQ EDITORVDT,1; # IF EDITOR VERSION OF VIRTERM #
VTXCUR = VTHOLD; # RESTORE X COORDINATE #
VTYCUR = VTI;
VDMOVE(VTXCUR,VTYCUR); # RESET CURSOR POSITION #
CONTROL FI; # END OF IF EDITOR VIRTERM #
END
IOEND # VDTCLL #
CONTROL EJECT;
PROC VDTCLS;
# TITLE VDTCLS - CLEAR SCREEN. #
IOBEGIN(VDTCLS)
#
** VDTCLS - CLEAR SCREEN.
*
* THIS PROCEDURE CLEARS THE SCREEN AND POSITIONS THE CURSOR TO
* THE HOME POSITION.
*
* PROC VDTCLS
*
* EXIT VTXCUR = 0.
* VTYCUR = 0 OR VTYMAX.
*
* CALLS VDCTRL, VDTHOM.
*
* USES VTXCUR, VTYCUR.
*
* NOTES THE *TDU* DEFINITION OF THE BEGIN OUTPUT SEQUENCE
* (WHICH MUST BE ISSUED PRIOR TO CALLING VDTCLS)
* INCLUDES THE SEQUENCE TO TURN OFF INSERT MODE AND
* TO DISABLE PROTECT.
#
VDCTRL(OUT"CLRSCRCURH"); # CLEAR SCREEN, CURSOR HOME #
IF NUMBERBYTE EQ 0 THEN
BEGIN # IF NO CLEAR WITH CURSOR HOME #
VDCTRL(OUT"CLRSCREEN"); # ISSUE CLEAR SCREEN SEQUENCE #
VDTHOM; # POSITION CURSOR TO HOME #
END
ELSE
BEGIN # CURSOR IS AT HOME POSITION #
VTXCUR = 0; # RESET COLUMN POINTER #
IF TABVTHOMEU[0] THEN
BEGIN # IF HOME POSITION IS TOP #
VTYCUR = 0; # CLEAR Y COORDINATE #
END
ELSE
BEGIN # HOME IS AT BOTTOM #
VTYCUR = VTYMAX; # SET Y COORDINATE #
END
END
IOEND # VDTCLS #
CONTROL EJECT;
PROC VDTCOR(LINE,COLUMN);
# TITLE VDTCOR - SET INTERNAL CURSOR POSITION. #
BEGIN # VDTCOR #
#
** VDTCOR - SET INTERNAL CURSOR POSITION.
*
* THIS PROCEDURE ALLOWS AN APPLICATION PROGRAM TO SET THE
* INTERNAL CURSOR POSITION TO A SPECIFIED LINE AND COLUMN.
*
* PROC VDTCOR(LINE,COLUMN)
*
* ENTRY LINE = DESIRED Y COORDINATE.
* COLUMN = DESIRED X COORDINATE.
*
* EXIT VTYCUR = LINE.
* VTXCUR = COLUMN.
*
* NOTES THIS ROUTINE DOES NOT PHYSICALLY MOVE THE CURSOR
* BUT MERELY CHANGES THE INTERNAL POINTERS TO THE
* CORRECT VALUES IF THEY ARE NO LONGER VALID, FOR
* EXAMPLE AFTER A TAB FUNCTION HAS BEEN RECEIVED.
#
ITEM LINE I; # DESIRED X COORDINATE #
ITEM COLUMN I; # DESIRED Y COORDIANTE #
VTYCUR = LINE;
VTXCUR = COLUMN;
END # VDTCOR #
CONTROL EJECT;
PROC VDTCTS;
# TITLE VDTCTS - CLEAR ALL TABS. #
IOBEGIN(VDTCTS)
#
** VDTCTS - CLEAR ALL TABS.
*
* THIS PROCEDURE CLEARS ALL TAB STOPS.
*
* PROC VDTCTS
*
* EXIT VTTABS CLEARED.
*
* CALLS VDCTRL.
#
VDCTRL(OUT"CLRALLTABS"); # CLEAR TAB STOPS #
IOEND # VDTCTS #
CONTROL EJECT;
PROC VDTEOO;
# TITLE VDTEOO - END OF OUTPUT SEQUENCE. #
IOBEGIN(VDTEOO)
#
** VDTEOO - END OF OUTPUT SEQUENCE.
*
* THIS PROCEDURE IS CALLED TO END EACH OUTPUT SEQUENCE.
*
* EXIT VTOUTDATA = TRANSPARENT OUTPUT WORD.
* VTOUTNEXT = 12.
*
* CALLS VDCTRL, VDSYNCH.
*
#
CONTROL IFEQ EDITORVDT,0; # IF NOT EDITOR VIRTERM #
VDCTRL(OUT"ENDISPLAY"); # OUTPUT END DISPLAY #
IF NUMBERBYTE NQ 0 THEN
BEGIN # IF A SEQUENCE WAS SENT #
ATTRIBMASK = 0; # NO ATTRIBUTES #
END
CONTROL FI; # END OF IF NOT EDITOR #
VDCTRL(OUT"ENDOUTPUT"); # END OUTPUT SEQUENCE #
VDSYNCH;
IOEND # VDTEOO #
CONTROL EJECT;
PROC VDTGTD(COLUMNS,LINES);
# TITLE VDTGTD - GET TERMINAL DIMENSIONS. #
BEGIN # VDTGTD #
#
** VDTGTD - GET TERMINAL DIMENSIONS.
*
* THIS PROCEDURE RETURNS THE CURRENT NUMBER OF COLUMNS AND LINES.
*
* PROC VDTGTD(COLUMNS,LINES)
*
* EXIT COLUMNS = NUMBER OF COLUMNS ON SCREEN.
* LINES = NUMBER OF LINES ON SCREEN.
#
ITEM COLUMNS I; # NUMBER OF COLUMNS #
ITEM LINES I; # NUMBER OF LINES #
COLUMNS = VTXMAX + 1;
LINES = VTYMAX + 1;
END # VDTGTD #
CONTROL EJECT;
PROC VDTHOM;
# TITLE VDTHOM - MOVE CURSOR TO HOME POSITION. #
IOBEGIN(VDTHOM)
#
** VDTHOM - MOVE CURSOR TO HOME POSITION.
*
* THIS PROCEDURE POSITIONS THE CURSOR TO HOME.
*
* PROC VDTHOM
*
* EXIT VTXCUR = 0.
* VTYCUR = 0 OR VTYMAX.
*
* CALLS VDCTRL.
*
* USES VTXCUR, VTYCUR.
#
VDCTRL(OUT"CURSORHOME"); # POSITION CURSOR TO HOME #
VTXCUR = 0; # RESET COLUMN POINTER #
IF TABVTHOMEU[0] THEN
BEGIN # IF HOME POSITION IS TOP #
VTYCUR = 0; # CLEAR Y COORDINATE #
END
ELSE
BEGIN # HOME IS AT BOTTOM #
VTYCUR = VTYMAX; # SET Y COORDINATE #
END
IOEND # VDTHOM #
CONTROL EJECT;
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
PROC VDTITD(MODELNAME);
# TITLE VDTITD - INITIALIZE *TDU* TABLE. #
BEGIN # VDTITD #
#
** VDTITD - INITIALIZE *TDU* TABLE.
*
* THIS PROCEDURE GETS THE *TDU* (TERMINAL DEFINITION UTILITY) TABLE
* FROM MEMORY OR FILE *ZZZZTRM* AND MOVES IT TO ARRAYS *TABLEHEADR*
* AND *TABLEWORDS* SO THAT THE TERMINAL CAN BE RUN IN SCREEN MODE.
* TDUINDEX IS LEFT POSITIONED WHERE THE READING OF THE INPUT AND
* OUPTUT DATA STOPPED TO ALLOW SUBSEQUENT ACCESS TO THE REST OF
* THE DATA IN THE REMAINING SECTIONS OF THE *TDU* TABLE.
*
* PROC VDTITD(MODELNAME)
*
* EXIT MODELNAME = THE MODELNAME OF THE TERMINAL AS DEFINED
* TO *TDU*, LEFT JUSTIFIED, BLANK FILL.
* = BLANK, IF NO *TDU* DEFINITION EXISTS.
*
* CALLS VDGETW, VDTGSL, VDTGTA.
*
* USES VTI, VTJ, VTMODEL.
*
* NOTES VDTITD CAN NOT BE CALLED IN THE MULTI USER VERSION
* VERSION OF THE EDITOR SINCE IT MAY DO DISK I/O TO
* TO GET A USER DEFINED *TDU* TABLE.
#
ITEM MODELNAME C(6); # MODEL NAME #
ITEM TDUINOUT U; # COUNT OF *TDU* I/O INFORMATION #
ITEM TDUWORD U; # WORD FROM *TDU* TABLE #
CONTROL IFEQ QTRMV,1; # IF QTRM #
ITEM I I;
ITEM TMODEL C(7); # TEMP MODEL NAME #
ITEM SCRCLS I; # CAPSULE LOADED SUCCESSFULLY #
ITEM SCRLCA U; # LOADED CAPSULE ADDRESS #
ITEM SCRPFF I; # PERMANENT FILE FOUND FLAG #
ITEM SCRPFN C(7) = "TERMLIB"; # PERMANENT FILE NAME #
ITEM SCRSTS B; # *TERMLIB* STATUS FLAG #
ITEM SCRTCL I; # TERMINAL CAPSULE LENGTH #
ITEM SCRUSN C(7) = "LIBRARY"; # ALTERNATE USER NUMBER #
ITEM SCRZTM C(7); # MODEL NAME PREFACED WITH Z #
CONTROL FI; # END OF IF QTRM #
IF NOT VTTDUREAD[0] THEN
BEGIN # IF *TDU* TABLE NOT READ YET #
*IF UNDEF,QTRM
VDTGSL(VTMODEL,VTI); # GET MODEL AND SCREEN OR LINE #
IF VTMODEL NQ 0 THEN
BEGIN # IF TERMINAL HAS BEEN DEFINED #
IF VTMODEL NQ 1 THEN
BEGIN # IF SYSTEM RESIDENT TABLE #
VDTGTA(VTMODEL,VTJ); # GET ADDRESS FOR *TDU* TABLE #
P<TEMPSTORE> = VTJ; # POSITION BASED ARRAY #
TDURESID[0] = TRUE; # SET RESIDENT TABLE #
END
ELSE
BEGIN # NOT SYSTEM RESIDENT TABLE #
VTJ = LOC(TDUBUF); # PRESET FET FOR READ #
TDUCODE = 1;
TDUIN = VTJ;
TDUFIRST = VTJ;
TDUOUT = VTJ;
TDULIMIT = VTJ + TDUBUFFLEN; # BUFFER LENGTH #
VDTRWD(TDUFET,1); # REWIND FET WITH RECALL #
VDTRD$(TDUFET,1); # READ *TDU* TABLE WITH RECALL #
TDURESID[0] = FALSE; # CLEAR RESIDENT TABLE #
END
TDUINDEX[0] = 0; # START INDEX AT ZERO #
VDGETW(TDUWORD,VTI); # MOVE TABLE HEADER TO COMMON #
IF VTI EQ 0 THEN
BEGIN # IF TABLE EXISTS #
TABHEADONE[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADTWO[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADTHR[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADFOU[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADFIV[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADSIX[0] = TDUWORD;
TDUINOUT = TABSTRNMES[0] - 7; # COUNT *TDU* I/O INFORMATION #
IF TDUINOUT GR TDUBUFFLEN - O"10" THEN
BEGIN # IF TOO MUCH I/O INFORMATION #
TDUINOUT = TDUBUFFLEN - O"10";
END
FOR VTJ = 0 STEP 1 UNTIL TDUINOUT DO
BEGIN # MOVE BODY OF TABLE TO COMMON #
VDGETW(TDUWORD,VTI);
TABFULLWRD[VTJ] = TDUWORD;
END
VTTDUREAD[0] = TRUE; # SET TABLE READ FLAG #
END
ELSE
BEGIN # TABLE CAN NOT BE FOUND #
TABMODNAME[0] = " "; # SET BLANK NAME IN BLOCK #
END
END
ELSE
BEGIN # UNDEFINED TERMINAL #
TABMODNAME[0] = " "; # SET BLANK NAME IN BLOCK #
END
END
*ELSE
VDTGTO(VTMODEL,MODELNAME); # GET TERMINAL ORDINAL #
IF VTMODEL NQ 0 THEN
BEGIN # IF SYSTEM RESIDENT TABLE #
VDTGTA(VTMODEL,VTJ); # GET ADDRESS FOR *TDU* TABLE #
P<TEMPSTORE> = VTJ; # POSITION BASED ARRAY #
TDURESID[0] = TRUE; # SET RESIDENT TABLE #
END
ELSE
BEGIN # NOT SYSTEM RESIDENT TABLE #
PF("GET",SCRPFN,SCRPFN,"RC",SCRPFF,"UN",SCRUSN,0);
IF SCRPFF NQ 0 THEN
BEGIN # IF NOT INDIRECT, TRY DIRECT #
PF("ATTACH",SCRPFN,SCRPFN,"RC",SCRPFF,"UN",SCRUSN,"PN",
"0","NA",0,0);
END
IF SCRPFF EQ 0 THEN
BEGIN # IF FILE FOUND #
C<0>SCRZTM = "Z"; # LOADER PREFIX #
FOR I = 1 STEP 1 UNTIL 6 DO C<I>SCRZTM = C<I-1>MODELNAME;
SCRLCP(SCRZTM,SCRLCA,SCRCLS); # LOAD TERMINAL CAPSULE #
IF SCRCLS EQ 0 THEN
BEGIN # IF CAPSULE LOADED #
P<TEMPSTORE> = SCRLCA; # POSITION BASED ARRAY #
TDURESID[0] = TRUE; # SET RESIDENT TABLE #
TABMODNAME[0] = MODELNAME; # BLANK NAME IN BLOCK #
END # CAPSULE LOADED #
END
IF ((SCRCLS NQ 0) OR (SCRPFF NQ 0)) THEN
BEGIN # IF CAPSULE NOT FOUND #
TABMODNAME[0] = " "; # SET BLANK NAME IN BLOCK #
END
END
TDUINDEX[0] = 0; # START INDEX AT ZERO #
VDGETW(TDUWORD,VTI); # MOVE TABLE HEADER TO COMMON #
TABHEADONE[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADTWO[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADTHR[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADFOU[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADFIV[0] = TDUWORD;
VDGETW(TDUWORD,VTI);
TABHEADSIX[0] = TDUWORD;
TDUINOUT = TABSTRNMES[0] - 7; # COUNT *TDU* I/O INFORMATION #
IF TDUINOUT GR TDUBUFFLEN - O"10" THEN
BEGIN # IF TOO MUCH I/O INFORMATION #
TDUINOUT = TDUBUFFLEN - O"10";
END
FOR VTJ = 0 STEP 1 UNTIL TDUINOUT DO
BEGIN # MOVE BODY OF TABLE TO COMMON #
VDGETW(TDUWORD,VTI);
TABFULLWRD[VTJ] = TDUWORD;
END
VTTDUREAD[0] = TRUE; # SET TABLE READ FLAG #
END
*ENDIF
C<0,6>MODELNAME = TABMODNAME[0]; # RETURN MODEL NAME #
END # VDTITD #
CONTROL FI; # END OF IF SINGLE USER FSE #
*IF UNDEF,QTRM
CONTROL EJECT;
PROC VDTOUT(CHAR);
# TITLE VDTOUT - ISSUE ONE BYTE TO ACCUMULATOR WORD. #
IOBEGIN(VDTOUT)
#
** VDTOUT - ISSUE ONE BYTE TO ACCUMULATOR WORD.
*
* THIS PROCEDURE ALLOWS THE GENERAL OUTPUT OF ONE CHARACTER.
*
* PROC VDTOUT(CHAR)
*
* ENTRY CHAR = 12 BIT BYTE TO QUEUE OR TRANSMIT.
* VTOUTDATA = ACCUMULATOR WORD.
* VTOUTNEXT = PRESENT BIT POSITION.
*
* EXIT VTOUTDATA, VTOUTNEXT UPDATED.
*
* CALLS VDTWTO.
*
* USES VTOUTDATA, VTOUTNEXT.
#
ITEM CHAR I; # OUTPUT BYTE #
B<VTOUTNEXT,12>VTOUTDATA = CHAR LOR O"4000"; # XPARENT BYTE #
# END OF NON-REENTRANT PARAMETER USAGE #
VTOUTNEXT = VTOUTNEXT +12; # INCREMENT BIT POSITION #
IF VTOUTNEXT EQ 60 THEN
BEGIN # IF ACCUMULATOR WORD IS FULL #
VDTWTO(VTOUTDATA); # WRITE WORD #
VTOUTDATA = 0; # CLEAR ACCUMULATOR WORD #
VTOUTNEXT = 0; # SET BIT POSITION #
END
IOEND # VDTOUT #
*ELSE
CONTROL EJECT; # QTRM VARIANT OF VDTOUT #
PROC VDTOUT(CHAR);
# TITLE VDTOUT - ISSUE ONE BYTE TO ACCUMULATOR WORD. #
BEGIN # VDTOUT #
#
** VDTOUT - ISSUE ONE BYTE TO ACCUMULATOR WORD.
*
* THIS PROCEDURE ALLOWS GENERAL QTRM OUTPUT OF ONE CHARACTER.
*
* PROC VDTOUT(CHAR)
*
* ENTRY CHAR = 12 BIT BYTE TO QUEUE OR TRANSMIT.
* VTOUTDATA = ACCUMULATOR WORD.
* VTOUTNEXT = PRESENT BIT POSITION.
*
* EXIT VTOUTDATA, VTOUTNEXT UPDATED.
*
* CALLS SFNQUE.
*
* USES VTOUTDATA, VTOUTNEXT.
#
ITEM CHAR I; # OUTPUT BYTE #
ITEM I I; # DUMMY PARAMETER #
B<VTOUTNEXT,12>VTOUTDATA = CHAR;
VTOUTNEXT = VTOUTNEXT + 12;
IF VTOUTNEXT EQ 60 THEN
BEGIN # IF ACCUMULATOR WORD IS FULL #
NIT$CTLC = 5; # ENQUEUE WORD #
SFNQUE("PUT",VTOUTDATA,I);
VTOUTDATA = 0; # CLEAR ACCUMULATOR WORD #
VTOUTNEXT = 0; # SET BIT POSITION #
END
END # VDTOUT #
*ENDIF
CONTROL EJECT;
PROC VDTPOS(XX,YY);
# TITLE VDTPOS - POSITION CURSOR. #
IOBEGIN(VDTPOS)
#
** VDTPOS - POSITION CURSOR.
*
* THIS PROCEDURE MOVES THE CURSOR TO THE SPECIFIED POSITION.
*
* PROC VDTPOS(XX,YY)
*
* ENTRY XX = DESIRED X COORDINATE.
* YY = DESIRED Y COORDINATE.
*
* EXIT VTXCUR = XX.
* VTYCUR = YY.
*
* CALLS VDMOVE.
#
ITEM XX I; # COLUMN POSITION #
ITEM YY I; # LINE POSITION #
VTXCUR = XX; # RESET COLUMN POINTER #
VTYCUR = YY; # RESET LINE POINTER #
# END OF NON-REENTRANT PARAMETER USAGE #
VDMOVE(VTXCUR,VTYCUR); # POSITION CURSOR #
IOEND # VDTPOS #
*IF UNDEF,QTRM
CONTROL EJECT;
PROC VDTPPI;
# TITLE VDTPPI - PRE-PROCESS INPUT. #
IOBEGIN(VDTPPI)
#
** VDTPPI - PRE-PROCESS INPUT.
*
* THIS PROCEDURE VERIFIES THAT THE INPUT IS EITHER NULL OR IS
* TRANSPARENT INPUT. THE EFFECT IS TO BANISH MOST TYPE AHEAD
* EXCEPT FOR TYPED AHEAD CARRIAGE RETURNS WHICH CAN BE IGNORED.
*
* PROC VDTPPI
*
* EXIT VTORDN = 0, IF TRANSPARENT INPUT RECEIVED OK.
* = NON ZERO, IF NON-NULL TYPEAHEAD.
* VTINPDATA = CONTAINS NEW TRANSPARENT INPUT DATA.
* VTRESINP = BLOCK MODE RESIDUAL INPUT.
* VTINPNEXT = UPDATED.
*
* CALLS VDTRDO, VDTWTO.
*
* USES VTINPDATA, VTINPDATA, VTORDN.
*
* NOTES SINCE THIS PROCEDURE INITIALIZES THE BIT POINTER
* (VTINPNEXT), IT MUST BE CALLED EXACTLY AT THE
* START OF EACH INPUT SEQUENCE.
#
CONTROL IFEQ EDITORVDT,1; # IF EDITOR VIRTERM #
CONTROL IFEQ SINGLE,1; # MULTI DOES THIS IN TTITRAP #
IF NOT TABTYPHEAD[0] THEN
BEGIN # IF TYPE AHEAD NOT ENABLED #
VDTWTO(O"0006 4704 0015 0000 0000"); # XPARENT INPUT MODE #
END
CONTROL FI;
CONTROL FI;
CONTROL IFEQ EDITORVDT,0; # IF STAND ALONE VIRTERM #
VDTWTO(O"0006 4704 0015 0000 0000"); # XPARENT INPUT MODE #
CONTROL FI;
VTORDN = 1;
VDTRDO(VTINPDATA); # READ WORD #
VTINPNEXT = 12; # RESET BIT POSITION #
VTRESINP = 0; # CLEAR RESIDUAL INPUT #
IF B<0,12>VTINPDATA EQ 7 THEN
BEGIN # IF TRANSPARENT INPUT #
VTORDN = 0;
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TYPE TERMINAL #
B<00,12>VTRESINP = B<24,12>VTINPDATA; # CURSOR ADDRESS #
B<12,12>VTRESINP = B<36,12>VTINPDATA;
B<24,12>VTRESINP = B<12,12>VTINPDATA; # ATTENTION IDENTIFIER #
VTINPNEXT = 48; # SET BIT POINTER #
END
CONTROL FI; # END OF IF NOT MULTI FSE #
END
ELSE
BEGIN # NOT TRANSPARENT INPUT #
IF VTINPDATA EQ 0 THEN VTORDN = 0; # CHECK FOR NULL TYPE AHEAD #
END
IOEND # VDTPPI #
*ELSE
CONTROL EJECT; # QTRM VARIANT OF VDTPPI #
PROC VDTPPI;
# TITLE VDTPPI - PRE-PROCESS INPUT. #
BEGIN # VDTPPI #
#
** VDTPPI - PRE-PROCESS INPUT.
*
* THIS PROCEDURE DOES INITIALIZATION FOR QTRM INPUT.
*
* PROC VDTPPI
*
* EXIT VTINPDATA = FIRST WORD OF INPUT.
* VTINPWORD = 1.
* VTINPNEXT = 0.
* VTORDN = 0.
*
* USES VTINPDATA, VTINPNEXT, VTINPWORD, VTORDN.
#
ITEM WORD I; # WORD POINTER #
ITEM BIT I; # BIT POINTER #
VTINPNEXT = 0; # CLEAR INPUT WORD #
VTORDN = 0; # CLEAR ORDINAL #
VTINPWORD = 1;
WORD = (NIT$CTLC + 1) / 5; # INSERT DUMMY CARRIAGE RETURN #
BIT = (NIT$CTLC + 1 - (WORD * 5)) * 12;
B<BIT,12>QTRM$WD0[WORD] = O"15";
VTINPDATA = QTRM$WD0[0];
END # VDTPPI #
*ENDIF
CONTROL EJECT;
PROC VDTSAM(MASK);
# TITLE VDTSAM - SET ATTRIBUTE MASK. #
IOBEGIN(VDTSAM)
#
** VDTSAM - SET ATTRIBUTE MASK.
*
* THIS PROCEDURE SETS THE ATTRIBUTES REQUESTED BY MASK.
*
* PROC VDTSAM(MASK)
*
* ENTRY MASK = MASK OF LOGICAL/PHYSICAL ATTRIBUTES.
* ATTRIBMASK = CURRENT ATTRIBUTE MASK.
*
* EXIT ATTRIBMASK = NEW ATTRIBUTE MASK.
*
* CALLS VDCTRL, VDTOUT.
*
* USES ATTNEWMASK, ATTRIBMASK, ATTRIBSAME.
#
ITEM MASK U; # REQUESTED ATTRIBUTES #
ATTNEWMASK = MASK; # SAVE NEW ATTRIBUTES #
IF NOT TABNOTMASK[0] THEN
BEGIN # IF ATTRIBUTES ARE MASKABLE #
# CALCULATE ATTRIBUTES THAT WILL BE UNCHANGED #
ATTRIBSAME = (ATTNEWMASK LAN ATTRIBMASK[0]) LAN O"3000";
IF ATTLOGICAL[0] THEN
BEGIN # IF LOGICAL ATTRIBUTE #
IF B<0,1>ATTNEWMASK EQ 1 AND ATTORDINAL[0] EQ B<6,6>ATTNEWMASK THEN
ATTRIBSAME = ATTRIBSAME LOR (ATTNEWMASK LAN O"4077");
END
ELSE
BEGIN # PHYSICAL ATTRIBUTES #
IF B<0,1> ATTNEWMASK EQ 0 THEN
BEGIN
ATTRIBSAME = ATTRIBSAME LOR
((ATTNEWMASK LAN ATTRIBMASK[0]) LAN O"0017");
END
END
# TURN OFF ATTRIBUTES THAT ARE ON AND NOT REQUESTED THIS CALL #
ATTRIBMASK[0] = ATTRIBMASK[0] LXR ATTRIBSAME;
END
IF ATTRIBMASK[0] NQ 0 THEN
BEGIN # IF TURNING OFF ANY ATTRIBUTES #
IF ATTLOGICAL[0] THEN
BEGIN # TURN OFF LOGICAL ATTRIBUTE #
IF ATTORDINAL[0] GQ 0 AND ATTORDINAL[0] LQ MAXLOGTYPE THEN
BEGIN # IF GROUP ONE LOGICAL #
VDCTRL(OUT"INPTEXTOFF" + (ATTORDINAL[0] * 2));
IF ATTORDINAL[0] EQ 0 THEN VTPSUNDACT[0] = FALSE;
END
ELSE
BEGIN # NOT GROUP ONE LOGICAL #
IF ATTORDINAL[0] LQ MAXLOGTYPE*2+1 THEN
BEGIN # IF LEGAL GROUP TWO LOGICAL #
VDCTRL(OUT"INPUTE2" + ((ATTORDINAL[0]-6) * 2));
END
END
END
ELSE
BEGIN # TURN OFF PHYSICAL ATTRIBUTES #
IF ATTUNDERLN[0] THEN VTPSUNDACT[0] = FALSE;
IF ATTUNDERLN[0] THEN VDCTRL(OUT"UNDERLNOFF");
IF ATTALTERIN[0] THEN VDCTRL(OUT"ALTINTNOFF");
IF ATTINVERSE[0] THEN VDCTRL(OUT"INVERSEOFF");
IF ATTBLINKMD[0] THEN VDCTRL(OUT"BLINKOFF");
END
IF ATTPROTECT[0] THEN VDCTRL(OUT"PROTECTOFF");
IF ATTGUARDMD[0] THEN VDCTRL(OUT"GUARDOFF");
END
# TURN ON ATTRIBUTES THAT ARE NOT ON AND ARE REQUESTED THIS CALL #
ATTRIBMASK[0] = ATTNEWMASK; # RESET NEW ATTRIBUTES #
IF ATTRIBMASK NQ 0 THEN
BEGIN # IF ANY ATTRIBUTES TO TURN ON #
IF NOT TABLOCKMDE[0] THEN
BEGIN # IF NOT BLOCK TYPE TERMINAL #
IF NOT TABNOTMASK[0] THEN
BEGIN # IF ATTRIBUTES ARE MASKABLE #
ATTRIBMASK[0] = ATTRIBMASK[0] LXR ATTRIBSAME;
END
IF ATTPROTECT[0] THEN VDCTRL(OUT"PROTECTON");
IF ATTGUARDMD[0] THEN VDCTRL(OUT"GUARDON");
END
IF ATTLOGICAL[0] THEN
BEGIN # TURN ON LOGICAL ATTRIBUTE #
IF ATTORDINAL[0] GQ 0 AND ATTORDINAL[0] LQ MAXLOGTYPE THEN
BEGIN # IF GROUP ONE LOGICAL #
VDCTRL(OUT"INPTEXTON" + (ATTORDINAL[0] * 2));
IF ATTORDINAL[0] EQ 0 THEN VTPSUNDACT[0] = VTPSUNDREQ[0];
END
ELSE
BEGIN # NOT GROUP ONE LOGICAL #
IF ATTORDINAL[0] LQ MAXLOGTYPE*2+1 THEN
BEGIN # IF LEGAL GROUP TWO LOGICAL #
VDCTRL(OUT"INPUTB2" + ((ATTORDINAL[0]-6)* 2));
END
END
END
ELSE
BEGIN # TURN ON PHYSICAL ATTRIBUTES #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK TYPE TERMINAL #
VDTOUT(X"1D"); # OUTPUT START FIELD ORDER #
IF ATTGUARDMD[0] THEN
BEGIN # IF GUARD MODE #
VTCHAR = X"3C"; # ASSUME UNPROTECTED #
IF ATTPROTECT[0] THEN VTCHAR = VTCHAR + X"04";
END
ELSE
BEGIN # UNGUARDED FIELD #
VTCHAR = X"44"; # ASSUME UNPROTECTED AND NORMAL #
IF ATTPROTECT[0] THEN VTCHAR = VTCHAR - X"10";
IF ATTALTERIN[0] OR ATTUNDERLN[0] OR
ATTINVERSE[0] OR ATTBLINKMD[0] THEN
VTCHAR = VTCHAR + X"04";
END
VDTOUT(VTCHAR); # OUTPUT FIELD ATTRIBUTE #
END
ELSE
BEGIN
IF ATTUNDERLN[0] THEN VTPSUNDACT[0] = VTPSUNDREQ[0];
IF ATTUNDERLN[0] THEN VDCTRL(OUT"UNDERLNEON");
IF ATTALTERIN[0] THEN VDCTRL(OUT"ALTINTENON");
IF ATTINVERSE[0] THEN VDCTRL(OUT"INVERSEON");
IF ATTBLINKMD[0] THEN VDCTRL(OUT"BLINKON");
END
END
END
ELSE
BEGIN # NO ATTRIBUTES #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TERMINAL #
VDTOUT(X"1D"); # OUTPUT *START FIELD* ORDER #
VDTOUT(X"20"); # UNPROTECTED #
END
END
ATTRIBMASK[0] = ATTNEWMASK; # SAVE CURRENT ATTRIBUTES #
IOEND # VDTSAM #
CONTROL EJECT;
PROC VDTSAP(LASTPOS,XPOS,YPOS);
# TITLE VDTSAP - SET ATTRIBUTE POSITION. #
IOBEGIN(VDTSAP)
#
** VDTSAP - SET ATTRIBUTE POSITION.
*
* THIS PROCEDURE MOVES THE CURSOR TO THE SPECIFIED ROW AND COLUMN.
* FOR A NON BLOCK MODE TERMINAL THIS IS IDENTICAL TO VDTPOS BUT A
* BLOCK MODE TERMINAL WHOSES ATTRIBUTE CHARACTER OCCUPIES A SPACE
* ON THE SCREEN REQUIRES THAT THE POSITION BE BACKED UP ONE SPACE.
*
* PROC VDTSAP(LASTPOS,XPOS,YPOS)
*
* ENTRY LASTPOS = BUFFER POSITION OF LAST FIELD ATTRIBUTE.
* XPOS = DESIRED X COORDINATE.
* YPOS = DESIRED Y COORDINATE.
*
* EXIT CURSOR MOVED TO APPROPRIATE POSITION.
*
* CALLS VDMOVE, VDTOUT.
*
* USES VTCOUNT, VTHOLD, VTXCUR, VTYCUR.
#
ITEM LASTPOS I; # LAST ATTRIBUTE POSITION #
ITEM XPOS I; # DESIRED X COORDINATE #
ITEM YPOS I; # DESIRED Y COORDINATE #
VTXCUR = XPOS;
VTYCUR = YPOS;
VTHOLD = LASTPOS;
CONTROL IFEQ EDITORVDT,0; # IF NOT FSE VERSION OF VIRTERM #
IF TABLOCKMDE[0] OR TABATTRCHR[0] THEN
BEGIN # IF ATTRIBUTE WILL TAKE A BYTE #
CONTROL FI; # END OF IF NOT FSE #
CONTROL IFEQ EDITORVDT,1; # IF FSE VERSION OF VIRTERM #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TERMINAL #
CONTROL FI; # END OF IF FSE #
VTXCUR = VTXCUR - 1; # BACK CURSOR UP ONE POSITION #
IF VTXCUR LS 0 THEN
BEGIN # IF WRAP TO PREVIOUS LINE #
VTXCUR = VTXMAX;
VTYCUR = VTYCUR - 1;
IF VTYCUR LS 0 THEN
BEGIN # IF WRAP TO LAST SCREEN POSTION #
VTYCUR = VTYMAX;
IF TABATTRCHR[0] THEN
BEGIN # IF ATTRIBUTE TAKES A SPACE #
VTXCUR = 0;
VTYCUR = 0;
END
END
END
CONTROL IFEQ EDITORVDT,0; # IF NOT FSE VERSION OF VIRTERM #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TERMINAL #
VTCOUNT = (VTYCUR * (VTXMAX + 1)) + VTXCUR;
IF VTCOUNT LS VTHOLD - 1 OR VTCOUNT GR VTHOLD THEN
BEGIN # IF TERMINATING PREVIOUS FIELD #
VDTOUT(X"1D"); # START FIELD ORDER #
VDTOUT(X"30"); # AUTOSKIP, DISPLAY, NON-SELECT #
END
VTHOLD = VTCOUNT; # UPDATE POSITION #
END
CONTROL FI; # END OF IF NOT FSE #
END
VDMOVE(VTXCUR,VTYCUR); # MOVE CURSOR #
LASTPOS = VTHOLD; # UPDATE LAST POSITION #
IOEND # VDTSAP #
CONTROL EJECT;
PROC VDTSTD(COLUMNS,LINES);
# TITLE VDTSTD - SET TERMINAL DIMENSIONS. #
IOBEGIN(VDTSTD)
#
** VDTSTD - SET TERMINAL DIMENSIONS.
*
* THIS PROCEDURE ATTEMPTS TO SET THE REQUESTED TERMINAL DIMENSIONS.
* IF THE DIMENSIONS CAN NOT BE ALTERED AS REQUESTED, NO ACTION WILL
* OCCUR. IF POSSIBLE, *VDTSTD* WILL CHANGE THE WIDTH AND/OR LENGTH
* OF THE TERMINAL SCREEN TO CONFORM AS NEARLY AS POSSIBLE TO THE
* SPECIFIED SIZE.
*
* PROC VDTSTD(COLUMNS,LINES)
*
* ENTRY COLUMNS = NUMBER OF COLUMNS DESIRED.
* LINES = NUMBER OF LINES DESIRED.
*
* EXIT TERMINAL DIMENSIONS ADJUSTED IF NECESSARY AND POSSIBLE.
*
* CALLS VDCTRL.
*
* USES VTI, VTJ, VTXMAX, VTYMAX.
#
ITEM COLUMNS I; # NUMBER OF COLUMNS DESIRED #
ITEM LINES I; # NUMBER OF LINES DESIRED #
ITEM TMP1 U; # TEMPORARY STORAGE #
ITEM TMP2 U; # TEMPORARY STORAGE #
ITEM TMP3 U; # TEMPORARY STORAGE #
ITEM TMP4 U; # TEMPORARY STORAGE #
ITEM TMP5 U; # TEMPORARY STORAGE #
VTI = COLUMNS;
VTJ = LINES;
TMP2 = 0;
TMP3 = -1;
TMP4 = 0;
TMP5 = 0;
FOR TMP1 = 0 STEP 15 WHILE TMP3 LS VTI
AND TMP3 NQ 0 AND TMP1 LS 60 DO
BEGIN # FIND BEST COLUMNS FIT #
TMP3 = B<TMP1,8>TABHEADSIX;
IF TMP3 GR TMP4 THEN
BEGIN # IF BETTER THAN PREVIOUS BEST #
TMP2 = TMP1;
TMP4 = TMP3;
TMP5 = B<TMP1+8,7>TABHEADSIX;
END
END
TMP3 = -1;
FOR TMP1 = TMP2 STEP 15 WHILE TMP3 LS VTJ
AND TMP3 NQ 0 AND TMP1 LS 60 DO
BEGIN # FIND BEST ROWS FIT #
TMP3 = B<TMP1+8,7>TABHEADSIX;
IF TMP3 GR TMP5 THEN
BEGIN # IF BETTER THAN PREVIOUS BEST #
TMP2 = TMP1;
TMP4 = B<TMP1,8>TABHEADSIX;
TMP5 = TMP3;
END
END
IF VTXMAX NQ TMP4-1 OR VTYMAX NQ TMP5-1 THEN
BEGIN # IF SIZE CHANGE REQUIRED #
VTXMAX = TMP4 - 1;
VTYMAX = TMP5 - 1;
IF TMP2 LS 15 THEN VDCTRL(OUT"SCREENSZ1");
ELSE IF TMP2 LS 30 THEN VDCTRL(OUT"SCREENSZ2");
ELSE IF TMP2 LS 45 THEN VDCTRL(OUT"SCREENSZ3");
ELSE VDCTRL(OUT"SCREENSZ4");
END
IOEND # VDTSTD #
CONTROL EJECT;
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
PROC VDTSTM(MODE,STAT);
# TITLE VDTSTM - SET TERMINAL MODE. #
BEGIN # VDTSTM #
#
** VDTSTM - SET TERMINAL MODE.
*
* THIS PROCEDURE SETS THE TERMINAL MODE TO EITHER SCREEN OR LINE.
*
* PROC VDTSTM(MODE,STAT)
*
* ENTRY MODE = 1, IF SCREEN MODE REQUESTED.
* = 0, IF LINE MODE REQUESTED.
*
* EXIT STAT = 1, IF CURRENT MODE IS SCREEN.
* = 0, IF CURRENT MODE IS LINE.
*
*IF UNDEF QTRM
* CALLS VDCTRL, VDTBOO, VDTCLO, VDTGSL, VDTITD, VDTPRT$
* VDTSTR, VDSYNCH, VDTWTO.
*ELSE
* CALLS VDTITD, VDSYNCH.
*ENDIF
*
* USES VTXMAX, VTYMAX.
*
* NOTES VDTSTM DOES NOT SET THE TERMINAL SIZE, THAT
* TASK IS PERFORMED BY A CALL TO VDTSTD. THE
* VDTBOO OUTPUT SEQUENCE INCLUDES THE SEQUENCE
* NECESSARY TO DISABLE PROTECT FOR THE TERMINAL.
* VDTBOO MUST HAVE BEEN CALLED PRIOR TO VDTSTM.
#
ITEM MODE I; # REQUESTED MODE #
ITEM MODELNAME C(6); # *TDU* DEFINED MODEL NAME #
ITEM STAT I; # SELECTED MODE #
DEF XONOFF #O"00164104400100000000"#; # XPARENT ON AND OFF #
VDTITD(MODELNAME); # INITIALIZE *TDU* DEFINITION #
*IF UNDEF,QTRM
VDTGSL(VTMODEL,STAT); # GET MODEL AND SCREEN OR LINE #
*ELSE
MODELNAME = NIT$TRNAM[NIT$CON]; # GET MODELNAME #
MODE = 1;
STAT = 1;
*ENDIF
IF MODELNAME NQ " " THEN
BEGIN # IF OS MODE IS SCREEN #
IF MODE EQ 1 THEN
BEGIN # IF SCREEN MODE IS REQUESTED #
TABLOCKMDE[0] = TABCURADDT[0] EQ 4;
VDSYNCH; # FLUSH ANY OUTPUT #
*IF UNDEF,QTRM
VDTWTO(XONOFF); # XPARENT ON AND OFF #
*ENDIF
CONTROL IFEQ EDITORVDT,1;
IF TABTYPHEAD[0] THEN
BEGIN # IF TYPE AHEAD REQUESTED #
VDTSTR(ENABLEMMSG); # ENABLE MULTI-MSG TRANSPARENT #
VDTPRT$(0); # PROMPT OFF #
END
CONTROL FI;
VDTTFF(OUT"CLREOL",VTCOUNT); # TEST CLEAR EOL AND SET FLAG #
VTCLRFRST[0] = VTCOUNT NQ 0 AND NOT TABLOCKMDE[0];
IF VTCLRFRST[0] THEN
BEGIN # IF TERMINAL HAS A CLEAR TO EOL #
VDTTFF(OUT"CURSORSTR",VTCOUNT);
VTNUMBLNK[0] = VTCOUNT; # FIND BLANK/VDTPOS THRESHOLD #
VDTTFF(OUT"CURSORSEC",VTCOUNT);
VTNUMBLNK[0] = VTNUMBLNK[0] + VTCOUNT;
VDTTFF(OUT"CURSORTHR",VTCOUNT);
VTNUMBLNK[0] = VTNUMBLNK[0] + VTCOUNT;
IF TABCURADDT[0] EQ 3 THEN
BEGIN # IF ANSI #
IF TABXDECIML[0] EQ 0 THEN
BEGIN # IF NOT FIXED LENGTH X/Y #
VTNUMBLNK[0] = VTNUMBLNK[0] + 4;
END
ELSE
BEGIN # FIXED LENGTH COORDINATES #
VTNUMBLNK[0] = VTNUMBLNK[0] + TABXDECIML[0] + TABYDECIML[0];
END
END
ELSE IF TABCURADDT[0] EQ 5 THEN
BEGIN # IF 3151 #
VTNUMBLNK[0] = VTNUMBLNK[0] + 4;
END
ELSE
BEGIN # BINARY OR 721 #
VTNUMBLNK[0] = VTNUMBLNK[0] + 2;
END
END
CONTROL IFEQ EDITORVDT,1;
VDTBOO; # BEGIN OUTPUT SEQUENCE #
CONTROL FI;
SCREENMODE = TRUE; # SCREEN MODE IS TRUE #
VDCTRL(OUT"SETSCRMODE"); # SET SCREEN MODE #
VDTTFF(OUT"UNDERLNEON",VTCOUNT); # TEST UNDERLINE AND SET FLAG #
VTPSUNDREQ[0] = VTCOUNT EQ 0 AND NOT TABLOCKMDE[0];
STAT = 1;
VDSYNCH; # FLUSH OUTPUT #
END
ELSE
BEGIN # IF LINE MODE REQUESTED #
IF SCREENMODE THEN
BEGIN # IF CURRENT MODE IS SCREEN #
VDSYNCH; # FLUSH ANY OUTPUT #
CONTROL IFEQ EDITORVDT,1;
IF TABTYPHEAD[0] THEN
BEGIN # IF TYPE AHEAD WAS ON #
VDTSTR(DISABLMMSG); # DISABLE MULTI-MSG TRANSPARENT #
VDTPRT$(1); # PROMPT ON #
END
CONTROL FI;
VTXMAX = 0; # CLEAR SCREEN SIZE #
VTYMAX = 0;
SCREENMODE = FALSE; # SCREEN MODE IS FALSE #
VDCTRL(OUT"SETLNEMODE"); # SET LINE MODE #
VDSYNCH; # FLUSH OUTPUT #
STAT = 0;
CONTROL IFEQ EDITORVDT,1;
VDTCLO(0); # FLUSH THE OUTPUT BUFFER #
VTTDUREAD[0] = FALSE; # CLEAR VALID TABLE READ FLAG #
CONTROL FI;
END
END
END
ELSE
BEGIN # OS MODE IS LINE #
STAT = 0;
END
END # VDTSTM #
CONTROL FI; # END OF IF SINGLE USER FSE #
*IF UNDEF,QTRM
CONTROL EJECT;
PROC VDTSTR(STRING);
# TITLE VDTSTR - WRITE ONE LINE OF OUTPUT. #
IOBEGIN(VDTSTR)
#
** VDTSTR - WRITE ONE LINE OF OUTPUT.
*
* THIS PROCEDURES WRITES A STRING OF ASCII8 CHARACTERS.
*
* PROC VDTSTR(STRING)
*
* ENTRY STRING = ASCII8 STRING, ZERO BYTE TERMINATED.
*
* USES VTHOLD.
*
* CALLS VDTWTC, VDSYNCH.
#
ARRAY STRING [0:0] P(1);; # LINE IMAGE BUFFER #
BASED ARRAY PARM [0:0] P(1);; # LINE IMAGE BUFFER ADDRESS #
VTHOLD = LOC(STRING); # SAVE PARAMETER ADDRESS #
# END OF NON-REENTRANT PARAMETER USAGE #
VDSYNCH;
# START OF NON-REENTRANT CODE SEQUENCE #
P<PARM> = VTHOLD; # RESTORE BUFFER ADDRESS #
VDTWTC(PARM); # WRITE LINE OF OUTPUT #
# END OF NON-REENTRANT CODE SEQUENCE #
IOEND # VDTSTR #
*ELSE
CONTROL EJECT; # QTRM VARIANT OF VDTSTR #
PROC VDTSTR(STRING);
# TITLE VDTSTR - WRITE ONE LINE OF OUTPUT. #
BEGIN # VDTSTR #
#
** VDTSTR - WRITE ONE LINE OF OUTPUT.
*
* THIS PROCEDURE WRITES A STRING OF ASCII CHARACTERS.
*
* PROC VDTSTR(STRING)
*
* ENTRY STRING = ASCII8 STRING, ZERO BYTE TERMINATED.
*
* USES VTHOLD.
*
* CALLS SFNQUE, VDSYNCH.
#
ARRAY STRING [0:0] P(1); # LINE IMAGE BUFFER #
BEGIN
ITEM STRING$WORD U(00,00,60); # BUFFER WORD (INTEGER) #
END
BASED ARRAY PARM [0:0] P(1);; # LINE IMAGE BUFFER ADDRESS #
ITEM BIT I; # BIT POSITION #
ITEM I I; # DUMMY PARAMETER #
ITEM OH$SEVEN I; # SET FOR 0007 IN BYTE 1 #
ITEM NUMCHAR I; # NUMBER OF CHARACTERS #
ITEM WORD I; # BUFFER WORD #
VTHOLD = LOC(STRING);
VDSYNCH; # POSITION TO A WORD BOUNDARY #
P<PARM> = VTHOLD;
WORD = 0;
BIT = 0;
NUMCHAR = 0;
OH$SEVEN = 0;
IF B<0,12>STRING$WORD[0] EQ O"0007" THEN
BEGIN # IF TRANSPARENT OUTPUT BYTE #
B<0,12>STRING$WORD[0] = O"0000";
OH$SEVEN = 1; # SET FLAG TO RESTORE 0007 BYTE #
NUMCHAR = 1;
BIT = 12;
END
VDTSTR1: # LOOP FOR A ZERO BYTE #
IF B<BIT,12>STRING$WORD[WORD] EQ 0 THEN
BEGIN # IF LAST WORD #
NIT$CTLC = NUMCHAR; # STORE STRING INTO QTRM BUFFER #
SFNQUE("PUT",PARM,I);
IF OH$SEVEN NQ 0 THEN
BEGIN # IF NEED TO RESTORE 0007 BYTE #
B<0,12>STRING$WORD[0] = O"0007";
END
RETURN; # RETURN #
END
NUMCHAR = NUMCHAR + 1; # POSITION TO NEXT CHARACTER #
BIT = BIT + 12;
IF BIT GQ 60 THEN
BEGIN # IF WORD FULL #
BIT = 0; # POSITION TO NEXT WORD #
WORD = WORD + 1;
END
GOTO VDTSTR1; # CONTINUE #
END # VDTSTR #
*ENDIF
CONTROL EJECT;
PROC VDTSTS(TABX);
# TITLE VDTSTS - SET TAB STOP. #
IOBEGIN(VDTSTS)
#
** VDTSTS - SET TAB STOP.
*
* THIS PROCEDURE SETS A TAB STOP AT POSITION TABX ON THE
* CURRENT LINE.
*
* PROC VDTSTS(TABX)
*
* ENTRY TABX = X COORDINATE FOR TAB STOP.
*
* EXIT TAB SET AT POSITION (TABX,VTYCUR).
*
* CALLS VDCTRL, VDMOVE.
#
ITEM TABX I; # X COORDINATE FOR TAB STOP #
# START OF NON-REENTRANT CODE SEQUENCE #
IF TABX GR VTXMAX OR TABX LS 0 THEN IORET
# END OF NON-REENTRANT CODE SEQUENCE #
VDMOVE(TABX,VTYCUR); # POSITION CURSOR #
# END OF NON-REENTRANT PARAMETER USAGE #
VDCTRL(OUT"SETTABSTOP"); # SET TAB STOP #
IOEND # VDTSTS #
*IF DEF,QTRM
CONTROL EJECT; # QTRM VDTWTO ROUTINE #
PROC VDTWTO (A);
# TITLE - WRITE ONE WORD OF OUTPUT. #
BEGIN # VDTWTO #
#
** VDTWTO - WRITE ONE WORD OF OUTPUT.
*
* THIS PROCEDURE WRITES ONE WORD OF OUTPUT FROM BUFFER *A*.
*
* PROC VDTWTO(A)
*
* ENTRY A = THE BUFFER.
*
* CALLS SFNQUE.
#
ARRAY A [0:0] P(1);; # WORD OF OUTPUT #
ITEM I I; # DUMMY PARAMETER #
NIT$CTLC = 5; # PUT WORD INTO QUEUE #
SFNQUE("PUT",A,I);
END # VDTWTO #
*ENDIF
*IF UNDEF,QTRM
CONTROL EJECT; # EDITOR CALLABLE ONLY #
PROC VDSYNCH;
# TITLE VDSYNCH - INSURE FLUSH OF ONE WORD ACCUMULATOR. #
IOBEGIN(VDSYNCH)
#
** VDSYNCH - INSURE FLUSH OF ONE WORD ACCUMULATOR.
*
* THIS PROCEDURE FLUSHES PARTIAL WORDS OF OUTPUT AND INITIALIZES
* THE ACCUMULATOR WORD AND POINTER.
*
* PROC VDSYNCH
*
* ENTRY VTOUTNEXT = ACCUMULATOR BIT POSITION.
* VTOUTDATA = ACCUMULATOR WORD.
*
* EXIT VTOUTDATA = TRANSPARENT OUTPUT WORD.
* VTOUTNEXT = 12.
*
* CALLS VDTWTO.
*
* USES VTOUTDATA, VTOUTNEXT.
#
IF VTOUTNEXT NQ 0 AND VTOUTDATA NQ XPARENTOUT THEN
BEGIN # IF NOT EMPTY ACCUMULATOR #
VDTWTO(VTOUTDATA); # FLUSH ACCUMULATOR WORD #
END
VTOUTDATA = XPARENTOUT; # ASSURE XPARENT OUTPUT #
VTOUTNEXT = 12; # SET BIT POSITION #
IOEND # VDSYNCH #
*ELSE
CONTROL EJECT; # QTRM VERSION OF VDSYNCH #
PROC VDSYNCH;
# TITLE VDSYNCH - INSURE FLUSH OF ONE WORD ACCUMULATOR. #
BEGIN # VDSYNCH #
#
** VDSYNCH - INSURE FLUSH OF ONE WORD ACCUMULATOR.
*
* THIS PROCEDURE FLUSHES PARTIAL WORDS OF OUPUT FOR QTRM.
*
* PROC VDSYNCH
*
* ENTRY VTOUTNEXT = ACCUMULATOR BIT POSITION.
* VTOUTDATA = ACCUMULATOR WORD.
*
* EXIT VTOUTNEXT = 0.
* VTOUTDATA = 0.
*
* CALLS SFNQUE.
#
ITEM I I; # DUMMY PARAMETER #
IF VTOUTNEXT NQ 0 THEN
BEGIN # IF DATA TO ENQUEUE #
NIT$CTLC = VTOUTNEXT / 12; # ENQUEUE DATA #
SFNQUE("PUT",VTOUTDATA,I);
VTOUTDATA = 0; # CLEAR ACCUMULATOR #
VTOUTNEXT = 0; # SET BIT POSITION #
END
END # VDSYNCH #
*ENDIF
CONTROL EJECT; # INTERNAL (VIRTERM) PROCEDURES #
PROC VDCTRL(ORDINAL);
# TITLE VDCTRL - ISSUE AN OUTPUT CONTROL SEQUENCE BY ORDINAL. #
IOBEGIN(VDCTRL)
#
** VDCTRL - ISSUE AN OUTPUT CONTROL SEQUENCE BY ORDINAL.
*
* THIS PROCEDURE OUTPUTS 0 TO N CHARACTERS (BY ORDINAL) USING
* THE ORDINAL AS A POINTER IN THE *TDU* PRODUCED TABLE TO FIND
* THE CORRECT OUTPUT SEQUENCE FOR THE OUTPUT FUNCTION REQUESTED.
*
* PROC VDCTRL(ORDINAL)
*
* ENTRY ORDINAL = *TDU* ORDINAL FOR OUTPUT SEQUENCE.
*
* EXIT NUMBERBYTE = NUMBER OF BYTES OUTPUT FOR SEQUENCE.
*
* CALLS VDGNCP, VDGNOB, VDTOUT, VDSYNCH, VDTWRR$.
*
* USES NUMBERBYTE, VDCHAR, VTCOUNT, VTHOLD, VTI, VTJ.
*
* NOTES NUMBERBYTE IS USED BY VARIOUS ROUTINES AFTER VDCTRL
* IS CALLED TO DETERMINE IF THE FUNCTION IS AVAILABLE.
#
ITEM ORDINAL I; # ORDINAL #
ITEM I I; # COUNTER #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
ITEM RECALL I = 1; # RECALL FOR WRITER REQUEST #
ITEM VTPOS I; # BUFFER POSITION #
CONTROL FI; # END OF IF NOT MULTI USER FSE #
CONTROL EJECT; # EMBEDDED VDCTRL PROCEDURE #
PROC VDGNOB;
# TITLE VDGNOB - GET NEXT OUTPUT BYTE. #
BEGIN # VDGNOB #
#
* VDGNOB - GET NEXT OUTPUT BYTE.
*
* THIS PROCEDURE GETS THE NEXT OUTPUT BYTE.
*
* EXIT VTCHAR = NEXT OUTPUT BYTE.
*
* USES VTCHAR, VTHOLD, VTI, VTJ.
#
VTCOUNT = VTCOUNT - 1;
VTI = VTHOLD / 8;
VTJ = 7 * (VTHOLD - (VTI * 8));
VTCHAR = B<VTJ+4,7>TABFULLWRD[VTI];
VTHOLD = VTHOLD + 1;
END # VDGNOB #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
CONTROL EJECT; # EMBEDDED VDCTRL PROCEDURE #
PROC VDGNCP(VTCUR,VTMAX);
# TITLE VDGNCP - GET NEXT CURSOR POSITION. #
BEGIN # VDGNCP #
#
* VDGNCP - GET NEXT CURSOR POSITION.
*
* THIS PROCEDURE GETS THE NEXT CURSOR POSITION.
*
* ENTRY VTCUR = CURRENT CURSOR POSITION.
* VTMAX = MAXIMUM CURSOR POSITION.
*
* EXIT VTCHAR = CURSOR COORDINATE.
*
* CALLS VDGNOB.
*
* USES VTCHAR, VTHOLD, VTI, VTJ.
#
ITEM VTCUR I; # CURRENT CURSOR POSITION #
ITEM VTMAX I; # MAXIMUM CURSOR POSITION #
IF VTCOUNT NQ 0 THEN
BEGIN # IF SOMETHING TO PROCESS #
VDGNOB; # GET NEXT OUTPUT BYTE #
IF VTCHAR EQ X"7E" THEN
BEGIN # IF USING CURRENT POSITION #
VTCHAR = VTCUR;
END
ELSE
BEGIN # NOT CURRENT POSITION #
IF VTCHAR EQ X"7F" THEN
BEGIN # IF USING MAXIMUM POSITION #
VTCHAR = VTMAX;
END
END
END
END # VDGNCP #
CONTROL FI; # END OF IF NOT MULTI FSE #
CONTROL EJECT; # START OF MAIN CODE FOR VDCTRL #
VTHOLD = ORDINAL;
# END OF NON-REENTRANT PARAMETER USAGE #
NUMBERBYTE = 0; # CLEAR NUMBER OF BYTES COUNT #
IF VTHOLD GR OUT"RESERVED" AND VTHOLD LS OUT"LASTOUT" THEN
BEGIN # IF LEGAL OUTPUT ORDINAL #
VTI = VTHOLD / 5; # GET OFFSET FOR ORDINAL #
VTJ = 12 * (VTHOLD - (VTI * 5));
VTHOLD = B<VTJ,12>TABFULLWRD[VTI];
IF VTJ NQ 48 THEN
BEGIN # IF NEXT BYTE IS IN SAME WORD #
VTCOUNT = B<VTJ+12,12>TABFULLWRD[VTI];
END
ELSE
BEGIN # GET BYTE FROM NEXT WORD #
VTCOUNT = B<0,12>TABFULLWRD[VTI+1];
END
VTCOUNT = VTCOUNT - VTHOLD; # CALCULATE NUMBER OF BYTES #
NUMBERBYTE = VTCOUNT; # SAVE NUMBER OF BYTES #
IF (VTHOLD + VTCOUNT) / 8 LS O"272" THEN
BEGIN # IF WITHIN *TDU* TABLE #
FOR I = I WHILE VTCOUNT NQ 0 DO
BEGIN # WHILE NOT DONE #
VDGNOB; # GET NEXT OUTPUT BYTE #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
CONTROL IFEQ QTRMV,0; # IF NOT QTRM VARIANT #
IF TABLOCKMDE[0] AND (VTCHAR EQ X"11") THEN
BEGIN # IF BLOCK MODE SBA #
CONTROL IFEQ EDITORVDT,0; # IF NOT EDITOR VIRTERM #
P<TTYO> = LISTFETPTR; # SET BASED ARRAY ADDRESS #
CONTROL FI; # END OF NOT EDITOR VIRTERM #
VTI = TTYOIN - TTYOOT;
IF VTI LS 0 THEN
BEGIN # IF *CIRCULAR* INPUT/OUTPUT #
VTI = VTI + (TTYOLM - TTYOFT);
END
IF VTI GR O"144" THEN
BEGIN # IF NEAR *1MI* BREAK THRESHOLD #
VDSYNCH; # FLUSH BUFFER #
*IF DEF,DEBUG
VDTDMP$; # DUMP BUFFER FOR DEBUG #
*ENDIF
VDTWRR$(TTYO,RECALL); # FLUSH BUFFER #
VTOUTDATA = O"0007 4061 4103 0000 0000";
VTOUTNEXT = 36;
END
END
CONTROL FI; # END OF NOT QTRM VIRTERM #
CONTROL FI; # END OF IF NOT MULTI FSE #
VDTOUT(VTCHAR); # OUTPUT BYTE #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TERMINAL #
IF VTCHAR EQ X"11" OR VTCHAR EQ X"12" OR VTCHAR EQ X"14" THEN
BEGIN # IF SBA, RA OR EUA ORDER #
VDGNCP(VTYCUR,VTYMAX+1); # GET ROW COORDINATE #
VTPOS = VTCHAR * (VTXMAX + 1);
VDGNCP(VTXCUR,VTXMAX); # GET COLUMN COORDINATE #
VTPOS = VTPOS + VTCHAR;
VDTOUT(RTA3270[B<48,6>VTPOS]); # OUTPUT BYTE 1 OF ADDRESS #
VDTOUT(RTA3270[B<54,6>VTPOS]); # OUTPUT BYTE 2 OF ADDRESS #
END
ELSE IF VTCHAR EQ X"1D" THEN
BEGIN # IF START FIELD #
VTCHAR = 0;
IF VTCOUNT NQ 0 THEN
VDGNOB; # GET NEXT OUTPUT BYTE #
IF ATTGUARDMD[0] THEN
BEGIN # IF GUARD MODE #
VTCHAR = X"3C"; # ASSUME UNPROTECTED #
END
ELSE
BEGIN # IF UNGUARDED FIELD #
IF VTCHAR EQ X"38" THEN
BEGIN # IF HIGHLIGHTED FIELD #
IF NOT ATTPROTECT[0] THEN VTCHAR = VTCHAR + X"10";
END
ELSE
BEGIN
VTCHAR = X"44"; # ASSUME UNPROTECTED AND NORMAL #
IF ATTPROTECT[0] THEN VTCHAR = VTCHAR - X"10";
END
END
VDTOUT(VTCHAR); # OUTPUT FIELD ATTRIBUTE #
END
END
CONTROL FI; # END OF IF NOT MULTI FSE #
END
END
END
IOEND # VDCTRL #
CONTROL EJECT;
CONTROL IFEQ SINGLE,1;
PROC VDGETW(WORD,STAT);
# TITLE VDGETW - GET WORD FROM *TDU* TABLE. #
BEGIN # VDGETW #
#
** VDGETW - GET WORD FROM *TDU* TABLE.
*
* THIS PROCEDURE GETS THE NEXT WORD FROM THE *TDU* TABLE FOR
* EITHER A RESIDENT OR A NON-RESIDENT TABLE.
*
* PROC VDGETW(WORD,STAT)
*
* ENTRY TDUINDEX = WORD COUNT READ SO FAR OF *TDU* TABLE.
* TDURESID = RESIDENT *TDU* TABLE FLAG.
*
* EXIT WORD = THE NEXT WORD FROM THE *TDU* TABLE.
* STAT = 0, IF NO ERROR.
*
* CALLS VDTREO$.
*
* USES TDUINDEX.
#
ITEM STAT I; # STATUS RETURNED #
ITEM WORD U; # WORD FROM *TDU* TABLE #
STAT = 0;
IF TDURESID[0] THEN
BEGIN # IF RESIDENT *TDU* TABLE #
WORD = TEMPWORD[TDUINDEX[0]]; # GET WORD FROM MEMORY #
END
ELSE
BEGIN # IF NON-RESIDENT *TDU* TABLE #
VDTREO$(TDUFET,WORD,STAT); # READ WORD FROM CIO BUFFER #
END
TDUINDEX[0] = TDUINDEX[0] + 1; # UPDATE COUNT #
END # VDGETW #
CONTROL FI;
CONTROL EJECT;
PROC VDMOVE(XX,YY);
# TITLE VDMOVE - CURSOR MOVEMENT. #
IOBEGIN(VDMOVE)
#
** VDMOVE - CURSOR MOVEMENT.
*
* THIS PROCEDURE PROVIDES CURSOR POSITIONING.
*
* PROC VDMOVE(XX,YY)
*
* ENTRY XX = DESIRED X COORDINATE.
* YY = DESIRED Y COORDINATE.
*
* EXIT VTXCUR = XX.
* VTYCUR = YY.
*
* CALLS VDCTRL.
*
* USES VTXCUR, VTYCUR.
#
ITEM XX I; # COLUMN POSITION #
ITEM YY I; # LINE POSITION #
SWITCH CURADDRTYP # CURSOR ADDRESSING TYPE #
NONE, # UNDEFINED #
BINARY, # BINARY #
CDC721, # CDC 721 #
ANSI, # ANSI #
IBM3270, # 3270 #
IBM3151; # 3151 #
VTXCUR = XX;
VTYCUR = YY;
# END OF NON-REENTRANT PARAMETER USAGE #
VDCTRL(OUT"CURSORSTR"); # ISSUE CURSOR START SEQUENCE #
GOTO CURADDRTYP[TABCURADDT[0]]; # PROCESS ADDRESSING BY TYPE #
BINARY: # BINARY TYPE ADDRESSING #
IF TABXFIRSTY[0] THEN
BEGIN # IF X COORDINATE FIRST #
VDTOUT(VTXCUR+TABCURBIAS[0]); # X COORDINATE #
VDCTRL(OUT"CURSORSEC"); # ISSUE SECOND CURSOR SEQUENCE #
VDTOUT(VTYCUR+TABCURBIAS[0]); # Y COORDINATE #
END
ELSE
BEGIN # Y COORDINATE FIRST #
VDTOUT(VTYCUR+TABCURBIAS[0]); # Y COORDINATE #
VDCTRL(OUT"CURSORSEC"); # ISSUE SECOND CURSOR SEQUENCE #
VDTOUT(VTXCUR+TABCURBIAS[0]); # X COORDINATE #
END
VDCTRL(OUT"CURSORTHR"); # ISSUE THIRD CURSOR SEQUENCE #
GOTO ENDADDRTYP;
CDC721: # CDC 721 TYPE ADDRESSING #
IF NOT TABXFIRSTY[0] THEN
VDTOUT(VTYCUR+TABCURBIAS[0]); # IF ROW FIRST, Y COORDINATE #
IF VTXCUR LS 80 THEN
BEGIN # IF CHARACTER POSITION 0 - 79 #
VDTOUT(VTXCUR+TABCURBIAS[0]); # X COORDINATE #
END
ELSE
BEGIN # IF CHARACTER POSITION PAST 79 #
VDCTRL(OUT"CURSORSEC"); # ISSUE SECOND CURSOR SEQUENCE #
VDTOUT(VTXCUR+TABCURBIAS[0]-80); # X COORDINATE #
END
IF TABXFIRSTY[0] THEN
VDTOUT(VTYCUR+TABCURBIAS[0]); # IF COLUMN FIRST, Y COORDINATE #
VDCTRL(OUT"CURSORTHR"); # ISSUE THIRD CURSOR SEQUENCE #
GOTO ENDADDRTYP;
ANSI: # ANSI TYPE ADDRESSING #
IF TABXFIRSTY[0] THEN
BEGIN # IF X COORDINATE FIRST #
VDNUMC(VTXCUR+TABCURBIAS[0]+1,TABXDECIML[0]); # X COORDINATE #
VDCTRL(OUT"CURSORSEC"); # ISSUE SECOND CURSOR SEQUENCE #
VDNUMC(VTYCUR+TABCURBIAS[0]+1,TABYDECIML[0]); # Y COORDINATE #
END
ELSE
BEGIN # Y COORDINATE FIRST #
VDNUMC(VTYCUR+TABCURBIAS[0]+1,TABYDECIML[0]); # Y COORDINATE #
VDCTRL(OUT"CURSORSEC"); # ISSUE SECOND CURSOR SEQUENCE #
VDNUMC(VTXCUR+TABCURBIAS[0]+1,TABXDECIML[0]); # X COORDINATE #
END
VDCTRL(OUT"CURSORTHR"); # ISSUE THIRD CURSOR SEQUENCE #
GOTO ENDADDRTYP;
IBM3270:
GOTO ENDADDRTYP;
IBM3151:
IF TABXFIRSTY[0] THEN
BEGIN # IF X COORDINATE FIRST #
VTHOLD = VTXCUR/32;
VDTOUT(VTHOLD+TABCURBIAS[0]); # X COORDINATE #
VDTOUT(VTXCUR-VTHOLD*32+TABCURBIAS[0]);
VDCTRL(OUT"CURSORSEC"); # ISSUE SECOND CURSOR SEQUENCE #
VTHOLD = VTYCUR/32;
VDTOUT(VTHOLD+TABCURBIAS[0]); # Y COORDINATE #
VDTOUT(VTYCUR-VTHOLD*32+TABCURBIAS[0]+32);
END
ELSE
BEGIN # Y COORDINATE FIRST #
VTHOLD = VTYCUR/32;
VDTOUT(VTHOLD+TABCURBIAS[0]); # Y COORDINATE #
VDTOUT(VTYCUR-VTHOLD*32+TABCURBIAS[0]);
VDCTRL(OUT"CURSORSEC"); # ISSUE SECOND CURSOR SEQUENCE #
VTHOLD = VTXCUR/32;
VDTOUT(VTHOLD+TABCURBIAS[0]); # X COORDINATE #
VDTOUT(VTXCUR-VTHOLD*32+TABCURBIAS[0]+32);
END
VDCTRL(OUT"CURSORTHR"); # ISSUE THIRD CURSOR SEQUENCE #
GOTO ENDADDRTYP;
NONE: # UNDEFINED #
ENDADDRTYP: # END OF ADDRESS TYPE PROCESSING #
IOEND # VDMOVE #
CONTROL EJECT;
PROC VDNUMC(NUM,COUNT);
# TITLE VDNUMC - NUMBER CONVERSION. #
IOBEGIN(VDNUMC)
#
** VDNUMC - NUMBER CONVERSION.
*
* THIS PROCEDURE PROVIDES FOR A BINARY NUMBER TO BE CONVERTED
* TO DECIMAL AND THEN OUTPUT TO ALLOW ANSI X3.64 POSITIONING.
*
* PROC VDNUMC(NUM,COUNT)
*
* ENTRY NUM = BINARY NUMBER TO BE CONVERTED AND OUTPUT.
* COUNT = MINIMUM NUMBER OF CHARACTERS TO OUTPUT.
*
* CALLS VDTOUT.
*
* USES VTCHARS, VTCOUNT, VTHOLD, VTI.
#
ITEM NUM I; # BINARY SCREEN COORDINATE #
ITEM COUNT I; # MINIMUM NUMBER OF DIGITS #
ITEM DB I; # INDUCTION VARIABLE #
VTI = COUNT - 2; # MINIMUM CHARACTER COUNT #
VTCOUNT = - 1; # ACTUAL DIGIT COUNTER #
VTHOLD = NUM; # SCREEN COORDINATE #
# END OF NON-REENTRANT PARAMETER USAGE #
# START OF NON-REENTRANT CODE SEQUENCE #
FOR DB = DB WHILE VTHOLD GQ 10 DO
BEGIN
VTCOUNT = VTCOUNT + 1; # INCREMENT DIGIT COUNTER #
C<VTCOUNT>VTCHARS = (VTHOLD - ((VTHOLD/10) * 10));
VTHOLD = VTHOLD / 10; # REDUCE BY FACTOR OF TEN #
VTI = VTI - 1; # DECREMENT MINIMUM COUNT #
END
# END OF NON-REENTRANT CODE SEQUENCE #
FOR VTI = VTI STEP - 1 UNTIL 0 DO
BEGIN # ZERO PAD AS NECESSARY #
VDTOUT(X"30"); # OUTPUT ZERO CHARACTER #
END
VDTOUT(VTHOLD+X"30"); # FIRST (NON-ZERO) DIGIT #
FOR VTCOUNT = VTCOUNT STEP - 1 UNTIL 0 DO
BEGIN # OUTPUT REST OF DIGITS #
VTHOLD = C<VTCOUNT>VTCHARS;
VDTOUT(VTHOLD+X"30");
END
IOEND # VDNUMC #
CONTROL EJECT;
PROC VDNXTI;
# TITLE VDNXTI - FETCH NEXT INPUT BYTE FROM BUFFER/ACCUMULATOR. #
IOBEGIN(VDNXTI)
#
** VDNXTI - FETCH NEXT INPUT BYTE FROM BUFFER/ACCUMULATOR.
*
* THIS PROCEDURE GETS THE NEXT INPUT CHARACTER.
*
* PROC VDNXTI
*
* ENTRY VTINPDATA = ONE WORD INPUT DE-ACCUMULATOR.
* VTINPNEXT = CURRENT BIT POSITION IN VTINPDATA.
*
* EXIT VTINPNEXT = INCREMENTED OR RECIRCULATED.
* VTINPDATA = POSSIBLE NEW WORD OF TEXT.
* VTCHAR = DATA BYTE FETCHED.
*
* CALLS VDTRDO.
*
* USES VTINPDATA, VTINPNEXT.
#
IF VTINPNEXT EQ 60 THEN
BEGIN # IF EMPTY WORD #
*IF UNDEF,QTRM
VDTRDO(VTINPDATA); # GET NEXT WORD #
*ELSE
VTINPDATA = QTRM$WD0[VTINPWORD]; # GET NEXT WORD FROM QUEUE #
VTINPWORD = VTINPWORD + 1;
*ENDIF
VTINPNEXT = 0; # RESET BIT POSITION #
END
VTCHAR = B<VTINPNEXT,12>VTINPDATA; # GET NEXT CHARACTER #
VTCHAR = B<53,7>VTCHAR; # RIGHT JUSTIFY CHARACTER #
VTINPNEXT = VTINPNEXT + 12; # INCREMENT BIT POSITION #
IOEND # VDNXTI #
CONTROL EJECT; # INPUT PROCESSING #
PROC VDTIINP;
# TITLE VDTIINP - IDENTIFY NEXT VIRTUAL INPUT EVENT. #
IOBEGIN(VDTIINP)
#
** VDTIINP - IDENTIFY NEXT VIRTUAL INPUT EVENT.
*
* THIS PROCEDURE IDENTIFIES THE NEXT VIRTUAL TERMINAL INPUT
* EVENT. THIS ROUTINE IS INTERNAL AND IS CALLED DIRECTLY BY
* THE FULL SCREEN EDITOR AFTER VDTPPI HAS BEEN CALLED.
*
* PROC VDTIINP
*
* ENTRY VTINCR = RESIDUAL CURSOR INCREMENT.
* VTXMAX = NUMBER OF COLUMNS ON SCREEN.
* VTYMAX = NUMBER OF LINES ON SCREEN.
*
* EXIT VTORDN = EVENT CATEGORY.
* VTCHAR = DATA CHARACTER OR FUNCTION KEY INDEX.
* VTYCUR = Y COORDINATE OF CURSOR POSITION.
* VTXCUR = X COORDINATE OF CURSOR POSITION.
* VTOYPOS = OLD Y COORDINATE (HOME ONLY).
* VTOXPOS = OLD X COORDINATE (HOME ONLY).
* VTINCR = SETUP FOR NEXT VDTINP CALL.
*
* CALLS VDNXTI, VDCHECK.
*
* NOTES THE INP SWITCH MUST EXACTLY PARALLEL *TDU* PRODUCED
* INPUT ORDINALS. IN SOME CASES WHERE COMMON CODE IS
* USED THE SIMULATED CASE STATEMENT ALLOWS A FALL THRU
* TO FINISH THE CODE FOR A PARTICULAR FUNCTION.
#
STATUS OPCODES # *TDU* INPUT OPCODES #
FAIL, # FAIL #
LIST, # LIST #
MANY, # MANY ACTION RANGE #
SNGL, # SINGLE ACTION RANGE #
MAXOP; # HIGHER THAN ANY VALID CODE #
SWITCH INP:INPUTORD # INPUT ORDINALS (SEE *COMFVDT*) #
# START OF CDC DEFINED INPUT/OUTPUT ORDINALS #
BADINPUT : BADINPUT, # UNRECOGNIZED SEQUENCE #
INSERTCHAR : INSERTCHAR, # INSERT CHARACTER #
DELETECHAR : DELETECHAR, # DELETE CHARACTER #
INSERTLINE : INSERTLINE, # INSERT LINE #
INSLNECURL : INSLNECURL, # INSERT LINE, CURSOR LEFT #
DELETELINE : DELETELINE, # DELETE LINE #
DELINECURL : DELINECURL, # DELETE LINE, CURSOR LEFT #
CLRSCREEN : CLRSCREEN, # CLEAR SCREEN #
CLRSCRCURH : CLRSCRCURH, # CLEAR SCREEN, CURSOR HOME #
CLRUNPROT : CLRUNPROT, # CLEAR UNPROTECTED #
CLREOS : CLREOS, # CLEAR TO END OF SCREEN #
ERASELINE : ERASELINE, # ERASE LINE #
ERASELNECL : ERASELNECL, # ERASE LINE, CURSOR LEFT #
CLREOL : CLREOL, # CLEAR TO END OF LINE #
NOOP : CLRFIELD, # CLEAR UNPROTECTED FIELD #
NOOP : CLRFLDCBOF, # CLEAR FIELD, CURSOR LEFT #
NOOP : CLREOF, # CLEAR TO END OF FIELD #
ERASECHAR : ERASECHAR, # ERASE CHARACTER #
CURSORHOME : CURSORHOME, # CURSOR HOME #
CURSORUP : CURSORUP, # CURSOR UP #
CURSORDOWN : CURSORDOWN, # CURSOR DOWN #
CURSORLEFT : CURSORLEFT, # CURSOR LEFT #
CURSORIGHT : CURSORIGHT, # CURSOR RIGHT #
TABFORWARD : TABFORWARD, # TAB FORWARD #
TABACKWARD : TABACKWARD, # TAB BACKWARD #
RET : RET, # RETURN #
RESET : RESET, # RESET #
INSRTMDEON : INSRTMDEON, # INSERT MODE ON #
INSRTMDOFF : INSRTMDOFF, # INSERT MODE OFF #
INSRTMDTOG : INSRTMDTOG, # INSERT MODE TOGGLE #
CLRTABSTOP : CLRTABSTOP, # CLEAR TAB STOP #
CLRALLTABS : CLRALLTABS, # CLEAR ALL TAB STOPS #
SETTABSTOP : SETTABSTOP, # SET TAB STOP #
CURSORSTR : CURSORSTR, # CURSOR POSITION START #
CURSORSEC : CURSORSEC, # CURSOR POSITION SECOND #
CURSORTHR : CURSORTHR, # CURSOR POSITION THIRD #
# START OF CDC DEFINED INPUT ONLY ORDINALS. #
EOI : EOI, # END OF INFORMATION #
CHARACTER : CHARACTER, # OVERSTRIKE CHARACTER #
FKEY : F1, # FUNCTION KEY 1 #
FKEY : F2, # FUNCTION KEY 2 #
FKEY : F3, # FUNCTION KEY 3 #
FKEY : F4, # FUNCTION KEY 4 #
FKEY : F5, # FUNCTION KEY 5 #
FKEY : F6, # FUNCTION KEY 6 #
FKEY : F7, # FUNCTION KEY 7 #
FKEY : F8, # FUNCTION KEY 8 #
FKEY : F9, # FUNCTION KEY 9 #
FKEY : F10, # FUNCTION KEY 10 #
FKEY : F11, # FUNCTION KEY 11 #
FKEY : F12, # FUNCTION KEY 12 #
FKEY : F13, # FUNCTION KEY 13 #
FKEY : F14, # FUNCTION KEY 14 #
FKEY : F15, # FUNCTION KEY 15 #
FKEY : F16, # FUNCTION KEY 16 #
FKEYSHIFT : F1S, # SHIFTED FUNCTION KEY 1 #
FKEYSHIFT : F2S, # SHIFTED FUNCTION KEY 2 #
FKEYSHIFT : F3S, # SHIFTED FUNCTION KEY 3 #
FKEYSHIFT : F4S, # SHIFTED FUNCTION KEY 4 #
FKEYSHIFT : F5S, # SHIFTED FUNCTION KEY 5 #
FKEYSHIFT : F6S, # SHIFTED FUNCTION KEY 6 #
FKEYSHIFT : F7S, # SHIFTED FUNCTION KEY 7 #
FKEYSHIFT : F8S, # SHIFTED FUNCTION KEY 8 #
FKEYSHIFT : F9S, # SHIFTED FUNCTION KEY 9 #
FKEYSHIFT : F10S, # SHIFTED FUNCTION KEY 10 #
FKEYSHIFT : F11S, # SHIFTED FUNCTION KEY 11 #
FKEYSHIFT : F12S, # SHIFTED FUNCTION KEY 12 #
FKEYSHIFT : F13S, # SHIFTED FUNCTION KEY 13 #
FKEYSHIFT : F14S, # SHIFTED FUNCTION KEY 14 #
FKEYSHIFT : F15S, # SHIFTED FUNCTION KEY 15 #
FKEYSHIFT : F16S, # SHIFTED FUNCTION KEY 16 #
GKEY : NEXTKEY, # NEXT KEY #
GKEY : BACKKEY, # BACK KEY #
GKEY : HELPKEY, # HELP KEY #
GKEY : STOPKEY, # STOP KEY #
GKEY : DOWNKEY, # DOWN KEY #
GKEY : UPKEY, # UP KEY #
GKEY : FWDKEY, # FWD KEY #
GKEY : BKWKEY, # BKW KEY #
GKEY : EDITKEY, # EDIT KEY #
GKEY : DATAKEY, # DATA KEY #
GKEYSHIFT : SHFNEXT, # SHIFTED NEXT KEY #
GKEYSHIFT : SHFBACK, # SHIFTED BACK KEY #
GKEYSHIFT : SHFHELP, # SHIFTED HELP KEY #
GKEYSHIFT : SHFSTOP, # SHIFTED STOP KEY #
GKEYSHIFT : SHFDOWN, # SHIFTED DOWN KEY #
GKEYSHIFT : SHFUP, # SHIFTED UP KEY #
GKEYSHIFT : SHFFWD, # SHIFTED FWD KEY #
GKEYSHIFT : SHFBKW, # SHIFTED BKW KEY #
GKEYSHIFT : SHFEDIT, # SHIFTED EDIT KEY #
GKEYSHIFT : SHFDATA, # SHIFTED BKW KEY #
BACKSPACE : BACKSPACE, # BACK SPACE #
FKEYX : F17, # FUNCTION KEY 17 #
FKEYX : F18, # FUNCTION KEY 18 #
FKEYX : F19, # FUNCTION KEY 19 #
FKEYX : F20, # FUNCTION KEY 20 #
FKEYX : F21, # FUNCTION KEY 21 #
FKEYX : F22, # FUNCTION KEY 22 #
FKEYX : F23, # FUNCTION KEY 23 #
FKEYX : F24, # FUNCTION KEY 24 #
FKEYXS : F17S, # SHIFTED FUNCTION KEY 17 #
FKEYXS : F18S, # SHIFTED FUNCTION KEY 18 #
FKEYXS : F19S, # SHIFTED FUNCTION KEY 19 #
FKEYXS : F20S, # SHIFTED FUNCTION KEY 20 #
FKEYXS : F21S, # SHIFTED FUNCTION KEY 21 #
FKEYXS : F22S, # SHIFTED FUNCTION KEY 22 #
FKEYXS : F23S, # SHIFTED FUNCTION KEY 23 #
FKEYXS : F24S, # SHIFTED FUNCTION KEY 24 #
# START OF INSTALLATION INPUT ORDINALS DEFINED VIA *TDU*. #
BADINPUT : IINP1, # INSTALLATION INPUT SEQUENCE 1 #
BADINPUT : IINP2, # INSTALLATION INPUT SEQUENCE 2 #
BADINPUT : IINP3, # INSTALLATION INPUT SEQUENCE 3 #
BADINPUT : IINP4, # INSTALLATION INPUT SEQUENCE 4 #
BADINPUT : IINP5, # INSTALLATION INPUT SEQUENCE 5 #
BADINPUT : IINP6, # INSTALLATION INPUT SEQUENCE 6 #
BADINPUT : IINP7, # INSTALLATION INPUT SEQUENCE 7 #
BADINPUT : IINP8, # INSTALLATION INPUT SEQUENCE 8 #
BADINPUT : IINP9, # INSTALLATION INPUT SEQUENCE 9 #
BADINPUT : IINP10, # INSTALLATION INPUT SEQUENCE 10 #
BADINPUT : IINP11, # INSTALLATION INPUT SEQUENCE 11 #
BADINPUT : IINP12, # INSTALLATION INPUT SEQUENCE 12 #
BADINPUT : IINP13, # INSTALLATION INPUT SEQUENCE 13 #
BADINPUT : IINP14, # INSTALLATION INPUT SEQUENCE 14 #
BADINPUT : IINP15, # INSTALLATION INPUT SEQUENCE 15 #
BADINPUT : IINP16, # INSTALLATION INPUT SEQUENCE 16 #
BADINPUT : IINP17, # INSTALLATION INPUT SEQUENCE 17 #
BADINPUT : IINP18, # INSTALLATION INPUT SEQUENCE 18 #
BADINPUT : IINP19, # INSTALLATION INPUT SEQUENCE 19 #
BADINPUT : IINP20, # INSTALLATION INPUT SEQUENCE 20 #
# END OF INSTALLATION INPUT ORDINALS. #
BADINPUT : MAXPLUS1; # LEGAL ORDINALS MUST BE LESS #
CONTROL EJECT; # EMBEDDED VDTIINP PROCEDURE #
PROC VDGETS;
# TITLE VDGETS - GET SEPTET. #
BEGIN # VDGETS #
#
* VDGETS - GET SEPTET.
*
* THIS PROCEDURE GETS THE NEXT SEVEN BITS FROM THE INPUT TABLE.
*
* ENTRY VTCOUNT = OFFSET INTO INPUT TABLE.
*
* EXIT VTHOLD = SEPTET.
* VTCOUNT = INCREMENTED IF WITHIN TABLE.
*
* USES VTHOLD.
#
ITEM WORDINDEX I; # WORD INDEX INTO INPUT TABLE #
ITEM BITPINDEX I; # BIT POSITION INDEX INTO WORD #
WORDINDEX = VTCOUNT / 8;
IF WORDINDEX LS (TABSTRNMES[0] - TABSTRINPT[0]) THEN
BEGIN # IF WITHIN *TDU* TABLE #
BITPINDEX = 4 + (7 * ((VTCOUNT - (WORDINDEX * 8))));
VTHOLD = B<BITPINDEX,7>TABFULLWRD[WORDINDEX + TABSTRINPT[0] - 6 ];
VTCOUNT = VTCOUNT + 1; # INCREMENT POINTER #
END
ELSE # IF OUTSIDE OF *TDU* TABLE #
BEGIN
VTHOLD = -1; # RETURN FAIL INDICATION #
END
END # VDGETS #
CONTROL EJECT; # EMBEDDED VDTIINP PROCEDURE #
PROC VDLIST;
# TITLE VDLIST - CHECK LIST FOR CHARACTER. #
BEGIN # VDLIST #
#
* VDLIST - CHECK LIST FOR CHARACTER.
*
* THIS PROCEDURE CHECKS FOR AN INPUT CHARACTER IN A LIST.
*
* ENTRY VTCOUNT = OFFSET INTO INPUT TABLE FOR LIST SIZE.
*
* EXIT VTCOUNT = OFFSET INTO INPUT TABLE FOR ACTION,
* OR NEXT OPCODE IF NO MATCH FOUND.
* VTI = 0, IF NO CHARACTER MATCH FOUND, OR
* NONZERO IF MATCH FOUND.
*
* USES VTHOLD, VTI.
#
VDGETS; # GET LENGTH OF LIST #
FOR VTI = VTHOLD STEP -1 WHILE VTI GR 0 AND VTHOLD GQ 0 DO
BEGIN # SEARCH FOR CHARACTER #
VDGETS; # GET CHARACTER #
IF VTCHAR EQ VTHOLD THEN
BEGIN # IF MATCH FOUND #
RETURN; # RETURN - CHARACTER FOUND #
END
ELSE
BEGIN # NO MATCH #
VTCOUNT = VTCOUNT + 2; # INCREMENT OFFSET #
END
END
END # VDLIST #
CONTROL EJECT; # EMBEDDED VDTIINP PROCEDURE #
PROC VDMANY;
# TITLE VDMANY - CHECK MANY ACTION RANGE FOR CHARACTER. #
BEGIN # VDMANY #
#
* VDMANY - CHECK MANY ACTION RANGE FOR CHARACTER.
*
* THIS PROCEDURE CHECKS A MANY ACTION RANGE FOR A CHARACTER.
*
* ENTRY VTCOUNT = OFFSET INTO INPUT TABLE FOR RANGE PAIR.
*
* EXIT VTCOUNT = OFFSET INTO INPUT TABLE FOR ACTION,
* OR NEXT OPCODE IF NO MATCH FOUND.
* VTI = 0, IF NO CHARACTER MATCH FOUND, OR
* NONZERO IF MATCH FOUND.
*
* USES VTHOLD, VTI.
#
VDGETS; # GET LOWER RANGE CHARACTER #
IF VTHOLD GQ 0 THEN
BEGIN # IF GOOD TABLE ENTRY #
VTI = VTHOLD;
VDGETS; # GET UPPER RANGE CHARACTER #
IF VTHOLD GQ 0 THEN
BEGIN # IF GOOD TABLE ENTRY #
VTJ = VTHOLD;
IF VTCHAR GQ VTI AND VTCHAR LQ VTJ THEN
BEGIN # IF CHARACTER WITHIN RANGE #
VTCOUNT = VTCOUNT + ((VTCHAR - VTI) * 2); # ACTION OFFSET #
VTI = 1;
END
ELSE
BEGIN # OFFSET FOR NEXT OPCODE #
VTCOUNT = VTCOUNT + ((VTJ - VTI + 1) * 2); # OPCODE OFFSET #
VTI = 0;
END
END
END
END # VDMANY #
CONTROL EJECT; # EMBEDDED VDTIINP PROCEDURE #
PROC VDSNGL;
# TITLE VDSNGL - CHECK SINGLE ACTION RANGE FOR CHARACTER. #
BEGIN # VDSNGL #
#
* VDSNGL - CHECK SINGLE ACTION RANGE FOR CHARACTER.
*
* THIS PROCEDURE CHECKS A SINGLE ACTION RANGE FOR A CHARACTER.
*
* ENTRY VTCOUNT = OFFSET INTO INPUT TABLE FOR RANGE PAIR.
*
* EXIT VTCOUNT = OFFSET INTO INPUT TABLE FOR ACTION,
* OR NEXT OPCODE IF NO MATCH FOUND.
* VTI = 0, IF NO CHARACTER MATCH FOUND, OR
* NONZERO IF MATCH FOUND.
*
* USES VTHOLD, VTI.
#
VDGETS; # GET LOWER RANGE CHARACTER #
IF VTHOLD GQ 0 THEN
BEGIN # IF GOOD TABLE ENTRY #
VTI = VTHOLD;
VDGETS; # GET UPPER RANGE CHARACTER #
IF VTHOLD GQ 0 THEN
BEGIN # IF GOOD TABLE ENTRY #
VTJ = VTHOLD;
IF VTCHAR GQ VTI AND VTCHAR LQ VTJ THEN
BEGIN # IF CHARACTER WITHIN RANGE #
VTI = 1;
END
ELSE
BEGIN # IF NO MATCH #
VTCOUNT = VTCOUNT + 2; # OFFSET FOR NEXT OPCODE #
VTI = 0;
END
END
END
END # VDSNGL #
CONTROL EJECT; # EMBEDDED VDTIINP PROCEDURE #
PROC VDCHEK;
# TITLE VDCHEK - CHECK VIRTUAL TERMINAL INPUT SEQUENCE. #
IOBEGIN(VDCHEK) # VDCHEK #
#
* VDCHEK - CHECK VIRTUAL TERMINAL INPUT SEQUENCE.
*
* THIS PROCEDURE MAPS INPUT SEQUENCES TO INP ORDINALS.
*
* EXIT VTORDN = INPUT EVENT ORDINAL.
*
* CALLS VDNXTI, VDGETS, VDSNGL, VDMANY, VDLIST.
*
* USES VTCOUNT, VTHOLD, VTI, VTORDN.
*
* NOTES OPCODE SWITCH DEPENDS ON *TDU* PRODUCED VALUES.
#
ARRAY ACT [0:0] P(1); # DEFINED ACTION FOR SEQUENCE #
BEGIN
ITEM ACTONE U(00,46,07); # FIRST SEPTET OF ACTION #
ITEM ACTTWO U(00,53,07); # SECOND SEPTET OF ACTION #
ITEM ACTION I(00,46,14); # ACTION AS SIGNED INTEGER #
END
SWITCH OPCODE:OPCODES # BASED ON *TDU* INPUT OPCODES #
FAIL:FAIL, # FAIL #
LIST:LIST, # LIST #
MANY:MANY, # MANY ACTION RANGE #
SNGL:SNGL; # SINGLE ACTION RANGE #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
IF VTRESINP NQ 0 THEN
BEGIN # IF ONLY SBA ALLOWED #
VDNXTI; # GET NEXT INPUT CHARACTER #
IF VTCHAR EQ X"11" THEN
BEGIN # IF SBA #
VTORDN = 33; # CURSORSTR #
END
ELSE
BEGIN # NOT SBA #
IF VTCHAR EQ X"00" THEN
BEGIN # IF EOI #
VTORDN = 36; # EOI #
END
ELSE
BEGIN # CHARACTER #
VTORDN = 37;
END
END
IORET
END
CONTROL FI; # END OF IF NOT MULTI FSE #
VTCOUNT = 0; # SEARCH ENTIRE TABLE #
VTI = 0; # NO MATCH FOUND YET #
VDNXTI; # GET INPUT #
IF TABVTFKLSM[0] EQ 0 AND NOT TABLOCKMDE[0] THEN
BEGIN # IF A CHAR IS A CHAR IS A CHAR #
IF VTCHAR GQ X"20" AND VTCHAR LQ X"7E" THEN
BEGIN # IF VALID CHARACTER #
VTORDN = 37;
IORET # RETURN #
END
END
PARSE:
VDGETS; # GET OPCODE #
IF VTHOLD GQ 0 AND VTHOLD LS OPCODES"MAXOP" THEN
GOTO OPCODE[VTHOLD]; # IF OPCODE WITHIN RANGE #
FAIL: # FAIL #
VTORDN = 0; # UNRECOGNIZED SEQUENCE #
IORET # RETURN #
LIST: # LIST #
VDLIST;
GOTO ENDCASE;
MANY: # MANY ACTION RANGE #
VDMANY;
GOTO ENDCASE;
SNGL: # SINGLE ACTION RANGE #
VDSNGL;
ENDCASE:
IF VTHOLD LS 0 THEN GOTO FAIL; # IF TABLE SEARCH FAILED #
IF VTI EQ 0 THEN GOTO PARSE; # IF NO MATCH FOUND YET #
# START OF NON-REENTRANT CODE SEQUENCE #
VDGETS; # PUT ACTION INTO VTHOLD #
IF VTHOLD LS 0 THEN GOTO FAIL; # IF TABLE SEARCH FAILED #
ACTONE = VTHOLD;
VDGETS;
IF VTHOLD LS 0 THEN GOTO FAIL; # IF TABLE SEARCH FAILED #
ACTTWO = VTHOLD;
VTHOLD = ACTION;
# END OF NON-REENTRANT CODE SEQUENCE #
IF VTHOLD GQ 0 THEN
BEGIN # IF ACTION IS AN OFFSET #
VTCOUNT = VTHOLD; # CONTINUE WITH PARSING #
VDNXTI; # GET NEXT INPUT BYTE #
GOTO PARSE; # CONTINUE SEQUENCE #
END
ELSE
BEGIN
VTORDN = ABS(VTHOLD); # RETURN INP ORDINAL #
END
IOEND # VDCHEK #
CONTROL EJECT; # START OF MAIN CODE FOR VDTIINP #
IF VTINCR NQ 0 THEN
BEGIN # IF POSITION NEEDS UPDATING #
VTINCR = 0;
VTXCUR = VTXCUR + 1; # INCREMENT X POSITION #
IF VTXCUR GR VTXMAX THEN
BEGIN # IF PAST COLUMN BOUNDARY #
IF TABRGHTCHR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTXCUR = 0; # CLEAR X POSITION #
IF TABRGHTCHR[0] EQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF SPIRAL #
VTYCUR = VTYCUR + 1; # INCREMENT Y POSITION #
IF VTYCUR GR VTYMAX THEN
BEGIN # IF PAST LINE BOUNDARY #
IF TABLASTPOS[0] EQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF SPIRAL #
VTYCUR = 0; # CLEAR Y POSITION #
END
ELSE # STOP, WRAP OR SCROLL #
BEGIN
VTYCUR = VTYMAX; # SET Y TO LAST LINE #
IF TABLASTPOS[0] EQ CURSORMOVE"SCROLL" THEN
BEGIN # IF SCROLL #
VTORDN = SCREENST"CLRPAG";
IORET # RETURN SOFT CLEAR PAGE #
END
END
END
END
END
ELSE
BEGIN # IF STOP #
VTXCUR = VTXMAX; # SET X TO LAST COLUMN #
END
END
END
VDCHEK; # CHECK INPUT SEQUENCE #
IF VTORDN LS INPUTORD"MAXPLUS1" THEN GOTO INP[VTORDN];
# FALL THROUGH TO FAIL CASE #
BADINPUT: # UNRECOGNIZED SEQUENCE #
IF VTCHAR EQ X"14" THEN
BEGIN # IF CONTROL-T #
VTORDN = SCREENST"GKEY"; # RETURN GENERIC STOP #
VTCHAR = 4;
END
ELSE
BEGIN # NOT CONTROL-T #
VTORDN = SCREENST"BAD"; # BAD INPUT #
END
IORET # RETURN #
CONTROL EJECT;
NOOP: # CURRENTLY NON OPERATIONAL #
VTORDN = SCREENST"NOOP";
IORET # RETURN #
INSERTCHAR: # INSERT CHARACTER #
VTCHAR = X"20"; # BLANK #
VTORDN = SCREENST"INSC";
IORET # RETURN #
DELETECHAR: # DELETE CHARACTER #
VTORDN = SCREENST"DELC";
IORET # RETURN #
INSLNECURL: # INSERT LINE, CURSOR LEFT #
VTXCUR = 0; # FALL THROUGH TO COMMON CODE #
INSERTLINE: # INSERT LINE #
VTORDN = SCREENST"INSL";
IORET # RETURN #
DELINECURL: # DELETE LINE, CURSOR LEFT #
VTXCUR = 0; # FALL THROUGH TO COMMON CODE #
DELETELINE: # DELETE LINE #
VTORDN = SCREENST"DELL";
IORET
CLRSCRCURH: # CLEAR SCREEN, CURSOR HOME #
VTOXPOS = VTXCUR; # SAVE CURSOR POSITION #
VTOYPOS = VTYCUR;
IF TABVTHOMEU[0] THEN VTYCUR = 0; ELSE VTYCUR = VTYMAX;
VTXCUR = 0; # FALL THROUGH TO COMMON CODE #
CLRSCREEN: # CLEAR SCREEN #
VTORDN = SCREENST"CLRPAG";
IORET # RETURN #
CLRUNPROT: # CLEAR UNPROTECTED #
VTORDN = SCREENST"CLRUNP";
IORET # RETURN #
CLREOS: # CLEAR TO END OF SCREEN #
VTORDN = SCREENST"CLREOP";
IORET # RETURN #
ERASELNECL: # ERASE LINE, CURSOR LEFT #
VTXCUR = 0; # FALL THROUGH TO COMMON CODE #
ERASELINE: # ERASE LINE #
VTORDN = SCREENST"ERAL";
IORET # RETURN #
CLREOL: # CLEAR TO END OF LINE #
VTORDN = SCREENST"CLREOL";
IORET # RETURN #
ERASECHAR: # ERASE CHARACTER #
VTDELT = 6; # CURSOR MOVEMENT ORDINAL #
VTXCUR = VTXCUR - 1;
VTORDN = SCREENST"ERAC";
IF VTXCUR LS 0 THEN
BEGIN # IF OFF LEFT SIDE OF SCREEN #
IF TABLEFTCHR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTXCUR = VTXMAX; # CURSOR IS IN LAST COLUMN #
IF TABLEFTCHR[0] EQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF CURSOR IS ON PREVIOUS LINE #
VTYCUR = VTYCUR - 1; # DECREMENT AND CHECK BOUNDARY #
IF VTYCUR LS 0 THEN VTYCUR = VTYMAX;
END
END
ELSE
BEGIN # CURSOR HAS STOPPED AT LEFT #
VTXCUR = 0; # CURSOR IS IN FIRST COLUMN #
END
END
IORET # RETURN #
CURSORHOME: # CURSOR HOME #
VTOXPOS = VTXCUR; # SAVE CURSOR POSITION #
VTOYPOS = VTYCUR;
VTXCUR = 0; # SET POSITION TO HOME #
IF TABVTHOMEU[0] THEN VTYCUR = 0; ELSE VTYCUR = VTYMAX;
VTORDN = SCREENST"HOME";
IORET # RETURN #
CURSORUP: # CURSOR UP #
VTDELT = 4; # CURSOR MOVEMENT ORDINAL #
VTYCUR = VTYCUR - 1;
VTORDN = SCREENST"UP";
IF VTYCUR LS 0 THEN
BEGIN # IF OFF TOP OF SCREEN #
IF TABUPCURSR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTYCUR = VTYMAX; # CURSOR IS ON LAST LINE #
IF TABUPCURSR[0] EQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF CURSOR IN PREVIOUS COLUMN #
VTXCUR = VTXCUR - 1; # DECREMENT AND CHECK BOUNDARY #
IF VTXCUR LS 0 THEN VTXCUR = VTXMAX;
END
END
ELSE
BEGIN # CURSOR HAS STOPPED AT TOP #
VTYCUR = 0; # CURSOR IS ON FIRST LINE #
END
END
IORET # RETURN #
CURSORDOWN: # CURSOR DOWN #
VTDELT = 2; # CURSOR MOVEMENT ORDINAL #
VTYCUR = VTYCUR + 1;
VTORDN = SCREENST"DOWN";
IF VTYCUR GR VTYMAX THEN
BEGIN # IF OFF BOTTOM TOP OF SCREEN #
IF TABDWNCRSR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTYCUR = 0; # CURSOR IS ON FIRST LINE #
IF TABDWNCRSR[0] EQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF CURSOR IS IN NEXT COLUMN #
VTXCUR = VTXCUR + 1; # INCREMENT AND CHECK BOUNDARY #
IF VTXCUR GR VTXMAX THEN VTXCUR = 0;
END
END
ELSE
BEGIN # SCROLL OR STOP #
IF TABDWNCRSR[0] EQ CURSORMOVE"SCROLL" THEN
BEGIN # TERMINAL HAS SCROLLED #
VTORDN = SCREENST"CLRPAG"; # RETURN SOFT CLEAR PAGE #
END
ELSE
BEGIN # CURSOR HAS STOPPED AT BOTTOM #
VTYCUR = VTYMAX; # CURSOR IS ON LAST LINE #
END
END
END
IORET # RETURN #
CURSORLEFT: # CURSOR LEFT #
VTDELT = 1; # CURSOR MOVEMENT ORDINAL #
VTXCUR = VTXCUR - 1;
VTORDN = SCREENST"LEFT";
IF VTXCUR LS 0 THEN
BEGIN # IF OFF LEFT SIDE OF SCREEN #
IF TABLEFTCUR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTXCUR = VTXMAX; # CURSOR IS IN LAST COLUMN #
IF TABLEFTCUR[0] EQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF CURSOR IN PREVIOUS ROW #
VTYCUR = VTYCUR - 1; # DECREMENT AND CHECK BOUNDARY #
IF VTYCUR LS 0 THEN
BEGIN # IF BACKWARD WRAP FROM TOP LINE #
IF NOT TABPTDWBPG[0] THEN VTYCUR = VTYMAX;
ELSE
BEGIN # IF CANNOT PAGE WRAP BACKWARD #
VTXCUR = 0;
VTYCUR = 0;
END
END
END
END
ELSE
BEGIN # CURSOR HAS STOPPED AT LEFT #
VTXCUR = 0; # CURSOR IS IN FIRST COLUMN #
END
END
IORET # RETURN #
CURSORIGHT: # CURSOR RIGHT #
VTDELT = 3; # CURSOR MOVEMENT ORDINAL #
VTXCUR = VTXCUR + 1;
VTORDN = SCREENST"RIGHT";
IF VTXCUR GR VTXMAX THEN
BEGIN # IF OFF RIGHT SIDE OF SCREEN #
IF TABRGHTCUR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTXCUR = 0; # CURSOR IS IN FIRST COLUMN #
IF TABRGHTCUR[0] EQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF CURSOR IS IN NEXT ROW #
VTYCUR = VTYCUR + 1; # INCREMENT AND CHECK BOUNDARY #
IF VTYCUR GR VTYMAX THEN VTYCUR = 0;
END
END
ELSE
BEGIN # CURSOR HAS STOPPED AT RIGHT #
VTXCUR = VTXMAX; # CURSOR IS IN LAST COLUMN #
END
END
IORET # RETURN #
TABFORWARD: # TAB FORWARD #
VTORDN = SCREENST"FTAB";
IORET # RETURN #
TABACKWARD: # TAB BACKWARD #
VTORDN = SCREENST"BTAB";
IORET # RETURN #
RET: # RETURN FUNCTION #
VTORDN = SCREENST"RET";
IORET # RETURN #
RESET: # RESET FUNCTION #
VTORDN = SCREENST"RESET";
IORET # RETURN #
INSRTMDEON: # INSERT MODE ON #
VTINSMODE[0] = TRUE;
VTORDN = SCREENST"NOOP";
IORET # RETURN #
INSRTMDOFF: # INSERT MODE OFF #
VTINSMODE[0] = FALSE;
VTORDN = SCREENST"NOOP";
IORET # RETURN #
INSRTMDTOG: # INSERT MODE TOGGLE #
VTINSMODE[0] = NOT VTINSMODE[0];
VTORDN = SCREENST"NOOP";
IORET # RETURN #
CLRTABSTOP: # CLEAR TAB STOP #
VTORDN = SCREENST"CLRTAB";
IORET # RETURN #
CLRALLTABS: # CLEAR ALL TABS #
VTORDN = SCREENST"CLRALL";
IORET # RETURN #
SETTABSTOP: # SET TAB STOP #
VTORDN = SCREENST"SETTAB";
IORET # RETURN #
CURSORSTR: # CURSOR POSITION START #
IF TABCURADDT[0] EQ 2 THEN
BEGIN # IF CDC 721 #
VDNXTI; # GET TOUCH PANEL POSITION #
IF VTCHAR EQ X"7E" THEN
BEGIN # 132 COLUMN TOUCH PANEL INPUT #
VDNXTI;
IF VTCHAR NQ TABCURBIAS[0] THEN
BEGIN # IF PAST COLUMN 80 #
VDNXTI;
VTXCUR = VTCHAR - TABCURBIAS[0] + 80;
VDNXTI;
VTYCUR = VTCHAR - TABCURBIAS[0];
VTCHAR = GENERICST"GPOS"; # RETURN GENERIC TYPE #
VTORDN = SCREENST"GKEY"; # RETURN ORDINAL #
IORET # RETURN #
END
ELSE
BEGIN # NOT PAST COLUMN 80 #
VDNXTI;
END
END
VTXCUR = VTCHAR - TABCURBIAS[0];
VDNXTI;
VTYCUR = VTCHAR - TABCURBIAS[0];
VTCHAR = GENERICST"GPOS"; # RETURN GENERIC TYPE #
VTORDN = SCREENST"GKEY"; # RETURN ORDINAL #
END
ELSE
BEGIN # IF NOT CDC 721 TOUCH PANEL #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TERMINAL #
VDNXTI; # GET BUFFER ADDRESS #
VTHOLD = ATR3270[VTCHAR] * 64;
VDNXTI; # CALCULATE COORDINATES #
VTHOLD = VTHOLD + ATR3270[VTCHAR];
VTYCUR = VTHOLD / (VTXMAX + 1);
VTXCUR = VTHOLD - (VTYCUR * (VTXMAX + 1));
IF VTRESINP NQ 0 THEN
BEGIN # IF NOT JUST RESIDUAL INPUT #
VTORDN = SCREENST"STRTFLD";
END
ELSE
BEGIN # REFLECT FINAL CURSOR POSITION #
VTORDN = SCREENST"NOOP";
END
END
ELSE
BEGIN # NOT 721 TOUCH PANEL #
CONTROL FI; # END OF IF NOT MULTI FSE #
VTORDN = SCREENST"NOOP"; # CURRENTLY UNSUPPORTED #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
END
CONTROL FI; # END OF IF NOT MULTI FSE #
END
IORET # RETURN #
CURSORSEC: # CURSOR POSITION SECOND #
CURSORTHR: # CURSOR POSITION THIRD #
VTORDN = SCREENST"NOOP"; # CURRENTLY UNSUPPORTED #
IORET # RETURN #
EOI: # END OF INFORMATION #
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
IF VTRESINP NQ 0 THEN
BEGIN # IF RESIDUAL INPUT TO PROCESS #
VTINPDATA = VTRESINP;
VTINPNEXT = 0;
VTRESINP = 0;
GOTO CURSORSTR; # PROCESS FINAL CURSOR POSITION #
END
CONTROL FI; # END OF IF NOT MULTI FSE #
VTORDN = SCREENST"EOI";
IORET # RETURN #
CHARACTER: # OVERSTRIKE CHARACTER #
IF VTCHAR GQ X"20" AND VTCHAR LQ X"7E" THEN
BEGIN # IF VALID CHARACTER #
VTINCR = 1;
VTORDN = SCREENST"CHAR";
IF VTINSMODE[0] THEN VTORDN = SCREENST"INSC";
END
ELSE
BEGIN # NOT VALID CHARACTER #
IF VTCHAR EQ X"14" THEN
BEGIN # IF CONTROL-T #
VTORDN = SCREENST"GKEY"; # RETURN GENERIC STOP #
VTCHAR = 4;
END
ELSE
BEGIN # NOT CONTROL-T #
VTORDN = SCREENST"BAD"; # BAD INPUT #
END
END
IORET # RETURN #
FKEYX: # FUNCTION KEY 17 THROUGH 24 #
VTORDN = VTORDN - INPUTORD"BACKSPACE" + INPUTORD"F16";
FKEY: # FUNCTION KEY 1 THROUGH 16 #
IF TABVTFKLSM[0] NQ 0 THEN VTINCR = TABVTFKLSM[0];
VTCHAR = VTORDN - INPUTORD"CHARACTER";
VTORDN = SCREENST"FKEY"; # RETURN ORDINAL #
IORET # RETURN #
FKEYXS: # SHIFTED KEY 17 THROUGH 24 #
VTORDN = VTORDN - INPUTORD"F24" + INPUTORD"F16S";
FKEYSHIFT: # SHIFTED KEY 1 THROUGH 16 #
IF TABVTFKLSM[0] NQ 0 THEN VTINCR = TABVTFKLSM[0];
VTCHAR = VTORDN - INPUTORD"F16";
VTCHAR = -VTCHAR; # RETURN NEGATIVE VALUE #
VTORDN = SCREENST"FKEY"; # RETURN ORDINAL #
IORET # RETURN #
GKEY: # GENERIC FUNCTION KEYS #
IF TABVTFKLSM[0] NQ 0 THEN VTINCR = TABVTFKLSM[0];
VTCHAR = VTORDN - INPUTORD"F16S";
VTORDN = SCREENST"GKEY"; # RETURN ORDINAL #
IORET # RETURN #
GKEYSHIFT: # SHIFTED GENERIC KEYS #
IF TABVTFKLSM[0] NQ 0 THEN VTINCR = TABVTFKLSM[0];
VTCHAR = VTORDN - INPUTORD"DATAKEY";
VTCHAR = -VTCHAR; # RETURN NEGATIVE VALUE #
VTORDN = SCREENST"GKEY"; # RETURN ORDINAL #
IORET # RETURN #
BACKSPACE: # BACK SPACE #
VTDELT = 5; # CURSOR MOVEMENT ORDINAL #
VTXCUR = VTXCUR - 1;
VTORDN = SCREENST"LEFT";
IF VTXCUR LS 0 THEN
BEGIN # IF OFF LEFT SIDE OF SCREEN #
IF TABLEFTCHR[0] GQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF WRAP OR SPIRAL #
VTXCUR = VTXMAX; # CURSOR IS IN LAST COLUMN #
IF TABLEFTCHR[0] EQ CURSORMOVE"SPIRAL" THEN
BEGIN # IF CURSOR IS ON PREVIOUS LINE #
VTYCUR = VTYCUR - 1; # DECREMENT AND CHECK BOUNDARY #
IF VTYCUR LS 0 THEN
BEGIN # IF BACKWARD WRAP FROM TOP LINE #
IF NOT TABPTDWBPG[0] THEN VTYCUR = VTYMAX;
ELSE
BEGIN # IF CANNOT PAGE WRAP BACKWARD #
VTXCUR = 0;
VTYCUR = 0;
END
END
END
END
ELSE
BEGIN # CURSOR HAS STOPPED AT LEFT #
VTXCUR = 0; # CURSOR IS IN FIRST COLUMN #
END
END
IORET # RETURN #
IOEND # VDTIINP #
END # VIRTERM # TERM