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