mirror of
https://github.com/PDP-10/its.git
synced 2026-02-18 05:34:15 +00:00
343 lines
6.8 KiB
Plaintext
343 lines
6.8 KiB
Plaintext
'<PCODE "SCR">
|
||
|
||
<PACKAGE "SCR">
|
||
|
||
<ENTRY TTY STREAM TERM-MOVE? SCR-INIT GET-TTY TTY-SETUP TTY-SCR SET-ECHO-MODE
|
||
SET-IMAGE-MODE TTY-RESET CLEAR-SCREEN CLEAR-EOL CLEAR-EOS FRESH-LINE KILL-CHAR
|
||
ERASE-CHAR HOME-CURSOR BOTTOM-CURSOR HOR-POS-CURSOR VER-POS-CURSOR MOVE-CURSOR
|
||
BACK-CURSOR DOWN-CURSOR UP-CURSOR FORWARD-CURSOR SAVE-CURSOR RESTORE-CURSOR
|
||
DO-OUTPUT DO-INPUT DO-BIN TCHAN TICHAN TWIDTH THEIGHT TCURSX TCURSY TSCRIPT>
|
||
|
||
<SETG TCHAN %<OFFSET 1 TTY>>
|
||
|
||
<MANIFEST TCHAN>
|
||
|
||
<SETG TICHAN %<OFFSET 2 TTY>>
|
||
|
||
<MANIFEST TICHAN>
|
||
|
||
<SETG TSVMOD %<OFFSET 3 TTY>>
|
||
|
||
<MANIFEST TSVMOD>
|
||
|
||
<SETG TCMOD %<OFFSET 4 TTY>>
|
||
|
||
<MANIFEST TCMOD>
|
||
|
||
<SETG TSCRIPT %<OFFSET 5 TTY>>
|
||
|
||
<MANIFEST TSCRIPT>
|
||
|
||
<NEWTYPE TTY VECTOR '<<PRIMTYPE VECTOR> CHANNEL CHANNEL <UVECTOR [3 WORD]> <
|
||
UVECTOR [3 WORD]> <OR FALSE <LIST [REST <OR UVECTOR STRING>]>>>>
|
||
|
||
"CONSTANTS FOR SCR PACKAGE"
|
||
|
||
<SETG VTNOP 0>
|
||
|
||
<MANIFEST VTNOP>
|
||
|
||
<SETG VTFWD 1>
|
||
|
||
<MANIFEST VTFWD>
|
||
|
||
<SETG VTBCK 2>
|
||
|
||
<MANIFEST VTBCK>
|
||
|
||
<SETG VTUP 3>
|
||
|
||
<MANIFEST VTUP>
|
||
|
||
<SETG VTDWN 4>
|
||
|
||
<MANIFEST VTDWN>
|
||
|
||
<SETG VTHRZ 5>
|
||
|
||
<MANIFEST VTHRZ>
|
||
|
||
<SETG VTVRT 6>
|
||
|
||
<MANIFEST VTVRT>
|
||
|
||
<SETG VTMOV 7>
|
||
|
||
<MANIFEST VTMOV>
|
||
|
||
<SETG VTHOM 8>
|
||
|
||
<MANIFEST VTHOM>
|
||
|
||
<SETG VTHMD 9>
|
||
|
||
<MANIFEST VTHMD>
|
||
|
||
<SETG VTADV 10>
|
||
|
||
<MANIFEST VTADV>
|
||
|
||
<SETG VTSAV 11>
|
||
|
||
<MANIFEST VTSAV>
|
||
|
||
<SETG VTRES 12>
|
||
|
||
<MANIFEST VTRES>
|
||
|
||
<SETG VTCLR 13>
|
||
|
||
<MANIFEST VTCLR>
|
||
|
||
<SETG VTCEW 14>
|
||
|
||
<MANIFEST VTCEW>
|
||
|
||
<SETG VTCEL 15>
|
||
|
||
<MANIFEST VTCEL>
|
||
|
||
<SETG VTERA 16>
|
||
|
||
<MANIFEST VTERA>
|
||
|
||
<SETG VTBEC 17>
|
||
|
||
<MANIFEST VTBEC>
|
||
|
||
<SETG VTLID 18>
|
||
|
||
<MANIFEST VTLID>
|
||
|
||
<SETG VTCID 19>
|
||
|
||
<MANIFEST VTCID>
|
||
|
||
<SETG VTESC 20>
|
||
|
||
<MANIFEST VTESC>
|
||
|
||
<SETG DPAG1 65536>
|
||
|
||
<MANIFEST DPAG1>
|
||
|
||
<SETG DPAG2 32768>
|
||
|
||
<MANIFEST DPAG2>
|
||
|
||
<SETG TMDPY 131072>
|
||
|
||
<MANIFEST TMDPY>
|
||
|
||
<SETG TMSCR 65536>
|
||
|
||
<MANIFEST TMSCR>
|
||
|
||
<SETG TMMOR 32768>
|
||
|
||
<MANIFEST TMMOR>
|
||
|
||
<SETG TMMVR 16384>
|
||
|
||
<MANIFEST TMMVR>
|
||
|
||
<SETG TMMSM 8192>
|
||
|
||
<MANIFEST TMMSM>
|
||
|
||
<SETG TMVBL 4096>
|
||
|
||
<MANIFEST TMVBL>
|
||
|
||
<SETG TMITP 1>
|
||
|
||
<MANIFEST TMITP>
|
||
|
||
<SETG TCMOV 131072>
|
||
|
||
<MANIFEST TCMOV>
|
||
|
||
<SETG TCBS 65536>
|
||
|
||
<MANIFEST TCBS>
|
||
|
||
<SETG TCHOM 32768>
|
||
|
||
<MANIFEST TCHOM>
|
||
|
||
<SETG TCCLR 16384>
|
||
|
||
<MANIFEST TCCLR>
|
||
|
||
<SETG TCSCL 8192>
|
||
|
||
<MANIFEST TCSCL>
|
||
|
||
<SETG TCLID 4096>
|
||
|
||
<MANIFEST TCLID>
|
||
|
||
<SETG TCCID 2048>
|
||
|
||
<MANIFEST TCCID>
|
||
|
||
<SETG TCVBL 1024>
|
||
|
||
<MANIFEST TCVBL>
|
||
|
||
<SETG TCMET 512>
|
||
|
||
<MANIFEST TCMET>
|
||
|
||
<SETG TCSCR 256>
|
||
|
||
<MANIFEST TCSCR>
|
||
|
||
<SETG TCRSC 128>
|
||
|
||
<MANIFEST TCRSC>
|
||
|
||
<SETG TCOVR 64>
|
||
|
||
<MANIFEST TCOVR>
|
||
|
||
<SETG TCPRT 1>
|
||
|
||
<MANIFEST TCPRT>
|
||
|
||
<SETG TJDIS 2048>
|
||
|
||
<MANIFEST TJDIS>
|
||
|
||
<SETG TOERS 4294967296>
|
||
|
||
<MANIFEST TOERS>
|
||
|
||
<SETG IOT %<RSUBR!- '[ %<PCODE!- "SCR" 0> IOT #DECL ("VALUE" CHARACTER
|
||
"OPTIONAL" <PRIMTYPE WORD> CHANNEL CHARACTER) %<RGLOC INCHAN T> %<RGLOC OUTCHAN
|
||
T> %<RGLOC CNSUV T> T %<TYPE-W TTY VECTOR> "DONE" %<RGLOC TTY1 T> %<RGLOC TTY2 T
|
||
> %<RGLOC TEMPSTRING T> %<RGLOC JUNKSTR T>]>>
|
||
<AND <ASSIGNED? GLUE> .GLUE <PUT ,IOT PGLUE ![1073740800!]>>
|
||
|
||
|
||
<SETG SIOT %<RSUBR-ENTRY '[IOT SIOT #DECL ("VALUE" STRING STRING "OPTIONAL" <
|
||
PRIMTYPE WORD> CHANNEL FIX)] 38>>
|
||
|
||
<SETG RCPOS %<RSUBR-ENTRY '[IOT RCPOS #DECL ("VALUE" FIX "OPTIONAL" CHANNEL)]
|
||
102>>
|
||
|
||
<SETG TTY-GET %<RSUBR-ENTRY '[IOT TTY-GET #DECL ("VALUE" <UVECTOR [REST <
|
||
PRIMTYPE WORD>]> UVECTOR "OPTIONAL" CHANNEL)] 125>>
|
||
|
||
<SETG TTY-SET %<RSUBR-ENTRY '[IOT TTY-SET #DECL ("VALUE" UVECTOR UVECTOR
|
||
"OPTIONAL" CHANNEL)] 173>>
|
||
|
||
<SETG CNSGET %<RSUBR-ENTRY '[IOT CNSGET #DECL ("VALUE" UVECTOR UVECTOR
|
||
"OPTIONAL" CHANNEL)] 149>>
|
||
|
||
"Macros for SCR package. Common to all versions."
|
||
|
||
<DEFMAC CLEAR-SCREEN ('TTY) <FORM DPYOP .TTY ,VTCLR>>
|
||
|
||
<DEFMAC CLEAR-EOL ('TTY) <FORM DPYOP .TTY ,VTCEL>>
|
||
|
||
<DEFMAC CLEAR-EOS ('TTY) <FORM DPYOP .TTY ,VTCEW>>
|
||
|
||
<DEFMAC FRESH-LINE ('TTY "OPTIONAL" ('N 1)) <FORM DPYOP .TTY ,VTADV .N>>
|
||
|
||
<DEFMAC KILL-CHAR ('TTY) <FORM DPYOP .TTY ,VTERA>>
|
||
|
||
<DEFMAC ERASE-CHAR ('TTY "OPTIONAL" ('N 1)) <FORM DPYOP .TTY ,VTBEC .N>>
|
||
|
||
"SUBTITLE Cursor movement of various sorts"
|
||
|
||
<DEFMAC HOME-CURSOR ('TTY) <FORM DPYOP .TTY ,VTHOM>>
|
||
|
||
<DEFMAC BOTTOM-CURSOR ('TTY) <FORM DPYOP .TTY ,VTHMD>>
|
||
|
||
<DEFMAC HOR-POS-CURSOR ('TTY 'X) <FORM DPYOP .TTY ,VTHRZ .X>>
|
||
|
||
<DEFMAC VER-POS-CURSOR ('TTY 'Y) <FORM DPYOP .TTY ,VTVRT .Y>>
|
||
|
||
<DEFMAC MOVE-CURSOR ('TTY 'X 'Y) <FORM DPYOP .TTY ,VTMOV .X .Y>>
|
||
|
||
<DEFMAC BACK-CURSOR ('TTY "OPTIONAL" ('N 1)) <FORM DPYOP .TTY ,VTBCK .N>>
|
||
|
||
<DEFMAC DOWN-CURSOR ('TTY "OPTIONAL" ('N 1)) <FORM DPYOP .TTY ,VTDWN .N>>
|
||
|
||
<DEFMAC UP-CURSOR ('TTY "OPTIONAL" ('N 1)) <FORM DPYOP .TTY ,VTUP .N>>
|
||
|
||
<DEFMAC FORWARD-CURSOR ('TTY "OPTIONAL" ('N 1)) <FORM DPYOP .TTY ,VTFWD .N>>
|
||
|
||
<DEFMAC SAVE-CURSOR ('TTY) <FORM DPYOP .TTY ,VTSAV>>
|
||
|
||
<DEFMAC RESTORE-CURSOR ('TTY) <FORM DPYOP .TTY ,VTRES>>
|
||
|
||
<SETG TERM-MOVE? %<RSUBR-ENTRY '[IOT TERM-MOVE? #DECL ("VALUE" <OR ATOM FALSE>
|
||
ANY)] 240>>
|
||
|
||
<SETG NORMAL-OUT %<RSUBR-ENTRY '[IOT NORMAL-OUT #DECL ("VALUE" <OR CHARACTER
|
||
STRING> TTY <OR STRING CHARACTER> "OPTIONAL" FIX CHARACTER)] 271>>
|
||
|
||
<SETG IMAGE-OUT %<RSUBR-ENTRY '[IOT IMAGE-OUT #DECL ("VALUE" <OR CHARACTER
|
||
STRING> TTY <OR FIX CHARACTER STRING> "OPTIONAL" FIX CHARACTER)] 331>>
|
||
|
||
<SETG ADDSCRIPT %<RSUBR-ENTRY '[IOT ADDSCRIPT #DECL ("VALUE" <OR LIST TTY> TTY <
|
||
OR CHARACTER STRING>)] 391>>
|
||
|
||
<SETG SCR-INIT %<RSUBR-ENTRY '[IOT SCR-INIT #DECL ("VALUE" STRING "OPTIONAL" <OR
|
||
ATOM FALSE>)] 435>>
|
||
|
||
<SETG GET-TTY %<RSUBR-ENTRY '[IOT GET-TTY #DECL ("VALUE" TTY CHANNEL CHANNEL
|
||
"OPTIONAL" <PRIMTYPE WORD>)] 460>>
|
||
|
||
<SETG TTY1 #WORD *020202020202*>
|
||
|
||
<SETG TTY2 #WORD *030202020202*>
|
||
|
||
<SETG TTY-SETUP %<RSUBR-ENTRY '[IOT TTY-SETUP #DECL ("VALUE" UVECTOR TTY)] 522>>
|
||
|
||
<SETG SET-ECHO-MODE %<RSUBR-ENTRY '[IOT SET-ECHO-MODE #DECL ("VALUE" TTY TTY <OR
|
||
ATOM FALSE>)] 551>>
|
||
|
||
<SETG SET-IMAGE-MODE %<RSUBR-ENTRY '[IOT SET-IMAGE-MODE #DECL ("VALUE" TTY TTY <
|
||
OR ATOM FALSE>)] 565>>
|
||
|
||
<SETG TTY-SCR %<RSUBR-ENTRY '[IOT TTY-SCR #DECL ("VALUE" UVECTOR TTY)] 579>>
|
||
|
||
<SETG TTY-RESET %<RSUBR-ENTRY '[IOT TTY-RESET #DECL ("VALUE" TTY TTY)] 593>>
|
||
|
||
"SUBTITLE User output routines"
|
||
|
||
<SETG TEMPSTRING " ">
|
||
|
||
<GDECL (TEMPSTRING) STRING>
|
||
|
||
<SETG DO-OUTPUT %<RSUBR-ENTRY '[IOT DO-OUTPUT #DECL ("VALUE" <OR CHARACTER
|
||
STRING> TTY <OR CHARACTER STRING> "OPTIONAL" <OR ATOM FALSE> FIX)] 630>>
|
||
|
||
<SETG DO-INPUT %<RSUBR-ENTRY '[IOT DO-INPUT #DECL ("VALUE" CHARACTER TTY
|
||
"OPTIONAL" <OR ATOM FALSE STRING>)] 698>>
|
||
|
||
<SETG JUNKSTR " ">
|
||
|
||
<SETG CTRL-P %<RSUBR-ENTRY '[IOT CTRL-P #DECL ("VALUE" <OR CHARACTER STRING> TTY
|
||
CHARACTER "OPTIONAL" <OR FALSE FIX> <OR FALSE FIX>)] 751>>
|
||
|
||
<SETG DPYOP %<RSUBR-ENTRY '[IOT DPYOP #DECL ("VALUE" <OR ATOM CHARACTER FALSE
|
||
STRING> TTY FIX "OPTIONAL" <OR FIX FALSE> <OR FIX FALSE>)] 819>>
|
||
|
||
<SETG CNSUV <IUVECTOR 5 0>>
|
||
|
||
<GDECL (CNSUV) <UVECTOR [REST FIX]>>
|
||
|
||
<SETG TWIDTH %<RSUBR-ENTRY '[IOT TWIDTH #DECL ("VALUE" FIX TTY)] 1054>>
|
||
|
||
<SETG THEIGHT %<RSUBR-ENTRY '[IOT THEIGHT #DECL ("VALUE" FIX TTY)] 1077>>
|
||
|
||
<SETG TCURSX %<RSUBR-ENTRY '[IOT TCURSX #DECL ("VALUE" FIX TTY)] 1100>>
|
||
|
||
<SETG TCURSY %<RSUBR-ENTRY '[IOT TCURSY #DECL ("VALUE" FIX TTY)] 1117>>
|
||
|
||
<ENDPACKAGE>
|