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;