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

OPTIONS(/l);
BEGIN
  EXTERNAL CHARACTER PROCEDURE fetchar, getch;
  EXTERNAL INTEGER PROCEDURE trmop, gettab, checkreal,
  checkint;
  EXTERNAL BOOLEAN PROCEDURE meny, tmpout;
  EXTERNAL PROCEDURE depchar, forceout, outstring, echo, abort, outchr;
  EXTERNAL TEXT PROCEDURE frontstrip, upcase, storbokstav, scanto, tmpin;
  EXTERNAL CLASS vista, form, termty;
  CHARACTER c;
  REAL pricesum, numbersum;
  INTEGER rownumber, terminaltyp;
  TEXT ninechars, terminalparameters;

  BOOLEAN PROCEDURE wholenumber(r); REAL r;
  wholenumber:= abs(r - entier(r+0.5)) < 0.005;

  form CLASS tablein;
  BEGIN
    REF (row) ARRAY rows(5:10);

    PROCEDURE updatesum;
    BEGIN
      numbersum:= pricesum:= 0;
      FOR rownumber:= 5 STEP 1 UNTIL 10 DO
      INSPECT rows(rownumber) DO
      BEGIN
        IF number.defined THEN
        numbersum:= numbersum + number.realvalue;
        IF number.defined AND price.defined
        THEN pricesum:= pricesum +
        number.realvalue*price.realvalue;
      END;
      move_the_cursor_to(14,12);
      outfix(numbersum,
      IF wholenumber(numbersum) THEN 0 ELSE 2,
      IF wholenumber(numbersum) THEN 7 ELSE 10);
      outtext("   ");
      move_the_cursor_to(40,12);
      IF pricesum > 0.0 THEN
      BEGIN
        outfix(pricesum,2,10);
        outtext(" Kr");
      END ELSE outtext("             ");
    END;

    CLASS row(vertical); INTEGER vertical;
    BEGIN
      REF (typefield) type;
      REF (numberfield) number;
      REF (pricefield) price;

      PROCEDURE updatetotal;
      IF number.defined AND price.defined THEN
      BEGIN
        move_the_cursor_to(40,vertical);
        outfix(number.realvalue*price.realvalue,2,10);
        outtext(" Kr");
      END;

      type:- NEW typefield(0,vertical,"",14,char(0),
      "Type kind of item and then push the tab key."
      " Push just the CR key to stop.");
      number:- NEW numberfield(15,vertical,"",11,' ',
      "Type number of items of this type"
      " and then push TAB or RETURN.",0,999,
      "Must be between 0 and 999",THIS row);
      price:- NEW pricefield(27,vertical,"",12,' ',
      "Type price of one item and then push the tab or CR key.",0,
      999.99,
      "Must be between 0 and 999.99",THIS row);
    END;

    alphafield CLASS typefield;
    BEGIN
      IF answer.strip == NOTEXT THEN stopasking
      ELSE
      BEGIN
        upcase(answer.sub(1,1));
        IF answer.length > 14 THEN
        error("Max length 14 characters");
        change_answer(answer);
      END;
    END;

    realfield CLASS tablefield(myrow); REF (row) myrow;
    BEGIN
      BOOLEAN defined;
      defined:= TRUE;
      ninechars:= NOTEXT;
      INNER;
      change_answer(ninechars);
      updatesum; myrow.updatetotal;
    END;

    tablefield CLASS numberfield;
    BEGIN
      ninechars.sub(1,IF wholenumber(realvalue)
      THEN 5 ELSE 8).putfix(realvalue,
      IF wholenumber(realvalue) THEN 0 ELSE 2);
    END;

    tablefield CLASS pricefield;
    BEGIN
      ninechars.sub(1,6).putfix(realvalue,2);
      ninechars.sub(8,2):= "Kr";
    END;

    FOR rownumber:= 5 STEP 1 UNTIL 10 DO
    rows (rownumber) :- NEW row(rownumber);
  END;

  ninechars:- blanks(9);
  WHILE TRUE DO
  BEGIN
    tablein(79,19,sysin,sysout,FALSE,terminaltyp,NOTEXT,
    terminalparameters)
    BEGIN
      terminalparameters:- extraparameters;
      IF terminalparameters =/= NOTEXT THEN terminaltyp:= 999;
      terminaltyp:= terminaltype;
      blank_the_screen; home_the_cursor;
      outtext(" TABLE FILL-IN DEMONSTRATION EXAMPLE:        "
      "    (Type ? for HELP)");
      outimage; outimage;
      outtext(
      " Type of        Number of   Price per       Total");
      outimage;
      outtext(
      " unit           units       unit            price");
      outimage;

      show_page;
      move_the_cursor_to(0,11);
      outtext(
      " ----------------------------------------------------");
      outimage;
      outtext(" Sum");
      IF FALSE THEN correction:
      BEGIN
        blank_line(14); blank_line(15);
        blank_line(16);
        blank_line(17);
        resume(first_field);
      END;
      ask_page;
      blank_line(14);
      outtext("Is this OK to store? ");
      inimage; c:= sysin.image.getchar;
      IF c NE 'y' AND c NE 'Y' THEN GOTO correction;
    END;
  END;
END of main program;