perm filename SAFEI.SIM[SIM,SYS] blob sn#460199 filedate 1979-07-20 generic text, type T, neo UTF8
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:- 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;