Ok.......................
Eliminated the SIN/COS bottleneck from my code. This has been an all day affair, especially because
the substitute algorithm differed slightly in precision. I've about got that licked, but there is a little more
tweaking to do. At present I have 1 ear slightly larger than the other...... But its all good.
Its certainly not up to 32 or 64 Linux speed. But its noticeably quicker than my previous code
HANGMAN thread continues in GAMES.
Forum rules
This section is for testing Commander X16 programs and programs related to the CX16 for other platforms (compilers, data conversion tools, etc.)
Feel free to post works in progress, test builds, prototypes, and tech demos.
Finished works go in the Downloads category. Don't forget to add a hashtag (#) and the version number your program was meant to run on. (ie: #R41).
This section is for testing Commander X16 programs and programs related to the CX16 for other platforms (compilers, data conversion tools, etc.)
Feel free to post works in progress, test builds, prototypes, and tech demos.
Finished works go in the Downloads category. Don't forget to add a hashtag (#) and the version number your program was meant to run on. (ie: #R41).
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH
Last edited by ahenry3068 on Fri Aug 25, 2023 7:19 am, edited 1 time in total.
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH
Here is the code
Code: Select all
10 SCREEN $80
15 DIM EC%(15):DIM TC%(2,8):DIM AL%(2,26)
20 GOSUB 59000 : REM INITIALIZE ALL VARIABLES
40 RECT 0,0,319,239,$3B
45 RECT 3,3,316,236,$10:GOSUB 1000
50 DC$=CHR$(228):GOSUB 180
55 DC$=CHR$(162):GOSUB 180
60 REM GOSUB TO MAKE 166 TO SOLID BLOCK CHAR
65 DC$=CHR$(113):GOSUB 180
70 CHAR 75,165,$A9,CHR$($0C)+"THE CLASSIC WORD GAME"
75 CHAR 62,180,$AB,CHR$($0C)+"NOW ON THE COMMANDER X16"
80 CHAR 4,222,1,"CODED IN BASIC"
85 CHAR 4,232,1,"2023.. ANTHONY HENRY"
86 CHAR 185,222,1,"MUSIC CONTRIBUTED BY"
87 CHAR 205,232,1,"MOOINGLEMUR"
90 GOSUB 270:GOSUB 300
95 RESTORE 50300:GW=0
100 READ PS$,DL
105 IF DL=0 THEN 95
110 FMCHORD 0,PS$
115 FOR I=1 TO DL
120 GET X$
125 IF X$ <>"" THEN GW=1
130 GOSUB 275
135 NEXT I
140 IF GW=1 THEN GW=0:GOTO 150
145 GOTO 100
150 FOR X = 1 TO 31
160 LOCATE 1,1:PRINT CHR$(145)
161 READ PS$,DL:IF DL=0 THEN RESTORE 50300:GOTO 161
162 FMCHORD 0,PS$
166 FOR I = 1 TO DL:GOSUB 275:NEXT I
170 NEXT X
171 READ PS$,DL
172 IF DL=0 THEN 178
173 FMCHORD 0,PS$
174 SLEEP DL
175 GOTO 171
178 FMINIT
179 GOTO 2640
180 X = 5:Y=2:UC=1:WD$="Hang"
185 GOSUB 39600
190 X=8:Y=11:WD$="Man"
195 GOSUB 39600
200 RETURN
REM PALLETTE ANIMATION FOR TITLE SCREEN
270 P1=13
275 IF P1=2 THEN P2=13:GOTO 285
280 P2 = P1 - 1
285 GOSUB 40500
290 P1 = P1 - 1:IF P1<2 THEN P1=13
295 RETURN
REM DRAW STICK FIGURE HANGMAN
300 LINE 180,210,300,210,$53
311 LINE 180,209,299,209,$53
320 LINE 300,210,300,17,$53
321 LINE 299,209,299,18,$53
325 LINE 300,17,100,17,$53
326 LINE 299,18,100,18,$53
400 LINE 102,19,102,38,$57
405 FILL=0:CC=$57:YS=.4:XS=0:RA=13:CX=102:CY=45
410 GOSUB 3000
425 YS=0:XS=.8:CY=35:RA=9:CC=$25:FILL=1:GOSUB 3000
426 CX=CX-3:RA=2:CY=CY-2:CC=2:GOSUB 3000:CX=CX+6:GOSUB 3000
430 LINE 102,44,102,49,$25
435 LINE 102,51,102,78,$25
440 LINE 102,53,88,64,$25
445 LINE 102,53,116,64,$25
450 LINE 102,78,87,99,$25
455 LINE 102,78,117,99,$25
500 RETURN
1000 R%=15:G%=0:B%=2
1005 P1=$3B:P2=10:GOSUB 41000
1006 P1=1:P2=11:GOSUB 41000
1007 P1=$C7:P2=12:GOSUB 41000
1008 P1=$A0:P2=13:GOSUB 41000
1010 FOR I= 2 TO 9
1015 TC%(2,I-1) = 0
1020 TC%(1,I-1) = I
1025 P1 = I:GOSUB 40000:R%=R%-1
1030 IF I/3 = INT(I/3) THEN R%=R%-1:G%=G%+1
1050 NEXT I
1090 RETURN
2640 GOSUB 45000:GOSUB 59300
REM THE BACKGROUND
2650 GOSUB 5000
REM GALLOWS
2655 GOSUB 7000
REM ROPE
2660 GOSUB 8000
REM THE HEAD AND FACE
2665 GOSUB 9500
REM TORSO
2670 GOSUB 10000
REM LEFT ARM
2675 GOSUB 11000
REM RIGHT ARM
2680 GOSUB 12000
REM RIGHT LEG
2685 GOSUB 12500
REM LEFT LEG
2690 GOSUB 12620
2695 DM$="AWAITING KEY":GOSUB 20010:GOSUB 63000
2700 GOSUB 20100
REM DEADFACE
2705 GOSUB 4000
REM PULSING EYES
2710 GOSUB 20010:GOSUB 4200
REM RESTORE DRAWING PALLETTE
2715 GOSUB 59300
2720 COLOR 1,6
2725 LOCATE 6,14:PRINT " ";
2730 LOCATE 7,14:PRINT " WORKING WORD HERE ";
2735 LOCATE 8,14:PRINT " ";
2740 DM$=" CLUE GOES HERE : ANY KEY TO END DEMO":GOSUB 20010
2745 GOSUB 63000
REM RESTORE VERA DEFAULT PALLETTE
2746 GOSUB 45000
2750 SCREEN 0:END
REM BRESHNAHM CIRCLE
3000 WR=RA:X=0: D=2*(1-RA):W=INT(2*320/240)
3005 IF XS<=0 OR XS>1 THEN XS=1
3006 IF YS<=0 OR YS>1 THEN YS=1
3010 IF WR < 0 THEN 3350
3020 DX=X*XS:DY=WR*YS
3080 ZX=CX-DX
3090 ZY=CY-DY
3100 AX=CX+DX
3110 AY=CY+DY
3115 IF FILL=1 THEN 3165
3118 IF ZX<0 OR ZX>XL OR ZY<0 OR ZY>YL OR Q1=0 THEN 3130
3120 PSET ZX, ZY, CC
3130 IF AX<0 OR AX>XL OR ZY<0 OR ZY>YL OR Q2=0 THEN 3140
3131 PSET AX, ZY, CC
3140 IF ZX<0 OR ZX>XL OR AY<0 OR AY>YL OR Q3=0 THEN 3150
3141 PSET ZX, AY, CC
3150 IF AX<0 OR AX>XL OR AY<0 OR AY>YL OR Q4=0 THEN 3300
3151 PSET AX, AY, CC
3160 GOTO 3300
3165 X1=ZX:X2=AX
3166 IF (Q1=0 AND Q2=O) OR X1>XL THEN 3200
3170 IF ZY<0 OR ZY>YL THEN 3200
3171 IF X1<0 THEN X1=0
3172 IF X2>XL THEN X2=XL
3176 IF Q1=0 THEN X1=CX
3177 IF Q2=0 THEN X2=CX
3180 LINE X1,ZY,X2,ZY,CC
3200 IF (Q3=0 AND Q4=0) OR ZX>XL THEN 3300
3203 IF AY<0 OR AY>YL THEN 3300
3204 IF ZX<0 THEN ZX=0
3205 IF AX>XL THEN AX=XL
3210 IF Q3=0 THEN ZX=CX
3215 IF Q4=0 THEN AX=CX
3220 LINE ZX,AY,AX,AY,CC
3300 IF (D+RA)>0 THEN WR=WR-1:D=D-W*WR-1
3310 IF X>D THEN X=X+1: D=D+2*X+1
3320 GOTO 3010
3350 RETURN
REM DEADFACE
4000 P1=$24:P2=$FF:J=4:GOSUB 40200
4010 P1=$3B:P2=$FE:J=4:GOSUB 40200
4011 P1=$01:J=5:GOSUB 40200
4012 P1=$3A:J=3:GOSUB 40200
4013 P1=$15:J=5:GOSUB 40200
4014 P1=$3B:J=7:GOSUB 40200
4015 P1=$23:P2=$FF:J=8:GOSUB 40200
4016 P1=$B8:J=7:GOSUB 40200
4020 P1=$BF:GOSUB 40200
4030 P1=$C0:GOSUB 40200
4100 RETURN
REM EYE PULSING WHILE WAIT FOR KEY
4200 P2=$FE
4205 GET X$:IF X$<>"" THEN 4205
4210 GET X$
4215 IF X$<>"" THEN RETURN
4220 I=INT(RND(1)*15)+1
4225 P1 = EC%(I):J=INT(RND(1)*3)+2
4230 GOSUB 40200
4235 GOTO 4210
REM IY LOCATE Y LOCATION
REM IX LOCATE X LOCATION
REM ML MAX LENGTH OF STRING TO GET (1 TO 80)
REM IT TYPE OF INPUT 1=ALPHA ONLY, 2=NUMERIC(INCLUDE 1 AND ONLY 1 DECIMAL
REM POINT)
REM 3=ALPHANUMERIC, 4=LINE INPUT(CAN INCLUDE SPACE AND
REM TAB AND PUNCTUATION MARKS)
REM IS$ THE STRING TO RETURN
REM AC ADD CHAR 1=YES
REM ID DECIMAL DONE 1=YES
REM SPECIALIZED INPUT ROUTINE
4800 GET X$:IF X$<>"" THEN 4800
4801 IS$="":ID=0
REM BEFORE INPUT BEGINS
REM RESTORE VERA DEFAULT PALLETTE
4805 GOSUB 4920
4810 GET X$:IF X$="" THEN 4810
4811 C=ASC(X$)
4815 IF WL=ML THEN
4820 AC=0
4830 IF (IT<>2 OR IT=3) AND C>=65 AND C<=90 THEN AC=1
4835 IF (IT=2 OR IT=4 OR IT=3) AND C>=48 AND C<=57 THEN AC=1
4840 IF (IT=2) AND C=46 AND ID=0 THEN AC=1:ID=1
4845 IF (IT=4) AND C=32 THEN AC = 1: REM ALLOW SPACES WHEN INPUTTING A LINE
4846 IF (IT=4) AND (C>=35 AND C<=47) THEN AC=1
4847 IF (IT=4) AND (C>=58 AND C<=63) THEN AC=1 : REM ALLOW PUNCS IN STRING.
4850 IF C=13 THEN RETURN
4855 IF AC=1 AND LEN(IS$)<ML THEN PRINT CHR$(C);:IS$=IS$+CHR$(C):GOTO 4810
4860 IF C<>20 THEN 4895
4861 IF LEN(IS$) = 0 THEN PRINT CHR$(7);
4865 IF LEN(IS$)=1 OR LEN(IS$)=0 THEN IS$="":GOSUB 4920:GOTO 4810
4870 I = LEN(IS$)-1
4871 IF RIGHT$(IS$,1)="." AND IT=2 THEN ID=0
4875 IS$=LEFT$(IS$,I)
4890 GOSUB 4920:PRINT IS$;:GOTO 4810
4895 PRINT CHR$(7);:GOTO 4810
4920 LOCATE IY,IX:FOR I = 1 TO ML+1:PRINT " ";:NEXT I
4921 LOCATE IY,IX
4925 RETURN
5000 DM$="THE SKY":GOSUB 20000
REM THE SKY
5005 RECT 0,0, XLIMIT, YLIMIT, 14
5010 CX = 5:CY=4:CC = $10:FILL = 1:XS=0:YS=0:RA = 33
5011 GOSUB 3000:RA=RA-1:GOSUB 3000
REM 5020 GOSUB 3000:RA=RA-.3:GOSUB 3000:RA=RA-.5:GOSUB 3000:RA = RA+1:GOSUB 3000
5029 DM$="THE SUN":GOSUB 20000
5030 CC = $07
5038 FILL = 1: RA = 30:GOSUB 3000:FILL=0
REM BRUTE FORCE, RAYS FROM THE SUN...
5050 C=$07
5051 LINE 2,37,2,44,C
5052 LINE 6,37,6,44,C
5053 LINE 9,37,10,44,C
5054 LINE 13,36,14,43,C
5055 LINE 16,34,18,42,C
5056 LINE 18,34,21,41,C
5057 LINE 20,33,25,40,C
5058 LINE 22,29,27,37,C
5059 LINE 24,28,29,35,C
5060 LINE 27,25,32,32,C
5061 LINE 30,23,35,29,C
5062 LINE 32,21,37,26,C
5063 LINE 33,19,39,23,C
5064 LINE 35,17,41,20,C
5065 LINE 36,15,42,17,C
5066 LINE 36,15,43,15,C
5067 LINE 38,11,44,11,C
5068 LINE 38,8,45,8,C
5069 LINE 38,5,45,5,C
5070 LINE 38,1,45,2,C
REM DRAW CLOUDS AT GOSUB 6500
5095 GOSUB 6500:GOSUB 6500:GOSUB 6500:GOSUB 6500
5100 DM$="GRASS":GOSUB 20000
5110 RECT 0, 180, XLIMIT, YLIMIT, $85
5120 FOR Y = 161 TO 179
5130 LINE 0, Y, 40, 179, 105
5140 NEXT Y
5150 FOR Y = 180 TO 150 STEP -1
5160 LINE 288,179, XLIMIT, Y, 105
5170 NEXT Y
5171 COLOR 1
REM DRAW GRASS STUFF
5180 GOSUB 6000
5190 GOSUB 6000
5200 GOSUB 6000
5210 RETURN
REM RANDOM GRASS
6000 FOR I = 1 TO 35
6110 X1 = INT(RND(1)*310) + 5
6120 Y1 = INT(RND(1)*60) + 180:IF Y1 > YLIMIT THEN GOTO 6120
6130 X2 = INT(RND(1)*310) + 5:IF X2 = X1 THEN GOTO 6130
6140 Y2 = INT(RND(1)*60) + 180:IF Y2 = Y1 OR Y2 > YLIMIT THEN GOTO 6140
6145 IF X2 - X1 > 55 OR X1 - X2 > 55 THEN GOTO 6110
6146 IF Y2 - Y1 > 12 OR Y1 - Y2 > 15 THEN GOTO 6110
6150 REM GOSUB 6400:LINE X1,Y1,X2,Y2, GC
6155 PSET X1, Y1 - 1, 133:PSET X1 , Y1-1, 104:PSET X2, Y1 - 3,107
6160 GOSUB 6200:X1=X2:Y1=Y2:GOSUB 6200
6180 NEXT I
6185 FOR I = 1 TO 10:X1=INT(RND(1)*310)+5:Y1=INT(RND(1)*4)+180
6186 GOSUB 6200:NEXT I
6190 RETURN
6200 GOSUB 6400
6210 LINE X1,Y1,X1-4,Y1-5,GC:GOSUB 6400
6215 LINE X1,Y1,X1-3,Y1-3,GC:GOSUB 6400
6220 LINE X1,Y1,X1,Y1-5,GC:GOSUB 6400
6225 LINE X1,Y1,X1+3,Y1-3,GC:GOSUB 6400
6230 LINE X1,Y1,X1+4,Y1-5,GC
6235 RETURN
6400 GC=INT(RND(1)*24)+$60:RETURN
6500 REM SUPPOSED TO BE A CLOUD HERE
6501 Q1=1:Q2=1:Q3=1:Q4=1:FILL=1
6502 DM$="CLOUDS":GOSUB 20000
6540 H = INT(RND(1)*(165))+ 45
6541 HL = INT(RND(1)*30)+25
6545 V = INT(RND(1)*30) + 6
6550 VB = INT(RND(1)*11) + 7
6555 FOR Y = V TO V+VB STEP 3
6560 FOR X = H TO H + HL STEP 4
6580 RA = INT(RND(1)*5)+3
6585 CC = INT(RND(1)*4)+ $1C
6590 CX=X
6592 CY= INT(RND(1)*4) + (Y-4):IF (CY - RA) < 0 THEN 6580
6600 GOSUB 6800
6605 NEXT X
6610 NEXT Y
6615 RETURN
REM MIDPOINT CIRCLE ALGORITHM FILLED
6800 T1=RA/16:XA=RA:YA=0
6810 LINE CX+(XA),CY+(YA),CX-(XA),CY+(YA),CC
6815 LINE CX+(YA),CY+(XA),CX-(YA),CY+(XA),CC
6820 LINE CX+(XA),CY-(YA),CX-(XA),CY-(YA),CC
6825 LINE CX+(YA),CY-(XA),CX-(YA),CY-(XA),CC
6830 YA=YA+1
6835 T1=T1+YA
6840 T2=T1-XA
6845 IF T2 >= 0 THEN T1=T2:XA=XA-1
6850 IF XA>=YA THEN 6810
6855 RETURN
REM THE GALLOWS
7000 DM$="THE GALLOWS":GOSUB 20000
7010 FRAME 189,195,285,208,$10
7020 FRAME 188,194,285,211,$10
7021 LINE 189,210,285,210,$10
7022 PSET 189,209,$10
7023 PSET 284,206,$10
7024 PSET 284,209,$10
7030 FRAME 275,21,285,207,$10
7040 FRAME 276,22,284,205,$10
7050 FRAME 67,20,285,30,$10
7060 FRAME 68,21,284,29,$10
7070 RECT 71,30,79,33,$10
7080 RECT 190,196,283,209,$53
7090 RECT 277,23,283,209,$53
7100 RECT 69,22,283,28,83
7150 RETURN
REM THE ROPE
8000 DM$="THE NOOSE":GOSUB 20000
8005 FILL = 0
8010 LINE 73,33,73,53,16
8020 LINE 77,33,77,53,16
8030 RECT 74,34,76,53,87
8040 FOR Y = 38 TO 53 STEP 3
8050 LINE 73, Y, 77, Y - 3, $10
8060 NEXT Y
8070 FRAME 71,53,80, 68, 16
8080 RECT 72,54,79,68,87
8090 FOR Y = 56 TO 68 STEP 4
8100 LINE 72,Y,79, Y-4, $10
8110 NEXT Y
REM THE NOOSE
8130 RA = 24
8140 YS = .38
8150 CX = 75:CY = 79:CC=$10
8160 GOSUB 3000:RA=25:GOSUB 3000
8165 RA=24:GOSUB 3000
8166 RA =23:GOSUB 3000
8167 RA = 22:GOSUB 3000
8170 RA = 19:GOSUB 3000
8175 RA = 18:GOSUB 3000
8180 CC = 87
8190 FOR X = 20 TO 24 STEP .3
8200 RA=X:GOSUB 3000
8210 NEXT X
9000 YS=0:RETURN
REM END ROPE
REM THE FACE
9500 DM$="A TROUBLED FACE":GOSUB 20000
REM HIS EARS
9501 CX=58:CY=60:RA=6:XS=.4:CC=$10
9505 Q1=1:Q2=0:Q3=1:Q4=0
9510 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9520 FILL=1:CC=$25:GOSUB 3000
9530 FILL=0:CX=90:RA=6:CC=$10
9531 Q1=0:Q2=1:Q3=0:Q4=1
9540 GOSUB 3000:RA=7:GOSUB 3000
9550 RA = RA-1:FILL=1:CC=$25:GOSUB 3000
9555 Q1=1:Q2=Q1:Q3=Q1:Q4=Q1
REM DRAW HIS NECK
9560 LINE 67,76,67,84,$10
9570 LINE 66,76,66,84,$10
9580 LINE 67,87,67,90,$10:LINE 66,87,66,90,$10
9590 LINE 82,76,82,84,$10
9600 LINE 83,76,83,84,$10
9605 LINE 82,87,82,90,$10:LINE 83,87,83,90,$10
9610 RECT 68,76,81,84,$25
9620 RECT 68,89,81,90,$25
REM END NECK
9630 RA=20:XS=.8:FILL=0
9640 CC=$10:CX=74:CY=63
9650 GOSUB 3000:RA = RA -1:GOSUB 3000
9660 RA=RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9665 CY=CY-1:GOSUB 3000:CY=CY-1:GOSUB 3000:CY=CY+2
9666 FILL=1:GOSUB 3000
9670 CC=$FF:FILL=1:CY = CY+1:GOSUB 3000
9680 XS = 1:YS = XS
REM RIGHT EYE
9690 CY=CY-6:CX = CX-6:RA=3:CC=$FE:GOSUB 6800
9700 PSET CX+4,CY,$FF:GOSUB 9950
REM LEFT EYE
9710 CX = CX + 12:GOSUB 6800
9720 PSET CX+4,CY,$FF:GOSUB 9950:CX = 74:CY = 63
9730 LINE CX-1,CY, CX - 2, CY + 6, $10
9740 LINE CX+1,CY, CX + 2, CY + 6, $10
9750 LINE CX,CY,CX -1, CY + 6, $23
9760 LINE CX,CY,CX + 1, CY + 6, $23
9770 LINE CX,CY+3,CX,CY+6,$22
9780 Q3=0:Q4=0:CC=$10:CY = CY + 13:YS=.35:RA=6:FILL=0
9790 GOSUB 3000
9800 CY = CY + 1:CC=$31:GOSUB 3000
9805 CY = CY + 1:CC=$10:GOSUB 3000
REM REMEMBER TO TURN CIRCLE FULLY ON !!!
9806 Q3=1:Q4=1:YS=0
9810 RETURN
REM THE PUPILS
9950 PSET CX,CY, $10:PSET CX -1,CY,$10
9955 PSET CX,CY -1,$10:PSET CX - 1, CY -1 ,$10
9960 RETURN
REM END FACE
REM THE TORSO
10000 DM$="TORSO":GOSUB 20000
10001 LINE 82,90,105,93,$10
10005 LINE 83,91,105,94,$10
10010 LINE 68,90,42,93, $10
10015 LINE 69,91,42,94, $10
10020 LINE 67,90,74,105,$10
10025 LINE 83,90,74,105,$10
REM THIS FOR LOOP FILLS IN THE NECKLINE
10030 FOR X = 81 TO 68 STEP -1
10035 LINE 75,103,X, 90, $25
10040 NEXT X
10053 LINE 74,105,72,110,$10
10054 LINE 72,110,72,141,$10
10055 LINE 72,141,53,144,$10
10060 LINE 53,144,53,108,$10
10065 RECT 71,140,54,103,$08
10066 LINE 54,141,68,141,$08
10067 LINE 54,142,62,142,$08
10068 LINE 54,143,56,143,$08
10069 PSET 65,91,$10
10070 LINE 72,102,72,108,$08
10071 LINE 73,104,73,106,$08
10072 PSET 74,109,$08
10073 RECT 47,107,68,94,$08
10074 RECT 69,96,69,99,$08
10076 RECT 42,107,48,95,$08
10077 LINE 56,93,67,93, $08:PSET 55,92,$10:PSET 64,91,$10
10078 LINE 65,92,67,92, $08
10079 RECT 68,100,71,102,$08
10080 LINE 70,98,70,100, $08
10090 RECT 73,110,91,140,$08
10095 RECT 75,105,91,109,$08
10120 RECT 88, 94, 101, 106, $08
10125 RECT 81, 95, 105, 106, $08
10130 LINE 80, 96, 80, 105, $08
10135 LINE 79,98,79,105, $08
10140 LINE 78,100,78,105,$08
10145 LINE 77,101,77,105,$08
10150 LINE 76,103,76,105,$08
10155 LINE 74,103,75,103, $10
10160 PSET 76,101,$10:PSET 73,101,$10:PSET 72,99,$10:PSET 71,97,$10
10165 PSET 70,95,$10:PSET 69,93,$10:PSET 81,92,$10:PSET 80,94,$10
10166 PSET 80,96,$10:PSET 78,97,$10:PSET 77,99,$10
10167 LINE 76,100,76,103,$10
10175 RECT 82, 94, 93, 93, $08
10180 LINE 83, 92, 86, 92, $08
10185 LINE 74, 107,74, 108,$08
10190 PSET 73,109,$10
10195 PSET 73,141,$10
10200 LINE 76,141,91,141,$08
10205 LINE 81,142,91,142,$08
10210 LINE 89,143,91,143,$08
10360 LINE 74,141,92,144,$10
10365 LINE 92,144,92,107,$10
REM STRAY PIXEL AT WAISTLINE
12366 PSET 73,141,$10
REM SHIRT BUTTONS
10370 CC = 16:RA = 1
10375 CX = 76:FILL = 1
10385 FOR CY = 112 TO 142 STEP 8
10390 GOSUB 3000
10400 NEXT CY
REM POCKET AND PRISONER NUMBER
10410 LINE 58,108,68,108,$10
10415 LINE 58,108,58,116,$10
10420 LINE 68,108,68,116,$10
10425 Q1=0:Q2=0:Q3=1:Q4=1:RA=4.5:XS=0:YS=.6
10430 CX = 63:CY=116:CC=$10:FILL=0
10435 GOSUB 3000
10436 PN$="P-1"
10440 CHAR 57,106,$10,PN$
10600 RETURN
REM ARM ON THE RIGHT (LEFT ARM)
11000 Q1=0:Q2=1:Q3=0:Q4=0:FILL = 0
11005 DM$="LEFT ARM":GOSUB 20000
11010 XSQUISH = .52
11020 RA = 16:CC=$10
11030 CY = 116:CX = 92
11035 GOSUB 3000:RA=RA+.6
11040 GOSUB 3000
11060 RA=RA-1:GOSUB 3000
11090 XSQUISH=.28:CX = 106:CY = 105:FILL=0
11095 GOSUB 3000
11096 FOR L = 1 TO 3:RA=RA+.5:GOSUB 3000:NEXT L
11100 CC = $08:Q1=0:Q2=1:Q3=0:Q4=0
11105 FOR RA = 14 TO 12 STEP -.7
11110 GOSUB 3000:IF RA =12 THEN Q1=1
11115 NEXT RA
11116 RECT CX-1,CY-3,CX+2,CY-7,$08
11120 LINE 99,113,99,133,$10
11130 LINE 111,102,111,133,$10
11135 RECT 100,102,110,133,$08
11140 LINE 99,107,99,109,$08
11145 LINE 98,108,101,108,$08
11150 LINE 97,107,100,107,$08 :PSET 94,107,$0E
11155 LINE 99,134,111,134,$10
REM (THE LEFT HAND)
11160 LINE 101,134,101,143,$10
11165 LINE 101,143,103,143,$10
11166 LINE 102,142,102,139,$25
11170 LINE 103,144,103,140,$10
11175 LINE 103,145,105,145,$10
11176 LINE 104,144,104,139,$25
11180 LINE 105,146,105,140,$10
11185 LINE 105,146,107,146,$10
11186 LINE 106,145,106,139,$25
11190 LINE 107,146,107,140,$10
11195 LINE 107,145,109,145,$10
11196 LINE 108,144,108,139,$25
11200 LINE 109,145,109,134,$10
11205 RECT 102,139,108,135,$25
11210 RETURN
REM ARM ON THE LEFT (RIGHT ARM)
12000 Q1=1:Q2=0:Q3=0:Q4=0:FILL = 0
12010 XSQUISH = .52
12020 RA = 16:CC=$10
12030 CY = 118:CX = 54
12031 DM$="RIGHT ARM":GOSUB 20000
12035 GOSUB 3000:RA=RA+.6
12040 GOSUB 3000
12060 RA=RA-1:GOSUB 3000
12090 XSQUISH=.43:CX = 42:CY = 105:FILL=0
12095 GOSUB 3000
12096 FOR L = 1 TO 3:RA=RA+.3:GOSUB 3000:NEXT L
12100 CC = $08:Q1=1:Q2=0:Q3=0:Q4=0
12105 FOR RA = 14 TO 12 STEP -.7
12110 GOSUB 3000:IF RA =12 THEN Q1=1
12115 NEXT RA
12116 RECT CX-4,CY-8,CX+3,CY+6,$08
12117 RECT CX-4,CY-4,CX,CY+6,$08
12120 LINE 34,102,34,133,$10
12130 LINE 46,115,46,133,$10
12135 RECT 35,102,45,133,$08
12136 LINE 34,134,46,134,$10
12140 LINE 46,CY,46,CY+6,$08
12142 LINE 47,CY,47,CY+5,$08
12145 RECT 47,CY,49,CY+3,$08
12150 LINE 51,CY+4,52,CY+4,$0E
12155 PSET 48,CY+4, $08
REM (THE LEFT HAND)
12160 LINE 44,134,44,143,$10
12165 LINE 44,143,42,143,$10
12166 LINE 43,142,43,139,$25
12170 LINE 42,140,42,145,$10
12175 LINE 42,145,40,145,$10
12176 LINE 41,144,41,139,$25
12180 LINE 40,146,40,140,$10
12185 LINE 40,146,38,146,$10
12186 LINE 39,145,39,139,$25
12190 LINE 38,146,38,140,$10
12195 LINE 38,145,36,145,$10
12196 LINE 37,144,37,139,$25
12200 LINE 36,145,36,134,$10
12205 RECT 43,139,37,135,$25
12210 RETURN
REM RIGHT LEG
12500 Q1=1:Q2=0:Q3=0:Q4=0
12505 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12506 DM$="RIGHT LEG":GOSUB 20000
12510 GOSUB 3000
12515 LINE 70,159,70,192,$10
12520 LINE 55,145,53,192,$10
12525 LINE 53,193,70,193,$10
12530 RECT 56,145,69,192,$46
12535 LINE 55,157,55,192,$46
12540 LINE 54,181,54,192,$46
12555 LINE 57,144,71,144,$46
12560 RECT 69,142,71,154,$46
12565 RECT 72,142,73,153,$46
12570 LINE 63,143,68,143,$46
12575 PSET 70,155,$46
REM THE FOOT
12580 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1:CX=62:CY=208
12585 GOSUB 3000:RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12590 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12591 RA = RA + 1:CC=$12:FILL=0:GOSUB 3000
12595 LINE 57,193,57,202,$10
12600 LINE 66,193,66,202,$10
12605 RECT 58,194,65,200,$1C
12610 RETURN
REM LEFT LEG
12620 Q1=0:Q2=1:Q3=0:Q4=0
12625 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12626 DM$="LEFT LEG":GOSUB 20000
12630 GOSUB 3000
12635 LINE 77,157,77,192,$10
12640 LINE 90,145,92,192,$10
12645 LINE 77,193,92,193,$10
12650 RECT 78,145,89,192,$46
12655 LINE 90,157,90,192,$46
12660 LINE 91,181,91,192,$46
12665 LINE 74,144,88,144,$46
12670 RECT 76,143,79,154,$46
12675 RECT 74,142,76,153,$46
12680 LINE 74,143,82,143,$46
12685 LINE 77,154,77,156,$46
REM THE FOOT
12690 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1
12695 CX=85:CY=208
12700 GOSUB 3000
12705 RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12710 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12715 RA = RA + 1:CC=$12:FILL=0:GOSUB 3000
12720 LINE 80,193,80,202,$10
12725 LINE 89,193,89,202,$10
12730 RECT 81,194,88,200,$1C
12740 RETURN
REM THIS ROUTINE SAVES THE SCREEN TO "BG.DAT" FOR
REM SUBSEQUENT BVLOAD. TESTED AND WORKS
REM NOT CURRENTLY USED. VERY SLOW
15000 OPEN 8,8,8,"BG.DAT,S,W"
15010 FOR P = 0 TO 65535
15020 PRINT#8,CHR$(VPEEK(0,P));
15021 PRINT ST,P
15030 NEXT P
15040 FOR P = 0 TO 11264
15050 PRINT#8,CHR$(VPEEK(1,P));
15051 PRINT ST,P,
15060 NEXT P
15070 CLOSE 8
15080 RETURN
REM PLACE A MESSAGE ON THE BOTTOM OF THE SCREEN
20000 DM$="DRAWING: "+DM$
20010 COLOR 1,0:GOSUB 20100
20015 LOCATE 30,2:PRINT DM$;
20020 RETURN
20100 LOCATE 30,2:PRINT RPT$(32,35);
20101 RETURN
REM BIGWORD ROUTINE.. READS ROM FONT AND BLOWS IT UP
39600 L = LEN(WD$)
39660 SX = X
39665 OB=PEEK(1)
39670 BANK PEEK(0),6
39675 FOR K = 1 TO L
39680 CC=ASC(MID$(WD$,K,1))
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
39685 IF (CC>=64 AND CC<=90) OR (CC>=193 AND CC<=218) THEN AA=64:GOTO 39695
39690 AA = 0
39695 CA = $C000 + 8*(CC-AA)
39700 FOR I = 1 TO 8
39710 CM(I) = PEEK(CA+(I-1)):CM$(I)=""
39715 NEXT I
39720 IF DC$="" THEN DC$=CHR$(CC)
39725 FOR J = 1 TO 8
39730 RESTORE 50200
39735 FOR CT = 1 TO 8
39740 READ CP
39745 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+DC$:GOTO 39755
39750 CM$(J)=CM$(J)+CHR$(32)
39755 NEXT CT
39760 LOCATE Y+(J-1),X:IF UC=1 THEN COLOR TC%(1,J),TC%(2,J)
39765 PRINT CM$(J);
39770 NEXT J
39775 IF DC$=CHR$(CC) THEN DC$=""
39780 X=X+8
39785 NEXT K
39790 X=SX
39795 BANK PEEK(0),OB
39800 RETURN
REM SET PALLETTE ENTRY P1 TO R%,G%,B%
40000 VPOKE 1,$FA00+(P1*2),(G%*16) + B%
40010 VPOKE 1,$FA00+((P1*2)+1),R%
40020 RETURN
REM READ PALLETTE ENTRY AT P1
REM RETURNED IN %R,%G,%B
40100 A1 = $FA00+(P1*2)
40105 R% = VPEEK(1,A1+1)
40110 GB%= VPEEK(1,A1)
40115 G% = GB%/16
40120 B% = GB% AND $0F
40125 RETURN
REM FADE P2 FROM CURRENT COLOR TO P1 COLOR, J IS JIFFY DELAY
40200 GOSUB 40100
40205 P3=P1
40210 P1=P2
40215 GOSUB 40300
40220 P1=P3
40225 RETURN
REM FADE P1 TO R%,G%,B%, J IS JIFFY DELAY
40300 DR%=R%:DG%=G%:DB%=B%
40305 GOSUB 40100
40310 RI=1:IF DR%<R% THEN RI=-1
40315 GI=1:IF DG%<G% THEN GI=-1
40320 BI=1:IF DB%<B% THEN BI=-1
40325 IF DR%<>R% THEN R%=R%+RI
40330 IF DG%<>G% THEN G%=G%+GI
40335 IF DB%<>B% THEN B%=B%+BI
40340 GOSUB 40000
40345 SLEEP J
40350 IF DR%=R% AND DG%=G% AND DB%=B% THEN 40360
40355 GOTO 40325
40360 RETURN
REM SWAP PALLETTE COLORS AT P1 & P2
40500 A1 = $FA00+(P1*2)
40505 A2 = $FA00+(P2*2)
40510 B1 = VPEEK (1,A1)
40515 B2 = VPEEK (1,A1+1)
40520 B3 = VPEEK (1,A2)
40525 B4 = VPEEK (1,A2+1)
40530 VPOKE 1, A1, B3
40535 VPOKE 1, A1+1, B4
40450 VPOKE 1, A2, B1
40455 VPOKE 1, A2+1, B2
40560 RETURN
REM COPY P1 PALLETTE ENTRY TO P2.. P1 IS LEFT UNCHANGED.
41000 VPOKE 1,$FA00+(P2*2), VPEEK(1, $FA00+(P1*2))
41010 VPOKE 1,$FA00+(P2*2)+1, VPEEK(1, $FA00+(P1*2)+1)
41020 RETURN
REM LOOP THROUGH THE PALLETTE ADDRESS SPACE
REM AND POKE THE VERA DEFAULT PALLETTE
45000 RESTORE 50000
45020 FOR PE = $FA00 TO $FBFE STEP 2
45025 READ R:READ GB
45030 VPOKE 1,PE,GB
45035 VPOKE 1,PE+1, R
45040 NEXT PE
45050 RETURN
REM DEFAULT VERA PALLETTE AS DATA. FROM 0 TO 255 (2 BYTES EACH ENTRY)R,GB
50000 DATA 0,0,15,255,8,0,10,254,12,76,0,197,0,10,14,231,13,133,6,64,15,119,3
50005 DATA 51,7,119,10,246,0,143,11,187,0,0,1,17,2,34,3,51,4,68,5,85,6,102,7
50010 DATA 119,8,136,9,153,10,170,11,187,12,204,13,221,14,238,15,255,2,17,4,51
50015 DATA 6,68,8,102,10,136,12,153,15,187,2,17,4,34,6,51,8,68,10,85,12,102,15
50020 DATA 119,2,0,4,17,6,17,8,34,10,34,12,51,15,51,2,0,4,0,6,0,8,0,10,0,12,0
50025 DATA 15,0,2,33,4,67,6,100,8,134,10,168,12,201,15,235,2,17,4,50,6,83,8
50030 DATA 116,10,149,12,182,15,215,2,16,4,49,6,81,8,98,10,130,12,163,15,195,2
50035 DATA 16,4,48,6,64,8,96,10,128,12,144,15,176,1,33,3,67,5,100,7,134,9,168
50040 DATA 11,201,13,251,1,33,3,66,4,99,6,132,8,165,9,198,11,247,1,32,2,65,4
50045 DATA 97,5,130,6,162,8,195,9,243,1,32,2,64,3,96,4,128,5,160,6,192,7,240,1
50050 DATA 33,3,67,4,101,6,134,8,168,9,202,11,252,1,33,2,66,3,100,4,133,5,166
50055 DATA 6,200,7,249,0,32,1,65,1,98,2,131,2,164,3,197,3,246,0,32,0,65,0,97,0
50060 DATA 130,0,162,0,195,0,243,1,34,3,68,4,102,6,136,8,170,9,204,11,255,1,34
50065 DATA 2,68,3,102,4,136,5,170,6,204,7,255,0,34,1,68,1,102,2,136,2,170,3
50070 DATA 204,3,255,0,34,0,68,0,102,0,136,0,170,0,204,0,255,1,18,3,52,4,86,6
50075 DATA 104,8,138,9,172,11,207,1,18,2,36,3,70,4,88,5,106,6,140,7,159,0,2,1
50080 DATA 20,1,38,2,56,2,74,3,92,3,111,0,2,0,20,0,22,0,40,0,42,0,60,0,63,1,18
50085 DATA 3,52,5,70,7,104,9,138,11,156,13,191,1,18,3,36,4,54,6,72,8,90,9,108
50090 DATA 11,127,1,2,2,20,4,22,5,40,6,42,8,60,9,63,1,2,2,4,3,6,4,8,5,10,6,12
50095 DATA 7,15,2,18,4,52,6,70,8,104,10,138,12,156,15,190,2,17, 4,35,6,53,8,71
50100 DATA 10,89,12,107,15,125,2,1,4,19,6,21,8,38,10,40,12,58,15,60,2,1,4,3,6
50105 DATA 4,8,6,10,8,12,9,15,11
REM BITMAP VALUES FOR READING FONTS.
REM 50200 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
REM 50205 DATA %00000010,%00000001,%00000000
50200 DATA 128,64,32,16,8,4,2,1,0
REM MUSIC FROM MOOINGLEMUR
50300 DATA "O4V63I0CO3V50I18CV50I18E-V50I18G",60,"O4CO3E-G-B-",45,"O4C",15
50305 DATA "O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60,"O4CO3E-G-B-",45
50310 DATA "O4C",15,"O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60
50315 DATA "O4CO3E-G-B-",45,"O4C",15,"O4CO3CE-G",60,"O4E-O3E-G-B-",45,"O4D",12
50320 DATA "E-",3,"O4DO3CE-G",45,"O4C",15,"O4CO3E-G-B-",45,"O4C",15
50325 DATA "O4CO3CE-G",60,"RE-G-B-",60,"",0
REM SETUP INITIAL VARIABLES
59000 XLIMIT=319:YLIMIT=239:
59001 PI=3.1416:HP=PI/2
59002 X=RND(-TI):FMINIT
REM LOAD DEFAULT PALLETTE INIT VERA
59005 GOSUB 45000
REM SET PRETTY FONT
59007 POKE$30C,4:SYS$FF62
REM Q1-Q4 ARE INITIALIZED FOR CIRCLE DRAWING ROUTINE AT 3000
59020 Q1=1:Q2=1:Q3=1:Q4=1
REM MAX LENGTH OF WORD AND CLUE
59025 MW% = 20
59030 MC% = 35
REM INITIALIZE THE ALPHABET
59035 GOSUB 59500
REM CRAZY PALLETTE COLORS FOR EYE PULSE ROUTINE
59040 EC%(1)=$2D
59045 FOR I = 2 TO 7:EC%(I)=$27+I:NEXT I
59046 EC%(8)=$F8
59050 FOR I = 8 TO 14:EC%(I)=$35+I:NEXT I
59055 EC%(15)=$14
59200 RETURN
REM SET MY PALLETTE COLORS I AM GOING TO ANIMATE LATER
REM COPY FLESH COLOR ALSO TO $FF
59300 P1=$25:P2=$FF:GOSUB 41000
REM COPY PURE WHITE ALSO TO $FE
59305 P1=1:P2=$FE:GOSUB 41000
REM RED TO $FD
59310 P1=$3B:P2=$FD:GOSUB 41000
59400 RETURN
REM INITIALIZE AN ARRAY TO HOLD THE ALPHABET
REM USING ASCII VALUES INSTEAD OF STRING
REM WITH A FLAG TO SHOW IF THE LETTERS BEEN USED
59500 FOR I=65 TO 90
59505 AL%(1,I-64)=0:AL%(2,I-64)=I
59510 NEXT I
59515 RETURN
REM FLUSH KEYBOARD BUFFER AND WAIT FOR KEYPRESS
63000 GET X$:IF X$<>"" THEN 63000
63010 GET X$:IF X$="" THEN 63010
63020 RETURN
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH
Its past time to make this an actual playable Game.
I've only got another few days to meet my Self Imposed Goal
I've only got another few days to meet my Self Imposed Goal
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
FIXED STUFF NEW CIRCLE BROKE.
Ok. Not a lot of change here but a couple things.
The New CIRCLE algorithm is quite a bit quicker. And I saved a little RAM by
eliminating PI and HP (Half PI) variables I no longer needed.
It differed in precision from the SIN/COS enough to introduce some undesirable artifacts
in my Drawing. I've got that all fixed. And the FACE & SHOES Draw much faster now.
Been plunking away early morning. I hoped to incorporate the LETTER Control Panel into
the screen, but not enough time. I have to get ready for work now.
Be back soon. (If you want to skip the Intro add
paste the code.
The New CIRCLE algorithm is quite a bit quicker. And I saved a little RAM by
eliminating PI and HP (Half PI) variables I no longer needed.
It differed in precision from the SIN/COS enough to introduce some undesirable artifacts
in my Drawing. I've got that all fixed. And the FACE & SHOES Draw much faster now.
Been plunking away early morning. I hoped to incorporate the LETTER Control Panel into
the screen, but not enough time. I have to get ready for work now.
Be back soon. (If you want to skip the Intro add
21 GOTO 2640after you
paste the code.
Code: Select all
10 SCREEN $80
15 DIM EC%(15):DIM TC%(2,8):DIM AL%(4 ,26)
20 GOSUB 59000 : REM INITIALIZE ALL VARIABLES
40 RECT 0,0,319,239,$3B
45 RECT 3,3,316,236,$10:GOSUB 1000
50 DC$=CHR$(228):GOSUB 180
55 DC$=CHR$(162):GOSUB 180
60 REM GOSUB TO MAKE 166 TO SOLID BLOCK CHAR
65 DC$=CHR$(113):GOSUB 180
70 CHAR 75,165,$A9,CHR$($0C)+"THE CLASSIC WORD GAME"
75 CHAR 62,180,$AB,CHR$($0C)+"NOW ON THE COMMANDER X16"
80 CHAR 4,222,1,"CODED IN BASIC"
85 CHAR 4,232,1,"2023.. ANTHONY HENRY"
86 CHAR 185,222,1,"MUSIC CONTRIBUTED BY"
87 CHAR 205,232,1,"MOOINGLEMUR"
90 GOSUB 270:GOSUB 300
95 RESTORE 50300:GW=0
100 READ PS$,DL
105 IF DL=0 THEN 95
110 FMCHORD 0,PS$
115 FOR I=1 TO DL
120 GET X$
125 IF X$ <>"" THEN GW=1
130 GOSUB 275
135 NEXT I
140 IF GW=1 THEN GW=0:GOTO 150
145 GOTO 100
150 FOR X = 1 TO 31
160 LOCATE 1,1:PRINT CHR$(145)
161 READ PS$,DL:IF DL=0 THEN RESTORE 50300:GOTO 161
162 FMCHORD 0,PS$
166 FOR I = 1 TO DL:GOSUB 275:NEXT I
170 NEXT X
171 READ PS$,DL
172 IF DL=0 THEN 178
173 FMCHORD 0,PS$
174 SLEEP DL
175 GOTO 171
178 FMINIT
179 GOTO 2640
180 X = 5:Y=2:UC=1:WD$="Hang"
185 GOSUB 39600
190 X=8:Y=11:WD$="Man"
195 GOSUB 39600
200 RETURN
REM PALLETTE ANIMATION FOR TITLE SCREEN
270 P1=13
275 IF P1=2 THEN P2=13:GOTO 285
280 P2 = P1 - 1
285 GOSUB 40500
290 P1 = P1 - 1:IF P1<2 THEN P1=13
295 RETURN
REM DRAW STICK FIGURE HANGMAN
300 LINE 180,210,300,210,$53
311 LINE 180,209,299,209,$53
320 LINE 300,210,300,17,$53
321 LINE 299,209,299,18,$53
325 LINE 300,17,100,17,$53
326 LINE 299,18,100,18,$53
400 LINE 102,19,102,38,$57
405 FILL=0:CC=$57:YS=.4:XS=0:RA=13:CX=102:CY=45
410 GOSUB 3000
425 YS=0:XS=.8:CY=35:RA=10:CC=$25:FILL=1:GOSUB 3000
426 CX=CX-3:RA=2:CY=CY-2:CC=2:GOSUB 3000:CX=CX+6:GOSUB 3000
430 LINE 102,44,102,49,$25
435 LINE 102,51,102,78,$25
440 LINE 102,53,88,64,$25
445 LINE 102,53,116,64,$25
450 LINE 102,78,87,99,$25
455 LINE 102,78,117,99,$25
500 RETURN
1000 R%=15:G%=0:B%=2
1005 P1=$3B:P2=10:GOSUB 41000
1006 P1=1:P2=11:GOSUB 41000
1007 P1=$C7:P2=12:GOSUB 41000
1008 P1=$A0:P2=13:GOSUB 41000
1010 FOR I= 2 TO 9
1015 TC%(2,I-1) = 0
1020 TC%(1,I-1) = I
1025 P1 = I:GOSUB 40000:R%=R%-1
1030 IF I/3 = INT(I/3) THEN R%=R%-1:G%=G%+1
1050 NEXT I
1090 RETURN
2640 GOSUB 45000:GOSUB 59300
REM THE BACKGROUND
2650 GOSUB 5000
REM GALLOWS
2655 GOSUB 7000
REM ROPE
2660 GOSUB 8000
REM THE HEAD AND FACE
2665 GOSUB 9500
REM TORSO
2670 GOSUB 10000
REM LEFT ARM
2675 GOSUB 11000
REM RIGHT ARM
2680 GOSUB 12000
REM RIGHT LEG
2685 GOSUB 12500
REM LEFT LEG
2690 GOSUB 12620
2695 DM$="AWAITING KEY":GOSUB 20010:GOSUB 63000
2700 GOSUB 20100
REM DEADFACE
2705 GOSUB 4000
REM PULSING EYES
2710 GOSUB 20010:GOSUB 4200
REM RESTORE DRAWING PALLETTE
2715 GOSUB 59300
2720 COLOR 1,6
2725 LOCATE 6,14:PRINT " ";
2730 LOCATE 7,14:PRINT " WORKING WORD HERE ";
2735 LOCATE 8,14:PRINT " ";
2740 DM$=" CLUE GOES HERE : ANY KEY TO END DEMO":GOSUB 20010
2745 GOSUB 63000
REM RESTORE VERA DEFAULT PALLETTE
2746 GOSUB 45000
2750 SCREEN 0:END
REM BRESHNAHM CIRCLE
REM EXTRA CODE TO ENABLE TURNING ON AND OFF QUARTERS
REM X AND Y SCALING(XS & YS) AND CLIPPING AT EDGE OF SCREEN
3000 WR=RA:X=0: D=2*(1-RA):W=INT(2*320/240)
3005 IF XS<=0 OR XS>1 THEN XS=1
3006 IF YS<=0 OR YS>1 THEN YS=1
REM WHILE WR<0
3010 IF WR < 0 THEN 3350
3020 DX=X*XS:DY=WR*YS
3080 ZX=CX-DX
3090 ZY=CY-DY
3100 AX=CX+DX
3110 AY=CY+DY
3115 IF FILL=1 THEN 3165
3118 IF ZX<0 OR ZX>XL OR ZY<0 OR ZY>YL OR Q1=0 THEN 3130
3120 PSET ZX, ZY, CC
3130 IF AX<0 OR AX>XL OR ZY<0 OR ZY>YL OR Q2=0 THEN 3140
3131 PSET AX, ZY, CC
3140 IF ZX<0 OR ZX>XL OR AY<0 OR AY>YL OR Q3=0 THEN 3150
3141 PSET ZX, AY, CC
3150 IF AX<0 OR AX>XL OR AY<0 OR AY>YL OR Q4=0 THEN 3300
3151 PSET AX, AY, CC
3160 GOTO 3300
3165 X1=ZX:X2=AX
3166 IF (Q1=0 AND Q2=O) OR X1>XL THEN 3200
3170 IF ZY<0 OR ZY>YL THEN 3200
3171 IF X1<0 THEN X1=0
3172 IF X2>XL THEN X2=XL
3176 IF Q1=0 THEN X1=CX
3177 IF Q2=0 THEN X2=CX
3180 LINE X1,ZY,X2,ZY,CC
3200 IF (Q3=0 AND Q4=0) OR ZX>XL THEN 3300
3203 IF AY<0 OR AY>YL THEN 3300
3204 IF ZX<0 THEN ZX=0
3205 IF AX>XL THEN AX=XL
3210 IF Q3=0 THEN ZX=CX
3215 IF Q4=0 THEN AX=CX
3220 LINE ZX,AY,AX,AY,CC
3300 IF (D+RA)>0 THEN WR=WR-1:D=D-W*WR-1
3310 IF X>D THEN X=X+1: D=D+2*X+1
3320 GOTO 3010
REM WEND
3350 RETURN
REM DEADFACE
4000 P1=$24:P2=$FF:J=4:GOSUB 40200
4010 P1=$3B:P2=$FE:J=4:GOSUB 40200
4011 P1=$01:J=5:GOSUB 40200
4012 P1=$3A:J=3:GOSUB 40200
4013 P1=$15:J=5:GOSUB 40200
4014 P1=$3B:J=7:GOSUB 40200
4015 P1=$23:P2=$FF:J=8:GOSUB 40200
4016 P1=$B8:J=7:GOSUB 40200
4020 P1=$BF:GOSUB 40200
4030 P1=$C0:GOSUB 40200
4100 RETURN
REM EYE PULSING WHILE WAIT FOR KEY
4200 P2=$FE
4205 GET X$:IF X$<>"" THEN 4205
4210 GET X$
4215 IF X$<>"" THEN RETURN
4220 I=INT(RND(1)*15)+1
4225 P1 = EC%(I):J=INT(RND(1)*3)+2
4230 GOSUB 40200
4235 GOTO 4210
REM IY LOCATE Y LOCATION
REM IX LOCATE X LOCATION
REM ML MAX LENGTH OF STRING TO GET (1 TO 80)
REM IT TYPE OF INPUT 1=ALPHA ONLY, 2=NUMERIC(INCLUDE 1 AND ONLY 1 DECIMAL
REM POINT)
REM 3=ALPHANUMERIC, 4=LINE INPUT(CAN INCLUDE SPACE AND
REM TAB AND PUNCTUATION MARKS)
REM IS$ THE STRING TO RETURN
REM AC ADD CHAR 1=YES
REM ID DECIMAL DONE 1=YES
REM SPECIALIZED INPUT ROUTINE
4800 GET X$:IF X$<>"" THEN 4800
4801 IS$="":ID=0
REM BEFORE INPUT BEGINS
REM RESTORE VERA DEFAULT PALLETTE
4805 GOSUB 4920
4810 GET X$:IF X$="" THEN 4810
4811 C=ASC(X$)
4815 IF WL=ML THEN
4820 AC=0
4830 IF (IT<>2 OR IT=3) AND C>=65 AND C<=90 THEN AC=1
4835 IF (IT=2 OR IT=4 OR IT=3) AND C>=48 AND C<=57 THEN AC=1
4840 IF (IT=2) AND C=46 AND ID=0 THEN AC=1:ID=1
4845 IF (IT=4) AND C=32 THEN AC = 1: REM ALLOW SPACES WHEN INPUTTING A LINE
4846 IF (IT=4) AND (C>=35 AND C<=47) THEN AC=1
4847 IF (IT=4) AND (C>=58 AND C<=63) THEN AC=1 : REM ALLOW PUNCS IN STRING.
4850 IF C=13 THEN RETURN
4855 IF AC=1 AND LEN(IS$)<ML THEN PRINT CHR$(C);:IS$=IS$+CHR$(C):GOTO 4810
4860 IF C<>20 THEN 4895
4861 IF LEN(IS$) = 0 THEN PRINT CHR$(7);
4865 IF LEN(IS$)=1 OR LEN(IS$)=0 THEN IS$="":GOSUB 4920:GOTO 4810
4870 I = LEN(IS$)-1
4871 IF RIGHT$(IS$,1)="." AND IT=2 THEN ID=0
4875 IS$=LEFT$(IS$,I)
4890 GOSUB 4920:PRINT IS$;:GOTO 4810
4895 PRINT CHR$(7);:GOTO 4810
4920 LOCATE IY,IX:FOR I = 1 TO ML+1:PRINT " ";:NEXT I
4921 LOCATE IY,IX
4925 RETURN
5000 DM$="THE SKY":GOSUB 20000
REM THE SKY
5005 RECT 0,0, XLIMIT, YLIMIT, 14
5010 P1=14:P2=$10:GOSUB 41000
5020 CX = 5:CY=4:CC = $10:FILL = 1:XS=0:YS=0:RA = 32
5025 GOSUB 3000
5029 DM$="THE SUN":GOSUB 20000
5030 CC = $07
5038 FILL = 1: RA = 30:GOSUB 3000:FILL=0
REM BRUTE FORCE, RAYS FROM THE SUN...
5050 C=$F1:P1=14:P2=C:GOSUB 41000
5051 LINE 2,37,2,44,C
5052 LINE 6,37,6,44,C
5053 LINE 9,37,10,44,C
5054 LINE 12,36,14,43,C
5055 LINE 15,35,17,42,C
5056 LINE 18,34,21,41,C
5057 LINE 20,33,24,39,C
5058 LINE 22,31,27,37,C
5059 LINE 24,28,29,35,C
5060 LINE 27,25,32,32,C
5061 LINE 30,23,35,29,C
5062 LINE 32,21,37,26,C
5063 LINE 33,19,39,23,C
5064 LINE 35,17,41,20,C
5065 LINE 36,15,43,17,C
5066 LINE 37,12,44,14,C
5067 LINE 38,10,45,11,C
5068 LINE 39,7,45,8,C
5069 LINE 39,4,45,5,C
5070 LINE 39,1,46,2,C
5071 P1=0:P2=$10:J=3:GOSUB 40200
5072 P1=7:P2=$F1:GOSUB 40200
REM DRAW CLOUDS AT GOSUB 6500
5095 GOSUB 6500:GOSUB 6500:GOSUB 6500:GOSUB 6500
5100 DM$="GRASS":GOSUB 20000
5110 RECT 0, 180, XLIMIT, YLIMIT, $85
5120 FOR Y = 161 TO 179
5130 LINE 0, Y, 40, 179, 105
5140 NEXT Y
5150 FOR Y = 180 TO 150 STEP -1
5160 LINE 288,179, XLIMIT, Y, 105
5170 NEXT Y
5171 COLOR 1
REM DRAW GRASS STUFF
5180 GOSUB 6000
5190 GOSUB 6000
5200 GOSUB 6000
5210 RETURN
REM RANDOM GRASS
6000 FOR I = 1 TO 35
6110 X1 = INT(RND(1)*310) + 5
6120 Y1 = INT(RND(1)*60) + 180:IF Y1 > YLIMIT THEN GOTO 6120
6130 X2 = INT(RND(1)*310) + 5:IF X2 = X1 THEN GOTO 6130
6140 Y2 = INT(RND(1)*60) + 180:IF Y2 = Y1 OR Y2 > YLIMIT THEN GOTO 6140
6145 IF X2 - X1 > 55 OR X1 - X2 > 55 THEN GOTO 6110
6146 IF Y2 - Y1 > 12 OR Y1 - Y2 > 15 THEN GOTO 6110
6150 REM GOSUB 6400:LINE X1,Y1,X2,Y2, GC
6155 PSET X1, Y1 - 1, 133:PSET X1 , Y1-1, 104:PSET X2, Y1 - 3,107
6160 GOSUB 6200:X1=X2:Y1=Y2:GOSUB 6200
6180 NEXT I
6185 FOR I = 1 TO 10:X1=INT(RND(1)*310)+5:Y1=INT(RND(1)*4)+180
6186 GOSUB 6200:NEXT I
6190 RETURN
6200 GOSUB 6400
6210 LINE X1,Y1,X1-4,Y1-5,GC:GOSUB 6400
6215 LINE X1,Y1,X1-3,Y1-3,GC:GOSUB 6400
6220 LINE X1,Y1,X1,Y1-5,GC:GOSUB 6400
6225 LINE X1,Y1,X1+3,Y1-3,GC:GOSUB 6400
6230 LINE X1,Y1,X1+4,Y1-5,GC
6235 RETURN
6400 GC=INT(RND(1)*24)+$60:RETURN
6500 REM SUPPOSED TO BE A CLOUD HERE
6501 Q1=1:Q2=1:Q3=1:Q4=1:FILL=1
6502 DM$="CLOUDS":GOSUB 20000
6540 H = INT(RND(1)*(165))+ 45
6541 HL = INT(RND(1)*30)+25
6545 V = INT(RND(1)*30) + 6
6550 VB = INT(RND(1)*11) + 7
6555 FOR Y = V TO V+VB STEP 3
6560 FOR X = H TO H + HL STEP 4
6580 RA = INT(RND(1)*5)+3
6585 CC = INT(RND(1)*4)+ $1C
6590 CX=X
6592 CY= INT(RND(1)*4) + (Y-4):IF (CY - RA) < 0 THEN 6580
6600 GOSUB 6800
6605 NEXT X
6610 NEXT Y
6615 RETURN
REM MIDPOINT CIRCLE ALGORITHM FILLED
6800 T1=RA/16:XA=RA:YA=0
6810 LINE CX+(XA),CY+(YA),CX-(XA),CY+(YA),CC
6815 LINE CX+(YA),CY+(XA),CX-(YA),CY+(XA),CC
6820 LINE CX+(XA),CY-(YA),CX-(XA),CY-(YA),CC
6825 LINE CX+(YA),CY-(XA),CX-(YA),CY-(XA),CC
6830 YA=YA+1
6835 T1=T1+YA
6840 T2=T1-XA
6845 IF T2 >= 0 THEN T1=T2:XA=XA-1
6850 IF XA>=YA THEN 6810
6855 RETURN
REM THE GALLOWS
7000 DM$="THE GALLOWS":GOSUB 20000
7010 FRAME 189,195,285,208,$10
7020 FRAME 188,194,285,211,$10
7021 LINE 189,210,285,210,$10
7022 PSET 189,209,$10
7023 PSET 284,206,$10
7024 PSET 284,209,$10
7030 FRAME 275,21,285,207,$10
7040 FRAME 276,22,284,205,$10
7050 FRAME 67,20,285,30,$10
7060 FRAME 68,21,284,29,$10
7070 RECT 71,30,79,33,$10
7080 RECT 190,196,283,209,$53
7090 RECT 277,23,283,209,$53
7100 RECT 69,22,283,28,83
7150 RETURN
REM THE ROPE
8000 DM$="THE NOOSE":GOSUB 20000
8005 FILL = 0
8010 LINE 73,33,73,53,16
8020 LINE 77,33,77,53,16
8030 RECT 74,34,76,53,87
8040 FOR Y = 38 TO 53 STEP 3
8050 LINE 73, Y, 77, Y - 3, $10
8060 NEXT Y
8070 FRAME 71,53,80, 68, 16
8080 RECT 72,54,79,68,87
8090 FOR Y = 56 TO 68 STEP 4
8100 LINE 72,Y,79, Y-4, $10
8110 NEXT Y
REM THE NOOSE
8130 RA = 24
8140 YS = .38
8150 CX = 75:CY = 79:CC=$10
8160 GOSUB 3000:RA=25:GOSUB 3000
8165 RA=24:GOSUB 3000
8166 RA =23:GOSUB 3000
8167 RA = 22:GOSUB 3000
8170 RA = 19:GOSUB 3000
8175 RA = 18:GOSUB 3000
8180 CC = 87
8190 FOR X = 20 TO 23 STEP .4
8200 RA=X:GOSUB 3000
8210 NEXT X
9000 YS=0:RETURN
REM END ROPE
REM THE FACE
9500 DM$="A TROUBLED FACE":GOSUB 20000
REM HIS EARS
9501 CX=58:CY=60:RA=6:XS=.4:CC=$10
9505 Q1=1:Q2=0:Q3=1:Q4=0
9510 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9520 FILL=1:CC=$25:GOSUB 3000
9530 FILL=0:CX=90:RA=6:CC=$10
9531 Q1=0:Q2=1:Q3=0:Q4=1
9540 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9550 FILL=1:CC=$25:GOSUB 3000
9551 LINE 93,58,93,62,$10
9555 Q1=1:Q2=Q1:Q3=Q1:Q4=Q1
REM DRAW HIS NECK
9560 LINE 67,76,67,84,$10
9570 LINE 66,76,66,84,$10
9580 LINE 67,87,67,90,$10:LINE 66,87,66,90,$10
9590 LINE 82,76,82,84,$10
9600 LINE 83,76,83,84,$10
9605 LINE 82,87,82,90,$10:LINE 83,87,83,90,$10
9610 RECT 68,76,81,84,$25
9620 RECT 68,89,81,90,$25
REM END NECK
9630 RA=20:XS=.8:FILL=1
9640 CC=$10:CX=74:CY=63
9650 GOSUB 3000:RA = RA - 1:GOSUB 3000
9670 RA=RA-2:CY=CY+1:CC=$FF:FILL=1:GOSUB 3000
9680 XS = 1:YS = XS
REM RIGHT EYE
9690 CY=CY-6:CX = CX-6:RA=3:CC=$FE:GOSUB 6800
9700 PSET CX+4,CY,$FF:GOSUB 9950
REM LEFT EYE
9710 CX = CX + 12:GOSUB 6800
9720 PSET CX+4,CY,$FF:GOSUB 9950:CX = 74:CY = 63
9730 LINE CX-1,CY, CX - 2, CY + 6, $10
9740 LINE CX+1,CY, CX + 2, CY + 6, $10
9750 LINE CX,CY,CX -1, CY + 6, $23
9760 LINE CX,CY,CX + 1, CY + 6, $23
9770 LINE CX,CY+3,CX,CY+6,$22
9780 Q3=0:Q4=0:CC=$10:CY = CY + 13:YS=.35:RA=6:FILL=0
9790 GOSUB 3000
9800 CY = CY + 1:CC=$31:GOSUB 3000
9805 CY = CY + 1:CC=$10:GOSUB 3000
REM REMEMBER TO TURN CIRCLE FULLY ON !!!
9806 Q3=1:Q4=1:YS=0
9810 RETURN
REM THE PUPILS
9950 PSET CX,CY,$10:PSET CX -1,CY,$10
9955 PSET CX,CY +1,$10:PSET CX - 1, CY + 1 ,$10
9960 RETURN
REM END FACE
REM THE TORSO
10000 DM$="TORSO":GOSUB 20000
10001 LINE 82,90,105,93,$10
10005 LINE 83,91,105,94,$10
10010 LINE 68,90,42,93, $10
10015 LINE 69,91,42,94, $10
10020 LINE 67,90,74,105,$10
10025 LINE 83,90,74,105,$10
REM THIS FOR LOOP FILLS IN THE NECKLINE
10030 FOR X = 81 TO 68 STEP -1
10035 LINE 75,103,X, 90, $25
10040 NEXT X
10053 LINE 74,105,72,110,$10
10054 LINE 72,110,72,141,$10
10055 LINE 72,141,53,144,$10
10060 LINE 53,144,53,108,$10
10065 RECT 71,140,54,103,$08
10066 LINE 54,141,68,141,$08
10067 LINE 54,142,62,142,$08
10068 LINE 54,143,56,143,$08
10069 PSET 65,91,$10
10070 LINE 72,102,72,108,$08
10071 LINE 73,104,73,106,$08
10072 PSET 74,109,$08
10073 RECT 47,107,68,94,$08
10074 RECT 69,96,69,99,$08
10076 RECT 42,107,48,95,$08
10077 LINE 56,93,67,93, $08:PSET 55,92,$10:PSET 64,91,$10
10078 LINE 65,92,67,92, $08
10079 RECT 68,100,71,102,$08
10080 LINE 70,98,70,100, $08
10090 RECT 73,110,91,140,$08
10095 RECT 75,105,91,109,$08
10120 RECT 88, 94, 101, 106, $08
10125 RECT 81, 95, 105, 106, $08
10130 LINE 80, 96, 80, 105, $08
10135 LINE 79,98,79,105, $08
10140 LINE 78,100,78,105,$08
10145 LINE 77,101,77,105,$08
10150 LINE 76,103,76,105,$08
10155 LINE 74,103,75,103, $10
10160 PSET 76,101,$10:PSET 73,101,$10:PSET 72,99,$10:PSET 71,97,$10
10165 PSET 70,95,$10:PSET 69,93,$10:PSET 81,92,$10:PSET 80,94,$10
10166 PSET 80,96,$10:PSET 78,97,$10:PSET 77,99,$10
10167 LINE 76,100,76,103,$10
10175 RECT 82, 94, 93, 93, $08
10180 LINE 83, 92, 86, 92, $08
10185 LINE 74, 107,74, 108,$08
10190 PSET 73,109,$10
10195 PSET 73,141,$10
10200 LINE 76,141,91,141,$08
10205 LINE 81,142,91,142,$08
10210 LINE 89,143,91,143,$08
10360 LINE 74,141,92,144,$10
10365 LINE 92,144,92,107,$10
REM STRAY PIXEL AT WAISTLINE
12366 PSET 73,141,$10
REM SHIRT BUTTONS
10370 CC = 16:RA = 1.2
10375 CX = 75:FILL = 1
10385 FOR CY = 113 TO 143 STEP 8
10390 GOSUB 3000
10400 NEXT CY
REM POCKET AND PRISONER NUMBER
10410 LINE 58,108,68,108,$10
10415 LINE 58,108,58,116,$10
10420 LINE 68,108,68,116,$10
10425 Q1=0:Q2=0:Q3=1:Q4=1:RA=4.5:XS=0:YS=.6
10430 CX = 63:CY=116:CC=$10:FILL=0
10435 GOSUB 3000
10436 PN$="P-1"
10440 CHAR 57,106,$10,PN$
10600 RETURN
REM ARM ON THE RIGHT (LEFT ARM)
11000 Q1=0:Q2=1:Q3=0:Q4=0:FILL = 0
11005 DM$="LEFT ARM":GOSUB 20000
11010 XSQUISH = .52
11020 RA = 16:CC=$10
11030 CY = 116:CX = 92
11035 GOSUB 3000:RA=RA+.6
11040 GOSUB 3000
11060 RA=RA-1:GOSUB 3000
11090 XSQUISH=.28:CX = 106:CY = 105:FILL=0
11095 GOSUB 3000
11096 FOR L = 1 TO 3:RA=RA+.5:GOSUB 3000:NEXT L
11100 CC = $08:Q1=0:Q2=1:Q3=0:Q4=0
11105 FOR RA = 14 TO 12 STEP -.7
11110 GOSUB 3000:IF RA =12 THEN Q1=1
11115 NEXT RA
11116 RECT CX-1,CY-3,CX+2,CY-7,$08
11120 LINE 99,113,99,133,$10
11130 LINE 111,102,111,133,$10
11135 RECT 100,102,110,133,$08
11140 LINE 99,107,99,109,$08
11145 LINE 98,108,101,108,$08
11150 LINE 97,107,100,107,$08 :PSET 94,107,$0E
11155 LINE 99,134,111,134,$10
REM (THE LEFT HAND)
11160 LINE 101,134,101,143,$10
11165 LINE 101,143,103,143,$10
11166 LINE 102,142,102,139,$25
11170 LINE 103,144,103,140,$10
11175 LINE 103,145,105,145,$10
11176 LINE 104,144,104,139,$25
11180 LINE 105,146,105,140,$10
11185 LINE 105,146,107,146,$10
11186 LINE 106,145,106,139,$25
11190 LINE 107,146,107,140,$10
11195 LINE 107,145,109,145,$10
11196 LINE 108,144,108,139,$25
11200 LINE 109,145,109,134,$10
11205 RECT 102,139,108,135,$25
11210 RETURN
REM ARM ON THE LEFT (RIGHT ARM)
12000 Q1=1:Q2=0:Q3=0:Q4=0:FILL = 0
12010 XSQUISH = .52
12020 RA = 16:CC=$10
12030 CY = 118:CX = 54
12031 DM$="RIGHT ARM":GOSUB 20000
12035 GOSUB 3000:RA=RA+.6
12040 GOSUB 3000
12060 RA=RA-1:GOSUB 3000
12090 XSQUISH=.43:CX = 42:CY = 105:FILL=0
12095 GOSUB 3000
12096 FOR L = 1 TO 3:RA=RA+.3:GOSUB 3000:NEXT L
12100 CC = $08:Q1=1:Q2=0:Q3=0:Q4=0
12105 FOR RA = 14 TO 12 STEP -.7
12110 GOSUB 3000:IF RA =12 THEN Q1=1
12115 NEXT RA
12116 LINE 54,107,54,109,$08
12117 RECT CX-4,CY-8,CX+3,CY+6,$08
12118 RECT CX-4,CY-4,CX,CY+6,$08
12120 LINE 34,102,34,133,$10
12130 LINE 46,115,46,133,$10
12135 RECT 35,102,45,133,$08
12136 LINE 34,134,46,134,$10
12140 LINE 46,CY,46,CY+6,$08
12142 LINE 47,CY,47,CY+5,$08
12145 RECT 47,CY,49,CY+3,$08
12150 LINE 51,CY+4,52,CY+4,$0E
12155 PSET 48,CY+4, $08
REM (THE LEFT HAND)
12160 LINE 44,134,44,143,$10
12165 LINE 44,143,42,143,$10
12166 LINE 43,142,43,139,$25
12170 LINE 42,140,42,145,$10
12175 LINE 42,145,40,145,$10
12176 LINE 41,144,41,139,$25
12180 LINE 40,146,40,140,$10
12185 LINE 40,146,38,146,$10
12186 LINE 39,145,39,139,$25
12190 LINE 38,146,38,140,$10
12195 LINE 38,145,36,145,$10
12196 LINE 37,144,37,139,$25
12200 LINE 36,145,36,134,$10
12205 RECT 43,139,37,135,$25
12210 RETURN
REM RIGHT LEG
12500 Q1=1:Q2=0:Q3=0:Q4=0
12505 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12506 DM$="RIGHT LEG":GOSUB 20000
12510 GOSUB 3000
12515 LINE 70,159,70,192,$10
12520 LINE 55,145,53,192,$10
12525 LINE 53,193,70,193,$10
12530 RECT 56,145,69,192,$46
12535 LINE 55,157,55,192,$46
12540 LINE 54,181,54,192,$46
12555 LINE 57,144,71,144,$46
12560 RECT 69,142,71,154,$46
12565 RECT 72,142,73,153,$46
12570 LINE 63,143,68,143,$46
12575 PSET 70,155,$46
REM THE FOOT
12580 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1:CX=62:CY=208
12585 GOSUB 3000:RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12590 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12591 RA = RA + 1:CC=$12:FILL=0:GOSUB 3000
12595 LINE 57,193,57,202,$10
12600 LINE 66,193,66,202,$10
12605 RECT 58,194,65,200,$1C
12610 RETURN
REM LEFT LEG
12620 Q1=0:Q2=1:Q3=0:Q4=0
12625 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12626 DM$="LEFT LEG":GOSUB 20000
12630 GOSUB 3000
12635 LINE 77,157,77,192,$10
12640 LINE 90,145,92,192,$10
12645 LINE 77,193,92,193,$10
12650 RECT 78,145,89,192,$46
12655 LINE 90,157,90,192,$46
12660 LINE 91,181,91,192,$46
12665 LINE 74,144,88,144,$46
12670 RECT 76,143,79,154,$46
12675 RECT 74,142,76,153,$46
12680 LINE 74,143,82,143,$46
12685 LINE 77,154,77,156,$46
REM THE FOOT
12690 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1
12695 CX=85:CY=208
12700 GOSUB 3000
12705 RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12710 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12715 RA = RA + 1:CC=$12:FILL=0:GOSUB 3000
12720 LINE 80,193,80,202,$10
12725 LINE 89,193,89,202,$10
12730 RECT 81,194,88,200,$1C
12740 RETURN
REM THIS ROUTINE SAVES THE SCREEN TO "BG.DAT" FOR
REM SUBSEQUENT BVLOAD. TESTED AND WORKS
REM NOT CURRENTLY USED. VERY SLOW
15000 OPEN 8,8,8,"BG.DAT,S,W"
15010 FOR P = 0 TO 65535
15020 PRINT#8,CHR$(VPEEK(0,P));
15021 PRINT ST,P
15030 NEXT P
15040 FOR P = 0 TO 11264
15050 PRINT#8,CHR$(VPEEK(1,P));
15051 PRINT ST,P,
15060 NEXT P
15070 CLOSE 8
15080 RETURN
REM PLACE A MESSAGE ON THE BOTTOM OF THE SCREEN
20000 DM$="DRAWING: "+DM$
20010 COLOR 1,0:GOSUB 20100
20015 LOCATE 30,2:PRINT DM$;
20020 RETURN
20100 LOCATE 30,2:PRINT RPT$(32,35);
20101 RETURN
REM BIGWORD ROUTINE.. READS ROM FONT AND BLOWS IT UP
39600 L = LEN(WD$)
39660 SX = X
39665 OB=PEEK(1)
39670 BANK PEEK(0),6
39675 FOR K = 1 TO L
39680 CC=ASC(MID$(WD$,K,1))
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
39685 IF (CC>=64 AND CC<=90) OR (CC>=193 AND CC<=218) THEN AA=64:GOTO 39695
39690 AA = 0
39695 CA = $C000 + 8*(CC-AA)
39700 FOR I = 1 TO 8
39710 CM(I) = PEEK(CA+(I-1)):CM$(I)=""
39715 NEXT I
39720 IF DC$="" THEN DC$=CHR$(CC)
39725 FOR J = 1 TO 8
39730 RESTORE 50200
39735 FOR CT = 1 TO 8
39740 READ CP
39745 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+DC$:GOTO 39755
39750 CM$(J)=CM$(J)+CHR$(32)
39755 NEXT CT
39760 LOCATE Y+(J-1),X:IF UC=1 THEN COLOR TC%(1,J),TC%(2,J)
39765 PRINT CM$(J);
39770 NEXT J
39775 IF DC$=CHR$(CC) THEN DC$=""
39780 X=X+8
39785 NEXT K
39790 X=SX
39795 BANK PEEK(0),OB
39800 RETURN
REM SET PALLETTE ENTRY P1 TO R%,G%,B%
40000 VPOKE 1,$FA00+(P1*2),(G%*16) + B%
40010 VPOKE 1,$FA00+((P1*2)+1),R%
40020 RETURN
REM READ PALLETTE ENTRY AT P1
REM RETURNED IN %R,%G,%B
40100 A1 = $FA00+(P1*2)
40105 R% = VPEEK(1,A1+1)
40110 GB%= VPEEK(1,A1)
40115 G% = GB%/16
40120 B% = GB% AND $0F
40125 RETURN
REM FADE P2 FROM CURRENT COLOR TO P1 COLOR, J IS JIFFY DELAY
40200 GOSUB 40100
40205 P3=P1
40210 P1=P2
40215 GOSUB 40300
40220 P1=P3
40225 RETURN
REM FADE P1 TO R%,G%,B%, J IS JIFFY DELAY
40300 DR%=R%:DG%=G%:DB%=B%
40305 GOSUB 40100
40310 RI=1:IF DR%<R% THEN RI=-1
40315 GI=1:IF DG%<G% THEN GI=-1
40320 BI=1:IF DB%<B% THEN BI=-1
40325 IF DR%<>R% THEN R%=R%+RI
40330 IF DG%<>G% THEN G%=G%+GI
40335 IF DB%<>B% THEN B%=B%+BI
40340 GOSUB 40000
40345 SLEEP J
40350 IF DR%=R% AND DG%=G% AND DB%=B% THEN 40360
40355 GOTO 40325
40360 RETURN
REM SWAP PALLETTE COLORS AT P1 & P2
40500 A1=$FA00+(P1*2):A2=$FA00+(P2*2)
40510 B1=VPEEK(1,A1):B2=VPEEK(1,A1+1)
40520 B3=VPEEK(1,A2):B4=VPEEK(1,A2+1)
40530 VPOKE 1,A1,B3:VPOKE 1,A1+1, B4
40450 VPOKE 1,A2,B1:VPOKE 1,A2+1, B2
40560 RETURN
REM COPY P1 PALLETTE ENTRY TO P2.. P1 IS LEFT UNCHANGED.
41000 VPOKE 1,$FA00+(P2*2), VPEEK(1, $FA00+(P1*2))
41010 VPOKE 1,$FA00+(P2*2)+1, VPEEK(1, $FA00+(P1*2)+1)
41020 RETURN
REM LOOP THROUGH THE PALLETTE ADDRESS SPACE
REM AND POKE THE VERA DEFAULT PALLETTE
45000 RESTORE 50000
45020 FOR PE=$FA00 TO $FBFE STEP 2
45025 READ R:READ GB
45030 VPOKE 1,PE,GB:VPOKE 1,PE+1,R
45040 NEXT PE
45050 RETURN
REM DEFAULT VERA PALLETTE AS DATA. FROM 0 TO 255 (2 BYTES EACH ENTRY)R,GB
50000 DATA 0,0,15,255,8,0,10,254,12,76,0,197,0,10,14,231,13,133,6,64,15,119,3
50005 DATA 51,7,119,10,246,0,143,11,187,0,0,1,17,2,34,3,51,4,68,5,85,6,102,7
50010 DATA 119,8,136,9,153,10,170,11,187,12,204,13,221,14,238,15,255,2,17,4,51
50015 DATA 6,68,8,102,10,136,12,153,15,187,2,17,4,34,6,51,8,68,10,85,12,102,15
50020 DATA 119,2,0,4,17,6,17,8,34,10,34,12,51,15,51,2,0,4,0,6,0,8,0,10,0,12,0
50025 DATA 15,0,2,33,4,67,6,100,8,134,10,168,12,201,15,235,2,17,4,50,6,83,8
50030 DATA 116,10,149,12,182,15,215,2,16,4,49,6,81,8,98,10,130,12,163,15,195,2
50035 DATA 16,4,48,6,64,8,96,10,128,12,144,15,176,1,33,3,67,5,100,7,134,9,168
50040 DATA 11,201,13,251,1,33,3,66,4,99,6,132,8,165,9,198,11,247,1,32,2,65,4
50045 DATA 97,5,130,6,162,8,195,9,243,1,32,2,64,3,96,4,128,5,160,6,192,7,240,1
50050 DATA 33,3,67,4,101,6,134,8,168,9,202,11,252,1,33,2,66,3,100,4,133,5,166
50055 DATA 6,200,7,249,0,32,1,65,1,98,2,131,2,164,3,197,3,246,0,32,0,65,0,97,0
50060 DATA 130,0,162,0,195,0,243,1,34,3,68,4,102,6,136,8,170,9,204,11,255,1,34
50065 DATA 2,68,3,102,4,136,5,170,6,204,7,255,0,34,1,68,1,102,2,136,2,170,3
50070 DATA 204,3,255,0,34,0,68,0,102,0,136,0,170,0,204,0,255,1,18,3,52,4,86,6
50075 DATA 104,8,138,9,172,11,207,1,18,2,36,3,70,4,88,5,106,6,140,7,159,0,2,1
50080 DATA 20,1,38,2,56,2,74,3,92,3,111,0,2,0,20,0,22,0,40,0,42,0,60,0,63,1,18
50085 DATA 3,52,5,70,7,104,9,138,11,156,13,191,1,18,3,36,4,54,6,72,8,90,9,108
50090 DATA 11,127,1,2,2,20,4,22,5,40,6,42,8,60,9,63,1,2,2,4,3,6,4,8,5,10,6,12
50095 DATA 7,15,2,18,4,52,6,70,8,104,10,138,12,156,15,190,2,17, 4,35,6,53,8,71
50100 DATA 10,89,12,107,15,125,2,1,4,19,6,21,8,38,10,40,12,58,15,60,2,1,4,3,6
50105 DATA 4,8,6,10,8,12,9,15,11
REM BITMAP VALUES FOR READING FONTS.
REM 50200 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
REM 50205 DATA %00000010,%00000001,%00000000
50200 DATA 128,64,32,16,8,4,2,1,0
REM MUSIC FROM MOOINGLEMUR
50300 DATA "O4V63I0CO3V50I18CV50I18E-V50I18G",60,"O4CO3E-G-B-",45,"O4C",15
50305 DATA "O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60,"O4CO3E-G-B-",45
50310 DATA "O4C",15,"O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60
50315 DATA "O4CO3E-G-B-",45,"O4C",15,"O4CO3CE-G",60,"O4E-O3E-G-B-",45,"O4D",12
50320 DATA "E-",3,"O4DO3CE-G",45,"O4C",15,"O4CO3E-G-B-",45,"O4C",15
50325 DATA "O4CO3CE-G",60,"RE-G-B-",60,"",0
REM SETUP INITIAL VARIABLES
59000 XLIMIT=319:YLIMIT=239:
59002 X=RND(-TI):FMINIT
REM LOAD DEFAULT PALLETTE INIT VERA
59005 GOSUB 45000
REM SET PRETTY FONT
59007 POKE$30C,4:SYS$FF62
REM Q1-Q4 ARE INITIALIZED FOR CIRCLE DRAWING ROUTINE AT 3000
59020 Q1=1:Q2=1:Q3=1:Q4=1
REM MAX LENGTH OF WORD AND CLUE
59025 MW% = 20
59030 MC% = 35
REM INITIALIZE THE ALPHABET
59035 GOSUB 59500
REM CRAZY PALLETTE COLORS FOR EYE PULSE ROUTINE
59040 EC%(1)=$2D
59045 FOR I = 2 TO 7:EC%(I)=$27+I:NEXT I
59046 EC%(8)=$F8
59050 FOR I = 8 TO 14:EC%(I)=$35+I:NEXT I
59055 EC%(15)=$14
59200 RETURN
REM SET MY PALLETTE COLORS I AM GOING TO ANIMATE LATER
REM COPY FLESH COLOR ALSO TO $FF
59300 P1=$25:P2=$FF:GOSUB 41000
REM COPY PURE WHITE ALSO TO $FE
59305 P1=1:P2=$FE:GOSUB 41000
REM RED TO $FD
59310 P1=$3B:P2=$FD:GOSUB 41000
REM COPY YELLOW TO $F1 FOR SUN RAYS COLOR IF I VLOAD.
59315 C=$F1:P1=14:P2=C:GOSUB 41000
59400 RETURN
REM INITIALIZE AN ARRAY TO HOLD THE ALPHABET
REM USING ASCII VALUES INSTEAD OF STRING
REM WITH A FLAG TO SHOW IF THE LETTERS BEEN USED
REM 2 DIMENSIONAL ARRAY 1,X IS FLAG, 2,X IS ASCII CODE 3&4,X is X,Y
REM FOR BUTTON POSITION ON SCREEN.
59500 FOR I=65 TO 90
59505 AL%(1,I-64)=0:AL%(2,I-64)=I
59510 NEXT I
59515 RETURN
REM FLUSH KEYBOARD BUFFER AND WAIT FOR KEYPRESS
63000 GET X$:IF X$<>"" THEN 63000
63010 GET X$:IF X$="" THEN 63010
63020 RETURN
REM SKIP INTRO
REM 21 GOTO 2640
REM JUST WORKING ON THIS AREA OF CODE AT THE MOMENT
REM SKIP ALL THE OTHER STUFF
PRINT:PRINT
PRINT FRE(0)
PRINT:PRINT
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH
No new code tonight. I've got a few things in the pipeline. But ........ So Many Projects........ So little Time.
I actually have the button control panel in the main code now. (though not called).............. I'm not a big C fan at all, but going back to this primitive Dialect of BASIC as been a chore........... The major chore as the program gets larger and larger is to make sure all the line #'s fit into the program.......
I still plan on having a minimally playable version within a week. And I plan to complete this as a viable game for distribution on this platform.........
So Since I've started this project I'm always announcing my Bedtime unto the entire X16 community.
G, nite for now................ TTYS
I actually have the button control panel in the main code now. (though not called).............. I'm not a big C fan at all, but going back to this primitive Dialect of BASIC as been a chore........... The major chore as the program gets larger and larger is to make sure all the line #'s fit into the program.......
I still plan on having a minimally playable version within a week. And I plan to complete this as a viable game for distribution on this platform.........
So Since I've started this project I'm always announcing my Bedtime unto the entire X16 community.
G, nite for now................ TTYS
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH
I'm paying close attention to RAM usage. There are still about 4 or 5 more GOSUBS to add to this and I'm hovering around 20k FRE. I think Its going to work though.
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
GAME INTERFACE IS COMING OUT
Everything I do on this game lately is an exercise in line number shuffling.
I have the game interface coming along.
You must run the demo until the end to see what I've got planned here.
I have the game interface coming along.
You must run the demo until the end to see what I've got planned here.
Code: Select all
10 SCREEN $80
15 DIM TC%(2,8):DIM AL%(4 ,26)
20 GOSUB 59000 : REM INITIALIZE ALL VARIABLES
40 RECT 0,0,319,239,$3B
45 RECT 3,3,316,236,$10:GOSUB 1000
50 DC$=CHR$(228):GOSUB 180
55 DC$=CHR$(162):GOSUB 180
60 REM GOSUB TO MAKE 166 TO SOLID BLOCK CHAR
65 DC$=CHR$(113):GOSUB 180
70 CHAR 75,165,$A9,CHR$($0C)+"THE CLASSIC WORD GAME"
75 CHAR 62,180,$AB,CHR$($0C)+"NOW ON THE COMMANDER X16"
80 CHAR 4,222,1,"CODED IN BASIC"
85 CHAR 4,232,1,"2023.. ANTHONY HENRY"
86 CHAR 185,222,1,"MUSIC CONTRIBUTED BY"
87 CHAR 205,232,1,"MOOINGLEMUR"
90 GOSUB 270:GOSUB 300
95 RESTORE 50300:GW=0
100 READ PS$,DL
105 IF DL=0 THEN 95
110 FMCHORD 0,PS$
115 FOR I=1 TO DL
120 GET X$
125 IF X$ <>"" THEN GW=1
130 GOSUB 275
135 NEXT I
140 IF GW=1 THEN GW=0:GOTO 150
145 GOTO 100
150 FOR X = 1 TO 31
160 LOCATE 1,1:PRINT CHR$(145)
161 READ PS$,DL:IF DL=0 THEN RESTORE 50300:GOTO 161
162 FMCHORD 0,PS$
166 FOR I = 1 TO DL:GOSUB 275:NEXT I
170 NEXT X
171 READ PS$,DL
172 IF DL=0 THEN 178
173 FMCHORD 0,PS$
174 SLEEP DL
175 GOTO 171
178 FMINIT
179 GOTO 2640
180 X = 5:Y=2:UC=1:WD$="Hang"
185 GOSUB 39600
190 X=8:Y=11:WD$="Man"
195 GOSUB 39600
200 RETURN
REM PALLETTE ANIMATION FOR TITLE SCREEN
270 P1=13
275 IF P1=2 THEN P2=13:GOTO 285
280 P2 = P1 - 1
285 GOSUB 40500
290 P1 = P1 - 1:IF P1<2 THEN P1=13
295 RETURN
REM DRAW STICK FIGURE HANGMAN
300 LINE 180,210,300,210,$53
311 LINE 180,209,299,209,$53
320 LINE 300,210,300,17,$53
321 LINE 299,209,299,18,$53
325 LINE 300,17,100,17,$53
326 LINE 299,18,100,18,$53
400 LINE 102,19,102,38,$57
405 FILL=0:CC=$57:YS=.4:XS=1:RA=13:CX=102:CY=45
410 GOSUB 3000
425 YS=1:XS=.8:CY=35:RA=10:CC=$25:FILL=1:GOSUB 3000
426 CX=CX-3:RA=2:CY=CY-2:CC=2:GOSUB 3000:CX=CX+6:GOSUB 3000
430 LINE 102,44,102,49,$25
435 LINE 102,51,102,78,$25
440 LINE 102,53,88,64,$25
445 LINE 102,53,116,64,$25
450 LINE 102,78,87,99,$25
455 LINE 102,78,117,99,$25
500 RETURN
1000 R%=15:G%=0:B%=2
1005 P1=$3B:P2=10:GOSUB 41000
1006 P1=1:P2=11:GOSUB 41000
1007 P1=$C7:P2=12:GOSUB 41000
1008 P1=$A0:P2=13:GOSUB 41000
1010 FOR I= 2 TO 9
1015 TC%(2,I-1) = 0
1020 TC%(1,I-1) = I
1025 P1 = I:GOSUB 40000:R%=R%-1
1030 IF I/3 = INT(I/3) THEN R%=R%-1:G%=G%+1
1050 NEXT I
1090 RETURN
2640 GOSUB 45000:GOSUB 59300
REM THE BACKGROUND
2650 GOSUB 5000
REM GALLOWS
2655 GOSUB 7000
REM ROPE
2660 GOSUB 8000
REM THE HEAD AND FACE
2665 GOSUB 9500
REM TORSO
2670 GOSUB 10000
REM LEFT ARM
2675 GOSUB 11000
REM RIGHT ARM
2680 GOSUB 12000
REM RIGHT LEG
2685 GOSUB 12500
REM LEFT LEG
2690 GOSUB 12620
2695 DM$="AWAITING KEY":GOSUB 20010:GOSUB 63000
2700 GOSUB 20100
REM DEADFACE
2705 GOSUB 4000
REM PULSING EYES
2710 GOSUB 20010:GOSUB 4200
REM RESTORE DRAWING PALLETTE
2715 GOSUB 59300
2720 COLOR 1,6
2725 LOCATE 6,14:PRINT " ";
2730 LOCATE 7,14:PRINT " WORKING WORD HERE ";
2735 LOCATE 8,14:PRINT " ";:MOUSE 1
2736 DM$=" CLUE GOES HERE : ANY KEY TO END DEMO":GOSUB 20010
2740 L=65
2745 X=131:Y=90:W=14:C1=1:C2=$17:C3=$C2:C4=$1E
2746 FRAME 123,83,261,164,$10
2747 RECT 124,84,260,163,$C0:RECT 126,87,258,161,$06
2750 SX=X
2755 FOR KK = 1 TO 3
2760 FOR J = 1 TO 7
2765 L$=CHR$(L)
2770 GOSUB 2900
2775 I=L-64
2780 AL%(1,I)=0
2785 AL%(2,I)=L
2790 AL%(3,I)=X
2795 AL%(4,I)=Y
2800 X = X + W + 4
2805 L=L+1
2810 NEXT J
2815 Y = Y + W + 4:X=SX
2820 NEXT KK
2825 X = SX
2830 FOR J = 1 TO 5
2835 L$=CHR$(L)
2840 GOSUB 2900
2845 I=L-64
2850 AL%(1,I)=0
2855 AL%(2,I)=L
2860 AL%(3,I)=X
2865 AL%(4,I)=Y
2870 X = X + W + 4
2875 L=L+1
2880 NEXT J
2885 GOSUB 63000:MOUSE 0
REM RESTORE VERA DEFAULT PALLETTE
2890 GOSUB 45000:SCREEN 1:END
REM X,Y BUTTON POSITION
REM W CURRENTLY HEIGHT AND WIDTH MAY CHANGE FOR SEPERATE HEIGHT VARIABLE
REM C1, C2 3D BORDER COLORS
REM C3 CENTER COLOR
REM C4 TEXT LABEL COLOR
REM L$ THE TEXT LABEL
REM DRAW 3-D BUTTON WITH LABEL L$ AT X,Y
2900 X1=X+1:XW=X+W:YW=Y+W:Y1=Y+1
2905 Y5=YW-1:X5=XW-1
2910 LINE X,Y,XW,Y,C1
2915 LINE X1,Y1,X5,Y1,C1
2920 LINE XW,Y,XW,YW,C1
2925 LINE X5,Y1,X5,Y5,C1
2930 LINE X,Y,X,YW,C2
2940 LINE X1,Y1,X1,Y5,C2
2950 LINE X,YW,X,YW,C2
2955 LINE X,YW,X5,YW,C2
2960 LINE X,Y5,XW-2,Y5,C2
2965 RECT X+2,Y+2,XW-2,YW-2,C3
2970 CHAR X+3,YW-3,C4,L$
2980 RETURN
REM BRESHNAHM CIRCLE
REM EXTRA CODE TO ENABLE TURNING ON AND OFF QUARTERS
REM X AND Y SCALING(XS & YS) AND CLIPPING AT EDGE OF SCREEN
REM TOOK OUT ERROR CHECKING FOR YS AND XS. * MAKE SURE CORRECT IN MAIN CODE *
3000 WR=RA:X=0: D=2*(1-RA):W=INT(2*320/240)
REM WHILE WR<0
3010 IF WR < 0 THEN 3350
3020 DX=X*XS:DY=WR*YS
3080 ZX=CX-DX
3090 ZY=CY-DY
3100 AX=CX+DX
3110 AY=CY+DY
3115 IF FILL=1 THEN 3165
3118 IF ZX<0 OR ZX>XL OR ZY<0 OR ZY>YL OR Q1=0 THEN 3130
3120 PSET ZX, ZY, CC
3130 IF AX<0 OR AX>XL OR ZY<0 OR ZY>YL OR Q2=0 THEN 3140
3131 PSET AX, ZY, CC
3140 IF ZX<0 OR ZX>XL OR AY<0 OR AY>YL OR Q3=0 THEN 3150
3141 PSET ZX, AY, CC
3150 IF AX<0 OR AX>XL OR AY<0 OR AY>YL OR Q4=0 THEN 3300
3151 PSET AX, AY, CC
3160 GOTO 3300
3165 X1=ZX:X2=AX
3166 IF (Q1=0 AND Q2=O) OR X1>XL THEN 3200
3170 IF ZY<0 OR ZY>YL THEN 3200
3171 IF X1<0 THEN X1=0
3172 IF X2>XL THEN X2=XL
3176 IF Q1=0 THEN X1=CX
3177 IF Q2=0 THEN X2=CX
3180 LINE X1,ZY,X2,ZY,CC
3200 IF (Q3=0 AND Q4=0) OR ZX>XL THEN 3300
3203 IF AY<0 OR AY>YL THEN 3300
3204 IF ZX<0 THEN ZX=0
3205 IF AX>XL THEN AX=XL
3210 IF Q3=0 THEN ZX=CX
3215 IF Q4=0 THEN AX=CX
3220 LINE ZX,AY,AX,AY,CC
3300 IF (D+RA)>0 THEN WR=WR-1:D=D-W*WR-1
3310 IF X>D THEN X=X+1: D=D+2*X+1
3320 GOTO 3010
REM WEND
3350 RETURN
REM DEADFACE
4000 P1=$24:P2=$FF:J=4:GOSUB 40200
4010 P1=$3B:P2=$FE:J=4:GOSUB 40200
4011 P1=$01:J=3:GOSUB 40200
4012 P1=$3A:J=1:GOSUB 40200
4013 P1=$15:J=3:GOSUB 40200
4014 P1=$3B:J=4:GOSUB 40200
4015 P1=$23:P2=$FF:J=6:GOSUB 40200
4016 P1=$B8:J=5:GOSUB 40200
4020 P1=$BF:GOSUB 40200
4030 P1=$C0:GOSUB 40200
4100 RETURN
REM EYE PULSING WHILE WAIT FOR KEY
4200 P1=$FE:G%=0:B%=0
4205 GET X$:IF X$<>"" THEN 4205
4210 GET X$
4215 IF X$<>"" THEN RETURN
4220 R%=RND(1)*15+1
4225 B%=RND(1)*6
4230 GOSUB 40300
4235 GOTO 4210
REM IY LOCATE Y LOCATION
REM IX LOCATE X LOCATION
REM ML MAX LENGTH OF STRING TO GET (1 TO 80)
REM IT TYPE OF INPUT 1=ALPHA ONLY, 2=NUMERIC(INCLUDE 1 AND ONLY 1 DECIMAL
REM POINT)
REM 3=ALPHANUMERIC, 4=LINE INPUT(CAN INCLUDE SPACE AND
REM TAB AND PUNCTUATION MARKS)
REM IS$ THE STRING TO RETURN
REM AC ADD CHAR 1=YES
REM ID DECIMAL DONE 1=YES
REM SPECIALIZED INPUT ROUTINE
4800 GET X$:IF X$<>"" THEN 4800
4801 IS$="":ID=0
REM BEFORE INPUT BEGINS
REM RESTORE VERA DEFAULT PALLETTE
4805 GOSUB 4920
4810 GET X$:IF X$="" THEN 4810
4811 C=ASC(X$)
4815 IF WL=ML THEN
4820 AC=0
4830 IF (IT<>2 OR IT=3) AND C>=65 AND C<=90 THEN AC=1
4835 IF (IT=2 OR IT=4 OR IT=3) AND C>=48 AND C<=57 THEN AC=1
4840 IF (IT=2) AND C=46 AND ID=0 THEN AC=1:ID=1
4845 IF (IT=4) AND C=32 THEN AC = 1: REM ALLOW SPACES WHEN INPUTTING A LINE
4846 IF (IT=4) AND (C>=35 AND C<=47) THEN AC=1
4847 IF (IT=4) AND (C>=58 AND C<=63) THEN AC=1 : REM ALLOW PUNCS IN STRING.
4850 IF C=13 THEN RETURN
4855 IF AC=1 AND LEN(IS$)<ML THEN PRINT CHR$(C);:IS$=IS$+CHR$(C):GOTO 4810
4860 IF C<>20 THEN 4895
4861 IF LEN(IS$) = 0 THEN PRINT CHR$(7);
4865 IF LEN(IS$)=1 OR LEN(IS$)=0 THEN IS$="":GOSUB 4920:GOTO 4810
4870 I = LEN(IS$)-1
4871 IF RIGHT$(IS$,1)="." AND IT=2 THEN ID=0
4875 IS$=LEFT$(IS$,I)
4890 GOSUB 4920:PRINT IS$;:GOTO 4810
4895 PRINT CHR$(7);:GOTO 4810
4920 LOCATE IY,IX:FOR I = 1 TO ML+1:PRINT " ";:NEXT I
4921 LOCATE IY,IX
4925 RETURN
5000 DM$="THE SKY":GOSUB 20000
REM THE SKY
5005 RECT 0,0, XLIMIT, YLIMIT, 14
5010 P1=14:P2=$10:GOSUB 41000
5020 CX = 5:CY=4:CC=$10:FILL = 1:XS=1:YS=1:RA=32
5025 GOSUB 3000
5029 DM$="THE SUN":GOSUB 20000
5030 CC = $07
5038 FILL = 1: RA = 30:GOSUB 3000:FILL=0
REM BRUTE FORCE, RAYS FROM THE SUN...
REM USING SCRATCH PALLETTE ENTRY AT $F1 SO
REM I CAN USE FADE EFFECT, FINAL COLOR WILL BE THE
REM SAME AS AT DEFAULT PALLETTE $07
5050 C=$F1:P1=14:P2=C:GOSUB 41000
5051 LINE 2,37,2,44,C:LINE 6,37,6,44,C:LINE 9,37,10,44,C
5054 LINE 12,36,14,43,C:LINE 15,35,17,42,C:LINE 18,34,21,41,C
5057 LINE 20,33,24,39,C:LINE 22,31,27,37,C:LINE 24,28,29,35,C
5060 LINE 27,25,32,32,C:LINE 30,23,35,29,C:LINE 32,21,37,26,C
5063 LINE 33,19,39,23,C:LINE 35,17,41,20,C:LINE 36,15,43,17,C
5066 LINE 37,12,44,14,C:LINE 38,10,45,11,C:LINE 39,7,45,8,C
5069 LINE 39,4,45,5,C:LINE 39,1,46,2,C
5071 P1=0:P2=$10:J=3:GOSUB 40200
5072 P1=7:P2=$F1:GOSUB 40200
REM DRAW CLOUDS AT GOSUB 6500
5095 GOSUB 6500:GOSUB 6500:GOSUB 6500:GOSUB 6500
5100 DM$="GRASS":GOSUB 20000
5110 RECT 0, 180, XLIMIT, YLIMIT, $85
5120 FOR Y = 161 TO 179
5130 LINE 0, Y, 40, 179, 105
5140 NEXT Y
5150 FOR Y = 180 TO 150 STEP -1
5160 LINE 288,179, XLIMIT, Y, 105
5170 NEXT Y
5171 COLOR 1
REM DRAW GRASS STUFF
5180 GOSUB 6000
5190 GOSUB 6000
5200 GOSUB 6000
5210 RETURN
REM RANDOM GRASS
6000 FOR I = 1 TO 35
6110 X1 = INT(RND(1)*310) + 5
6120 Y1 = INT(RND(1)*60) + 180:IF Y1 > YLIMIT THEN GOTO 6120
6130 X2 = INT(RND(1)*310) + 5:IF X2 = X1 THEN GOTO 6130
6140 Y2 = INT(RND(1)*60) + 180:IF Y2 = Y1 OR Y2 > YLIMIT THEN GOTO 6140
6145 IF X2 - X1 > 55 OR X1 - X2 > 55 THEN GOTO 6110
6146 IF Y2 - Y1 > 12 OR Y1 - Y2 > 15 THEN GOTO 6110
6160 GOSUB 6200:X1=X2:Y1=Y2:GOSUB 6200
6180 NEXT I
6185 FOR I = 1 TO 10:X1=INT(RND(1)*310)+5:Y1=INT(RND(1)*4)+180
6186 GOSUB 6200:NEXT I
6190 RETURN
6200 GOSUB 6400
6210 LINE X1,Y1,X1-4,Y1-5,GC:GOSUB 6400
6215 LINE X1,Y1,X1-3,Y1-3,GC:GOSUB 6400
6220 LINE X1,Y1,X1,Y1-5,GC:GOSUB 6400
6225 LINE X1,Y1,X1+3,Y1-3,GC:GOSUB 6400
6230 LINE X1,Y1,X1+4,Y1-5,GC
6235 RETURN
6400 GC=INT(RND(1)*24)+$60:RETURN
6500 REM SUPPOSED TO BE A CLOUD HERE
6501 Q1=1:Q2=1:Q3=1:Q4=1:FILL=1
6502 DM$="CLOUDS":GOSUB 20000
6540 H = INT(RND(1)*(200))+ 45
6541 HL = INT(RND(1)*30)+30
6545 V = INT(RND(1)*30) + 6
6550 VB = INT(RND(1)*11) + 7
6555 FOR Y = V TO V+VB STEP 3
6560 FOR X = H TO H + HL STEP 4
6580 RA = INT(RND(1)*5)+3
6585 CC = INT(RND(1)*4)+ $1C
6590 CX=X
6592 CY= INT(RND(1)*4) + (Y-4):IF (CY - RA) < 0 THEN 6580
6600 GOSUB 6800
6605 NEXT X
6610 NEXT Y
6615 RETURN
REM MIDPOINT CIRCLE ALGORITHM FILLED
6800 T1=RA/16:XA=RA:YA=0
6810 LINE CX+(XA),CY+(YA),CX-(XA),CY+(YA),CC
6815 LINE CX+(YA),CY+(XA),CX-(YA),CY+(XA),CC
6820 LINE CX+(XA),CY-(YA),CX-(XA),CY-(YA),CC
6825 LINE CX+(YA),CY-(XA),CX-(YA),CY-(XA),CC
6830 YA=YA+1
6835 T1=T1+YA
6840 T2=T1-XA
6845 IF T2 >= 0 THEN T1=T2:XA=XA-1
6850 IF XA>=YA THEN 6810
6855 RETURN
REM THE GALLOWS
7000 DM$="THE GALLOWS":GOSUB 20000
7010 FRAME 189,195,285,208,$10
7020 FRAME 188,194,285,211,$10
7021 LINE 189,210,285,210,$10
7022 PSET 189,209,$10
7023 PSET 284,206,$10
7024 PSET 284,209,$10
7030 FRAME 275,21,285,207,$10
7040 FRAME 276,22,284,205,$10
7050 FRAME 67,20,285,30,$10
7060 FRAME 68,21,284,29,$10
7070 RECT 71,30,79,33,$10
7080 RECT 190,196,283,209,$53
7090 RECT 277,23,283,209,$53
7100 RECT 69,22,283,28,83
7150 RETURN
REM THE ROPE
8000 DM$="THE NOOSE":GOSUB 20000
8005 FILL = 0
8010 LINE 73,33,73,53,16
8020 LINE 77,33,77,53,16
8030 RECT 74,34,76,53,87
8040 FOR Y = 38 TO 53 STEP 3
8050 LINE 73, Y, 77, Y - 3, $10
8060 NEXT Y
8070 FRAME 71,53,80, 68, 16
8080 RECT 72,54,79,68,87
8090 FOR Y = 56 TO 68 STEP 4
8100 LINE 72,Y,79, Y-4, $10
8110 NEXT Y
REM THE NOOSE
8130 RA = 24
8140 YS = .38
8150 CX = 75:CY = 79:CC=$10
8160 GOSUB 3000:RA=25:GOSUB 3000
8165 RA=24:GOSUB 3000
8166 RA =23:GOSUB 3000
8167 RA = 22:GOSUB 3000
8170 RA = 19:GOSUB 3000
8175 RA = 18:GOSUB 3000
8180 CC = 87
8190 FOR X = 20 TO 23 STEP .4
8200 RA=X:GOSUB 3000
8210 NEXT X
9000 YS=1:RETURN
REM END ROPE
REM THE FACE
9500 DM$="A TROUBLED FACE":GOSUB 20000
REM HIS EARS
9501 CX=58:CY=60:RA=6:XS=.4:CC=$10
9505 Q1=1:Q2=0:Q3=1:Q4=0
9510 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9520 FILL=1:CC=$25:GOSUB 3000
9530 FILL=0:CX=90:RA=6:CC=$10
9531 Q1=0:Q2=1:Q3=0:Q4=1
9540 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9550 FILL=1:CC=$25:GOSUB 3000
9551 LINE 93,58,93,62,$10
9555 Q1=1:Q2=Q1:Q3=Q1:Q4=Q1
REM DRAW HIS NECK
9560 LINE 67,76,67,84,$10
9570 LINE 66,76,66,84,$10
9580 LINE 67,87,67,90,$10:LINE 66,87,66,90,$10
9590 LINE 82,76,82,84,$10
9600 LINE 83,76,83,84,$10
9605 LINE 82,87,82,90,$10:LINE 83,87,83,90,$10
9610 RECT 68,76,81,84,$25
9620 RECT 68,89,81,90,$25
REM END NECK
9630 RA=20:XS=.8:FILL=1
9640 CC=$10:CX=74:CY=63
9650 GOSUB 3000:RA = RA - 1:GOSUB 3000
9670 RA=RA-2:CY=CY+1:CC=$FF:FILL=1:GOSUB 3000
9680 XS = 1:YS = XS
REM RIGHT EYE
9690 CY=CY-6:CX = CX-6:RA=3:CC=$FE:GOSUB 6800
9700 PSET CX+4,CY,$FF:GOSUB 9950
REM LEFT EYE
9710 CX = CX + 12:GOSUB 6800
9720 PSET CX+4,CY,$FF:GOSUB 9950:CX = 74:CY = 63
9730 LINE CX-1,CY, CX - 2, CY + 6, $10
9740 LINE CX+1,CY, CX + 2, CY + 6, $10
9750 LINE CX,CY,CX -1, CY + 6, $23
9760 LINE CX,CY,CX + 1, CY + 6, $23
9770 LINE CX,CY+3,CX,CY+6,$22
9780 Q3=0:Q4=0:CC=$10:CY = CY + 13:YS=.35:RA=6:FILL=0
9790 GOSUB 3000
9800 CY = CY + 1:CC=$31:GOSUB 3000
9805 CY = CY + 1:CC=$10:GOSUB 3000
REM REMEMBER TO TURN CIRCLE FULLY ON !!!
9806 Q3=1:Q4=1:YS=1
9810 RETURN
REM THE PUPILS
9950 PSET CX,CY,$10:PSET CX -1,CY,$10
9955 PSET CX,CY +1,$10:PSET CX - 1, CY + 1 ,$10
9960 RETURN
REM END FACE
REM THE TORSO
10000 DM$="TORSO":GOSUB 20000
10001 LINE 82,90,105,93,$10
10005 LINE 83,91,105,94,$10
10010 LINE 68,90,42,93, $10
10015 LINE 69,91,42,94, $10
10020 LINE 67,90,74,105,$10
10025 LINE 83,90,74,105,$10
REM THIS FOR LOOP FILLS IN THE NECKLINE
10030 FOR X = 81 TO 68 STEP -1
10035 LINE 75,103,X, 90, $25
10040 NEXT X
10053 LINE 74,105,72,110,$10
10054 LINE 72,110,72,141,$10
10055 LINE 72,141,53,144,$10
10060 LINE 53,144,53,108,$10
10065 RECT 71,140,54,103,$08
10066 LINE 54,141,68,141,$08
10067 LINE 54,142,62,142,$08
10068 LINE 54,143,56,143,$08
10069 PSET 65,91,$10
10070 LINE 72,102,72,108,$08
10071 LINE 73,104,73,106,$08
10072 PSET 74,109,$08
10073 RECT 47,107,68,94,$08
10074 RECT 69,96,69,99,$08
10076 RECT 42,107,48,95,$08
10077 LINE 56,93,67,93, $08:PSET 55,92,$10:PSET 64,91,$10
10078 LINE 65,92,67,92, $08
10079 RECT 68,100,71,102,$08
10080 LINE 70,98,70,100, $08
10090 RECT 73,110,91,140,$08
10095 RECT 75,105,91,109,$08
10120 RECT 88, 94, 101, 106, $08
10125 RECT 81, 95, 105, 106, $08
10130 LINE 80, 96, 80, 105, $08
10135 LINE 79,98,79,105, $08
10140 LINE 78,100,78,105,$08
10145 LINE 77,101,77,105,$08
10150 LINE 76,103,76,105,$08
10155 LINE 74,103,75,103, $10
10160 PSET 76,101,$10:PSET 73,101,$10:PSET 72,99,$10:PSET 71,97,$10
10165 PSET 70,95,$10:PSET 69,93,$10:PSET 81,92,$10:PSET 80,94,$10
10166 PSET 80,96,$10:PSET 78,97,$10:PSET 77,99,$10
10167 LINE 76,100,76,103,$10
10175 RECT 82, 94, 93, 93, $08
10180 LINE 83, 92, 86, 92, $08
10185 LINE 74, 107,74, 108,$08
10190 PSET 73,109,$10
10195 PSET 73,141,$10
10200 LINE 76,141,91,141,$08
10205 LINE 81,142,91,142,$08
10210 LINE 89,143,91,143,$08
10360 LINE 74,141,92,144,$10
10365 LINE 92,144,92,107,$10
REM STRAY PIXEL AT WAISTLINE
12366 PSET 73,141,$10
REM SHIRT BUTTONS
10370 CC = 16:RA = 1.2
10375 CX = 75:FILL = 1
10385 FOR CY = 113 TO 143 STEP 8
10390 GOSUB 3000
10400 NEXT CY
REM POCKET AND PRISONER NUMBER
10410 LINE 58,108,68,108,$10
10415 LINE 58,108,58,116,$10
10420 LINE 68,108,68,116,$10
10425 Q1=0:Q2=0:Q3=1:Q4=1:RA=4.5:XS=1:YS=.6
10430 CX = 63:CY=116:CC=$10:FILL=0
10435 GOSUB 3000
10436 PN$="P-1"
10440 CHAR 57,106,$10,PN$
10600 RETURN
REM ARM ON THE RIGHT (LEFT ARM)
11000 Q1=0:Q2=1:Q3=0:Q4=0:FILL = 0
11005 DM$="LEFT ARM":GOSUB 20000
11010 XSQUISH = .52
11020 RA = 16:CC=$10
11030 CY = 116:CX = 92
11035 GOSUB 3000:RA=RA+.6
11040 GOSUB 3000
11060 RA=RA-1:GOSUB 3000
11090 XSQUISH=.28:CX = 106:CY = 105:FILL=0
11095 GOSUB 3000
11096 FOR L = 1 TO 3:RA=RA+.5:GOSUB 3000:NEXT L
11100 CC = $08:Q1=0:Q2=1:Q3=0:Q4=0
11105 FOR RA = 14 TO 12 STEP -.7
11110 GOSUB 3000:IF RA =12 THEN Q1=1
11115 NEXT RA
11116 RECT CX-1,CY-3,CX+2,CY-7,$08
11120 LINE 99,113,99,133,$10
11130 LINE 111,102,111,133,$10
11135 RECT 100,102,110,133,$08
11140 LINE 99,107,99,109,$08
11145 LINE 98,108,101,108,$08
11150 LINE 97,107,100,107,$08 :PSET 94,107,$0E
11155 LINE 99,134,111,134,$10
REM (THE LEFT HAND)
11160 LINE 101,134,101,143,$10:LINE 101,143,103,143,$10
11166 LINE 102,142,102,139,$25:LINE 103,144,103,140,$10
11175 LINE 103,145,105,145,$10:LINE 104,144,104,139,$25
11180 LINE 105,146,105,140,$10:LINE 105,146,107,146,$10
11186 LINE 106,145,106,139,$25:LINE 107,146,107,140,$10
11195 LINE 107,145,109,145,$10:LINE 108,144,108,139,$25
11200 LINE 109,145,109,134,$10:RECT 102,139,108,135,$25
11210 RETURN
REM ARM ON THE LEFT (RIGHT ARM)
12000 Q1=1:Q2=0:Q3=0:Q4=0:FILL = 0
12010 XSQUISH = .52
12020 RA = 16:CC=$10
12030 CY = 118:CX = 54
12031 DM$="RIGHT ARM":GOSUB 20000
12035 GOSUB 3000:RA=RA+.6
12040 GOSUB 3000
12060 RA=RA-1:GOSUB 3000
12090 XSQUISH=.43:CX = 42:CY = 105:FILL=0
12095 GOSUB 3000
12096 FOR L = 1 TO 3:RA=RA+.3:GOSUB 3000:NEXT L
12100 CC = $08:Q1=1:Q2=0:Q3=0:Q4=0
12105 FOR RA = 14 TO 12 STEP -.7
12110 GOSUB 3000:IF RA =12 THEN Q1=1
12115 NEXT RA
12116 LINE 54,107,54,109,$08
12117 RECT CX-4,CY-8,CX+3,CY+6,$08
12118 RECT CX-4,CY-4,CX,CY+6,$08
12120 LINE 34,102,34,133,$10
12130 LINE 46,115,46,133,$10
12135 RECT 35,102,45,133,$08
12136 LINE 34,134,46,134,$10
12140 LINE 46,CY,46,CY+6,$08
12142 LINE 47,CY,47,CY+5,$08
12145 RECT 47,CY,49,CY+3,$08
12150 LINE 51,CY+4,52,CY+4,$0E
12155 PSET 48,CY+4, $08
REM (THE LEFT HAND)
12160 LINE 44,134,44,143,$10:LINE 44,143,42,143,$10
12166 LINE 43,142,43,139,$25:LINE 42,140,42,145,$10
12175 LINE 42,145,40,145,$10:LINE 41,144,41,139,$25
12180 LINE 40,146,40,140,$10:LINE 40,146,38,146,$10
12186 LINE 39,145,39,139,$25:LINE 38,146,38,140,$10
12195 LINE 38,145,36,145,$10:LINE 37,144,37,139,$25
12200 LINE 36,145,36,134,$10:RECT 43,139,37,135,$25
12210 RETURN
REM RIGHT LEG
12500 Q1=1:Q2=0:Q3=0:Q4=0
12505 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12506 DM$="RIGHT LEG":GOSUB 20000
12510 GOSUB 3000
12515 LINE 70,159,70,192,$10:LINE 55,145,53,192,$10
12525 LINE 53,193,70,193,$10:RECT 56,145,69,192,$46
12535 LINE 55,157,55,192,$46:LINE 54,181,54,192,$46
12555 LINE 57,144,71,144,$46:RECT 69,142,71,154,$46
12565 RECT 72,142,73,153,$46:LINE 63,143,68,143,$46:PSET 70,155,$46
REM THE FOOT
12580 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1:CX=62:CY=208
12585 GOSUB 3000:RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12590 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12591 RA = RA + 1:CC=$12:FILL=0:GOSUB 3000
12595 LINE 57,193,57,202,$10:LINE 66,193,66,202,$10
12605 RECT 58,194,65,200,$1C
12610 RETURN
REM LEFT LEG
12620 Q1=0:Q2=1:Q3=0:Q4=0
12625 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12626 DM$="LEFT LEG":GOSUB 20000
12630 GOSUB 3000
12635 LINE 77,157,77,192,$10:LINE 90,145,92,192,$10
12645 LINE 77,193,92,193,$10:RECT 78,145,89,192,$46
12655 LINE 90,157,90,192,$46:LINE 91,181,91,192,$46
12665 LINE 74,144,88,144,$46:RECT 76,143,79,154,$46
12675 RECT 74,142,76,153,$46:LINE 74,143,82,143,$46
12685 LINE 77,154,77,156,$46
REM THE FOOT
12690 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1
12695 CX=85:CY=208
12700 GOSUB 3000
12705 RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12710 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12715 RA = RA + 1:CC=$12:FILL=0:GOSUB 3000
12720 LINE 80,193,80,202,$10:LINE 89,193,89,202,$10
12730 RECT 81,194,88,200,$1C
12740 RETURN
REM THIS ROUTINE SAVES THE SCREEN TO "BG.DAT" FOR
REM SUBSEQUENT BVLOAD. TESTED AND WORKS
REM NOT CURRENTLY USED. VERY SLOW
15000 OPEN 8,8,8,"BG.DAT,S,W"
15010 FOR P = 0 TO 65535
15020 PRINT#8,CHR$(VPEEK(0,P));
15030 NEXT P
15040 FOR P = 0 TO 11264
15050 PRINT#8,CHR$(VPEEK(1,P));
15060 NEXT P
15070 CLOSE 8
15080 RETURN
REM PLACE A MESSAGE ON THE BOTTOM OF THE SCREEN
20000 DM$=" DRAWING: "+DM$
20010 COLOR 1,0:GOSUB 20100
20015 LOCATE 30,1:PRINT DM$;
20020 RETURN
20100 LOCATE 30,1:PRINT RPT$(32,39);
20101 RETURN
REM BIGWORD ROUTINE.. READS ROM FONT AND BLOWS IT UP
39600 L = LEN(WD$):SX = X
39665 OB=PEEK(1):BANK PEEK(0),6
39675 FOR K = 1 TO L
39680 CC=ASC(MID$(WD$,K,1))
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
39685 IF (CC>=64 AND CC<=90) OR (CC>=193 AND CC<=218) THEN AA=64:GOTO 39695
39690 AA = 0
39695 CA = $C000 + 8*(CC-AA)
39700 FOR I = 1 TO 8
39710 CM(I) = PEEK(CA+(I-1)):CM$(I)=""
39715 NEXT I
39720 IF DC$="" THEN DC$=CHR$(CC)
39725 FOR J = 1 TO 8
39730 RESTORE 50200
39735 FOR CT = 1 TO 8
39740 READ CP
39745 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+DC$:GOTO 39755
39750 CM$(J)=CM$(J)+CHR$(32)
39755 NEXT CT
39760 LOCATE Y+(J-1),X:IF UC=1 THEN COLOR TC%(1,J),TC%(2,J)
39765 PRINT CM$(J);
39770 NEXT J
39775 IF DC$=CHR$(CC) THEN DC$=""
39780 X=X+8
39785 NEXT K
39790 X=SX
39795 BANK PEEK(0),OB
39800 RETURN
REM SET PALLETTE ENTRY P1 TO R%,G%,B%
40000 VPOKE 1,$FA00+(P1*2),(G%*16) + B%
40010 VPOKE 1,$FA00+((P1*2)+1),R%
40020 RETURN
REM READ PALLETTE ENTRY AT P1
REM RETURNED IN %R,%G,%B
40100 A1 = $FA00+(P1*2)
40105 R% = VPEEK(1,A1+1)
40110 GB%= VPEEK(1,A1)
40115 G% = GB%/16
40120 B% = GB% AND $0F
40125 RETURN
REM FADE P2 FROM CURRENT COLOR TO P1 COLOR, J IS JIFFY DELAY
40200 GOSUB 40100
40205 P3=P1
40210 P1=P2
40215 GOSUB 40300
40220 P1=P3
40225 RETURN
REM FADE P1 TO R%,G%,B%, J IS JIFFY DELAY
40300 DR%=R%:DG%=G%:DB%=B%
40305 GOSUB 40100
40310 RI=1:IF DR%<R% THEN RI=-1
40315 GI=1:IF DG%<G% THEN GI=-1
40320 BI=1:IF DB%<B% THEN BI=-1
40325 IF DR%<>R% THEN R%=R%+RI
40330 IF DG%<>G% THEN G%=G%+GI
40335 IF DB%<>B% THEN B%=B%+BI
40340 GOSUB 40000
40345 SLEEP J
40350 IF DR%=R% AND DG%=G% AND DB%=B% THEN 40360
40355 GOTO 40325
40360 RETURN
REM SWAP PALLETTE COLORS AT P1 & P2
40500 A1=$FA00+(P1*2):A2=$FA00+(P2*2)
40510 B1=VPEEK(1,A1):B2=VPEEK(1,A1+1)
40520 B3=VPEEK(1,A2):B4=VPEEK(1,A2+1)
40530 VPOKE 1,A1,B3:VPOKE 1,A1+1, B4
40450 VPOKE 1,A2,B1:VPOKE 1,A2+1, B2
40560 RETURN
REM COPY P1 PALLETTE ENTRY TO P2.. P1 IS LEFT UNCHANGED.
41000 VPOKE 1,$FA00+(P2*2), VPEEK(1, $FA00+(P1*2))
41010 VPOKE 1,$FA00+(P2*2)+1, VPEEK(1, $FA00+(P1*2)+1)
41020 RETURN
REM LOOP THROUGH THE PALLETTE ADDRESS SPACE
REM AND POKE THE VERA DEFAULT PALLETTE
45000 RESTORE 50000
45020 FOR PE=$FA00 TO $FBFE STEP 2
45025 READ R:READ GB
45030 VPOKE 1,PE,GB:VPOKE 1,PE+1,R
45040 NEXT PE
45050 RETURN
REM DEFAULT VERA PALLETTE AS DATA. FROM 0 TO 255 (2 BYTES EACH ENTRY)R,GB
50000 DATA 0,0,15,255,8,0,10,254,12,76,0,197,0,10,14,231,13,133,6,64,15,119,3
50005 DATA 51,7,119,10,246,0,143,11,187,0,0,1,17,2,34,3,51,4,68,5,85,6,102,7
50010 DATA 119,8,136,9,153,10,170,11,187,12,204,13,221,14,238,15,255,2,17,4,51
50015 DATA 6,68,8,102,10,136,12,153,15,187,2,17,4,34,6,51,8,68,10,85,12,102,15
50020 DATA 119,2,0,4,17,6,17,8,34,10,34,12,51,15,51,2,0,4,0,6,0,8,0,10,0,12,0
50025 DATA 15,0,2,33,4,67,6,100,8,134,10,168,12,201,15,235,2,17,4,50,6,83,8
50030 DATA 116,10,149,12,182,15,215,2,16,4,49,6,81,8,98,10,130,12,163,15,195,2
50035 DATA 16,4,48,6,64,8,96,10,128,12,144,15,176,1,33,3,67,5,100,7,134,9,168
50040 DATA 11,201,13,251,1,33,3,66,4,99,6,132,8,165,9,198,11,247,1,32,2,65,4
50045 DATA 97,5,130,6,162,8,195,9,243,1,32,2,64,3,96,4,128,5,160,6,192,7,240,1
50050 DATA 33,3,67,4,101,6,134,8,168,9,202,11,252,1,33,2,66,3,100,4,133,5,166
50055 DATA 6,200,7,249,0,32,1,65,1,98,2,131,2,164,3,197,3,246,0,32,0,65,0,97,0
50060 DATA 130,0,162,0,195,0,243,1,34,3,68,4,102,6,136,8,170,9,204,11,255,1,34
50065 DATA 2,68,3,102,4,136,5,170,6,204,7,255,0,34,1,68,1,102,2,136,2,170,3
50070 DATA 204,3,255,0,34,0,68,0,102,0,136,0,170,0,204,0,255,1,18,3,52,4,86,6
50075 DATA 104,8,138,9,172,11,207,1,18,2,36,3,70,4,88,5,106,6,140,7,159,0,2,1
50080 DATA 20,1,38,2,56,2,74,3,92,3,111,0,2,0,20,0,22,0,40,0,42,0,60,0,63,1,18
50085 DATA 3,52,5,70,7,104,9,138,11,156,13,191,1,18,3,36,4,54,6,72,8,90,9,108
50090 DATA 11,127,1,2,2,20,4,22,5,40,6,42,8,60,9,63,1,2,2,4,3,6,4,8,5,10,6,12
50095 DATA 7,15,2,18,4,52,6,70,8,104,10,138,12,156,15,190,2,17, 4,35,6,53,8,71
50100 DATA 10,89,12,107,15,125,2,1,4,19,6,21,8,38,10,40,12,58,15,60,2,1,4,3,6
50105 DATA 4,8,6,10,8,12,9,15,11
REM BITMAP VALUES FOR READING FONTS.
REM 50200 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
REM 50205 DATA %00000010,%00000001,%00000000
50200 DATA 128,64,32,16,8,4,2,1,0
REM MUSIC FROM MOOINGLEMUR
50300 DATA "O4V63I0CO3V50I18CV50I18E-V50I18G",60,"O4CO3E-G-B-",45,"O4C",15
50305 DATA "O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60,"O4CO3E-G-B-",45
50310 DATA "O4C",15,"O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60
50315 DATA "O4CO3E-G-B-",45,"O4C",15,"O4CO3CE-G",60,"O4E-O3E-G-B-",45,"O4D",12
50320 DATA "E-",3,"O4DO3CE-G",45,"O4C",15,"O4CO3E-G-B-",45,"O4C",15
50325 DATA "O4CO3CE-G",60,"RE-G-B-",60,"",0
REM SETUP INITIAL VARIABLES
59000 XLIMIT=319:YLIMIT=239:
59002 X=RND(-TI):FMINIT
REM LOAD DEFAULT PALLETTE INIT VERA
59005 GOSUB 45000
REM SET PRETTY FONT
59007 POKE$30C,4:SYS$FF62
REM Q1-Q4 ARE INITIALIZED FOR CIRCLE DRAWING ROUTINE AT 3000
59020 Q1=1:Q2=1:Q3=1:Q4=1
59021 XS=1:YS=1
REM MAX LENGTH OF WORD AND CLUE
59025 MW% = 20
59030 MC% = 35
REM INITIALIZE THE ALPHABET
59035 GOSUB 59500
REM SET MY PALLETTE COLORS I AM GOING TO ANIMATE LATER
REM COPY FLESH COLOR ALSO TO $FF
59300 P1=$25:P2=$FF:GOSUB 41000
REM COPY PURE WHITE ALSO TO $FE
59305 P1=1:P2=$FE:GOSUB 41000
REM RED TO $FD
59310 P1=$3B:P2=$FD:GOSUB 41000
REM COPY YELLOW TO $F1 FOR SUN RAYS COLOR IF I VLOAD.
59315 C=$F1:P1=7:P2=C:GOSUB 41000
59400 RETURN
REM INITIALIZE AN ARRAY TO HOLD THE ALPHABET
REM USING ASCII VALUES INSTEAD OF STRING
REM WITH A FLAG TO SHOW IF THE LETTERS BEEN USED
REM 2 DIMENSIONAL ARRAY 1,X IS FLAG, 2,X IS ASCII CODE 3&4,X is X,Y
REM FOR BUTTON POSITION ON SCREEN.
59500 FOR I=65 TO 90
59505 AL%(1,I-64)=0:AL%(2,I-64)=I
59510 NEXT I
59515 RETURN
REM FLUSH KEYBOARD BUFFER AND WAIT FOR KEYPRESS
63000 GET X$:IF X$<>"" THEN 63000
63010 GET X$:IF X$="" THEN 63010
63020 RETURN
REM SKIP INTRO
21 GOTO 2640
REM JUST WORKING ON THIS AREA OF CODE AT THE MOMENT
REM SKIP ALL THE OTHER STUFF
PRINT:PRINT
PRINT FRE(0)
PRINT:PRINT
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH
I know no update in a couple days. Been going over the code at a fine grained detail to eke out every byte of memory I can get
back without the code being obfuscated. Also got a couple of things to speed up the code a little. I've actually shaved a few seconds off of drawing the complete hangman. I've got a little RAM back too, according to FRE(0).
Expect a code update sometime in the next 4 hours. But its probably not going to be a playable version yet
......
I could have probably had a playable version by now if I had just concentrated on that. I did the Stick Hangman on the title
screen in less than 30 mins of coding. But since I got into it I want this game to also showcase some of the things you can do with just BASIC. I have a couple of Machine Code subroutines ready to be incorporated, contributed by other members of the forum. But I want the initial playable version to be Pure BASIC code, at least for DEMO purpose.
back without the code being obfuscated. Also got a couple of things to speed up the code a little. I've actually shaved a few seconds off of drawing the complete hangman. I've got a little RAM back too, according to FRE(0).
Expect a code update sometime in the next 4 hours. But its probably not going to be a playable version yet
...... I could have probably had a playable version by now if I had just concentrated on that. I did the Stick Hangman on the title
screen in less than 30 mins of coding. But since I got into it I want this game to also showcase some of the things you can do with just BASIC. I have a couple of Machine Code subroutines ready to be incorporated, contributed by other members of the forum. But I want the initial playable version to be Pure BASIC code, at least for DEMO purpose.
Last edited by ahenry3068 on Fri Sep 01, 2023 1:12 am, edited 1 time in total.
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
MEMORY AND SPEED ENHANCEMENTS
Ok. It runs a good bit quicker, loosened some loops, eliminated some overdrawing of lines.
Eliminated some variables by consolidating.
Not much visual enhancement over the last version though the clouds and Eyes of the Hanged Man look just slightly different
due to eliminating the Midpoint Algorithm. I still have 2 separate GOSUBS to draw circles, but they both use the BRESHNHAM algorithm now. The routine I use to draw the clouds just eliminates clipping and error checking to make it as streamlined as possible, and it cuts it down to just a very few lines of code.
Though its not visible I also freed up about 1000 line code space between 6700 and 7000 to insert a couple more subroutines.
My Midpoint Algorithm was located at 6800 the abbreviated BRESNHAM algorithm is at 3500 immediately following the main algorithm in the source.
I've got 21092 Free after loading.
and 20251 Free after running through the program.
I think I've got enough room to run through and try to get most of the way through the game logic tomorrow.
After cutting and Pasting the following code use the following line if you want to skip the intro
screen and just see the Drawing Code in action.
Eliminated some variables by consolidating.
Not much visual enhancement over the last version though the clouds and Eyes of the Hanged Man look just slightly different
due to eliminating the Midpoint Algorithm. I still have 2 separate GOSUBS to draw circles, but they both use the BRESHNHAM algorithm now. The routine I use to draw the clouds just eliminates clipping and error checking to make it as streamlined as possible, and it cuts it down to just a very few lines of code.
Though its not visible I also freed up about 1000 line code space between 6700 and 7000 to insert a couple more subroutines.
My Midpoint Algorithm was located at 6800 the abbreviated BRESNHAM algorithm is at 3500 immediately following the main algorithm in the source.
I've got 21092 Free after loading.
and 20251 Free after running through the program.
I think I've got enough room to run through and try to get most of the way through the game logic tomorrow.
After cutting and Pasting the following code use the following line if you want to skip the intro
screen and just see the Drawing Code in action.
21 GOTO 2640Heres the current code
Code: Select all
10 SCREEN $80
15 DIM TC%(2,8):DIM AL%(4 ,26)
20 GOSUB 59000 : REM INITIALIZE ALL VARIABLES
40 RECT 0,0,319,239,$3B
45 RECT 3,3,316,236,$10:GOSUB 1000
50 DC$=CHR$(228):GOSUB 180
55 DC$=CHR$(162):GOSUB 180
60 REM GOSUB TO MAKE 166 TO SOLID BLOCK CHAR
65 DC$=CHR$(113):GOSUB 180
70 CHAR 75,165,$A9,CHR$($0C)+"THE CLASSIC WORD GAME"
75 CHAR 62,180,$AB,CHR$($0C)+"NOW ON THE COMMANDER X16"
80 CHAR 4,222,1,"CODED IN BASIC"
85 CHAR 4,232,1,"2023.. ANTHONY HENRY"
86 CHAR 185,222,1,"MUSIC CONTRIBUTED BY"
87 CHAR 205,232,1,"MOOINGLEMUR"
90 GOSUB 270:GOSUB 300
95 RESTORE 50300:GW=0
100 READ PS$,DL
105 IF DL=0 THEN 95
110 FMCHORD 0,PS$
115 FOR I=1 TO DL
120 GET X$
125 IF X$ <>"" THEN GW=1
130 GOSUB 275
135 NEXT I
140 IF GW=1 THEN GW=0:GOTO 150
145 GOTO 100
150 FOR X = 1 TO 31
160 LOCATE 1,1:PRINT CHR$(145)
161 READ PS$,DL:IF DL=0 THEN RESTORE 50300:GOTO 161
162 FMCHORD 0,PS$
166 FOR I = 1 TO DL:GOSUB 275:NEXT I
170 NEXT X
171 READ PS$,DL
172 IF DL=0 THEN 178
173 FMCHORD 0,PS$
174 SLEEP DL
175 GOTO 171
178 FMINIT
179 GOTO 2640
180 X = 5:Y=2:UC=1:WD$="Hang"
185 GOSUB 39600
190 X=8:Y=11:WD$="Man"
195 GOSUB 39600
200 RETURN
REM PALLETTE ANIMATION FOR TITLE SCREEN
270 P1=13
275 IF P1=2 THEN P2=13:GOTO 285
280 P2 = P1 - 1
285 GOSUB 40500
290 P1 = P1 - 1:IF P1<2 THEN P1=13
295 RETURN
REM DRAW STICK FIGURE HANGMAN
300 LINE 180,210,300,210,$53
311 LINE 180,209,299,209,$53
320 LINE 300,210,300,17,$53
321 LINE 299,209,299,18,$53
325 LINE 300,17,100,17,$53
326 LINE 299,18,100,18,$53
400 LINE 102,19,102,38,$57
405 FILL=0:CC=$57:YS=.4:XS=1:RA=13:CX=102:CY=45
410 GOSUB 3000
425 YS=1:XS=.8:CY=35:RA=10:CC=$25:FILL=1:GOSUB 3000
426 CX=CX-3:RA=2:CY=CY-2:CC=2:GOSUB 3000:CX=CX+6:GOSUB 3000
430 LINE 102,44,102,49,$25
435 LINE 102,51,102,78,$25
440 LINE 102,53,88,64,$25
445 LINE 102,53,116,64,$25
450 LINE 102,78,87,99,$25
455 LINE 102,78,117,99,$25
500 RETURN
1000 R%=15:G%=0:B%=2
1005 P1=$3B:P2=10:GOSUB 41000
1006 P1=1:P2=11:GOSUB 41000
1007 P1=$C7:P2=12:GOSUB 41000
1008 P1=$A0:P2=13:GOSUB 41000
1010 FOR I= 2 TO 9
1015 TC%(2,I-1) = 0
1020 TC%(1,I-1) = I
1025 P1 = I:GOSUB 40000:R%=R%-1
1030 IF I/3 = INT(I/3) THEN R%=R%-1:G%=G%+1
1050 NEXT I
1090 RETURN
2640 GOSUB 45000:GOSUB 59300
REM THE BACKGROUND
2650 GOSUB 5000
REM GALLOWS
2655 GOSUB 7000
REM ROPE
2660 GOSUB 8000
REM THE HEAD AND FACE
2665 GOSUB 9500
REM TORSO
2670 GOSUB 10000
REM LEFT ARM
2675 GOSUB 11000
REM RIGHT ARM
2680 GOSUB 12000
REM RIGHT LEG
2685 GOSUB 12500
REM LEFT LEG
2690 GOSUB 12620
2695 DM$="AWAITING KEY":GOSUB 20010:GOSUB 63000
2700 GOSUB 20100
REM DEADFACE
2705 GOSUB 4000
REM PULSING EYES
2710 GOSUB 20010:GOSUB 4200
REM RESTORE DRAWING PALLETTE
2715 GOSUB 59300
2720 COLOR 1,6
2725 LOCATE 6,14:PRINT " ";
2730 LOCATE 7,14:PRINT " WORKING WORD HERE ";
2735 LOCATE 8,14:PRINT " ";:MOUSE 1
2736 DM$=" CLUE GOES HERE : ANY KEY TO END DEMO":GOSUB 20010
2740 L=65
2745 X=131:Y=90:W=14:C1=1:C2=$17:C3=$C2:C4=$1E
2746 FRAME 123,83,261,164,$10
2747 RECT 124,84,260,163,$C0:RECT 126,87,258,161,$06
2750 SX=X
2755 FOR KK = 1 TO 3
2760 FOR J = 1 TO 7
2765 L$=CHR$(L)
2770 GOSUB 2900
2775 I=L-64
2780 AL%(1,I)=0
2785 AL%(2,I)=L
2790 AL%(3,I)=X
2795 AL%(4,I)=Y
2800 X = X + W + 4
2805 L=L+1
2810 NEXT J
2815 Y = Y + W + 4:X=SX
2820 NEXT KK
2825 X = SX
2830 FOR J = 1 TO 5
2835 L$=CHR$(L)
2840 GOSUB 2900
2845 I=L-64
2850 AL%(1,I)=0
2855 AL%(2,I)=L
2860 AL%(3,I)=X
2865 AL%(4,I)=Y
2870 X = X + W + 4
2875 L=L+1
2880 NEXT J
2885 GOSUB 63000:MOUSE 0
REM RESTORE VERA DEFAULT PALLETTE
2890 GOSUB 45000:SCREEN 1:END
REM X,Y BUTTON POSITION
REM W CURRENTLY HEIGHT AND WIDTH MAY CHANGE FOR SEPERATE HEIGHT VARIABLE
REM C1, C2 3D BORDER COLORS
REM C3 CENTER COLOR
REM C4 TEXT LABEL COLOR
REM L$ THE TEXT LABEL
REM DRAW 3-D BUTTON WITH LABEL L$ AT X,Y
2900 X1=X+1:XW=X+W:YW=Y+W:Y1=Y+1
2905 Y5=YW-1:X5=XW-1
2910 LINE X,Y,XW,Y,C1
2915 LINE X1,Y1,X5,Y1,C1
2920 LINE XW,Y,XW,YW,C1
2925 LINE X5,Y1,X5,Y5,C1
2930 LINE X,Y,X,YW,C2
2940 LINE X1,Y1,X1,Y5,C2
2950 LINE X,YW,X,YW,C2
2955 LINE X,YW,X5,YW,C2
2960 LINE X,Y5,XW-2,Y5,C2
2965 RECT X+2,Y+2,XW-2,YW-2,C3
2970 CHAR X+3,YW-3,C4,L$
2980 RETURN
REM BRESHNAHM CIRCLE
REM EXTRA CODE TO ENABLE TURNING ON AND OFF QUARTERS
REM X AND Y SCALING(XS & YS) AND CLIPPING AT EDGE OF SCREEN
REM TOOK OUT ERROR CHECKING FOR YS AND XS. * MAKE SURE CORRECT IN MAIN CODE *
3000 WR=RA:X=0: D=2*(1-RA):W=INT(2*320/240)
REM WHILE WR<0
3010 IF WR < 0 THEN 3350
3020 DX=X*XS:DY=WR*YS
3080 ZX=CX-DX
3090 ZY=CY-DY
3100 AX=CX+DX
3110 AY=CY+DY
3115 IF FILL=1 THEN 3165
3118 IF ZX<0 OR ZX>XL OR ZY<0 OR ZY>YL OR Q1=0 THEN 3130
3120 PSET ZX, ZY, CC
3130 IF AX<0 OR AX>XL OR ZY<0 OR ZY>YL OR Q2=0 THEN 3140
3131 PSET AX, ZY, CC
3140 IF ZX<0 OR ZX>XL OR AY<0 OR AY>YL OR Q3=0 THEN 3150
3141 PSET ZX, AY, CC
3150 IF AX<0 OR AX>XL OR AY<0 OR AY>YL OR Q4=0 THEN 3300
3151 PSET AX, AY, CC
3160 GOTO 3300
3165 X1=ZX:X2=AX
3166 IF (Q1=0 AND Q2=O) OR X1>XL THEN 3200
3170 IF ZY<0 OR ZY>YL THEN 3200
3171 IF X1<0 THEN X1=0
3172 IF X2>XL THEN X2=XL
3176 IF Q1=0 THEN X1=CX
3177 IF Q2=0 THEN X2=CX
3180 LINE X1,ZY,X2,ZY,CC
3200 IF (Q3=0 AND Q4=0) OR ZX>XL THEN 3300
3203 IF AY<0 OR AY>YL THEN 3300
3204 IF ZX<0 THEN ZX=0
3205 IF AX>XL THEN AX=XL
3210 IF Q3=0 THEN ZX=CX
3215 IF Q4=0 THEN AX=CX
3220 LINE ZX,AY,AX,AY,CC
3300 IF (D+RA)>0 THEN WR=WR-1:D=D-W*WR-1
3310 IF X>D THEN X=X+1: D=D+2*X+1
3320 GOTO 3010
REM WEND
3350 RETURN
REM STRIPPED BRESHNAHM CIRCLE ALGORITHM FOR CLOUD DRAWING
REM STRIPPED FOR SPEED.
3500 WR=RA:G=0: D=2*(1-RA):W=INT(2*320/240)
REM WHILE WR<0
3505 IF WR < 0 THEN 3535
3510 LINE CX-G,CY-WR,CX+G,CY-WR,CC
3515 LINE CX-G,CY+WR,CX+G,CY+WR,CC
3520 IF (D+RA)>0 THEN WR=WR-1:D=D-W*WR-1
3525 IF G>D THEN G=G+1: D=D+2*G+1
3530 GOTO 3505
REM WEND
3535 RETURN
REM DEADFACE
4000 P1=$24:P2=$FF:J=4:GOSUB 40200
4010 P1=$3B:P2=$FE:J=4:GOSUB 40200
4011 P1=$01:J=3:GOSUB 40200
4012 P1=$3A:J=1:GOSUB 40200
4013 P1=$15:J=3:GOSUB 40200
4014 P1=$3B:J=4:GOSUB 40200
4015 P1=$23:P2=$FF:J=6:GOSUB 40200
4016 P1=$B8:J=5:GOSUB 40200
4020 P1=$BF:GOSUB 40200
4030 P1=$C0:GOSUB 40200
4100 RETURN
REM EYE PULSING WHILE WAIT FOR KEY
4200 P1=$FE:G%=0:B%=0
4205 GET X$:IF X$<>"" THEN 4205
4210 GET X$
4215 IF X$<>"" THEN RETURN
4220 R%=RND(1)*15+1
4225 B%=RND(1)*6
4230 GOSUB 40300
4235 GOTO 4210
REM IY LOCATE Y LOCATION
REM IX LOCATE X LOCATION
REM ML MAX LENGTH OF STRING TO GET (1 TO 80)
REM IT TYPE OF INPUT 1=ALPHA ONLY, 2=NUMERIC(INCLUDE 1 AND ONLY 1 DECIMAL
REM POINT)
REM 3=ALPHANUMERIC, 4=LINE INPUT(CAN INCLUDE SPACE AND
REM TAB AND PUNCTUATION MARKS)
REM IS$ THE STRING TO RETURN
REM AC ADD CHAR 1=YES
REM ID DECIMAL DONE 1=YES
REM SPECIALIZED INPUT ROUTINE
4800 GET X$:IF X$<>"" THEN 4800
4801 IS$="":ID=0
REM BEFORE INPUT BEGINS
4805 GOSUB 4920
4810 GET X$:IF X$="" THEN 4810
4811 C=ASC(X$)
4815 IF WL=ML THEN
4820 AC=0
4830 IF (IT<>2 OR IT=3) AND C>=65 AND C<=90 THEN AC=1
4835 IF (IT=2 OR IT=4 OR IT=3) AND C>=48 AND C<=57 THEN AC=1
4840 IF (IT=2) AND C=46 AND ID=0 THEN AC=1:ID=1
4845 IF (IT=4) AND C=32 THEN AC = 1: REM ALLOW SPACES WHEN INPUTTING A LINE
4846 IF (IT=4) AND (C>=35 AND C<=47) THEN AC=1
4847 IF (IT=4) AND (C>=58 AND C<=63) THEN AC=1 : REM ALLOW PUNCS IN STRING.
4850 IF C=13 THEN RETURN
4855 IF AC=1 AND LEN(IS$)<ML THEN PRINT CHR$(C);:IS$=IS$+CHR$(C):GOTO 4810
4860 IF C<>20 THEN 4895
4861 IF LEN(IS$) = 0 THEN PRINT CHR$(7);
4865 IF LEN(IS$)=1 OR LEN(IS$)=0 THEN IS$="":GOSUB 4920:GOTO 4810
4870 I = LEN(IS$)-1
4871 IF RIGHT$(IS$,1)="." AND IT=2 THEN ID=0
4875 IS$=LEFT$(IS$,I)
4890 GOSUB 4920:PRINT IS$;:GOTO 4810
4895 PRINT CHR$(7);:GOTO 4810
4920 LOCATE IY,IX:FOR I = 1 TO ML+1:PRINT " ";:NEXT I
4921 LOCATE IY,IX
4925 RETURN
5000 DM$="THE SKY":GOSUB 20000
REM THE SKY
5005 RECT 0,0, XLIMIT, YLIMIT, 14
5010 P1=14:P2=$10:GOSUB 41000
5020 CX = 5:CY=4:CC=$10:FILL = 1:XS=1:YS=1:RA=32
5025 GOSUB 3000
5029 DM$="THE SUN":GOSUB 20000
5030 CC = $07
5038 FILL = 1: RA = 30:GOSUB 3000:FILL=0
REM BRUTE FORCE, RAYS FROM THE SUN...
REM USING SCRATCH PALLETTE ENTRY AT $F1 SO
REM I CAN USE FADE EFFECT, FINAL COLOR WILL BE THE
REM SAME AS AT DEFAULT PALLETTE $07
5050 C=$F1:P1=14:P2=C:GOSUB 41000
5051 LINE 2,37,2,44,C:LINE 6,37,6,44,C:LINE 9,37,10,44,C
5054 LINE 12,36,14,43,C:LINE 15,35,17,42,C:LINE 18,34,21,41,C
5057 LINE 20,33,24,39,C:LINE 22,31,27,37,C:LINE 24,28,29,35,C
5060 LINE 27,25,32,32,C:LINE 30,23,35,29,C:LINE 32,21,37,26,C
5063 LINE 33,19,39,23,C:LINE 35,17,41,20,C:LINE 36,15,43,17,C
5066 LINE 37,12,44,14,C:LINE 38,10,45,11,C:LINE 39,7,45,8,C
5069 LINE 39,4,45,5,C:LINE 39,1,46,2,C
5071 P1=0:P2=$10:J=3:GOSUB 40200
5072 P1=7:P2=$F1:GOSUB 40200
REM DRAW CLOUDS AT GOSUB 6500
5095 GOSUB 6500:GOSUB 6500:GOSUB 6500:GOSUB 6500
5100 DM$="GRASS":GOSUB 20000
5110 RECT 0, 180, XLIMIT, YLIMIT, $85
5120 FOR Y = 161 TO 179
5130 LINE 0, Y, 40, 179, 105
5140 NEXT Y
5150 FOR Y = 180 TO 150 STEP -1
5160 LINE 288,179, XLIMIT, Y, 105
5170 NEXT Y
5171 COLOR 1
REM DRAW RANDOM GRASS
6000 FOR I = 1 TO 400
6110 X1 = INT(RND(1)*310) + 5
6120 Y1 = INT(RND(1)*60) + 180:IF Y1 > YLIMIT THEN GOTO 6120
6130 GOSUB 6200
6140 NEXT I
REM 6185 FOR I = 1 TO 10:X1=INT(RND(1)*310)+5:Y1=INT(RND(1)*4)+180
REM 6186 GOSUB 6200:NEXT I
6150 RETURN
6200 GOSUB 6400
6210 LINE X1,Y1,X1-4,Y1-5,GC:GOSUB 6400
6215 LINE X1,Y1,X1-3,Y1-3,GC:GOSUB 6400
6220 LINE X1,Y1,X1,Y1-5,GC:GOSUB 6400
6225 LINE X1,Y1,X1+3,Y1-3,GC:GOSUB 6400
6230 LINE X1,Y1,X1+4,Y1-5,GC
6235 RETURN
6400 GC=INT(RND(1)*24)+$60:RETURN
6500 REM SUPPOSED TO BE A CLOUD HERE
6502 DM$="CLOUDS":GOSUB 20000
6540 H = INT(RND(1)*(200))+ 45
6541 HL = INT(RND(1)*30)+30
6545 V = INT(RND(1)*30) + 6
6550 VB = INT(RND(1)*11) + 7
6555 FOR Y = V TO V+VB STEP 3
6560 FOR X = H TO H + HL STEP 4
6580 RA = INT(RND(1)*5)+3
6585 CC = INT(RND(1)*4)+ $1C
6590 CX=X
6592 CY= INT(RND(1)*4) + (Y-4):IF (CY - RA) < 0 THEN 6580
6600 GOSUB 3500
6605 NEXT X
6610 NEXT Y
6615 RETURN
REM THE GALLOWS
7000 DM$="THE GALLOWS":GOSUB 20000
7010 FRAME 189,195,285,208,$10
7020 FRAME 188,194,285,211,$10
7021 LINE 189,210,285,210,$10
7022 PSET 189,209,$10
7023 PSET 284,206,$10
7024 PSET 284,209,$10
7030 FRAME 275,21,285,207,$10
7040 FRAME 276,22,284,205,$10
7050 FRAME 67,20,285,30,$10
7060 FRAME 68,21,284,29,$10
7070 RECT 71,30,79,33,$10
7080 RECT 190,196,283,209,$53
7090 RECT 277,23,283,209,$53
7100 RECT 69,22,283,28,83
7150 RETURN
REM THE ROPE
8000 DM$="THE NOOSE":GOSUB 20000
8005 FILL = 0
8010 LINE 73,33,73,53,16
8020 LINE 77,33,77,53,16
8030 RECT 74,34,76,53,87
8040 FOR Y = 38 TO 53 STEP 3
8050 LINE 73, Y, 77, Y - 3, $10
8060 NEXT Y
8070 FRAME 71,53,80, 68, 16
8080 RECT 72,54,79,68,87
8090 FOR Y = 56 TO 68 STEP 4
8100 LINE 72,Y,79, Y-4, $10
8110 NEXT Y
REM THE NOOSE
8130 RA = 24
8140 YS = .38
8150 CX = 75:CY = 79:CC=$10
8160 GOSUB 3000:RA=25:GOSUB 3000
8165 RA=24:GOSUB 3000
8166 RA =23:GOSUB 3000
8170 RA = 19:GOSUB 3000
8175 RA = 18:GOSUB 3000
8180 CC = 87
8190 FOR X = 20 TO 23 STEP .6
8200 RA=X:GOSUB 3000
8210 NEXT X
9000 YS=1:RETURN
REM END ROPE
REM THE FACE
9500 DM$="A TROUBLED FACE":GOSUB 20000
REM HIS EARS
9501 CX=58:CY=60:RA=6:XS=.4:CC=$10
9505 Q1=1:Q2=0:Q3=1:Q4=0
9510 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9520 FILL=1:CC=$25:GOSUB 3000
9530 FILL=0:CX=90:RA=6:CC=$10
9531 Q1=0:Q2=1:Q3=0:Q4=1
9540 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9550 FILL=1:CC=$25:GOSUB 3000
9551 LINE 93,58,93,62,$10
9555 Q1=1:Q2=Q1:Q3=Q1:Q4=Q1
REM DRAW HIS NECK
9560 LINE 67,76,67,84,$10
9570 LINE 66,76,66,84,$10
9580 LINE 67,87,67,90,$10:LINE 66,87,66,90,$10
9590 LINE 82,76,82,84,$10
9600 LINE 83,76,83,84,$10
9605 LINE 82,87,82,90,$10:LINE 83,87,83,90,$10
9610 RECT 68,76,81,84,$25
9620 RECT 68,89,81,90,$25
REM END NECK
9630 RA=20:XS=.8:FILL=1
9640 CC=$10:CX=74:CY=63
9650 GOSUB 3000:RA = RA - 1:GOSUB 3000
9670 RA=RA-2:CY=CY+1:CC=$FF:FILL=1:GOSUB 3000
9680 XS = 1:YS = XS
REM RIGHT EYE
9690 CY=CY-6:CX = CX-6:RA=3:CC=$FE:GOSUB 3500
9700 PSET CX+4,CY,$FF:GOSUB 9950
REM LEFT EYE
9710 CX = CX + 12:GOSUB 3500
9720 PSET CX+4,CY,$FF:GOSUB 9950:CX = 74:CY = 63
9730 LINE CX-1,CY, CX - 2, CY + 6, $10
9740 LINE CX+1,CY, CX + 2, CY + 6, $10
9750 LINE CX,CY,CX -1, CY + 6, $23
9760 LINE CX,CY,CX + 1, CY + 6, $23
9770 LINE CX,CY+3,CX,CY+6,$22
9780 Q3=0:Q4=0:CC=$10:CY = CY + 13:YS=.35:RA=6:FILL=0
9790 GOSUB 3000
9800 CY = CY + 1:CC=$31:GOSUB 3000
9805 CY = CY + 1:CC=$10:GOSUB 3000
REM REMEMBER TO TURN CIRCLE FULLY ON !!!
9806 Q3=1:Q4=1:YS=1
9810 RETURN
REM THE PUPILS
9950 PSET CX,CY,$10:PSET CX -1,CY,$10
9955 PSET CX,CY +1,$10:PSET CX - 1, CY + 1 ,$10
9960 RETURN
REM END FACE
REM THE TORSO
10000 DM$="TORSO":GOSUB 20000
10001 LINE 82,90,105,93,$10
10005 LINE 83,91,105,94,$10
10010 LINE 68,90,42,93, $10
10015 LINE 69,91,42,94, $10
10020 LINE 67,90,74,105,$10
10025 LINE 83,90,74,105,$10
REM THIS FOR LOOP FILLS IN THE NECKLINE
10030 FOR X = 81 TO 68 STEP -1
10035 LINE 75,103,X, 90, $25
10040 NEXT X
10053 LINE 74,105,72,110,$10
10054 LINE 72,110,72,141,$10
10055 LINE 72,141,53,144,$10
10060 LINE 53,144,53,108,$10
10065 RECT 71,140,54,103,$08
10066 LINE 54,141,68,141,$08
10067 LINE 54,142,62,142,$08
10068 LINE 54,143,56,143,$08
10069 PSET 65,91,$10
10070 LINE 72,102,72,108,$08
10071 LINE 73,104,73,106,$08
10072 PSET 74,109,$08
10073 RECT 47,107,68,94,$08
10074 RECT 69,96,69,99,$08
10076 RECT 42,107,48,95,$08
10077 LINE 56,93,67,93, $08:PSET 55,92,$10:PSET 64,91,$10
10078 LINE 65,92,67,92, $08
10079 RECT 68,100,71,102,$08
10080 LINE 70,98,70,100, $08
10090 RECT 73,110,91,140,$08
10095 RECT 75,105,91,109,$08
10120 RECT 88, 94, 101, 106, $08
10125 RECT 81, 95, 105, 106, $08
10130 LINE 80, 96, 80, 105, $08
10135 LINE 79,98,79,105, $08
10140 LINE 78,100,78,105,$08
10145 LINE 77,101,77,105,$08
10150 LINE 76,103,76,105,$08
10155 LINE 74,103,75,103, $10
10160 PSET 76,101,$10:PSET 73,101,$10:PSET 72,99,$10:PSET 71,97,$10
10165 PSET 70,95,$10:PSET 69,93,$10:PSET 81,92,$10:PSET 80,94,$10
10166 PSET 80,96,$10:PSET 78,97,$10:PSET 77,99,$10
10167 LINE 76,100,76,103,$10
10175 RECT 82, 94, 93, 93, $08
10180 LINE 83, 92, 86, 92, $08
10185 LINE 74, 107,74, 108,$08
10190 PSET 73,109,$10
10195 PSET 73,141,$10
10200 LINE 76,141,91,141,$08
10205 LINE 81,142,91,142,$08
10210 LINE 89,143,91,143,$08
10360 LINE 74,141,92,144,$10
10365 LINE 92,144,92,107,$10
REM STRAY PIXEL AT WAISTLINE
12366 PSET 73,141,$10
REM SHIRT BUTTONS
10370 CC = 16:RA = 1.2
10375 CX = 75:FILL = 1
10385 FOR CY = 113 TO 143 STEP 8
10390 GOSUB 3000
10400 NEXT CY
REM POCKET AND PRISONER NUMBER
10410 LINE 58,108,68,108,$10
10415 LINE 58,108,58,116,$10
10420 LINE 68,108,68,116,$10
10425 Q1=0:Q2=0:Q3=1:Q4=1:RA=4.5:XS=1:YS=.6
10430 CX = 63:CY=116:CC=$10:FILL=0
10435 GOSUB 3000
10436 PN$="P-1"
10440 CHAR 57,106,$10,PN$
10600 RETURN
REM ARM ON THE RIGHT (LEFT ARM)
11000 Q1=0:Q2=1:Q3=0:Q4=0:FILL = 0
11005 DM$="LEFT ARM":GOSUB 20000
11010 XSQUISH = .52
11020 RA = 16:CC=$10
11030 CY = 116:CX = 92
11035 GOSUB 3000:RA=RA+.6
11040 GOSUB 3000
11060 RA=RA-1:GOSUB 3000
11090 XSQUISH=.28:CX = 106:CY = 105:FILL=0
11095 GOSUB 3000
11096 FOR L = 1 TO 3:RA=RA+.5:GOSUB 3000:NEXT L
11100 CC = $08:Q1=0:Q2=1:Q3=0:Q4=0:FILL=1:RA=RA-2.5
11105 GOSUB 3000
11110 RECT CX-1,CY-3,CX+2,CY-7,$08
11120 LINE 99,113,99,133,$10
11130 LINE 111,102,111,133,$10
11135 RECT 100,102,110,133,$08
11140 LINE 99,107,99,109,$08
11145 LINE 98,108,101,108,$08
11150 LINE 97,107,100,107,$08 :PSET 94,107,$0E
11155 LINE 99,134,111,134,$10
REM (THE LEFT HAND)
11160 LINE 101,134,101,143,$10:LINE 101,143,103,143,$10
11166 LINE 102,142,102,139,$25:LINE 103,144,103,140,$10
11175 LINE 103,145,105,145,$10:LINE 104,144,104,139,$25
11180 LINE 105,146,105,140,$10:LINE 105,146,107,146,$10
11186 LINE 106,145,106,139,$25:LINE 107,146,107,140,$10
11195 LINE 107,145,109,145,$10:LINE 108,144,108,139,$25
11200 LINE 109,145,109,134,$10:RECT 102,139,108,135,$25
11210 RETURN
REM ARM ON THE LEFT (RIGHT ARM)
12000 Q1=1:Q2=0:Q3=0:Q4=0:FILL = 0
12010 XSQUISH = .52
12020 RA = 16:CC=$10
12030 CY = 118:CX = 54
12031 DM$="RIGHT ARM":GOSUB 20000
12035 GOSUB 3000:RA=RA+.6
12040 GOSUB 3000
12060 RA=RA-1:GOSUB 3000
12090 XSQUISH=.43:CX = 42:CY = 105:FILL=0
12095 GOSUB 3000
12096 FOR L = 1 TO 3:RA=RA+.3:GOSUB 3000:NEXT L
12100 CC = $08:Q1=1:Q2=0:Q3=0:Q4=0:FILL=1:RA=RA-3
12105 GOSUB 3000:FILL=0
REM 12105 FOR RA = 14 TO 12 STEP -.7
REM 12110 GOSUB 3000:IF RA =12 THEN Q1=1
REM 12115 NEXT RA
12116 LINE 54,107,54,109,$08
12117 RECT CX-4,CY-8,CX+3,CY+6,$08
12118 RECT CX-4,CY-4,CX,CY+6,$08
12120 LINE 34,102,34,133,$10
12130 LINE 46,115,46,133,$10
12135 RECT 35,102,45,133,$08
12136 LINE 34,134,46,134,$10
12140 LINE 46,CY,46,CY+6,$08
12142 LINE 47,CY,47,CY+5,$08
12145 RECT 47,CY,49,CY+3,$08
12150 LINE 51,CY+4,52,CY+4,$0E
12155 PSET 48,CY+4, $08
REM (THE LEFT HAND)
12160 LINE 44,134,44,143,$10:LINE 44,143,42,143,$10
12166 LINE 43,142,43,139,$25:LINE 42,140,42,145,$10
12175 LINE 42,145,40,145,$10:LINE 41,144,41,139,$25
12180 LINE 40,146,40,140,$10:LINE 40,146,38,146,$10
12186 LINE 39,145,39,139,$25:LINE 38,146,38,140,$10
12195 LINE 38,145,36,145,$10:LINE 37,144,37,139,$25
12200 LINE 36,145,36,134,$10:RECT 43,139,37,135,$25
12210 RETURN
REM RIGHT LEG
12500 Q1=1:Q2=0:Q3=0:Q4=0
12505 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12506 DM$="RIGHT LEG":GOSUB 20000
12510 GOSUB 3000
12515 LINE 70,159,70,192,$10:LINE 55,145,53,192,$10
12525 LINE 53,193,70,193,$10:RECT 56,145,69,192,$46
12535 LINE 55,157,55,192,$46:LINE 54,181,54,192,$46
12555 LINE 57,144,71,144,$46:RECT 69,142,71,154,$46
12565 RECT 72,142,73,153,$46:LINE 63,143,68,143,$46:PSET 70,155,$46
REM THE FOOT
12580 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1:CX=62:CY=208
12585 GOSUB 3000:RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12590 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12591 RA = RA + 1:CC=$12:FILL=0:GOSUB 3000
12595 LINE 57,193,57,202,$10:LINE 66,193,66,202,$10
12605 RECT 58,194,65,200,$1C
12610 RETURN
REM LEFT LEG
12620 Q1=0:Q2=1:Q3=0:Q4=0
12625 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12626 DM$="LEFT LEG":GOSUB 20000
12630 GOSUB 3000
12635 LINE 77,157,77,192,$10:LINE 90,145,92,192,$10
12645 LINE 77,193,92,193,$10:RECT 78,145,89,192,$46
12655 LINE 90,157,90,192,$46:LINE 91,181,91,192,$46
12665 LINE 74,144,88,144,$46:RECT 76,143,79,154,$46
12675 RECT 74,142,76,153,$46:LINE 74,143,82,143,$46
12685 LINE 77,154,77,156,$46
REM THE FOOT
12690 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1
12695 CX=85:CY=208
12700 GOSUB 3000
12705 RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12710 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12715 RA = RA + 1:CC=$12:FILL=0:GOSUB 3000
12720 LINE 80,193,80,202,$10:LINE 89,193,89,202,$10
12730 RECT 81,194,88,200,$1C
12740 RETURN
REM THIS ROUTINE SAVES THE SCREEN TO "BG.DAT" FOR
REM SUBSEQUENT BVLOAD. TESTED AND WORKS
REM NOT CURRENTLY USED. VERY SLOW
15000 OPEN 8,8,8,"BG.DAT,S,W"
15010 FOR P = 0 TO 65535
15020 PRINT#8,CHR$(VPEEK(0,P));
15030 NEXT P
15040 FOR P = 0 TO 11264
15050 PRINT#8,CHR$(VPEEK(1,P));
15060 NEXT P
15070 CLOSE 8
15080 RETURN
REM PLACE A MESSAGE ON THE BOTTOM OF THE SCREEN
20000 DM$=" DRAWING: "+DM$
20010 COLOR 1,0:GOSUB 20100
20015 LOCATE 30,1:PRINT DM$;
20020 RETURN
20100 LOCATE 30,1:PRINT RPT$(32,39);
20101 RETURN
REM BIGWORD ROUTINE.. READS ROM FONT AND BLOWS IT UP
39600 L = LEN(WD$):SX = X
39665 OB=PEEK(1):BANK PEEK(0),6
39675 FOR K = 1 TO L
39680 CC=ASC(MID$(WD$,K,1))
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
39685 IF (CC>=64 AND CC<=90) OR (CC>=193 AND CC<=218) THEN AA=64:GOTO 39695
39690 AA = 0
39695 CA = $C000 + 8*(CC-AA)
39700 FOR I = 1 TO 8
39710 CM(I) = PEEK(CA+(I-1)):CM$(I)=""
39715 NEXT I
39720 IF DC$="" THEN DC$=CHR$(CC)
39725 FOR J = 1 TO 8
39730 RESTORE 50200
39735 FOR CT = 1 TO 8
39740 READ CP
39745 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+DC$:GOTO 39755
39750 CM$(J)=CM$(J)+CHR$(32)
39755 NEXT CT
39760 LOCATE Y+(J-1),X:IF UC=1 THEN COLOR TC%(1,J),TC%(2,J)
39765 PRINT CM$(J);
39770 NEXT J
39775 IF DC$=CHR$(CC) THEN DC$=""
39780 X=X+8
39785 NEXT K
39790 X=SX
39795 BANK PEEK(0),OB
39800 RETURN
REM SET PALLETTE ENTRY P1 TO R%,G%,B%
40000 VPOKE 1,$FA00+(P1*2),(G%*16) + B%
40010 VPOKE 1,$FA00+((P1*2)+1),R%
40020 RETURN
REM READ PALLETTE ENTRY AT P1
REM RETURNED IN %R,%G,%B
40100 A1 = $FA00+(P1*2)
40105 R% = VPEEK(1,A1+1)
40110 GB%= VPEEK(1,A1)
40115 G% = GB%/16
40120 B% = GB% AND $0F
40125 RETURN
REM FADE P2 FROM CURRENT COLOR TO P1 COLOR, J IS JIFFY DELAY
40200 GOSUB 40100
40205 P3=P1
40210 P1=P2
40215 GOSUB 40300
40220 P1=P3
40225 RETURN
REM FADE P1 TO R%,G%,B%, J IS JIFFY DELAY
40300 DR%=R%:DG%=G%:DB%=B%
40305 GOSUB 40100
40310 RI=1:IF DR%<R% THEN RI=-1
40315 GI=1:IF DG%<G% THEN GI=-1
40320 BI=1:IF DB%<B% THEN BI=-1
40325 IF DR%<>R% THEN R%=R%+RI
40330 IF DG%<>G% THEN G%=G%+GI
40335 IF DB%<>B% THEN B%=B%+BI
40340 GOSUB 40000
40345 SLEEP J
40350 IF DR%=R% AND DG%=G% AND DB%=B% THEN 40360
40355 GOTO 40325
40360 RETURN
REM SWAP PALLETTE COLORS AT P1 & P2
40500 A1=$FA00+(P1*2):A2=$FA00+(P2*2)
40510 B1=VPEEK(1,A1):B2=VPEEK(1,A1+1)
40520 B3=VPEEK(1,A2):B4=VPEEK(1,A2+1)
40530 VPOKE 1,A1,B3:VPOKE 1,A1+1, B4
40450 VPOKE 1,A2,B1:VPOKE 1,A2+1, B2
40560 RETURN
REM COPY P1 PALLETTE ENTRY TO P2.. P1 IS LEFT UNCHANGED.
41000 VPOKE 1,$FA00+(P2*2), VPEEK(1, $FA00+(P1*2))
41010 VPOKE 1,$FA00+(P2*2)+1, VPEEK(1, $FA00+(P1*2)+1)
41020 RETURN
REM LOOP THROUGH THE PALLETTE ADDRESS SPACE
REM AND POKE THE VERA DEFAULT PALLETTE
45000 RESTORE 50000
45020 FOR PE=$FA00 TO $FBFE STEP 2
45025 READ R:READ GB
45030 VPOKE 1,PE,GB:VPOKE 1,PE+1,R
45040 NEXT PE
45050 RETURN
REM DEFAULT VERA PALLETTE AS DATA. FROM 0 TO 255 (2 BYTES EACH ENTRY)R,GB
50000 DATA 0,0,15,255,8,0,10,254,12,76,0,197,0,10,14,231,13,133,6,64,15,119,3
50005 DATA 51,7,119,10,246,0,143,11,187,0,0,1,17,2,34,3,51,4,68,5,85,6,102,7
50010 DATA 119,8,136,9,153,10,170,11,187,12,204,13,221,14,238,15,255,2,17,4,51
50015 DATA 6,68,8,102,10,136,12,153,15,187,2,17,4,34,6,51,8,68,10,85,12,102,15
50020 DATA 119,2,0,4,17,6,17,8,34,10,34,12,51,15,51,2,0,4,0,6,0,8,0,10,0,12,0
50025 DATA 15,0,2,33,4,67,6,100,8,134,10,168,12,201,15,235,2,17,4,50,6,83,8
50030 DATA 116,10,149,12,182,15,215,2,16,4,49,6,81,8,98,10,130,12,163,15,195,2
50035 DATA 16,4,48,6,64,8,96,10,128,12,144,15,176,1,33,3,67,5,100,7,134,9,168
50040 DATA 11,201,13,251,1,33,3,66,4,99,6,132,8,165,9,198,11,247,1,32,2,65,4
50045 DATA 97,5,130,6,162,8,195,9,243,1,32,2,64,3,96,4,128,5,160,6,192,7,240,1
50050 DATA 33,3,67,4,101,6,134,8,168,9,202,11,252,1,33,2,66,3,100,4,133,5,166
50055 DATA 6,200,7,249,0,32,1,65,1,98,2,131,2,164,3,197,3,246,0,32,0,65,0,97,0
50060 DATA 130,0,162,0,195,0,243,1,34,3,68,4,102,6,136,8,170,9,204,11,255,1,34
50065 DATA 2,68,3,102,4,136,5,170,6,204,7,255,0,34,1,68,1,102,2,136,2,170,3
50070 DATA 204,3,255,0,34,0,68,0,102,0,136,0,170,0,204,0,255,1,18,3,52,4,86,6
50075 DATA 104,8,138,9,172,11,207,1,18,2,36,3,70,4,88,5,106,6,140,7,159,0,2,1
50080 DATA 20,1,38,2,56,2,74,3,92,3,111,0,2,0,20,0,22,0,40,0,42,0,60,0,63,1,18
50085 DATA 3,52,5,70,7,104,9,138,11,156,13,191,1,18,3,36,4,54,6,72,8,90,9,108
50090 DATA 11,127,1,2,2,20,4,22,5,40,6,42,8,60,9,63,1,2,2,4,3,6,4,8,5,10,6,12
50095 DATA 7,15,2,18,4,52,6,70,8,104,10,138,12,156,15,190,2,17, 4,35,6,53,8,71
50100 DATA 10,89,12,107,15,125,2,1,4,19,6,21,8,38,10,40,12,58,15,60,2,1,4,3,6
50105 DATA 4,8,6,10,8,12,9,15,11
REM BITMAP VALUES FOR READING FONTS.
REM 50200 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
REM 50205 DATA %00000010,%00000001,%00000000
50200 DATA 128,64,32,16,8,4,2,1,0
REM MUSIC FROM MOOINGLEMUR
50300 DATA "O4V63I0CO3V50I18CV50I18E-V50I18G",60,"O4CO3E-G-B-",45,"O4C",15
50305 DATA "O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60,"O4CO3E-G-B-",45
50310 DATA "O4C",15,"O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60
50315 DATA "O4CO3E-G-B-",45,"O4C",15,"O4CO3CE-G",60,"O4E-O3E-G-B-",45,"O4D",12
50320 DATA "E-",3,"O4DO3CE-G",45,"O4C",15,"O4CO3E-G-B-",45,"O4C",15
50325 DATA "O4CO3CE-G",60,"RE-G-B-",60,"",0
REM SETUP INITIAL VARIABLES
59000 XLIMIT=319:YLIMIT=239:
59002 X=RND(-TI):FMINIT
REM LOAD DEFAULT PALLETTE INIT VERA
59005 GOSUB 45000
REM SET PRETTY FONT
59007 POKE$30C,4:SYS$FF62
REM Q1-Q4 ARE INITIALIZED FOR CIRCLE DRAWING ROUTINE AT 3000
59020 Q1=1:Q2=1:Q3=1:Q4=1
59021 XS=1:YS=1
REM MAX LENGTH OF WORD AND CLUE
59025 MW% = 20
59030 MC% = 35
REM INITIALIZE THE ALPHABET
59035 GOSUB 59500
REM SET MY PALLETTE COLORS I AM GOING TO ANIMATE LATER
REM COPY FLESH COLOR ALSO TO $FF
59300 P1=$25:P2=$FF:GOSUB 41000
REM COPY PURE WHITE ALSO TO $FE
59305 P1=1:P2=$FE:GOSUB 41000
REM RED TO $FD
59310 P1=$3B:P2=$FD:GOSUB 41000
REM COPY YELLOW TO $F1 FOR SUN RAYS COLOR IF I VLOAD.
59315 C=$F1:P1=7:P2=C:GOSUB 41000
59400 RETURN
REM INITIALIZE AN ARRAY TO HOLD THE ALPHABET
REM USING ASCII VALUES INSTEAD OF STRING
REM WITH A FLAG TO SHOW IF THE LETTERS BEEN USED
REM 2 DIMENSIONAL ARRAY 1,X IS FLAG, 2,X IS ASCII CODE 3&4,X is X,Y
REM FOR BUTTON POSITION ON SCREEN.
59500 FOR I=65 TO 90
59505 AL%(1,I-64)=0:AL%(2,I-64)=I
59510 NEXT I
59515 RETURN
REM FLUSH KEYBOARD BUFFER AND WAIT FOR KEYPRESS
63000 GET X$:IF X$<>"" THEN 63000
63010 GET X$:IF X$="" THEN 63010
63020 RETURN
REM JUST WORKING ON THIS AREA OF CODE AT THE MOMENT
REM SKIP ALL THE OTHER STUFF
PRINT:PRINT
PRINT FRE(0)
PRINT:PRINT
-
ahenry3068
- Posts: 1138
- Joined: Tue Apr 04, 2023 9:57 pm
Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH
I missed my goal of a playable version by Sep 01.
Anyway I haven't stopped work on this just other things to do too.
I've had a water leak under my house, had to do two oil changes (my son's car and mine)
Plus a couple 6 day work weeks.
There are just a couple visible changes in this latest code when running the program.
The Player interface is in I think close to the final position on screen. There are a couple
elements to add to it.
Also when the program is Awaiting a Key I didn't change any messages but a Mouse
button click now works as well.
I've been doing a lot of clean up work on the code though. Shifting around line numbers
and making a bit more room to implement the game logic. And doing little things here and
there to save memory, when I find them.
Its another work day and I'm posting just before I have to stop and get ready for work
HERES THE CURRENT CODE
Anyway I haven't stopped work on this just other things to do too.
I've had a water leak under my house, had to do two oil changes (my son's car and mine)
Plus a couple 6 day work weeks.
There are just a couple visible changes in this latest code when running the program.
The Player interface is in I think close to the final position on screen. There are a couple
elements to add to it.
Also when the program is Awaiting a Key I didn't change any messages but a Mouse
button click now works as well.
I've been doing a lot of clean up work on the code though. Shifting around line numbers
and making a bit more room to implement the game logic. And doing little things here and
there to save memory, when I find them.
Its another work day and I'm posting just before I have to stop and get ready for work
HERES THE CURRENT CODE
Code: Select all
10 SCREEN $80:MOUSE 1
15 DIM TC%(2,8):DIM AL%(4 ,26)
20 GOSUB 59000 : REM INITIALIZE ALL VARIABLES
REM SKIP INTRO
21 REM GOTO 2640
40 RECT 0,0,319,239,$3B
45 RECT 3,3,316,236,$10:GOSUB 1000
50 DC$=CHR$(228):GOSUB 180
55 DC$=CHR$(162):GOSUB 180
60 REM GOSUB TO MAKE 166 TO SOLID BLOCK CHAR
65 DC$=CHR$(113):GOSUB 180
70 CHAR 75,165,$A9,CHR$($0C)+"THE CLASSIC WORD GAME"
75 CHAR 62,180,$AB,CHR$($0C)+"NOW ON THE COMMANDER X16"
80 CHAR 4,222,1,"CODED IN BASIC"
85 CHAR 4,232,1,"2023.. ANTHONY HENRY"
86 CHAR 185,222,1,"MUSIC CONTRIBUTED BY"
87 CHAR 205,232,1,"MOOINGLEMUR"
90 GOSUB 270:GOSUB 300
95 RESTORE 50300:GW=0
100 READ PS$,DL
105 IF DL=0 THEN 95
110 FMCHORD 0,PS$
115 FOR I=1 TO DL
120 GET X$
125 IF X$ <>"" OR MB<>0 THEN GW=1
130 GOSUB 275
135 NEXT I
140 IF GW=1 THEN GW=0:GOTO 150
145 GOTO 100
150 FOR X = 1 TO 31
160 LOCATE 1,1:PRINT CHR$(145)
161 READ PS$,DL:IF DL=0 THEN RESTORE 50300:GOTO 161
162 FMCHORD 0,PS$
166 FOR I = 1 TO DL:GOSUB 275:NEXT I
170 NEXT X
171 READ PS$,DL
172 IF DL=0 THEN 178
173 FMCHORD 0,PS$
174 SLEEP DL
175 GOTO 171
178 FMINIT
179 GOSUB 59300:GOTO 2640
180 X = 5:Y=2:UC=1:WD$="Hang"
185 GOSUB 39600
190 X=8:Y=11:WD$="Man"
195 GOSUB 39600
200 RETURN
REM PALLETTE ANIMATION FOR TITLE SCREEN
270 P1=13
275 IF P1=2 THEN P2=13:GOTO 285
280 P2 = P1 - 1
285 GOSUB 40500
290 P1 = P1 - 1:IF P1<2 THEN P1=13
295 RETURN
REM DRAW STICK FIGURE HANGMAN
300 LINE 180,210,300,210,$53
311 LINE 180,209,299,209,$53
320 LINE 300,210,300,17,$53
321 LINE 299,209,299,18,$53
325 LINE 300,17,100,17,$53
326 LINE 299,18,100,18,$53
400 LINE 102,19,102,38,$57
405 FILL=0:CC=$57:YS=.4:XS=1:RA=13:CX=102:CY=45
410 GOSUB 3000
425 YS=1:XS=.8:CY=35:RA=10:CC=$25:FILL=1:GOSUB 3000
426 CX=CX-3:RA=2:CY=CY-2:CC=2:GOSUB 3000:CX=CX+6:GOSUB 3000
430 LINE 102,44,102,49,$25
435 LINE 102,51,102,78,$25
440 LINE 102,53,88,64,$25
445 LINE 102,53,116,64,$25
450 LINE 102,78,87,99,$25
455 LINE 102,78,117,99,$25
500 RETURN
1000 R%=15:G%=0:B%=2
1005 P1=$3B:P2=10:GOSUB 41000
1006 P1=1:P2=11:GOSUB 41000
1007 P1=$C7:P2=12:GOSUB 41000
1008 P1=$A0:P2=13:GOSUB 41000
1010 FOR I= 2 TO 9
1015 TC%(2,I-1) = 0
1020 TC%(1,I-1) = I
1025 P1 = I:GOSUB 40000:R%=R%-1
1030 IF I/3 = INT(I/3) THEN R%=R%-1:G%=G%+1
1050 NEXT I
1090 RETURN
2640 GOSUB 45000:GOSUB 59300
REM THE BACKGROUND
2650 GOSUB 5000
REM GALLOWS
2655 GOSUB 7000
REM ROPE
2660 GOSUB 8000
REM THE HEAD AND FACE
2665 GOSUB 9500
REM TORSO
2670 GOSUB 10000
REM LEFT ARM
2675 GOSUB 11000
REM RIGHT ARM
2680 GOSUB 12000
REM RIGHT LEG
2685 GOSUB 12500
REM LEFT LEG
2690 GOSUB 12620
2695 DM$="AWAITING KEY":GOSUB 20010:GOSUB 63000
2700 GOSUB 20100
REM DEADFACE
2705 GOSUB 4000
REM PULSING EYES
2710 GOSUB 20010:GOSUB 4200
REM RESTORE DRAWING PALLETTE
2715 GOSUB 59300
2720 COLOR 5,6:X=13:Y=5:H=3:W=22
2725 GOSUB 3600:COLOR 1
2730 LOCATE 6,14:PRINT "????????????????????";
2736 DM$=" CLUE GOES HERE : ANY KEY TO END DEMO":GOSUB 20010
2740 L=65
2745 X=131:Y=97:W=14:C1=1:C2=$17:C3=$C2:C4=$1E
2746 FRAME 123,90,261,171,$10
2747 RECT 124,91,260,170,$C0:RECT 126,94,258,168,$06
2750 SX=X
2755 FOR KK = 1 TO 3
2760 FOR J = 1 TO 7
2765 L$=CHR$(L)
2770 GOSUB 2900
2775 I=L-64
2780 AL%(1,I)=0
2785 AL%(2,I)=L
2790 AL%(3,I)=X
2795 AL%(4,I)=Y
2800 X = X + W + 4
2805 L=L+1
2810 NEXT J
2815 Y = Y + W + 4:X=SX
2820 NEXT KK
2825 X = SX
2830 FOR J = 1 TO 5
2835 L$=CHR$(L)
2840 GOSUB 2900
2845 I=L-64
2850 AL%(1,I)=0
2855 AL%(2,I)=L
2860 AL%(3,I)=X
2865 AL%(4,I)=Y
2870 X = X + W + 4
2875 L=L+1
2880 NEXT J
2885 GOSUB 63000:MOUSE 0
REM RESTORE VERA DEFAULT PALLETTE
2890 GOSUB 45000:SCREEN 1:END
REM X,Y BUTTON POSITION
REM W CURRENTLY HEIGHT AND WIDTH MAY CHANGE FOR SEPERATE HEIGHT VARIABLE
REM C1, C2 3D BORDER COLORS
REM C3 CENTER COLOR
REM C4 TEXT LABEL COLOR
REM L$ THE TEXT LABEL
REM DRAW 3-D BUTTON WITH LABEL L$ AT X,Y
2900 X1=X+1:XW=X+W:YW=Y+W:Y1=Y+1
2905 Y5=YW-1:X5=XW-1
2910 LINE X,Y,XW,Y,C1
2915 LINE X1,Y1,X5,Y1,C1
2920 LINE XW,Y,XW,YW,C1
2925 LINE X5,Y1,X5,Y5,C1
2930 LINE X,Y,X,YW,C2
2940 LINE X1,Y1,X1,Y5,C2
2950 LINE X,YW,X,YW,C2
2955 LINE X,YW,X5,YW,C2
2960 LINE X,Y5,XW-2,Y5,C2
2965 RECT X+2,Y+2,XW-2,YW-2,C3
2970 CHAR X+3,YW-3,C4,L$
2980 RETURN
REM BRESHNAHM CIRCLE
REM EXTRA CODE TO ENABLE TURNING ON AND OFF QUARTERS
REM X AND Y SCALING(XS & YS) AND CLIPPING AT EDGE OF SCREEN
REM TOOK OUT ERROR CHECKING FOR YS AND XS. * MAKE SURE CORRECT IN MAIN CODE *
3000 WR=RA:X=0: D=2*(1-RA):W=INT(2*320/240)
REM WHILE WR<0
3010 IF WR < 0 THEN 3350
3020 DX=X*XS:DY=WR*YS
3080 ZX=CX-DX
3090 ZY=CY-DY
3100 AX=CX+DX
3110 AY=CY+DY
3115 IF FILL=1 THEN 3165
3118 IF ZX<0 OR ZX>XL OR ZY<0 OR ZY>YL OR Q1=0 THEN 3130
3120 PSET ZX, ZY, CC
3130 IF AX<0 OR AX>XL OR ZY<0 OR ZY>YL OR Q2=0 THEN 3140
3131 PSET AX, ZY, CC
3140 IF ZX<0 OR ZX>XL OR AY<0 OR AY>YL OR Q3=0 THEN 3150
3141 PSET ZX, AY, CC
3150 IF AX<0 OR AX>XL OR AY<0 OR AY>YL OR Q4=0 THEN 3300
3151 PSET AX, AY, CC
3160 GOTO 3300
3165 X1=ZX:X2=AX
3166 IF (Q1=0 AND Q2=O) OR X1>XL THEN 3200
3170 IF ZY<0 OR ZY>YL THEN 3200
3171 IF X1<0 THEN X1=0
3172 IF X2>XL THEN X2=XL
3176 IF Q1=0 THEN X1=CX
3177 IF Q2=0 THEN X2=CX
3180 LINE X1,ZY,X2,ZY,CC
3200 IF (Q3=0 AND Q4=0) OR ZX>XL THEN 3300
3203 IF AY<0 OR AY>YL THEN 3300
3204 IF ZX<0 THEN ZX=0
3205 IF AX>XL THEN AX=XL
3210 IF Q3=0 THEN ZX=CX
3215 IF Q4=0 THEN AX=CX
3220 LINE ZX,AY,AX,AY,CC
3300 IF (D+RA)>0 THEN WR=WR-1:D=D-W*WR-1
3310 IF X>D THEN X=X+1: D=D+2*X+1
3320 GOTO 3010
REM WEND
3350 RETURN
REM STRIPPED BRESHNAHM CIRCLE ALGORITHM FOR CLOUD DRAWING
REM STRIPPED FOR SPEED.
3500 WR=RA:G=0: D=2*(1-RA):W=INT(2*320/200)
REM WHILE WR<0
3505 IF WR < 0 THEN 3535
3510 LINE CX-G,CY-WR,CX+G,CY-WR,CC
3515 LINE CX-G,CY+WR,CX+G,CY+WR,CC
3520 IF (D+RA)>0 THEN WR=WR-1:D=D-W*WR-1
3525 IF G>D THEN G=G+1: D=D+2*G+1
3530 GOTO 3505
REM WEND
3535 RETURN
REM DRAW TEXT BOX
3600 LOCATE Y,X
3605 PRINT CHR$($6F);RPT$($A3,W-2);CHR$($70);
3610 IF H=2 THEN 3635
3615 FOR II = 1 TO H-2
3620 LOCATE Y+II,X
3625 PRINT CHR$($A5);RPT$(32,W-2);CHR$($A7);
3630 NEXT II
3635 LOCATE Y+H-1,X
3640 PRINT CHR$($6C);RPT$($A4,W-2);CHR$($BA);
3645 RETURN
REM DEADFACE
4000 P1=$24:P2=$FF:J=4:GOSUB 40200
4010 P1=$3B:P2=$FE:J=4:GOSUB 40200
4011 P1=$01:J=3:GOSUB 40200
4012 P1=$3A:J=1:GOSUB 40200
4013 P1=$15:J=3:GOSUB 40200
4014 P1=$3B:J=4:GOSUB 40200
4015 P1=$23:P2=$FF:J=6:GOSUB 40200
4016 P1=$B8:J=5:GOSUB 40200
4020 P1=$BF:GOSUB 40200
4030 P1=$C0:GOSUB 40200
4100 RETURN
REM EYE PULSING WHILE WAIT FOR KEY
4200 P1=$FE:G%=0:B%=0
4205 GET X$:IF X$<>"" THEN 4205
4210 GET X$
4211 IF MB<>0 THEN X$="A"
4215 IF X$<>"" THEN RETURN
4220 R%=RND(1)*15+1
4225 B%=RND(1)*6
4226 IF MB<>0 THEN X$="A":GOTO 4215
4230 GOSUB 40300
4235 GOTO 4210
REM IY LOCATE Y LOCATION
REM IX LOCATE X LOCATION
REM ML MAX LENGTH OF STRING TO GET (1 TO 80)
REM IT TYPE OF INPUT 1=ALPHA ONLY, 2=NUMERIC(INCLUDE 1 AND ONLY 1 DECIMAL
REM POINT)
REM 3=ALPHANUMERIC, 4=LINE INPUT(CAN INCLUDE SPACE AND
REM TAB AND PUNCTUATION MARKS)
REM IS$ THE STRING TO RETURN
REM AC ADD CHAR 1=YES
REM ID DECIMAL DONE 1=YES
REM SPECIALIZED INPUT ROUTINE
4800 GET X$:IF X$<>"" THEN 4800
4801 IS$="":ID=0
REM BEFORE INPUT BEGINS
4805 GOSUB 4920
4810 GET X$:IF X$="" THEN 4810
4811 C=ASC(X$)
4815 IF WL=ML THEN
4820 AC=0
4830 IF (IT<>2 OR IT=3) AND C>=65 AND C<=90 THEN AC=1
4835 IF (IT=2 OR IT=4 OR IT=3) AND C>=48 AND C<=57 THEN AC=1
4840 IF (IT=2) AND C=46 AND ID=0 THEN AC=1:ID=1
4845 IF (IT=4) AND C=32 THEN AC = 1: REM ALLOW SPACES WHEN INPUTTING A LINE
4846 IF (IT=4) AND (C>=35 AND C<=47) THEN AC=1
4847 IF (IT=4) AND (C>=58 AND C<=63) THEN AC=1 : REM ALLOW PUNCS IN STRING.
4850 IF C=13 THEN RETURN
4855 IF AC=1 AND LEN(IS$)<ML THEN PRINT CHR$(C);:IS$=IS$+CHR$(C):GOTO 4810
4860 IF C<>20 THEN 4895
4861 IF LEN(IS$) = 0 THEN PRINT CHR$(7);
4865 IF LEN(IS$)=1 OR LEN(IS$)=0 THEN IS$="":GOSUB 4920:GOTO 4810
4870 I = LEN(IS$)-1
4871 IF RIGHT$(IS$,1)="." AND IT=2 THEN ID=0
4875 IS$=LEFT$(IS$,I)
4890 GOSUB 4920:PRINT IS$;:GOTO 4810
4895 PRINT CHR$(7);:GOTO 4810
4920 LOCATE IY,IX:FOR I = 1 TO ML+1:PRINT " ";:NEXT I
4921 LOCATE IY,IX
4925 RETURN
5000 DM$="THE SKY":GOSUB 20000
REM THE SKY
5005 RECT 0,0, XLIMIT, YLIMIT, 14
5010 P1=14:P2=$10:GOSUB 41000
5020 CX = 5:CY=4:CC=$10:FILL = 1:XS=1:YS=1:RA=32
5025 GOSUB 3000
5029 DM$="THE SUN":GOSUB 20000
5030 CC = $07
5038 FILL = 1: RA = 30:GOSUB 3000:FILL=0
REM BRUTE FORCE, RAYS FROM THE SUN...
REM USING SCRATCH PALLETTE ENTRY AT $F1 SO
REM I CAN USE FADE EFFECT, FINAL COLOR WILL BE THE
REM SAME AS AT DEFAULT PALLETTE $07
5050 C=$F1:P1=14:P2=C:GOSUB 41000
5051 LINE 2,37,2,44,C:LINE 6,37,6,44,C:LINE 9,37,10,44,C
5054 LINE 12,36,14,43,C:LINE 15,35,17,42,C:LINE 18,34,21,41,C
5057 LINE 20,33,24,39,C:LINE 22,31,27,37,C:LINE 24,28,29,35,C
5060 LINE 27,25,32,32,C:LINE 30,23,35,29,C:LINE 32,21,37,26,C
5063 LINE 33,19,39,23,C:LINE 35,17,41,20,C:LINE 36,15,43,17,C
5066 LINE 37,12,44,14,C:LINE 38,10,45,11,C:LINE 39,7,45,8,C
5069 LINE 39,4,45,5,C:LINE 39,1,46,2,C
5071 P1=0:P2=$10:J=3:GOSUB 40200
5072 P1=7:P2=$F1:GOSUB 40200
REM DRAW CLOUDS AT GOSUB 6500
5095 GOSUB 6500:GOSUB 6500:GOSUB 6500:GOSUB 6500
5100 DM$="GRASS":GOSUB 20000
5110 RECT 0, 180, XLIMIT, YLIMIT, $85
5120 FOR Y = 161 TO 179
5130 LINE 0, Y, 40, 179, 105
5140 NEXT Y
5150 FOR Y = 180 TO 150 STEP -1
5160 LINE 288,179, XLIMIT, Y, 105
5170 NEXT Y
5171 COLOR 1
REM DRAW RANDOM GRASS
6000 FOR I = 1 TO 400
6110 X1 = INT(RND(1)*310) + 5
6120 Y1 = INT(RND(1)*60) + 180:IF Y1 > YLIMIT THEN GOTO 6120
6130 GOSUB 6200
6140 NEXT I
REM 6185 FOR I = 1 TO 10:X1=INT(RND(1)*310)+5:Y1=INT(RND(1)*4)+180
REM 6186 GOSUB 6200:NEXT I
6150 RETURN
6200 GOSUB 6400
6210 LINE X1,Y1,X1-4,Y1-5,GC:GOSUB 6400
6215 LINE X1,Y1,X1-3,Y1-3,GC:GOSUB 6400
6220 LINE X1,Y1,X1,Y1-5,GC:GOSUB 6400
6225 LINE X1,Y1,X1+3,Y1-3,GC:GOSUB 6400
6230 LINE X1,Y1,X1+4,Y1-5,GC
6235 RETURN
6400 GC=INT(RND(1)*24)+$60:RETURN
6500 REM SUPPOSED TO BE A CLOUD HERE
6502 DM$="CLOUDS":GOSUB 20000
6540 H = INT(RND(1)*(200))+ 45
6541 HL = INT(RND(1)*30)+30
6545 V = INT(RND(1)*30) + 6
6550 VB = INT(RND(1)*11) + 7
6555 FOR Y = V TO V+VB STEP 3
6560 FOR X = H TO H + HL STEP 4
6580 RA = INT(RND(1)*5)+3
6585 CC = INT(RND(1)*4)+ $1C
6590 CX=X
6592 CY= INT(RND(1)*4) + (Y-4):IF (CY - RA) < 0 THEN 6580
6600 GOSUB 3500
6605 NEXT X
6610 NEXT Y
6615 RETURN
REM THE GALLOWS
7000 DM$="THE GALLOWS":GOSUB 20000
7010 FRAME 189,195,285,208,$10
7020 FRAME 188,194,285,211,$10
7021 LINE 189,210,285,210,$10
7022 PSET 189,209,$10
7023 PSET 284,206,$10
7024 PSET 284,209,$10
7030 FRAME 275,21,285,207,$10
7040 FRAME 276,22,284,205,$10
7050 FRAME 67,20,285,30,$10
7060 FRAME 68,21,284,29,$10
7070 RECT 71,30,79,33,$10
7080 RECT 190,196,283,209,$53
7090 RECT 277,23,283,209,$53
7100 RECT 69,22,283,28,83
7150 RETURN
REM THE ROPE
8000 DM$="THE NOOSE":GOSUB 20000
8005 FILL = 0
8010 LINE 73,33,73,53,16
8020 LINE 77,33,77,53,16
8030 RECT 74,34,76,53,87
8040 FOR Y = 38 TO 53 STEP 3
8050 LINE 73, Y, 77, Y - 3, $10
8060 NEXT Y
8070 FRAME 71,53,80, 68, 16
8080 RECT 72,54,79,68,87
8090 FOR Y = 56 TO 68 STEP 4
8100 LINE 72,Y,79, Y-4, $10
8110 NEXT Y
REM THE NOOSE
8130 RA = 24
8140 YS = .38
8150 CX = 75:CY = 79:CC=$10
8160 GOSUB 3000:RA=25:GOSUB 3000
8165 RA=24:GOSUB 3000
8166 RA =23:GOSUB 3000
8170 RA = 19:GOSUB 3000
8175 RA = 18:GOSUB 3000
8180 CC = 87
8190 FOR X = 20 TO 23 STEP .6
8200 RA=X:GOSUB 3000
8210 NEXT X
9000 YS=1:RETURN
REM END ROPE
REM THE FACE
9500 DM$="A TROUBLED FACE":GOSUB 20000
REM HIS EARS
9501 CX=58:CY=60:RA=6:XS=.4:CC=$10
9505 Q1=1:Q2=0:Q3=1:Q4=0
9510 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9520 FILL=1:CC=$25:GOSUB 3000
9530 FILL=0:CX=90:RA=6:CC=$10
9531 Q1=0:Q2=1:Q3=0:Q4=1
9540 GOSUB 3000:RA = RA-1:GOSUB 3000:RA=RA-1:GOSUB 3000
9550 FILL=1:CC=$25:GOSUB 3000
9551 LINE 93,58,93,62,$10
9555 Q1=1:Q2=Q1:Q3=Q1:Q4=Q1
REM DRAW HIS NECK
9560 LINE 67,76,67,84,$10
9570 LINE 66,76,66,84,$10
9580 LINE 67,87,67,90,$10:LINE 66,87,66,90,$10
9590 LINE 82,76,82,84,$10
9600 LINE 83,76,83,84,$10
9605 LINE 82,87,82,90,$10:LINE 83,87,83,90,$10
9610 RECT 68,76,81,84,$25
9620 RECT 68,89,81,90,$25
REM END NECK
9630 RA=20:XS=.8:FILL=1
9640 CC=$10:CX=74:CY=63
9650 GOSUB 3000:RA = RA - 1:GOSUB 3000
9670 RA=RA-2:CY=CY+1:CC=$FF:FILL=1:GOSUB 3000
9680 XS = 1:YS = XS
REM RIGHT EYE
9690 CY=CY-6:CX = CX-6:RA=3:CC=$FE:GOSUB 3500
9700 PSET CX+4,CY,$FF:GOSUB 9950
REM LEFT EYE
9710 CX = CX + 12:GOSUB 3500
9720 PSET CX+4,CY,$FF:GOSUB 9950:CX = 74:CY = 63
9730 LINE CX-1,CY, CX - 2, CY + 6, $10
9740 LINE CX+1,CY, CX + 2, CY + 6, $10
9750 LINE CX,CY,CX -1, CY + 6, $23
9760 LINE CX,CY,CX + 1, CY + 6, $23
9770 LINE CX,CY+3,CX,CY+6,$22
9780 Q3=0:Q4=0:CC=$10:CY = CY + 13:YS=.35:RA=6:FILL=0
9790 GOSUB 3000
9800 CY = CY + 1:CC=$31:GOSUB 3000
9805 CY = CY + 1:CC=$10:GOSUB 3000
REM REMEMBER TO TURN CIRCLE FULLY ON !!!
9806 Q3=1:Q4=1:YS=1
9810 RETURN
REM THE PUPILS
9950 PSET CX,CY,$10:PSET CX -1,CY,$10
9955 PSET CX,CY +1,$10:PSET CX - 1, CY + 1 ,$10
9960 RETURN
REM END FACE
REM THE TORSO
10000 DM$="TORSO":GOSUB 20000
10001 LINE 82,90,105,93,$10
10005 LINE 83,91,105,94,$10
10010 LINE 68,90,42,93, $10
10015 LINE 69,91,42,94, $10
10020 LINE 67,90,74,105,$10
10025 LINE 83,90,74,105,$10
REM THIS FOR LOOP FILLS IN THE NECKLINE
10030 FOR X=81 TO 68 STEP -1
10035 LINE 75,103,X, 90, $25
10040 NEXT X
10053 LINE 74,105,72,110,$10
10054 LINE 72,110,72,141,$10
10055 LINE 72,141,53,144,$10
10060 LINE 53,144,53,108,$10
10065 RECT 71,140,54,103,$08
10066 LINE 54,141,68,141,$08
10067 LINE 54,142,62,142,$08
10068 LINE 54,143,56,143,$08
10069 PSET 65,91,$10
10070 LINE 72,102,72,108,$08
10071 LINE 73,104,73,106,$08
10072 PSET 74,109,$08
10073 RECT 47,107,68,94,$08
10074 RECT 69,96,69,99,$08
10076 RECT 42,107,48,95,$08
10077 LINE 56,93,67,93, $08:PSET 55,92,$10:PSET 64,91,$10
10078 LINE 65,92,67,92, $08
10079 RECT 68,100,71,102,$08
10080 LINE 70,98,70,100, $08
10090 RECT 73,110,91,140,$08
10095 RECT 75,105,91,109,$08
10120 RECT 88, 94, 101, 106, $08
10125 RECT 81, 95, 105, 106, $08
10130 LINE 80, 96, 80, 105, $08
10135 LINE 79,98,79,105, $08
10140 LINE 78,100,78,105,$08
10145 LINE 77,101,77,105,$08
10150 LINE 76,103,76,105,$08
10155 LINE 74,103,75,103, $10
10160 PSET 76,101,$10:PSET 73,101,$10:PSET 72,99,$10:PSET 71,97,$10
10165 PSET 70,95,$10:PSET 69,93,$10:PSET 81,92,$10:PSET 80,94,$10
10166 PSET 80,96,$10:PSET 78,97,$10:PSET 77,99,$10
10167 LINE 76,100,76,103,$10
10175 RECT 82, 94, 93, 93, $08
10180 LINE 83, 92, 86, 92, $08
10185 LINE 74, 107,74, 108,$08
10190 PSET 73,109,$10:PSET 73,141,$10
10200 LINE 76,141,91,141,$08
10205 LINE 81,142,91,142,$08
10210 LINE 89,143,91,143,$08
10360 LINE 74,141,92,144,$10
10365 LINE 92,144,92,107,$10
REM STRAY PIXEL AT WAISTLINE
12366 PSET 73,141,$10
REM SHIRT BUTTONS
10370 CC = 16:RA = 1.2
10375 CX=75:FILL=1
10385 FOR CY=113 TO 143 STEP 8
10390 GOSUB 3000
10400 NEXT CY
REM POCKET AND PRISONER NUMBER
10410 LINE 58,108,68,108,$10
10415 LINE 58,108,58,116,$10
10420 LINE 68,108,68,116,$10
10425 Q1=0:Q2=0:Q3=1:Q4=1:RA=4.5:XS=1:YS=.6
10430 CX=63:CY=116:CC=$10:FILL=0
10435 GOSUB 3000
10436 PN$="P-1"
10440 CHAR 57,106,$10,PN$
10600 RETURN
REM ARM ON THE RIGHT (LEFT ARM)
11000 Q1=0:Q2=1:Q3=0:Q4=0:FILL = 0
11005 DM$="LEFT ARM":GOSUB 20000
11010 XSQUISH=.52
11020 RA=16:CC=$10
11030 CY=116:CX=92
11035 GOSUB 3000:RA=RA+.6
11040 GOSUB 3000
11060 RA=RA-1:GOSUB 3000
11090 XSQUISH=.28:CX = 106:CY = 105:FILL=0
11095 GOSUB 3000
11096 FOR L=1 TO 3:RA=RA+.5:GOSUB 3000:NEXT L
11100 CC=$08:Q1=0:Q2=1:Q3=0:Q4=0:FILL=1:RA=RA-2.5
11105 GOSUB 3000
11110 RECT CX-1,CY-3,CX+2,CY-7,$08
11120 LINE 99,113,99,133,$10
11130 LINE 111,102,111,133,$10
11135 RECT 100,102,110,133,$08
11140 LINE 99,107,99,109,$08
11145 LINE 98,108,101,108,$08
11150 LINE 97,107,100,107,$08 :PSET 94,107,$0E
11155 LINE 99,134,111,134,$10
REM (THE LEFT HAND)
11160 LINE 101,134,101,143,$10:LINE 101,143,103,143,$10
11166 LINE 102,142,102,139,$25:LINE 103,144,103,140,$10
11175 LINE 103,145,105,145,$10:LINE 104,144,104,139,$25
11180 LINE 105,146,105,140,$10:LINE 105,146,107,146,$10
11186 LINE 106,145,106,139,$25:LINE 107,146,107,140,$10
11195 LINE 107,145,109,145,$10:LINE 108,144,108,139,$25
11200 LINE 109,145,109,134,$10:RECT 102,139,108,135,$25
11210 RETURN
REM ARM ON THE LEFT (RIGHT ARM)
12000 Q1=1:Q2=0:Q3=0:Q4=0:FILL=0
12010 XSQUISH=.52
12020 RA=16:CC=$10
12030 CY=118:CX=54
12031 DM$="RIGHT ARM":GOSUB 20000
12035 GOSUB 3000:RA=RA+.6
12040 GOSUB 3000
12060 RA=RA-1:GOSUB 3000
12061 LINE 54,107,54,109,$08
12090 XSQUISH=.43:CX = 42:CY = 105:FILL=0
12095 GOSUB 3000
12097 FOR L=1 TO 3:RA=RA+.3:GOSUB 3000:NEXT L
12100 CC=$08:Q1=1:Q2=0:Q3=0:Q4=0:FILL=1:RA=RA-3
12105 GOSUB 3000:FILL=0
REM 12105 FOR RA = 14 TO 12 STEP -.7
REM 12110 GOSUB 3000:IF RA =12 THEN Q1=1
REM 12115 NEXT RA
REM 12116 LINE 54,107,54,109,$08
12117 RECT CX-4,CY-8,CX+3,CY+6,$08
12118 RECT CX-4,CY-4,CX,CY+6,$08
12120 LINE 34,102,34,133,$10
12130 LINE 46,115,46,133,$10
12135 RECT 35,102,45,133,$08
12136 LINE 34,134,46,134,$10
12140 LINE 46,CY,46,CY+6,$08
12142 LINE 47,CY,47,CY+5,$08
12145 RECT 47,CY,49,CY+3,$08
12150 LINE 51,CY+4,52,CY+4,$0E
12155 PSET 48,CY+4, $08
REM (THE LEFT HAND)
12160 LINE 44,134,44,143,$10:LINE 44,143,42,143,$10
12166 LINE 43,142,43,139,$25:LINE 42,140,42,145,$10
12175 LINE 42,145,40,145,$10:LINE 41,144,41,139,$25
12180 LINE 40,146,40,140,$10:LINE 40,146,38,146,$10
12186 LINE 39,145,39,139,$25:LINE 38,146,38,140,$10
12195 LINE 38,145,36,145,$10:LINE 37,144,37,139,$25
12200 LINE 36,145,36,134,$10:RECT 43,139,37,135,$25
12210 RETURN
REM RIGHT LEG
12500 Q1=1:Q2=0:Q3=0:Q4=0
12505 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12506 DM$="RIGHT LEG":GOSUB 20000
12510 GOSUB 3000
12515 LINE 70,159,70,192,$10:LINE 55,145,53,192,$10
12525 LINE 53,193,70,193,$10:RECT 56,145,69,192,$46
12535 LINE 55,157,55,192,$46:LINE 54,181,54,192,$46
12555 LINE 57,144,71,144,$46:RECT 69,142,71,154,$46
12565 RECT 72,142,73,153,$46:LINE 63,143,68,143,$46:PSET 70,155,$46
REM THE FOOT
12580 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1:CX=62:CY=208
12585 GOSUB 3000:RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12590 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12591 RA = RA+1:CC=$12:FILL=0:GOSUB 3000
12595 LINE 57,193,57,202,$10:LINE 66,193,66,202,$10
12605 RECT 58,194,65,200,$1C
12610 RETURN
REM LEFT LEG
12620 Q1=0:Q2=1:Q3=0:Q4=0
12625 CC=$10:CX=74:CY=159:RA=8:XQUISH=.10
12626 DM$="LEFT LEG":GOSUB 20000
12630 GOSUB 3000
12635 LINE 77,157,77,192,$10:LINE 90,145,92,192,$10
12645 LINE 77,193,92,193,$10:RECT 78,145,89,192,$46
12655 LINE 90,157,90,192,$46:LINE 91,181,91,192,$46
12665 LINE 74,144,88,144,$46:RECT 76,143,79,155,$46
12675 RECT 74,142,76,153,$46:LINE 74,143,82,143,$46
12685 LINE 77,154,77,156,$46
REM THE FOOT
12690 Q1=1:Q2=1:Q3=1:Q4=1:RA=20:XS=.35:CC=$10:FILL=1
12695 CX=85:CY=208
12700 GOSUB 3000
12705 RA=RA+1:FILL=0:CC=$12:GOSUB 3000:FILL=1
12710 XS=.38:CY=204:CC=$1C:RA=11:GOSUB 3000
12715 RA = RA+1:CC=$12:FILL=0:GOSUB 3000
12720 LINE 80,193,80,202,$10:LINE 89,193,89,202,$10
12730 RECT 81,194,88,200,$1C
12740 RETURN
REM PLACE A MESSAGE ON THE BOTTOM OF THE SCREEN
20000 DM$=" DRAWING: "+DM$
20010 COLOR 1,0:GOSUB 20100
20015 LOCATE 30,1:PRINT DM$;
20020 RETURN
20100 LOCATE 30,1:PRINT RPT$(32,39);
20101 RETURN
REM BIGWORD ROUTINE.. READS ROM FONT AND BLOWS IT UP
39600 L=LEN(WD$):SX = X
39665 OB=PEEK(1):BANK PEEK(0),6
39675 FOR K=1 TO L
39680 CC=ASC(MID$(WD$,K,1))
REM READ IN A CHARACTER MAP CC
REM AND PRINT IT OUT AT Y,X
39685 IF (CC>=64 AND CC<=90) OR (CC>=193 AND CC<=218) THEN AA=64:GOTO 39695
39690 AA=0
39695 CA=$C000 + 8*(CC-AA)
39700 FOR I=1 TO 8
39710 CM(I) = PEEK(CA+(I-1)):CM$(I)=""
39715 NEXT I
39720 IF DC$="" THEN DC$=CHR$(CC)
39725 FOR J=1 TO 8
39730 RESTORE 50200
39735 FOR CT=1 TO 8
39740 READ CP
39745 IF (CP AND CM(J)) THEN CM$(J)=CM$(J)+DC$:GOTO 39755
39750 CM$(J)=CM$(J)+CHR$(32)
39755 NEXT CT
39760 LOCATE Y+(J-1),X:IF UC=1 THEN COLOR TC%(1,J),TC%(2,J)
39765 PRINT CM$(J);
39770 NEXT J
39775 IF DC$=CHR$(CC) THEN DC$=""
39780 X=X+8
39785 NEXT K
39790 X=SX
39795 BANK PEEK(0),OB
39800 RETURN
REM SET PALLETTE ENTRY P1 TO R%,G%,B%
40000 VPOKE 1,$FA00+(P1*2),(G%*16) + B%
40010 VPOKE 1,$FA00+((P1*2)+1),R%
40020 RETURN
REM READ PALLETTE ENTRY AT P1
REM RETURNED IN %R,%G,%B
40100 A1=$FA00+(P1*2)
40105 R%=VPEEK(1,A1+1)
40110 GB%=VPEEK(1,A1)
40115 G%=GB%/16
40120 B%=GB% AND $0F
40125 RETURN
REM FADE P2 FROM CURRENT COLOR TO P1 COLOR, J IS JIFFY DELAY
40200 GOSUB 40100
40205 P3=P1
40210 P1=P2
40215 GOSUB 40300
40220 P1=P3
40225 RETURN
REM FADE P1 TO R%,G%,B%, J IS JIFFY DELAY
40300 DR%=R%:DG%=G%:DB%=B%
40305 GOSUB 40100
40310 RI=1:IF DR%<R% THEN RI=-1
40315 GI=1:IF DG%<G% THEN GI=-1
40320 BI=1:IF DB%<B% THEN BI=-1
40325 IF DR%<>R% THEN R%=R%+RI
40330 IF DG%<>G% THEN G%=G%+GI
40335 IF DB%<>B% THEN B%=B%+BI
40340 GOSUB 40000
40345 SLEEP J
40350 IF DR%=R% AND DG%=G% AND DB%=B% THEN 40360
40355 GOTO 40325
40360 RETURN
REM SWAP PALLETTE COLORS AT P1 & P2
40500 A1=$FA00+(P1*2):A2=$FA00+(P2*2)
40510 B1=VPEEK(1,A1):B2=VPEEK(1,A1+1)
40520 B3=VPEEK(1,A2):B4=VPEEK(1,A2+1)
40530 VPOKE 1,A1,B3:VPOKE 1,A1+1, B4
40450 VPOKE 1,A2,B1:VPOKE 1,A2+1, B2
40560 RETURN
REM COPY P1 PALLETTE ENTRY TO P2.. P1 IS LEFT UNCHANGED.
41000 VPOKE 1,$FA00+(P2*2),VPEEK(1,$FA00+(P1*2))
41010 VPOKE 1,$FA00+(P2*2)+1,VPEEK(1,$FA00+(P1*2)+1)
41020 RETURN
REM LOOP THROUGH THE PALLETTE ADDRESS SPACE
REM AND POKE THE VERA DEFAULT PALLETTE
45000 RESTORE 50000
45020 FOR PE=$FA00 TO $FBFE STEP 2
45025 READ R:READ GB
45030 VPOKE 1,PE,GB:VPOKE 1,PE+1,R
45040 NEXT PE
45050 RETURN
REM DEFAULT VERA PALLETTE AS DATA. FROM 0 TO 255 (2 BYTES EACH ENTRY)R,GB
50000 DATA 0,0,15,255,8,0,10,254,12,76,0,197,0,10,14,231,13,133,6,64,15,119,3
50005 DATA 51,7,119,10,246,0,143,11,187,0,0,1,17,2,34,3,51,4,68,5,85,6,102,7
50010 DATA 119,8,136,9,153,10,170,11,187,12,204,13,221,14,238,15,255,2,17,4,51
50015 DATA 6,68,8,102,10,136,12,153,15,187,2,17,4,34,6,51,8,68,10,85,12,102,15
50020 DATA 119,2,0,4,17,6,17,8,34,10,34,12,51,15,51,2,0,4,0,6,0,8,0,10,0,12,0
50025 DATA 15,0,2,33,4,67,6,100,8,134,10,168,12,201,15,235,2,17,4,50,6,83,8
50030 DATA 116,10,149,12,182,15,215,2,16,4,49,6,81,8,98,10,130,12,163,15,195,2
50035 DATA 16,4,48,6,64,8,96,10,128,12,144,15,176,1,33,3,67,5,100,7,134,9,168
50040 DATA 11,201,13,251,1,33,3,66,4,99,6,132,8,165,9,198,11,247,1,32,2,65,4
50045 DATA 97,5,130,6,162,8,195,9,243,1,32,2,64,3,96,4,128,5,160,6,192,7,240,1
50050 DATA 33,3,67,4,101,6,134,8,168,9,202,11,252,1,33,2,66,3,100,4,133,5,166
50055 DATA 6,200,7,249,0,32,1,65,1,98,2,131,2,164,3,197,3,246,0,32,0,65,0,97,0
50060 DATA 130,0,162,0,195,0,243,1,34,3,68,4,102,6,136,8,170,9,204,11,255,1,34
50065 DATA 2,68,3,102,4,136,5,170,6,204,7,255,0,34,1,68,1,102,2,136,2,170,3
50070 DATA 204,3,255,0,34,0,68,0,102,0,136,0,170,0,204,0,255,1,18,3,52,4,86,6
50075 DATA 104,8,138,9,172,11,207,1,18,2,36,3,70,4,88,5,106,6,140,7,159,0,2,1
50080 DATA 20,1,38,2,56,2,74,3,92,3,111,0,2,0,20,0,22,0,40,0,42,0,60,0,63,1,18
50085 DATA 3,52,5,70,7,104,9,138,11,156,13,191,1,18,3,36,4,54,6,72,8,90,9,108
50090 DATA 11,127,1,2,2,20,4,22,5,40,6,42,8,60,9,63,1,2,2,4,3,6,4,8,5,10,6,12
50095 DATA 7,15,2,18,4,52,6,70,8,104,10,138,12,156,15,190,2,17, 4,35,6,53,8,71
50100 DATA 10,89,12,107,15,125,2,1,4,19,6,21,8,38,10,40,12,58,15,60,2,1,4,3,6
50105 DATA 4,8,6,10,8,12,9,15,11
REM BITMAP VALUES FOR READING FONTS.
REM 50200 DATA %10000000,%01000000,%00100000,%00010000,%00001000,%00000100
REM 50205 DATA %00000010,%00000001,%00000000
50200 DATA 128,64,32,16,8,4,2,1,0
REM MUSIC FROM MOOINGLEMUR
50300 DATA "O4V63I0CO3V50I18CV50I18E-V50I18G",60,"O4CO3E-G-B-",45,"O4C",15
50305 DATA "O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60,"O4CO3E-G-B-",45
50310 DATA "O4C",15,"O4CO3CE-G",60,"RE-G-B-",60,"O4CO3CE-G",60
50315 DATA "O4CO3E-G-B-",45,"O4C",15,"O4CO3CE-G",60,"O4E-O3E-G-B-",45,"O4D",12
50320 DATA "E-",3,"O4DO3CE-G",45,"O4C",15,"O4CO3E-G-B-",45,"O4C",15
50325 DATA "O4CO3CE-G",60,"RE-G-B-",60,"",0
REM SETUP INITIAL VARIABLES
59000 XLIMIT=319:YLIMIT=239:
59002 X=RND(-TI):FMINIT
REM LOAD DEFAULT PALLETTE INIT VERA
59005 GOSUB 45000
REM SET PRETTY FONT
59007 POKE$30C,4:SYS$FF62
REM Q1-Q4 ARE INITIALIZED FOR CIRCLE DRAWING ROUTINE AT 3000
59020 Q1=1:Q2=1:Q3=1:Q4=1
59021 XS=1:YS=1
REM MAX LENGTH OF WORD AND CLUE
59025 MW%=20
59030 MC%=35
REM INITIALIZE THE ALPHABET
59035 GOSUB 59500
REM SET MY PALLETTE COLORS I AM GOING TO ANIMATE LATER
REM COPY FLESH COLOR ALSO TO $FF
59300 P1=$25:P2=$FF:GOSUB 41000
REM COPY PURE WHITE ALSO TO $FE
59305 P1=1:P2=$FE:GOSUB 41000
REM RED TO $FD
59310 P1=$3B:P2=$FD:GOSUB 41000
REM COPY YELLOW TO $F1 FOR SUN RAYS COLOR IF I VLOAD.
59315 P1=7:P2=$F1:GOSUB 41000
59316 P1=$C0:P2=5:GOSUB 41000
REM COPY BLACK TO PAL 4 SO I CAN HAVE
REM NON TRANSPARENT BLACK TEXT
59320 P1=$10:P2=4:GOSUB 41000
59400 RETURN
REM INITIALIZE AN ARRAY TO HOLD THE ALPHABET
REM USING ASCII VALUES INSTEAD OF STRING
REM WITH A FLAG TO SHOW IF THE LETTERS BEEN USED
REM 2 DIMENSIONAL ARRAY 1,X IS FLAG, 2,X IS ASCII CODE 3&4,X is X,Y
REM FOR BUTTON POSITION ON SCREEN.
59500 FOR I=65 TO 90
59505 AL%(1,I-64)=0:AL%(2,I-64)=I
59510 NEXT I
59515 RETURN
REM FLUSH KEYBOARD BUFFER AND WAIT FOR KEYPRESS
63000 GET X$:IF X$<>"" THEN 63000
63010 GET X$:IF X$="" AND MB=0 THEN 63010
63020 RETURN
PRINT:PRINT
PRINT FRE(0)
PRINT:PRINT