From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import

---
 system/base/1.7.5/src/basic transput | 177 +++++++++++++++++++++++++++++++++++
 1 file changed, 177 insertions(+)
 create mode 100644 system/base/1.7.5/src/basic transput

(limited to 'system/base/1.7.5/src/basic transput')

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 ;
+
-- 
cgit v1.2.3