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