+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: Deadly Towers 64 (beta for testing) (/showthread.php?tid=1788)
Deadly Towers 64 (beta for testing) - Cobalt - 06-25-2023
My current official project!
a clone of Deadly Towers for the NES.
Arguably one of the more frustrating games ever released for the NES, I started this project to try and fix some of the issues I have with the game, mainly the collision detection. You get stuck in the game a lot.
I have done some testing on my own but would like to see if anybody else can break anything or if there are spots where you seem to get 'stuck' or have trouble with the character not moving. Mainly to see if the collision detection can be broken anywhere. I have 1 dungeon loading the start location and exit location are the same as the NES version so you can use this map to navigate it.
https://gamefaqs.gamespot.com/nes/587219-deadly-towers/map/2815-dungeon-maze-01-map
there are no shops yet or anything its just map exploring.
keys are:
Arrow keys move
Spacebar brings up status screen
'a' uses item in status screen (lower case)
'b' drops item in status screen (lower case)
also exits game when out of status screen
Download the attached MFI file
Code: (Select All)
'Deadly Tower clone beta test release
'date code: 06252023
'Cobalt
TYPE Control_Keys
Up_Key AS LONG
Down_Key AS LONG
Left_Key AS LONG
Right_Key AS LONG
A_Button AS LONG
B_Button AS LONG
Select_Button AS LONG
Start_Button AS LONG
END TYPE
TYPE MapData
x AS INTEGER
y AS INTEGER
MaxScroll AS INTEGER
Scroll AS _BYTE
END TYPE
TYPE Corddata
X AS INTEGER
Y AS INTEGER
END TYPE
TYPE Gamedata
Map AS Corddata 'scroll value of map 0 to MaxScroll
Scroll_Direction AS _BYTE 'which direction does map scroll, vert or horiz
Passage AS _BYTE 'has player entered a doorway of somekind?
Dungeon AS _BYTE 'has player entered a dungeon?
Dungeon_Shop_Count AS _BYTE
Exit_Dungeon AS _BYTE ' works like passage, puts player on overworld at dungeon exit passage
Last_Dungeon AS _BYTE
Shop_Count AS _BYTE
Where AS _BYTE ' where the doorway leads
Door_Side AS _BYTE 'denote which door player went through in dungeon
Shop AS _BYTE 'which shop is player entering
FallDeath AS _BYTE
Scroll_Lock AS _BYTE 'turn scrolling on or off on level
On_Ladder AS _BYTE 'is player currently climbing a ladder
Duration AS _BYTE 'if player used blue or green necklace, how long it lasts
PauseEnemies AS _BYTE 'if player uses the figure pause all for `Duration` (affects all enemies not just humaniod ones as in original)
END TYPE
TYPE PlayerData
Health AS _UNSIGNED _BYTE
MaxHealth AS _UNSIGNED _BYTE
Ludder AS _UNSIGNED _BYTE
Bells AS _BYTE 'bells player has
Burned AS _BYTE 'bells burned
Helm AS _BYTE
Shield AS _BYTE
Armor AS _BYTE
Sword AS _BYTE
Enhance AS _BYTE
Glove AS _BYTE
Boots AS _BYTE
O_Necklace AS _BYTE
DefBonus AS _BYTE 'bonus to defence by blue or green necklaces
X AS INTEGER 'player screen location
Y AS INTEGER
DX AS _BYTE 'player location in Dungeon
DY AS _BYTE 'player location in dungeon
Level AS _BYTE
Direction AS _BYTE
Action AS _BYTE
END TYPE
TYPE Passage_Data
Level AS _BYTE
P AS Corddata
M AS Corddata
Scrolling AS _BYTE 'horizontal,vertical, locked
END TYPE
TYPE Item_Data
Name AS STRING * 14
x AS INTEGER
y AS INTEGER
power AS _BYTE
defen AS _BYTE
Heal AS _UNSIGNED _BYTE
effct AS _BYTE
END TYPE
TYPE Dungeon_Data
N AS _BYTE
E AS _BYTE
W AS _BYTE
S AS _BYTE
Doorways AS _BYTE
Layout AS _UNSIGNED INTEGER '4bit wall\door color, 3 bit floor color, 1 bit windows, 1 bit columns,3bit floor mural ,4bit is exit or shop,
Torch AS _BYTE
Monster_Group AS _BYTE
END TYPE
TYPE Dungeon_Extra
StartRoom AS _BYTE 'which room does player start in.
ExitRoom AS _BYTE 'Which room is exit.
Shop_Count AS _BYTE 'number of shops in dungeon
END TYPE
CONST TRUE = -1, FALSE = NOT TRUE, LOCKED = TRUE, Horizontal = 0, Vertical = 1
CONST UP = 0, DOWN = 4, LEFT = 6, RIGHT = 2
CONST UP_LEFT = 7, UP_RIGHT = 1, DOWN_LEFT = 5, DOWN_RIGHT = 3
CONST Moving = 1, Standing = 0, Climbing = 2
'map bounds collision and door way collision
CONST Collide_White = _RGB32(255), Collide_Blue = _RGB32(0, 0, 255)
SCREEN _NEWIMAGE(640, 480, 32): RANDOMIZE 79819.18: t! = TIMER: 'CLS
DIM SHARED Layer(16) AS LONG, Control AS Control_Keys
DIM SHARED P AS PlayerData, Pack(9) AS _BYTE, Map(33) AS MapData, G AS Gamedata
DIM SHARED D(84) AS Passage_Data, I(64) AS Item_Data
DIM SHARED Dungeon(10, 15, 15) AS Dungeon_Data, DE(10) AS Dungeon_Extra
Layer(0) = _DISPLAY
Layer(1) = _COPYIMAGE(_DISPLAY)
Layer(2) = _COPYIMAGE(_DISPLAY) 'collision mask layer
Layer(3) = _NEWIMAGE(8192, 7680, 32) 'dungeon map layer
Layer(4) = _NEWIMAGE(8192, 7680, 32) 'dungeon map mask layer
'Layer(13) = _LOADIMAGE("StatScreen.bmp", 32)
'Layer(14) = _LOADIMAGE("CastleMapsMask.bmp", 32)
'Layer(15) = _LOADIMAGE("Myer_Sheet_2.bmp", 32)
'Layer(16) = _LOADIMAGE("CastleMaps.bmp", 32)
MFI_Loader "DeadlyTowers_06252023.MFI"
_CLEARCOLOR _RGB32(64, 128, 128), Layer(15)
_CLEARCOLOR _RGB32(146, 144, 255), Layer(13)
_CLEARCOLOR _RGB32(255, 128, 255), Layer(16)
_CLEARCOLOR _RGB32(255, 128, 255), Layer(14)
_SOURCE Layer(2) 'Main collision detection layer
_PRINTSTRING (800, 100), "Dungeon 1", Layer(16)
'OPEN "DT_Data_V1_0.dat" FOR BINARY AS #1
'GET #1, , Map()
'GET #1, , D()
'GET #1, , I()
'GET #1, , Dungeon()
'GET #1, , DE()
'CLOSE
Control.Up_Key = 18432
Control.Down_Key = 20480
Control.Left_Key = 19200
Control.Right_Key = 19712
Control.Select_Button = 32 ' space
Control.Start_Button = 13 'enter
Control.A_Button = 97 ' a
Control.B_Button = 115 ' s
'player start status
P.Health = 100
P.MaxHealth = 100
P.Ludder = 50
P.Direction = DOWN
P.Helm = 0
P.Shield = 0
P.Armor = 0
P.Sword = 1
P.Enhance = 0
P.Glove = 0
P.Boots = 0
FOR i%% = 0 TO 8
Pack(i%%) = INT(RND * 54) + 1
NEXT i%%
'EnterDungeon 1
'CLS
'_PUTIMAGE , Layer(4), Layer(0), (1536, 0)-STEP(2047, 1939) '(8192, 7680)
'PRINT _BIN$(Dungeon(P.Level, P.DX, P.DY).Layout)
'_PRINTSTRING (160, 0), "Timer Seed" + STR$(t!), Layer(0)
'END
Passage 0 'start game here
DO
KB~%% = Controls
IF _READBIT(KB~%%, 0) THEN P.Action = Moving: P.Direction = UP 'player pressed up arrow
IF _READBIT(KB~%%, 1) THEN P.Action = Moving: P.Direction = DOWN 'player pressed down arrow
IF _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = LEFT 'player pressed left arrow
IF _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = RIGHT 'player pressed right arrow
IF _READBIT(KB~%%, 0) AND _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = UP_LEFT 'player pressed up arrow
IF _READBIT(KB~%%, 0) AND _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = UP_RIGHT 'player pressed down arrow
IF _READBIT(KB~%%, 1) AND _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = DOWN_LEFT 'player pressed left arrow
IF _READBIT(KB~%%, 1) AND _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = DOWN_RIGHT 'player pressed right arrow
IF _READBIT(KB~%%, 4) THEN Status_screen
IF _READBIT(KB~%%, 5) THEN Pause_Game
IF _READBIT(KB~%%, 7) THEN ExitFlag%% = -1
IF _SHL(KB~%%, 4) = FALSE THEN P.Action = Standing 'if no direction key press then stop moving
IF P.Action <> Standing THEN Move_Player
IF G.Passage THEN Passage G.Where
IF G.FallDeath THEN Fall_Death
IF G.Dungeon THEN EnterDungeon G.Dungeon 'big deal code wise! whole seperate main loop
Draw_Map
Draw_Player
'--------------------debug data--------------------------
_PRINTSTRING (0, 0), STR$(P.X), Layer(1)
_PRINTSTRING (0, 16), STR$(P.Y), Layer(1)
_PRINTSTRING (0, 32), " ", Layer(1)
_PRINTSTRING (0, 32), STR$(G.Map.X), Layer(1)
_PRINTSTRING (0, 48), STR$(P.Level), Layer(1)
_PRINTSTRING (0, 64), " ", Layer(1)
_PRINTSTRING (0, 64), STR$(G.Map.Y), Layer(1)
' _PRINTSTRING (0, 80), STR$(P.X + 2 + 64), Layer(1)
' _PRINTSTRING (0, 96), STR$(P.Y + 62 + 16), Layer(1)
'--------------------------------------------------------
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
LOOP UNTIL ExitFlag%% = -1
_PUTIMAGE , Layer(2), Layer(1)
Draw_Player
_PUTIMAGE , Layer(1), Layer(0)
LINE (P.X + 2 + 64, P.Y + 62 + 16)-STEP(1, 1), _RGB32(255, 0, 0), BF
LINE (P.X + 30 + 64, P.Y + 62 + 16)-STEP(1, 1), _RGB32(255, 0, 0), BF
SUB EnterDungeon (ID%%)
OPEN "debug.txt" FOR OUTPUT AS #1 'save dungeon room layouts incase of issue
Fade_Out Layer(0)
P.X = 242
P.Y = 288
P.Level = ID%% 'level = the dungeon player is in
P.DX = VAL("&H" + LEFT$(HEX$(DE(P.Level).StartRoom), 1)) 'High 4 bits room X loc
P.DY = DE(ID%%).StartRoom AND 15 'Low 4 bits room Y loc
IF G.Dungeon <> G.Last_Dungeon THEN 'don't recreate dungeon if player just left it(save 3.5s)
ClearLayer Layer(3)
ClearLayer Layer(4)
COLOR _RGB32(64)
FOR y%% = 0 TO 15
FOR x%% = 0 TO 15
ClearLayer Layer(1)
Draw_Dungeon x%%, y%%
percent%% = INT(count% / 256 * 100)
_PRINTSTRING (212, 232), "Loading Dungeon..." + LTRIM$(STR$(percent%%)) + "%", Layer(0)
count% = count% + 1
NEXT x%%, y%%
G.Last_Dungeon = G.Dungeon
END IF
Draw_Dungeon P.DX, P.DY
Draw_Player
Fade_In Layer(1)
G.Passage = FALSE
G.Scroll_Lock = TRUE
G.Dungeon = FALSE
Dungeon_Main_Routine 'normal routine incompatable with dungeon mechanics so switch over
CLOSE #1
END SUB
SUB Dungeon_Main_Routine
'first collision mask
_PUTIMAGE (64, 16)-STEP(511, 447), Layer(4), Layer(2), (512 * P.DX, 448 * P.DY)-STEP(511, 447)
DO
KB~%% = Controls
IF _READBIT(KB~%%, 0) THEN P.Action = Moving: P.Direction = UP 'player pressed up arrow
IF _READBIT(KB~%%, 1) THEN P.Action = Moving: P.Direction = DOWN 'player pressed down arrow
IF _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = LEFT 'player pressed left arrow
IF _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = RIGHT 'player pressed right arrow
IF _READBIT(KB~%%, 0) AND _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = UP_LEFT 'player pressed up arrow
IF _READBIT(KB~%%, 0) AND _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = UP_RIGHT 'player pressed down arrow
IF _READBIT(KB~%%, 1) AND _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = DOWN_LEFT 'player pressed left arrow
IF _READBIT(KB~%%, 1) AND _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = DOWN_RIGHT 'player pressed right arrow
IF _READBIT(KB~%%, 4) THEN Status_screen
IF _READBIT(KB~%%, 5) THEN Pause_Game
IF _READBIT(KB~%%, 7) THEN ExitFlag%% = -1
IF _SHL(KB~%%, 4) = FALSE THEN P.Action = Standing 'if no direction key press then stop moving
IF P.Action <> Standing THEN Move_Player
IF G.Passage THEN Dungeon_Passage G.Where
' IF G.Dungeon THEN Passage G.Dungeon 'exit back to overworld
IF G.Exit_Dungeon THEN Passage G.Exit_Dungeon: ExitFlag%% = TRUE: G.Exit_Dungeon = FALSE
' IF G.Shop THEN Run_Shop G.Shop
_PUTIMAGE (64, 16)-STEP(511, 447), Layer(3), Layer(1), (512 * P.DX, 448 * P.DY)-STEP(511, 447)
Draw_Player
'--------------------debug data--------------------------
_PRINTSTRING (0, 0), STR$(P.X), Layer(1)
_PRINTSTRING (0, 16), STR$(P.Y), Layer(1)
_PRINTSTRING (0, 32), " ", Layer(1)
_PRINTSTRING (0, 32), STR$(P.DX), Layer(1)
_PRINTSTRING (0, 48), " ", Layer(1)
_PRINTSTRING (0, 48), STR$(P.DY), Layer(1)
_PRINTSTRING (0, 64), STR$(P.Level), Layer(1)
_PRINTSTRING (0, 80), STR$(Layer(4)) + " " + STR$(_SOURCE), Layer(1)
_PRINTSTRING (96, 0), SPACE$(24), Layer(1)
_PRINTSTRING (96, 0), HEX$(Dungeon(P.Level, P.DX, P.DY).N) + " " + HEX$(Dungeon(P.Level, P.DX, P.DY).E) + " " + HEX$(Dungeon(P.Level, P.DX, P.DY).W) + " " + HEX$(Dungeon(P.Level, P.DX, P.DY).S), Layer(1)
'--------------------------------------------------------
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
LOOP UNTIL ExitFlag%% = TRUE
ExitFlag%% = FALSE
END SUB
SUB Draw_Dungeon (X%%, Y%%)
IF Dungeon(P.Level, X%%, Y%%).Layout = 0 THEN Create_Dungeon_Layout X%%, Y%%
Tmp& = _COPYIMAGE(Layer(0)) 'create a temp creation layer for the mask screen
temp$ = HEX$(Dungeon(P.Level, X%%, Y%%).Layout)
binn$ = _BIN$(Dungeon(P.Level, X%%, Y%%).Layout)
B$ = LEFT$("0000000000000000", 16 - LEN(binn$)) + binn$
W%% = VAL("&H" + LEFT$(temp$, 1)) 'wall color
S%% = VAL("&H" + RIGHT$(temp$, 1)) 'shop or exit
F%% = VAL("&B" + MID$(B$, 5, 3))
' PRINT _BIN$(F%%), B$
' IF F%% = 0 OR F%% > 6 THEN BEEP: END
_PUTIMAGE (192, 16)-STEP(255, 255), Layer(16), Layer(1), (3335, 1 + 129 * (W%% - 1))-STEP(127, 127)
_PUTIMAGE (64, 16)-STEP(127, 383), Layer(16), Layer(1), (3464, 1 + 193 * ((W%% - 1) MOD 5))-STEP(63, 191)
_PUTIMAGE (64 + 256 + 128, 16)-STEP(127, 383), Layer(16), Layer(1), (3528, 1 + 193 * ((W%% - 1) MOD 5))-STEP(63, 191)
'---------------------------mask---------------------------------
_PUTIMAGE (192, 16)-STEP(255, 255), Layer(14), Tmp&, (3334, 1 + 129 * (W%% - 1))-STEP(127, 127)
_PUTIMAGE (64, 16)-STEP(127, 383), Layer(14), Tmp&, (3464, 1 + 193 * ((W%% - 1) MOD 5))-STEP(63, 191)
_PUTIMAGE (64 + 256 + 128, 16)-STEP(127, 383), Layer(14), Tmp&, (3528, 1 + 193 * ((W%% - 1) MOD 5))-STEP(63, 191)
SELECT CASE (W%% - 1) MOD 5 'bottom wall
CASE 0
_PUTIMAGE (64, 400)-STEP(511, 63), Layer(16), Layer(1), (1277, 1912)-STEP(255, 31)
_PUTIMAGE (64, 400)-STEP(511, 79), Layer(14), Tmp&, (1277, 1912)-STEP(255, 39) 'mask
CASE 1
_PUTIMAGE (64, 400)-STEP(511, 63), Layer(16), Layer(1), (1020, 1912)-STEP(255, 31)
_PUTIMAGE (64, 400)-STEP(511, 79), Layer(14), Tmp&, (1020, 1912)-STEP(255, 39) 'mask
CASE 2
_PUTIMAGE (64, 400)-STEP(511, 63), Layer(16), Layer(1), (1020, 1912)-STEP(255, 31)
_PUTIMAGE (64, 400)-STEP(511, 79), Layer(14), Tmp&, (1020, 1912)-STEP(255, 39) 'mask
CASE 3
_PUTIMAGE (64, 400)-STEP(511, 63), Layer(16), Layer(1), (1020, 1912)-STEP(255, 31)
_PUTIMAGE (64, 400)-STEP(511, 79), Layer(14), Tmp&, (1020, 1912)-STEP(255, 39) 'mask
CASE 4
_PUTIMAGE (64, 400)-STEP(511, 63), Layer(16), Layer(1), (1020, 1912)-STEP(255, 31)
_PUTIMAGE (64, 400)-STEP(511, 79), Layer(14), Tmp&, (1020, 1912)-STEP(255, 39) 'mask
END SELECT
SELECT CASE F%% 'floor
CASE 1
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(16), Layer(1), (1535, 1911)-STEP(255, 63)
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(14), Tmp&, (1535, 1911)-STEP(255, 63) 'mask
CASE 2
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(16), Layer(1), (1535, 1976)-STEP(255, 63)
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(14), Tmp&, (1535, 1976)-STEP(255, 63) 'mask
CASE 3
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(16), Layer(1), (1792, 1911)-STEP(255, 63)
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(14), Tmp&, (1792, 1911)-STEP(255, 63) 'mask
CASE 4
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(16), Layer(1), (1792, 1976)-STEP(255, 63)
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(14), Tmp&, (1792, 1976)-STEP(255, 63) 'mask
CASE 5
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(16), Layer(1), (2049, 1911)-STEP(255, 63)
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(14), Tmp&, (2049, 1911)-STEP(255, 63) 'mask
CASE 6
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(16), Layer(1), (2049, 1976)-STEP(255, 63)
_PUTIMAGE (64, 272)-STEP(511, 127), Layer(14), Tmp&, (2049, 1976)-STEP(255, 63) 'mask
END SELECT
SELECT CASE (W%% - 1) MOD 5 'door
CASE 0
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 0) THEN
_PUTIMAGE (288, 176)-STEP(63, 95), Layer(16), Layer(1), (2508 + 34, 1911)-STEP(31, 47)
_PUTIMAGE (288, 176)-STEP(63, 97), Layer(14), Tmp&, (2508 + 34, 1911)-STEP(31, 48) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 1) THEN
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(16), Layer(1), (2508 + 67, 1911)-STEP(31, 71)
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(14), Tmp&, (2508 + 67, 1911)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 2) THEN
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(16), Layer(1), (2508 + 0, 1911)-STEP(31, 71)
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(14), Tmp&, (2508 + 0, 1911)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 3) THEN
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(16), Layer(1), (2609, 2048)-STEP(48, 8)
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(14), Tmp&, (2609, 2048)-STEP(48, 8) 'mask
END IF
CASE 1
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 0) THEN
_PUTIMAGE (288, 176)-STEP(63, 95), Layer(16), Layer(1), (2407 + 34, 1984)-STEP(31, 47)
_PUTIMAGE (288, 176)-STEP(63, 97), Layer(14), Tmp&, (2407 + 34, 1984)-STEP(31, 48) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 1) THEN
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(16), Layer(1), (2407 + 67, 1984)-STEP(31, 71)
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(14), Tmp&, (2407 + 67, 1984)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 2) THEN
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(16), Layer(1), (2407 + 0, 1984)-STEP(31, 71)
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(14), Tmp&, (2407 + 0, 1984)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 3) THEN
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(16), Layer(1), (2609, 2048)-STEP(48, 8)
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(14), Tmp&, (2609, 2048)-STEP(48, 8) 'mask
END IF
CASE 2
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 0) THEN
_PUTIMAGE (288, 176)-STEP(63, 95), Layer(16), Layer(1), (2306 + 34, 1984)-STEP(31, 47)
_PUTIMAGE (288, 176)-STEP(63, 97), Layer(14), Tmp&, (2306 + 34, 1984)-STEP(31, 48) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 1) THEN
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(16), Layer(1), (2306 + 67, 1984)-STEP(31, 71)
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(14), Tmp&, (2306 + 67, 1984)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 2) THEN
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(16), Layer(1), (2306 + 0, 1984)-STEP(31, 71)
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(14), Tmp&, (2306 + 0, 1984)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 3) THEN
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(16), Layer(1), (2609, 2048)-STEP(40, 8)
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(14), Tmp&, (2609, 2048)-STEP(40, 8) 'mask
END IF
CASE 3
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 0) THEN
_PUTIMAGE (288, 176)-STEP(63, 95), Layer(16), Layer(1), (2407 + 34, 1911)-STEP(31, 47)
_PUTIMAGE (288, 176)-STEP(63, 97), Layer(14), Tmp&, (2407 + 34, 1911)-STEP(31, 48) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 1) THEN
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(16), Layer(1), (2407 + 67, 1911)-STEP(31, 71)
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(14), Tmp&, (2407 + 67, 1911)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 2) THEN
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(16), Layer(1), (2407 + 0, 1911)-STEP(31, 71)
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(14), Tmp&, (2407 + 0, 1911)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 3) THEN
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(16), Layer(1), (2609, 2048)-STEP(48, 8)
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(14), Tmp&, (2609, 2048)-STEP(48, 8) 'mask
END IF
CASE 4
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 0) THEN
_PUTIMAGE (288, 176)-STEP(63, 95), Layer(16), Layer(1), (2306 + 34, 1911)-STEP(31, 47)
_PUTIMAGE (288, 176)-STEP(63, 97), Layer(14), Tmp&, (2306 + 34, 1911)-STEP(31, 48) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 1) THEN
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(16), Layer(1), (2306 + 67, 1911)-STEP(31, 71)
_PUTIMAGE (480, 224)-STEP(63, 143), Layer(14), Tmp&, (2306 + 67, 1911)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 2) THEN
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(16), Layer(1), (2306 + 0, 1911)-STEP(31, 71)
_PUTIMAGE (94, 224)-STEP(63, 143), Layer(14), Tmp&, (2306 + 0, 1911)-STEP(31, 71) 'mask
END IF
IF _READBIT(Dungeon(P.Level, X%%, Y%%).Doorways, 3) THEN
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(16), Layer(1), (2609, 2048)-STEP(48, 8)
_PUTIMAGE (272, 400)-STEP(95, 15), Layer(14), Tmp&, (2609, 2048)-STEP(48, 8) 'mask
END IF
END SELECT
'murals
M%% = VAL("&B" + MID$(B$, 10, 3))
IF M%% THEN _PUTIMAGE (272, 304)-STEP(99, 35), Layer(16), Layer(1), (2563, 2057 + 19 * (M%% - 1))-STEP(49, 17)
'exit and shop
IF VAL("&B" + MID$(B$, 13, 4)) = 15 THEN 'exit
_DEST Tmp&
LINE (306, 310)-STEP(27, 15), _RGB32(255, 1, 74 + P.Level), BF
_DEST Layer(0)
ELSEIF VAL("&B" + MID$(B$, 13, 4)) > 0 THEN 'shop
_DEST Tmp&
LINE (306, 310)-STEP(27, 15), _RGB32(255, 0, VAL("&B" + MID$(_BIN$(Dungeon(P.Level, X%%, Y%%).Layout), 13, 4))), BF
_DEST Layer(0)
END IF
_PUTIMAGE (X%% * 512, Y%% * 448)-STEP(511, 447), Layer(1), Layer(3), (64, 16)-STEP(511, 447)
_PUTIMAGE (X%% * 512, Y%% * 448)-STEP(511, 447), Tmp&, Layer(4), (64, 16)-STEP(511, 447)
END SUB
SUB Create_Dungeon_Layout (X%%, Y%%)
'setup a layout for this room if not set
colors%% = INT(RND * 15) + 1 'wall and door colors
floor%% = INT(RND * 6) + 1 'floor color
windows%% = INT(RND * 1) 'window flag
columns%% = INT(RND * 1) 'column flag
IF INT(RND * 255) > 245 THEN Murals%% = INT(RND * 5) + 1 'is there a mural?
IF G.Shop_Count < DE(P.Level).Shop_Count THEN 'if more shops available and not the exit room
IF X%% <> VAL("&H" + LEFT$(HEX$(DE(P.Level).ExitRoom), 1)) AND Y%% <> DE(P.Level).ExitRoom AND 15 THEN
'IF INT(RND * 255) > 230 THEN shops%% = INT(RND * 8) + 1
'Murals%% = INT(RND * 5) + 1 'shops auto get a mural
END IF
END IF
temp%% = VAL("&H" + HEX$(X%%) + HEX$(Y%%))
IF temp%% = DE(P.Level).ExitRoom THEN
FlagForExit%% = TRUE
Murals%% = INT(RND * 5) + 1 'exits auto get a mural
END IF
A$ = LEFT$("0000", 4 - LEN(_BIN$(colors%% AND 15))) + _BIN$(colors%% AND 15) + LEFT$("000", 3 - LEN(_BIN$(floor%% AND 7))) + _BIN$(floor%% AND 7)
IF windows%% THEN 'windows and columns are mutually exclusive, windows take precidence.
A$ = A$ + "10"
ELSEIF columns%% THEN
A$ = A$ + "01"
ELSE
A$ = A$ + "00"
END IF
A$ = A$ + LEFT$("000", 3 - LEN(_BIN$(Murals%% AND 7))) + _BIN$(Murals%% AND 7)
IF FlagForExit%% THEN A$ = A$ + "1111" ELSE A$ = A$ + LEFT$("0000", 4 - LEN(_BIN$(shops%% AND 15))) + _BIN$(shops%% AND 15): FlagForExit%% = FALSE
PRINT #1, HEX$(X%%) + HEX$(Y%%) + "-" + A$ + "||" + STR$(DE(P.Level).ExitRoom)
' PRINT "&B" + A$
' PRINT VAL("&B" + A$)
Dungeon(P.Level, X%%, Y%%).Layout = VAL("&B" + A$)
' PRINT Dungeon(P.Level, X%%, Y%%).Layout
END SUB
SUB Draw_Health
END SUB
SUB Draw_Map
'screen map
_PUTIMAGE (64, 16)-STEP(511, 447), Layer(16), Layer(1), (Map(P.Level).x + G.Map.X, Map(P.Level).y + G.Map.Y)-STEP(255, 223)
'collision mask
_PUTIMAGE (64, 16)-STEP(511, 447), Layer(14), Layer(2), (Map(P.Level).x + G.Map.X, Map(P.Level).y + G.Map.Y)-STEP(255, 223)
END SUB
SUB Draw_Player
STATIC Frame%%, Count%%
IF P.Action = Standing THEN
ELSE 'if player is not standing then animate
Count%% = Count%% + 1
IF Count%% = 8 THEN Frame%% = NOT Frame%%: Count%% = 0
END IF
IF P.Action = Climbing THEN
_PUTIMAGE (64 + P.X, 16 + P.Y)-STEP(31, 63), Layer(15), Layer(1), (3 + (19 * ABS(Frame%%)), 37)-STEP(15, 31)
ELSEIF G.On_Ladder THEN 'player is not climbing then use main sprite array
IF P.Direction = UP OR P.Direction = DOWN THEN 'us climbing pose for up or down
_PUTIMAGE (64 + P.X, 16 + P.Y)-STEP(31, 63), Layer(15), Layer(1), (3 + (19 * ABS(Frame%%)), 37)-STEP(15, 31)
ELSE
_PUTIMAGE (64 + P.X, 16 + P.Y)-STEP(31, 63), Layer(15), Layer(1), (3 + (38 * P.Direction) + (19 * ABS(Frame%%)), 4)-STEP(15, 31)
END IF
ELSE
_PUTIMAGE (64 + P.X, 16 + P.Y)-STEP(31, 63), Layer(15), Layer(1), (3 + (38 * P.Direction) + (19 * ABS(Frame%%)), 4)-STEP(15, 31)
END IF
END SUB
SUB Fall_Death
'player fell off of ledge
P.Health = 0
DO
frame%% = frame%% + 1
IF frame%% = 1 THEN
P.Direction = P.Direction + 1
IF P.Direction = 8 THEN P.Direction = 0
P.Y = P.Y + 2
IF P.Y >= 484 THEN ExitFlag%% = TRUE
frame%% = 0
END IF
Draw_Map
Draw_Player
_PUTIMAGE , Layer(1), Layer(0)
ClearLayer Layer(1)
_LIMIT 60
LOOP UNTIL ExitFlag%%
Passage 0
G.FallDeath = FALSE
END SUB
SUB Move_Player
SELECT CASE P.Direction
CASE UP
P.Y = P.Y - 2 'movement
'Basic Wall collision
'check collision based on center point of player sprite, if true move P.Y back
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y + 2
CASE DOWN
P.Y = P.Y + 2 'movement
'Basic Wall collision
'check collision based on center point of player sprite, if true move P.Y back
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y - 2
'Item collision (only chest right now)
'Monster collision
CASE LEFT
P.X = P.X - 2 'movement
'Basic Wall collision
'check collision based on center point of player sprite, if true move P.Y back
IF Player_Collision(P.X, P.Y) THEN P.X = P.X + 2
CASE RIGHT
P.X = P.X + 2 'movement
'Basic Wall collision
'check collision based on center point of player sprite, if true move P.Y back
IF Player_Collision(P.X, P.Y) THEN P.X = P.X - 2
CASE UP_LEFT
'check each movement seperatly so player can 'slide' along walls
P.Y = P.Y - 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y + 2
P.X = P.X - 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.X = P.X + 2
CASE UP_RIGHT
'check each movement seperatly so player can 'slide' along walls
P.Y = P.Y - 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y + 2
P.X = P.X + 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.X = P.X - 2
CASE DOWN_LEFT
'check each movement seperatly so player can 'slide' along walls
P.Y = P.Y + 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y - 2
P.X = P.X - 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.X = P.X + 2
CASE DOWN_RIGHT
'check each movement seperatly so player can 'slide' along walls
P.Y = P.Y + 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y - 2
P.X = P.X + 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.X = P.X - 2
END SELECT
IF NOT G.Scroll_Lock THEN 'only run if scrolling allowed
'scroll map if player reaches X max
IF G.Scroll_Direction = Horizontal THEN 'only scroll this way if flagged to do so
IF P.X > 354 THEN P.X = 354: G.Map.X = G.Map.X + 1
IF G.Map.X > Map(P.Level).MaxScroll THEN G.Map.X = Map(P.Level).MaxScroll 'stop scroll at edge
END IF
'scroll map if player reaches X min
IF G.Scroll_Direction = Horizontal THEN 'only scroll this way if flagged to do so
IF P.X < 118 THEN P.X = 118: G.Map.X = G.Map.X - 1
IF G.Map.X = -1 THEN G.Map.X = 0 'stop scroll at edge
END IF
IF G.Scroll_Direction = Vertical THEN 'only scroll this way if flagged to do so
IF P.Y > 300 THEN P.Y = 300: G.Map.Y = G.Map.Y + 1
IF G.Map.Y > Map(P.Level).MaxScroll THEN G.Map.Y = Map(P.Level).MaxScroll 'stop scroll at edge
END IF
IF G.Scroll_Direction = Vertical THEN 'only scroll this way if flagged to do so
IF P.Y < 100 THEN P.Y = 100: G.Map.Y = G.Map.Y - 1
IF G.Map.Y = -1 THEN G.Map.Y = 0 'stop scroll at edge
END IF
END IF
IF P.Level = 10 THEN
IF G.Map.X = 0 THEN G.Map.X = 2046
IF G.Map.X = 2048 THEN G.Map.X = 2
END IF
END SUB
SUB Passage (ID%%)
IF ID%% = 73 AND P.Burned = 7 THEN
'only allow player to take this passage if all bells are burned
Fade_Out Layer(0)
P.X = D(ID%%).P.X
P.Y = D(ID%%).P.Y
P.Level = D(ID%%).Level
G.Map.X = D(ID%%).M.X
G.Map.Y = D(ID%%).M.Y
G.Scroll_Direction = Map(P.Level).Scroll
G.Passage = FALSE
G.Scroll_Lock = D(ID%%).Scrolling
_DELAY .15
Draw_Map
Draw_Player
Fade_In Layer(1)
ELSEIF ID%% <> 73 THEN
Fade_Out Layer(0)
P.X = D(ID%%).P.X
P.Y = D(ID%%).P.Y
P.Level = D(ID%%).Level
G.Map.X = D(ID%%).M.X
G.Map.Y = D(ID%%).M.Y
G.Scroll_Direction = Map(P.Level).Scroll
G.Passage = FALSE
G.Scroll_Lock = D(ID%%).Scrolling
_DELAY .15
Draw_Map
Draw_Player
Fade_In Layer(1)
END IF
END SUB
SUB Dungeon_Passage (ID%%)
Fade_Out Layer(0)
P.DX = VAL("&H" + LEFT$(HEX$(G.Where), 1))
P.DY = VAL("&H" + RIGHT$(HEX$(G.Where), 1))
SELECT CASE G.Door_Side
CASE 0 'up
P.Y = 316
CASE 1 'east
P.X = 70
CASE 2 'west
P.X = 408
CASE 3 'down
P.Y = 208
END SELECT
G.Passage = FALSE
G.Scroll_Lock = TRUE
'change collision mask
_PUTIMAGE (64, 16)-STEP(511, 447), Layer(4), Layer(2), (512 * P.DX, 448 * P.DY)-STEP(511, 447)
'new screen
_PUTIMAGE (64, 16)-STEP(511, 447), Layer(3), Layer(1), (512 * P.DX, 448 * P.DY)-STEP(511, 447)
Draw_Player
Fade_In Layer(1)
END SUB
SUB Pause_Game
Control_lock
Tmp& = _COPYIMAGE(Layer(0))
DO
KB~%% = Controls
_LIMIT 60
LOOP UNTIL _READBIT(KB~%%, 5)
_FREEIMAGE Tmp&
Control_lock
END SUB
SUB DT_Print (X%, Y%, Txt$)
L%% = LEN(Txt$)
FOR i%% = 1 TO L%%
C%% = ASC(MID$(Txt$, i%%, 1))
SELECT CASE C%%
CASE 65 TO 90 'A-Z
_PUTIMAGE (X% + 16 * i%%, Y%)-STEP(15, 15), Layer(13), Layer(1), (0 + 9 * (C%% - 65), 269)-STEP(7, 7)
CASE 48 TO 57 '0-9
_PUTIMAGE (X% + 16 * i%%, Y%)-STEP(15, 15), Layer(13), Layer(1), (0 + 9 * (C%% - 48), 278)-STEP(7, 7)
CASE 46 '.
_PUTIMAGE (X% + 16 * i%%, Y%)-STEP(15, 15), Layer(13), Layer(1), (0 + 9 * 13, 278)-STEP(7, 7)
END SELECT
NEXT i%%
END SUB
SUB Status_screen
Control_lock
DO
KB~%% = Controls
Control_lock
IF _READBIT(KB~%%, 2) THEN selection%% = selection%% - 1 'player pressed left arrow
IF _READBIT(KB~%%, 3) THEN selection%% = selection%% + 1 'player pressed right arrow
IF _READBIT(KB~%%, 6) THEN useitem%% = TRUE
IF _READBIT(KB~%%, 7) THEN dropitem%% = TRUE
IF selection%% = -1 THEN selection%% = 8
IF selection%% = 9 THEN selection%% = 0
'background
_PUTIMAGE (64, 16)-STEP(512, 447), Layer(13), Layer(1), (0, 0)-STEP(255, 223)
'status and items
DT_Print 240, 128, LEFT$("000", 3 - LEN(LTRIM$(STR$(P.Health)))) + LTRIM$(STR$(P.Health))
DT_Print 304, 128, LEFT$("000", 3 - LEN(LTRIM$(STR$(P.MaxHealth)))) + LTRIM$(STR$(P.MaxHealth))
DT_Print 256, 160, LEFT$("000", 3 - LEN(LTRIM$(STR$(P.Ludder)))) + LTRIM$(STR$(P.Ludder))
_PUTIMAGE (288, 288)-STEP(31, 31), Layer(13), Layer(1), (I(P.Sword).x, I(P.Sword).y)-STEP(15, 15) 'sword
_PUTIMAGE (336, 288)-STEP(31, 31), Layer(13), Layer(1), (I(P.Enhance).x, I(P.Enhance).y)-STEP(15, 15) 'enhancement
_PUTIMAGE (384, 288)-STEP(31, 31), Layer(13), Layer(1), (I(P.Glove).x, I(P.Glove).y)-STEP(15, 15) 'Cauntlets
_PUTIMAGE (384, 176)-STEP(31, 31), Layer(13), Layer(1), (I(P.Boots).x, I(P.Boots).y)-STEP(15, 15) 'hyperboots
_PUTIMAGE (112, 288)-STEP(31, 31), Layer(13), Layer(1), (I(P.Helm).x, I(P.Helm).y)-STEP(15, 15) 'helmet
_PUTIMAGE (160, 288)-STEP(31, 31), Layer(13), Layer(1), (I(P.Shield).x, I(P.Shield).y)-STEP(15, 15) 'shield
_PUTIMAGE (208, 288)-STEP(31, 31), Layer(13), Layer(1), (I(P.Armor).x, I(P.Armor).y)-STEP(15, 15) 'armor
FOR J%% = 1 TO P.Bells 'bells player has
_PUTIMAGE (480, 64 + 32 * J%%)-STEP(31, 31), Layer(13), Layer(1), (17 * 13, 303)-STEP(15, 15) 'bells
NEXT J%%
FOR J%% = 1 TO P.Burned 'bells player has bunred
_PUTIMAGE (480, 64 + 32 * J%%)-STEP(31, 31), Layer(13), Layer(1), (I(57).x, I(57).y)-STEP(15, 15) 'bells
NEXT J%%
FOR J%% = 0 TO 8 'items player has
_PUTIMAGE (112 + 48 * J%%, 400)-STEP(31, 31), Layer(13), Layer(1), (I(Pack(J%%)).x, I(Pack(J%%)).y)-STEP(15, 15)
NEXT J%%
DT_Print 96, 368, RTRIM$(I(Pack(selection%%)).Name)
_PUTIMAGE (120 + 48 * selection%%, 384)-STEP(15, 15), Layer(13), Layer(1), (0 + 9 * 15, 278)-STEP(7, 7) 'arrow
IF useitem%% THEN Item_Use selection%%: useitem%% = FALSE
IF dropitem%% THEN Item_Drop selection%%: dropitem%% = FALSE
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
LOOP UNTIL _READBIT(KB~%%, 4)
Control_lock
END SUB
SUB Item_Use (ID%%)
'-----------equip-ables---------
SELECT CASE Pack(ID%%)
CASE 1 TO 4 'swords
P.Sword = Pack(ID%%)
CASE 5 TO 7 'helms
P.Helm = Pack(ID%%)
CASE 8 TO 10 'shields
P.Shield = Pack(ID%%)
CASE 11 TO 13 'armor
P.Armor = Pack(ID%%)
CASE 14, 15 'boots
P.Boots = Pack(ID%%)
CASE 16, 17 'enhancements
P.Enhance = Pack(ID%%)
CASE 18 TO 20 'gloves
P.Glove = Pack(ID%%)
CASE 36 'agate (orange) necklace
P.O_Necklace = TRUE 'adds a negligable amount of defence perminatly
END SELECT
'----------consume-ables----------
SELECT CASE Pack(ID%%)
CASE 25 'key
CASE 26 'torch
CASE 27 ' grail
P.Ludder = 255 'player gets full cash +5!(for that special item!)
CASE 28 'figure
G.Duration = 96
G.PauseEnemies = TRUE
CASE 31 TO 34 'potions
IF P.Health + I(Pack(ID%%)).Heal > P.MaxHealth THEN P.Health = P.MaxHealth ELSE P.Health = P.Health + I(Pack(ID%%)).Heal
CASE 35, 37, 38 'necklaces(minus agate(orange))
IF Pack(ID%%) = 35 THEN a = FALSE 'do something unknown
IF Pack(ID%%) = 37 THEN P.DefBonus = 8: G.Duration = 96
IF Pack(ID%%) = 38 THEN P.DefBonus = 127: G.Duration = 32 'invincable!
CASE 39 TO 42 'crystals
CASE 46 TO 49 'scrolls
IF Pack(ID%%) = 47 THEN Passage 29 'return to holy flame
IF Pack(ID%%) = 48 THEN Passage 0 'return to start point
CASE 59 'cursed shield
P.Shield = FALSE ' player looses shield!
P.Armor = FALSE 'player looses armor TOO!
CASE 60 'False grail
P.Ludder = 0 'player looses all cash
END SELECT
Pack(ID%%) = 0
Reduce_Pack ID%% 'remove empty item
END SUB
SUB Item_Drop (ID%%)
tmp& = _COPYIMAGE(Layer(1))
DO
_PUTIMAGE , tmp&, Layer(1)
KB~%% = Controls
Control_lock
FOR i%% = 0 TO 6 'anykey but 'b' exits routine
IF _READBIT(KB~%%, i%%) THEN ExitFlag%% = TRUE
NEXT i%%
IF _READBIT(KB~%%, 7) THEN 'press 'B' again to confirm
DT_Print 96, 368, RTRIM$(I(Pack(ID%%)).Name) + " DROPPED ! "
Pack(ID%%) = 0
ExitFlag%% = TRUE
Reduce_Pack ID%%
_PUTIMAGE , Layer(1), Layer(0)
_DELAY .75
END IF
IF NOT ExitFlag%% THEN DT_Print 96, 368, RTRIM$(I(Pack(ID%%)).Name) + " THROW AWAY?"
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
LOOP UNTIL ExitFlag%%
Layer(1) = _COPYIMAGE(tmp&)
_FREEIMAGE tmp&
END SUB
SUB Reduce_Pack (Start%%)
FOR i%% = Start%% TO 8
SWAP Pack(i%%), Pack(i%% + 1) 'move current `0'ed item to end
NEXT i%%
END SUB
SUB Run_Shop (ID%%)
END SUB
FUNCTION Controls~%%
IF _KEYDOWN(Control.Up_Key) THEN Result~%% = _SETBIT(Result~%%, 0) '1
IF _KEYDOWN(Control.Down_Key) THEN Result~%% = _SETBIT(Result~%%, 1) '2
IF _KEYDOWN(Control.Left_Key) THEN Result~%% = _SETBIT(Result~%%, 2) '4
IF _KEYDOWN(Control.Right_Key) THEN Result~%% = _SETBIT(Result~%%, 3) '8
IF _KEYDOWN(Control.Select_Button) THEN Result~%% = _SETBIT(Result~%%, 4) '16
IF _KEYDOWN(Control.Start_Button) THEN Result~%% = _SETBIT(Result~%%, 5) '32
IF _KEYDOWN(Control.A_Button) THEN Result~%% = _SETBIT(Result~%%, 6) '64
IF _KEYDOWN(Control.B_Button) THEN Result~%% = _SETBIT(Result~%%, 7) '128
Controls = Result~%%
END FUNCTION
FUNCTION Player_Collision%% (Xpos%, Ypos%)
Result%% = FALSE 'start with no collision
Point1~& = POINT(Xpos% + 2 + 64, Ypos% + 62 + 16) 'bottom lt collision point
Point2~& = POINT(Xpos% + 30 + 64, Ypos% + 62 + 16) 'bottom rt collision point
Rp1~%% = _RED32(Point1~&)
Rp2~%% = _RED32(Point2~&)
Gp1~%% = _GREEN32(Point1~&)
Gp2~%% = _GREEN32(Point2~&)
Bp1~%% = _BLUE32(Point1~&)
Bp2~%% = _BLUE32(Point2~&)
'Point3~& = POINT(Xpos% + 16, Ypos% + 20) 'bottom
'Point4~& = POINT(Xpos% - 16, Ypos% + 20) 'bottom
'passages
IF Bp1~%% = 255 AND Rp1~%% < 75 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Where = Rp1~%% 'passage check
IF Bp2~%% = 255 AND Rp2~%% < 75 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Where = Rp2~%% 'passage check
'dungeon passages
IF Bp1~%% = 255 AND Rp1~%% = 90 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Door_Side = 0: G.Where = Dungeon(P.Level, P.DX, P.DY).N 'north door
IF Bp2~%% = 255 AND Rp2~%% = 90 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Door_Side = 0: G.Where = Dungeon(P.Level, P.DX, P.DY).N '
IF Bp1~%% = 255 AND Rp1~%% = 91 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Door_Side = 1: G.Where = Dungeon(P.Level, P.DX, P.DY).E 'east door
IF Bp2~%% = 255 AND Rp2~%% = 91 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Door_Side = 1: G.Where = Dungeon(P.Level, P.DX, P.DY).E '
IF Bp1~%% = 255 AND Rp1~%% = 92 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Door_Side = 2: G.Where = Dungeon(P.Level, P.DX, P.DY).W 'west door
IF Bp2~%% = 255 AND Rp2~%% = 92 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Door_Side = 2: G.Where = Dungeon(P.Level, P.DX, P.DY).W '
IF Bp1~%% = 255 AND Rp1~%% = 93 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Door_Side = 3: G.Where = Dungeon(P.Level, P.DX, P.DY).S 'south door
IF Bp2~%% = 255 AND Rp2~%% = 93 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Door_Side = 3: G.Where = Dungeon(P.Level, P.DX, P.DY).S '
'ladder
IF Bp1~%% = 255 AND Rp1~%% = 255 AND Gp1~%% = 0 THEN P.Action = Climbing: G.On_Ladder = TRUE ELSE G.On_Ladder = FALSE
IF Bp2~%% = 255 AND Rp2~%% = 255 AND Gp2~%% = 0 THEN P.Action = Climbing
'fall off edge
IF Gp1~%% = 255 AND Bp1~%% = 0 AND Rp1~%% = 0 THEN Point1~& = Collide_White: G.FallDeath = TRUE 'cliff edge check
IF Gp2~%% = 255 AND Bp2~%% = 0 AND Rp2~%% = 0 THEN Point2~& = Collide_White: G.FallDeath = TRUE 'cliff edge check
'dungeons
IF Gp1~%% = 255 AND Bp1~%% < 11 AND Rp1~%% = 255 THEN Point1~& = Collide_White: G.Dungeon = Bp1~%% 'dungeon check
IF Gp2~%% = 255 AND Bp2~%% < 11 AND Rp2~%% = 255 THEN Point2~& = Collide_White: G.Dungeon = Bp2~%% 'dungeon check
'Dungeon Exit
IF Rp1~%% = 255 AND Gp1~%% = 1 AND Bp1~%% >= 75 THEN Point1~& = Collide_White: G.Exit_Dungeon = Bp1~%% 'dungeon check
IF Rp2~%% = 255 AND Gp2~%% = 1 AND Bp2~%% >= 75 THEN Point2~& = Collide_White: G.Exit_Dungeon = Bp2~%% 'dungeon check
'dungeon shop
IF Rp1~%% = 255 AND Gp1~%% = 0 AND Bp1~%% < 10 THEN Point1~& = Collide_White: G.Shop = Bp1~%% 'dungeon check
IF Rp2~%% = 255 AND Gp2~%% = 0 AND Bp2~%% < 10 THEN Point2~& = Collide_White: G.Shop = Bp2~%% 'dungeon check
'chests
'IF Point1~& = _RGB32(255, 0, 0) THEN Game.Chest = TRUE
'IF Point2~& = _RGB32(255, 0, 0) THEN Game.Chest = TRUE
' IF Point3~& = _RGB32(255, 0, 0) THEN Game.Chest = TRUE
' IF Point4~& = _RGB32(255, 0, 0) THEN Game.Chest = TRUE
'normal
IF Point1~& = Collide_White THEN Point1~& = FALSE ELSE Point1~& = TRUE
IF Point2~& = Collide_White THEN Point2~& = FALSE ELSE Point2~& = TRUE
' IF Point3~& = _RGB32(255) THEN Point3~& = TRUE ELSE Point3~& = FALSE
' IF Point4~& = _RGB32(255) THEN Point4~& = TRUE ELSE Point4~& = FALSE
IF Point1~& = FALSE OR Point2~& = FALSE THEN Result%% = TRUE
Player_Collision = Result%%
END FUNCTION
SUB ClearLayer (L&)
Old& = _DEST: _DEST L&: CLS: _DEST Old&
END SUB
SUB Control_lock
DO
LOOP WHILE Controls
END SUB
SUB DarkenImage (Image AS LONG, Value_From_0_To_1 AS SINGLE)
IF Value_From_0_To_1 <= 0 OR Value_From_0_To_1 >= 1 OR _PIXELSIZE(Image) <> 4 THEN EXIT SUB
DIM Buffer AS _MEM: Buffer = _MEMIMAGE(Image) 'Get a memory reference to our image
DIM Frac_Value AS LONG: Frac_Value = Value_From_0_To_1 * 65536 'Used to avoid slow floating point calculations
DIM O AS _OFFSET, O_Last AS _OFFSET
O = Buffer.OFFSET 'We start at this offset
O_Last = Buffer.OFFSET + _WIDTH(Image) * _HEIGHT(Image) * 4 'We stop when we get to this offset
'use on error free code ONLY!
$CHECKING:OFF
DO
_MEMPUT Buffer, O, _MEMGET(Buffer, O, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
_MEMPUT Buffer, O + 1, _MEMGET(Buffer, O + 1, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
_MEMPUT Buffer, O + 2, _MEMGET(Buffer, O + 2, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
O = O + 4
LOOP UNTIL O = O_Last
'turn checking back on when done!
$CHECKING:ON
_MEMFREE Buffer
END SUB
SUB Fade_Out (L&)
FOR n! = 1 TO 0.00 STEP -0.05
i2& = _COPYIMAGE(L&)
DarkenImage i2&, n!
_PUTIMAGE (0, 0), i2&
_FREEIMAGE i2&
_DELAY .03
NEXT
END SUB
SUB Fade_In (L&)
FOR n! = 0.01 TO 1 STEP 0.05
i2& = _COPYIMAGE(L&)
DarkenImage i2&, n!
_PUTIMAGE (0, 0), i2&
_FREEIMAGE i2&
_DELAY .03
NEXT
END SUB
SUB MFI_Loader (FN$)
DIM Size(128) AS LONG, FOffset(128) AS LONG
OPEN FN$ FOR BINARY AS #1
GET #1, , c~%% 'retrieve number of files
FOR I~%% = 1 TO c~%%
GET #1, , FOffset(I~%%)
GET #1, , Size(I~%%)
FOffset&(I~%%) = FOffset&(I~%%) + 1
NEXT I~%%
_KEYCLEAR
Layer(13) = LoadGFX(FOffset(2), Size(2))
Layer(14) = LoadGFX(FOffset(4), Size(4))
Layer(15) = LoadGFX(FOffset(1), Size(1))
Layer(16) = LoadGFX(FOffset(3), Size(3))
LoadData FOffset(5), Size(5)
CLOSE #1
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB
SUB LoadData (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
F1 = FREEFILE
OPEN "temp.dat" FOR BINARY AS #F1
GET #F1, , Map()
GET #F1, , D()
GET #F1, , I()
GET #F1, , Dungeon()
GET #F1, , DE()
CLOSE #F1
END SUB
FUNCTION LoadGFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadGFX& = _LOADIMAGE("temp.dat", 32)
END FUNCTION
FUNCTION LoadFFX& (Foff&, Size&, Fize%%)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadFFX& = _LOADFONT("temp.dat", Fize%%, "monospace")
END FUNCTION
FUNCTION LoadSFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadSFX& = _SNDOPEN("temp.dat")
END FUNCTION
SUB maptest
FOR y%% = 0 TO 15
FOR x%% = 0 TO 15
IF Dungeon(1, x%%, y%%).Doorways > 0 THEN LINE (x%% * 7, y%% * 7)-STEP(4, 4), _RGB32(255, 255, 0), BF
IF _READBIT(Dungeon(1, x%%, y%%).Doorways, 0) THEN PSET (x%% * 7 + 2, y%% * 7), _RGB32(255, 0, 0)
IF _READBIT(Dungeon(1, x%%, y%%).Doorways, 1) THEN PSET (x%% * 7 + 4, y%% * 7 + 2), _RGB32(255, 0, 0)
IF _READBIT(Dungeon(1, x%%, y%%).Doorways, 2) THEN PSET (x%% * 7, y%% * 7 + 2), _RGB32(255, 0, 0)
IF _READBIT(Dungeon(1, x%%, y%%).Doorways, 3) THEN PSET (x%% * 7 + 2, y%% * 7 + 4), _RGB32(255, 0, 0)
NEXT x%%
NEXT y%%
_PUTIMAGE (0, 0)-STEP(299, 299), Layer(0), Layer(1), (0, 0)-STEP(149, 149)
CLS
_PUTIMAGE , Layer(1), Layer(0)
END
END SUBRE: Deadly Towers 64 (beta for testing) - bplus - 06-25-2023
Wow Cobalt! long time, you came to see b+ Summer Banner didn't you? ;-))
OK tried the game and get's around fine! by me. You make it hard to walk off a ledge, but you do give a clue which ledges are dangerous.
RE: Deadly Towers 64 (beta for testing) - Cobalt - 06-26-2023
(06-25-2023, 10:44 PM)bplus Wrote: Wow Cobalt! long time, you came to see b+ Summer Banner didn't you? ;-))The banner is pretty cool, just lacking the Bikini clad hotties!
OK tried the game and get's around fine! by me. You make it hard to walk off a ledge, but you do give a clue which ledges are dangerous.
opps, yeah I did not think to mention that there are crumbled edges that you can fall from.
Thank you for the feed back!
RE: Deadly Towers 64 (beta for testing) - bplus - 06-26-2023
Oh man you have been looking at stone towers too long ;-))
RE: Deadly Towers 64 (beta for testing) - a740g - 06-26-2023
@Cobalt Whoa dude! This is so cool.
That .MFI file... seems to be some kind resource data file like a doom .WAD file? Are you using any public tool to generate that or is it something custom that you made? Just curious.
I noticed that LoadGFX(), LoadFFX() and LoadSFX() are writing to temp files then _LOADIMAGE(), _LOADFONT() and _SNDOPEN() are used to load the resource. You can use the load-from-memory extensions of _LOADIMAGE(), _LOADFONT() and _SNDOPEN() to load the data directly from memory and avoid any file writes. That way your code can run in environments where there are no write-permissions.
RE: Deadly Towers 64 (beta for testing) - justsomeguy - 06-26-2023
Great work! I'm looking forward to playing more of it when you have it further along.
I'll be keeping an eye on this.