summaryrefslogtreecommitdiff
path: root/system/base/1.7.5/src/std transput
diff options
context:
space:
mode:
Diffstat (limited to 'system/base/1.7.5/src/std transput')
-rw-r--r--system/base/1.7.5/src/std transput264
1 files changed, 264 insertions, 0 deletions
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 ;
+