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