This is non-commercial site, its content is based on Atari 8-bit home computer contents and references.
If you feel your rights are violated by showing/using any part of contents of your product represented on this page,
please contact me immediatelly so I can remove it!
Atari 8-bit Source code
|
|
|
-
Entry name:Castle Hexagon
-
Category:Games
-
Publisher/Developer:BELLCOM - Public Domain Library
-
Year:1982
Listing 1
10 REM ******************** 20 REM ** CASTLE HEXAGON ** 30 REM ** S.O. 10/82 ** 40 REM ******************** 45 GRAPHICS 18:POSITION 6,4:? #6;"CtL":POSITION 6,6:? #6;"xAn" 49 REM * Sound generation in VBI, Data in page 6 * 50 DIM VBI$(75):RESTORE 52:FOR J=1 TO 75:READ A:VBI$(J,J)=CHR$(A):NEXT J 52 DATA 174,252,6,240,67,173,244,6,240,32,206,244,6,208,57 54 DATA 189,0,6,141,0,210,10,234,234 56 DATA 141,2,210,232,189,0,6,240,30,141,248,6,232,142,252,6,208,30,206,248,6,16,25,169,0 58 DATA 141,0,210,141,2,210,173,243,6,141,244,6,208,9,141,252,6,141,0,210,141,2,210,76,98,228 60 RESTORE 62:FOR J=1536 TO 1749:READ A:POKE J,A:NEXT J 62 DATA 104,160,0,162,0,169,7,76,92,228 64 DATA 81,20,68,40,60,20,53,30,50,10,53,20,60,40,72,20,91,30,81,10,73,20,68,40,81,20,81,30,85,10,81,20,72,40 65 DATA 85,20,108,40,81,20,68,40,60,20,53,30,50,10,53,20,60,40,72,20,91,30,81,10,72,20,68,30,72,10,81,20,85,30 66 DATA 96,10,91,20,81,40,81,20,0,0,53,40,60,20,53,20,81,20,81,20,91,20,81,20,68,20,72,20,85,20,81,60,81,20 67 DATA 53,80,53,20,81,20,68,20,53,20,60,20,68,20,60,80,60,20,53,20,50,40,50,20,53,20,60,40,68,20,60,20,53,20 68 DATA 53,20,60,20,68,20,81,60,81,20,53,80,53,20,81,20,68,20,53,20,60,20,72,20,68,80,0,0,100,5,80,5,60,5,40,5 69 DATA 20,5,0,0,20,5,40,5,60,5,80,5,100,5,0,0,100,2,0,2,140,2,0,2,100,2,0,2,140,2,0,0 80 A=ADR(VBI$):B=INT(A/256):C=A-256*B:POKE 1538,C:POKE 1540,B:POKE 53761,174:POKE 53763,170:POKE 1779,5 82 A=USR(1536):POKE 1788,88 90 GOSUB 1000 100 DIM NXTRM$(69),BRD$(48),BLD$(48),LD$(48),RD$(48),P$(48),CC$(20),CO$(20),T$(43),PD$(8),RN$(23),H$(23),U$(23) 109 REM * H$-Room assoc. with chest contents, CB$-Color of background * 110 DIM OBJ$(23),Q$(322),R$(345),CRY$(14),CB$(23),M$(15),F$(37):RN$(23)=" ":RESTORE 112:FOR J=1 TO 23:READ A 111 H$(J,J)=CHR$(A):NEXT J:FOR J=1 TO 23:READ A:CB$(J)=CHR$(A):NEXT J 112 DATA 3,22,12,15,18,16,20,19,1,2,4,6,9,10,13,14,8,17,11,5,21,7,0 113 DATA 18,66,84,100,34,110,0,180,98,178,4,16,174,178,52,20,6,0,254,210,64,242,50 114 REM * Randomize room names * 115 FOR J=1 TO 23 116 R=INT(RND(0)*23):FOR K=1 TO J:IF R=ASC(RN$(K)) THEN 116 118 NEXT K:RN$(J,J)=CHR$(R):NEXT J:K=0 119 K=K+1:IF ASC(RN$(K))<>17 THEN 119 120 RN$(K,K)=RN$(18,18):RN$(18,18)=CHR$(17) 121 REM * Put objects in proper place * 122 FOR J=1 TO 23:K=ASC(H$(J)):OBJ$(J,J)=RN$(K+1,K+1):NEXT J:CRY=ASC(OBJ$(22)):OBJ$(22,22)=CHR$(17) 123 REM ** ALL STRING CHARACTERS IN LINES 124-170 ARE CTRL (EXCEPT THE X'S) ** 124 NXTRM$="" 125 BRD$=" " 127 BLD$=" " 130 LD$=" " 140 RD$=" " 150 CC$=" XXXXXXXX" 160 CO$="XXXXXXXX" 170 PD$="" 179 REM * Room names * 180 Q$="###MDGH#XUQ####ZRRGHQ#VWDNH##SHUIXPHG#RLO#JROGHQ#JREOHW##LURQ#FDOGURQ##ODFH#SLOORZV##UDZKLGH#ZKLS#" 181 Q$(99)="##FKLQD#GROO####SXUSOH#UREH###PDJLF#ZDQG##LURQ#KRUVHVKRH##FKDLQ#PDLO##FRSSHU#NHWWOH#" 182 Q$(183)="##VS\JODVV####VLOYHU#EULGOH#FRORUHG#EDOOV#ZRRG#FURVVERZ#ERRN#RI#NQRZQ###TXLOO#SHQ###EUDVV#EDODQFH#" 183 Q$(281)="#FDQGOHVWLFN###EDJ#RI#VDOW####SUD\HU#UXJ##" 185 R$="#FDVWOH#FU\SW##YDPSLUH*V#ODLU#SULQFHVV*V#EDWK##GLQLQJ#KDOO####ZLWFK*V#GHQ##TXHHQ*V#EHGURRP" 186 R$(91)="#GDUN#GXQJHRQ##KHLU*V#QXUVHU\#NLQJ*V#FKDPEHUVVRUFHUHU*V#GHQ#EODFNVPLWK#VKRS" 187 R$(166)="#NQLJKW*V#URRP##FDVWOH#NLWFKHQ##ZDWFKWRZHU####KRUVH#VWDEOH###MHVWHU*V#URRP##FDVWOH#DUPRU\#" 188 R$(256)="###############FDVWOH#OLEUDU\#DOFKHPLVW*V#ODE#FDVWOH#FKDSHO####VWRUHURRP###PRQN*V#TXDUWHUV" 200 T$(1)=CHR$(0):T$(43)=CHR$(0):T$(2)=T$:FLAG=0 209 REM * U$-Passage # blocked at certain room * 210 RESTORE 212:FOR J=1 TO 23:READ A:U$(J)=CHR$(A):NEXT J 212 DATA 0,0,0,23,0,0,0,0,12,0,0,18,31,0,0,0,16,0,39,35,42,0,37 213 REM * Set up passages blocked * 214 FOR J=1 TO 23:A=ASC(U$(J)):IF A=0 THEN NEXT J 216 T$(A,A)=CHR$(1):NEXT J:T$(38,38)=CHR$(1):T$(40,40)=CHR$(1):T$(43,43)=CHR$(1) 300 ?:? " "; 302 IF PEEK(53279)<>6 THEN 302 304 ? CHR$(125):GOSUB 1100:GOSUB 1230 306 POSITION 6,0:? "carrying:":POSITION 2,19:? "this is room # ":CUX=19:CUY=11 310 RM=INT(RND(0)*8):PRRM=ASC(NXTRM$(RM*3+INT(RND(0)*3+1))):A=RM+PRRM:IF ASC(T$(A))>0 THEN 310 350 R1=ASC(NXTRM$(RM*3+1)):R2=ASC(NXTRM$(RM*3+2)):R3=ASC(NXTRM$(RM*3+3)) 356 IF R1=PRRM THEN RTRM=R2:LTRM=R3 357 IF R2=PRRM THEN RTRM=R3:LTRM=R1 358 IF R3=PRRM THEN RTRM=R1:LTRM=R2 359 POKE 1779,1:POKE 1788,198 360 POKE 559,0:POKE 712,ASC(CB$(ASC(RN$(RM+1))+1)):POKE 710,48:POKE 77,0 361 POSITION 1,1:? "TO ROOM # ";LTRM;" ":POSITION 26,1:? "TO ROOM # ";RTRM;" " 362 POSITION 14,18:? "TO ROOM # ";PRRM;" ":POSITION 17,19:? RM;" " 364 LT=ASC(T$(RM+LTRM)):RT=ASC(T$(RM+RTRM)):GOSUB 1250 366 IF LT>0 THEN GOSUB 1215:GOTO 370 368 IF LT=0 THEN GOSUB 1210 370 IF RT>0 THEN GOSUB 1225:GOTO 382 372 IF RT=0 THEN GOSUB 1220 382 POKE 559,34:X=23:Y=19:Q=15*ASC(RN$(RM+1))+1:M$=R$(Q,Q+14):GOSUB 1500:POSITION 22,19:? " "; 383 IF OBJ$(RM+1,RM+1)=RN$(RM+1,RM+1) THEN POSITION 22,19:? CHR$(170) 384 X=24:Y=0:P=14*CRY+1:M$=Q$(P,P+13):GOSUB 1500 390 POKE 712,ASC(CB$(ASC(RN$(RM+1))+1)):POKE 710,48:POKE 77,0 392 POKE 209,18:POKE 208,14 400 S=STICK(0):IF STRIG(0)=0 THEN 410 402 IF S=14 THEN CUX=19:CUY=9 404 IF S=13 THEN CUX=19:CUY=16 406 IF S=7 THEN CUX=33:CUY=11 407 IF S=11 THEN CUX=6:CUY=11 410 LOCATE CUX,CUY,Z:POSITION CUX,CUY:? "*";:TR=STRIG(0) 430 IF TR=0 AND CUY=16 THEN TEMP=RM:RM=PRRM:PRRM=TEMP:GOTO 350 440 IF TR=0 AND LT=0 AND CUX=6 THEN LT=RM+LTRM:PRRM=RM:RM=LTRM:GOTO 350 450 IF TR=0 AND RT=0 AND CUX=33 THEN RT=RM+RTRM:PRRM=RM:RM=RTRM:GOTO 350 460 IF TR=0 AND CUY=9 THEN GOSUB 2000 470 IF FLAG=1 THEN FLAG=0:GOTO 360 480 IF FLAG=3 THEN POKE 1788,10:GOTO 600 490 POSITION CUX,CUY:? CHR$(Z); 500 GOTO 400 600 ? CHR$(125):POSITION 1,0:? "YOU FOUND THE BOOK congratulations!" 602 POSITION 2,19:? " to repeat for new game"; 608 FOR J=0 TO 123:IF J>27 AND J<32 THEN NEXT J 610 F$(1)=CHR$(J):F$(37)=CHR$(J):F$(2)=F$:FOR K=3 TO 16:POSITION 1,K:? F$; 612 A=PEEK(53279):IF A=6 THEN GRAPHICS 0:POKE 756,START/256:GOTO 122 614 IF A=5 THEN GRAPHICS 0:POKE 756,START/256:?:? "Just a sec ...":GOTO 114 616 NEXT K:NEXT J:GOTO 608 999 REM * Change character set * 1000 DIM ZZ$(32):RESTORE 1010:FOR I=1 TO 32:READ A:ZZ$(I)=CHR$(A):NEXT I 1010 DATA 104,104,133,204,104,133,203,104,133,206,104,133,205,162,4,160,0 1012 DATA 177,203,145,205,136,208,249,230,204,230,206,202,208,240,96 1014 POKE 106,PEEK(106)-5:GRAPHICS 0:GOSUB 1800:START=(PEEK(106)+1)*256:POKE 756,START/256:POKE 752,1 1016 A=USR(ADR(ZZ$),57344,START):RESTORE 1020:FOR I=START+520 TO START+727:READ A:POKE I,A:NEXT I 1018 RETURN 1020 DATA 170,170,170,170,170,170,170,170,255,255,255,255,255,255,255,255,255,255,255,255,253,244,208,64 1030 DATA 253,244,208,64,0,0,0,0,0,0,0,0,1,6,26,106,1,6,26,106,170,170,170,170 1040 DATA 127,31,7,1,0,0,0,0,255,255,255,255,127,31,7,1,64,144,164,169,170,170,170,170 1050 DATA 0,0,0,0,64,144,164,169,170,170,168,168,160,160,128,128,170,171,170,174,170,186,170,234 1060 DATA 191,239,251,254,190,46,10,2,191,47,11,2,0,0,0,0,191,239,251,254,190,238,250,254 1070 DATA 0,0,0,0,128,224,248,254,128,224,248,254,190,238,250,254,254,251,239,191,190,184,160,128 1080 DATA 254,248,224,128,0,0,0,0,254,251,239,191,190,187,175,191,0,0,0,0,2,11,47,191 1090 DATA 2,11,47,191,190,187,175,191,2,2,10,10,42,42,170,170,255,127,63,31,15,7,3,1 1092 DATA 64,192,208,240,244,252,253,255,170,170,170,170,170,170,170,170 1099 REM * Change display list * 1100 DL=PEEK(560)+256*PEEK(561):POKE DL+3,70:POKE DL+6,7:POKE DL+25,6:POKE DL+26,7 1110 FOR J=0 TO 3:POKE DL+27+J,PEEK(DL+29+J):NEXT J:FOR J=8 TO 23:POKE DL+J,4:NEXT J:RETURN 1199 REM * Draw figures using strings * 1200 FOR J=0 TO H:L=W*J:POSITION X,Y+J:? P$(L+1,L+W):NEXT J:RETURN 1210 P$=LD$:H=11:W=4:X=4:Y=4:GOSUB 1200:RETURN 1215 P$=BLD$:H=11:W=4:X=4:Y=4:GOSUB 1200:RETURN 1220 P$=RD$:H=11:W=4:X=32:Y=4:GOSUB 1200:RETURN 1225 P$=BRD$:H=11:W=4:X=32:Y=4:GOSUB 1200:RETURN 1230 P$=CC$:H=3:W=5:X=17:Y=7:GOSUB 1200:RETURN 1240 P$=CO$:H=3:W=5:X=17:Y=7:GOSUB 1200:RETURN 1250 P$=PD$:H=0:W=8:X=16:Y=16:GOSUB 1200:RETURN 1500 POSITION X,Y:FOR J=1 TO LEN(M$):? CHR$(ASC(M$(J))-3);:FOR K=1 TO 3:NEXT K:NEXT J:RETURN 1800 ? " gets its name from":? "its six sided rooms with doors at" 1810 ? "alternate walls. Rumor says an":? "ancient manuscript of wisdom called" 1820 ? "the ' ' lies hidden in":? "one of the castle's many rooms" 1830 ? "Your job is to find this treasure.":? " Each room has a chest containing" 1840 ? "an item associated with another":? "room. You can only carry one item" 1850 ? "at a time. Position the cursor on":? "the chest and push ''. Many" 1860 ? "doors have been bricked over but":? "some will magically open when the" 1870 ? "chest contains the proper item.":? "Position the cursor on the desired" 1872 ? "door and push '' to move between":? "rooms. The 'mat' in the middle" 1874 ? "represents the room you just came":? "from. Just remember you are facing" 1876 ? "into the room, (the map should help).":? " A final warning ... it's not" 1878 ? "easy and if you re-run the program":? "all the rooms get switched around!"; 1890 RETURN 1999 REM * Exchange chest contents * 2000 GOSUB 1240:TEMP=CRY:K=ASC(OBJ$(RM+1)):P=14*K+1:CRY=K 2010 OBJ$(RM+1,RM+1)=CHR$(TEMP):X=24:Y=0:M$=Q$(P,P+13):GOSUB 1500:POKE 1788,174:FOR J=1 TO 100:NEXT J 2020 POKE 1788,186:GOSUB 1230 2025 IF CRY=17 THEN FLAG=3 2030 IF TEMP=ASC(RN$(RM+1)) THEN GOSUB 2500 2040 RETURN 2499 REM * Clear passage * 2500 FOR J=1 TO 100:NEXT J:POKE 1788,10:FLAG=0:A=ASC(U$(RM+1)):IF A=0 THEN RETURN 2510 T$(A,A)=CHR$(0):FLAG=1:RETURN
References
Listing downloads
Downloads
Copyright holder