(* ------------------- 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 ;