system/base/1.7.5/src/std transput

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