system/base/unknown/src/STD.ELA

PACKET command dialogue DEFINES                (* Autor: J.Liedtke *)
                                               (* Stand:  26.04.82 *)
       command dialogue ,
       say ,
       yes ,
       no ,
       param position ,
       last param :
 
 
LET up      = ""3"" ,
    right   = ""2"" ,
    param pre  = " (""" ,
    param post = """)"13""10"" ;

TEXT VAR std param := "" ;
 
BOOL VAR dialogue flag := TRUE ;

INT VAR param x := 0 ;
 
 
BOOL PROC command dialogue :
  dialogue flag
ENDPROC command dialogue ;
 
PROC command dialogue (BOOL CONST status) :
  dialogue flag := status
ENDPROC command dialogue ;
 
 
BOOL PROC yes (TEXT CONST question) :
 
  IF dialogue flag
    THEN ask question
    ELSE TRUE
  FI .
 
ask question :
  put (question) ;
  skip previous input chars ;
  put ("(j/n) ?") ;
  get answer ;
  IF correct answer
    THEN putline (answer) ;
         positive answer
    ELSE out (""7"") ;
         LENGTH question + 9 TIMESOUT ""8"" ;
         yes (question)
  FI .
 
get answer :
  TEXT VAR answer ;
  inchar (answer) .
 
correct answer :
  pos ("jnyJNY", answer) > 0 .
 
positive answer :
  pos ("jyJY", answer) > 0 .

skip previous input chars :
  REP UNTIL incharety = "" PER .
 
ENDPROC yes ;
 
BOOL PROC no (TEXT CONST question) :
 
  NOT yes (question)
 
ENDPROC no ;
 
PROC say (TEXT CONST message) :
 
  IF dialogue flag
    THEN out (message)
  FI
 
ENDPROC say ;
 
PROC param position (INT CONST x) :
 
  param x := x

ENDPROC param position ;

TEXT PROC last param :
 
  IF param x > 0
    THEN out (up) ;
         param x TIMESOUT right ;
         out (param pre) ;
         out (std param) ;
         out (param post)
  FI ;
  std param
 
ENDPROC last param ;
 
PROC last param (TEXT CONST new) :
  std param := new
ENDPROC last param ;

ENDPACKET command dialogue ;


PACKET input DEFINES                         (* Stand: 01.05.81 *)
 
    get ,
    getline , 
    get secret line :
 
 
LET cr              = ""13"" ,
    esc             = ""27"" ,
    rubout          = ""12"" ,
    bell            = ""7"" ,
    back blank back = ""8" "8"" ,
    del line cr lf  = ""5""13""10"" ;

PROC get (TEXT VAR word) : 
 
  REP
    get (word, " ")
  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) : 
 
  word := "" ;
  feldseparator (separator) ;
  editget (word) ;
  feldseparator ("") ;
  echoe last char
 
ENDPROC get ;
 
PROC echoe last char :
 
  TEXT CONST last char := feldzeichen ;
  IF last char = ""13""
    THEN out (""13""10"")
    ELSE out (last char)
  FI
 
ENDPROC echoe last char ;
 
PROC get (TEXT VAR word, INT CONST length) :
 
  word := "" ;
  feldseparator ("") ;
  editget (word, length, length) ;
  echoe last char 
 
ENDPROC get ;
 
PROC getline (TEXT VAR line ) : 
 
  line := "" ;
  feldseparator ("") ;
  editget (line) ;
  echoe last char
 
ENDPROC getline ;
 
PROC get secret line (TEXT VAR line) :

  TEXT VAR char ;
  line := "" ;
  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 line CAT char ;
           out (".")
    ELSE   out (bell)
    FI
  PER .

delete last char :
  IF LENGTH line = 0
    THEN out (bell)
    ELSE out (back blank back) ;
         delete char (line, LENGTH line)
  FI .

get line little secret :
  feldseparator ("") ;
  cursor to start position ;
  editget (line) .

get start cursor position :
  INT VAR x, y; 
  get cursor (x, y) .

cursor to start position :
  cursor (x, y) .

ENDPROC get secret line ;

ENDPACKET input ;