Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0135/10/table.sim
There are 4 other files named table.sim in the archive. Click here to see a list.
00040 OPTIONS(/l);
00080 BEGIN
00120 EXTERNAL CHARACTER PROCEDURE fetchar, insinglechar;
00160 EXTERNAL INTEGER PROCEDURE trmop, gettab, checkreal,
00200 checkint, iondx;
00240 EXTERNAL BOOLEAN PROCEDURE meny, tmpout;
00280 EXTERNAL PROCEDURE depchar, forceout, outstring, echo, abort, outchr;
00300 EXTERNAL PROCEDURE outche;
00320 EXTERNAL TEXT PROCEDURE frontstrip, upcase, storbokstav, scanto, tmpin;
00360 EXTERNAL CLASS vista, form, termty;
00400 CHARACTER c;
00440 REAL pricesum, numbersum;
00480 INTEGER rownumber, terminaltyp;
00520 TEXT ninechars, terminalparameters;
00560
00600 BOOLEAN PROCEDURE wholenumber(r); REAL r;
00640 wholenumber:= abs(r - entier(r+0.5)) < 0.005;
00680
00720 form CLASS tablein;
00760 BEGIN
00800 REF (row) ARRAY rows(5:10);
00840
00880 PROCEDURE updatesum;
00920 BEGIN
00960 numbersum:= pricesum:= 0;
01000 FOR rownumber:= 5 STEP 1 UNTIL 10 DO
01040 INSPECT rows(rownumber) DO
01080 BEGIN
01120 IF number.defined THEN
01160 numbersum:= numbersum + number.realvalue;
01200 IF number.defined AND price.defined
01240 THEN pricesum:= pricesum +
01280 number.realvalue*price.realvalue;
01320 END;
01360 move_the_cursor_to(14,12);
01400 outfix(numbersum,
01440 IF wholenumber(numbersum) THEN 0 ELSE 2,
01480 IF wholenumber(numbersum) THEN 7 ELSE 10);
01520 outtext(" ");
01560 move_the_cursor_to(40,12);
01600 IF pricesum > 0.0 THEN
01640 BEGIN
01680 outfix(pricesum,2,10);
01720 outtext(" Kr");
01760 END ELSE outtext(" ");
01800 END;
01840
01880 CLASS row(vertical); INTEGER vertical;
01920 BEGIN
01960 REF (typefield) type;
02000 REF (numberfield) number;
02040 REF (pricefield) price;
02080
02120 PROCEDURE updatetotal;
02160 IF number.defined AND price.defined THEN
02200 BEGIN
02240 move_the_cursor_to(40,vertical);
02280 outfix(number.realvalue*price.realvalue,2,10);
02320 outtext(" Kr");
02360 END;
02400
02440 type:- NEW typefield(0,vertical,"",14,char(0),
02480 "Type kind of item and then push the tab key."
02520 " Push just the CR key to stop.");
02560 number:- NEW numberfield(15,vertical,"",11,' ',
02600 "Type number of items of this type"
02640 " and then push TAB or RETURN.",0,999,
02680 "Must be between 0 and 999",THIS row);
02720 price:- NEW pricefield(27,vertical,"",12,' ',
02760 "Type price of one item and then push the tab or CR key.",0,
02800 999.99,
02840 "Must be between 0 and 999.99",THIS row);
02880 END;
02920
02960 alphafield CLASS typefield;
03000 BEGIN
03040 IF answer.strip == NOTEXT THEN stopasking
03080 ELSE
03120 BEGIN
03160 upcase(answer.sub(1,1));
03200 IF answer.length > 14 THEN
03240 error("Max length 14 characters");
03280 change_answer(answer);
03320 END;
03360 END;
03400
03440 realfield CLASS tablefield(myrow); REF (row) myrow;
03480 BEGIN
03520 BOOLEAN defined;
03560 defined:= TRUE;
03600 ninechars:= NOTEXT;
03640 INNER;
03680 change_answer(ninechars);
03720 updatesum; myrow.updatetotal;
03760 END;
03800
03840 tablefield CLASS numberfield;
03880 BEGIN
03920 ninechars.sub(1,IF wholenumber(realvalue)
03960 THEN 5 ELSE 8).putfix(realvalue,
04000 IF wholenumber(realvalue) THEN 0 ELSE 2);
04040 END;
04080
04120 tablefield CLASS pricefield;
04160 BEGIN
04200 ninechars.sub(1,6).putfix(realvalue,2);
04240 ninechars.sub(8,2):= "Kr";
04280 END;
04320
04360 FOR rownumber:= 5 STEP 1 UNTIL 10 DO
04400 rows (rownumber) :- NEW row(rownumber);
04440 END;
04480
04520 ninechars:- blanks(9);
04560 WHILE TRUE DO
04600 BEGIN
04640 tablein(79,19,sysin,sysout,FALSE,terminaltyp,NOTEXT,
04680 terminalparameters)
04720 BEGIN
04760 terminalparameters:- extraparameters;
04800 IF terminalparameters =/= NOTEXT THEN terminaltyp:= 999;
04840 terminaltyp:= terminaltype;
04880 blank_the_screen; home_the_cursor;
04920 outtext(" TABLE FILL-IN DEMONSTRATION EXAMPLE: "
04960 " (Type ? for HELP)");
05000 outimage; outimage;
05040 outtext(
05080 " Type of Number of Price per Total");
05120 outimage;
05160 outtext(
05200 " unit units unit price");
05240 outimage;
05280
05320 show_page;
05360 move_the_cursor_to(0,11);
05400 outtext(
05440 " ----------------------------------------------------");
05480 outimage;
05520 outtext(" Sum");
05560 IF FALSE THEN correction:
05600 BEGIN
05640 blank_line(14); blank_line(15);
05680 blank_line(16);
05720 blank_line(17);
05760 resume(first_field);
05800 END;
05840 ask_page;
05880 blank_line(14);
05920 outtext("Is this OK to store? ");
05960 inimage; c:= sysin.image.getchar;
06000 IF c NE 'y' AND c NE 'Y' THEN GOTO correction;
06040 END;
06080 END;
06120 END of main program;