Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0135/comp/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;