10REM >Joker
20REM by Steven Flintham
30REM
40REM Version 1.00
50REM
60REM Thursday 7th January 1993
70REM Friday 8th January 1993
80REM Saturday 9th January 1993
90REM
100REM (C) Steven Flintham 1993
110:
120MODE 7
130VDU 23;8202;0;0;0;
140PROCdisable
150PROCinit
160REPEAT
170PROCjoke
180UNTIL FALSE
190PROCenable
200END
210:
220DEF PROCdisable
230*FX229
240*FX4,1
250ENDPROC
260:
270DEF PROCenable
280*FX229
290*FX4
300ENDPROC
310:
320DEF PROCinit
330LOCAL byte%,last`byte%
340chan%=OPENUP("Jokes")
350ON ERROR IF ERR<>17 THEN CLOSE #cha
n%:MODE 7:REPORT:PRINT " at line ";ERL:P
ROCenable:END ELSE MODE 7:CLOSE #chan%:P
ROCenable:END
360PROCpromote
370DIM joke`ptr%(100),used%(100)
380num`jokes%=0
390PTR #chan%=0
400byte%=-1
410REPEAT
420last`byte%=byte%
430byte%=BGET #chan%
440IF byte%=ASC("|") THEN num`jokes%=n
um`jokes%+1:joke`ptr%(num`jokes%)=PTR #c
han%
450IF byte%=ASC("$") AND last`byte%=AS
C("|") THEN used%(num`jokes%)=FALSE
460IF byte%=ASC("^") AND last`byte%=AS
C("|") THEN used%(num`jokes%)=TRUE
470UNTIL byte%=ASC("^") AND last`byte%
<>ASC("|")
480PRINT'TAB(2);CHR$131;"Please press
SPACE to continue...";
490*FX21
500REPEAT UNTIL GET=32
510ENDPROC
520:
530DEF PROCtitle
540PRINTTAB(14,0);CHR$141;CHR$132;CHR$
157;CHR$131;"Joker ";CHR$156
550PRINTTAB(14,1);CHR$141;CHR$132;CHR$
157;CHR$131;"Joker ";CHR$156
560PRINTTAB(8,2);CHR$131;"(C) Steven F
lintham 1993"
570ENDPROC
580:
590DEF PROCpromote
600PROCtitle
610PRINTTAB(0,4);"This program was fir
st written for 8-bitSoftware, a disc-bas
ed magazine and user-group by post. For
more information,"
620PRINT "send an SAE to:"
630PRINT'TAB(5);"8-bit Software"
640PRINT TAB(5);"1 Oakwood Drive"
650PRINT TAB(5);"Heaton"
660PRINT TAB(5);"Bolton"
670PRINT TAB(5);"BL1 5EE"
680PRINT'"Joker 1.00 is freeware. It m
ay be freelycopied and distributed provi
ded no"'"profit is made in the process a
nd that"'"none of the files are modified
in any"'"way, including the joke file.
However,"
690PRINT "the program code remains (C)
Steven"'"Flintham 1993 - of course, thi
s does notapply to the jokes."
700ENDPROC
710:
720DEF PROCjoke
730CLS
740PROCtitle
750PROCptr`to`joke
760PROCshow`joke
770ENDPROC
780:
790DEF PROCptr`to`joke
800LOCAL attempts%,joke%,all`used%,sca
n%
810*FX229,1
820all`used%=TRUE
830FOR scan%=1 TO num`jokes%
840IF used%(scan%)=FALSE THEN all`used
%=FALSE
850NEXT
860IF all`used% THEN PROCcancel`all`us
ed`marks
870attempts%=0
880REPEAT
890joke%=RND(num`jokes%)
900attempts%=attempts%+1
910IF attempts%=10 THEN joke%=0:REPEAT
:joke%=joke%+1:UNTIL NOT used%(joke%)
920UNTIL NOT used%(joke%)
930PTR #chan%=joke`ptr%(joke%)
940BPUT #chan%,ASC("^")
950used%(joke%)=TRUE
960*FX229
970ENDPROC
980:
990DEF PROCcancel`all`used`marks
1000LOCAL cancel%
1010FOR cancel%=1 TO num`jokes%
1020PTR #chan%=joke`ptr%(cancel%)
1030BPUT #chan%,ASC("$")
1040used%(cancel%)=FALSE
1050NEXT
1060ENDPROC
1070:
1080DEF PROCshow`joke
1090LOCAL
1100PRINTTAB(0,4);
1110REPEAT
1120new`page%=FALSE
1130REPEAT
1140word$=""
1150REPEAT
1160byte%=BGET #chan%
1170IF byte%<>13 AND byte%<>10 AND byte
%<>ASC("|") AND byte%<>ASC("^") THEN wor
d$=word$+CHR$(byte%)
1180UNTIL byte%=13 OR byte%=10 OR byte%
=ASC("|") OR byte%=32 OR (byte%=ASC("^")
AND EOF #chan%)
1190IF (POS+LEN(word$))>39 THEN PRINT:I
F VPOS=23 THEN new`page%=TRUE
1200IF NOT new`page% THEN PRINT word$;
1210IF byte%=13 OR byte%=10 THEN PRINT:
IF VPOS=23 THEN new`page%=TRUE:word$=""
1220UNTIL byte%=ASC("|") OR (byte%=ASC(
"^") AND EOF #chan%) OR new`page%
1230IF new`page% THEN PRINTTAB(0,24);CH
R$131;"Press SPACE to continue..."; ELSE
PRINTTAB(0,24);CHR$131;"Press SPACE for
the next joke...";
1240*FX21
1250REPEAT UNTIL GET=32
1260IF new`page% THEN CLS:PROCtitle:PRI
NTTAB(0,4);word$;:byte%=BGET #chan%:PTR
#chan%=(PTR #chan%)-1:IF byte%=ASC("|")
OR byte%=ASC("^") THEN new`page%=FALSE
1270UNTIL NOT new`page%
1280ENDPROC