JJFlash/C64_Superchase
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Uploading final version

Browse Source
This commit is contained in:
JJFlash 2022-11-01 08:37:14 +01:00
parent ab78d63bcc
commit c9e9021b71
5 changed files with 633 additions and 458 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
SuperChaseProj.charsetproject
View File

Binary file not shown.

202
inc_monster.bas Normal file
View File

@ -0,0 +1,202 @@
Const MASK_SUBGROUP = 8 '0000 1000
Const MASK_WALK_LOWHALF = 24 '0001 1000
Dim SHARED bMonster_Col as BYTE
Dim SHARED bMonster_Row as BYTE
Dim bMonster_Direction as BYTE
Dim bMonster_Lag as BYTE
Dim bMonster_PreviousTile as BYTE
Dim SHARED bMonster_SpeedUpMode as BYTE
Dim bMonster_MarkingMode as BYTE
Dim bMonster_DelayFrame as BYTE
Dim bMonster_Distance_TurnONSpeedUp as BYTE
Dim bMonster_Distance_TurnOFFSpeedUp as BYTE
Dim bManhattanDistance as BYTE
declare sub monsterMovement() STATIC
sub initMonster() SHARED STATIC
bMonsterIsOn = FALSE
if bSkillLevel < 8 then
bTreasuresToActivateMonster = 8 - bSkillLevel
end if
bMonster_Col = 1
bMonster_Row = 1
bMonster_Direction = EAST
bMonster_Lag = 10
bMonster_PreviousTile = SPACE
bMonster_SpeedUpMode = FALSE
bMonster_MarkingMode = FALSE
if bSkillLevel < 16 then
bMonster_Distance_TurnONSpeedUp = 21 - bSkillLevel 'minimum: 6
bMonster_Distance_TurnOFFSpeedUp = 12 - shr(bSkillLevel, 1) 'minimum: 5
end if
bMonster_DelayFrame = 9 '= Lag - 1
VOICE 2 OFF TONE 256 WAVE NOISE ADSR 0, 0, VOI2_S, VOI2_R 'monster sound
'~ textat 33, 3, " "
'~ textat 33, 4, " "
'~ textat 33, 21, " "
end sub
sub handleMonster() SHARED STATIC
Dim bMoveFrame as BYTE
bManhattanDistance = myByteABS(bPlayer_Row - bMonster_Row) + myByteABS(bPlayer_Col - bMonster_Col)
'~ textat 33, 21, str$(bManhattanDistance) + " ", 11 'dark gray
if bManhattanDistance > bMonster_Distance_TurnONSpeedUp then
bMonster_SpeedUpMode = TRUE
else
if bManhattanDistance < bMonster_Distance_TurnOFFSpeedUp then
if bMonster_SpeedUpMode then
if bMonster_Lag > 1 then
bMonster_Lag = bMonster_Lag - 1
textat 33, 20, 11 - bMonster_Lag, 2 'red
end if
bMonster_SpeedUpMode = FALSE
VOICE 2 TONE 256 ADSR 0, 0, VOI2_S, VOI2_R
end if
end if
end if
if bMonster_SpeedUpMode then
VOICE 2 TONE shl(cword(bManhattanDistance), 8) ADSR 0, 0, 2, VOI2_R
call monsterMovement()
exit sub
end if
if bMonster_DelayFrame then
bMonster_DelayFrame = bMonster_DelayFrame - 1
if bMonster_DelayFrame = 0 then bMoveFrame = bSkillLevel
else
call monsterMovement()
if bMoveFrame then bMoveFrame = bMoveFrame - 1
if bMoveFrame = 0 then bMonster_DelayFrame = bMonster_Lag - 1
end if
'~ textat 33, 3, str$(bMonster_DelayFrame), 10 'light red
'~ textat 33, 4, str$(bMoveFrame) + " ", 13 'light green
end sub
sub monsterMovement() STATIC
Const MINUS_ONE = 255
Dim wPeekingLocation as WORD
Dim bMonster_PreviousColour as BYTE
Dim bTravelingDirection as BYTE
Dim bThisTileDistance as BYTE
Dim bClosestDistance as BYTE
Dim bThisTileRow as BYTE
Dim bThisTileCol as BYTE
Dim bClosestTileDirection as BYTE
Dim bPeekedDirection as BYTE FAST
Dim bWalkableDirections(4) as BYTE '0...3
Dim bWalkableDirections_Count as BYTE FAST
Dim bTrailDirections(4) as BYTE '0...3
Dim bTrailDirections_Count as BYTE FAST
'------------------------------------------------
wPeekingLocation = scrAddrCache(bMonster_Row) + bMonster_Col
bTravelingDirection = bMonster_Direction
bWalkableDirections_Count = MINUS_ONE
bTrailDirections_Count = MINUS_ONE
bClosestDistance = 255
bMonster_Direction = (bMonster_Direction - 1) AND 3 'starting from the Monster's right (going clockwise)
For bPeekedDirection = 1 to 4
bPeekedTileContent = peek(wPeekingLocation + iDirections(bMonster_Direction))
if (bPeekedTileContent AND MASK_ALL) = GROUP_CREATURES then bExitEvent = EVENT_PLAYER_CAUGHT : exit for 'Gotcha, Player!!
if (bPeekedTileContent AND MASK_WALK_LOWHALF) = GROUP_WALKABLE then
if bPeekedTileContent = TRAIL then
bWalkableDirections_Count = bWalkableDirections_Count + 1
bTrailDirections_Count = bTrailDirections_Count + 1
bTrailDirections(bTrailDirections_Count) = bMonster_Direction
else
if bPeekedDirection < 4 then 'ignoring the opposite travelled direction!
bWalkableDirections_Count = bWalkableDirections_Count + 1
bWalkableDirections(bWalkableDirections_Count) = bMonster_Direction
'ALSO, find the closest tile to the player...
bThisTileRow = bMonster_Row : bThisTileCol = bMonster_Col
if (bMonster_Direction AND 1) then 'odd number, vertical direction
bThisTileRow = bMonster_Row + cbyte(SGN(iDirections(bMonster_Direction)))
else 'even number, horizontal direction
bThisTileCol = bMonster_Col + cbyte(iDirections(bMonster_Direction))
end if
bThisTileDistance = myByteABS(bPlayer_Row - bThisTileRow) + myByteABS(bPlayer_Col - bThisTileCol)
if bThisTileDistance < bClosestDistance then
bClosestDistance = bThisTileDistance
bClosestTileDirection = bMonster_Direction
end if
end if
end if
end if
bMonster_Direction = (bMonster_Direction + 1) AND 3 'now going counter-clockwise
next bPeekedDirection
if bExitEvent = EVENT_NONE then
if bTrailDirections_Count <> MINUS_ONE then
bMonster_Direction = bTrailDirections(myRandom(bTrailDirections_Count, 3))
else
if bWalkableDirections_Count = MINUS_ONE then
bMonster_Direction = (bTravelingDirection + 2) AND 3 'go to the opposite direction and start marking tiles
bMonster_MarkingMode = TRUE
else
if bWalkableDirections_Count = 2 then 'if there are *three* walkable tiles...
bWalkableDirections_Count = bWalkableDirections_Count + 1
bWalkableDirections(bWalkableDirections_Count) = bClosestTileDirection
end if
bMonster_Direction = bWalkableDirections(myRandom(bWalkableDirections_Count, 3))
end if
end if
if bWalkableDirections_Count AND (bWalkableDirections_Count <> MINUS_ONE) then bMonster_MarkingMode = FALSE 'if there are at least *two* walkable tiles...
end if
'------------------------DRAW-------------------------------------------
if (bMonster_PreviousTile AND MASK_ALL) <> GROUP_TREASURE then
bMonster_PreviousTile = SPACE
end if
if bMonster_MarkingMode then
bMonster_PreviousTile = bMonster_PreviousTile OR MASK_SUBGROUP
end if
charat bMonster_Col, bMonster_Row, bMonster_PreviousTile, bMonster_PreviousColour
bMonster_PreviousTile = peek(wPeekingLocation + iDirections(bMonster_Direction))
bMonster_PreviousColour = peek(VIC_COLOR_OFFSET + wPeekingLocation + iDirections(bMonster_Direction))
if (bMonster_Direction AND 1) then 'odd number, vertical direction
bMonster_Row = bMonster_Row + cbyte(SGN(iDirections(bMonster_Direction)))
else 'even number, horizontal direction
bMonster_Col = bMonster_Col + cbyte(iDirections(bMonster_Direction))
end if
charat bMonster_Col, bMonster_Row, MONSTER, 2 'red
VOICE 2 ON
'debug code right after -DRAW-
'~ for bMonsterDebug as BYTE = 0 to 3
'~ textat 33, 2 + bMonsterDebug, " "
'~ next bMonsterDebug
'~ if bWalkableDirections_Count <> MINUS_ONE then
'~ for bMonsterDebug as BYTE = 0 to bWalkableDirections_Count
'~ if bWalkableDirections(bMonsterDebug) = bMonster_Direction then
'~ textat 33, 2 + bMonsterDebug, str$(bWalkableDirections(bMonsterDebug)), 1 'white
'~ else
'~ textat 33, 2 + bMonsterDebug, str$(bWalkableDirections(bMonsterDebug)), 11 'gray
'~ end if
'~ next bMonsterDebug
'~ end if
end sub

97
inc_player.bas Normal file
View File

@ -0,0 +1,97 @@
SHARED Const PLAYER = 64
SHARED Const PLAYER_ALT = 65
Const PLAYER_LEFT = 66
Const MASK_TREASURE_GOLD = 247 '1111 0111
Const MASK_TILE = 7 '0000 0111
SHARED Const EAST = 0
Const NORTH = 1
Const WEST = 2
Const SOUTH = 3
Dim SHARED bPlayer_Col as BYTE
Dim SHARED bPlayer_Row as BYTE
Dim SHARED bPlayer_FacingCharacter as BYTE
Dim bPlayerDirection as BYTE
declare function playerMoved as BYTE () STATIC
sub initPlayer() SHARED STATIC
bPlayer_Col = 1
bPlayer_Row = 1
bPlayer_FacingCharacter = PLAYER
VOICE 1 TONE 256 PULSE 1536 WAVE PULSE ADSR 0, 0, VOI1_S, VOI1_R OFF 'player sound
end sub
sub playerMovement() SHARED STATIC
bJoystick2 = peek( $DC00) XOR 127
if (bJoystick2 AND 1) then
bPlayerDirection = NORTH
if playerMoved() then exit sub
else
if (bJoystick2 AND 2) then
bPlayerDirection = SOUTH
if playerMoved() then exit sub
end if
end if
if (bJoystick2 AND 4) then
bPlayerDirection = WEST
bPlayer_FacingCharacter = PLAYER_LEFT
if playerMoved() then exit sub
else
if (bJoystick2 AND 8) then
bPlayerDirection = EAST
bPlayer_FacingCharacter = PLAYER
if playerMoved() then exit sub
end if
end if
end sub
function playerMoved as BYTE () STATIC
Dim wScoreTable(5) as WORD @loc_wScoreTable
loc_wScoreTable:
DATA AS WORD 10, 20, 30, 50, 500
bPeekedTileContent = peek(scrAddrCache(bPlayer_Row) + bPlayer_Col + iDirections(bPlayerDirection))
if (bPeekedTileContent AND MASK_ALL) = GROUP_CREATURES then 'Player bumped into Monster!
charat bPlayer_Col, bPlayer_Row, SPACE
bExitEvent = EVENT_PLAYER_CAUGHT
return TRUE
end if
if (bPeekedTileContent AND MASK_WALKABLE) = GROUP_WALKABLE then
charat bPlayer_Col, bPlayer_Row, TRAIL, 11 'dark grey
VOICE 1 ON
if (bPlayerDirection AND 1) then 'odd number, vertical direction
bPlayer_Row = bPlayer_Row + cbyte(SGN(iDirections(bPlayerDirection)))
else 'even number, horizontal direction
bPlayer_Col = bPlayer_Col + cbyte(iDirections(bPlayerDirection))
end if
charat bPlayer_Col, bPlayer_Row, bPlayer_FacingCharacter, 13 'light green
if (bPeekedTileContent AND MASK_ALL) = GROUP_TREASURE Then
bTreasuresCollected = bTreasuresCollected + 1
if bTreasuresCollected = bTreasuresToActivateMonster then bMonsterIsOn = TRUE
if (bPeekedTileContent AND MASK_TREASURE_GOLD) = TREASURE_GOLD then 'both non-marked and marked gold!
bGoldNotCollected = FALSE : bSoundTimer_GoldTaken = 28
else
bSoundTimer_TreasureTaken = 7
end if
wScore = wScore + wScoreTable( (bPeekedTileContent AND MASK_TILE) )
textat 33, 15, wScore, 10 'light red
if bTreasuresCollected = bTreasuresToOpenDoor then call openDoorAnimation()
else
if bPeekedTileContent = DOOR_OPEN then bExitEvent = EVENT_PLAYER_EXITED
end if
return TRUE
end if
return FALSE
end function

728
superchase.bas
View File

@ -8,15 +8,15 @@
'** - Atari version by someone @ Compute! Gazette ** '** - Atari version by someone @ Compute! Gazette **
'** - TI-99 4/A version by Cheryl Regena ** '** - TI-99 4/A version by Cheryl Regena **
'** ** '** **
'** Written in XC-BASIC 3.0.8 by @JJFlash@mastodon.social - Sep 2022 ** '** Written in XC-BASIC 3.1.0 by @JJFlash@mastodon.social - Oct 2022 **
'** XC-BASIC created by Csaba Fekete! - https://xc-basic.net/ ** '** XC-BASIC created by Csaba Fekete! - https://xc-basic.net/ **
'** ** '** **
'** WORK IN PROGRESS!! ** '** WORK IN PROGRESS!! **
'*********************************************************************** '***********************************************************************
'--------------INITIAL-SETUP-------------------------------------------- '------------------------INITIAL-SETUP----------------------------------
Dim scrAddrCache(25) as WORD @loc_scrAddrCache ' 0 -> 24 Dim SHARED scrAddrCache(25) as WORD @loc_scrAddrCache ' 0 -> 24
loc_scrAddrCache: loc_scrAddrCache:
DATA AS WORD 1024, 1064, 1104, 1144, 1184, 1224, 1264, 1304, 1344, 1384 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 1424, 1464, 1504, 1544, 1584, 1624, 1664, 1704, 1744, 1784
@ -24,129 +24,130 @@ DATA AS WORD 1824, 1864, 1904, 1944, 1984
poke 53280, 0 : poke 53281, 0 poke 53280, 0 : poke 53281, 0
memcpy @LOC_charset_addr, $3800, 1024 '~ memcpy @LOC_charset_addr, $3800, 1000
poke $D018, 31 'final character location: $3800 poke $D018, %00011111 'screen $0400, char location: $3800
poke 657, 128 'disable upper-lower case change poke 657, 128 'disable upper-lower case change
Dim wStack(128) as WORD @LOC_charset_addr 'recycling the charset data already copied to the final location!
VOLUME 15
'----------------------------------------------------------------------- '-----------------------------------------------------------------------
'-------------CONSTANTS------------------------------------------------- '-------------------------CONSTANTS-------------------------------------
Const TRUE = 255 SHARED Const TRUE = 255
Const FALSE = 0 SHARED Const FALSE = 0
Const INIT = 255
Const GO_ON = 0
Const SPACE = 88 SHARED Const SPACE = 81
Const MARKED_SPACE = 89
Const WALL = 96 Const WALL = 96
Const EX_WALL = 98 Const EX_WALL = 98
Const DOOR_CLOSED = 97 Const DOOR_CLOSED = 97
Const DOOR_CLOSED_REVERSED = 101 Const DOOR_CLOSED_REVERSED = 99
Const DOOR_OPEN = 99 SHARED Const DOOR_OPEN = 88
Const DOOR_OPEN_REVERSED = 103
Const PLAYER = 64 SHARED Const MONSTER = 68
Const PLAYER_LEFT = 66
Const MONSTER = 68
Const MONSTER_ALT = 69 Const MONSTER_ALT = 69
Const TRAIL = 80 SHARED Const TRAIL = 80
Const TREASURES = 112 Const TREASURES = 112
Const TREASURE_GOLD = 116 SHARED Const TREASURE_GOLD = 116
Const EAST = 0 SHARED Const MASK_WALKABLE = 16 '0001 0000
Const NORTH = 1 SHARED Const MASK_ALL = 48 '0011 0000
Const WEST = 2
Const SOUTH = 3
Const MASK_WALKABLE = 16 '0001 0000 SHARED Const GROUP_CREATURES = 0 '0000 0000
Const MASK_ALL = 48 '0011 0000 SHARED Const GROUP_WALKABLE = 16 '0001 0000
Const MASK_SUBGROUP = 8 '0000 1000 SHARED Const GROUP_TREASURE = 48 '0011 0000
Const MASK_ALL_SUBGROUP = 56 '0011 1000
Const MASK_TILE = 7 '0000 0111
Const GROUP_CREATURES = 0 '0000 0000 SHARED Const EVENT_NONE = 0
Const GROUP_WALKABLE = 16 '0001 0000 SHARED Const EVENT_PLAYER_CAUGHT = 1
'~ Const GROUP_WALLS = 32 '0010 0000 SHARED Const EVENT_PLAYER_EXITED = 2
Const GROUP_TREASURE = 48 '0011 0000
Const SUBGROUP_TREASURE = 56 '0011 1000
Const VIC_COLOR_OFFSET = $D400 SHARED Const VIC_COLOR_OFFSET = $D400
SHARED Const VOI1_S = 3
SHARED Const VOI1_R = 3
SHARED Const VOI2_S = 8
SHARED Const VOI2_R = 5
Const VOI3_S = 7
Const VOI3_R = 8
'----------------------------------------------------------------------- '-----------------------------------------------------------------------
'--------------GAME-STATE-&-GLOBAL-STUFF-------------------------------- '-----------------GAME-STATE-&-GLOBAL-STUFF-----------------------------
Dim bPeekedTileContent as BYTE Dim SHARED bPeekedTileContent as BYTE
Dim bFrameCounter as BYTE Dim bFrameCounter as BYTE
Dim bAnimFrameCounter as BYTE Dim bAnimFrameCounter as BYTE
Dim iDirections(4) as INT @loc_iDirections Dim SHARED iDirections(4) as INT @loc_iDirections
loc_iDirections: loc_iDirections:
DATA as INT 1, -40, -1, 40 'east, north, west, south DATA as INT 1, -40, -1, 40 'east, north, west, south
Dim bPlayer_Col as BYTE
Dim bPlayer_Row as BYTE
Dim bPlayer_FacingCharacter as BYTE
Dim bMonsterIsOn as BYTE
Dim bMonster_Col as BYTE
Dim bMonster_Row as BYTE
Dim bMonster_Direction as BYTE
Dim bMonster_Lag as BYTE
Dim bMonster_PreviousTile as BYTE
Dim bMonster_SpeedUpMode as BYTE
Dim bMonster_DelayFrame as BYTE
Dim bMonster_Distance_TurnONSpeedUp as BYTE
Dim bMonster_Distance_TurnOFFSpeedUp as BYTE
Dim bTreasuresToActivateMonster as BYTE
Dim bManhattanDistance as BYTE
Dim wDoorAddress as WORD Dim wDoorAddress as WORD
Dim wDoorColorAddress as WORD
Dim wGoldColorAddress as WORD Dim wGoldColorAddress as WORD
Dim bSkillLevel as BYTE : bSkillLevel = 1 Dim SHARED bSkillLevel as BYTE : bSkillLevel = 1
Dim wScore as WORD Dim SHARED wScore as WORD
Dim wLastExitScore as WORD : wLastExitScore = 0 Dim wLastExitScore as WORD : wLastExitScore = 0
Dim bTreasures_Quantity as BYTE Dim bTreasures_Quantity as BYTE FAST
Dim bTreasuresCollected as BYTE Dim SHARED bTreasuresCollected as BYTE
Dim bTreasuresToOpenDoor as BYTE Dim SHARED bTreasuresToActivateMonster as BYTE : bTreasuresToActivateMonster = 1
Dim bGoldNotCollected as BYTE Dim SHARED bTreasuresToOpenDoor as BYTE
Dim bPlayerExited as BYTE
Dim bPlayerCaught as BYTE Dim SHARED bMonsterIsOn as BYTE
Dim SHARED bGoldNotCollected as BYTE
Dim SHARED bExitEvent as BYTE
Dim wNoteTable(4) as WORD @loc_wNoteTable
loc_wNoteTable:
DATA as WORD $4495, $5669, $6602, $892B 'C6, E6, G6, C7
Dim bSoundIndex as BYTE
Dim SHARED bSoundTimer_GoldTaken as BYTE
Dim SHARED bSoundTimer_TreasureTaken as BYTE
Dim wEventSound as WORD
Dim N as BYTE FAST
Dim SHARED bJoystick2 as BYTE
declare sub generateMaze () STATIC declare sub generateMaze () STATIC
declare sub placeDoor() STATIC declare sub placeDoor() STATIC
declare sub playerMovement() STATIC
declare sub initMonster() STATIC
declare sub handleMonster() STATIC
declare sub monsterMovement() STATIC
declare sub drawInfoBox() STATIC declare sub drawInfoBox() STATIC
declare sub shakeScreen() STATIC declare sub shakeScreen() STATIC
declare sub mazeShiftAway() STATIC declare sub mazeShiftAway() STATIC
declare sub openDoorAnimation() STATIC declare sub openDoorAnimation() SHARED STATIC
declare sub goldFlashAnimation(bInitAnim as BYTE) STATIC declare sub timedSounds() STATIC
declare sub colouredFrame() STATIC
declare sub titleScreen() STATIC declare sub titleScreen() STATIC
declare sub playerAppears() STATIC
declare sub placeCharset() STATIC
'----------------------------------------------------------------------- '-----------------------------------------------------------------------
'------------------HELPER FUNCTIONS------------------------------------- '------------------HELPER FUNCTIONS-------------------------------------
function myRandom as BYTE (bMax as BYTE, bMask as BYTE) STATIC function myRandom as BYTE (bMax as BYTE, bMask as BYTE) SHARED STATIC
do do
myRandom = RNDB() AND bMask myRandom = RNDB() AND bMask
loop while myRandom > bMax loop while myRandom > bMax
end function end function
function myByteABS as BYTE (bNumber as BYTE) STATIC function myByteABS as BYTE (bNumber as BYTE) SHARED STATIC
if (bNumber AND 128) = 128 then bNumber = (NOT bNumber) + 1 if (bNumber AND 128) = 128 then bNumber = (NOT bNumber) + 1
return bNumber return bNumber
end function end function
'-----------------------------------------------------------------------
'------------------------INCLUDES---------------------------------------
include "inc_player.bas"
include "inc_monster.bas"
'-----------------------------------------------------------------------
'------------------TITLE SCREEN----------------------------------------- '------------------TITLE SCREEN-----------------------------------------
sys $E544 FAST ' clear screen sys $E544 FAST ' clear screen
call placeCharset()
call titleScreen() call titleScreen()
'------------------LEVEL-START------------------------------------------ '-------------------GAME-START------------------------------------------
'~ Dim lRandomSeed as LONG : lRandomSeed = clong(248) ' <<<<<<<<<<<<<<<------------- RANDOM!!! '~ Dim lRandomSeed as LONG : lRandomSeed = clong(248) ' <<<<<<<<<<<<<<<------------- RANDOM!!!
@ -158,9 +159,12 @@ textat 33, 8, "level", 5 'green
textat 32, 13, "score", 3 'cyan textat 32, 13, "score", 3 'cyan
textat 32, 18, "speed", 7 'yellow textat 32, 18, "speed", 7 'yellow
Randomize (TI() * (clong(peek( $D012)) + clong(1))) '~ Randomize (TI() * (clong(peek( $D012)) + clong(1)))
Randomize TI()
For N = 1 to 10 : bPeekedTileContent = RNDB() : Next N ' bPeekedTileContent used here as a dummy variable!
redraw: '------------------LEVEL-START------------------------------------------
restartLevel:
For N as BYTE = 0 to 24 For N as BYTE = 0 to 24
memset scrAddrCache(N), 31, WALL memset scrAddrCache(N), 31, WALL
memset VIC_COLOR_OFFSET + scrAddrCache(N), 31, 6 'blue memset VIC_COLOR_OFFSET + scrAddrCache(N), 31, 6 'blue
@ -169,29 +173,27 @@ Next N
'~ lRandomSeed = lRandomSeed + clong(1) '~ lRandomSeed = lRandomSeed + clong(1)
'~ textat 33, 23, str$(lRandomSeed), 14 'light blue '~ textat 33, 23, str$(lRandomSeed), 14 'light blue
'~ Randomize (lRandomSeed) '~ Randomize (lRandomSeed)
'~ For N = 1 to 10 : bPeekedTileContent = RNDB() : Next N ' bPeekedTileContent used here as a dummy variable!
For N as BYTE = 1 to 10 : bPeekedTileContent = RNDB() : Next N ' bPeekedTileContent used here as a dummy variable!
call generateMaze() call generateMaze()
'~ textat 33, 24, str$(bTreasures_Quantity), 7 'yellow '~ textat 33, 24, str$(bTreasures_Quantity), 7 'yellow
call placeDoor() call placeDoor()
'********LEVEL INIT**********
bFrameCounter = 0 bFrameCounter = 0
bPlayer_Col = 1 bSoundIndex = 255
bPlayer_Row = 1 bSoundTimer_TreasureTaken = 0
bPlayer_FacingCharacter = PLAYER bSoundTimer_GoldTaken = 0
VOICE 3 WAVE TRI ADSR 0, 0, VOI3_S, VOI3_R OFF
call initMonster()
wScore = wLastExitScore wScore = wLastExitScore
bTreasuresCollected = 0 bTreasuresCollected = 0
bPlayerExited = FALSE bExitEvent = EVENT_NONE
bPlayerCaught = FALSE
textat 33, 10, str$(bSkillLevel), 1 'white textat 33, 10, bSkillLevel, 1 'white
memset 1657, 5, 32 'erase previous printed score memset 1657, 5, 32 'erase previous printed score
textat 33, 15, str$(wScore), 10 'light red textat 33, 15, wScore, 10 'light red
textat 33, 20, "1 ", 2 'red textat 33, 20, "1 ", 2 'red
bTreasuresToOpenDoor = shr(bTreasures_Quantity, 1) bTreasuresToOpenDoor = shr(bTreasures_Quantity, 1)
@ -202,75 +204,81 @@ else
end if end if
'~ textat 36, 24, str$(bTreasuresToOpenDoor), 12 'gray '~ textat 36, 24, str$(bTreasuresToOpenDoor), 12 'gray
call playerAppears()
call initPlayer()
call initMonster()
'-------------------------MAIN LOOP!------------------------------------ '-------------------------MAIN LOOP!------------------------------------
do do
on bFrameCounter goto actorMovement, endFrame, animation, endFrame on bFrameCounter goto actorMovement, endFrame, mainAnimation, endFrame
actorMovement: actorMovement:
'-------PLAYER MOVEMENT----------------- '-------PLAYER MOVEMENT-----------------
call playerMovement() call playerMovement()
if (bPlayerCaught OR bPlayerExited) then exit do if bExitEvent then exit do
'~ textat 33, 22, str$(bTreasuresCollected) + " ", 15 ' light gray '~ textat 33, 22, str$(bTreasuresCollected) + " ", 15 ' light gray
'-------MONSTER MOVEMENT----------------- '-------MONSTER MOVEMENT-----------------
if bMonsterIsOn then if bMonsterIsOn then
call handleMonster() call handleMonster()
if bPlayerCaught then exit do if bExitEvent then exit do
else
if bTreasuresCollected = bTreasuresToActivateMonster then bMonsterIsOn = TRUE
end if end if
if NOT bGoldNotCollected then call goldFlashAnimation(GO_ON)
goto endFrame goto endFrame
'------------------------------------------------------------------- '-------------------------------------------------------------------
animation: mainAnimation:
if bGoldNotCollected then if bGoldNotCollected then poke wGoldColorAddress, peek(wGoldColorAddress) XOR 6 'alternates white, yellow, white, yellow, ...
poke wGoldColorAddress, peek(wGoldColorAddress) XOR 6 'alternates white, yellow, white, yellow, ...
else
call goldFlashAnimation(GO_ON)
end if
charat bPlayer_Col, bPlayer_Row, bPlayer_FacingCharacter XOR 1, 13 'light green charat bPlayer_Col, bPlayer_Row, bPlayer_FacingCharacter XOR 1, 13 'light green
VOICE 1 OFF
if bMonsterIsOn then if bMonsterIsOn then
if bMonster_SpeedUpMode then if bMonster_SpeedUpMode then
call handleMonster() call handleMonster()
if bExitEvent then exit do
else else
charat bMonster_Col, bMonster_Row, MONSTER_ALT, 2 'red charat bMonster_Col, bMonster_Row, MONSTER_ALT, 2 'red
VOICE 2 OFF
end if end if
end if end if
if bTreasuresCollected = bTreasuresToOpenDoor then call openDoorAnimation()
'------------------------------------------------------------------- '-------------------------------------------------------------------
endFrame: endFrame:
'~ if (peek ( $DC00) AND 16) = 0 then goto redraw '~ if (peek( $DC00) AND 16) = 0 then goto restartGame
'~ if (peek( $DC00) AND 16) = 0 then poke wDoorAddress, DOOR_CLOSED : call openDoorAnimation()
'~ if (peek( $DC00) AND 16) = 0 then bAnimTimer_GoldTaken = 16
'~ if (peek( $DC00) AND 16) = 0 then call colouredFrame() : wait $DC00, 16
'~ if (peek( $DC00) AND 16) = 0 then call playerAppears()
call timedSounds()
wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128 wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128
bFrameCounter = (bFrameCounter + 1) AND 3 bFrameCounter = (bFrameCounter + 1) AND 3
loop loop
if bPlayerCaught then if bExitEvent = EVENT_PLAYER_CAUGHT then
call shakeScreen() call shakeScreen()
call drawInfoBox() call drawInfoBox()
textat 8, 12, "a tasty morsel", 8 'orange textat 8, 12, "a tasty morsel", 8 'orange
textat 12, 13, "indeed!", 8 'orange textat 12, 13, "indeed!", 8 'orange
wScore = wLastExitScore wait $DC00, 16, 16 'wait for fire to be pressed
else else
call drawInfoBox() call drawInfoBox()
textat 8, 12, "congratulations!", 7 'yellow textat 8, 12, "congratulations!", 7 'yellow
textat 6, 13, "onto the next level!", 7 'yellow textat 6, 13, "onto the next level!", 7 'yellow
wLastExitScore = wScore wLastExitScore = wScore
if bSkillLevel < 255 then bSkillLevel = bSkillLevel + 1 if bSkillLevel < 255 then bSkillLevel = bSkillLevel + 1
call colouredFrame()
call mazeShiftAway()
end if end if
wait $DC00, 16, 16 'wait for fire to be pressed goto restartLevel
if bPlayerExited then call mazeShiftAway()
goto redraw
'------------GAME-SUBROUTINES------------------------------------------- '------------GAME-SUBROUTINES-------------------------------------------
sub generateMaze () STATIC sub generateMaze () STATIC
Dim bRow as BYTE Dim bRow as BYTE FAST
Dim bCol as BYTE Dim bCol as BYTE FAST
Dim bRowEnd as BYTE Dim bRowEnd as BYTE FAST
Dim bColEnd as BYTE Dim bColEnd as BYTE FAST
memset 1065, 5, EX_WALL memset 1065, 5, EX_WALL
poke 1105, EX_WALL poke 1105, EX_WALL
@ -278,14 +286,14 @@ sub generateMaze () STATIC
poke 1185, EX_WALL poke 1185, EX_WALL
poke 1225, EX_WALL poke 1225, EX_WALL
For N as BYTE = 1 to 65 For N = 1 to 65
bCol = shl(myRandom(13, 15), 1) + 1 bCol = shl(myRandom(13, 15), 1) + 1
bRow = shl(myRandom(11, 15), 1) + 1 bRow = shl(myRandom(11, 15), 1) + 1
bColEnd = bCol + 6 : if bColEnd > 29 then bColEnd = 29 bColEnd = bCol + 6 : if bColEnd > 29 then bColEnd = 29
memset scrAddrCache(bRow) + bCol, bColEnd - bCol + 1, EX_WALL memset scrAddrCache(bRow) + bCol, bColEnd - bCol + 1, EX_WALL
Next N Next N
For N as BYTE = 1 to 60 For N = 1 to 60
bCol = shl(myRandom(14, 15), 1) + 1 bCol = shl(myRandom(14, 15), 1) + 1
bRow = shl(myRandom(10, 15), 1) + 1 bRow = shl(myRandom(10, 15), 1) + 1
bRowEnd = bRow + 4 : if bRowEnd > 23 then bRowEnd = 23 bRowEnd = bRow + 4 : if bRowEnd > 23 then bRowEnd = 23
@ -294,10 +302,11 @@ sub generateMaze () STATIC
Next K Next K
Next N Next N
Dim wCalcScreenAddress as WORD Dim wCalcScreenAddress as WORD FAST
Dim bStackPointer as BYTE Dim bStackPointer as BYTE FAST
Dim wFilledCells as WORD Dim wFilledCells as WORD FAST
Dim wPatchScrAddress as WORD Dim wPatchScrAddress as WORD
Dim wStack(128) as WORD
bStackPointer = 1 : wFilledCells = 0 bStackPointer = 1 : wFilledCells = 0
wStack(0) = 1065 'player starting position: Row 1, Column 1 wStack(0) = 1065 'player starting position: Row 1, Column 1
@ -339,12 +348,12 @@ loc_bTreasures_Sequence:
if wFilledCells > 5 then if wFilledCells > 5 then
If myRandom(5, 7) = 5 then If myRandom(5, 7) = 5 then
bTileType = TREASURES + bTreasures_Sequence(bTreasures_Index) bTileType = TREASURES + bTreasures_Sequence(bTreasures_Index)
if bTileType = TREASURE_GOLD then wGoldColorAddress = VIC_COLOR_OFFSET + wCalcScreenAddress : bGoldNotCollected = TRUE
bTileColor = bTreasures_Color(bTileType AND 7) bTileColor = bTreasures_Color(bTileType AND 7)
if bTreasures_Index < 50 then bTreasures_Index = bTreasures_Index + 1 if bTreasures_Index < 50 then bTreasures_Index = bTreasures_Index + 1
bTreasures_Quantity = bTreasures_Quantity + 1 bTreasures_Quantity = bTreasures_Quantity + 1
end if end if
end if end if
if bTileType = TREASURE_GOLD then wGoldColorAddress = VIC_COLOR_OFFSET + wCalcScreenAddress : bGoldNotCollected = TRUE
poke wCalcScreenAddress, bTileType : poke VIC_COLOR_OFFSET + wCalcScreenAddress, bTileColor poke wCalcScreenAddress, bTileType : poke VIC_COLOR_OFFSET + wCalcScreenAddress, bTileColor
wFilledCells = wFilledCells + 1 wFilledCells = wFilledCells + 1
@ -379,271 +388,31 @@ loc_bTreasures_Sequence:
end sub end sub
sub placeDoor() STATIC sub placeDoor() STATIC
wDoorAddress = $0586 'Col 30, Row 9 Dim wStartingDoorAddress as WORD FAST
wStartingDoorAddress = scrAddrCache(myRandom(22, 31) + 1) + 29 'Col 29, Row random
Dim wMaxDoorAddress as WORD FAST : wMaxDoorAddress = $07DD 'Col 29, Row 24
Dim wMinDoorAddress as WORD FAST : wMinDoorAddress = $0445 'Col 29, Row 1
wDoorAddress = wStartingDoorAddress
do do
For bRowIncrement AS BYTE = 0 to 22 'row 9 -> 23 + 1 -> 8 if (peek(wDoorAddress) AND MASK_WALKABLE) = GROUP_WALKABLE then
if ((peek(wDoorAddress - cword(1)) AND MASK_WALKABLE) = GROUP_WALKABLE) then wDoorAddress = wDoorAddress + 1
poke wDoorAddress, DOOR_CLOSED poke wDoorAddress, DOOR_CLOSED
poke VIC_COLOR_OFFSET + wDoorAddress, 14 'light blue wDoorColorAddress = VIC_COLOR_OFFSET + wDoorAddress
poke wDoorColorAddress, 14 'light blue
exit sub exit sub
else
if bRowIncrement = 14 then
wDoorAddress = wDoorAddress - 880 'up 22 rows
else
wDoorAddress = wDoorAddress + cword(40) 'next row
end if end if
wDoorAddress = wDoorAddress + 40
if wDoorAddress = wMaxDoorAddress then wDoorAddress = wMinDoorAddress
if wDoorAddress = wStartingDoorAddress then
wStartingDoorAddress = wStartingDoorAddress - 1
wDoorAddress = wStartingDoorAddress
wMaxDoorAddress = wMaxDoorAddress - 1
wMinDoorAddress = wMinDoorAddress - 1
end if end if
Next bRowIncrement
'back to row 9? Try the previous column...
wDoorAddress = wDoorAddress - cword(1)
loop loop
end sub end sub
sub playerMovement() STATIC
Dim wScoreTable(5) as WORD @loc_wScoreTable
loc_wScoreTable:
DATA AS WORD 10, 20, 30, 50, 500
Dim bJoystick2 as BYTE
bJoystick2 = peek ( $DC00) XOR 127
if (bJoystick2 AND 1) then
bJoystick2 = NORTH
else
if (bJoystick2 AND 2) then
bJoystick2 = SOUTH
else
if (bJoystick2 AND 4) then
bJoystick2 = WEST
bPlayer_FacingCharacter = PLAYER_LEFT
else
if (bJoystick2 AND 8) then
bJoystick2 = EAST
bPlayer_FacingCharacter = PLAYER
else
exit sub
end if
end if
end if
end if
bPeekedTileContent = peek(scrAddrCache(bPlayer_Row) + bPlayer_Col + iDirections(bJoystick2))
if (bPeekedTileContent AND MASK_ALL) = GROUP_CREATURES then 'Player bumped into Monster!
charat bPlayer_Col, bPlayer_Row, SPACE, 11 'dark grey
bPlayerCaught = TRUE : exit sub
end if
if ((bPeekedTileContent AND MASK_WALKABLE) = GROUP_WALKABLE) OR (bPeekedTileContent = DOOR_OPEN) then
charat bPlayer_Col, bPlayer_Row, TRAIL, 11 'dark grey
if (bJoystick2 AND 1) then 'odd number, vertical direction
bPlayer_Row = bPlayer_Row + cbyte(SGN(iDirections(bJoystick2)))
else 'even number, horizontal direction
bPlayer_Col = bPlayer_Col + cbyte(iDirections(bJoystick2))
end if
charat bPlayer_Col, bPlayer_Row, bPlayer_FacingCharacter, 13 'light green
if (bPeekedTileContent AND MASK_ALL) = GROUP_TREASURE Then
'~ poke 53280, (bPeekedTileContent AND MASK_TILE) + 1
'~ wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128
'~ poke 53280, 0
bTreasuresCollected = bTreasuresCollected + 1
if (bPeekedTileContent AND 247) = TREASURE_GOLD then call goldFlashAnimation(INIT) 'both non-marked and marked!
wScore = wScore + wScoreTable ( (bPeekedTileContent AND MASK_TILE) )
textat 33, 15, str$(wScore), 10 'light red
else
if bPeekedTileContent = DOOR_OPEN then bPlayerExited = TRUE
end if
end if
end sub
sub initMonster() STATIC
bMonsterIsOn = FALSE
if bSkillLevel < 8 then
bTreasuresToActivateMonster = 8 - bSkillLevel
else
bTreasuresToActivateMonster = 1
end if
bMonster_Col = 1
bMonster_Row = 1
bMonster_Direction = EAST
bMonster_Lag = 10
bMonster_PreviousTile = SPACE
bMonster_SpeedUpMode = FALSE
if bSkillLevel < 14 then
bMonster_Distance_TurnONSpeedUp = 20 - bSkillLevel
bMonster_Distance_TurnOFFSpeedUp = 12 - shr(bSkillLevel, 1)
else
bMonster_Distance_TurnONSpeedUp = 7
bMonster_Distance_TurnOFFSpeedUp = 5
end if
bMonster_DelayFrame = 9 '= Lag - 1
'~ textat 33, 3, " "
'~ textat 33, 4, " "
'~ textat 33, 21, " "
end sub
sub handleMonster() STATIC
Dim bMoveFrame as BYTE
bManhattanDistance = myByteABS(bPlayer_Row - bMonster_Row) + myByteABS(bPlayer_Col - bMonster_Col)
'~ textat 33, 21, str$(bManhattanDistance) + " ", 11 'dark gray
if bManhattanDistance > bMonster_Distance_TurnONSpeedUp then
bMonster_SpeedUpMode = TRUE
else
if bManhattanDistance < bMonster_Distance_TurnOFFSpeedUp then
if bMonster_SpeedUpMode then
if bMonster_Lag > 1 then
bMonster_Lag = bMonster_Lag - 1
textat 33, 20, str$(11 - bMonster_Lag), 2 'red
end if
bMonster_SpeedUpMode = FALSE
end if
end if
end if
if bMonster_SpeedUpMode then call monsterMovement() : exit sub
if bMonster_DelayFrame = 0 then
call monsterMovement()
if bMoveFrame > 0 then bMoveFrame = bMoveFrame - 1
if bMoveFrame = 0 then bMonster_DelayFrame = bMonster_Lag - 1
else
bMonster_DelayFrame = bMonster_DelayFrame - 1
if bMonster_DelayFrame = 0 then bMoveFrame = bSkillLevel
end if
'~ textat 33, 3, str$(bMonster_DelayFrame), 10 'light red
'~ textat 33, 4, str$(bMoveFrame) + " ", 13 'light green
end sub
sub monsterMovement() STATIC
Const MINUS_ONE = 255
Dim wPeekingLocation as WORD
Dim bMonster_PreviousColour as BYTE
Dim bTravelingDirection as BYTE
Dim bThisTileDistance as BYTE
Dim bClosestDistance as BYTE
Dim bThisTileRow as BYTE
Dim bThisTileCol as BYTE
Dim bClosestTileDirection as BYTE
Dim bPeekedDirection as BYTE
Dim bWalkableDirections(4) as BYTE '0...3
Dim bWalkableDirections_Count as BYTE
Dim bTrailDirections(4) as BYTE '0...3
Dim bTrailDirections_Count as BYTE
'------------------------------------------------
wPeekingLocation = scrAddrCache(bMonster_Row) + bMonster_Col
bTravelingDirection = bMonster_Direction
bWalkableDirections_Count = MINUS_ONE
bTrailDirections_Count = MINUS_ONE
bClosestDistance = 255
bMonster_Direction = (bMonster_Direction - 1) AND 3 'starting from the Monster's right (going clockwise)
For bPeekedDirection = 1 to 4
bPeekedTileContent = peek(wPeekingLocation + iDirections(bMonster_Direction))
if (bPeekedTileContent AND MASK_ALL) = GROUP_CREATURES then bPlayerCaught = TRUE : exit for 'Gotcha, Player!!
if (bPeekedTileContent AND MASK_WALKABLE) = GROUP_WALKABLE then
'~ if (bPeekedTileContent AND MASK_ALL_SUBGROUP) = GROUP_TRAIL then
if bPeekedTileContent = TRAIL then
bWalkableDirections_Count = bWalkableDirections_Count + 1
'~ bWalkableDirections(bWalkableDirections_Count) = bMonster_Direction
bTrailDirections_Count = bTrailDirections_Count + 1
bTrailDirections(bTrailDirections_Count) = bMonster_Direction
else
if ((bPeekedTileContent AND MASK_ALL_SUBGROUP) <> SUBGROUP_TREASURE) AND (bPeekedTileContent <> MARKED_SPACE) and bPeekedDirection < 4 then 'ignoring the opposite direction travelled!
bWalkableDirections_Count = bWalkableDirections_Count + 1
bWalkableDirections(bWalkableDirections_Count) = bMonster_Direction
'ALSO, find the closest tile to the player...
bThisTileRow = bMonster_Row : bThisTileCol = bMonster_Col
if (bMonster_Direction AND 1) then 'odd number, vertical direction
bThisTileRow = bMonster_Row + cbyte(SGN(iDirections(bMonster_Direction)))
else 'even number, horizontal direction
bThisTileCol = bMonster_Col + cbyte(iDirections(bMonster_Direction))
end if
bThisTileDistance = myByteABS(bPlayer_Row - bThisTileRow) + myByteABS(bPlayer_Col - bThisTileCol)
if bThisTileDistance < bClosestDistance then
bClosestDistance = bThisTileDistance
bClosestTileDirection = bMonster_Direction
end if
end if
end if
end if
bMonster_Direction = (bMonster_Direction + 1) AND 3 'now going counter-clockwise
next bPeekedDirection
if bPlayerCaught = FALSE then
if bTrailDirections_Count <> MINUS_ONE then
bMonster_Direction = bTrailDirections(myRandom(bTrailDirections_Count, 3))
else
if bWalkableDirections_Count = MINUS_ONE then
bMonster_Direction = (bTravelingDirection + 2) AND 3 'opposite direction
else
bWalkableDirections_Count = bWalkableDirections_Count + 1
bWalkableDirections(bWalkableDirections_Count) = bClosestTileDirection
bMonster_Direction = bWalkableDirections(myRandom(bWalkableDirections_Count, 3))
end if
end if
end if
'------------------------DRAW-------------------------------------------
'~ for bMonsterDebug as BYTE = 0 to 3
'~ textat 33, 2 + bMonsterDebug, " "
'~ next bMonsterDebug
'~ if bWalkableDirections_Count <> MINUS_ONE then
'~ for bMonsterDebug as BYTE = 0 to bWalkableDirections_Count
'~ if bWalkableDirections(bMonsterDebug) = bMonster_Direction then
'~ textat 33, 2 + bMonsterDebug, str$(bWalkableDirections(bMonsterDebug)), 1 'white
'~ else
'~ textat 33, 2 + bMonsterDebug, str$(bWalkableDirections(bMonsterDebug)), 11 'gray
'~ end if
'~ next bMonsterDebug
'~ end if
if (bMonster_PreviousTile AND MASK_ALL) = GROUP_TREASURE then
if bWalkableDirections_Count = MINUS_ONE then
bMonster_PreviousTile = bMonster_PreviousTile OR MASK_SUBGROUP
end if
else
if bWalkableDirections_Count = MINUS_ONE then
bMonster_PreviousTile = MARKED_SPACE
else
bMonster_PreviousTile = SPACE
end if
end if
if (bMonster_PreviousColour AND 15) = 0 then bMonster_PreviousColour = 14
charat bMonster_Col, bMonster_Row, bMonster_PreviousTile, bMonster_PreviousColour
bMonster_PreviousTile = peek(wPeekingLocation + iDirections(bMonster_Direction))
bMonster_PreviousColour = peek(VIC_COLOR_OFFSET + wPeekingLocation + iDirections(bMonster_Direction))
if (bMonster_Direction AND 1) = 1 then 'odd number, vertical direction
bMonster_Row = bMonster_Row + cbyte(SGN(iDirections(bMonster_Direction)))
else 'even number, horizontal direction
bMonster_Col = bMonster_Col + cbyte(iDirections(bMonster_Direction))
end if
charat bMonster_Col, bMonster_Row, MONSTER, 2 'red
if bWalkableDirections_Count = MINUS_ONE then bMonster_Direction = bTravelingDirection
end sub
sub drawInfoBox() STATIC sub drawInfoBox() STATIC
'~ textat 4, 11, "{168}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{173}", 6 'blu '~ textat 4, 11, "{168}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{171}{173}", 6 'blu
'~ textat 4, 12, "{169} {174}", 6 'blu '~ textat 4, 12, "{169} {174}", 6 'blu
@ -661,90 +430,173 @@ sub drawInfoBox() STATIC
memset 1549, 21, 32 'col 5-25, row 13 memset 1549, 21, 32 'col 5-25, row 13
poke 1570, 110 'col 26, row 13 poke 1570, 110 'col 26, row 13
poke 1588, 106 'col 4, row 13 poke 1588, 106 'col 4, row 14
memset 1589, 21, 108 'col 5-25, row 13 memset 1589, 21, 108 'col 5-25, row 14
poke 1610, 111 'col 26, row 13 poke 1610, 111 'col 26, row 14
memset VIC_COLOR_OFFSET + 1468, 23, 6 'blu memset 55740, 23, 6 'blu
memset VIC_COLOR_OFFSET + 1508, 23, 6 'blu memset 55780, 23, 6 'blu
memset VIC_COLOR_OFFSET + 1548, 23, 6 'blu memset 55820, 23, 6 'blu
memset VIC_COLOR_OFFSET + 1588, 23, 6 'blu memset 55860, 23, 6 'blu
end sub end sub
sub shakeScreen() STATIC sub shakeScreen() STATIC
Dim bVariance as BYTE : bVariance = 7 Dim bVariance as BYTE
VOICE 1 OFF
VOICE 2 ON
VOICE 3 OFF WAVE SAW
bVariance = 7
bAnimFrameCounter = 0 bAnimFrameCounter = 0
wEventSound = 1382
do do
poke $D011, %10011000 OR ((3 + myRandom(bVariance, 7)) AND 7) poke $D011, %10011000 OR ((3 + myRandom(bVariance, 7)) AND 7)
poke $D016, %00001000 OR myRandom(bVariance, 7) poke $D016, %00001000 OR myRandom(bVariance, 7)
VOICE 3 TONE wEventSound ON
wait $d011, 128, 128 : wait $d011, 128 wait $d011, 128, 128 : wait $d011, 128
bAnimFrameCounter = (bAnimFrameCounter + 1) AND 3 bAnimFrameCounter = (bAnimFrameCounter + 1) AND 3
if bAnimFrameCounter = 0 then bVariance = bVariance - 1 if bAnimFrameCounter = 0 then bVariance = bVariance - 1
wEventSound = wEventSound - 40
loop until bVariance = 255 loop until bVariance = 255
VOICE 2 OFF
VOICE 3 OFF
end sub end sub
sub mazeShiftAway() STATIC sub mazeShiftAway() STATIC
dim wLineAddress as WORD : dim wColorLineAddress as WORD dim wLineAddress as WORD FAST : dim wColorLineAddress as WORD FAST
wait $d011, 128, 128 : wait $d011, 128 Dim nShiftLine as BYTE FAST
for nShiftColumn as BYTE = 0 to 30 for nShiftLine = 0 to 24
for nShiftLine as BYTE = 0 to 24
wLineAddress = scrAddrCache(nShiftLine) wLineAddress = scrAddrCache(nShiftLine)
wColorLineAddress = VIC_COLOR_OFFSET + wLineAddress wColorLineAddress = VIC_COLOR_OFFSET + wLineAddress
memcpy wLineAddress + 1, wLineAddress, 31 memcpy wLineAddress + 1, wLineAddress, 31
memcpy wColorLineAddress + 1, wColorLineAddress, 31 memcpy wColorLineAddress + 1, wColorLineAddress, 31
next nShiftLine next nShiftLine
wait $d011, 128, 128 : wait $d011, 128
next nShiftColumn for N = 0 to 15 '31 columns, 2 cells moved per frame, so 16 times
for nShiftLine = 0 to 24
wLineAddress = scrAddrCache(nShiftLine)
wColorLineAddress = VIC_COLOR_OFFSET + wLineAddress
memcpy wLineAddress + 2, wLineAddress, 30
memcpy wColorLineAddress + 2, wColorLineAddress, 30
next nShiftLine
wait $d011, 128
next N
end sub end sub
sub openDoorAnimation() STATIC sub openDoorAnimation() SHARED STATIC
For bAnimFrameCounter = 1 to 5 Dim bDoorColor as BYTE : bDoorColor = 14 'light blue
poke wDoorAddress, DOOR_CLOSED_REVERSED Dim bDoorChar as BYTE : bDoorChar = DOOR_CLOSED_REVERSED
poke VIC_COLOR_OFFSET + wDoorAddress, 13 'light green wEventSound = $7F00
wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128
poke wDoorAddress, DOOR_CLOSED
poke VIC_COLOR_OFFSET + wDoorAddress, 14 'light blue
wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128
Next bAnimFrameCounter
For bAnimFrameCounter = 1 to 5
poke wDoorAddress, DOOR_OPEN_REVERSED
poke VIC_COLOR_OFFSET + wDoorAddress, 7 'yellow
wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128
poke wDoorAddress, DOOR_OPEN
poke VIC_COLOR_OFFSET + wDoorAddress, 14 'light blue
wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128
Next bAnimFrameCounter
bTreasuresToOpenDoor = 0 VOICE 1 OFF
VOICE 2 OFF
VOICE 3 OFF WAVE PULSE ADSR 0, 0, 12, 1
For bAnimFrameCounter = 1 to 20
bDoorChar = bDoorChar XOR 2 'alternates normal door, reversed door, normal door, ... (or viceversa)
poke wDoorAddress, bDoorChar
bDoorColor = bDoorColor XOR 9 'alternates yellow, light blue, yellow, ...
poke wDoorColorAddress, bDoorColor
VOICE 3 TONE wEventSound PULSE 63 ON
wEventSound = wEventSound + 780
wait $d011, 128, 128 : wait $d011, 128 : wait $d011, 128, 128 : wait $d011, 128
if bAnimFrameCounter = 10 then bDoorChar = DOOR_OPEN 'changes from reversed closed door to NORMAL open door
Next bAnimFrameCounter
VOICE 3 OFF TONE 0 WAVE TRI ADSR 0, 0, VOI3_S, VOI3_R
bSoundTimer_TreasureTaken = 0
end sub end sub
sub goldFlashAnimation (bInitAnim as BYTE) STATIC sub timedSounds() STATIC
Dim bFlashTimer as BYTE dim bSoundPreviousIndex as BYTE
if bInitAnim then if bSoundTimer_GoldTaken then
bGoldNotCollected = FALSE VOICE 3 TONE shr(wNoteTable(bSoundIndex), 2) ON
bFlashTimer = 8 bSoundIndex = (bSoundIndex + 1) AND 3
else
if bFlashTimer = 0 then exit sub bSoundTimer_GoldTaken = bSoundTimer_GoldTaken - 1
if bSoundTimer_GoldTaken = 0 then VOICE 3 OFF : bSoundTimer_TreasureTaken = 0
exit sub
end if end if
bFlashTimer = bFlashTimer - 1 if bSoundTimer_TreasureTaken then
if (bFlashTimer AND 1) then bSoundPreviousIndex = bSoundIndex
poke 53281, 8 'orange do
else bSoundIndex = myRandom(3, 3)
poke 53281, 0 'black loop while bSoundIndex = bSoundPreviousIndex
VOICE 3 TONE wNoteTable(bSoundIndex) ON
bSoundTimer_TreasureTaken = bSoundTimer_TreasureTaken - 1
if bSoundTimer_TreasureTaken = 0 then VOICE 3 OFF
end if end if
end sub end sub
sub colouredFrame() STATIC
Dim iFrameColorAddress as INT FAST
Dim bStripIndex as BYTE FAST
Dim bStartingStripIndex as BYTE FAST
Dim bStripColors(8) as BYTE @loc_bStripColors
loc_bStripColors:
DATA as BYTE 1, 1, 7, 7, 3, 3, 2, 2 'white, yellow, cyan, red
VOICE 1 OFF WAVE TRI TONE shr(wNoteTable(0), 4) ADSR 0, 11, 1, 10 ON
VOICE 2 OFF WAVE TRI TONE shr(wNoteTable(1), 1) ADSR 0, 11, 1, 10 ON
VOICE 3 OFF WAVE TRI TONE wNoteTable(2) ADSR 0, 11, 1, 10 ON
bStartingStripIndex = 0
do
bStripIndex = bStartingStripIndex
for iFrameColorAddress = $D800 to $D81E
poke iFrameColorAddress, bStripColors(bStripIndex)
bStripIndex = (bStripIndex + 1) AND 7
next iFrameColorAddress
for iFrameColorAddress = $D846 to $DBDE STEP 40
poke iFrameColorAddress, bStripColors(bStripIndex)
bStripIndex = (bStripIndex + 1) AND 7
next iFrameColorAddress
poke wDoorColorAddress, 13 'light green (Player is here)
for iFrameColorAddress = $DBDD to $DBC0 STEP -1
poke iFrameColorAddress, bStripColors(bStripIndex)
bStripIndex = (bStripIndex + 1) AND 7
next iFrameColorAddress
for iFrameColorAddress = $DB98 to $D828 STEP -40
poke iFrameColorAddress, bStripColors(bStripIndex)
bStripIndex = (bStripIndex + 1) AND 7
next iFrameColorAddress
for bAnimFrameCounter = 1 to 5
wait $D011, 128, 128 : wait $D011, 128
if peek( $DC00) = %01101111 then exit do 'if fire button is pressed, exit
next bAnimFrameCounter
bStartingStripIndex = (bStartingStripIndex - 2) AND 7
loop
VOICE 1 TONE shr(wNoteTable(0), 3) OFF
VOICE 2 TONE shr(wNoteTable(0), 1) OFF
VOICE 3 TONE shl(wNoteTable(0), 1) OFF
end sub
sub titleScreen() STATIC sub titleScreen() STATIC
Const PLAYER_LOCATION = 1354 Const PLAYER_LOCATION = 1354
Const MONSTER_LOCATION = 1434 Const MONSTER_LOCATION = 1434
Dim bJoystick2 as BYTE Dim sCredits(5) as STRING * 40 @loc_sCredits
loc_sCredits:
DATA as STRING * 40 " written by jjflash@itch.io "
DATA as STRING * 40 " original vic-20 game: anthony godshall "
DATA as STRING * 40 " atari graphics: compute! gazette "
DATA as STRING * 40 " ti99-4/a version: cheryl regena "
DATA as STRING * 40 " xc=basic 3: csaba fekete - xc-basic.net"
Dim bCreditIndex as BYTE
'treasure frame for title 'treasure frame for title
memset 1036, 16, TREASURE_GOLD memset 1036, 16, TREASURE_GOLD
@ -765,13 +617,19 @@ sub titleScreen() STATIC
textat 13, 10, "monster of dungeons!", 7 'yellow textat 13, 10, "monster of dungeons!", 7 'yellow
textat 12, 15, "choose skill level", 5 'green textat 12, 15, "choose skill level", 5 'green
textat 13, 19, "then press fire", 5 'green
charat 18, 17, 60, 10 'left arrow, light red charat 18, 17, 60, 10 'left arrow, light red
charat 22, 17, 62, 10 'right arrow, light red charat 22, 17, 62, 10 'right arrow, light red
poke PLAYER_LOCATION, PLAYER : poke 55626, 13 'light green poke PLAYER_LOCATION, PLAYER : poke 55626, 13 'light green
poke MONSTER_LOCATION, MONSTER : poke 55706, 2 'red poke MONSTER_LOCATION, MONSTER : poke 55706, 2 'red
bCreditIndex = 0
do do
textat 0, 24, sCredits(bCreditIndex), 15 'light gray
for bFrameCounter = 1 to 36
charat 20, 17, 48 + bSkillLevel, 1 'white charat 20, 17, 48 + bSkillLevel, 1 'white
poke 55994, 10 'color for left arrow, light red poke 55994, 10 'color for left arrow, light red
@ -779,8 +637,8 @@ sub titleScreen() STATIC
bJoystick2 = peek( $DC00) XOR 127 bJoystick2 = peek( $DC00) XOR 127
if (bJoystick2 AND 4) then 'color for left arrow, left if (bJoystick2 AND 4) then 'left
poke 55994, 1 'white poke 55994, 1 'color for left arrow, white
if bSkillLevel > 1 then bSkillLevel = bSkillLevel - 1 if bSkillLevel > 1 then bSkillLevel = bSkillLevel - 1
else else
if (bJoystick2 AND 8) then 'right if (bJoystick2 AND 8) then 'right
@ -788,7 +646,7 @@ sub titleScreen() STATIC
if bSkillLevel < 9 then bSkillLevel = bSkillLevel + 1 if bSkillLevel < 9 then bSkillLevel = bSkillLevel + 1
else else
if (bJoystick2 AND 16) then 'fire if (bJoystick2 AND 16) then 'fire
exit do exit sub
end if end if
end if end if
end if end if
@ -796,12 +654,30 @@ sub titleScreen() STATIC
poke PLAYER_LOCATION, peek(PLAYER_LOCATION) XOR 1 poke PLAYER_LOCATION, peek(PLAYER_LOCATION) XOR 1
poke MONSTER_LOCATION, peek(MONSTER_LOCATION) XOR 1 poke MONSTER_LOCATION, peek(MONSTER_LOCATION) XOR 1
wait $D011, 128, 128 : wait $D011, 128 : wait $D011, 128, 128 : wait $D011, 128 for bAnimFrameCounter = 1 to 6
wait $D011, 128, 128 : wait $D011, 128 : wait $D011, 128, 128 : wait $D011, 128 wait $D011, 128, 128 : wait $D011, 128
wait $D011, 128, 128 : wait $D011, 128 : wait $D011, 128, 128 : wait $D011, 128 next bAnimFrameCounter
next bFrameCounter
bCreditIndex = bCreditIndex + 1 : if bCreditIndex = 5 then bCreditIndex = 0
loop loop
end sub
sub playerAppears() STATIC
charat 1, 1, PLAYER_ALT, 0 'black
VOICE 1 WAVE PULSE TONE 10000 PULSE 2048 ADSR 0, 0, 2, 9 ON OFF
For bAnimFrameCounter = 1 to 21
poke $D829, peek( $D829) XOR 13 'row 1, col 1, light green
wait $d011, 128, 128 : wait $d011, 128
wait $d011, 128, 128 : wait $d011, 128
next bAnimFrameCounter
end sub end sub
'----------------------------------------------------------------------- '-----------------------------------------------------------------------
LOC_charset_addr: sub placeCharset() STATIC
exit sub
origin $3800
incbin "charset_superchase.chr" incbin "charset_superchase.chr"
end sub

BIN
superchase.prg
View File

Binary file not shown.