summaryrefslogtreecommitdiff
path: root/system/base/1.7.5/src/basic transput
diff options
context:
space:
mode:
Diffstat (limited to 'system/base/1.7.5/src/basic transput')
-rw-r--r--system/base/1.7.5/src/basic transput177
1 files changed, 177 insertions, 0 deletions
diff --git a/system/base/1.7.5/src/basic transput b/system/base/1.7.5/src/basic transput
new file mode 100644
index 0000000..5608bb1
--- /dev/null
+++ b/system/base/1.7.5/src/basic transput
@@ -0,0 +1,177 @@
+
+PACKET basic transput DEFINES
+ out ,
+ outsubtext ,
+ outtext ,
+ TIMESOUT ,
+ cout ,
+ display ,
+ inchar ,
+ incharety ,
+ cat input ,
+ pause ,
+ cursor ,
+ get cursor ,
+ channel ,
+ online ,
+ control ,
+ blockout ,
+ blockin :
+
+
+
+LET channel field = 4 ,
+ blank times 64 =
+ " " ;
+
+LET BLOCKIO = STRUCT (ALIGN page align, ROW 256 INT buffer) ,
+ buffer page = 2 ;
+
+BOUND BLOCKIO VAR block io ;
+DATASPACE VAR block io ds ;
+INITFLAG VAR this packet := FALSE ;
+
+
+PROC out (TEXT CONST text ) :
+ EXTERNAL 60
+ENDPROC out ;
+
+PROC outsubtext ( TEXT CONST source, INT CONST from ) :
+ EXTERNAL 62
+END PROC outsubtext;
+
+PROC outsubtext (TEXT CONST source, INT CONST from, to) :
+ EXTERNAL 63
+END PROC outsubtext;
+
+PROC outtext ( TEXT CONST source, INT CONST from, to ) :
+ out subtext (source, from, to) ;
+ INT VAR trailing ;
+ IF from <= LENGTH source
+ THEN trailing := to - LENGTH source
+ ELSE trailing := to + 1 - from
+ FI ;
+ IF trailing > 0
+ THEN trailing TIMESOUT " "
+ FI
+ENDPROC outtext ;
+
+OP TIMESOUT (INT CONST times, TEXT CONST text) :
+
+ IF text = " "
+ THEN fast timesout blank
+ ELSE timesout
+ FI .
+
+fast timesout blank :
+ INT VAR i := 0 ;
+ WHILE i + 64 < times REP
+ out (blank times 64) ;
+ i INCR 64
+ PER ;
+ outsubtext (blank times 64, 1, times - i) .
+
+timesout :
+ FOR i FROM 1 UPTO times REP
+ out(text)
+ ENDREP .
+
+ENDOP TIMESOUT ;
+
+PROC display (TEXT CONST text) :
+ IF online
+ THEN out (text)
+ FI
+ENDPROC display ;
+
+PROC inchar (TEXT VAR character ) :
+ EXTERNAL 64
+ENDPROC inchar ;
+
+TEXT PROC incharety :
+ EXTERNAL 65
+END PROC incharety ;
+
+TEXT PROC incharety (INT CONST time limit) :
+ internal pause (time limit) ;
+ incharety
+ENDPROC incharety ;
+
+PROC pause (INT CONST time limit) :
+ internal pause (time limit) ;
+ TEXT CONST dummy := incharety
+ENDPROC pause ;
+
+PROC pause :
+ TEXT VAR dummy; inchar (dummy)
+ENDPROC pause ;
+
+PROC internal pause (INT CONST time limit) :
+ EXTERNAL 66
+ENDPROC internal pause ;
+
+PROC cat input (TEXT VAR t, esc char) :
+ EXTERNAL 68
+ENDPROC cat input ;
+
+
+PROC cursor (INT CONST x, y) :
+ out (""6"") ;
+ out (code(y-1)) ;
+ out (code(x-1)) ;
+ENDPROC cursor ;
+
+PROC get cursor (INT VAR x, y) :
+ EXTERNAL 67
+ENDPROC get cursor ;
+
+PROC cout (INT CONST number) :
+ EXTERNAL 61
+ENDPROC cout ;
+
+
+INT PROC channel :
+ pcb (channel field)
+ENDPROC channel ;
+
+BOOL PROC online :
+ pcb (channel field) <> 0
+ENDPROC online ;
+
+
+PROC control (INT CONST code1, code2, code3, INT VAR return code) :
+ EXTERNAL 84
+ENDPROC control ;
+
+PROC blockout (ROW 256 INT CONST block, INT CONST code1, code2,
+ INT VAR return code) :
+
+ access block io ds ;
+ block io.buffer := block ;
+ blockout (block io ds, buffer page, code1, code2, return code) .
+
+access block io ds :
+ IF NOT initialized (this packet)
+ THEN block io ds := nilspace
+ FI ;
+ block io := block io ds .
+
+ENDPROC blockout ;
+
+PROC blockin (ROW 256 INT VAR block, INT CONST code1, code2,
+ INT VAR return code) :
+
+ access block io ds ;
+ blockin (block io ds, buffer page, code1, code2, return code) ;
+ block := block io.buffer .
+
+access block io ds :
+ IF NOT initialized (this packet)
+ THEN block io ds := nilspace
+ FI ;
+ block io := block io ds .
+
+ENDPROC blockin ;
+
+ENDPACKET basic transput ;
+