10 REM >Joker
   20 REM by Steven Flintham
   30 REM
   40 REM Version 1.10
   50 REM
   60 REM Thursday 7th January 1993
   70 REM Friday 8th January 1993
   80 REM Saturday 9th January 1993
   90 REM Monday 15th February 1993
  100 REM
  110 REM (C) Steven Flintham 1993
  120 :
  130 MODE 7
  140 VDU 23;8202;0;0;0;
  150 PROCdisable
  160 PROCinit
  170 REPEAT
  180 PROCjoke
  190 UNTIL FALSE
  200 PROCenable
  210 END
  220 :
  230 DEF PROCdisable
  240 *FX229
  250 *FX4,1
  260 ENDPROC
  270 :
  280 DEF PROCenable
  290 *FX229
  300 *FX4
  310 ENDPROC
  320 :
  330 DEF PROCinit
  340 ON ERROR IF ERR<>17 THEN CLOSE #0:MODE 7:REPORT:PRINT " at line ";ERL:PROCenable:END ELSE MODE 7:VDU 23;8202;0;0;0;:CLOSE #0:PRINT'"Please wait...":PROCwrite_jokeind:MODE 7:PROCenable:END
  350 *FX229,1
  360 PROCpromote
  370 DIM joke_ptr%(100),used%(100)
  380 IF FNexist("JokeInd") THEN PROCread_jokeind ELSE PROCcreate_jokeind
  390 *FX229
  400 PRINT'TAB(2);CHR$131;"Please press SPACE to continue...";
  410 *FX21
  420 REPEAT UNTIL GET=32
  430 ENDPROC
  440 :
  450 DEF FNexist(fname$)
  460 LOCAL chan%
  470 chan%=OPENIN(fname$)
  480 IF chan%<>0 THEN CLOSE #chan%
  490 =(chan%<>0)
  500 :
  510 DEF PROCcreate_jokeind
  520 LOCAL in%,byte%,last_byte%,out%,write%
  530 in%=OPENIN("Jokes")
  540 num_jokes%=0
  550 PTR #in%=0
  560 byte%=-1
  570 REPEAT
  580 last_byte%=byte%
  590 byte%=BGET #in%
  600 IF byte%=ASC("|") THEN num_jokes%=num_jokes%+1:joke_ptr%(num_jokes%)=PTR #in%+1
  610 UNTIL byte%=ASC("^") AND last_byte%<>ASC("|")
  620 CLOSE #in%
  630 out%=OPENOUT("JokeInd")
  640 PRINT #out%,num_jokes%
  650 FOR write%=1 TO num_jokes%
  660 PRINT #out%,joke_ptr%(write%),FALSE
  670 NEXT
  680 CLOSE #out%
  690 ENDPROC
  700 :
  710 DEF PROCread_jokeind
  720 LOCAL in%,read%
  730 in%=OPENIN("JokeInd")
  740 INPUT #in%,num_jokes%
  750 FOR read%=1 TO num_jokes%
  760 INPUT #in%,joke_ptr%(read%),used%(read%)
  770 NEXT
  780 CLOSE #in%
  790 ENDPROC
  800 :
  810 DEF PROCwrite_jokeind
  820 LOCAL out%,write%
  830 out%=OPENOUT("JokeInd")
  840 PRINT #out%,num_jokes%
  850 FOR write%=1 TO num_jokes%
  860 PRINT #out%,joke_ptr%(write%),used%(write%)
  870 NEXT
  880 CLOSE #out%
  890 ENDPROC
  900 :
  910 DEF PROCtitle
  920 PRINTTAB(14,0);CHR$141;CHR$132;CHR$157;CHR$131;"Joker  ";CHR$156
  930 PRINTTAB(14,1);CHR$141;CHR$132;CHR$157;CHR$131;"Joker  ";CHR$156
  940 PRINTTAB(8,2);CHR$131;"(C) Steven Flintham 1993"
  950 ENDPROC
  960 :
  970 DEF PROCpromote
  980 PROCtitle
  990 PRINTTAB(0,4);"This program was first written for 8-bitSoftware, a disc-based magazine and user-group by post. For more information,"
 1000 PRINT "send an SAE to:"
 1010 PRINT'TAB(5);"8-bit Software"
 1020 PRINT TAB(5);"1 Oakwood Drive"
 1030 PRINT TAB(5);"Heaton"
 1040 PRINT TAB(5);"Bolton"
 1050 PRINT TAB(5);"BL1 5EE"
 1060 PRINT'"Joker 1.10 is freeware. It may be freelycopied and distributed provided no"'"profit is made in the process and that"'"none of the files are modified in any"'"way, including the joke file. However,"
 1070 PRINT "the program code remains (C) Steven"'"Flintham 1993 - of course, this does notapply to the jokes."
 1080 ENDPROC
 1090 :
 1100 DEF PROCjoke
 1110 CLS
 1120 PROCtitle
 1130 PROCshow_joke
 1140 ENDPROC
 1150 :
 1160 DEF FNptr_to_joke
 1170 LOCAL attempts%,joke%,all_used%,scan%
 1180 *FX229,1
 1190 all_used%=TRUE
 1200 FOR scan%=1 TO num_jokes%
 1210 IF used%(scan%)=FALSE THEN all_used%=FALSE
 1220 NEXT
 1230 IF all_used% THEN PROCcancel_all_used_marks
 1240 attempts%=0
 1250 REPEAT
 1260 joke%=RND(num_jokes%)
 1270 attempts%=attempts%+1
 1280 IF attempts%=10 THEN joke%=0:REPEAT:joke%=joke%+1:UNTIL NOT used%(joke%)
 1290 UNTIL NOT used%(joke%)
 1300 used%(joke%)=TRUE
 1310 *FX229
 1320 =joke_ptr%(joke%)
 1330 :
 1340 DEF PROCcancel_all_used_marks
 1350 LOCAL cancel%
 1360 FOR cancel%=1 TO num_jokes%
 1370 used%(cancel%)=FALSE
 1380 NEXT
 1390 ENDPROC
 1400 :
 1410 DEF PROCshow_joke
 1420 LOCAL chan%,new_page%,word$,byte%
 1430 chan%=OPENIN("Jokes")
 1440 PTR #chan%=FNptr_to_joke
 1450 PRINTTAB(0,4);
 1460 REPEAT
 1470 new_page%=FALSE
 1480 REPEAT
 1490 word$=""
 1500 REPEAT
 1510 byte%=BGET #chan%
 1520 IF byte%<>13 AND byte%<>10 AND byte%<>ASC("|") AND byte%<>ASC("^") THEN word$=word$+CHR$(byte%)
 1530 UNTIL byte%=13 OR byte%=10 OR byte%=ASC("|") OR byte%=32 OR (byte%=ASC("^") AND EOF #chan%)
 1540 IF (POS+LEN(word$))>39 THEN PRINT:IF VPOS=23 THEN new_page%=TRUE
 1550 IF NOT new_page% THEN PRINT word$;
 1560 IF byte%=13 OR byte%=10 THEN PRINT:IF VPOS=23 THEN new_page%=TRUE:word$=""
 1570 UNTIL byte%=ASC("|") OR (byte%=ASC("^") AND EOF #chan%) OR new_page%
 1580 IF new_page% THEN PRINTTAB(0,24);CHR$131;"Press SPACE to continue..."; ELSE PRINTTAB(0,24);CHR$131;"Press SPACE for the next joke...";
 1590 *FX21
 1600 REPEAT UNTIL GET=32
 1610 IF new_page% THEN CLS:PROCtitle:PRINTTAB(0,4);word$;:byte%=BGET #chan%:PTR #chan%=(PTR #chan%)-1:IF byte%=ASC("|") OR byte%=ASC("^") THEN new_page%=FALSE
 1620 UNTIL NOT new_page%
 1630 CLOSE #chan%
 1640 ENDPROC