Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/27/formt.sim
There are 4 other files named formt.sim in the archive. Click here to see a list.
OPTIONS(/l); OPTIONS(/s:"libsim[106,346]");
BEGIN
EXTERNAL TEXT PROCEDURE conc, upcase, storbokstav, scanto;
EXTERNAL TEXT PROCEDURE lowcase, frontstrip, today, tmpin;
EXTERNAL CHARACTER PROCEDURE fetchar, getch;
EXTERNAL INTEGER PROCEDURE trmop, gettab, checkreal, checkint;
EXTERNAL PROCEDURE depchar, forceout, outstring, echo, abort, outchr;
EXTERNAL CLASS vista, form, termty;
EXTERNAL BOOLEAN PROCEDURE meny, tmpout;
BOOLEAN ok_to_store;
form CLASS personin;
BEGIN
REF (field) givenname, surname, nationality,
birthyear, weight, eyes;
REF (intfield) height;
TEXT year;
intfield CLASS weightfield;
BEGIN
IF intvalue < (height.intvalue-47)/5 THEN
error("Cannot be so light with that height.");
END;
alphafield CLASS namefield;
BEGIN
BOOLEAN upnext;
IF answer == NOTEXT THEN error("Must have name.")
ELSE
BEGIN
lowcase(answer); upnext:= TRUE;
answer.setpos(1); WHILE answer.more DO
BEGIN
IF upnext THEN upcase(answer.sub(answer.pos,1));
upnext:= NOT letter(answer.getchar);
END;
change_answer(answer);
END;
END;
givenname:- NEW namefield(0,6,"given names:",64,char(0),NOTEXT);
surname:- NEW namefield(0,8,"surname:",24,char(0),NOTEXT);
nationality:- NEW alphafield(35,8,"nationality:",11,char(0),NOTEXT);
year:- today.sub(1,4);
birthyear:- NEW
intfield(0,10,"birthyear:",22,' ',NOTEXT,1800,year.getint,
conc("Birthyear should be between 1800 and ",year,"."));
height:- NEW intfield(35,10,"height:",16,' ',NOTEXT,10,220,
"Height should be between 10 and 220 cm.");
weight:- NEW weightfield(0,12,"weight:",25,' ',NOTEXT,1,300,
"Weight should be between 1 and 300 kg.");
INSPECT NEW choicefield(35,12,"eyecolour:",13,' ',NOTEXT,
"Accepted eyecolours: brown, blue and grey.") DO
BEGIN
eyes:- THIS choicefield;
NEW choice("brown"); NEW choice("blue");
NEW choice("grey");
END;
END;
REF (personin) personen; CHARACTER c;
personen:- NEW personin(79,19,sysin,sysout,FALSE,0,NOTEXT,NOTEXT);
ok_to_store:= TRUE;
WHILE TRUE DO
BEGIN
INSPECT personen DO
BEGIN
IF ok_to_store THEN
BEGIN
blank_the_screen;
outtext(
"Demonstration example of form-fill-in program in SIMULA:"
);
outimage;
outtext("Facilities: ");
outtext(
"Initial letters in names are made upper-case,");
outimage;
outtext(
" Missing letters in eyecolour are filled in,"
); outimage;
outtext(
" Several validity checks on each input value,"
); outimage;
outtext(
" Move back and forward allowed on screen.");
outimage;
show_page;
move_the_cursor_to(0,14);
outtext(
"Push e.g. ""^birth"" to correct previous entry.");
ask_page;
END ELSE
BEGIN
blank_line(14); blank_line(15); blank_line(16);
blank_line(17);
resume(first_field);
END;
blank_line(14);
outtext(givenname.answer); outtext(" ");
outtext(surname.answer);
outimage; outtext("is a ");
outtext(nationality.answer);
outtext(" citizen, "); outtext(height.answer);
outtext(" centimeters tall, weighing ");
outtext(weight.answer); outtext(" kilograms");
outimage;
outtext("and with "); outtext(lowcase(copy(eyes.answer)));
outtext(" eyes.");
outimage;
outtext("Is this OK to store? ");
inimage; c:= sysin.image.getchar;
ok_to_store:= c = 'y' OR c = 'Y';
END;
END;
END of main program;