Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/safei.sim
There is 1 other file named safei.sim in the archive. Click here to see a list.
OPTIONS(/E/-A/-Q/-I/-D/C/P:"SAFEIO - System");
EXTERNAL REF (Infile) PROCEDURE findinfile;
EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest,checkextension;
EXTERNAL CHARACTER PROCEDURE fetchar,findtrigger;
EXTERNAL LONG REAL PROCEDURE scanreal;
EXTERNAL INTEGER PROCEDURE checkreal,checkint,scanint,ilog;
EXTERNAL BOOLEAN PROCEDURE menu;
COMMENT --- CLASS SAFEI --- Version 4.0
Date: 76-01-09
Author: Mats Ohlin
Swedish Research Institute of National Defence
FOA 1
Fack
S-104 50 STOCKHOLM 80
SWEDEN
The information in this document is subject to change without
notice. The institute assumes no responsibility for any errors that
may be present in this document. The described software is furnished
to the user for use on a SIMULA system. (SIMULA is a registered
trademark of the Norwegian Computing Center, Oslo, Norway).
Copyright 1975 by the Swedish Research Institute for National Defence.
Copying is allowed.
----------------------------------------------------------------------
SAFEI is a SIMULA class which is designed to faciliate the
programming of conversational parts of SIMULA programs.
SAFEI is a reduced variant of the SAFEIO class.
SAFEI does not contain the file handling facilities
and has thus no SAFEIO command (!...) functions.
For more information, see SAFEIO.HLP and SAFEIO.DOC.
;
CLASS safei(language); VALUE language; TEXT language;
VIRTUAL: PROCEDURE special; LABEL eof;
BEGIN
PROCEDURE printint(i); INTEGER i;
COMMENT Printint prints the integer i without leading spaces
on Sysout in Putfrac(i,0) format. ;
BEGIN
Outtext(fracput(i))
END of printint;
PROCEDURE printreal(x); REAL x;
COMMENT Printreal prints the value of the real variable x
without leading spaces.
If Abs(x) is in the range (E-4,E8) the fixed point format will
be used so that 8 significant digits are typed out. Else the
Putreal format with 8 significant digits will be used. ;
BEGIN Outtext(realput(x)); END of printreal;
TEXT PROCEDURE fracput(i); INTEGER i;
COMMENT Fracput returns a text containing
the value of the integer i without leading spaces
in Putfrac(i,0) format. ;
BEGIN u.Putfrac(i,0);
fracput:- Copy(frontstrip(u))
END of fracput;
TEXT PROCEDURE intput(i); INTEGER i;
COMMENT Intput returns a text containing
the value of the integer i without leading spaces. ;
BEGIN u.Putint(i);
intput:- Copy(frontstrip(u))
END of intput;
TEXT PROCEDURE realput(x); REAL x;
BEGIN
IF x = 0 THEN u.Putfix(x,0) ELSE
IF Abs(x) >= &8 THEN u.Putreal(x,8) ELSE
IF Abs(x) >= &-4 THEN u.Putfix(x,8-ilog(x)) ELSE
u.Putreal(x,8);
realput:- Copy(frontstrip(u))
END of realput;
PROCEDURE outline(t); VALUE t; TEXT t;
BEGIN
WHILE t.Length > Length DO
BEGIN Outtext(t.Sub(1,Length));
t:- t.Sub(Length+1,t.Length-Length)
END loop;
Outtext(t); Outimage;
END of outline;
BOOLEAN PROCEDURE irange(test,low,high); INTEGER test,low,high;
irange:= low <= test AND test <= high;
BOOLEAN PROCEDURE range(test,low,high); REAL test,low,high;
range:= low <= test AND test <= high;
TEXT PROCEDURE outofrange(low,high); REAL low,high;
outofrange:- conc(message[83],realput(low),
",",realput(high),"].");
TEXT PROCEDURE outofirange(low,high); INTEGER low,high;
outofirange:- conc(message[83],intput(low),
",",intput(high),"].");
BOOLEAN PROCEDURE commandhelp(table,n); TEXT ARRAY table; INTEGER n;
BEGIN INTEGER i;
Outtext(message[84]); Outimage;
FOR i:= 1 STEP 1 UNTIL n DO
BEGIN Outtext(table[i]); Outimage END;
Outimage
END of commandhelp;
TEXT PROCEDURE commandmessage(index); INTEGER index;
commandmessage:-
IF index = 0 THEN message[85] ELSE message[86];
BOOLEAN PROCEDURE nohelp; outline(message[14]);
! The nohelp procedure issues a message that no special help
! information is available. The programmer is however encouraged to
! define his specific help procedures when using
! the request procedure. ;
BOOLEAN PROCEDURE help(message); NAME message; TEXT message;
! This procedure will have the side effect of displaying the
! text MESSAGE on Sysout.;
IF message.Length <= Length THEN
BEGIN Outtext(message); Outimage END ELSE
BEGIN TEXT t; INTEGER i;
t:- Copy(message);
WHILE t.Length > Length DO
BEGIN
FOR i:= Length STEP -1 UNTIL 2 DO
IF fetchar(t,i) = ' ' THEN GO TO blankfound;
i:= Length;
blankfound: Outtext(t.Sub(1,i));
t:- t.Sub(i+1,t.Length-i);
END loop;
Outtext(t); Outimage
END of help;
OPTIONS(/P);
BOOLEAN PROCEDURE intinput(result,valid);
! This procedure checks that the rest of the Sysin.image
! contain exactly one integer item (and nothing more).
! If so the syntaxok will be flagged true (so that the errormessage in
! request may be printed) and the intinput will return the value of
! the dynamically evaluated parameter valid (which usually is a boolean
! expression). Otherwise a message will be issued and the syntaxok will
! will be flagged false. ;
NAME result,valid; INTEGER result; BOOLEAN valid;
BEGIN INTEGER p,x;
p:= Sysin.Pos;
x:= scanint(Sysin.Image);
IF Sysin.Pos > p AND rest(Sysin.Image).Strip == NOTEXT THEN
BEGIN
result:= x;
syntaxok:= TRUE;
intinput:= IF checkvalidity THEN valid ELSE TRUE
END ELSE
BEGIN Outtext(message[15]);
outline(Sysin.Image.Sub(p,Sysin.Length-p+1).Strip);
syntaxok:= FALSE
END error
END of intinput;
BOOLEAN PROCEDURE realinput(result,valid);
! This procedure checks a real item. Otherwise as intinput. ;
NAME result,valid; REAL result; BOOLEAN valid;
BEGIN INTEGER p; REAL x;
p:= Sysin.Pos;
x:= scanreal(Sysin.Image);
IF
Sysin.Pos > p AND rest(Sysin.Image).Strip == NOTEXT
THEN
BEGIN Sysin.Setpos(p);
result:= x;
syntaxok:= TRUE;
realinput:= IF checkvalidity THEN valid ELSE TRUE
END ELSE
BEGIN syntaxok:= FALSE;
Outtext(message[16]);
outline(Sysin.Image.Sub(p,Sysin.Length-p+1).Strip)
END error
END of realinput;
BOOLEAN PROCEDURE longrealinput(result,valid);
! This procedure checks a real item in double
! precision. The syntax checking does not differ form that in realinput,
! but the result parameter is long real so that long results may be
! returned. ;
NAME result,valid; LONG REAL result; BOOLEAN valid;
BEGIN INTEGER p; LONG REAL x;
p:= Sysin.Pos;
x:= scanreal(Sysin.Image);
IF
Sysin.Pos > p AND rest(Sysin.Image).Strip == NOTEXT
THEN
BEGIN Sysin.Setpos(p);
result:= x;
syntaxok:= TRUE;
longrealinput:= IF checkvalidity THEN valid ELSE TRUE
END ELSE
BEGIN syntaxok:= FALSE;
Outtext(message[17]);
outline(Sysin.Image.Sub(p,Sysin.Length-p+1).Strip)
END error
END of longrealinput;
BOOLEAN PROCEDURE boolinput(result); NAME result; BOOLEAN result;
! The boolinput procedure has one parameter only. The validity check
! is of course unnecessary for boolean parameters.
! Accepted input depends on the content in the SAFEIO.language file.
! The input line may have lower case letters.
! In the English case it is YES, NO, TRUE OR FALSE.
! P} svenska g{ller JA, NEJ, SANN eller FALSK.;
BEGIN TEXT t; CHARACTER c;
t:- upcase(rest(Sysin.Image).Strip);
IF t.Length = 1 THEN c:= t.Getchar;
syntaxok:= TRUE; ! Allow errormessage to be issued.;
GO TO
IF c = 'Y' OR c = 'J' THEN l_true ELSE
IF c = 'N' THEN l_false ELSE
IF t = message[18] THEN l_false ELSE
IF t = message[19] THEN l_true ELSE
IF t = message[20] THEN l_true ELSE
IF t = message[21] THEN l_false ELSE
error;
l_true:
boolinput:= result:= TRUE; GO TO exit;
l_false:
boolinput:= TRUE; result:= FALSE; GO TO exit;
error:
Outtext(message[22]); outline(t); syntaxok:= FALSE;
exit:
END of boolinput;
BOOLEAN PROCEDURE textinput(result,valid);
! This procedure returns a copy of the stripped rest of the input line.
! The syntax is always considered correct.;
NAME result,valid; TEXT result; BOOLEAN valid;
BEGIN
result:- Copy(rest(Sysin.Image).Strip);
syntaxok:= TRUE; textinput:= IF checkvalidity THEN valid ELSE TRUE
END of textinput;
OPTIONS(/P);
PROCEDURE request(prompt,default,inputok,errormessage,help);
! The request procedure has the following parameters:
! Prompt is the prompting question, often ending with a
! prompting character as ':'.
! Default is the default text value. If default action is to be
! prohibited, the nodefault variable should be used.
! Inputok shall become true if the input is to be accepted,
! else false. Usually the actual parameter is a call to
! an ***input procedure.;
! Errormessage is a text that will be printed if inputok is
! is false and syntaxok is true (c.f. comment for intinput).
! Help is a BOOLEAN parameter by NAME which will
! be evaluated when the user types a '?'.
!;
VALUE prompt; NAME default,errormessage,inputok,help;
TEXT prompt,default,errormessage; BOOLEAN inputok,help;
BEGIN INTEGER p; TEXT u;
mainprompt:- prompt;
IF reqcount > 0 THEN Sysin.Setpos(0);
reqcount:= reqcount + 1;
GO TO start;
WHILE NOT inputok DO
BEGIN Sysin.Setpos(0);
IF syntaxok THEN
BEGIN Outtext(errormessage); Outimage END;
start: Outtext(prompt);
IF displaydefault AND default =/= nodefault THEN
BEGIN Outchar(defaultquote); Outtext(default);
Outchar(defaultquote); Outchar(promptingchar);
END display default;
IF Pos > 1 THEN
BEGIN
IF Pos < margin THEN Setpos(margin); Breakoutimage
END;
u:- rest(Sysin.Image);
IF u.Strip == NOTEXT THEN
BEGIN
Inimage;
IF Endfile THEN
BEGIN Outtext(message[10]); Outimage; GO TO eof END;
u:- Sysin.Image
END;
! Ignore lines ending with char 11(VT), 12(FF).;
FOR p:= IF u.Strip =/= NOTEXT THEN
Rank(u.Sub(u.Strip.Length,1).Getchar) ELSE 0
WHILE p = 11 OR p = 12 DO
BEGIN
Inimage;
IF Endfile THEN
BEGIN Outtext(message[10]); Outimage; GO TO eof END;
u:- Sysin.Image
END;
IF u.Getchar = helpchar THEN
BEGIN IF help THEN ; Sysin.Setpos(0); GO TO start END;
IF u.Strip == NOTEXT THEN
BEGIN
IF default == nodefault THEN
BEGIN Outtext(message[23]); Outimage;
GO TO start;
END no default allowed;
! Note the implicit restriction on length
! of the default text. ;
u:= IF default.Length > u.Length THEN
default.Sub(1,u.Length) ELSE default;
END empty input;
END input ok loop;
Sysin.Setpos(0);
reqcount:= reqcount - 1;
END of request;
PROCEDURE readmessages;
! Reads an input file containing SAFEIO messages.
! Currently two files are available: SAFEIO.ENG and SAFEIO.SWE
! for english and swedish texts respectively.
! If no such files exists on the user's area, the SYS: files
! will be used.
! Parameter "own.fra" will use the file "OWN.FRA".
! The parameter "own" will use a file OWN.ENG on your own disk
! area. SAFEI("") will use the SAFEIO.ENG file on the SYS: area. ;
BEGIN REF (Infile) languagefile; BOOLEAN sys_tried;
INTEGER i;
language:-
frontstrip(language.Strip);
IF language == NOTEXT THEN
language:- Copy("SAFEIO.ENG");
WHILE language.More DO
IF language.Getchar = '.' THEN GO TO lookup;
! Add default file name:;
language.Setpos(1);
WHILE language.More DO
IF language.Getchar = ':' THEN
GO TO colonfound;
language:- conc("SAFEIO.",language);
GO TO lookup;
colonfound:
language:- conc( language.Sub(1,language.Pos-1),
"SAFEIO.",rest(language));
lookup:
languagefile:- findinfile(language);
INSPECT languagefile DO
BEGIN Open(Blanks(80)); Inimage;
i:= 0;
FOR i:= i + 1 WHILE NOT Endfile AND i <= 91 DO
BEGIN
IF i=10 OR (14<=i AND i<=23) OR i=76 OR (83<=i AND i<=86) THEN
message[i]:- Copy(Image.Sub(2,Image.Strip.Length-2));
Inimage
END endfile loop;
Close
END inspect OTHERWISE
BEGIN
IF sys_tried THEN
BEGIN Outtext("? Unknown language:"); Outtext(language);
Outimage; Outtext("ENGLISH used."); Outimage;
language:- Copy("sys:SAFEIO.ENG");
GO TO lookup
END ELSE
BEGIN sys_tried:= TRUE;
WHILE language.More DO
IF language.Getchar = '[' THEN
BEGIN language:- language.Sub(1,language.Pos-2);
GO TO out
END;
out: language:- conc("SYS:",language);
GO TO lookup
END sys trial
END unsuccessfull lookup;
END of readmessages;
OPTIONS(/P);
TEXT nodefault,mainprompt,u;
TEXT ARRAY message[1:91];
BOOLEAN syntaxok,displaydefault,checkvalidity;
INTEGER margin,reqcount;
CHARACTER helpchar,defaultquote,promptingchar;
u:- Blanks(20);
readmessages;
! Set up initial values. ;
nodefault:- message[76];
checkvalidity:= syntaxok:= displaydefault:= TRUE;
! May be changed to zero if no indentation of answers
! is wanted. Could also be increased if very long questions. ;
margin:= 35;
! All these characters may be changed. However be
! carefull for clashes. ;
! Note the possibility to change these chracters. ;
helpchar:= '?';
defaultquote:= '/';
promptingchar:= ':';
! Eliminating page skipping on Sysout. ;
INSPECT Sysout WHEN Printfile DO Linesperpage(-1);
start: ;
INNER;
! Jumped here if End of File on Sysin:;
eof:
END of safei;