10 REM >Joker
   20 REM by Steven Flintham
   30 REM
   40 REM Version 1.00
   50 REM
   60 REM Thursday 7th January 1993
   70 REM Friday 8th January 1993
   80 REM Saturday 9th January 1993
   90 REM
  100 REM (C) Steven Flintham 1993
  110 :
  120 MODE 7
  130 VDU 23;8202;0;0;0;
  140 PROCdisable
  150 PROCinit
  160 REPEAT
  170 PROCjoke
  180 UNTIL FALSE
  190 PROCenable
  200 END
  210 :
  220 DEF PROCdisable
  230 *FX229
  240 *FX4,1
  250 ENDPROC
  260 :
  270 DEF PROCenable
  280 *FX229
  290 *FX4
  300 ENDPROC
  310 :
  320 DEF PROCinit
  330 LOCAL byte%,last_byte%
  340 chan%=OPENUP("Jokes")
  350 ON ERROR IF ERR<>17 THEN CLOSE #chan%:MODE 7:REPORT:PRINT " at line ";ERL:PROCenable:END ELSE MODE 7:CLOSE #chan%:PROCenable:END
  360 PROCpromote
  370 DIM joke_ptr%(100),used%(100)
  380 num_jokes%=0
  390 PTR #chan%=0
  400 byte%=-1
  410 REPEAT
  420 last_byte%=byte%
  430 byte%=BGET #chan%
  440 IF byte%=ASC("|") THEN num_jokes%=num_jokes%+1:joke_ptr%(num_jokes%)=PTR #chan%
  450 IF byte%=ASC("$") AND last_byte%=ASC("|") THEN used%(num_jokes%)=FALSE
  460 IF byte%=ASC("^") AND last_byte%=ASC("|") THEN used%(num_jokes%)=TRUE
  470 UNTIL byte%=ASC("^") AND last_byte%<>ASC("|")
  480 PRINT'TAB(2);CHR$131;"Please press SPACE to continue...";
  490 *FX21
  500 REPEAT UNTIL GET=32
  510 ENDPROC
  520 :
  530 DEF PROCtitle
  540 PRINTTAB(14,0);CHR$141;CHR$132;CHR$157;CHR$131;"Joker  ";CHR$156
  550 PRINTTAB(14,1);CHR$141;CHR$132;CHR$157;CHR$131;"Joker  ";CHR$156
  560 PRINTTAB(8,2);CHR$131;"(C) Steven Flintham 1993"
  570 ENDPROC
  580 :
  590 DEF PROCpromote
  600 PROCtitle
  610 PRINTTAB(0,4);"This program was first written for 8-bitSoftware, a disc-based magazine and user-group by post. For more information,"
  620 PRINT "send an SAE to:"
  630 PRINT'TAB(5);"8-bit Software"
  640 PRINT TAB(5);"1 Oakwood Drive"
  650 PRINT TAB(5);"Heaton"
  660 PRINT TAB(5);"Bolton"
  670 PRINT TAB(5);"BL1 5EE"
  680 PRINT'"Joker 1.00 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,"
  690 PRINT "the program code remains (C) Steven"'"Flintham 1993 - of course, this does notapply to the jokes."
  700 ENDPROC
  710 :
  720 DEF PROCjoke
  730 CLS
  740 PROCtitle
  750 PROCptr_to_joke
  760 PROCshow_joke
  770 ENDPROC
  780 :
  790 DEF PROCptr_to_joke
  800 LOCAL attempts%,joke%,all_used%,scan%
  810 *FX229,1
  820 all_used%=TRUE
  830 FOR scan%=1 TO num_jokes%
  840 IF used%(scan%)=FALSE THEN all_used%=FALSE
  850 NEXT
  860 IF all_used% THEN PROCcancel_all_used_marks
  870 attempts%=0
  880 REPEAT
  890 joke%=RND(num_jokes%)
  900 attempts%=attempts%+1
  910 IF attempts%=10 THEN joke%=0:REPEAT:joke%=joke%+1:UNTIL NOT used%(joke%)
  920 UNTIL NOT used%(joke%)
  930 PTR #chan%=joke_ptr%(joke%)
  940 BPUT #chan%,ASC("^")
  950 used%(joke%)=TRUE
  960 *FX229
  970 ENDPROC
  980 :
  990 DEF PROCcancel_all_used_marks
 1000 LOCAL cancel%
 1010 FOR cancel%=1 TO num_jokes%
 1020 PTR #chan%=joke_ptr%(cancel%)
 1030 BPUT #chan%,ASC("$")
 1040 used%(cancel%)=FALSE
 1050 NEXT
 1060 ENDPROC
 1070 :
 1080 DEF PROCshow_joke
 1090 LOCAL
 1100 PRINTTAB(0,4);
 1110 REPEAT
 1120 new_page%=FALSE
 1130 REPEAT
 1140 word$=""
 1150 REPEAT
 1160 byte%=BGET #chan%
 1170 IF byte%<>13 AND byte%<>10 AND byte%<>ASC("|") AND byte%<>ASC("^") THEN word$=word$+CHR$(byte%)
 1180 UNTIL byte%=13 OR byte%=10 OR byte%=ASC("|") OR byte%=32 OR (byte%=ASC("^") AND EOF #chan%)
 1190 IF (POS+LEN(word$))>39 THEN PRINT:IF VPOS=23 THEN new_page%=TRUE
 1200 IF NOT new_page% THEN PRINT word$;
 1210 IF byte%=13 OR byte%=10 THEN PRINT:IF VPOS=23 THEN new_page%=TRUE:word$=""
 1220 UNTIL byte%=ASC("|") OR (byte%=ASC("^") AND EOF #chan%) OR new_page%
 1230 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...";
 1240 *FX21
 1250 REPEAT UNTIL GET=32
 1260 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
 1270 UNTIL NOT new_page%
 1280 ENDPROC