Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/comp/vtmcur.mac
There are 2 other files named vtmcur.mac in the archive. Click here to see a list.
00100 COMMENT * vtmcur, SIMULA specification;
00200 OPTIONS(/E:QUICK,vtmcur);
00300 PROCEDURE vtmcur(param,horiz,vertic);
00400 NAME param; INTEGER param; INTEGER horiz,vertic;
00500 COMMENT moves the cursor to the screen position
00600 identified by horiz,vertic;
00700
00800
00900 !*;! MACRO-10 code !*;!
01000
01100 TITLE vtmcur
01200 ENTRY vtmcur ;! simula calling
01300 ENTRY mamcur ;! macro calling, with xbase,xlow,xwac1,xbh loaded
01400 ENTRY symcur ;! always move, even if you are there
01500 SUBTTL VIDED subroutine, Jacob Palme 1978
01600
01700 ;!*** Copyright 1978 by the Swedish Defence Research Institute. ***
01800
01900 sall
02000 search simmac,simmcr,simrpa
02100 search vtmvda
02200 macinit
02300
02400 COMMENT* REGISTER USAGE IN THIS PROCEDURE
02500 X0 Temporary use
02600 X1 Used by IONB via OUTCHR, other temporary use
02700 X2 ==XTAC when calling function procedures
02800 X3 ==XWAC1 = first parameter used to load XBASE,
02900 = reference to sysout used by IONB via OUTCHR
03000 X4 == ep temporary use as byte pointer elite 2500 dca
03100 X5 ==horiz
03200 X6 ==vertic
03300 X7 ==XBH = used by OUTCHR, buffer header pointer
03400 X10 free
03500 X11 free
03600 X12 ==I = loop variable
03700 = used for byte pointer to elitecursors
03800 X13 ==XTYP = terminal type number
03900 X14 ==XBASE = base of mvistax SIMULA data block
04000 X15 ==XCB current block pointer, used by RTS
04100 X16 ==XLOW points to static area in RTS, used by RTS
04200 X17 ==XPDP push down list pointer
04300 *;!
04400
04500 bup==OFFSET(ZBHBUP)
04600 cnt==OFFSET(ZBHCNT)
04700
04800 ;! OUTCHR assumes XWAC1 = file ref for Sysout, XBH pointer to
04900 ;! buffer header. XWAC1==AC3, XBH==AC7.
05000 ;! OUTCHR moves the character in AC0 to the SYSOUT output
05100 ;! file buffer. IF a parameter is given, the contents of
05200 ;! the word with the given offset from xbase is loaded into
05300 ;! AC0 first. xbase refers to the mvistax class block instance.
05400
05500 DEFINE outchr(c)<
05600 IFNB <c>,<L c(xbase)>
05700 SOSGE cnt(XBH)
05800 XEC IONB
05900 IDPB bup(XBH)
06000 >
06100
06200 ;! trueoutchr takes its parameter in X0
06300 DEFINE trueoutchr<
06400 XEC troutc
06500 >
06600
06700 DEFINE elicur(n)<
06800 IF2,<IFNDEF VT$BPT,<EXTERN VT$BPT>>
06900 LI X0,(n)
07000 IDIVI X0,5
07100 HLL X0,VT$BPT+1(X1)
07200 ADDI X0,elitecursors
07300 LDB X0,X0>
07400
07500 ;! Local definitions ;!
07600
07700 horiz==XWAC1+2 ;! AC5
07800 vertic==horiz+1 ;! AC6
07900
08000 xbase==X14 ;! base of mvistax class instance block
08100 xtyp== X13 ;! terminal type number
08200 bp==X4 ;! temporary byte pointer for elite 2500
08300 i==X12 ;! index in no of character loops
08400
08500 vtmcur: PROC ;! entry point when called from SIMULA
08600 ;! Set up environment variables
08700 LF xbase,ZFLZBI(,XWAC1) ;! Base of MVISTAX block (vtmvda offsets)
08800 LOWADR ;! XLOW points to static area
08900 L XWAC1,YSYSOUT(XLOW) ;! XWAC1==AC3:- Sysout for OUTCHR!
09000 LF XBH,ZFIOBH(XWAC1) ;! XBH==AC7:- buffer header
09100 SUBI XBH,1 ;! Compute buffer header reference
09200 L xtyp,trmtyp(xbase) ;! terminaltype in register xtyp
09300
09400 mamcur: ;! entry point when called from MACRO
09500 ;! IF horiz = q_horizontalpos AND vertic = q_verticalpos
09600 ;! THEN GOTO moved
09700 IF
09800 CAMN horiz,qhoriz(xbase)
09900 CAME vertic,qvertic(xbase)
10000 GOTO FALSE
10100 THEN
10200 GOTO moved
10300 FI
10400
10500 symcur: ;! entry point where always moving
10600 SKIPN qdisplayoutput(xbase) ;! IF NOT q_display_output THEN
10700 GOTO moved ;! no terminal output
10800 IF ;! direct cursor addressing
10900 SKIPN direct(xbase)
11000 GOTO FALSE
11100 THEN
11200 IF ;! terminaltype = minitec
11300 CAME xtyp,minitec(xbase)
11400 GOTO FALSE
11500 THEN
11600 LI QESC
11700 outchr
11800 outchr(addressscreen)
11900 LI 177
12000 SUB horiz
12100 trueoutchar ;! trueoutchr(127-horiz)
12200 LI 177
12300 SUB vertic
12400 trueoutchar ;! trueoutchr(127-vertic)
12500 ELSE
12600 IF ;! elite <= terminaltype <= kthelite
12700 CAML xtyp,elite(xbase)
12800 CAMLE xtyp,kthelite(xbase)
12900 GOTO FALSE
13000 THEN
13100 outchr(addressscreen)
13200 ;! true_outchr(fetchar(elitecursors,horiz+1))
13300 ;! elitecursors is local literal in this macro program
13400 elicur(horiz)
13500 trueoutchar
13600 ;! true_outchr(fetchar(elitecursors,vertic+1))
13700 ;! elitecursors is local literal in this macro program
13800 elicur(vertic)
13900 trueoutchar
14000 ELSE
14100 IF ;! terminaltype = newelite OR elite1521 OR
14200 ;! newkthelite OR i200 OR elite3025
14300 CAME xtyp,newelite(xbase)
14400 CAMN xtyp,elite1521(xbase)
14500 GOTO TRUE
14600 CAMN xtyp,newkthelite(xbase)
14700 GOTO TRUE
14800 CAMN xtyp,elite3025(xbase)
14900 GOTO TRUE
15000 CAME xtyp,i200(xbase)
15100 GOTO FALSE
15200 THEN
15210 IF ;! addaltmode
15219 SKIPN addaltmode(xbase)
15228 GOTO FALSE
15237 THEN
15246 LI qesc
15255 outchr
15264 FI
15300 outchr(addressscreen)
15400 LI 40(horiz) ;! true_outchr(horiz+40)
15500 trueoutchr
15600 LI 40(vertic) ;! true_outchr(horiz+40)
15700 trueoutchr
15800 ELSE
15900 IF ;! terminaltype = volker414H THEN
16000 CAME xtyp,vc414h(xbase)
16100 GOTO FALSE
16200 THEN
16300 LI qesc ;! outchr(sysout,altmode,1)
16400 outchr
16500
16600 ;! forceout(sysout)
16700 ofile==xwac1
16800 LF XBH,ZFIOBH(ofile)
16900 SUBI XBH,1
17000 LF X1,ZBHZBU(XBH)
17100 HRRZ X2,OFFSET(ZBHBUP)(XBH)
17200 IF ;! Nothing written
17300 CAIG X2,2(X1)
17400 SKIPE 2(X1)
17500 GOTO FALSE
17600 THEN
17700 GOTO forced ;! IONB returns here!
17800 FI
17900 XEC IONB
18000 forced:
18100
18200 ;! outche(ioindex,address_screen)
18300 LI X0,"Q"-100 ;! CONTROL-Q
18400 TTCALL 15,0 ;! image mode output
18500
18600 ;! true_outchr(char(if horiz < 32 then horiz+96 else horiz))
18700 LI 140(horiz) ;! X0:= horiz+96
18800 CAIL horiz,40
18900 LI 0(horiz) ;! X0:= horiz
19000 trueoutchr
19100 ;! true_outchr(vertic+64)
19200 LI 100(vertic) ;! X0:= vertic+64
19300 trueoutchr
19400 ELSE ;! All other terminal modes at present
19500 IF
19600 SKIPN addaltmode(xbase) ;! If addaltmode
19700 GOTO FALSE
19800 THEN
19900 LI qesc
20000 outchr
20100 FI
20200 outchr(addressscreen)
20300 LI 40(vertic) ;! true_outchr(vertic+40)
20400 trueoutchr
20500 LI 40(horiz) ;! true_outchr(horiz+40)
20600 trueoutchr
20700 FI FI FI FI
20800 GOTO moved
20900 FI
00100 ;! here comes the code not using direct-cursor-addressing
00200 ;! moving the cursor by left, right, up, down shifts
00300
00400 ;! IF terminaltype = tandberg THEN
00500 IF
00600 CAME xtyp,tandberg(xbase)
00700 GOTO FALSE
00800 THEN
00900 ;! BEGIN COMMENT TANDBERG TDV 2000 is funny on last screen line;!
01000 ;! IF q_verticalpos = heightm1 AND vertic < heightm1 THEN
01100 L X0,heim1(xbase)
01200 IF
01300 CAMN X0,qverticalpos(xbase)
01400 CAMGE X0,vertic
01500 GOTO FALSE
01600 THEN
01700 ;! BEGIN outchr(terminalout,home,1);!
01800 ;! q_horizontalpos:= q_verticalpos:= 0;!
01900 outchr(home)
02000 SETZM qhorizontalpos(xbase)
02100 SETZM qverticalalpos(xbase)
02200 ;! END;!
02300 FI
02400 ;! END;!
02500 FI
02600 ;! IF horiz < q_horizontalpos//2 THEN
02700 L X0,qhorizontalpos(xbase)
02800 ASH X0,-1
02900 IF
03000 CAML horiz,X0
03100 GOTO FALSE
03200 THEN
03300 ;! BEGIN
03400 ;! q_horizontalpos:= 0;!
03500 SETZM qhorizontalpos(xbase)
03600 ;! IF allow_cr AND vertic > q_verticalpos//2 THEN
03700 IF
03800 SKIPN allowcr(xbase)
03900 GOTO FALSE
04000 L X0,qverticalpos(xbase)
04100 ASH X0,-1
04200 CAMG vertic,X0
04300 GOTO FALSE
04400 THEN
04500 ;! outchr(terminalout,carriagereturn,1) ELSE
04600 outchr(carriagereturn)
04700 ELSE
04800 ;! BEGIN
04900 ;! IF NOT homesingle THEN outchr(terminalout,altmode,1)
05000 IF
05100 SKIPE homesingle(xbase)
05200 GOTO FALSE
05300 THEN
05400 LI qesc
05500 outchr
05600 ;! ELSE outchr(terminalout,home,1);!
05700 ELSE
05800 outchr(home)
05900 FI
06000 ;! outchr(terminalout,home,1);!
06100 outchr(home)
06200 ;! IF terminaltype = cdc71310s THEN q_verticalpos:= heightm1
06300 IF
06400 CAME xtyp,cdc73s(xbase)
06500 GOTO FALSE
06600 THEN
06700 L X0,heim1(xbase)
06800 ST qvertic(xbase)
06900 ;! ELSE q_verticalpos:= 0;!
07000 ELSE
07100 SETZM qvertic(xbase)
07200 FI
07300 ;! END;!
07400 FI
07500 ;! END;!
07600 FI
00100 ;! IF addaltmode THEN
00200 IF
00300 SKIPN addaltmode(xbase)
00400 GOTO FALSE
00500 ;! BEGIN
00600 THEN
00700 ;! FOR i:= horiz+1 STEP 1 UNTIL q_horizontalpos DO
00800 L i,qhorizontalpos(xbase)
00900 SUBI i,0(horiz) ;! i:=i-horiz-0
01000 WHILE
01100 SOJL i,FALSE ;! Subtract 1, jump if i < 0
01200 DO
01300 ;! BEGIN IF NOT leftsingle THEN outchr(terminalout,altmode,1);!
01400 IF
01500 SKIPE leftsingle(xbase)
01600 GOTO FALSE
01700 THEN
01800 LI QESC
01900 outchr
02000 FI
02100 ;! outchr(terminalout,left,1);!
02200 outchr(left)
02300 ;! END;!
02400 OD
02500
02600 ;! FOR i:= q_horizontalpos+1 STEP 1 UNTIL horiz DO
02700 L i,horiz
02800 SUB i,qhorizontalpos(xbase)
02900 WHILE
03000 SOJL i,FALSE ;! Subtract 1, jump if i < 0
03100 DO
03200 ;! BEGIN IF NOT rightsingle THEN outchr(terminalout,altmode,1);!
03300 IF
03400 SKIPE rightsingle(xbase)
03500 GOTO FALSE
03600 THEN
03700 LI QESC
03800 outchr
03900 FI
04000 ;! outchr(terminalout,right,1);!
04100 outchr(right)
04200 ;! END;!
04300 OD
04400
04500 ;! FOR i:= vertic+1 STEP 1 UNTIL q_verticalpos DO
04600 L i,qverticalpos(xbase)
04700 SUBI i,0(vertic)
04800 WHILE
04900 SOJL i,FALSE
05000 DO
05100 ;! BEGIN IF NOT upsingle THEN outchr(terminalout,altmode,1);!
05200 IF
05300 SKIPE upsingle(xbase)
05400 GOTO FALSE
05500 THEN
05600 LI QESC
05700 outchr
05800 FI
05900 ;! outchr(terminalout,up,1);!
06000 outchr(up)
06100 ;! END;!
06200 OD
06300
06400 ;! FOR i:= q_verticalpos+1 STEP 1 UNTIL vertic DO
06500 L i,vertic
06600 SUB i,qverticalpos(xbase)
06700 WHILE
06800 SOJL i,FALSE
06900 DO
07000 ;! BEGIN IF NOT downsingle THEN outchr(terminalout,altmode,1);!
07100 IF
07200 SKIPE downsingle(xbase)
07300 GOTO FALSE
07400 THEN
07500 LI QESC
07600 outchr
07700 FI
07800 ;! outchr(terminalout,down,1);!
07900 outchr(down)
08000 ;! END;!
08100 OD
08200
08300 ;! END ELSE
08400 ELSE
08500 ;! BEGIN
08600 ;! outchr(terminalout,right,horiz-q_horizontalpos);!
08700 ;! outchr(terminalout,left,q_horizontalpos-horiz);!
08800 ;! outchr(terminalout,down,vertic-q_verticalpos);!
08900 ;! outchr(terminalout,up,q_verticalpos-vertic);!
09000 L i,qhorizontalpos(xbase)
09100 SUBI i,0(horiz) ;! i:=i-horiz-0 = number of left shifts
09200 WHILE ;! Left shifts needed
09300 SOJL i,FALSE ;! Subtract 1, jump if i < 0
09400 DO
09500 outchr(left)
09600 OD
09700
09800 ;! Here, i = -1 if number of left shifts was >= 0,
09900 ;! i e no more horizontal movement needed here,
10000 ;! or i = -<number of right shifts> - 1
10100
10200 WHILE ;! More right shifts needed
10300 AOJE i,FALSE ;! Add 1, jump if i >= 0
10400 DO
10500 outchr(right)
10600 OD
10700
10800 L i,qverticalpos(xbase)
10900 SUBI i,0(vertic)
11000 WHILE ;! Upward shifts needed
11100 SOJL i,FALSE
11200 DO
11300 outchr(up)
11400 OD
11500
11600 ;! Here, i = -1 if number of upward shifts was >= 0,
11700 ;! i e no more vertical movement needed here,
11800 ;! or i = -<number of downward shifts> - 1
11900
12000 WHILE ;! Downward shifts needed
12100 AOJE i,FALSE ;! Add 1, jump if i >= 0
12200 DO
12300 outchr(down)
12400 OD
12500 FI
12600
12700 ;! now the cursor has been moved to the right position
12800 ;! moved:
12900 ;! q_horizontalpos:= horiz;! q_verticalpos:= vertic;!
13000 ;! !z_t(-5);!
13100 ;!END;!
13200 moved: ST horiz,qhorizontalpos(xbase) ;! q_horizontalpos:= horiz
13300 ST vertic,qverticalpos(xbase) ;! q_verticalpos:= vertic
13400 RETURN
13500 EPROC
13600 ;! elitecursors:- copy("`abcdefghijklmnop"
13700 ;! "qrstuvwxyz{|}~5@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ !""#"
13800 ;! "$%&'()*+,-./");
13900 ;! depchar(elitecursors,32,fill);
14000 elitecursors: ASCII "`abcdefghijklmnopqrstuvwxyz{|}"
14100 BYTE (7)"~",QDEL,"@","A","B"
14200 ASCII |CDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ !"#$%&'()*+,-./|
00100 subttl trueoutchar
00200
00300 DEFINE subst(x,y)<
00400 RADIX 10
00500 CAIE x
00600 GOTO .+3
00700 LI y
00800 GOTO trou
00900 RADIX 8
01000 >
01100
01200 troutc: PROC
01300 IF ;! ttyqz
01400 SKIPN ttyqz(xbase)
01500 GOTO FALSE
01600 THEN
01700 IF ;! ttyzq
01800 SKIPN ttyzq(xbase)
01900 GOTO FALSE
02000 THEN
02100 subst 35,124
02200 subst 36,126
02300 subst 64,92
02400 subst 91,35
02500 subst 92,64
02600 subst 93,36
02700 subst 96,91
02800 subst 124,96
02900 subst 126,93
03000 ELSE
03100 subst 35,91
03200 subst 36,93
03300 subst 64,92
03400 subst 91,35
03500 subst 92,64
03600 subst 93,36
03700 subst 96,124
03800 subst 124,96
03900 FI
04000 ELSE
04100 IF ;! ttyzq
04200 SKIPN ttyzq(xbase)
04300 GOTO FALSE
04400 THEN
04500 subst 35,96
04600 subst 36,126
04700 subst 96,35
04800 subst 126,36
04900 FI FI
05000 trou:! outchr
05100 RET
05200 EPROC
00100 LIT
00200 END;