Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0135/06/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;