Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/simeio.sim
There is 1 other file named simeio.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 REF (Outfile) PROCEDURE findoutfile;
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 SAFEIO --- 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.
----------------------------------------------------------------------
SIMEIO is a SIMULA class which is designed to faciliate the
programming of conversational parts of SIMULA programs.
For more information, see SAFEIO.HLP and SAFEIO.DOC.
;
Simulation CLASS simeio(savefilename,language); VALUE savefilename,language;
TEXT savefilename,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]);
IF Pos < Length//2 THEN Setpos(Length//2)
ELSE Outimage;
END;
Outimage
END of commandhelp;
TEXT PROCEDURE commandmessage(index); INTEGER index;
commandmessage:-
IF index = 0 THEN message[85] ELSE message[86];
PROCEDURE special;
! The programmer may specify his own procedure special (with exactly
! that name and no parameter. Since it is virtual the local procedure
! will be called when the user types in '!%'.
! Note that the programmer may implement code for analysing the rest
! of the currentfile.image following the '!%'.
! Note also that the special procedure may call other procedures
! which in turn may have parameters.
! This declaration has the sole purpose of avoiding run time error
! ("No virtual match") if the programmer hasn't declared his
! own special procedure. ;
BEGIN Outtext(message[1]); Outimage END;
PROCEDURE cmdclose;
! This procedure closes all open input SAFEIO files.
! If no input file is used a message is printed. ;
IF currentitem.file == Sysin THEN
BEGIN Outtext(message[2]); Outimage END ELSE
WHILE currentitem.file =/= Sysin DO currentitem.down;
PROCEDURE recordclose;
! This procedure will close the recording (log) file.
! If no recordfile is open no action is taken. ;
BEGIN
IF recordfile =/= NONE THEN
BEGIN
IF trace THEN
BEGIN Outtext(message[3]); Outtext(recordname);
Outchar(']'); Outimage;
END trace;
recordfile.Setpos(1);
recordfile.Close; recordfile:- NONE
END;
END of recordclose;
PROCEDURE recordappend;
! This procedure closes the current recording file and opens it
! again in append mode. The programmer may insert class to recordappend
! whenever he wants this kind of checkpoint. The user may call the
! procedure by typing in '!+'. ;
IF recordfile == NONE THEN
BEGIN Outtext(message[4]);
Outimage
END ELSE
BEGIN recordfile.Setpos(1); recordfile.Close;
recordfile:- NEW Outfile(conc(message[5],recordname,message[6]));
recordfile.Open(record_buffer);
IF trace THEN
BEGIN Outtext(message[7]); Outtext(recordname);
Outtext(message[8]); Outimage
END trace
END of recordappend;
CLASS fileitem(file,filename,wait); VALUE filename; TEXT filename;
! Class fileitem describes the elements in the input file stack.
! Since input file calls ('!<' and '!_') may be nested we need this
! class. The currentitem (REF (fileitem) ) always points at the top
! of the stack. Usually the currentfile (REF (Infile) ) points at
! currentitem.file. However when an illegal or unvalid input has been
! read the currentfile will temporarly be switched to Sysin.
! The filename is used to remember the filenames of the input files.
! The wait attribute flags the wait/nowait state of the input
! operations. ;
REF (Infile) file; BOOLEAN wait;
BEGIN REF (fileitem) p,s;
PROCEDURE up(x); REF (fileitem) x;
! The procedure up will add a new input file to the stack.
! The new file will be opened. ;
BEGIN s:- x; x.p:- THIS fileitem;
IF trace THEN
BEGIN
Outtext(message[9]);
Outchar(IF x.wait THEN cmdchar ELSE cmdnowaitchar);
Outtext(x.filename); Outchar(']'); Outimage;
END trace;
currentitem:- x; x.file.Open(cmd_buffer);
waitforsysin:= x.wait
END of up;
PROCEDURE down;
! This procedure removes the top element of the
! stack if not equal to Sysin (when a message will be issued). ;
IF file == Sysin THEN
BEGIN Outtext(message[10]); Outimage;
GO TO eof
END ELSE
BEGIN file.Close; cmdcount:= cmdcount - 1;
IF trace THEN
BEGIN Outimage;
Outtext(message[11]); Outtext(filename);
Outtext(message[12]);
Outchar(IF p.wait THEN cmdchar ELSE cmdnowaitchar);
Outtext(p.filename); Outchar('(');
printint(cmdcount); Outtext(")]"); Outimage;
END trace ELSE
IF p.file == Sysin THEN
BEGIN Outtext(message[13]); Outimage END;
currentfile:- p.file; currentitem:- p; waitforsysin:= p.wait;
p.s:- NONE; p:- NONE;
END OF DOWN;
END OF FILEITEM;
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 currentfile.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:= currentfile.Pos;
x:= scanint(currentfile.Image);
IF currentfile.Pos > p AND rest(currentfile.Image).Strip == NOTEXT THEN
BEGIN
result:= x;
syntaxok:= TRUE;
intinput:= IF checkvalidity THEN valid ELSE TRUE
END ELSE
BEGIN Outtext(message[15]);
outline(currentfile.Image.Sub(p,currentfile.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:= currentfile.Pos;
x:= scanreal(currentfile.Image);
IF
currentfile.Pos > p AND rest(currentfile.Image).Strip == NOTEXT
THEN
BEGIN currentfile.Setpos(p);
result:= x;
syntaxok:= TRUE;
realinput:= IF checkvalidity THEN valid ELSE TRUE
END ELSE
BEGIN syntaxok:= FALSE;
Outtext(message[16]);
outline(currentfile.Image.Sub(p,currentfile.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:= currentfile.Pos;
x:= scanreal(currentfile.Image);
IF
currentfile.Pos > p AND rest(currentfile.Image).Strip == NOTEXT
THEN
BEGIN currentfile.Setpos(p);
result:= x;
syntaxok:= TRUE;
longrealinput:= IF checkvalidity THEN valid ELSE TRUE
END ELSE
BEGIN syntaxok:= FALSE;
Outtext(message[17]);
outline(currentfile.Image.Sub(p,currentfile.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(currentfile.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(currentfile.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; reqcount:= reqcount + 1;
IF reqcount > 1 AND recordfile =/= NONE THEN
BEGIN Outtext(message[87]); Outimage; END warning;
IF NOT inputsaved THEN currentfile.Setpos(0);
inputsaved:= FALSE; GO TO start;
WHILE NOT inputok AND (IF syntaxok THEN NOT overrideflag ELSE TRUE) DO
BEGIN currentfile.Setpos(0); currentfile:- Sysin;
IF syntaxok THEN
BEGIN Outtext(errormessage); Outimage END;
GO TO mustprompt;
start:
IF displayprompt THEN mustprompt: Outtext(prompt);
IF displaydefault AND default =/= nodefault THEN
BEGIN Outchar(defaultquote); Outtext(default);
Outchar(defaultquote); Outchar(promptingchar);
END display default;
noprompt:
overrideflag:= FALSE;
IF Pos > 1 THEN
BEGIN
IF Pos < margin THEN Setpos(margin); Breakoutimage
END;
u:- rest(currentfile.Image);
IF u.Strip == NOTEXT THEN
BEGIN
IF currentfile.Endfile THEN
BEGIN currentitem.down; GO TO mustprompt END;
currentfile.Inimage;
u:- currentfile.Image
END ELSE IF FALSE THEN continue: u:- rest(currentfile.Image);
! 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
IF currentfile.Endfile THEN
BEGIN currentitem.down; GO TO mustprompt END;
currentfile.Inimage;
u:- currentfile.Image
END;
IF u.Strip == NOTEXT THEN
BEGIN
IF default == nodefault THEN
BEGIN Outtext(message[23]); Outimage;
currentfile:- Sysin; GO TO mustprompt
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 ELSE
test: switchtest(mustprompt,noprompt,continue,help);
p:= currentfile.Pos;
! If input from disk and displayinput is true then
! print input value. ;
IF displayinput AND currentfile =/= Sysin THEN
BEGIN Outtext(currentfile.Image.Sub(p,currentfile.Length-p+1).Strip);
IF waitforsysin THEN
BEGIN Outtext(message[24]); Breakoutimage END ELSE Outimage
END display input value;
! Check Sysin actions: ;
IF waitforsysin AND currentfile =/= Sysin THEN
BEGIN Inimage;
currentfile.Setpos(p);
IF Sysin.Image.Strip =/= NOTEXT THEN
BEGIN currentfile:- Sysin;
GO TO test
END overriding cmd answer
END wait for sysin ok;
END input ok loop;
! Save in recordfile if not NONE. ;
INSPECT recordfile DO
BEGIN
! May have been some Sysin overriding input since last time. ;
IF Pos > 1 THEN BEGIN Image:= NOTEXT; Setpos(1) END;
Outchar(switchchar); Outchar(switchchar);
Outint(prompt.Length+7,3); Outchar(Char(9));
Outtext(prompt);
IF overrideflag THEN
BEGIN Outchar(switchchar); Outchar(overridechar) END;
Outtext(currentfile.Image.Sub(p,currentfile.Length-p+1).Strip);
END recording;
! Restore currentfile.Image since REQUEST may have been
! called recursively.;
currentfile.Setpos(0);
currentfile:- currentitem.file;
! C.f. procedure switchtest. ;
IF NOT inputsaved THEN currentfile.Setpos(0);
INSPECT recordfile DO
BEGIN Outimage;
IF reqcount NE 1 THEN
BEGIN
Outtext(message[88]); Outint(reqcount,2);
Outimage;
END warning;
END inspect;
reqcount:= reqcount - 1;
END of request;
PROCEDURE nooverride; overridechar:= switchchar;
! A call of nooverride shortcircuits the '!&' override validity test
! facility. See procedure switchtest. ;
OPTIONS(/P);
PROCEDURE switchtest(mustprompt,noprompt,continue,helpvar);
! This procedure takes care of all input lines starting with '!' or '?'. ;
NAME helpvar; LABEL mustprompt,noprompt,continue; BOOLEAN helpvar;
BEGIN CHARACTER c; INTEGER startpos; BOOLEAN dummy;
PROCEDURE toggle(switch_,string); NAME switch_,string;
! Change a switch value and tell the user. ;
BOOLEAN switch_; TEXT string;
BEGIN switch_:= NOT switch_; Outtext(message[25]);
Outtext(string); Outtext(message[26]);
Outtext(IF switch_ THEN message[27] ELSE message[28]); Outimage;
END of toggle;
BOOLEAN PROCEDURE synchelp;
! Printing information concerning syncronization question. ;
BEGIN Outtext(message[29]);
Outimage; Outtext(message[30]);
Outimage; Outtext(message[31]);
Outimage; Outtext(message[32]);
Outchar(promptingchar); Outtext(message[33]);
Outimage;
END of synchelp;
IF currentfile.Lastitem THEN
BEGIN currentitem.down; GO TO exit END of file;
c:= currentfile.Inchar;
! Call help if input line starts with ?. ;
IF c = helpchar THEN
BEGIN IF helpvar THEN ; GO TO exit END;
IF c = switchchar THEN
BEGIN
c:= currentfile.Inchar;
IF c = ' ' THEN GO TO exit;
IF c = switchchar THEN
BEGIN posfield:- currentfile.Image.Sub(3,3);
! Reading the position where the answer starts. ;
IF checkint(posfield) = 1 THEN
BEGIN startpos:= posfield.Getint;
IF startpos < 7 OR startpos > currentfile.Length THEN GO TO exit;
! Compare input file question with current question. ;
IF (IF checkprompt AND currentfile =/= Sysin THEN
mainprompt NE currentfile.Image.Sub(7,startpos-7)
ELSE FALSE) THEN
BEGIN REF (Outfile) savefile; CHARACTER savechar;
TEXT ARRAY table[1:3]; TEXT command;
INTEGER action,oldcount,nskip;
BOOLEAN savedisplay,saveprompt;
PROCEDURE restore;
BEGIN
switchchar:= savechar; recordfile:- savefile;
displayinput:= savedisplay; displayprompt:= saveprompt;
END of restore;
table[1]:- message[79]; table[2]:- message[80];
table[3]:- message[81];
Outtext(message[34]);
Outimage; Outtext(message[35]);
Outtext(currentfile.Image.Sub(7,currentfile.Length-6).Strip);
Outchar(']'); Outimage;
currentfile:- Sysin;
! Save possibly recording file and shortcircuit
! the '!' facilities for this question. ;
! Save also the displayinput value. ;
! As well as the displayprompt value. ;
! And the reqcount value. ;
savefile:- recordfile; recordfile:- NONE;
savechar:= switchchar; switchchar:= ' ';
savedisplay:= displayinput; displayinput:= TRUE;
saveprompt:= displayprompt; displayprompt:= TRUE;
oldcount:= reqcount; reqcount:= 0;
request(message[36],nodefault,
textinput(command,menu(command,action,table,3)),
message[37],synchelp);
IF action = 2 THEN
BEGIN currentfile:- Sysin;
request("How many records:","1",intinput(nskip,
nskip >=1),"? Must be >= 1.",
help("Enter number of records to be replaced."));
END;
FOR nskip:= nskip - 1 WHILE nskip > 0 DO
BEGIN IF currentfile.Endfile THEN
BEGIN currentitem.down; restore;
GO TO mustprompt
END;
currentfile.Inimage;
END loop;
! .. and restore as before. ;
restore;
reqcount:= oldcount;
! If action = 1 : use input file still (accept).
! If action = 2 : replace input with Sysin
! for this question.
! If action = 3 : save input line for next question.;
inputsaved:= action = 3;
IF action >= 2 THEN
BEGIN currentfile:- Sysin;
currentitem.file.Setpos(action-2);
GO TO mustprompt
END >= 2;
! Still using startpos since action = 1 ;
END no syncronization;
currentfile.Setpos(startpos);
GO TO continue
END ELSE GO TO exit;
END ELSE
IF c = recordchar THEN recordswitch ELSE
IF c = cmdchar OR c = cmdnowaitchar THEN cmdswitch(c,continue) ELSE
IF c = closechar THEN cmdclose ELSE
IF c = displaychar THEN toggle(displaydefault,message[38]) ELSE
IF c = tracechar THEN toggle(trace,message[39]) ELSE
IF c = promptswitchchar THEN toggle(displayprompt,message[40]) ELSE
IF c = helpchar THEN BEGIN switchhelp; GO TO exit END ELSE
IF c = appendchar THEN recordappend ELSE
IF c = inputchar THEN
BEGIN toggle(displayinputvalue,message[41]);
displayprompt:= displaydefault:= displayinputvalue;
END ELSE
IF c = specialchar THEN special ELSE
IF c = overridechar THEN
BEGIN overrideflag:= TRUE; GO TO continue END ELSE
IF c = commentchar THEN outline(currentfile.Image.Strip) ELSE
BEGIN exit: currentfile.Setpos(0); GO TO mustprompt END;
currentfile.Setpos(0);
GO TO noprompt
END c = switchchar ELSE currentfile.Setpos(currentfile.Pos-1);
END of switchtest;
OPTIONS(/P);
PROCEDURE switchhelp;
! This procedure prints information on the SAFEIO ! commands. ;
BEGIN CHARACTER exclam;
PROCEDURE charout(c,t); NAME t; TEXT t; CHARACTER c;
BEGIN Outchar(exclam); Outchar(c); Outtext(message[42]);
Outtext(t); Outimage
END of charout;
PROCEDURE switchout(c,t,sw); NAME t; CHARACTER c; TEXT t;
BOOLEAN sw;
BEGIN Outchar(exclam); Outchar(c); Outtext(message[43]);
Outtext(t); Outtext(message[44]);
Outtext(IF sw THEN message[45] ELSE message[46]); Outimage
END switchout;
Outtext(message[47]); Outimage; Eject(Line+1);
charout(helpchar,message[48]);
Eject(Line+1); Outtext(message[49]); Outchar(switchchar);
Outimage; Eject(Line+1);
exclam:= switchchar;
switchout(promptswitchchar,message[50],displayprompt);
switchout(displaychar,message[51],displaydefault);
switchout(inputchar,message[52],displayinputvalue);
switchout(tracechar,message[53],trace);
charout(appendchar,message[54]);
charout(commentchar,message[55]);
charout(specialchar,message[56]);
! Will be printed only if not shortcircuited. ;
IF overridechar NE switchchar THEN
charout(overridechar,message[57]);
Outchar(exclam); Outchar(cmdchar);
Outtext(message[58]);
Outtext(defaultextension); Outimage;
charout(cmdnowaitchar,message[59]);
charout(cmdchar,message[60]);
charout(closechar,message[61]);
Outchar(exclam); Outchar(cmdnowaitchar);
Outtext(message[62]);
Outtext(defaultextension); Outimage;
Outchar(exclam); Outchar(recordchar);
Outtext(message[63]);
Outtext(defaultextension); Outimage;
charout(recordchar,message[64]);
charout(helpchar,message[65]);
Eject(Line+1);
Outtext(message[66]);
Outchar(switchchar); Outtext(message[67]);
Outimage; Eject(Line+1)
END of switchhelp;
OPTIONS(/P);
PROCEDURE cmdswitch(c,continue); CHARACTER c; LABEL continue;
! This procedure takes care of !< and !_ commands. ;
BEGIN TEXT cmdname;
cmdname:- rest(currentfile.Image).Strip;
currentfile.Setpos(0);
IF cmdname == NOTEXT THEN
! No file name given. ;
BEGIN
IF currentitem.file == Sysin THEN
BEGIN Outtext(message[68]);
Outimage; currentfile:- currentitem.file
END ELSE
IF c = cmdnowaitchar THEN
BEGIN
! Change to nowait input mode. ;
BEGIN waitforsysin:= FALSE; currentfile.Setpos(0);
currentfile:- currentitem.file; GO TO continue;
END;
END ELSE
! Close current input file:; currentitem.down
END ELSE
! File name was given. ;
BEGIN
cmdname:- checkextension(cmdname,defaultextension);
IF cmdcount = maxcmdfiles THEN
BEGIN
Outtext(message[82]); Outimage
END ELSE
BEGIN REF (Infile) x;
cmdcount:= cmdcount + 1;
x:- findinfile(cmdname);
IF x == NONE THEN
BEGIN Outtext(message[89]); Outtext(cmdname);
Outtext(message[91]); Outimage
END ELSE
BEGIN
IF trace THEN
BEGIN Outtext(message[69]); Breakoutimage END;
currentitem.up(NEW fileitem(x,cmdname,c = cmdchar));
currentfile:- currentitem.file
END input ok;
END new cmd file;
END new cmd file;
END of cmdswitch;
PROCEDURE recordswitch;
! This procedure takes care of the !> command. ;
BEGIN TEXT oldname;
oldname:- recordname;
recordname:- Copy(rest(currentfile.Image).Strip);
currentfile.Setpos(0);
IF recordname == NOTEXT THEN
! No file name given. ;
BEGIN
IF recordfile =/= NONE THEN
! Close it. ;
BEGIN recordfile.Setpos(1);
recordfile.Close; recordfile:- NONE;
IF trace THEN
BEGIN Outtext(message[70]); Outtext(oldname);
Outchar(']'); Outimage
END trace
END active record file ELSE
! No active file to close. ;
BEGIN Outtext(message[71]); Outimage END no file
END notext ELSE
! File name was given. ;
BEGIN
IF recordfile =/= NONE THEN
! Already recording. ;
BEGIN Outtext(message[72]); Outtext(oldname);
Outtext(message[73]); Outimage;
recordname:- oldname
END active record file ELSE
! Open new recording file. ;
BEGIN
recordname:- checkextension(recordname,defaultextension);
recordfile:- findoutfile(conc(message[74],recordname));
IF recordfile == NONE THEN
BEGIN Outtext(message[90]);
Outtext(recordname); Outtext(message[91]);
Outimage
END impossible ELSE
BEGIN
recordfile.Open(record_buffer);
IF trace THEN
BEGIN Outtext(message[75]);
Outtext(recordname); Outchar(']');
Outimage
END trace
END log ok
END was no active record file
END file name given
END of recordswitch;
PROCEDURE closefiles;
! Close all open input and recording SAFEIO files. ;
BEGIN
recordclose;
WHILE currentitem.file =/= Sysin DO currentitem.down;
END of closefiles;
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. SAFEIO("","") will create no log file and 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 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);
REF (Infile) currentfile; REF (fileitem) currentitem;
TEXT cmd_buffer,mainprompt,recordname,record_buffer,
nodefault,defaultextension,posfield,u;
TEXT ARRAY message[1:91];
BOOLEAN trace,syntaxok,displayprompt,displayinput,displaydefault,
inputsaved,checkprompt,overrideflag,waitforsysin,checkvalidity;
REF (Outfile) recordfile;
INTEGER margin,cmdcount,maxcmdfiles,reqcount;
CHARACTER cmdchar,recordchar,displaychar,tracechar,promptswitchchar,
switchchar,cmdnowaitchar,helpchar,inputchar,promptingchar,defaultquote,
closechar,commentchar,appendchar,specialchar,overridechar;
! Length of images may be increased. ;
u:- Blanks(20);
maxcmdfiles:= 10;
cmd_buffer:- Blanks(IF Length > 80 THEN Length ELSE 80);
record_buffer:- Blanks(cmd_buffer.Length);
readmessages;
! Set up initial values. ;
nodefault:- message[76]; defaultextension:- message[77];
checkprompt:= checkvalidity:=
syntaxok:= displaydefault:= displayprompt:= displayinput:= trace:= TRUE;
currentfile:- Sysin;
currentitem:- NEW fileitem(currentfile,message[78],waitforsysin);
! 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. See procedure switchtest about the
! testing order. Note the possibility to shortcircuit a facility
! by setting the corresponding character to ' '. ;
cmdchar:= '<';
recordchar:= '>';
helpchar:= '?';
displaychar:= '/';
tracechar:= '[';
promptswitchchar:= '*';
inputchar:= '=';
switchchar:= '!';
cmdnowaitchar:= '_';
defaultquote:= '/';
promptingchar:= ':';
specialchar:= '%';
overridechar:= '&';
appendchar:= '+';
commentchar:= ';';
closechar:= '^';
! Initializing recordfile from start. ;
IF savefilename =/= NOTEXT THEN
BEGIN Sysin.Image:= savefilename; Sysin.Setpos(1);
recordswitch; Sysin.Setpos(0);
END;
! Eliminating page skipping on Sysout. ;
INSPECT Sysout WHEN Printfile DO Linesperpage(-1);
start: ;
INNER;
! Jumped here if End of File on Sysin:;
eof:
closefiles;
END of simeio;