Reuploading of the initial attempt at porting almost 1:1 the TI994A version to XCB3

This commit is contained in:
JJFlash 2022-09-02 11:01:43 +02:00
parent 6b7323a8f6
commit 4e3214ed8f
5 changed files with 476 additions and 0 deletions

Binary file not shown.

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 38 KiB

View File

@ -0,0 +1,476 @@
Dim scrAddrCache(25) as WORD @loc_scrAddrCache ' 0 -> 24
loc_scrAddrCache:
DATA AS WORD 1024, 1064, 1104, 1144, 1184, 1224, 1264, 1304, 1344, 1384
DATA AS WORD 1424, 1464, 1504, 1544, 1584, 1624, 1664, 1704, 1744, 1784
DATA AS WORD 1824, 1864, 1904, 1944, 1984
Dim bTrailChar as BYTE : bTrailChar = 128
poke 53280, 13 : poke 53281, 13
'~ 100 CALL CLEAR
sys $E544 FAST ' clear screen
poke 646, 0 'black chars
locate 0, 24
'~ 110 PRINT TAB(6);"**************"
'~ 120 PRINT TAB(6);"* SUPERCHASE *"
'~ 130 PRINT TAB(6);"**************"
'~ 140 CALL CHAR(96,"00183C7E7E3C18") --- TREASURE! (rombo)
'~ 150 CALL COLOR(9,14,12) --- 96-103 -> Magenta/ Light Yellow
'~ 160 PRINT : : : :"USE THE ARROW KEYS TO MOVE."
'~ 170 PRINT : :"TRY TO GATHER AS MANY"
'~ 180 PRINT :"TREASURES (`) IN THE MAZE"
'~ 190 PRINT :"AS POSSIBLE BEFORE THE"
'~ 200 PRINT :"ENEMY CATCHES YOU!"
'~ 210 CALL COLOR(10,5,5) --- 104-111 -> Dark Blue/ Dark Blue
'~ 220 CALL COLOR(11,12,12) --- 112-119 -> Light Yellow/ Light Yellow
'~ 230 CALL CHAR(120,"383810FE10387CFE") --- HERO!
'~ 240 CALL COLOR(12,7,12) --- 120-127 -> Dark Red/ Light Yellow
'~ 250 CALL CHAR(128,"383810FE10387CFE") --- Ghost/shadow
'~ 260 CALL COLOR(13,16,12) --- 128-135 -> White/ Light Yellow
'~ 270 PRINT : : :"PRESS ANY KEY TO BEGIN";
'~ 280 CALL KEY(0,K,S)
'~ 290 IF S<1 THEN 280
dim charset_array(2048) as BYTE @LOC_charset_addr
memcpy @charset_array, $3800, 2048
poke $D018, 31 'final character location: $3800
PRINT " **************"
PRINT " * superchase *"
PRINT " **************"
PRINT "{13}{13}{13}{13} use the arrow keys to move."
PRINT "{13}{13} try to gather as many"
PRINT "{13} treasures ({160}) in the maze"
PRINT "{13} as possible before the"
PRINT "{13} enemy catches you!"
PRINT "{13}{13}{13} press any key to begin";
poke 198, 0 : wait 198, 1 : poke 198, 0
line300:
'~ 300 SC=0
'~ 310 LV=1
SC = 0
LV = 1
Dim FL as BYTE : FL = 0
Dim CX as INT : CX = 0
Dim CY as INT : CY = 0
Dim CCX as INT : CCX = 0
Dim CCY as INT : CCY = 0
Dim G as BYTE : G = 0
line320:
'~ 320 CALL CLEAR
sys $E544 FAST ' clear screen
'~ 330 CALL SCREEN(4) --- light green
poke 53280, 5 ' green
poke 53281, 7 'yellow
'~ 340 FOR X=3 TO 21
'~ 350 CALL HCHAR(X,3,104,27)
'~ 360 NEXT X
memset $0400, 1000, 104 'reverse space
memset $D800, 1000, 6 'blue
'~ 370 RANDOMIZE
Randomize TI()
'~ 380 FOR I=1 TO 65
'~ 390 X=2*(INT(9*RND))+4
'~ 400 Y=2*(INT(11*RND))+4
'~ 410 CALL HCHAR(X,Y,112,5)
'~ 420 NEXT I
For I AS BYTE = 1 to 65
X = 2 * (CBYTE(9*RND())) + 4
Y = 2 * (CBYTE(11*RND())) + 4
TEXTAT Y, X, "{176}{176}{176}{176}{176}"
Next I
'~ 430 FOR I=1 TO 60
'~ 440 X=2*(INT(7*RND))+4
'~ 450 Y=2*(INT(13*RND))+4
'~ 460 CALL VCHAR(X,Y,112,5)
'~ 470 NEXT I
For I AS BYTE = 1 to 60
X = 2 * (CBYTE(7*RND())) + 4
Y = 2 * (CBYTE(13*RND())) + 4
CHARAT Y, X , 112
CHARAT Y, X + 1, 112
CHARAT Y, X + 2, 112
CHARAT Y, X + 3, 112
CHARAT Y, X + 4, 112
Next I
'~ 480 CALL HCHAR(4,4,112,5)
'~ 490 CALL VCHAR(4,4,112,5)
TEXTAT 4, 4, "{176}{176}{176}{176}{176}"
CHARAT 4, 5, 112
CHARAT 4, 6, 112
CHARAT 4, 7, 112
CHARAT 4, 8, 112
'~ 500 FOR I=1 TO 80
'~ 510 X=2*(INT(9*RND))+4
'~ 520 Y=2*(INT(13*RND))+4
'~ 530 CALL HCHAR(X,Y,96)
'~ 540 NEXT I
For I AS BYTE = 1 to 80
X = 2 * (CBYTE(9*RND())) + 4
Y = 2 * (CBYTE(13*RND())) + 4
CHARAT Y, X, 96, 4 ' 4 = magenta
Next I
'~ 550 FOR I=1 TO 6
'~ 560 CALL HCHAR(23,2+I,ASC(SEG$("SCORE:",I,1)))
'~ 570 NEXT I
TEXTAT 3, 23, "score:", 0 'black
'****************************************************************************
'~ 580 CALL SOUND(100,1497,2)
'~ 590 T=0
T = 0
'~ 600 IF LV<8 THEN 620
'~ 610 LV=7
IF LV = 8 Then LV = 7
'~ 620 A=4
'~ 630 B=4
'~ 640 C=4
'~ 650 D=4
'~ 660 PG=112
A = 4
B = 4
C = 4
D = 4
PG = 112
'****************************************************************************
line670:
'~ 670 CALL HCHAR(A,B,120)
CHARAT B, A, 120, 2 ' 2 = Red
'~ 680 IF T<8-LV THEN 1410
IF T < 8-LV THEN goto line1410
'~ 690 IF FL=0 THEN 740
IF FL = 0 THEN goto line740
'~ 700 IF FL/2=INT(FL/2)THEN 1140
IF (FL AND 1) = 0 THEN Goto line1140
'~ 710 CCX=CX
'~ 720 CCY=CY
'~ 730 FL=0
CCX = CX
CCY = CY
FL = 0
textat 0, 0, "-fl " + str$(FL) + " ccx " + str$(CCX) + " ccy " + str$(CCY) + " cx " + str$(cx) + " cy " + str$(cy) + " ", 12 : poke 198,0 : wait 198, 1 : poke 198,0
line740: 'PRIMO CHECK -------------------------------------------------
'~ 740 CALL GCHAR(C+1,D,GC)
'~ 750 IF GC=120 THEN 1760
'~ 760 IF GC=104 THEN 810
'~ 770 IF GC<>128 THEN 810
'~ 780 CX=1
'~ 790 CY=0
'~ 800 GOTO 1340
GC = peek(scrAddrCache(C + 1) + D)
IF GC = 120 THEN goto line1760
IF GC = 104 THEN goto line810
IF GC <> 128 THEN goto line810
CX = 1
CY = 0
GOTO line1340
line810:
'~ 810 CALL GCHAR(C,D+1,GC)
'~ 820 IF GC=120 THEN 1760
'~ 830 IF GC=104 THEN 880
'~ 840 IF GC<>128 THEN 880
'~ 850 CX=0
'~ 860 CY=1
'~ 870 GOTO 1340
GC = peek(scrAddrCache(C) + D + 1)
IF GC = 120 THEN goto line1760
IF GC = 104 THEN goto line880
IF GC <> 128 THEN goto line880
CX = 0
CY = 1
GOTO line1340
line880:
'~ 880 CALL GCHAR(C-1,D,GC)
'~ 890 IF GC=120 THEN 1760
'~ 900 IF GC=104 THEN 950
'~ 910 IF GC<>128 THEN 950
'~ 920 CX=-1
'~ 930 CY=0
'~ 940 GOTO 1340
GC = peek(scrAddrCache(C - 1) + D)
IF GC = 120 THEN goto line1760
IF GC = 104 THEN goto line950
IF GC <> 128 THEN goto line950
CX = -1
CY = 0
GOTO line1340
line950:
'~ 950 CALL GCHAR(C,D-1,GC)
'~ 960 IF GC=120 THEN 1760
'~ 970 IF GC=128 THEN 1320
'~ 980 IF GC=112 THEN 1320
GC = peek(scrAddrCache(C) + D - 1)
IF GC = 120 THEN goto line1760
IF GC = 128 THEN goto line1320
IF GC = 112 THEN goto line1320
'~ 990 FL=FL+1
'~ 1000 IF FL/2=INT(FL/2)THEN 1040
FL = FL + 1
textat 0, 0, "fl " + str$(FL) + " ccx " + str$(CCX) + " ccy " + str$(CCY) + " cx " + str$(cx) + " cy " + str$(cy) + " ", 2 : poke 198,0 : wait 198, 1 : poke 198,0
IF (FL AND 1) = 0 then goto line1040
'~ 1010 CX=CCX
'~ 1020 CY=CCY
'~ 1030 GOTO 1160
CX = CCX
CY = CCY
GOTO line1160
line1040: '-----------CHECK con SGN!
'~ 1040 CX=SGN(A-C)
'~ 1050 CY=0
'~ 1060 IF CX<>0 THEN 1080
'~ 1070 CY=SGN(D-B)
textat 0, 0, "SGN! fl " + str$(FL) + " ccx " + str$(CCX) + " ccy " + str$(CCY) + " cx " + str$(cx) + " cy " + str$(cy) + " ", 11 : poke 198,0 : wait 198, 1 : poke 198,0
CX = SGN(A - C)
CY = 0
IF CX <> 0 THEN goto line1080
CY = SGN(D - B)
line1080:
'~ 1080 CALL GCHAR(C+CX,D+CY,GC)
'~ 1090 IF GC=104 THEN 1110
'~ 1100 IF (GC=96)+(GC=112)THEN 1340
'~ 1110 CX=-1
'~ 1120 CY=0
'~ 1130 GOTO 1160
GC = peek(scrAddrCache(C + CX) + D + CY)
IF GC = 104 THEN goto line1110
IF (GC = 96) OR (GC = 112) THEN goto line1340
line1110:
CX = -1
CY = 0
GOTO line1160
line1140:
'~ 1140 FL=FL+1
'~ 1150 IF FL>1 THEN 1300
FL = FL + 1
textat 0, 0, "!fl " + str$(FL) + " ccx " + str$(CCX) + " ccy " + str$(CCY) + " cx " + str$(cx) + " cy " + str$(cy) + " ", 4 : poke 198,0 : wait 198, 1 : poke 198,0
IF FL > 1 THEN goto line1300
line1160: '---------------SECONDO CHECK
'~ 1160 CALL GCHAR(C+CX,D+CY,GC)
'~ 1170 IF (GC=112)+(GC=96)+(GC=128)THEN 1340
'~ 1180 CX=1
'~ 1190 CY=0
'~ 1200 CALL GCHAR(C+CX,D,GC)
'~ 1210 IF (GC=112)+(GC=96)+(GC=128)THEN 1340
'~ 1220 CX=-1
'~ 1230 CALL GCHAR(C+CX,D,GC)
'~ 1240 IF (GC=112)+(GC=96)+(GC=128)THEN 1340
'~ 1250 CX=0
'~ 1260 CY=-1
'~ 1270 CALL GCHAR(C,D+CY,GC)
'~ 1280 IF (GC=112)+(GC=96)+(GC=128)THEN 1340
'~ 1290 CY=1
textat 0, 0, "!fl " + str$(FL) + " ccx " + str$(CCX) + " ccy " + str$(CCY) + " cx " + str$(cx) + " cy " + str$(cy) + " ", 10 : poke 198,0 : wait 198, 1 : poke 198,0
GC = peek(scrAddrCache(C + CX) + D + CY)
IF (GC = 112) OR (GC = 96) OR (GC = 128) THEN goto line1340
CX = 1
CY = 0
GC = peek(scrAddrCache(C + CX) + D)
IF (GC = 112) OR (GC = 96) OR (GC = 128) THEN goto line1340
CX = -1
GC = peek(scrAddrCache(C + CX) + D)
IF (GC = 112) OR (GC = 96) OR (GC = 128) THEN goto line1340
CX = 0
CY = -1
GC = peek(scrAddrCache(C) + D + CY)
IF (GC = 112) OR (GC = 96) OR (GC = 128) THEN goto line1340
CY = 1
line1300:
'~ 1300 CALL GCHAR(C+CX,D+CY,GC)
'~ 1310 IF GC=104 THEN 1390 ELSE 1340
GC = peek(scrAddrCache(C + CX) + D + CY)
IF GC = 104 THEN goto line1390 ELSE goto line1340
line1320:
'~ 1320 CX=0
'~ 1330 CY=-1
CX = 0
CY = -1
line1340:
'~ 1340 IF PG=96 THEN 1360
'~ 1350 PG=112+FL
IF PG = 96 THEN goto line1360
PG = 112 + FL
line1360:
'~ 1360 CALL HCHAR(C,D,PG)
'~ 1370 C=C+CX
'~ 1380 D=D+CY
CHARAT D, C, PG, 4 '4 = magenta
C = C + CX
D = D + CY
line1390:
'~ 1390 CALL HCHAR(C,D,42)
'~ 1400 PG=GC
textat 0, 0, "fl " + str$(FL) + " ccx " + str$(CCX) + " ccy " + str$(CCY) + " cx " + str$(cx) + " cy " + str$(cy) + " ", 0
CHARAT D, C, 42, 0 ' 0 = black
PG = GC
'****************************************************************************
line1410:
'~ 1410 CALL KEY(1,K1,S)
'~ 1420 IF (K1<0)+(K1>5)THEN 1410
'~ 1430 CALL HCHAR(A,B,128)
'~ 1440 ON K1+1 GOTO 1540,1410,1590,1640,1410,1690
K1 = peek( $DC00) : K1 = 127 - K1
if K1 = 0 then goto line1410
IF K1 = 16 then 'fire
if bTrailChar = 128 then bTrailChar = 112 else bTrailChar = 128
end if
IF K1 > 8 then goto line1410
do
loop until peek ( $DC00) = 127
CHARAT B, A, bTrailChar, 1 ' 1 = White
on K1 goto line1410, line1690, line1540, line1410, line1590, line1410, line1410, line1410, line1640, line1410, line1410, line1410, line1410, line1410, line1410, line1410, line1410
'sopra 1
'sotto 2
'sinistra 4
'sinistrasopra 5
'sinistrasotto 6
'destra 8
'destrasopra 9
'destrasotto 10
'fuoco 16
line1450:
'~ 1450 IF G<>96 THEN 670
'~ 1460 CALL SOUND(100,-1,4)
'~ 1470 SC=SC+1
'~ 1480 SC$=STR$(SC)
'~ 1490 FOR I=1 TO LEN(SC$)
'~ 1500 CALL HCHAR(23,10+I,ASC(SEG$(SC$,I,1)))
'~ 1510 NEXT I
'~ 1520 T=T+1
'~ 1530 IF T<45 THEN 670 ELSE 320 + ALZA LV!
'wait $d011, 128: wait $d011, 128, 128: wait $d011, 128: wait $d011, 128, 128
IF G <> 96 then goto line670
poke 53280, 13 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : poke 53280, 5 ' light green, green
SC = SC + 1
textat 10, 23, str$(SC), 0
T = T + 1
IF T < 45 then goto line670 else Goto line320
'~ IF T < 45 then
'~ goto line670
'~ Else
'~ LV = LV + 1
'~ Goto line320
'~ End If
line1540:
'~ 1540 CALL GCHAR(A+1,B,G)
'~ 1550 IF G=104 THEN 1740
'~ 1560 IF G=42 THEN 1760
'~ 1570 A=A+1
'~ 1580 GOTO 1450
G = peek(scrAddrCache(A + 1) + B)
IF G = 104 then goto line1740
IF G = 42 then goto line1760
A = A + 1
Goto line1450
line1590:
'~ 1590 CALL GCHAR(A,B-1,G)
'~ 1600 IF G=104 THEN 1740
'~ 1610 IF G=42 THEN 1760
'~ 1620 B=B-1
'~ 1630 GOTO 1450
G = peek(scrAddrCache(A) + B - 1)
IF G = 104 then goto line1740
IF G = 42 then goto line1760
B = B - 1
Goto line1450
line1640:
'~ 1640 CALL GCHAR(A,B+1,G)
'~ 1650 IF G=104 THEN 1740
'~ 1660 IF G=42 THEN 1760
'~ 1670 B=B+1
'~ 1680 GOTO 1450
G = peek(scrAddrCache(A) + B + 1)
IF G = 104 then goto line1740
IF G = 42 then goto line1760
B = B + 1
Goto line1450
line1690:
'~ 1690 CALL GCHAR(A-1,B,G)
'~ 1700 IF G=104 THEN 1740
'~ 1710 IF G=42 THEN 1760
'~ 1720 A=A-1
'~ 1730 GOTO 1450
G = peek(scrAddrCache(A - 1) + B)
IF G = 104 then goto line1740
IF G = 42 then goto line1760
A = A - 1
Goto line1450
line1740:
'~ 1740 CALL SOUND(-100,-5,4)
'~ 1750 GOTO 670
poke 53280, 2 : wait $d011, 128 : wait $d011, 128, 128 : poke 53280, 5 ' red, green
goto line670
'****************************************************************************
line1760:
'~ 1760 CALL SOUND(200,-6,4)
'~ 1770 FOR I=1 TO 3
'~ 1780 CALL SCREEN(16)
'~ 1790 CALL SCREEN(9)
'~ 1800 CALL SCREEN(8)
'~ 1810 NEXT I
'~ 1820 PRINT "GOT CAUGHT!!!"
'~ 1830 PRINT "TRY AGAIN? (Y/N)";
'~ 1840 CALL KEY(0,K,S)
'~ 1850 IF K=89 THEN 300
'~ 1860 IF K<>78 THEN 1840
'~ 1870 CALL CLEAR
'~ 1880 END
Print "beccato!!!"
poke 198, 0 : wait 198,1 : poke 198, 0
goto line300
LOC_charset_addr:
incbin "charset-debug.chr"

Binary file not shown.