10REM >Decisn 20REM by Steven Flintham 30REM 40REM Saturday 10th July 1993 50REM Sunday 11th July 1993 60REM Thursday 15th July 1993 70REM Sunday 18th July 1993 80REM Tuesday 3rd August 1993 90REM Thursday 5th August 1993 100REM Sunday 8th August 1993 110: 120MODE 7 130VDU 23;8202;0;0;0; 140PROCdisable 150PROCinit 160REPEAT 170file`error`line%=170:PROCload`file 180PROCdecide 190PROCsort`decisions 200file`error`line%=200:PROCshow`resul ts 210UNTIL FALSE 220END 230: 240DEF PROCdisable 250*FX220,0 260*FX4,2 270ENDPROC 280: 290DEF PROCenable 300*FX220,27 310*FX4 320ENDPROC 330: 340DEF PROCinit 350file`error`line%=170:REM just in ca se... 360ON ERROR PROCerror 370max`options%=20 380DIM block% 256, option$(max`options %), option%(max`options%) 390discard%=RND(-TIME) 400ENDPROC 410: 420DEF PROCerror 430*FX3,0 440CLOSE #0 450IF ERR>=&BD AND ERR<=&D6 THEN PRINT ''CHR$131;"A disc error has occurred:":R EPORT:PRINT''FNpress`space;"to continue. ..":PROCspace:GOTO file`error`line% 460VDU 22,7 470PROCenable 480IF ERR=17 THEN END 490REPORT:PRINT " at line ";ERL 500END 510: 520DEF PROCload`file 530LOCAL exist%,chan% 540REPEAT 550REPEAT 560PROCtitle 570PRINT'CHR$131;"Please enter the fil ename of the file"'CHR$131;"containing t he options." 580PRINT'CHR$131;"Filename:";CHR$135; 590filename$=FNinput(1,28) 600exist%=FNexist(filename$) 610IF NOT exist% THEN PRINT''CHR$131;" Sorry, that file does not exist."''FNpre ss`space;"to try again...":PROCspace 620UNTIL exist% 630chan%=OPENIN(filename$) 640options%=0 650REPEAT 660options%=options%+1 670option$(options%)=LEFT$(FNread`line (chan%),30) 680option%(options%)=0 690UNTIL EOF #chan% OR options%=max`op tions% 700IF NOT EOF #chan% THEN PRINT''CHR$1 31;"There are more than ";STR$(max`optio ns%);" options in"'CHR$131;"this file. I will ignore the extra"'CHR$131;"ones."' 'FNpress`space;"to continue...":PROCspac e 710IF options%=1 THEN PRINT''CHR$131;" There is only one option in this file."' 'FNpress`space;"to try again...":PROCspa ce 720CLOSE #chan% 730UNTIL options%>1 740ENDPROC 750: 760DEF PROCtitle 770VDU 26,12 780PRINTTAB(9,0);CHR$141;CHR$132;CHR$1 57;CHR$131;"Decision Maker ";CHR$156 790PRINTTAB(9,1);CHR$141;CHR$132;CHR$1 57;CHR$131;"Decision Maker ";CHR$156 800PRINTTAB(8,2);"(C) Steven Flintham 1993" 810ENDPROC 820: 830DEF FNinput(min%,max%) 840LOCAL xpos%,ypos%,text$,key% 850xpos%=POS 860ypos%=VPOS 870text$="" 880REPEAT 890REPEAT 900*FX21 910key%=GET 920UNTIL key%=13 OR (key%>=32 AND key% <=127) 930IF key%=127 AND LEN(text$)>0 THEN V DU 127:text$=LEFT$(text$,LEN(text$)-1) 940IF key%<>127 AND key%<>13 AND LEN(t ext$)<max% THEN VDU key%:text$=text$+CHR $(key%) 950UNTIL (key%=13 AND LEN(text$)>=min% ) 960=text$ 970: 980DEF FNexist(fname$) 990LOCAL chan% 1000chan%=OPENIN(fname$) 1010IF chan%<>0 THEN CLOSE #chan% 1020=(chan%<>0) 1030: 1040DEF PROCoscli($block%) 1050LOCAL X%,Y% 1060X%=block% MOD 256 1070Y%=block% DIV 256 1080CALL &FFF7 1090ENDPROC 1100: 1110DEF FNread`line(chan%) 1120LOCAL line$,byte% 1130IF EOF #chan% THEN ="" 1140line$="" 1150REPEAT 1160byte%=BGET #chan% 1170IF byte%<>10 AND byte%<>13 THEN lin e$=line$+CHR$(byte%) 1180UNTIL byte%=10 OR byte%=13 OR EOF # chan% 1190=line$ 1200: 1210DEF FNpress`space 1220=CHR$131+"Press"+CHR$132+CHR$157+CH R$131+"SPACE "+CHR$156 1230: 1240DEF PROCspace 1250*FX21 1260REPEAT UNTIL GET=32 1270ENDPROC 1280: 1290DEF PROCdecide 1300LOCAL decision%,total`decisions%,ou ter%,inner%,key$,prefer%,parameter% 1310decision%=0 1320total`decisions%=0.5*(options%-1)*o ptions% 1330FOR outer%=1 TO options%-1 1340FOR inner%=outer%+1 TO options% 1350decision%=decision%+1 1360PROCtitle 1370PRINT'CHR$131;"This is decision ";S TR$(decision%);" of ";STR$(total`decisio ns%) 1380PRINT'CHR$131;"Do you prefer:" 1390randomise%=RND(2) 1400PRINT'TAB(2);CHR$131;"1) ";option$( FNrandom(outer%,inner%,randomise%,1)) 1410PRINTTAB(2);CHR$131;"2) ";option$(F Nrandom(outer%,inner%,randomise%,2)) 1420PRINT'CHR$131;"Please choose:";CHR$ 135; 1430REPEAT 1440*FX21 1450key$=GET$ 1460UNTIL INSTR("12!"+CHR$34,key$)<>0 1470IF key$="1" OR key$="!" THEN prefer %=1 ELSE prefer%=2 1480PRINT STR$(prefer%); 1490parameter%=FNrandom(outer%,inner%,r andomise%,prefer%) 1500option%(parameter%)=option%(paramet er%)+1 1510NEXT 1520NEXT 1530ENDPROC 1540: 1550DEF FNrandom(outer%,inner%,randomis e%,required%) 1560IF randomise%=2 THEN required%=3-re quired% 1570IF required%=1 THEN =outer% ELSE =i nner% 1580: 1590DEF PROCsort`decisions 1600LOCAL outer%,inner%,temp$,temp% 1610FOR outer%=1 TO options%-1 1620FOR inner%=outer%+1 TO options% 1630IF option%(inner%)>option%(outer%) THEN temp$=option$(inner%):temp%=option% (inner%):option$(inner%)=option$(outer%) :option%(inner%)=option%(outer%):option$ (outer%)=temp$:option%(outer%)=temp% 1640NEXT 1650NEXT 1660ENDPROC 1670: 1680DEF PROCshow`results 1690LOCAL tab%,pad`to%,show%,key$ 1700REPEAT 1710REPEAT 1720PROCtitle 1730PRINTTAB(0,4);CHR$131;"Option";TAB( 32,4);"Points" 1740tab%=35-LEN(STR$(option%(1)))/2 1750IF tab%<32 THEN tab%=32 1760pad`to%=LEN(STR$(option%(1))) 1770FOR show%=1 TO options% 1780PRINTTAB(0,4+show%);CHR$131;option$ (show%);TAB(tab%,4+show%);FNpad(option%( show%),pad`to%); 1790NEXT 1800REPEAT 1810*FX21 1820key$=CHR$(GET AND &DF) 1830UNTIL INSTR("PSR",key$)<>0 1840IF key$="P" THEN PROCprint`results 1850IF key$="S" THEN PROCsave`results 1860UNTIL key$="R" 1870PROCtitle 1880PRINTTAB(0,4);CHR$131;"Are you sure you want to re-run the"'CHR$131;"progra m?";CHR$135; 1890UNTIL FNyes 1900ENDPROC 1910: 1920DEF FNyes 1930LOCAL key$ 1940REPEAT 1950*FX21 1960key$=CHR$(GET AND &DF) 1970UNTIL INSTR("YN",key$)<>0 1980IF key$="Y" THEN PRINT "Yes" ELSE P RINT "No" 1990=(key$="Y") 2000: 2010DEF FNpad(num%,len%) 2020LOCAL num$ 2030num$=STR$(num%) 2040REPEAT 2050IF LEN(num$)<len% THEN num$=" "+num $ 2060UNTIL LEN(num$)>=len% 2070=num$ 2080: 2090DEF PROCprint`results 2100LOCAL key$,tab%,pad`to%,show% 2110PROCtitle 2120PRINTTAB(0,4);CHR$131;"Please make sure the printer is ready"'CHR$131;"and press P to print or any other key"'CHR$1 31;"to return to the list..." 2130*FX21 2140key$=CHR$(GET AND &DF) 2150IF key$<>"P" THEN ENDPROC 2160*FX3,10 2170PRINT "Results of decision on ";fil ename$ 2180PRINT 2190PRINT "Option";TAB(32);"Points" 2200tab%=35-LEN(STR$(option%(1)))/2 2210IF tab%<32 THEN tab%=32 2220pad`to%=LEN(STR$(option%(1))) 2230FOR show%=1 TO options% 2240PRINT option$(show%);TAB(tab%);FNpa d(option%(show%),pad`to%) 2250NEXT 2260PRINT 2270*FX3,0 2280ENDPROC 2290: 2300DEF PROCsave`results 2310LOCAL save`file$,exist%,tab%,pad`to %,show% 2320REPEAT 2330PROCtitle 2340PRINT'CHR$131;"Please enter the fil ename to save the"'CHR$131;"results unde r." 2350PRINT'CHR$131;"Filename:";CHR$135; 2360save`file$=FNinput(1,28) 2370exist%=FNexist(save`file$) 2380IF exist% THEN PRINT''CHR$131;"That file already exists. Are you"'CHR$131;" sure?";CHR$135;:exist%=NOT FNyes 2390UNTIL NOT exist% 2400VDU 11:REM for tidier disc error me ssage 2410PROCoscli("SPOOL "+save`file$) 2420*FX3,2 2430PRINT "Results of decision on ";fil ename$ 2440PRINT 2450PRINT "Option";TAB(32);"Points" 2460tab%=35-LEN(STR$(option%(1)))/2 2470IF tab%<32 THEN tab%=32 2480pad`to%=LEN(STR$(option%(1))) 2490FOR show%=1 TO options% 2500PRINT option$(show%);TAB(tab%);FNpa d(option%(show%),pad`to%) 2510NEXT 2520PRINT 2530*FX3,0 2540PROCoscli("SPOOL") 2550ENDPROC