HANGMAN thread continues in GAMES.

Talk about your programs in progress. Discuss how to implement features, etc.
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).
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

HANGMAN IN BASIC... 3D Button Press done.

Post by ahenry3068 »

Still not playable. But most of the User Interface for Game Play is getting done.
I've got Skeleton Mouse support, but its not really there yet. On this version you get to the game screen and you can play on the keyboard. Press a Letter and there is a 3-d button press and sound. I've still got some coding time this afternoon so there may be another update after this. I just thought this was a milestone that should be posted.

If the Intro screen gets annoying. Then add the line --> 31 GOTO 700
That will skip the intro screen.


THE SOURCE FILE
HANGMAN.BAS
(28.47 KiB) Downloaded 559 times
THE LOADABLE PRG
HANGMAN.PRG
(19.99 KiB) Downloaded 555 times



CUT AND PASTE CODE FOR THE EMULATOR

Code: Select all

10 SCREEN $80:COLOR $C:PRINT "GAME INITIALIZATION":MOUSE 1
15 DIM TC%(2,8),AL%(4 ,26),MC$(4),DI$(3),PL%(2,2)
20 GOSUB 59000 : REM INITIALIZE ALL VARIABLES
30 COLOR 1,0:CLS
31 REM GOTO 700

40 RECT 0,0,319,239,$3B
45 RECT 3,3,316,236,$10:GOSUB 550
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
155     LOCATE 1,1:PRINT CHR$(145)
160     READ PS$,DL:IF DL=0 THEN RESTORE 50300:GOTO 160
165     FMCHORD 0,PS$
166     FOR I = 1 TO DL:GOSUB 275:NEXT I
167     GET X$:IF X$=CHR$(27) THEN X=31
170 NEXT X

171 IF X$=CHR$(27) THEN 178
172 READ PS$,DL
173 IF DL=0 THEN 178
174 FMCHORD 0,PS$
175 SLEEP DL

REM IF ESC IS HIT JUMP OUT OF THE INTRO SCREEN
176 GET X$:IF X$=CHR$(27) THEN 178
177 GOTO 172

178 FMINIT
179 GOSUB 63400:GOSUB 59300:GOTO 700


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:LINE 180,209,299,209,$53
320 LINE 300,210,300,17,$53:LINE 299,209,299,18,$53
325 LINE 300,17,100,17,$53: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:LINE 102,51,102,78,$25
440 LINE 102,53,88,64,$25:LINE 102,53,116,64,$25
450 LINE 102,78,87,99,$25:LINE 102,78,117,99,$25
500 RETURN

REM SETUP PALLETTE COLORS FOR INTRO SCREEN
550 R%=15:G%=0:B%=2
555 P1=$3B:P2=10:GOSUB 41000
560 P1=1:P2=11:GOSUB 41000
565 P1=$C7:P2=12:GOSUB 41000
570 P1=$A0:P2=13:GOSUB 41000
575 FOR I= 2 TO 9
580      TC%(2,I-1) = 0
590      TC%(1,I-1) = I
595      P1 = I:GOSUB 40000:R%=R%-1
600      IF I/3 = INT(I/3) THEN R%=R%-1:G%=G%+1
605 NEXT I
610 RETURN

700 GOSUB 45000:GOSUB 59300
705 DM$="HANGMAN GAME PARAMETERS":GOSUB 2600


710 X=5:Y=4:CH=4:DI=2
715 FOR I = 1 TO 4
720     Y=Y+2:LOCATE Y,X
725     COLOR 1,0:PRINT RIGHT$(STR$(I),1);
730     COLOR 4:PRINT ":"MC$(I);
735 NEXT I

740 LOCATE 16,5:COLOR 4,0:PRINT "<";
745 COLOR 1,4:PRINT "ENTER";:COLOR 4,0:PRINT ">";
750 COLOR 4,0:PRINT "  STARTS THE GAME";


755 LOCATE 18,5:COLOR 4:PRINT "(";:COLOR 7
760 PRINT "CURRENTLY UNDER DEVELOPMENT.";
765 LOCATE 19,6:PRINT "WILL DO QUICK PLAY FOR";
770 LOCATE 20,6:PRINT "ALL CHOICES";
775 COLOR 4:PRINT ")";

780 COLOR 4:LOCATE 24,20:PRINT "DIFFICULTY:";
785 COLOR 1:PRINT DI$(DI);
790 COLOR 1,4:LOCATE 25,26:PRINT "<-";:LOCATE 25,30:PRINT "->";:COLOR 4,0

810 GET X$:IF X$<> "" THEN 810

811 IF CH=4 THEN Y=12
812 IF CH=3 THEN Y=10
813 IF CH=2 THEN Y=8
814 IF CH=1 THEN Y=6
815 LOCATE Y,5:COLOR 7,4:PRINT CHR$($7A);" ";:
816 COLOR 1:PRINT MC$(CH);RPT$(32,27-LEN(MC$(CH)));
817 COLOR 1,0:LOCATE 24,31:PRINT RPT$(32,10);:LOCATE 24,31:PRINT DI$(DI);


820 GET X$
825 IF MB<> 1 THEN 850
830 LOCATE 26,4:PRINT RPT$(32,30);
835 LOCATE 26,4:COLOR 1:PRINT "MX:";MX;"    ";"MY:";MY;
840 IF MB=1 THEN 840
850 IF X$="" THEN 820
855 K=ASC(X$):IF K=27 THEN END
856 LOCATE Y,5:COLOR 1,0:PRINT RIGHT$(STR$(CH),1);
857 COLOR 4:PRINT ":"MC$(CH);RPT$(32,28-LEN(MC$(CH)));:FMDRUM 2,26
860 IF K>=49 AND K<=52 THEN CH=VAL(X$)
861 IF K=145 THEN CH=CH-1
865 IF K=17 THEN CH=CH+1
870 IF K=157 THEN DI=DI-1
875 IF K=29 THEN DI=DI+1
876 IF K=13 OR K=27 THEN CLS:PL=1:GOTO 910
880 IF CH>4 THEN CH=1
885 IF CH<1 THEN CH=4
890 IF DI>3 THEN DI=1
895 IF DI<1 THEN DI=3
900 GOTO 811

910 REM GAME PLAY STARTS HERE
REM GET WORD AND CLUE
915 GOSUB 2500
920 GOSUB 2300

930 GET X$
932 IF X$=CHR$(27) THEN 63500
935 IF MB=1 THEN 945
940 IF X$="" THEN 930
941 GOTO 970:REM SKIP MOUSE CODE
945 REM MOUSE HANDLING CODE HERE
950 REM MOUSE CODE
955 REM MORE MOUSE CODE
960 REM ALL MY MOUSE CODE FITS IN HERE
970 LL=ASC(X$)
975 IF LL<65 OR LL>90 THEN LOCATE 1,1:PRINT CHR$(7);:GOTO 930
980 A=LL-64
985 IF AL%(1,A)=1 THEN LOCATE 1,1:PRINT CHR$(7);:GOTO 930
990 CL$=CHR$(LL)
995 GOSUB 2670
1000 GOTO 930


2150 GOTO 63500


REM SETUP THE GAME BOARD
2300 COLOR 1,0:CLS:GOSUB 59300
2305 IF DI=1 THEN BP=7
2310 IF DI=2 THEN BP=6
2315 IF DI=3 THEN BP=5
2320 GOSUB 5000
2325 IF DI>1 THEN GOSUB 7000
2330 IF DI=3 THEN GOSUB 8000
2335 DW$=RPT$($7A,LEN(HW$))
2340 COLOR 5,6:X=17+(7-(LEN(HW$)/2)):Y=5:H=3:W=LEN(HW$)+2
2345 GOSUB 3600:COLOR 1
2350 LOCATE 6,18+(7-(LEN(HW$)/2)):PRINT DW$;

2355 GOSUB 2650

2360 GOSUB 2498
2361 GOSUB 2740
2365 RETURN



2498 DM$=HC$:GOSUB 20010
2499 RETURN


REM SELECT WORD AND CLUE
REM FILE I/O WILL GO HERE TOO WHEN WRITTEN
2500 DM$="GET GAME WORD AND CLUE":GOSUB 2600
2505 IY=8:IX=8:IT=1
2510 LOCATE 6,5:COLOR 4,0:PRINT "ENTER WORD TO PLAY";
2511 LOCATE 8,4:COLOR 1,0:PRINT "==";:COLOR 2,0:PRINT "> ";
2515 ML=15:COLOR 7,4:GOSUB 4800
2520 IF LEN(IS$)<>0 THEN 2535
2522 PRINT CHR$(7):LOCATE 25,4:PRINT "* MUST ENTER WORD *";:GOTO 2515
2535 COLOR 4,0:CLS:HW$=IS$:LOCATE 8,8:PRINT "HANG WORD IS: ";
2536 COLOR 1:PRINT RPT$($7A,LEN(HW$));
2540 LOCATE 13,5:COLOR 4,0:PRINT "ENTER CLUE FOR WORD. (OPTIONAL)";
2545 ML=34:IY=15:IX=3:IT=4:COLOR 7,4:GOSUB 4800
2550 HC$=IS$
2599 RETURN


2600 RECT 0,0,XLIMIT,YLIMIT,$3A
2605 FRAME 0,0,XLIMIT,YLIMIT,5
2610 RECT 4,4,XLIMIT-4,YLIMIT-4, $10
2615 RECT 10,15,307,214,6
2620 FRAME 13,27,304,211,12
2625 RECT 15,29,302,209,12
2630 CHAR 18,25,15,CHR$($0C)+DM$
2635 RETURN


2650 COLOR 5,6:X=15:Y=8:H=3:W=20:GOSUB 3600
2655 COLOR 1:LOCATE 9,16:PRINT "BODY PARTS LEFT:";
2657 COLOR 7:PRINT BP;
2660 RETURN

2670 X=AL%(3,A):Y=AL%(4,A):W=14:C1=$17:C2=1:C3=$61:C4=$10
2675 L$=CHR$(LL):GOSUB 2900:FMDRUM 2,26:SLEEP 5
2680 C1=1:C2=$17:C3=$C2:C4=$1E:GOSUB 2900
2682 REM AL%(1,A)=1
2685 RETURN

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 JK = 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 JK
2890 RETURN




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):FMDRUM 2,26
4856 IF AC=1 AND LEN(IS$)<ML THEN 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$;:FMDRUM 2,26: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

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

59040 MC$(1)="PLAYER VS COMPUTER"
59045 MC$(2)="2 PLAYER. COMPUTER PICKS"
59050 MC$(3)="HEAD TO HEAD"
59055 MC$(4)="QUICK PLAY THROUGH"

59060 DI$(1)="EASY"
59065 DI$(2)="MEDIUM"
59070 DI$(3)="HARD"

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
59325 P1=$1A:P2=12: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

63400 COLOR 1,0:CLS
63405 RECT 0,0,XLIMIT,YLIMIT,$10
63410 RETURN

63500 GOSUB 63000:GOSUB 45000:SCREEN 0:END
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

SCREEN LOAD ADDED

Post by ahenry3068 »

Ok. No more Game functionality but I did do a Huge speed up for the code.

Now when drawing the Background Stage the program first looks for HANGBG.DAT which will hold a VERA image of the "Stage". If it does not exist it will go ahead and draw the screen as before, and when the background screen is done, it is then saved to HANGBG.DAT which will be subsequently loaded for the Background instead of drawing it. This means the cloud pattern will be thereafter fixed. (If you get tired of the clouds just delete HANGBG.DAT and let it draw it again).

THIS IS A HUGE SPEED GAIN. DRAWING THE BACKGROUND TOOK THE LONGEST OF ANYTHING.!

A couple of monthes ago I was working with VPEEK and had a screen save routine written in just BASIC. But it was painfully, painfully slow. Xark was kind enough to whip out a tiny assembly routine for me that does it much faster.

Now this version of the program will error out if the file isn't there. Its BVSAVE700.BIN and its included in this zip file. I've already got a "File Exists" subroutine in here at line 13000. So I expect I'll put some conditional code in the future and just disable the Save routine if BVSAVE700.BIN isn't present. But this version will just try to load it regardless.

Try It Now!

HERES THE CODE FOR DOWNLOAD
HANGMAN.zip
(21.93 KiB) Downloaded 597 times
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

HANGMAN MORE OPTIMIZATIONS.

Post by ahenry3068 »

OK. More code speed up. I reset the default Pallette a couple times along the way. BVLOADING from a file is quicker than looping through the DATA with READ. So I've included a DPAL.BIN which holds the Default VERA pallette. If its there it will be used which speeds up a couple areas of program execution. If its not there the DATA statements remain and it defaults back to the previous routine, so it still works its just faster if DPAL.BIN is present. Still haven't conditional-ed out BVSAVE700.BIN so that file needs to be there or the progam errors out.

The speed difference on Palette load is most noticeable when loading the Background Screen, because when loading it from file I black out the whole pallette first then load it "After" the background image is loaded. With the original routine you could kind of see the pallette load happening. With BVLOAD on a 512 byte file its damn near instant.

Also: Not new but I didn't document it on the last upload, when your on the Button screen, hitting ESC twice will cleanly exit the program and reset Palette and Screen mode.

(If I get down to the wire on memory I can consider deleting the old routine, then DPAL.BIN would be required, but it would get me almost 3/4 of a Kilobyte back.)


HERES THE NEW CODE:
HANGMAN.zip
(22.55 KiB) Downloaded 555 times
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

MOUSE SUPPORT PARTIALLY THERE.

Post by ahenry3068 »

Included a HANGBG.DAT so you don't even have to look at the background draw if you don't want to.

AND.... Drum Roll please :). I've got Mouse support working on the Letter chooser panel.

Still no Mouse support on the Game Parameter screen but thats next. (currently it prints the MX & MY if you press the left Mouse Button, this is to aid me in figuring out the Mouse support for that screen).

After a bit of a lull I've been coding at least a little bit every day, so this is coming along. But I still have to work and do other things :)...

HERE'S THE NEWEST CODE
HANGMAN.zip
(29.95 KiB) Downloaded 578 times
mortarm
Posts: 299
Joined: Tue May 16, 2023 6:21 pm

Re: SCREEN LOAD ADDED

Post by mortarm »

ahenry3068 wrote: Sun Oct 08, 2023 10:38 pm Try It Now!
Not functioning.
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH

Post by ahenry3068 »

I know. But it does load all the files so can be used. Do a DOS "$ when you get to the Web Emulator. You'll figure out how to proceed. Thats why I left it. I have to write a Manifest.Json for this and I haven't had the time to figure the particulars.
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

Try It Now NOT WORKING

Post by ahenry3068 »

Its on my Mental TO-DO list. But thats pretty long and occasionally things drop off.
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH

Post by ahenry3068 »

ahenry3068 wrote: Tue Oct 10, 2023 9:06 pm I know. But it does load all the files so can be used. Do a DOS "$ when you get to the Web Emulator. You'll figure out how to proceed. Thats why I left it. I have to write a Manifest.Json for this and I haven't had the time to figure the particulars.
LOAD "HANGMAN.PRG"
RUN
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

PICKWORDS ALGORITHM

Post by ahenry3068 »

Ok. This isn't the program source code. But its going into it this afternoon or evening.

I thought it might be nice to show the clean algorithm without it being surrounded by other spaghetti code. (Hangman, especially the Drawing Routine is spaghettified..lol).

I'm doing pre-counting here. The HWORD#.DAT files will have exactly 300 words and clues. and be $0D terminated text files. Right now the number of HWORD files is only 2 and its hard coded. In HANGMAN I'll read that from an INI file so I can add more HWORD files later. I wanted something that could pick a random word and clue in mostly less than a second. This example code runs through it 30 times and times the iterations, then gives me an average. So far every run has come in with an average a bit less than 30 jiffies with the more lengthy calls being around 50 some Jiffies. So mostly I'm less than 1 second to pick a RANDOM word from any number of files. This shouldn't go up very much when I add more words because I'm already randomizing the file name first. Based on File I/O tests I ran the longest a pick should ever take is 70 jiffies and it shouldn't do that very often.

I've already got 600 words to go for starting the Game. Thats plenty for me to work on the Code and I am thinking about code speed now as I go. 600 is good for the BETA release which I'm hoping is very soon. I'll want to double that number for 1.0

As always I'm very open to suggestions. If anyone can think of a speedier algorithm to pick words, besides splitting the files smaller I'm open to suggestions.

HERES THE EXAMPLE CODE
PICKWORD.zip
(11.35 KiB) Downloaded 483 times
User avatar
ahenry3068
Posts: 1138
Joined: Tue Apr 04, 2023 9:57 pm

Re: HANGMAN IN BASIC... COMING DOWN THE HOME STRETCH

Post by ahenry3068 »

I'm super stoked to be finishing this up.
My #2 problem is I have multiple other projects also.



#1 problem for HANGMAN is that it has become Line # HELL. Its line #'s are from 5 to 64500.

I was thinking Stripping line number after my first release and doing a BASLOAD version.

Lately I've been thinking of BASLOAD first and just abandon the line # code right after I successfully convert it. I would appreciate any thoughts, mostly from developers, if they have looked at my code.
Post Reply