github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-06 11:03:21 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/dpypak/dpynew.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1870 lines
63 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE DPYPAK -- VIDEO DISPLAY PACKAGE
SUBTTL C.D. OTOOLE/CDO/WSM/NT 4-DEC-79
;*** COPYRIGHT (C) 1977, 1978, 1979, 1982, 1983
;DIGITAL EQUIPMENT CORP., MARLBORO, MASS. ***
SALL ;CLEAN UP LISTING
SYN IFE,IF ;DEFINE NEW PSEUDO OP FOR PRETTY CONDITIONALS
IFNDEF TOPS,<TOPS==10> ;BUILD TOPS10 DPYPAK
IF TOPS-10,<SEARCH UUOSYM>
IF TOPS-20,<SEARCH MONSYM>
TWOSEG
RELOC 400000
;DEFINE SOME AC'S FIRST
CHAR==0 ;CHARACTER HOLDER ( NEED NOT BE SAVED )
SCR==CHAR+1 ;A SCRATCH REG ( NEED NOT BE SAVED )
S1==4 ;Special super-temps
S2==S1+1 ;Invented to keep upgrades from breaking us
TYP==6 ;TYPE OF TERMINAL FOR CONTROL INDEX
CUR==7 ;CURRENT POSITION ON SCREEN
NEW==10 ;NEW DISPLAY ARRAY
OLD==11 ;OLD DISPLAY ARRAY
NL==12 ;LINE CURRENTLY EXAMINING
NC==13 ;COLUMN " "
POSL==14 ;LINE OF CURSOR
POSC==15 ;COLUMN " "
ARGS==16 ;DPSS ARGUMENT POINTER
P==17 ;A PUSH-DOWN LIST
; TABLE OF CONTENTS FOR DPYPAK
;
;
; SECTION PAGE
; 1. SETINI
; 1.1 INITIALIZE TERMINAL PARAMETERS.................... 23
; 2. DPYXIT
; 2.1 RESTORE USER TERMINAL PARAMETERS.................. 24
; 3. LOW SEG STORAGE........................................... 25
IF TOPS-10,<
;TERMINAL SUPPORT DESIRED (TYPES FROM TRMOP. .TOTRM)
; %VT05==<SIXBIT/VT05/>
; %VT06==<SIXBIT/VT06/>
; %VT50==<SIXBIT/VT50/>
%VT52==<SIXBIT/VT52/>
%VT61==<SIXBIT/VT61/>
%VT100==<SIXBIT/VT100/>
%VT101==<SIXBIT/VT101/>
%VT102==<SIXBIT/VT102/>
%VT125==<SIXBIT/VT125/>
%VT220==<SIXBIT/VT220/>
%VT240==<SIXBIT/VT240/>
%VT241==<SIXBIT/VT241/>
%VK100==<SIXBIT/VK100/>
%H19==<SIXBIT/H19/>
%H19A==<SIXBIT/H19A/>
; %ADDS==<SIXBIT/ADDS/>
; %REGENT==<SIXBIT/REGENT/>
; %INFOTO==<SIXBIT/INFOTO/>
TTYBYT==^D7 ;7 BIT BYTES
TTYCPW==^D5 ;CHARACTERS PER WORD
TTYFIL==177 ;CHARACTER USED FOR FILLER
;TRMOP. FUNCTIONS
.TOSET==1000 ;ADDON TO SET RATHER THAN READ
.TONFC==1010 ;NO FREE CRLF
.TOPSZ==1023 ;PAGE SIZE
.TOTSP==1031 ;TRANSMIT SPEED
.TOTRM==1041 ;TERMINAL TYPE
HB.RTC==<10,,0>
> ;END IF TOPS-10
IF TOPS-20,<
;TERMINAL SUPPORT DESIRED (TYPES FROM GTTYP)
; %VT05==12
; %VT50==13
%VT52==17
%VT100==20
%VT125==43
%VK100==44
%VT102==45
TTYBYT==8 ;8 BIT BYTES
TTYCPW==4 ;4 CHARACTERS PER WORD
TTYFIL==200 ;CHARACTER USED FOR FILL
> ;END IF TOPS-20
;Character attributes
DEFINE BB(BITNM,BIT)<
CA.'BITNM==:1_BIT
>
BB BLD,7 ;Character bold
BB UDS,10 ;Character has underscore on
BB BNK,11 ;Character is blinking
BB RVD,12 ;Character in reverse video
BB GRF,13 ;Character in graphics mode
BB NAB,15 ;No attributes on blank character
ATRMSK==CA.BLD!CA.UDS!CA.BNK!CA.RVD ;Mask for them all
GRFMSK==3B<36-11> ;Two bits for graphics
CLRMSK==77B<36-13> ;Color field starts at bit 12
GRFPOS==13 ;Position of graphics field
CLRPOS==14 ;Position of color field
ATRPDL==10 ;Lenght of attribute saving stack
BYTEPW==2 ;Bytes per word in screen area
;ENTRY POINTS IN DPYPAK
; DPYINI INITIALIZE A SCREEN FOR A TERMINAL TYPE
; DPYCLR FORCE A REFRESH CYCLE NEXT TIME THROUGH "DPYOUT"
; DPYREF FORCE A REFRESH NOW
; DPYZAP CLEAR SCREEN NOW (ERASE)
; DPYWAT WAIT FOR READER TO SEE THE SCREEN
; DPYLSH SHIFT LEFT JUSTIFIED CHARACTER TO RIGHT JUSTIFIED
; DPYROL SCROLL THE SCREEN ( SEE "RACE" )
; DPYSIZ RETURN MAX COLUMN AND MAX LINE NUMBERS
; DPYCHR PUT A SINGLE CHARACTER ON THE SCREEN
; DPYCRM SAME AS DPYCHR BUT REMEMBERS WHERE CURSOR WAS LEFT
; DPYOUT MAKE A SCREEN CHANGE
; DPYREM SAME AS DPYOUT BUT REMEMBERS WHERE CURSOR WAS LEFT
; DPYSEC OUTPUT A SCREEN SECTION
; DPYRSC SAVE AS DPYSEC BUT REMEMBERS WHERE CURSOR WAS LEFT
; DPYCSC CLEAR A SCREEN SECTION
; DPYSAV RETURN THE CURRENT SCREEN CONTENTS
; DPYRST RESTORE SCREEN ( OUTPUT FROM DPYSAV )
; DPYNAT SET NO ATTRIBUTES ON CHARACTER
; DPYSAT SET GLOBAL ATTRIBUTES FOR ALL SUBSEQUENT CHARACTERS
; DPYSVA SAVE CURRENT GLOBAL ATTRIBUTES ON THE ATTRIBUTES STACK
; DPYRSA RESTORE GLOBAL ATTRIBUTES FROM ATTRIBUTES STACK
; DPYISC INSERT A SECTION INTO THE SCREEN
; DPYDSC DELETE A SECTION FROM THE SCREEN
; DPYCRM, DPYREM, AND DPYRSC ARE USED WHEN ONLY A SMALL NUMBER OF THINGS
; CHANGE AND SAVES LOTS OF CURSOR MOVEMENTS ( SEE "PONG" ).
; HOWEVER, CALLER GUARANTEES THAT HE DIDN'T MOVE IT BETWEEN
; CALLS. ( LIKE SET NO ECHO ON TERMINAL )
; DPYCHR(CRM), DPYOUT(REM), DPYSEC(RSC) CAN NOW BE CALLED WITH
; AN OPTIONAL EXTRA ARGUEMENT, PROVIDED THAT THE CALLER
; USES FORTRAN CONVENTIONS AND PLACES THE NEGATIVE ARG
; COUNT IN THE LEFT HALF @-1(ARG). THIS EXTRA ARGUEMENT
; WILL BE THE DEVICE ATTRIBUTES TO BE USED FOR THIS CALL
; IN LIEU OF THE GLOBAL CHARACTERISTICS. ONCE THE CALL
; IS FINISHED, THE GLOBAL CHARACTERISTICS ARE RESTORED.
; THE GLOBAL CHARACTERISTICS CAN ONLY BE SET BY CALLING
; DPYSAT AND CAN ONLY BE CLEARED BY CALLING DPYNAT.
; IF THE CALLER IS USING RIGHT JUSTIFIED FORMAT FOR HIS CALLS TO
; DPYOUT OR DPYSEC, IT WILL BE ASSUMED THAT HE IS ALSO
; SETTING THE CHARACTER BITS FOR HIS SCREEN HIMSELF, AND
; THE GLOBAL SETTINGS WILL AGAIN BE OVERRIDDEN IN FAVOR
; OF THE SETTINGS SENT.
;TERMINAL SPECIFICS
;ARGUMENTS ARE:
; NAME name of the terminal
; LINES number of lines on the screen
; COLUMNS number of columns
; HOME encoded character for cursor home
; ERSEOL " " " " erase-to-end-of-line
; ERSEOS " " " " erase-to-end-of-screen
; ERSBOS " " " " erase-to-beginning-of-screen
; DIRADR " " " " enter direct addressing mode
; TRANSL instruction to execute to convert line/column to commands
; CURUP encoded character for cursor up
; CURLEFT " " " " left
; REVLF " " " " reverse LF (scroll backwards)
; CURDOWN " " " " down
; GRFON Enter graphics mode
; GRFOFF Exit graphics mode
; CHRATR Routine to set attributes to desired type
; (This avoids waste of characters on ANSI type terminals)
;
; Two parameters are given for each control sequence. The first will
; specify the second parameter type. The descriptions are as follows:
;
; -2 Second arguement is the address of the instruction to execute
; to translate arguements to be able to use common routine.
; -1 Second parameter is name of special routine to call to
; Perform this function.
; 0 Terminal cannot perform function at all
; 1 Only need to output the character, which is given in octal.
; 2 " " " " " " " " " " ASCII.
; 3 Character then fillers (Octal)
; 4 Fillers then character (Octal)
; 5 Escape character (Octal)
; 6 " " (ASCII)
; 7 ANSI ("<ESC>[") (Octal)
; 10 ANSI (ASCII)
; 11 Escape character followed by string
IFDEF %VT100!%VK100!%H19A,<%ANSI==SIXBIT /ANSI/> ;These terminals share a lot
DEFINE DPYTYP,<
TRMNAL (VT05,^D20,^D72,<3,35>,<3,36>,<3,37>,<0,0>,<1,16>,<-2,<ADDI CHAR,40>>,<3,32>,<1,10>,<0,0>,<3,12>,<0,0>,<0,0>,<0,0>)
TRMNAL (VT06,^D25,^D72,<3,35>,<3,36>,<3,37>,<0,0>,<0,0>,<0,0>,<4,32>,<4,10>,<0,0>,<1,12>,<0,0>,<0,0>,<0,0>,<0,0>)
TRMNAL (VT50,^D12,^D80,<6,H>,<6,K>,<6,J>,<0,0>,<5,o>,<0,0>,<6,B>,<1,10>,<0,0>,<1,12>,<0,0>,<0,0>,<0,0>,<0,0>)
TRMNAL (H19,^D24,^D80,<6,H>,<6,K>,<6,J>,<6,o>,<6,Y>,<-2,<ADDI CHAR,40>>,<6,B>,<1,10>,<6,I>,<1,12>,<6,F>,<6,G>,<-1,H19ATR>)
TRMNAL (H19A,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<0,0>,<0,0>,<-1,A19ATR>)
TRMNAL (VT52,^D24,^D80,<6,H>,<6,K>,<6,J>,<0,0>,<6,Y>,<-2,<ADDI CHAR,40>>,<6,B>,<1,10>,<6,I>,<1,12>,<6,F>,<6,G>,<-1,V52ATR>)
TRMNAL (VT61,^D24,^D80,<6,H>,<6,K>,<6,J>,<0,0>,<6,Y>,<-2,<ADDI CHAR,40>>,<6,B>,<1,10>,<6,I>,<1,12>,<6,F>,<6,G>,<-1,V52ATR>)
IF TOPS-10,<
TRMNAL (VT100,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<11,<(","0>>,<11,<)","0>>,<-1,V102CA>)
>
IF TOPS-20,<
TRMNAL (VT100,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<11,<(","0>>,<11,<)","0>>,<-1,V101CA>)
>
TRMNAL (VT101,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<11,<(","0>>,<11,<)","0>>,<-1,V101CA>)
TRMNAL (VT102,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<11,<(","0>>,<11,<)","0>>,<-1,V102CA>)
TRMNAL (VT220,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<11,<(","0>>,<11,<)","0>>,<-1,V102CA>)
TRMNAL (VT240,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<11,<(","0>>,<11,<)","0>>,<-1,V102CA>)
TRMNAL (VT125,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<11,<(","0>>,<11,<)","0>>,<-1,V102CA>)
TRMNAL (VK100,^D24,^D80,<10,H>,<10,K>,<10,J>,<10,<1","K>>,<-1,ANSIM>,<0,0>,<10,B>,<1,10>,<6,M>,<1,12>,<0,0>,<0,0>,<-1,GGATRB>)
TRMNAL (REGENT,^D24,^D80,<0,0>,<6,K>,<6,k>,<0,0>,<6,Y>,<-2,<ADDI CHAR,40>>,<1,32>,<1,10>,<0,0>,<1,12>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>)
TRMNAL (INFOTO,^D24,^D80,<1,10>,<1,13>,<1,14>,<0,0>,<0,0>,<0,0>,<1,34>,<1,32>,<0,0>,<1,12>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>)
TRMNAL (ADDS,^D24,^D80,<1,1>,<0,0>,<1,14>,<0,0>,<0,0>,<0,0>,<1,32>,<1,10>,<0,0>,<1,12>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>)
TRMNAL (DM,^D24,^D80,<1,2>,<1,27>,<0,0>,<0,0>,<-1,ADRDM>,<XORI CHAR,140>,<1,32>,<1,10>,<0,0>,<1,12>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>)
TRMNAL (TEC,^D24,^D80,<2,i>,<1,c>,<1,s>,<0,0>,<-1,ADRTEC>,<TRC CHAR,177>,<2,x>,<2,w>,<0,0>,<2,h>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>)
TRMNAL (IMLAC,^D40,^D80,<1,3>,<1,20>,<1,13>,<0,0>,<-1,ADRMLC>,<TRC CHAR,177>,<1,4>,<1,10>,<0,0>,<1,12>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>,<0,0>)
> ;END OF DEFINED TERMINAL TYPES
DOFILL==0 ;ASSUME NO TERMINALS NEED FILLERS
DEFINE CONTRL(..XX,..YY),<
..B35==0
DOFILL==0 ;;ASSUME NO FILLING
IFE ..XX+2,..ANS==<XWD -2,[..YY]>
IFE ..XX+1,..ANS==<XWD -1,..YY>
IFE ..XX,..ANS==<EXP 0>
IFE ..XX-1,..ANS==<XWD 0,[BYTE (7)..YY,0]>
IFE ..XX-2,..ANS==<XWD 0,[BYTE (7)"'..YY",0]>
IFE ..XX-3,<DOFILL==1
..ANS==<XWD 0,[BYTE (7)..YY,177,0]>>
IFE ..XX-4,<DOFILL==1
..ANS==<XWD 0,[BYTE (7)177,..YY,0]>>
IFE ..XX-5,..ANS==<XWD 0,[BYTE (7)33,..YY,0]>
IFE ..XX-6,..ANS==<XWD 0,[BYTE (7)33,"'..YY",0]>
IFE ..XX-7,..ANS==<XWD 0,[BYTE (7)33,"[",..YY,0]>
IFE ..XX-10,..ANS==<XWD 0,[BYTE (7)33,"[","'..YY",0]>
IFE ..XX-11,..ANS==<XWD 0,[BYTE (7)33,"'..YY",0]>
EXP <..ANS>
> ;END OF CONTRL
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<.'A==<.-TYPNAM>
<ASCII/A />>>
TYPNAM: DPYTYP
MAXTYP==.-TYPNAM
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<EXP %'A>>
TYPTAB: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<IFG <B-NLMAX>,<NLMAX==B>
EXP B>>
NLMAX==0 ;PRIME COUNTER FOR MAXIMUM LINES
NLINES: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<EXP C>>
NCMAX==^D80 ;CAN'T REALLY CHANGE THIS WITHOUT BREAKING LOTS OF OLD PROGRAMS
WDPLIN==<NCMAX/BYTEPW>
NCOLS: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(D)>>
HOMEUP: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(E)>>
ERAEOL: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(F)>>
ERAEOS: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(G)>>
ERABOL: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(H)
REVDIR==REVDIR!..B35>>
REVDIR==0 ;ASSUME NO TERMINALS WANT X,Y REVERSED
DIRADR: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(I)>>
COMPXY: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(J)>>
CURUP: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(K)>>
CLEFT: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(L)>>
REVLF: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(M)>>
LINEFD: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(N)>>
GRFON: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(O)>>
GRFOFF: DPYTYP
DEFINE TRMNAL(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P),<IFDEF %'A,<CONTRL(P)>>
CHRATR: DPYTYP
;ENTRY TO INITIALIZE A DISPLAY..
;
; CALL DPYINI(BYTE-SIZE,TERMINAL-TYPE)
;
;TERMINAL-TYPE IS ASCII NAME OF A SUPPORTED TERMINAL (VT05,VT06)
; IF DPYPAK CAN FIGURE OUT WHAT KIND OF TERMINAL (TOPS20 OR 7.01)
; IT WILL OVER RIDE CALLERS ARGUMENT AND RETURN TYPE (SEE BELOW)
;BYTE-SIZE IS 7 FOR ENCODE'ED ARRAYS ( "DIMENSION ARRAY(16,25)" )
; IS 36 FOR RIGHT JUSTIFIED CHARACTERS ( "DIMENSION ARRAY(80,25)" )
; IS <0 FOR LEFT JUSTIFIED CHARACTERS ( "DIMENSION ARRAY(80,25)" )
; BUT READ WITH A1 FORMAT ( AVOID DPYLSH )
;CALLER MUST ACCOUNT FOR ALL 80 POSSIBLE COLUMNS (EVEN IF ONLY 72 FOR TERMINAL)
; ALTHOUGH THAT'S NOT TRUE FOR LINES. E.G. FOR A VT05 SPECIFIC PROGRAM
; USE "DIMENSION ARRAY(80,20)" OR "DIMENSION ARRAY(16,20)"
;DPYINI CAN ALSO BE CALLED AS A FUNCTION RATHER THAN A SUBROUTINE
;
; FOO = DPYINI ( SAME-ARGUMENTS-AS-OTHER-CALL )
;
;FOO GETS THE TERMINAL ACTUALLY USED (ASCII) OR -1 IF IT WAS INVALID
DPYINI:: SETZM ZERO0 ;ZAP LOW SEG
MOVE SCR,[ZERO0,,ZERO0+1];SETUP FOR BLT
BLT SCR,ZERO1 ;CLEAR IT OUT
MOVE SCR,[IOWD ATRPDL,ATRSTK] ;Initialize the attribute stack
MOVEM SCR,ATRPTR ;...
SETOM CURL ;INIT AFEW OTHERS
SETOM VIDEOT ;..
MOVSI SCR,(POINT 0,0) ;AND THE BYTE POINTER
MOVEM SCR,NEWPTR ;..
MOVE CHAR,@0(ARGS) ;GET BYTE SIZE ( 7 OR 36 )
JUMPLE CHAR,[MOVEI CHAR,^D36 ;NEGATIVE IS LEFT JUSTIFIED ARRAY
SETOM LJUST ;REMEMBER THAT
JRST .+1] ;RESUME IN LINE CODE
DPB CHAR,[POINT 6,NEWPTR,11] ;INSERT INTO ARRAY BYTE POINTER
PUSHJ P,DPYCLR ;CLEAR THE INTERNAL BUFFER
PUSHJ P,GETTYP ;TRY TO FIGURE OUT TERMINAL TYPE
MOVE CHAR,@1(ARGS) ;GET TERMINAL TYPE
SKIPE SCR ;DO I KNOW IT FROM GETTYP
MOVE CHAR,SCR ;YES, OVERRIDE CALLER
MOVSI SCR,-MAXTYP ;FORM AOBJN FOR KNOWN TYPES
CAME CHAR,TYPNAM(SCR);FOUND IT
AOBJN SCR,.-1 ;NO, TRY AGAIN
JUMPGE SCR,[SETOB CHAR,VIDEOT ;DIDN'T FIND ONE, RETURN -1, ZAP TYPE
POPJ P,] ;AND RETURN
HRRZM SCR,VIDEOT ;Store the type away
PUSH P,NLINES(SCR) ;NUMBER OF LINES (EVEN IF INVALID)
PUSH P,NCOLS(SCR) ; " COLUMNS
POP P,MAXC ;PUT IN GLOBAL VARIABLE FOR MACRO HACKERS
POP P,MAXL ;...
MOVEI SCR,WDPLIN*NLMAX
MOVEM SCR,MAXS ;Store size of screen
PUSHJ P,ISOTST ;Go see if we've image outstrs
SKIPN ISOFLG ;Do we?
PUSHJ P,SETINI ;SET INITIAL TERMINAL CHARACTERISTICS
PUSH P,0 ;Save the terminal type
PUSHJ P,DPYNAT ;TURN OFF ATTRIBUTES
POP P,0 ;Restore term type for user
POPJ P, ;Return now
;ENTRY TO RETURN SCREEN SIZES
;
; CALL DPYSIZ(MAX-COLUMN,MAX-LINE)
;
;SIMPLY RETURNS THOSE VALUES
DPYSIZ:: JSP CHAR,SAVREG ;REALLY FOR EVER INITIALIZED CHECK
MOVE CHAR,MAXC ;MAXIMUM COLUMN NUMBER FOR THIS TYPE
MOVEM CHAR,@0(ARGS) ;STORE FOR USER
MOVE CHAR,MAXL ;MAXIMUM LINE NUMBER
MOVEM CHAR,@1(ARGS) ;SO CALLER CAN FIND END OF SCREEN FOR DPYCHR
JSP CHAR,RESREG ;RESTORE REGS
POPJ P, ;ALL DONE
;ENTRY TO ALLOW CALLER TO FORCE A REFRESH OF THE ENTIRE SCREEN..
;
; CALL DPYCLR
DPYCLR:: SETZM SCREEN ;CLEAR CURRENT SCREEN
DPYCL1: MOVE CHAR,[SCREEN,,SCREEN+1] ;THE ENTIRE SCREEN
BLT CHAR,ENDSCR ;TO THE END OF THE SCREEN
POPJ P, ;RETURN, WE'LL CLEAR ON NEXT SWEEP
;ENTRY TO ALLOW WATCHER TO READ THE SCREEN..
;
; CALL DPYWAT(NUMBER-OF-SECONDS)
; IF NUMBER-OF-SECONDS .GT. 60 THEN ITS NUMBER-OF-MILLISECONDS
;
;SIMPLY SLEEPS FOR THAT MANY SECONDS
DPYW.1: SKIPA SCR,[^D500] ;1.5 SECONDS
DPYWAT:: MOVE SCR,@0(ARGS) ;GET TIMER
CAIG SCR,^D60 ;SECONDS OR MILLISECONDS
IMULI SCR,^D1000 ;CONVERT SECONDS TO MILLISECONDS
IF TOPS-10,<
TLO SCR,(HB.RTC) ;WAIT FOR CHAR
HIBER SCR, ;WAIT THE SPECIFIED AMOUNT
JFCL ;IGNORE FAILURE
> ;END OF IF TOPS-10
IF TOPS-20,<DISMS> ;WAIT THE SPECIFIED AMOUNT
POPJ P, ;THEN RETURN
;ENTRY TO FORCE CLEAR OF ENTIRE SCREEN ( REAL CLEAR, NOT REFRESH )..
;
; CALL DPYZAP
DPYZAP:: MOVE CHAR,[XWD " "," "] ;LOAD BLANKS
MOVEM CHAR,SCREEN ;STORE THE BLANKS
PUSHJ P,DPYCL1 ;NOW BLT ENTIRE ARRAY
JSP CHAR,SAVREG ;SAVE CALLERS REGISTERS
PUSHJ P,HOME ;SEND HOME SEQUENCE
SKIPE ERAEOS(TYP) ;CAN THE TERMINAL ERASE TO END OF SCREEN
JRST [MOVEI S1,ERAEOS ;GEt the address of the table
PUSHJ P,XCTTBL ;Go see what must be done
JRST FORGET ;All done, return
PUSHJ P,PUTCTL ;OUTPUT IT
JRST FORGET] ;FORCE OUT, FORGET TRACKS, RETURN
MOVEI NC,1 ;WANT TO GET TO COLUMN 1
MOVEI NL,1 ;ON LINE 1
PUSHJ P,ERSLIN ;ERASE LINE N, INCREMENT TO NEXT
CAMG NL,NLINES(TYP) ;OFF THE END OF THE SCREEN
JRST .-2 ;NO, CLEAR ANOTHER LINE
JRST FORGET ;FORCE OUT, FORGET TRACKS, RETURN
;ENTRY TO CONVERT LEFT-JUSTIFIED CHARACTER TO RIGHT-JUSTIFIED BINARY
;
; BIN = DPYLSH(THING-READ-WITH-A1-FORMAT)
DPYLSH:: MOVE CHAR,@0(ARGS) ;GET CHARACTER ( ASCII /X / )
LSH CHAR,-^D29 ;MOVE TO LOW 7 BITS
POPJ P, ;RETURN WITH IT IN AC 0
;ENTRY TO SCROLL THE SCREEN SO MANY LINES..
;
; CALL DPYROL(NUMBER-OF-LINES-TO-ROLL)
;
;MOVES SCREEN FOR NEW OUTPUT ACCORDING TO SIGN OF NUMBER-OF-LINES-TO-ROLL
; IF POSITIVE, BRING IN "N" BLANK LINES ON THE BOTTOM OF THE SCREEN
; IF NEGATIVE, BRING IN "ABS(N)" BLANK LINES FROM THE TOP
; IF ZERO, WHY DID YOU CALL THIS ROUTINE
DPYROL:: JSP CHAR,SAVREG ;SAVE CALLERS
SKIPN NEW,@0(ARGS) ;ANY LINES TO ROLL
JRST FORGET ;NO, RETURN
PUSHJ P,GOHOME ;GOTO HOME POSITION (MAYBE)
JUMPL NEW,ROL.03 ;GO IF ROLLING BACKWARDS
MOVE NL,NLINES(TYP) ;FIND LAST LINE OF THIS SCREEN
IMULI NL,WDPLIN ;FIRST WORD NOT INVOLVED IN THE MOVE
MOVE OLD,NEW ;NUMBER OF LINES TO ROLL
IMULI OLD,WDPLIN ;COMPUTE NEW TOP OF SCREEN
ADDI OLD,SCREEN ;...
HRL CHAR,OLD ;SOURCE = NEW HOME POSITION
HRRI CHAR,SCREEN ;DESTINATION = HOME IN INTERNAL SCREEN
MOVNS OLD ;COMPUTE LAST COLUMNS TO APPEAR ON NEW SCREEN
ADDI OLD,SCREEN-1(NL) ;...
JUMPLE OLD,[JSP CHAR,RESREG ;ROLLING ENOUGH TO ACTUALLY CLEAR SCREEN
JRST DPYZAP] ;SO ZAP IT INSTEAD
BLT CHAR,SCREEN(OLD) ;MOVE THE NEW SCREEN TO HOME POSITION
MOVE CHAR,[" ",," "] ;LOAD SOME BLANKS
MOVEM CHAR,SCREEN+1(OLD) ;CLEAR LINES ROLLED UP
HRLI CHAR,SCREEN+1(OLD) ;SET UP FOR BLT
HRRI CHAR,SCREEN+2(OLD) ;...
BLT CHAR,SCREEN-1(NL) ;CLEAR IT ALL
MOVE NL,NLINES(TYP) ;WHERE TO START ROLLING FROM
MOVEI S1,LINEFD ;Get the linefeed table
;Common return point for backward and forward scroll
ROL.01: PUSH P,S1 ;Save the table
MOVEI NC,1 ;Want column 1
PUSHJ P,CURMOV ;GET TO CORRECT POSITION
ROL.02: MOVE S1,0(P) ;SAVED CONTROL SEQUENCE
PUSHJ P,XCTTBL ;Call the right routine
TRNA ;Everything has been done
PUSHJ P,PUTCTL ;OUTPUT THAT
SOJG NEW,ROL.02 ;CONTINUE FOR ALL LINES
POP P,S1 ;RESTORE THE STACK
JRST FORGET ;FORGET TRACKS, RETURN
;HERE IF ROLLING BACKWARDS
ROL.03: MOVE OLD,NEW ;GET - NUMBER OF LINES TO ROLL
IMULI OLD,WDPLIN ;COMPUTE NEW LOWER RIGHT CORNER
ADDI OLD,ENDSCR ;...
CAIGE OLD,SCREEN ;HOW FAR ARE WE BACKING UP
JRST [JSP CHAR,RESREG ;ENOUGH TO ACTUALLY CLEAR THE SCREEN
JRST DPYZAP] ;SO ZAP THE SCREEN INSTEAD
MOVEI NL,ENDSCR ;LOWER RIGHT IN INCORE SCREEN
ROL.04: CAIGE NL,SCREEN ;OFF THE TOP OF THE SCREEN YET
JRST ROL.05 ;YES, DONE MOVING THE INCORE SCREEN
CAIL OLD,SCREEN ;STILL USING REAL DATA
SKIPA SCR,0(OLD) ;YES, GET SCREEN CONTENTS
MOVE SCR,[" ",," "] ;NO, BRING BLANKS IN ON THE TOP LINES
MOVEM SCR,0(NL) ;RIPPLE DATA DOWN
SOS OLD ;STEP DOWN TO NEXT LOCATION
SOJA NL,ROL.04 ;GET THE ENTIRE SCREEN
ROL.05: SKIPN REVLF(TYP) ;CAN TERMINAL REVERSE SCROLL
JRST [JSP CHAR,RESREG ;NO, RESTORE CALLERS REGISTERS
JRST DPYREF] ;AND REFRESH FROM INTERNAL SCREEN
MOVEI S1,REVLF ;GEt the table to do reverse linefeeds
MOVMS NEW ;NUMBER OF LINES TO ROLL
MOVEI NL,1 ;STARTING AT HOME POSITION
JRST ROL.01 ;SCROLL, RETURN
;ENTRY TO PLACE A SINGLE RIGHT JUSTIFIED CHARACTER ON THE SCREEN
;
; CALL DPYCHR(RIGHT-JUSTIFIED-CHAR,COLUMN-DESIRED,LINE-DESIRED)
;
;LEAVES CURSOR TO THE RIGHT ( 1 COLUMN ) OF THE POSITION SPECIFIED
; UNLESS CHARACTER.LT.0 ( IN 36 BITS ) THEN CURSOR IS AT THE POSITION
;DPYCRM REMEMBERS THAT FACT FOR LATER USE
DPYCRM:: SETOM REMEMB ;MARK REMEMBERING
DPYCHR:: HLRE CHAR,-1(16) ;GEt the arguement count
MOVMS CHAR ;Make positive
MOVEI SCR,4 ;GEt the offset to the attribute word
CAML CHAR,SCR ;Did he specify an attribute
PUSHJ P,SAVATR ;Save the attributes
JSP CHAR,SAVREG ;SAVE CALLERS REGISTERS
SKIPLE NC,@1(ARGS) ;GET COLUMN DESIRED, RANGE CHECK IT
CAMLE NC,NCOLS(TYP) ;...
JRST FORGET ;INVALID, RETURN
SKIPLE NL,@2(ARGS) ;DO THE SAME FOR NEW LINE
CAMLE NL,NLINES(TYP) ;...
JRST FORGET ;THAT'S INVALID
PUSHJ P,GOHOME ;MOVE TO HOME POSITION (MAYBE)
PUSHJ P,CURMOV ;MOVE TO NEW POSITION
PUSHJ P,SETCUR ;COMPUTE BYTE POINTER TO SCREEN
MOVE CHAR,@0(ARGS) ;GET DISPLAY CHARACTER
JUMPL CHAR,CHRRET ;QUIT NOW IF JUST POSITION WITH NO DATA
PUSHJ P,CT2SPC ;If a control character, convert to space
MOVEI S1,CHRATR ;Get the characteristics handler table
PUSHJ P,XCTTBL ;Call it
JFCL ;Whatever happens is alright
IDPB CHAR,CUR ;STORE INTO CURRENT SCREEN
ANDI CHAR,177 ;Down to ASCII
PUSHJ P,DPYPUT ;TYPE IT OUT
AOS POSC ;ACCOUNT FOR TYPEOUT
CHRRET: SKIPN REMEMB ;WANT TO REMEMBER WE LEFT IT HERE
JRST FORGET ;NO, FORGET TRACKS
JRST FRCRET ;YES, JUST RETURN
;ENTRY TO CLEAR A SELECTED SECTION OF THE SCREEN
;
; CALL DPYCSC(1ST-COL,1ST-LINE,END-COL,END-LINE)
;
;FAKES OUT A CALL TO DPYSEC
DPYCSC:: SETOM CLRING ;MARK CLEARING THE SECTION
PUSH P,GLBATR ;SAVE OLD ATTRIBUTES
SETZM GLBATR ;CLEAR SECTION NEVER NEEDS ANY
SOS ARGS ;ARGS ARE IN SAME ORDER AS DPYSEC BUT
PUSHJ P,DPYSEC ; OFF BY ONE
POP P,GLBATR ;RESTORE OLD ATTRIBUTES
SETZM CLRING ;MAKE OTHER ENTRIES WORK AGAIN
AOJA ARGS,CPOPJ ;JUST FOR GRINS, PUT ARGS BACK AGAIN
;ENTRIES TO SAVE/RESTORE A SCREEN..
;
; CALL DPYSAV(HOLDING-ARRAY)
; CALL DPYRST(THAT-SAME-ARRAY)
;
;THESE ENTRIES ARE USEFUL WHEN CALLER REALLY WANTS TO "PUSH" A SCREEN, FLASH
; SOME OTHER OUTPUT, AND THEN "POP" THE OLD ONE. ESPECIALLY USEFUL WHEN
; CURRENT SCREEN HAS BEEN FILLED WITH DATA THAT IS NOT EASILY RE-CONSTRUCTED
; ( USED "DPYSEC" TO DO LINE AT A TIME OUTPUT OF "ENCODE"D DATA )
;
; CALLERS ARRAY MUST BE LARGE ENOUGH TO CONTAIN THE SCREEN FOR THE
; TERMINAL TYPE THAT IS CURRENTLY BEING USED. 400 (DECIMAL) WORDS IS
; SAFE FOR DEC TERMINALS AND MOST OTHERS BUT SOME HAVE MORE THAT 25 LINES
; AND REQUIRE MORE SPACE. CAVEAT: THE ARRAY IS NOT CHECKED AS TO LENGTH.
DPYSAV:: JSP CHAR,SAVREG ;SAVE REGS, GET TYPE
HRLI CHAR,SCREEN ;SOURCE = CURRENT SCREEN
HRRI CHAR,@0(ARGS) ;DESTINATION = USERS ARRAY
MOVE SCR,NLINES(TYP) ;NUMBER OF LINES ON THE SCREEN
IMULI SCR,WDPLIN ;NUMBER OF WORDS NEEDED
ADDI SCR,@0(ARGS) ;PLUS ARRAY START
BLT CHAR,-1(SCR) ;MOVE TO CALLERS BUFFER
JSP CHAR,RESREG ;PUT THE REGS BACK
POPJ P, ;RETURN NOW
DPYRST:: PUSH P,NEWPTR ;SAVE CURRENT BYTE POINTER INFO
PUSH P,LJUST ;AND JUSTIFICATION FLAG
MOVSI CHAR,(POINT 18,0) ;GET NEW BYTE POINTER
MOVEM CHAR,NEWPTR ;FAKE OUT DPYOUT
SETZM LJUST ;...
PUSHJ P,DPYOUT ;FLASH THE SCREEN BACK
POP P,LJUST ;RESTORE ORIGINAL PARAMETERS
POP P,NEWPTR ;...
POPJ P,
;ENTRY TO FORCE A REFRESH OF THE SCREEN RIGHT NOW USING THE CURRENT
; SCREEN CONTENTS. BETTER THAN CALLING "DPYCLR" THEN "DPYOUT" OF SCREEN
; OR "DPYSAV", "DPYCLR", "DPYRST".
;
; CALL DPYREF
DPYREF:: SETOM REFING ;MARK REFRESHING
PUSH P,ARGS ;SAVE CALLERS
MOVEI ARGS,1+[-1,,0
0,,SCREEN];ARGUMENT IS OLD SCREEN
PUSHJ P,DPYRST ;PRETEND THIS IS A RESTORE
POP P,ARGS ;RESTORE CALLERS
SETZM REFING ;CLEAR FLAG
POPJ P, ;RETURN
;ENTRY TO DISPLAY A SCREEN SECTION..
;
; CALL DPYSEC(NEW-SECTION-ARRAY,1ST-COL,1ST-LINE,END-COL,END-LINE)
;
;THIS ENTRY IS USED TO PARTITION A SCREEN INTO MANY RECTANGULAR SECTIONS.
; THE BOX DEFINED BY THE LAST 4 ARGUMENTS WILL BE THE ONLY SECTION OF THE
; SCREEN AFFECTED. SEE THE SIZE DEFINITIONS IN "DPYINI" AND NOTE THE
; FOLLOWING RESTRICTION. THE NUMBER OF COLUMNS THAT MUST BE ALLOCATED IN
; THE SECTION ARRAY MUST ACCOUNT FOR FULL WORD ALIGNMENT OF THE NEXT
; LINE TO BE DISPLAYED EVEN THOUGH THE DISPLAY WILL STOP AT THE MARGIN
; DEFINED BY "END-COL". AN EXAMPLE:
;
; CALL DPYINI(7,TTTYPE) ;USE ASCII DATA
; CALL DPYSEC(ARRAY,6,2,13,5) ;DISPLAY 8-COL BY 4-LINE AREA
;
; THE ARRAY DIMENSION MUST BE (2,4) . NOTICE 2 FULL WORDS ARE 10 CHARS
; BUT ONLY 8 WILL BE DISPLAYED.
;ENTER AT DPYRSC TO LEAVE CURSOR AT LAST POSITION AND REMEMBER THAT
DPYRSC:: SETOM REMEMB ;MARK REMEMBERING
DPYSEC::SKIPGE CLRING ;CLEARING A SECTION?
JRST DPYSCC ;YES--DONT CHECK ATTRIBUTES!
HLRE CHAR,-1(16) ;GEt the arguement count
MOVMS CHAR ;Make positive
MOVEI SCR,6 ;GEt the offset to the attribute word
CAML CHAR,SCR ;Did he specify an attribute
PUSHJ P,SAVATR ;Save the attributes
DPYSCC: JSP CHAR,SAVREG ;SAVE CALLERS
SETZM BOUNDS ;DPYOUT MUST RESET ITS BOUNDRIES
SKIPLE NC,@1(ARGS) ;GET 1ST-COLUMN
CAMLE NC,NCOLS(TYP) ;RANGE CHECK IT
JRST FORGET ;BAD ARGUMENT
MOVEM NC,NCPRIM ;SAVE STARTING COLUMN NUMBER
SKIPLE NL,@2(ARGS) ;GET 1ST-LINE
CAMLE NL,NLINES(TYP) ;RANGE CHECK THIS TOO
JRST FORGET ;ANOTHER BAD ARGUMENT
MOVEM NL,NLPRIM ;SAVE STARTING LINE NUMBER
MOVE CUR,@3(ARGS) ;GET END COLUMN
MOVE OLD,@4(ARGS) ;AND END LINE
CAML CUR,NC ;END .LT. BEGINNING
CAILE CUR,NCMAX ;BEYOND LEGAL VAULE
JRST FORGET ;STRANGE REQUEST
CAMLE OLD,NLINES(TYP) ;DON'T DISPLAY OFF THE BOTTOM
MOVE OLD,NLINES(TYP) ;SET LOWER MARGIN
MOVEM OLD,NLEND ;STORE LOWER BOUND
MOVE OLD,NCOLS(TYP) ;GET RIGHT MARGIN FOR THIS TERMINAL
CAMGE CUR,OLD ;END COLUMN INVISIBLE
MOVE OLD,CUR ;NO, USE IT
MOVEM OLD,NCEND ;STORE RIGHT MARGIN
LDB SCR,[POINT 6,NEWPTR,11] ;FETCH SIZE FROM DPYINI
MOVEI NEW,^D36 ;COMPUTE BYTES PER WORD
IDIVI NEW,(SCR) ;FOR WORD ALIGNMENT OF LINES
MOVE CHAR,CUR ;COPY FOR LATER DIVIDES
SUB CHAR,NC ;COMPUTE NUMBER OF COLUMNS REQUESTED
ADDI CHAR,(NEW) ;ROUND UP
IDIVI CHAR,(NEW) ;NUMBER OF FULL WORDS NEEDED
IMULI CHAR,(NEW) ;BACK TO NUMBER OF CHARACTERS
SOS CHAR ;NOW COMPUTE END COLUMN
ADD CHAR,NCPRIM ;AS START+NUMBER OF COLUMNS-1
MOVEM CHAR,ENDUSR ;...
JRST DPYO.1 ;ENTER DPYOUT FOR THE REST
;ENTRY TO DISPLAY A CHANGING SCREEN..
;
; CALL DPYOUT(NEW-SCREEN-ARRAY)
;
;SEE SIZE DEFINITIONS FOR "DPYINI"
;ENTER AT DPYREM TO LEAVE CURSOR AT LAST POSITION AND REMEMBER THAT
DPYREM:: SETOM REMEMB ;MARK REMEMBERING
DPYOUT::SKIPGE CLRING ;CLEARING A SECTION?
JRST DPYOUC ;YES--DONT CHECK ATTRIBUTES
HLRE CHAR,-1(16) ;GEt the arguement count
MOVMS CHAR ;Make positive
MOVEI SCR,2 ;GEt the offset to the attribute word
CAML CHAR,SCR ;Did he specify an attribute
PUSHJ P,SAVATR ;Save the attributes
DPYOUC: JSP CHAR,SAVREG ;SAVE CALLERS REGISTERS
SKIPE BOUNDS ;BOUNDRIES SET UP
JRST DPYO.1 ;YES, NO NEED TO DO IT TWICE
MOVEI CHAR,1 ;GET A 1
MOVEM CHAR,NLPRIM ;AS 1ST LINE OF SWEEP
MOVEM CHAR,NCPRIM ;AS 1ST COLUMN
MOVE CHAR,NLINES(TYP);GET LOWER BOUND
MOVEM CHAR,NLEND ;MARK END
MOVE CHAR,NCOLS(TYP) ;GET RIGHT BOUNDARY
MOVEM CHAR,NCEND ;MARK IT
MOVEI CHAR,NCMAX ;HIGHEST COLUMN REPRESENTED BY USERS ARRAY
MOVEM CHAR,ENDUSR ;FOR KEEPING BYTE POINTERS STRAIGHT
SETOM BOUNDS ;FLAG BOUNDS ARE SET NOW
DPYO.1: HLL NEW,NEWPTR ;INSERT SIZE AND POSITION FOR BYTE POINTER
SKIPE CLRING ;CLEARING?
JRST DPYOC2 ;YES
HLRZ CHAR,0(ARGS) ;Get the first arguement pointer
ANDI CHAR,(Z 17,) ;Just want the AC field
MOVEI SCR,@0(ARGS) ;GET ADDRESS OF SCREEN ARRAY
CAIN CHAR,(Z 15,) ;Do we have an F77 string?
HRRZ SCR,(SCR) ;Yes, get the address of string
CAIN CHAR,(Z 15,) ;Again
HRLI NEW,(POINT 7,0) ;User sent a 7 bit string
SKIPE CLRING ;CLEARING THE SPECIFIED SECTION
DPYOC2: TDZA NEW,NEW ;YES, GENERATE A NULL BYTE POINTER
HRRI NEW,0(SCR) ;POINT TO NEW SCREEN
PUSHJ P,GOHOME ;MAYBE SET TO HOME POSITION
;START OUTER ( PER LINE ) LOOP
MOVE NL,NLPRIM ;GET 1ST LINE OF SWEEP
MOVEI NC,1 ;SET COLUMN TO 1 FOR FIXOLD
PUSHJ P,FIXOLD ;SET "OLD" CORRECTLY
M1: SKIPE WHERA ;IS AN ERASE TO END OF LINE POSSIBLE
PUSHJ P,CLRLIN ;YES, TRY TO CLEAR IT NOW
CAMLE NL,NLEND ;OFF THE BOTTOM OF THE SCREEN
JRST REMRET ;YES, ALL DONE WITH THE SWEEP
;START INNER ( PER COLUMN ) LOOP
M1.1: MOVE NC,NCPRIM ;GET 1ST COLUMN OF SWEEP
CAIE NC,1 ;STARTING AT THE LEFT MARGIN
PUSHJ P,FIXOLD ;NO, BYTE POINTER MUST BE RE-COMPUTED
M2: CAILE NC,NCMAX ;OFF THE RIGHT HAND SIDE
AOJA NL,M1 ;YES, GO TO NEXT LINE
CAMG NC,ENDUSR ;OFF THE EDGE OF THE USERS ARRAY
ILDB CHAR,NEW ;NO, GET NEW CHARACTER
SKIPE LJUST ;LEFT JUSTIFIED A1 FORMAT
LSH CHAR,-^D29 ;YES, MOVE IT OVER
PUSHJ P,GETGLB ;GET ATTRIBUTES FOR THIS CHAR
ILDB SCR,OLD ;AND CURRENT SCREEN ENTRY
SKIPE REFING ;DOING SCREEN REFRESH
SETZ SCR, ;YES--NEVER MATCH
CAMLE NC,NCEND ;OFF THE END OF THE DISPLAY
MOVE CHAR,SCR ;YES, DISPLAY SELF TO KEEP POINTERS STRAIGHT
PUSHJ P,CT2SPC ;Convert control characters to spaces
CAIE CHAR," " ;SHOWING A BLANK
JRST M2.1 ;NO, LOOK SOME MORE
SKIPN ERAEOL(TYP) ;CAN WE ERASE TO EOL?
JRST [DPB CHAR,OLD ;NO--STORE BLANK
JRST M2.1] ;AND LOOP
SKIPN WHERA ;ALREADY FIND FIRST BLANK
MOVEM NC,WHERA ;REMEMBER FIRST BLANK
CAIN SCR," " ;WAS COLUMN ALREADY BLANKED
AOJA NC,M2 ;YES, TRY NEXT COLUMN
DPB CHAR,OLD ;STORE INTO CURRENT SCREEN NOW
SKIPN WHCHR ;THIS THE FIRST CHANGE TO A BLANK
MOVEM NC,WHCHR ;REMEMBER FIRST CHANGE
MOVEM NC,WHLST ;REMEMBER LAST CHANGE TO A BLANK TOO
AOJA NC,M2 ;AND GO LOOK AT THE NEXT
M2.1: SETZM WHERA ;CAN'T ERASE NOW
SKIPN WHCHR ;DID A CHANGE TO A BLANK OCCUR
JRST M2.2 ;NO, WE DON'T OWE IT ANY CHANGES
PUSH P,NC ;SAVE CURRENT COLUMN
MOVE NC,WHCHR ;GET WHERE THE FIRST CHANGE OCCURED
PUSHJ P,CURMOV ;POSITION CURSOR THERE
AOS NC,WHLST ;FIND BEYOND LAST CHANGE TO A BLANK
SETOM FRCRTY ;FORCE RE-TYPE OF LINE
PUSHJ P,CURMOV ;GET THERE BY RE-TYPING
SETZM WHCHR ;AND NOW, NO CHANGES
POP P,NC ;RESTORE CURRENT
SKIPE REFING ;DOING A REFRESH CYCLE
TDZA SCR,SCR ;YES--NEVER MATCH
LDB SCR,OLD ;GET OLD SCREEN CONTENTS BACK AFTER MOVING
M2.2: CAMN CHAR,SCR ;DISPLAYING THE SAME CHARACTER
AOJA NC,M2 ;YES, FORGET OUTPUT
PUSHJ P,CURMOV ;MOVE FROM "POSL,POSC" TO "NL,NC"
MOVEI S1,CHRATR ;Get the routine adress for special characters
PUSHJ P,XCTTBL ;Call the routine
JFCL ;Whatever happens happens
DPB CHAR,OLD ;STORE INTO CURRENT SCREEN NOW
ANDI CHAR,177 ;Down to ASCII
PUSHJ P,DPYPUT ;OUTPUT IT
MOVE CUR,OLD ;REMEMBER WHERE WE ARE NOW
AOS POSC ;AND ADJUST CURSOR POSITION
AOJA NC,M2 ;AND GET NEXT COLUMN
REMRET: SKIPN REMEMB ;WANT TO REMEMBER POSITION
FORGET: SETO POSL, ;AND FORGET POSITION INFO
FRCRET: SETZM REMEMB ;CLEAR REMEMBER FLAG
JSP CHAR,RESREG ;RESTORE CALLERS REGISTERS
SKIPN LINPTR ;AVOID OUTSTR IF NO CHANGES THIS SWEEP
POPJ P, ;RETURN, NO OUTPUT TO DO
; Output a buffer to the terminal
; Call: PUSHJ P,FRCOUT
;
FRCOUT::SETZM LINPTR ;CLEAR CURRENT LINE IN CORE
IF TOPS-10,<
SKIPN ISOFLG ;HAVE IMAGE OUTSTR FUNCTION?
JRST FRCO.3 ;NO
PUSH P,SCR ;SAVE FROM DESTRUCTION
MOVEI SCR,.TOISO ;GET THE IMAGE OUTSTR FUNCTION
MOVEM SCR,TRMFNC ;STORE IT
MOVEI SCR,^D499 ;GET COUNT OF MAX CHARS IN BUFFER
SUB SCR,LINCNT ;GET COUNT OF CHARS IN BUFFER NOW
HRLI SCR,7 ;7 BIT BYTES
MOVEM SCR,TRMARG ;STORE IT ALSO
MOVEI SCR,LINBUF ;GET ADDRESS OF BUFFER
MOVEM SCR,TRMARG+1 ;POINT MONITOR TO IT
MOVE SCR,[XWD 4,TRMFNC] ;GET THE FUNCTION POINTER
TRMOP. SCR, ;OUTPUT THE STRING IN IMAGE MODE
JRST FRCO.2 ;DO IT THE HARD WAY
JRST SCPOPJ ;RESTORE SCR AND RETURN
FRCO.1: PUSH P,SCR ;SAVE CHARACTER
FRCO.2: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
HRRZS S1,TRMARG ;GET COUNT OF CHARACTERS IN BUFFER NOW
MOVE S2,TRMARG+1 ;GET ADDRESS OF STRING
HRLI S2,(POINT 7,) ;MAKE A BYTE POINTER
MOVEI SCR,.TOOIC ;OUTPUT IMAGE CHARACTER FUNCTION
MOVEM SCR,TRMFNC ;SET IT
FRCO.3: SOJL S1,FRCO.4 ;DONE ALL CHARACTERS?
ILDB SCR,S2 ;GET A CHARACTER
MOVEM SCR,TRMARG ;SAVE IT
MOVE SCR,[3,,TRMFNC] ;SET UP UUO
TRMOP. SCR, ;OUTPUT IT
IONEOU TRMARG ;???
JRST FRCO.3 ;LOOP FOR ALL CHARACTERS
FRCO.4: POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
SCPOPJ: POP P,SCR ;RESTORE CHARACTER
POPJ P, ;RETURN
> ;END IF TOPS-10
IF TOPS-20,<
PUSH P,SCR ;SAVE CALLERS
PUSH P,SCR+1 ;...
PUSH P,SCR+2 ;...
PUSH P,SCR+3 ;...
MOVE SCR,TTYJFN ;IMAGE MODE OUTPUT JFN
MOVE SCR+1,[POINT TTYBYT,LINBUF]
SETZB SCR+2,SCR+3 ;STOP ON A NULL
SOUT ;OUTPUT IT
MOVE SCR+1,[1,,1] ;HACK FOR NOW, SET POS TO 1,,1
SFPOS ;EVENTUALLY I'LL SET TO WHERE CURSOR IS
POP P,SCR+3 ;RESTORE CALLERS
POP P,SCR+2 ;...
POP P,SCR+1 ;...
POP P,SCR ;...
> ;END IF IF TOPS-20
IF TOPS-10,<POP P,S1> ;REstore the register
CPOPJ: POPJ P, ;AND RETURN
; Test for the Image OUTSTR TRMOP. function
; Call: PUSHJ P,ISOTST
;
; On return ISOFLG will be set accordingly for use by FRCOUT
;
ISOTST: SETZM ISOFLG ;ASSUME NO IMAGE OUTSTR FUNCTION
IF TOPS-10,<
PUSH P,S1 ;SAVE FROM DESTRUCTION
MOVEI S1,.TOISO ;Get the Image OUTSTR function
MOVEM S1,TRMFNC ;STORE IT
MOVE S1,[7,,1] ;7 BIT BYTES,,ONE CHARACTER
MOVEM S1,TRMARG ;STORE WORD
MOVEI S1,[BYTE (7),0] ;A NULL STRING
MOVEM S1,TRMARG+1 ;STORE IT
MOVE S1,[XWD 4,TRMFNC] ;SET UP UUO
TRMOP. S1, ;TRY IT
SKIPA ;DON'T HAVE THIS FUNCTION
AOS ISOFLG ;REMEMBER WE HAVE IMAGE OUTSTR
POP P,S1 ;RESTORE S1
> ;END IF TOPS-10
IF TOPS-20,<
;; CDUNN TAKE NOTE: ADD SOME CODE HERE
> ;END IF TOPS-20
POPJ P, ;RETURN
;SUBROUTINE TO MOVE THE CURSOR
;
; POSL = LINE WHERE CURSOR IS
; POSC = COLUMN " " "
;
; NL = LINE WHERE WE WANT TO BE
; NC = COLUMN " " " " "
CURMOV: PUSH P,CHAR ;SAVE CALLERS CHARACTER
SKIPE FRCRTY ;FORCED TO RE-TYPE IN RIGHT MOVEMENT
JRST [SETZM FRCRTY ;YES, CLEAR INDICATOR
JRST MOV.3] ;AND MOVE IT ( ALREADY ON THE SAME LINE )
MOV.0: CAMN POSL,NL ;AT THE CORRECT LINE
JRST MOV.1 ;YES, END OF VERTICAL POSITIONING
SKIPE DIRADR(TYP) ;CAN TERMINAL DIRECT ADDRESS
JRST MOVDIR ;YES, DO IT NOW SINCE NOT ON RIGHT LINE
CAML POSL,NL ;MOVING UP
JRST MOV.01 ;YES, DO THAT
MOVEI S1,LINEFD ;LINE FEED
PUSHJ P,XCTTBL ;Execute the entry
TRNA ;Done
PUSHJ P,PUTCTL ;OUTPUT THE DOWN SEQUENCE
TLO CUR,77 ;BYTE POINTER IS INVALID NOW
AOJA POSL,MOV.0 ;ADJUST AND GET THE NEXT COLUMN
MOV.01: MOVE SCR,POSL ;GET CURRENT POSITION
SUB SCR,NL ;DIFFERENCE = NUMBER OF UP MOVES
CAILE SCR,-1(NL) ;IS HOME POSITION CLOSER
JRST [PUSHJ P,HOME ;GET TO THE HOME POSITION
JRST MOV.0] ;NOW GOING THE OTHER WAY
MOVEI S1,CURUP ;GET UP SEQUENCE
PUSHJ P,XCTTBL ;Execute it
TRNA ;Done
PUSHJ P,PUTCTL ;OUTPUT THAT
TLO CUR,77 ;BYTE POINTER IS INVALID NOW
SOJA POSL,MOV.0 ;CONTINUE MOVING
MOV.1: CAMN POSC,NC ;AT THE CORRECT COLUMN
JRST MOVEND ;YES, WE ARE THERE
CAIN NC,1 ;WANT BACK AT THE LEFT MARGIN
JRST MOV.2 ;YES, GO DO THAT NOW
MOVE SCR,POSC ;GET CURRENT
SUB SCR,NC ;HOW MANY AWAY FROM TARGET
MOVMS SCR ;IGNORE SIGN PROBLEMS
SKIPE DIRADR(TYP) ;CAN TERMINAL DIRECT CURSOR ADDRESS
CAIG SCR,4 ;YES, BUT IS MOVEMENT SLIGHT
SKIPA ;DO IT THE HARD WAY
JRST MOVDIR ;GO DIRECT MOVE
CAMGE NC,POSC ;WANT LEFT OF CURRENT
CAMG SCR,NC ;AND CLOSER TO THE LEFT MARGIN
JRST MOV.3 ;NO, CANNOT USE CARRIAGE RETURN
MOV.2: MOVEI CHAR,15 ;A CARRIAGE RETURN
PUSHJ P,DPYPUT ;OUTPUT IT
TLO CUR,77 ;MARK UNKNOWN POSITION
MOVEI POSC,1 ;NOW AT COLUMN 1
MOV.3: CAMLE POSC,NCOLS(TYP) ;BUMPED AGAINST THE RIGHT MARGIN
JRST [MOVE POSC,NCOLS(TYP) ;YES, THEN WE ARE THERE
TLO CUR,77 ;BYTE POINTER IS INVALID NOW
JRST .+1] ;RESUME IN-LINE CODE
MOVE SCR,POSC ;GET CURRENT COLUMN
MOV.4: CAMG SCR,NC ;HIT SPOT YET
JRST MOV.5 ;YES, NOW LOOK THE OTHER WAY
MOVEI S1,CLEFT ;GET CURSOR LEFT SEQUENCE
PUSHJ P,XCTTBL ;Execute it
TRNA ;Done
PUSHJ P,PUTCTL ;OUTPUT THE STRING
TLO CUR,77 ;MARK UNKNOWN POSITION
MOVE POSC,NC ;IN CASE THIS IS THE LAST ITERATION
SOJA SCR,MOV.4 ;DRIVE THIS LOOP BACKWARDS
MOV.5: CAMN POSC,NC ;AT THE CORRECT SPOT
JRST MOVEND ;YES, WE ARE FINALLY THERE
TLNE CUR,77 ;BYTE POINTER CORRECT
PUSHJ P,SETCUR ;NO, GO FIX IT
ILDB CHAR,CUR ;GET WHAT IS ALREADY THERE
MOVEI S1,CHRATR ;Get the special attributes table
PUSHJ P,XCTTBL ;Execute it
JFCL ;No matter here
PUSHJ P,DPYPUT ;OUTPUT IT
AOJA POSC,MOV.5 ;AND CONTINUE MOVING RIGHT BY RE-TYPING
MOVDIR: MOVEI S1,DIRADR ;Get the flag to see if this is special
PUSHJ P,XCTTBL ;Execute it
JRST MOVXIT ;SEND IT AND CLEAN UP
PUSHJ P,PUTCTL ;OUTPUT START SEQUENCE
MOVEI CHAR,-1(NL) ;GET LINE NUMBER ( 0 TO NLINES-1 )
IFN REVDIR,< ;IF SOME TERMINAL WANTS COLUMN THEN LINE
MOVE POSC,DIRADR(TYP);GET ADDRESSING SEQUENCE (BIT 35 IS FLAG)
TRNE POSC,1 ;TERMINAL TAKE COLUMN FIRST
MOVEI CHAR,-1(NC) ;YES, COLUMN INSTEAD
>
MOVEI S1,COMPXY ;Compute X
PUSHJ P,XCTTBL ;Execute it
TRNA ;Done
PUSHJ P,DPYPUT ;OUTPUT IT
IFDEF %VT05,< ;IF SUPPORTING VT05'S
CAIN TYP,.VT05 ;VT05 NEEDS SPECIAL HANDLING
PUSHJ P,VT05FL ;OUTPUT NULLS FOR FILLER
>
MOVEI CHAR,-1(NC) ;GET COLUMN NUMBER ( 0 TO NCOLS-1 )
IFN REVDIR,< ;DOES SOMEBODY TAKE LINE SECOND
TRNE POSC,1 ;TERMINAL WANT LINE LAST
MOVEI CHAR,-1(NL) ;YES, GET LINE INSTEAD
>
MOVEI S1,COMPXY ;Compute X
PUSHJ P,XCTTBL ;Execute it
TRNA ;Done
MOVXIT: PUSHJ P,DPYPUT ;OUTPUT THAT
MOVE POSC,NC ;RESET CURRENT POINTS
MOVE POSL,NL ;...
TLO CUR,77 ;BYTE POINTER IS NOW INVALID
MOVEND: POP P,CHAR ;RESTORE CALLERS AFTER MOVING
POPJ P, ;AND RETURN
;SUBROUTINE TO TRY AN ERASE TO END OF LINE
CLRLIN: SOS NL ;ALWAYS CALLED FOR PREVIOUS LINE
SETZ SCR, ;CLEAR A REG
EXCH SCR,WHCHR ;ANYTHING GET TURNED INTO A BLANK
JUMPE SCR,CLRL.2 ;NO, THEN NO NEED FOR ERASE
MOVE NC,WHERA ;COLUMN WHERE FIRST BLANK APPEARED
CAML NC,POSC ;FIRST BLANK RIGHT OF CURSOR
JRST CLRL.1 ;YES, CLEAR FROM THERE
CAML SCR,POSC ;FIRST CHANGE RIGHT OF CURSOR
JRST [MOVE NC,POSC ;YES, JUST NEED TO MOVE DOWN
JRST CLRL.1] ;GO CLEAR
MOVE CHAR,POSC ;FIND CLOSEST POINT
SUB CHAR,NC ;SAME AS MOV.1
CAMLE CHAR,NC ;WOULD <CR> BE CLOSER THAN BACKSPACE
MOVE CHAR,NC ;YES, REMEMBER THAT
MOVEM CHAR,WHERA ;STORE IN A TEMP FOR NOW
MOVE CHAR,POSC ;WHERE DID FIRST CHANGE TO A BLANK OCCUR
SUB CHAR,SCR ;AND WHERE WE ARE NOW
MOVMS CHAR ;WANT .ABS. OF THAT
CAMG CHAR,WHERA ;WHICH IS CLOSER TO CURRENT POINT
MOVE NC,SCR ;FIRST BLANK
CLRL.1: CAMLE NC,NCOLS(TYP) ;OFF THE RIGHT HAND SIDE ANYWAY
JRST CLRL.2 ;YES, WON'T SEE IT
ERSLIN: PUSHJ P,CURMOV ;MOVE THE CURSOR TO THE SPOT FOR ERASE
MOVEI S1,ERAEOL ;ERASE SEQUENCE
PUSHJ P,XCTTBL ;Execute the entry
TRNA ;All done
PUSHJ P,PUTCTL ;OUTPUT CONTROL SEQUENCE
CLRL.2: SETZM WHERA ;MARK CLEAR DONE
AOJA NL,CPOPJ ;RESTORE THIS LINE AND RETURN
;SUBROUTINE TO BUILD BYTE POINTER TO REFLECT "POSL,POSC"
SETCUR: MOVEI CHAR,-1(POSL) ;CURRENT LINE ON SCREEN
IMULI CHAR,NCMAX ;COMPUTE DOUBLE SUBSCRIPT
ADDI CHAR,-1(POSC) ;INCLUDE COLUMN
IDIVI CHAR,BYTEPW ;NOW FIND CORRECT WORD AND BYTE
MOVEI CUR,SCREEN ;BASE OF THE SCREEN
ADD CUR,CHAR ;MOVE ENOUGH WORDS
HLL CUR,CURPTR(SCR) ;AND INSERT POSITION INFORMATION
POPJ P, ;RETURN FOR "ILDB/IDPB"
;SUBROUTINE TO SET "OLD" TO REFLECT "NL,NC"
FIXOLD: MOVEI CHAR,-1(NL) ;SAME CODE AS SETCUR
IMULI CHAR,NCMAX ; BUT CAN'T USE THAT SUBROUTINE
ADDI CHAR,-1(NC) ; CAUSE I HAVE TO SAVE POSL,POSC
IDIVI CHAR,BYTEPW ; AND IT WORKS OUT TO THE SAME NUMBER
MOVEI OLD,SCREEN ; OF INSTRUCTIONS, SO.....
ADD OLD,CHAR ;...
HLL OLD,CURPTR(SCR) ;AT LEAST I CAN USE THE SAME TABLE
POPJ P,
;SUBROUTINE TO OUTPUT CONTROL SEQUENCES TO TERMINALS
;SUBROUTINE TO PLACE CURSOR AT THE HOME POSITION ( MAYBE )
GOHOME: TLO CUR,77 ;BYTE POINTER IS INVALID
JUMPG POSL,CPOPJ ;RETURN IF REMEMBERED POINT
SKIPN DIRADR(TYP) ;CAN TERMINAL DIRECT ADDRESS
JRST HOME ;NO, DO IT THE HARD WAY
MOVEI POSL,^D32768 ;FOR DIRECT MOVEMENT IN CURMOV
POPJ P, ;RETURN
HOME: MOVEI POSL,1 ;CURSOR IS AT LINE 1
MOVEI POSC,1 ;COLUMN 1
MOVEI S1,HOMEUP ;GOTO TOP OF SCREEN
PUSHJ P,XCTTBL ;Execute the entry
POPJ P, ;All done
PUTCTL::HRLI CHAR,(POINT 7,0);INSERT BYTE INFO
MOVEM CHAR,PUTPTR ;SAVE POINTER
PUTC.1: ILDB CHAR,PUTPTR ;GET CHARACTER IN SEQUENCE
JUMPE CHAR,CPOPJ ;STOP AT A NULL
IFN DOFILL,< ;IF SOME TERMINAL NEEDS FILLERS
CAIN CHAR,177 ;REQUEST FOR FILLERS
JRST PUTC.2 ;DO THEM
>
PUSHJ P,DPYPUT ;OUTPUT THE CHARACTER
JRST PUTC.1 ;RESUME LOOP
IFN DOFILL,<
PUTC.2: MOVE CHAR,FILLRS ;GET -NUMBER OF FILLERS,,0
JUMPE CHAR,PUTC.1 ;NONE AT THIS SPEED
HRRI CHAR,TTYFIL ;GET FILLER CHARACTER
PUSHJ P,DPYPUT ;OUTPUT IT
AOBJN CHAR,.-2 ;DO AS MANY AS NEEDED
JRST PUTC.1 ;AND RESUME FROM THE CONTROL STRING
>
;SUBROUTINE TO STUFF "CHAR" INTO INTERMEDIATE BUFFER FOR DISPLAY
DPYPUT: SKIPE LINPTR ;ANY CURRENT LINE
JRST DPYP.1 ;YES, GO INCLUDE CHARACTER
PUSH P,CHAR ;NO, SAVE CURRENT
MOVE CHAR,[POINT TTYBYT,LINBUF] ;GET BUFFER POINTER
MOVEM CHAR,LINPTR ;INITIALIZE POINTER
MOVEI CHAR,^D499 ;CHARACTERS IN THE BUFFER
MOVEM CHAR,LINCNT ;AS THE LINE COUNTER
SETZM LINBUF ;CLEAR THE INCORE BUFFER NOW
MOVE CHAR,[LINBUF,,LINBUF+1]
BLT CHAR,LBUFND
POP P,CHAR ;RESTORE CHARACTER
DPYP.1: SOSL LINCNT ;ROOM IN THE BUFFER
JRST [IDPB CHAR,LINPTR ;YES, ADD THE CHARACTER
POPJ P,] ;AND RETURN
PUSHJ P,FRCOUT ;NO, FORCE OUT THE BUFFER
JRST DPYPUT ;AND START AGAIN
;HERE TO HANDLE SPECIAL VT05 FILLERS FOR CURSOR ADDRESSING
;VT05 NEEDS FILLERS BETWEEN LINE NUMBER AND COLUMN NUMBER
IFDEF %VT05,<
VT05FL:
IF TOPS-10,<
MOVE CHAR,FILLRS ;DO IT THE HARD WAY HERE CAUSE I REALLY NEED NULLS
JUMPE CHAR,CPOPJ ;NOT NEEDED AT THIS SPEED
PUSHJ P,FRCOUT ;FORCE OUT THE CURRENT BUFFER
SETZ SCR, ;GET A NULL
IONEOU SCR ;IMAGE OUTPUT A NULL
AOBJN CHAR,.-1 ;OUTPUT AS MANY AS NEEDED
POPJ P, ;THEN RETURN
> ;END IF TOPS-10
IF TOPS-20,<
MOVEI CHAR,[BYTE (7)177] ;ASK FOR FILLERS (WILL BE IMAGE NULLS LATER)
JRST PUTCTL ;OUTPUT FILLERS
> ;END IF TOPS-20
> ;END IFDEF
;VT100 TAKES ASCII LINE AND COLUMN SEQUENCE, OUTPUT IT HERE
IFDEF %ANSI,<
ANSIM: PUSH P,CHAR+1 ;SAVE AC FROM DIVIDES
MOVEI CHAR,[BYTE (7)33,"[",0] ;Get the staring sequence
PUSHJ P,PUTCTL ;Output it
MOVEI CHAR,(NL) ;GET LINE
PUSHJ P,ANSID ;OUTPUT LINE NUMBER
MOVEI CHAR,";" ;SEPARATE WITH SEMICOLON
PUSHJ P,DPYPUT ;STUFF THAT IN
MOVEI CHAR,(NC) ;NOW COLUMN NUMBER
PUSHJ P,ANSID ;INCLUDE THAT
POP P,CHAR+1 ;RESTORE AC
MOVEI CHAR,"H" ;END OF SEQUENCE
POPJ P, ;Return
ANSID: IDIVI CHAR,^D10 ;CONVERT TO DECIMAL LINE/COLUMN NUMBERS
HRLM CHAR+1,(P) ;STANDARD STUFF HERE
SKIPE CHAR ;DONE YET
PUSHJ P,ANSID ;NO, RECURSE A LITTLE
HLRZ CHAR,(P) ;GET DIGIT
ADDI CHAR,"0" ;TO ASCII
JRST DPYPUT ;INCLUDE IN BUFFER, GET ANOTHER (MAYBE)
>
; SUBTTL XCTTBL -- Execute the table entries
; This routine will execute the table entries for the user so that
; We don't have to bother with checking for special routines to call
; or instructions to execute.
; Call:
; S1/ Name of the table
; PUSHJ P,XCTTBL
; Normal return ;Routine called,
; ; No skip return from them please
; Skip return ;Address of the string in CHAR
; ; or instruction executed
XCTTBL: ADDI S1,(TYP) ;Calculate the offset
HLRE S2,(S1) ;Get the left half of the word
MOVMS S2 ;Absolute value please
JRST @XCTDSP(S2) ;Go do it
XCT.0: MOVE CHAR,(S1) ;Get the address of the string
.POPJ1: AOS (P) ;Give a skip return
.POPJ: POPJ P,
XCT.1: HRRZ S2,(S1) ;Get the routine
JRST (S2) ;Go call it
XCT.2: HRRZ S2,(S1) ;Get the instruction
XCT (S2) ;Execute it
JRST .POPJ1 ;Give a skip return
XCTDSP: EXP XCT.0 ;Dispatch routines table
EXP XCT.1
EXP XCT.2
;SAVE AND RESTORE SEQUENCES
SAVREG: PUSH P,CUR ;SAVE CALLERS REGS
PUSH P,NEW ;...
PUSH P,OLD ;...
PUSH P,NL ;...
PUSH P,NC ;...
PUSH P,S1 ;...
PUSH P,S2 ;...
EXCH POSL,CURL ;SAVE OLD, GET NEW
EXCH POSC,CURC ;...
EXCH TYP,VIDEOT ;...
JUMPL TYP,INIERR ;ERROR IF NEVER DEFINED TERMINAL TYPE
JRST @CHAR ;RETURN TO CODE
RESREG: EXCH POSL,CURL ;SAVE COMPUTED, RESTORE OLD
EXCH POSC,CURC ;...
EXCH TYP,VIDEOT ;...
POP P,S2 ;RESTORE CALLERS REGISTERS
POP P,S1 ;...
POP P,NC ;...
POP P,NL ;...
POP P,OLD ;...
POP P,NEW ;...
POP P,CUR ;...
JRST @CHAR ;RETURN TO CODE
;TABLE OF BYTE POINTERS FOR "SETCUR" AND "FIXOLD"
CURPTR: 442200,,0 ;Left half word
222200,,0 ;Right half word
; 440700,,0 ;FOR CHARACTER 1
; 350700,,0 ; " " 2
; 260700,,0 ; " " 3
; 170700,,0 ; " " 4
; 100700,,0 ; " " 5
IF TOPS-10,<
TRMERR: OUTSTR [ASCIZ/?CANNOT SET TTY NO CRLF IN "DPYINI"/]
JRST ERRXIT
IONERR: OUTSTR [ASCIZ/?CANNOT FIND TERMINAL INDEX IN "DPYINI"/]
JRST ERRXIT
INIERR: OUTSTR [ASCIZ/?DPYPAK NEVER INITIALIZED/]
ERRXIT: EXIT 1, ;REMOVE AND RETURN ERROR = -1 WHEN
JRST .-1 ;DPYINI RETURNS TERMINAL HANDLES
> ;END OF IF TOPS-10
IF TOPS-20,<
NOTTY: SKIPA SCR,[-1,,[ASCIZ\?DPYPAK COULDN'T GTJFN/OPENF THE TTY\]]
INIERR: HRROI SCR,[ASCIZ/?DPYPAK NEVER INITIALIZED/]
PSOUT ;OUTPUT THE ERROR
HALTF ;REMOVE AND RETURN ERROR = -1 WHEN
JRST .-1 ;DPYINI RETURNS TERMINAL HANDLES
> ;END OF IF TOPS-20
;SUBROUTINE TO SET JOBS TTY THE WAY DPYPAK WANTS THEM
;RETURNS SCR = THE TERMINAL TYPE IF THIS MONITOR KNOWS IT
GETTYP:
IF TOPS-10,<
MOVSI CHAR,'TTY' ;GET CALLERS TTY NUMBER
IONDX. CHAR, ;ASK THE MONITOR
JRST IONERR ;CAN'T FIND OUT
MOVEM CHAR,TRMUDX ;STUFF INTO ARG BLOCK
MOVEI CHAR,.TOTRM ;READ TERMINAL TYPE
MOVEM CHAR,TRMFNC ;STORE FUNCTION
MOVE CHAR,[3,,TRMFNC];GET ARGUMENT POINTERS
TRMOP. CHAR, ;ASK FOR SET TERMINAL TYPE
SETZ CHAR, ;NONE, SET UNKNOWN TYPE
> ;END OF IF TOPS-10
IF TOPS-20,<
PUSH P,SCR+1 ;KEEP SAFE FROM JSYS'ES
MOVEI SCR,.PRIOU ;FOR CURRENT TERMINAL
GTTYP ;GET TERMINAL TYPE
MOVE CHAR,SCR+1 ;WANT IT IN CHAR
POP P,SCR+1 ;RESTORE AC'S
> ;END OF IF TOPS-20
MOVSI SCR,-MAXTYP ;NUMBER OF KNOWN TYPES
CAME CHAR,TYPTAB(SCR) ;FOUND IT
AOBJN SCR,.-1 ;NO, KEEP LOOKING
SKIPL SCR ;DID WE FIND ONE
TDZA SCR,SCR ;NO, CLEAR TERMINAL TYPE
MOVE SCR,TYPNAM(SCR) ;YES, GET ITS REAL NAME
POPJ P, ;RETURN TO DPYINI
SUBTTL SETINI -- INITIALIZE TERMINAL PARAMETERS
DPYTTY::
SETINI:
IF TOPS-10,<
PUSH P,CHAR ;SAVE CALLERS
MOVEI SCR,.TONFC ;READ STATE OF TTY CRLF
PUSHJ P,RTRMOP ;..
JRST TRMERR ;ERROR
MOVEM SCR,OCRLF ;SAVE
MOVEI SCR,.TONFC ;SET TTY NO CRLF
MOVEI CHAR,1 ;VALUE
PUSHJ P,STRMOP ;..
JRST TRMERR ;ERROR
MOVEI SCR,<.TOSSZ==1062>;READ STATE OF TTY STOP N
PUSHJ P,RTRMOP ;..
JRST SETI.1 ;OLD MONITOR
MOVEM SCR,OPAGES ;SAVE IT
MOVEI CHAR,0 ;CLEAR TTY STOP
MOVEI SCR,.TOSSZ ;SET FUNCTION
PUSHJ P,STRMOP ;SET IT
JRST TRMERR ;ERROR
JRST SETFIL ;AND HANDLE FILLERS
SETI.1: MOVEI SCR,.TOPSZ ;READ STATE OF TTY PAGE N
PUSHJ P,RTRMOP ;..
JRST TRMERR ;ERROR
MOVEM SCR,OPAGES ;SAVE IT
MOVEI CHAR,0 ;CLEAR TTY PAGE
MOVEI SCR,.TOPSZ ;SET FUNCTION
PUSHJ P,STRMOP ;SET ITT
JRST TRMERR ;ERROR
SETFIL:
IFN DOFILL,< ;ONLY IF SOME TERMINALS NEED FILLERS
MOVEI SCR,.TOTSP ;READ TRANSMIT SPEED
PUSHJ P,RTRMOP ;..
MOVEI SCR,0 ;FAILED
SKIPG SCR ;DID I GET ONE
TDZA CHAR,CHAR ;NO, CLEAR SPEED
MOVE CHAR,[EXP ^D50,^D75,^D110,^D134,^D150,^D200,^D300,^D600
EXP ^D1200,^D1800,^D2400,^D4800,^D9600,^D9600,^D9600]-1(SCR)
MOVEM CHAR,BAUD ;STORE INTERESTING NUMBER
IDIVI CHAR,^D600 ;RECOMMENDED CONVERSION
MOVNS CHAR ;GET - NUMBER NEEDED
HRLZM CHAR,FILLRS ;REMEMBER NUMBER OF FILLERS NEEDED
> ;END IFN DOFILL
POP P,CHAR ;RESTORE
POPJ P, ;RETURN
> ;END IF TOPS-10
IF TOPS-20,<
PUSH P,SCR+1 ;KEEP SAFE FROM JSYS'ES
MOVSI SCR,1 ;SHORT GTJFN
HRROI SCR+1,[ASCIZ/TTY:/]
GTJFN ;GET HANDLE FOR THE TERMINAL
JRST NOTTY ;CAN'T GET THE TTY?
HRRZM SCR,TTYJFN ;SAVE JFN ACQUIRED
MOVE SCR+1,[100000,,100000] ;8 BIT MODE, WRITE
OPENF ;OPEN THE TTY
JRST NOTTY ;WHAT?
IFN DOFILL,< ;ONLY IF SOME TERMINALS NEED FILLERS
PUSH P,SCR+2 ;KEEP SAFE FROM JSYS'ES
MOVEI SCR,.PRIOU ;FOR CURRENT TERMINAL
MOVEI SCR+1,.MORSP ;FUNCTION RETURN BAUD RATES
MTOPR ;GET THEM
SKIPGE SCR+2 ;RATE KNOWN
SKIPA SCR,[^D2400] ;NO, SAY 2400 (PROBABLY A PTY)
HRRI SCR,(SCR+2) ;YES, GET OUTPUT SPEED
HRRZM SCR,BAUD ;STORE INTERESTING NUMBER
IDIVI SCR,^D600 ;RECOMMENDED CONVERSION
MOVNS SCR ;GET - NUMBER NEEDED
HRLZM SCR,FILLRS ;REMEMBER NUMBER OF FILLERS NEEDED
POP P,SCR+2 ;RESTORE AC'S
> ;END IFN DOFILL
POP P,SCR+1 ;RESTORE AC'S
POPJ P, ;RETURN
> ;END IF TOPS-20
SUBTTL DPYXIT -- RESTORE USER TERMINAL PARAMETERS
DPYXIT::
PUSHJ P,DPYNAT ;TURN OFF ATTRIBUTES
PUSHJ P,FRCOUT ;FORCE OUT CHARACTERS TO RESET THE WORLD
SKIPE ISOFLG ;HAVE IMAGE MODE?
POPJ P, ;YES--NOTHING TO RESET
IF TOPS-10,<
SKIPG TRMUDX ;SEE IF ANY UDX
POPJ P, ;NEVER SAVED ANYTHING I GUESS
MOVEI SCR,.TONFC ;SET TTY CRLF
MOVE CHAR,OCRLF ;OLD VALUE
PUSHJ P,STRMOP ;..
JFCL
MOVEI SCR,.TOSSZ ;SET TTY STOP N
MOVE CHAR,OPAGES ;OLD VALUE
PUSHJ P,STRMOP ;..
CAIA ;OLD MONITOR?
POPJ P, ;RETURN
MOVEI SCR,.TOPSZ ;SET TTY PAGE N INSTEAD
PUSHJ P,STRMOP ;..
JFCL
>;END IF TOPS-10
IF TOPS-20,<
;I DONT KNOW HOW TO TO IT!
>;END IF TOPS-20
POPJ P, ;RETURN
SUBTTL TRMOP ROUTINES
IF TOPS-10,<
RTRMOP: MOVEM SCR,TRMFNC ;STORE FUCNTION
MOVE SCR,[2,,TRMFNC] ;POINT TO BLOCK
TRMOP. SCR, ;READ IT
POPJ P, ;FAILED
AOS (P) ;SKIP
POPJ P, ;AND RETURN
STRMOP: ADDI SCR,.TOSET ;TURN INTO SET
MOVEM SCR,TRMFNC ;STORE FUNCTION
MOVEM CHAR,TRMARG ;AND ARG
MOVE SCR,[3,,TRMFNC] ;POINT TO BLOCK
TRMOP. SCR, ;SET IT
POPJ P, ;FAILED
JRST .POPJ1 ;SKIP
>
SUBTTL DPYNAT -- Routine to turn off terminal attributes
; This routine will turn off all attributes that a terminal
; may have on at sometime
DPYNAT::PUSH P,S1 ;Save some regs
PUSH P,S2 ;...
EXCH TYP,VIDEOT ;Set up the terminal type
MOVEI S1,CHRATR ;Get the table of routines
SETZB CHAR,GLBATR ;Clear things
PUSHJ P,XCTTBL ;Call it if it's there
JFCL ;Done
EXCH TYP,VIDEOT ;Restore the type register
POP P,S2 ;Restore the acs
POP P,S1 ;...
POPJ P,
SUBTTL DPYSAT -- Routine to set attributes
;This routine will set the attributes of the terminal to what the
;user wants so that he can send out a string in ceratin formats
DPYSAT::MOVE CHAR,@(16) ;Get the attributes to set
MOVEM S1,GLBATR ;Store them in the global attributes word
POPJ P, ;Return
SUBTTL DPYSAV -- Save the current attributes
;This routine will save the current attributes so that others can be
;set temporarily
DPYSVA::EXCH SCR,ATRPTR ;Get the stack pointer for attributes
PUSH SCR,GLBATR ;Save the attributes on the stack
EXCH SCR,ATRPTR ;Store the pointer
POPJ P, ;Return
SUBTTL DPYRST -- Restore previous attributes
;This routine is the opposite of the above one. It will restore
;the previous attributes.
DPYRSA::EXCH SCR,ATRPTR ;Get the stack pointer for attributes
POP SCR,GLBATR ;Save the attributes on the stack
EXCH SCR,ATRPTR ;Store the pointer
POPJ P, ;Return
SUBTTL SAVATR -- Push old attributes and set new ones
; This is a co-routine to save the present attributes on the
; attributes stack and sets up the new ones.
SAVATR: PUSH P,GLBATR ;Save the global attributes
ADDI SCR,-1(16) ;Point to the attributes
SKIPL SCR,@(SCR) ;Get them
MOVEM SCR,GLBATR ;Set user attributes to be global
PUSHJ P,@-1(P) ;Call the caller
CAIA ;For skips
AOS -2(P) ;...
POP P,GLBATR ;Restore the old attributes
POP P,(P) ;Adjust the stack
POPJ P,
SUBTTL Terminal dependent routines
; These routines are for terminals which have special capabilities
; and we want to use them. It is up to the user to make sure he knows
; what he is doing, since one terminals graphics mode may not be another's
; etc. All routines called with:
; CHAR/ CHARACTER.AND.ATTRIBUTE.BITS
; PUSHJ P,Routine
; Only return
; GIGIs (VK100)
GGATRB: PUSHJ P,CHKATR ;Go find the attributes
POPJ P, ;The same, return
PUSH P,CHAR ;Save the character
PUSHJ P,GETCLR ;Get the color field
JRST GGENTP ;The same, continue
MOVEI CHAR,[BYTE (7)33,"[",0] ;Get the prefix string
PUSHJ P,PUTCTL ;Output it
MOVEI CHAR,GGCLRS(S1) ;Get the color string
PUSHJ P,PUTCTL ;Output the color string
JRST GGENTP ;Continue with the other attributes
GGINIT: POPJ P, ;Return
GGCLRS: ASCIZ |37m|
ASCIZ |31m|
ASCIZ |32m|
ASCIZ |33m|
ASCIZ |34m|
ASCIZ |35m|
ASCIZ |36m|
ASCIZ |37m|
SUBTTL VT100 - VT101 (No AVO board)
V101CA: PUSHJ P,CHKATR ;Check attributes
POPJ P, ;The same, return now
PUSH P,CHAR ;Save the character
PUSHJ P,GETGRF ;Get the graphics status
JRST V101.1 ;They are the same, continue on
MOVE CHAR,V100GS(S1) ;Get the graphics string we want
PUSHJ P,PUTCTL ;Output it
MOVE CHAR,(P) ;Get back the charater
V101.1: PUSHJ P,GETATR ;Get the attributes
JRST ATRXIT ;The same, we're done
MOVEI CHAR,[BYTE (7)33,"[",0] ;Get the prefix
PUSHJ P,PUTCTL ;Output it
MOVEI CHAR,V101RF ;Assume we're turning off the reverse video
TRNE S2,CA.RVD ;Are we turning it off
MOVEI CHAR,V101RN ;No, turn it on
PUSHJ P,PUTCTL ;Out put it
JRST ATRXIT ;Go exit
SUBTTL VT100 - VT102 (AVO option)
V102CA: PUSHJ P,CHKATR ;Seperate the attributes
POPJ P, ;Same, return immediately
PUSH P,CHAR ;Save the character
GGENTP: PUSHJ P,GETGRF ;Get the graphics attributes of this character
JRST V100C0 ;The same, continue
MOVE CHAR,V100GS(S1) ;Get the graphics string we want to output
PUSHJ P,PUTCTL ;Output it
MOVE CHAR,(P) ;Get back the character
V100C0: PUSHJ P,GETATR ;Get the attributes
JRST ATRXIT ;The same, all done
MOVEI CHAR,[BYTE (7)33,"[",0] ;Get the prefix
PUSHJ P,PUTCTL ;Output it
MOVE CHAR,V100AS(S1) ;Get the address of the output routine
PUSHJ P,PUTCTL ;Output it
ATRXIT: MOVE CHAR,(P) ;Get back the character
ANDI CHAR,777600 ;Clear out the ANSII
MOVEM CHAR,CURATR ;Store the attributes
POP P,CHAR ;Restore the ctack
POPJ P, ;Return
V100AS: [ASCIZ |m|]
[ASCIZ |;1m|]
[ASCIZ |;4m|]
[ASCIZ |;1;4m|]
[ASCIZ |;5m|]
[ASCIZ |;1;5m|]
[ASCIZ |;4;5m|]
[ASCIZ |;1;4;5m|]
[ASCIZ |;7m|]
[ASCIZ |;1;7m|]
[ASCIZ |;4;7m|]
[ASCIZ |;1;4;7m|]
[ASCIZ |;5;7m|]
[ASCIZ |;1;5;7m|]
[ASCIZ |;4;5;7m|]
[ASCIZ |;1;4;5;7m|]
V100GS: [BYTE (7)33,"(","B",0]
[BYTE (7)33,"(","0",0]
[BYTE (7)33,"(","A",0]
[BYTE (7)33,"(","1",0]
[BYTE (7)33,"(","2",0]
DEFINE XX<
YY CA.BLD,1
YY CA.UDS,4
YY CA.BNK,5
YY CA.RVD,7
>
DEFINE YY(A,B)<
EXP A
>
ATRTBL: XX ;Table to attribute bits
DEFINE YY(A,B)<
EXP "'B"
>
ATRCHR: XX ;Table to characters to output for them
;VT52/VT61
V52ATR: PUSHJ P,CHKATR ;Check the attributes
POPJ P, ;The same,return
PUSH P,CHAR ;Save the character
PUSHJ P,GETGRF ;Get the graphics capability
ANDI S1,1 ;Just get the least significant bit
JRST ATRXIT ;The same, go back
MOVEI CHAR,H19GRF(S1) ;Get the graphics string we want
PUSHJ P,PUTCTL ;Output it
JRST PUTCTL ;Output it
; H19A (Heath/Zenith terminal in ANSI mode)
A19ATR: PUSHJ P,CHKATR ;Check attributes
POPJ P, ;The same, return now
PUSH P,CHAR ;Save the character
PUSHJ P,GETGRF ;Get the graphics status
JRST A19A.1 ;They are the same, continue on
MOVEI CHAR,[BYTE (7)33,"[",0] ;Get the prefix
PUSHJ P,PUTCTL ;Output it
ANDI S1,1 ;We only need one bit here
MOVEI CHAR,A19GRF(S1) ;Get the graphics string we want
PUSHJ P,PUTCTL ;Output it
MOVE CHAR,(P) ;Get back the charater
A19A.1: PUSHJ P,GETATR ;Get the attributes
JRST ATRXIT ;The same, we're done
MOVEI CHAR,[BYTE (7)33,"[",0] ;Get the prefix
PUSHJ P,PUTCTL ;Output it
MOVEI CHAR,A19ROF ;Assume we're turning off the reverse video
TRNE S2,CA.RVD ;Are we turning it off
MOVEI CHAR,A19RON ;No, turn it on
PUSHJ P,PUTCTL ;Out put it
JRST ATRXIT ;Go exit
A19GRF: ASCIZ |11m|
ASCIZ |10m|
V101RF:
A19ROF: ASCIZ |0m|
V101RN:
A19RON: ASCIZ |7m|
; H19 (Heath/Zenith in Heath mode)
H19ATR: PUSHJ P,CHKATR ;Check attributes
POPJ P, ;The same, return now
PUSH P,CHAR ;Save the character
PUSHJ P,GETGRF ;Get the graphics status
JRST H19A.1 ;They are the same, continue on
ANDI S1,1 ;We only need one bit here
MOVEI CHAR,H19GRF(S1) ;Get the graphics string we want
PUSHJ P,PUTCTL ;Output it
MOVE CHAR,(P) ;Get back the charater
H19A.1: PUSHJ P,GETATR ;Get the attributes
JRST ATRXIT ;The same, we're done
MOVEI CHAR,H19ROF ;Assume we're turning off the reverse video
TRNE S2,CA.RVD ;Are we turning it off
MOVEI CHAR,H19RON ;No, turn it on
PUSHJ P,PUTCTL ;Out put it
JRST ATRXIT ;Go exit
V52GRF:
H19GRF: BYTE (7)33,"G",0
BYTE (7)33,"F",0
H19ROF: BYTE (7)33,"q",0
H19RON: BYTE (7)33,"p",0
SUBTTL Specific terminal helper routines
; This routines will be called from the specific terminal
; routines to do such things as take apart the attribute fields.
; All routines will also check the cureent field with what we
; wish to check and will give a skip return only if they are different.
; All routines will expect to receive the pseudo-character
; in S1, and they use S1 and S2.
CHKATR: MOVE S1,CHAR ;Get attributes of the character
ANDI S1,777600 ;Get just attributes
CAME S1,CURATR ;Same as the current ones?
AOS (P) ;Yes, give a skip return
POPJ P, ;Return
GETGRF: MOVE S1,CHAR ;Get attributes of the character
ANDI S1,777600 ;Get just attributes
MOVEI S2,GRFMSK ;Get the graphics mask
PUSHJ P,GETFLD ;Get the graphics field
TRNA ;The same, no skip return
AOS (P) ;Skip
LSH S1,-GRFPOS ;Shift it over
POPJ P, ;Return
GETCLR: MOVE S1,CHAR ;Get attributes of the character
ANDI S1,777600 ;Get just attributes
MOVEI S2,CLRMSK ;Get the color mask
PUSHJ P,GETFLD ;Get the color field
TRNA ;The same, no skip return
AOS (P) ;Skip
LSH S1,-CLRPOS ;Shift it over
POPJ P, ;Return
GETATR: MOVE S1,CHAR ;Get attributes of the character
ANDI S1,777600 ;Get just attributes
MOVEI S2,ATRMSK ;Get the mask we want
PUSHJ P,GETFLD ;Get the bits
TRNA ;The same will skip
AOS (P) ;Different will
MOVE S2,S1 ;Save the bits
LSH S1,-7 ;Shift over to the right
POPJ P, ;Return
GETGLB: SKIPN S1,CHAR ;Get the character
POPJ P, ;Nulls have no attributes
ANDI S1,777600 ;Get just the attributes
SKIPN S1 ;Any attributes?
MOVE S1,GLBATR ;No--Get the global ones
CAIN CHAR," " ;Plain space?
TRNN S1,CA.NAB ;Yes--He didnt want attributes?
IOR CHAR,S1 ;No--Combine wiht attributes
POPJ P,
GETFLD: AND S1,S2 ;Get just the bits we want
AND S2,CURATR ;Get just the graphics
CAME S1,S2 ;Same as before
AOS (P) ;No, Skip
POPJ P, ;Return
;This routine will take the encoded character, and if the ASCII is a
;control character, it will replace it with a space.
CT2SPC: MOVE S1,CHAR ;Save the character
ANDI S1,177 ;DOwn to ASCII
CAIL S1," " ;A CONTROL CHARACTER
POPJ P, ;Not, character, return
ANDI CHAR,777600 ;Clear the character
ADDI CHAR," " ;Replace with a space
POPJ P, ;Return
SUBTTL Special routines to help empire along
;These routines are placed inside DPYPAK because they are closely related
;to updating the screen and working with terminals that it is better to
;do it in here rather than setting everything global.
%EMPIR==1 ;Build special for EMPIRE
IFDEF %EMPIR,<
GETCHX::
IF TOPS-10,<
MOVEI 0,.TOCIB ;GEt the clear terminal input buffer
MOVEM 0,TRMFNC ;Store it
MOVE 0,[XWD 2,TRMFNC] ;Get the function pointer
TRMOP. 0, ;Do it
JFCL ;I wonder why
>
IF TOPS-20,<
MOVEI 1,.PRIIN ;Get the primary input designator
CFIBF ;Clear the input buffer
>
GETCHR::
IF TOPS-10,<
MOVEI 0,.TOISC ;Get the input a character function
MOVEM 0,TRMFNC ;Store it
GETC.0: MOVE 0,[XWD 2,TRMFNC] ;Get the block pointer
TRMOP. 0, ;Get the character
JFCL ;Shouldn't happen
>
IF TOPS-20,<
GETC.0: PBIN ;GEt a character from the terminal
MOVE 0,1 ;Transfer it
>
JUMPE 0,GETC.0 ;In case of null
CAIN 0,15 ;Carriage return?
JRST GETC.0 ;Yes, get the line feed
CAIGE 0," " ;A control character?
JRST GETC.1 ;Yes, return
LSH 0,^D29 ;Translate
IOR 0,[BYTE (7)0,40,40,40,40] ;Pad with spaces
GETC.1: MOVEM ,@0(16) ;Store it
POPJ P,
CHROUT::MOVE 0,@(16) ;Get the character
IF TOPS-10,<
CHAROT::MOVEM 0,TRMARG ;Store the character
MOVEI 0,.TOOIC ;GEt function to output character
MOVEM 0,TRMFNC ;Store it
MOVE 0,[XWD 3,TRMFNC] ;GEt the block pointer
TRMOP. 0, ;Output it
JFCL ;Error, no matter
POPJ P,
>
IF TOPS-20,<
CHAROT::MOVE 1,0 ;Get the character
PBOUT ;Output the character
POPJ 17,
>
EOL:: PUSH P,S1 ;Save some registers
PUSH P,S2 ;...
EXCH TYP,VIDEOT ; . . .
MOVEI S1,ERAEOL ;Get the string to typeout
PUSHJ P,XCTTBL ;Execute the string
TRNA ;Done
PUSHJ P,PUTCTL ;Output the string
EXCH TYP,VIDEOT ; Get back the video type
POP P,S2 ;Retstore some registers
POP P,S1 ;...
POPJ P,
>;;End of EMPIRE hacks
SUBTTL LOW SEG STORAGE
XLIST ;LITERALS
LIT
LIST
RELOC 0
ZERO0:!
IF TOPS-20,<
TTYJFN: .PRIOU ;JFN FOR TTY: (STARTS AS TTY, FILLED IN BY OPEN)
>
IF TOPS-10,<
TRMFNC: BLOCK 1 ;TRMOP. FUNCTION CODE
TRMUDX: BLOCK 1 ;UDX
TRMARG: BLOCK 2 ;TRMOP. ARG (SET FUNCTIONS ONLY)
OCRLF: BLOCK 1 ;OLD CRLF VALUE
OPAGES: BLOCK 1 ;OLD PAGESIZE VALUE
>;END IFN TOPS-10
BAUD: BLOCK 1 ;BAUD RATE FOR TERMINAL
FILLRS: BLOCK 1 ;NUMBER OF FILLERS NEEDED IF REQUESTED
REFING: BLOCK 1 ;FLAG FOR REFRESHING A SCREEN
CLRING: BLOCK 1 ;FLAG FOR CLEARING A SECTION
REMEMB::BLOCK 1 ;FLAG FOR REMEMBERING
ISOFLG: BLOCK 1 ;Flag for advanced TRMOP.
WHERA: BLOCK 1 ;COLUMN OF FIRST BLANK ON A LINE
WHLST: BLOCK 1 ;COLUMN OF LAST CHANGE TO A BLANK ON A LINE
WHCHR: BLOCK 1 ;COLUMN OF FIRST CHANGE TO A BLANK
PUTPTR: BLOCK 1 ;BYTE POINTER DURING PUTCTL
FRCRTY: BLOCK 1 ;-1 IF FORCED TO RE-TYPE DURING RIGHT MOVEMENT
LINPTR: BLOCK 1 ;POINTER FOR INCORE LINE
LINCNT: BLOCK 1 ;AMOUNT OF ROOM LEFT IN BUFFER
LINBUF: BLOCK <^D500/TTYCPW> ;ROOM FOR 199 CHARACTERS + 1 NULL
LBUFND==.-1 ;END OF THE LINE BUFFER
;ATTRIBUTE SPECIFIC INFORMATION
CURATR: BLOCK 1 ;Current character attributes
GLBATR: BLOCK 1 ;Current global attributes we want
ATRPTR: BLOCK 1 ;Attribute stack pointer
ATRSTK: BLOCK ATRPDL ;The stack
;SCREEN SPECIFIC INFORMATION
MAXC:: BLOCK 1 ;GLOBAL FOR MACRO HACKERS
MAXL:: BLOCK 1 ;...
MAXS:: BLOCK 1 ;...
BOUNDS: BLOCK 1 ;NEED TO SET BOUNDRIES
NLPRIM: BLOCK 1 ;1ST LINE OF SCREEN SWEEP
NCPRIM: BLOCK 1 ;1ST COLUMN
NLEND: BLOCK 1 ;LAST LINE OF SCREEN SWEEP
NCEND: BLOCK 1 ;LAST COLUMN
ENDUSR: BLOCK 1 ;LAST COLUMN (ROUNDED) OF USERS ARRAY
LJUST: BLOCK 1 ;-1 FOR LEFT JUSTIFIED ( A1 ) FORMAT
CURL: BLOCK 1 ;WHERE WE LEFT THE CURSOR
CURC: BLOCK 1 ; " " " " "
VIDEOT:: BLOCK 1 ;VIDEO TERMINAL TYPE
NEWPTR: BLOCK 1 ;SIZE FILLED IN DURING "DPYINI"
SCREEN: BLOCK <WDPLIN*NLMAX> ;ROOM FOR A SCREEN
ENDSCR==.-1 ;LAST LOC OF THE SCREEN
ZERO1==.-1
END ;END OF DPYPAK
Reference in New Issue View Git Blame Copy Permalink