Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

OPTIONS(/l);
BEGIN
  EXTERNAL TEXT PROCEDURE conc, upcase, storbokstav, scanto;
  EXTERNAL TEXT PROCEDURE lowcase, frontstrip, today, tmpin;
  EXTERNAL CHARACTER PROCEDURE fetchar, insinglechar;
  EXTERNAL INTEGER PROCEDURE trmop, gettab, checkreal, checkint, iondx;
  EXTERNAL PROCEDURE depchar, forceout, outstring, echo, abort, outchr, outche;
  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;