--- /dev/null
+"Low-level TTY output routines: raw output, padding, do terminal ops"
+
+"Perform simple tty ops--interpret specifications in tty-desc."
+<DEFINE DO-TTY-OP (OPCODE CHANNEL "OPTIONAL" (NEWX <>) (NEWY <>)
+ (SET? T)
+ "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
+ (TD <TT-DESC .TTY>) OD)
+ #DECL ((OPCODE) FIX (CHANNEL) CHANNEL (NEWX NEWY) <OR FALSE FIX>
+ (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC (SET?) <OR ATOM FALSE>)
+ <COND (.NEWX
+ <COND (.SET?
+ <TT-X .TTY <SET NEWX <MIN .NEWX <- <TD-WIDTH .TD> 1>>>>)>)
+ (<SET NEWX <TT-X .TTY>>)>
+ <COND (.NEWY
+ <COND (.SET?
+ <TT-Y .TTY <SET NEWY <MIN .NEWY <- <TD-HEIGHT .TD> 1>>>>)>)
+ (<SET NEWY <TT-Y .TTY>>)>
+ <TC-MODE .TC <ANDB <TC-MODE .TC> %<XORB ,TM-BADPOS -1>>>
+ <COND (.SET? <UPDATE-MC .CHANNEL .NEWX .NEWY>)>
+ <COND (<SET OD <AND <G=? <LENGTH <TD-PRIMOPS .TD>> .OPCODE>
+ <NTH <TD-PRIMOPS .TD> .OPCODE>>>
+ <OUTPUT-OP .OD .CHANNEL .TD .NEWX .NEWY>)>>
+
+<DEFINE OUTPUT-OP (OD CHANNEL TD X Y "OPTIONAL" (PAD 0))
+ #DECL ((OD) TTY-OP (CHANNEL) CHANNEL (TD) TTY-DESC (X Y PAD) FIX)
+ <COND (<TYPE? .OD VECTOR>
+ <MAPF <>
+ <FUNCTION (OC)
+ <OUTPUT-OP .OC .CHANNEL .TD .X .Y>>
+ .OD>
+ T)
+ (T
+ <COND (<TYPE? .OD TTY-OUT>
+ <SET PAD <TO-PAD .OD>>
+ <SET OD <TO-STRING .OD>>)>
+ <COND (<TYPE? .OD STRING>
+ <OUTPUT-RAW-STRING .CHANNEL .OD>)
+ (<TYPE? .OD TTY-ELT>
+ <MAPF <>
+ <FUNCTION (ELT "AUX" VAL)
+ #DECL ((ELT) <OR FIX STRING> (VAL) FIX)
+ <COND (<TYPE? .ELT STRING>
+ <OUTPUT-RAW-STRING .CHANNEL .ELT>)
+ (T
+ <COND (<0? <ANDB .ELT ,TTY-X/Y>>
+ <SET VAL .X>)
+ (<SET VAL .Y>)>
+ <COND (<NOT <0? <ANDB .ELT ,TTY-INC-ARG>>>
+ <SET VAL <+ .VAL 1>>)>
+ <COND (<NOT <0? <ANDB .ELT ,TTY-BCD-ARG>>>
+ <SET VAL <+ <* 16 </ .VAL 10>>
+ <MOD .VAL 10>>>)>
+ <SET ELT <ANDB .ELT ,TTY-ARG-DESC>>
+ <COND (<==? .ELT ,TTY-LITERAL>
+ <OUTPUT-RAW-STRING .CHANNEL <ASCII .VAL>>)
+ (<==? .ELT ,TTY-LIT+>
+ <OUTPUT-RAW-STRING .CHANNEL
+ <ASCII <+ .VAL 32>>>)
+ (<==? .ELT ,TTY-DECIMAL>
+ <OUTPUT-NUMBER .CHANNEL .VAL <>>)
+ (<==? .ELT ,TTY-RJD2>
+ <OUTPUT-NUMBER .CHANNEL .VAL <>>)
+ (<==? .ELT ,TTY-RJD3>
+ <OUTPUT-NUMBER .CHANNEL .VAL <>>)>)>>
+ .OD>)>
+ <COND (<NOT <0? .PAD>>
+ <OUTPUT-PAD .CHANNEL .TD .PAD>)>
+ T)>>
+
+<SETG BUF1 <ISTRING 1>>
+<GDECL (BUF1) STRING>
+
+"Lowest level output routine--stuff uninterpreted characters out or into
+ output buffer"
+<DEFINE OUTPUT-RAW-STRING (CHANNEL STR "OPTIONAL" (LENGTH <>)
+ "AUX" (TC <CHANNEL-DATA .CHANNEL>) OBUF)
+ #DECL ((CHANNEL) CHANNEL (STR) <OR CHARACTER STRING> (TC) TTY-CHANNEL
+ (LENGTH) <OR FIX FALSE> (OBUF) STRING)
+ <COND (<TYPE? .STR CHARACTER>
+ <SET STR <1 ,BUF1 .STR>>)>
+ <COND (<NOT .LENGTH>
+ <SET LENGTH <LENGTH .STR>>)>
+ <COND (<NOT <TC-OBUF .TC>>
+ <CALL SYSCALL WRITE <TC-OJFN .TC> .STR .LENGTH>
+ .LENGTH)
+ (T
+ <SET OBUF <TC-OBUF .TC>>
+ <REPEAT ((WR 0) TRANS)
+ #DECL ((TRANS) FIX)
+ <COND (<0? .LENGTH>
+ <RETURN .WR>)
+ (<EMPTY? .OBUF>
+ <DUMP-WRITE-BUFFER .TC>
+ <SET OBUF <TC-OBUF .TC>>)>
+ <SET TRANS <MIN <LENGTH .OBUF> .LENGTH>>
+ <SUBSTRUC .STR 0 .TRANS .OBUF>
+ <SET STR <REST .STR .TRANS>>
+ <TC-OBUF .TC <SET OBUF <REST .OBUF .TRANS>>>
+ <TC-OBC .TC <+ <TC-OBC .TC> .TRANS>>
+ <SET WR <+ .WR .TRANS>>
+ <SET LENGTH <- .LENGTH .TRANS>>>)>>
+
+"Output a specifed amount of padding (time in milliseconds)"
+<DEFINE OUTPUT-PAD (CHANNEL TD AMT "AUX" (TC <CHANNEL-DATA .CHANNEL>)
+ (OSPEED <TT-OSPEED <TC-TTY .TC>>) PC)
+ #DECL ((CHANNEL) CHANNEL (TD) TTY-DESC (AMT OSPEED) FIX (TC) TTY-CHANNEL)
+ <COND (<G? .AMT 0>
+ <COND (<==? .OSPEED 0> <SET OSPEED 9600>)>
+ <SET AMT <FIX </ <* <FLOAT .OSPEED> <FLOAT .AMT>>
+ 7000.0>>> ; "# chars to send"
+ <SET PC <TD-PADCHR .TD>> ; "Which char to send"
+ <COND (<NOT <TC-OBUF .TC>>
+ <REPEAT ((OJFN <TC-OJFN .TC>) (ST <STRING .PC>))
+ <COND (<0? .AMT> <RETURN>)>
+ <CALL SYSCALL WRITE .OJFN .ST 1>
+ <SET AMT <- .AMT 1>>>)
+ (T
+ <REPEAT ((OBUF <TC-OBUF .TC>) (OC <TC-OBC .TC>))
+ #DECL ((OBUF) STRING (OC) FIX)
+ <COND (<0? .AMT>
+ <TC-OBUF .TC .OBUF>
+ <TC-OBC .TC .OC>
+ <RETURN>)>
+ <COND (<EMPTY? .OBUF>
+ <TC-OBUF .TC .OBUF>
+ <TC-OBC .TC .OC>
+ <DUMP-WRITE-BUFFER .TC>
+ <SET OBUF <TC-OBUF .TC>>
+ <SET OC 0>)>
+ <1 .OBUF .PC>
+ <SET OC <+ .OC 1>>
+ <SET OBUF <REST .OBUF>>
+ <SET AMT <- .AMT 1>>>)>)>>
+
+<SETG NUMBUF <ISTRING 10>>
+<GDECL (NUMBUF) STRING>
+
+"Output a number in raw mode"
+<DEFINE OUTPUT-NUMBER (CHANNEL NUM WIDTH "AUX" (BUF <REST ,NUMBUF 10>)
+ CWIDTH (NEG? <>))
+ #DECL ((CHANNEL) CHANNEL (NUM) FIX (WIDTH) <OR FIX FALSE> (BUF) STRING)
+ <COND (<0? .NUM>
+ <1 <SET BUF <BACK .BUF>> !\0>
+ <SET CWIDTH 1>)
+ (T
+ <COND (<L? .NUM 0>
+ <SET NUM <- .NUM>>
+ <SET NEG? T>)>
+ <REPEAT (DIG)
+ <SET DIG <MOD .NUM 10>>
+ <SET NUM </ .NUM 10>>
+ <1 <SET BUF <BACK .BUF>> <ASCII <+ .DIG <ASCII !\0>>>>
+ <COND (<0? .NUM>
+ <COND (.NEG?
+ <1 <SET BUF <BACK .BUF>> !\->)>
+ <RETURN>)>>)>
+ <SET CWIDTH <LENGTH .BUF>>
+ <COND (<AND .WIDTH <G? .WIDTH .CWIDTH>>
+ <REPEAT ()
+ <1 <SET BUF <BACK .BUF>> !\ >
+ <COND (<L=? .WIDTH <SET CWIDTH <+ .CWIDTH 1>>>
+ <RETURN>)>>)>
+ <OUTPUT-RAW-STRING .CHANNEL .BUF .CWIDTH>>
+
+"Dump the channel's output buffer"
+<DEFINE DUMP-WRITE-BUFFER (TC "AUX" TOPB)
+ #DECL ((TC) TTY-CHANNEL (TOPB) STRING)
+ <COND (<G? <TC-OBC .TC> 0>
+ <CALL SYSCALL WRITE <TC-OJFN .TC>
+ <SET TOPB <TC-TOBUF .TC>> <TC-OBC .TC>>
+ <TC-OBC .TC 0>
+ <TC-OBUF .TC .TOPB>)>>
projects / pdp10-muddle.git / blobdiff