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/std transput | 264 +++++++++++++++++++++++++++++++++++++
 1 file changed, 264 insertions(+)
 create mode 100644 system/base/1.7.5/src/std transput

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

diff --git a/system/base/1.7.5/src/std transput b/system/base/1.7.5/src/std transput
new file mode 100644
index 0000000..94c51db
--- /dev/null
+++ b/system/base/1.7.5/src/std transput	
@@ -0,0 +1,264 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PACKET std transput DEFINES 
+ 
+    sysout ,
+    sysin ,
+    put ,
+    putline ,
+    line ,
+    page ,
+    write ,
+    get ,
+    getline , 
+    get secret line :
+ 
+ 
+LET cr              = ""13"" ,
+    cr lf           = ""13""10"" ,
+    home clear      = ""1""4"" ,
+    esc             = ""27"" ,
+    rubout          = ""12"" ,
+    bell            = ""7"" ,
+    back blank back = ""8" "8"" ,
+    del line cr lf  = ""5""13""10"" ;
+
+TEXT VAR number word , exit char ;
+
+BOOL VAR console output := TRUE, console input := TRUE ;
+
+FILE VAR outfile, infile ;
+TEXT VAR outfile name := "", infile name := "" ;
+
+
+PROC sysout (TEXT CONST file name) :
+
+  outfile name := file name ;
+  IF file name = ""
+    THEN console output := TRUE
+    ELSE outfile := sequential file (output, file name) ;
+         console output := FALSE
+  FI
+
+ENDPROC sysout ;
+
+TEXT PROC sysout :
+  outfile name
+ENDPROC sysout ;
+
+PROC sysin (TEXT CONST file name) :
+
+  infile name := file name ;
+  IF file name = ""
+    THEN console input := TRUE
+    ELSE infile := sequential file (input, file name) ;
+         console input := FALSE
+  FI
+
+ENDPROC sysin ;
+
+TEXT PROC sysin :
+  infile name
+ENDPROC sysin ;
+
+
+PROC put (TEXT CONST word) :
+
+  IF console output
+    THEN out (word) ; out (" ")
+    ELSE put (outfile, word)
+  FI
+
+ENDPROC put ;
+
+PROC put (INT CONST number) :
+
+  put (text (number))
+
+ENDPROC put ;
+
+PROC put (REAL CONST number) :
+
+  put (text (number))
+
+ENDPROC put ;
+
+PROC putline (TEXT CONST textline) :
+
+  IF console output
+    THEN out (textline) ; out (cr lf)
+    ELSE putline (outfile, textline)
+  FI
+
+ENDPROC putline ;
+
+PROC line :
+
+  IF console output
+    THEN out (cr lf)
+    ELSE line (outfile)
+  FI 
+
+ENDPROC line ;
+
+PROC line (INT CONST times) :
+
+  INT VAR i ;
+  FOR i FROM 1 UPTO times REP
+    line
+  PER
+
+ENDPROC line ;
+
+PROC page :
+
+  IF console output
+    THEN out (home clear)
+  FI
+
+ENDPROC page ;
+
+PROC write (TEXT CONST word) :
+
+  IF console output 
+    THEN out (word)
+    ELSE write (outfile, word)
+  FI
+
+ENDPROC write ;
+
+
+PROC get (TEXT VAR word) : 
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word)
+  FI .
+
+get from console :
+  REP
+    word := "" ;
+    editget (word, " ", "", exit char) ;
+    echoe exit char
+  UNTIL word <> "" AND word <> " " PER ;
+  delete leading blanks .
+ 
+delete leading blanks :
+  WHILE (word SUB 1) = " " REP
+    word := subtext (word,2)
+  PER .
+ 
+ENDPROC get ;
+ 
+PROC get (TEXT VAR word, TEXT CONST separator) : 
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word, separator)
+  FI .
+
+get from console :
+  word := "" ;
+  editget (word, separator, "", exit char) ;
+  echoe exit char .
+
+ENDPROC get ;
+ 
+PROC echoe exit char :
+ 
+  IF exit char = ""13""
+    THEN out (""13""10"")
+    ELSE out (exit char)
+  FI
+ 
+ENDPROC echoe exit char ;
+ 
+PROC get (INT VAR number) :
+
+  get (number word) ;
+  number := int (number word)
+
+ENDPROC get ;
+
+PROC get (REAL VAR number) :
+
+  get (number word) ;
+  number := real (number word) 
+
+ENDPROC get ;
+
+PROC get (TEXT VAR word, INT CONST length) :
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word, length)
+  FI .
+
+get from console :
+  word := "" ;
+  editget (word, length, exit char) ;
+  echoe exit char .
+ 
+ENDPROC get ;
+ 
+PROC getline (TEXT VAR textline) : 
+
+  IF console input
+    THEN get from console
+    ELSE getline (infile, textline)
+  FI .
+
+get from console :
+  textline := "" ;
+  editget (textline, "", "", exit char) ;
+  echoe exit char
+ 
+ENDPROC getline ;
+ 
+PROC get secret line (TEXT VAR textline) :
+
+  TEXT VAR char ;
+  textline := "" ;
+  get start cursor position ;
+  get line very secret ;
+  IF char = esc
+    THEN get line little secret
+  FI ;
+  cursor to start position ;
+  out (del line cr lf) .
+
+get line very secret :
+  REP
+    inchar (char) ;
+    IF char = esc OR char = cr
+      THEN LEAVE get line very secret
+    ELIF char = rubout
+      THEN delete last char
+    ELIF char >= " "
+      THEN textline CAT char ;
+           out (".")
+    ELSE   out (bell)
+    FI
+  PER .
+
+delete last char :
+  IF LENGTH textline = 0
+    THEN out (bell)
+    ELSE out (back blank back) ;
+         delete char (textline, LENGTH textline)
+  FI .
+
+get line little secret :
+  cursor to start position ;
+  editget (textline, "", "", exit char) .
+
+get start cursor position :
+  INT VAR x, y; 
+  get cursor (x, y) .
+
+cursor to start position :
+  cursor (x, y) .
+
+ENDPROC get secret line ;
+
+ENDPACKET std transput ;
+
-- 
cgit v1.2.3