+- 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: A new and Exciting Demo! (/showthread.php?tid=3704)
A new and Exciting Demo! - Cobalt - 05-23-2025
Say Hello to....
Diaper Man!
Movement with the Arrow Keys
use the mouse to click the inventory icon (the top right of the screen)
the inventory screen is all mouse driven, its all click by click. there is no draging.(yet)
ESC to quit.
just walk over items to pick them up, note that you have only 2 hands so how many items do you think you can pick up without accessing the inventory screen to empty a hand. And your character is right handed so you can only take stuff from "his right" hand. and only make him hold in that hand too. though he is smart enough to put what he is carrying in his left hand to pick something new up.
it is possible to drop an item in a location that you can not reach so take care there but, with only 3 items in the game, right now, not a big deal.
Also there are a few places yet you can get stuck when going from one screen to another, so try to pass screens toward the middle of the passage. I fix them as I find them but, haven't found them all for sure.
there is no treasure to turn into currency yet.
Not a whole lot going on yet, just showing off the movement and inventory stuff.
do not forget to download the attachment too.
Code: (Select All)
'62002164'https://icon-library.com/icon/drop-icon-1.html.html>Drop Icon # 99689
'IDE layout 136x38
'Diaper Man: "The Soiled Adventure!"
'May 23 2025!
'Cobalt
' 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00: ' 1
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00: ' 2
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,13,15,15,15,15,10,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00: ' 3
DATA 00,00,00,00,00,00,00,00,00,00,13,15,15,12,00,13,15,15,12,00,00,00,00,00,00,13,15,15,15,10,00,00,00,00,00,00,00,00,00,00: ' 4
DATA 00,00,00,00,00,00,00,00,00,00,02,00,00,00,00,02,00,00,00,00,00,00,00,00,00,02,00,00,00,02,00,00,00,00,00,00,00,00,00,00: ' 5
DATA 00,00,00,00,00,00,00,00,00,00,02,13,15,15,15,05,00,00,00,00,00,00,00,00,00,03,15,10,00,02,00,00,00,00,00,00,00,00,00,00: ' 6
DATA 00,00,00,00,00,00,00,00,00,00,02,02,00,00,00,02,00,00,00,00,00,00,21,00,00,00,00,02,13,12,00,00,00,00,00,00,00,00,00,00: ' 7
DATA 00,00,00,00,00,00,00,00,00,00,02,02,00,13,10,02,00,13,15,10,13,10,26,15,15,10,00,02,02,00,16,10,00,00,00,00,00,00,00,00: ' 8
DATA 00,00,00,00,00,00,00,00,00,00,02,03,15,12,02,25,16,12,01,02,25,02,25,00,00,02,00,02,03,10,00,02,00,00,00,00,00,00,00,00: ' 9
DATA 00,00,00,00,00,00,00,00,00,00,03,10,00,00,02,00,00,00,03,14,15,06,15,15,15,12,00,02,00,02,00,02,00,00,00,00,00,00,00,00: '10
DATA 00,00,00,00,00,00,00,00,00,00,13,12,13,15,12,00,13,08,00,03,15,15,10,00,00,00,00,02,13,12,00,02,00,00,00,00,00,00,00,00: '11
DATA 00,00,00,00,00,00,00,00,00,13,12,13,12,00,00,00,02,01,00,00,00,00,02,00,00,00,00,02,02,00,00,02,00,00,00,00,00,00,00,00: '12
DATA 00,00,00,00,00,00,00,00,00,02,00,02,00,00,00,13,12,02,13,15,10,16,05,00,00,00,13,12,07,15,15,12,00,00,00,00,00,00,00,00: '13
DATA 00,00,00,00,00,00,00,00,00,02,00,02,13,15,15,05,00,03,14,15,05,00,02,00,00,13,12,00,02,00,00,00,00,00,00,00,00,00,00,00: '14
DATA 00,00,00,00,00,00,00,00,00,03,10,03,12,00,00,03,15,15,12,00,02,00,02,00,00,02,00,00,02,00,00,00,00,00,00,00,00,00,00,00: '15
DATA 00,00,00,00,00,00,00,00,00,00,03,10,00,00,00,00,00,00,13,15,06,15,12,00,00,02,00,13,12,00,00,00,00,00,00,00,00,00,00,00: '16
DATA 00,00,00,00,00,00,00,00,00,00,00,02,00,13,10,00,00,00,09,00,00,00,00,00,13,12,00,02,00,00,00,00,00,00,00,00,00,00,00,00: '17
DATA 00,00,00,00,00,00,00,00,00,00,00,03,15,05,02,00,13,15,10,00,00,13,15,15,12,00,00,02,00,00,00,00,00,00,00,00,00,00,00,00: '18
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,03,06,15,12,00,03,15,15,12,00,00,00,13,15,12,00,00,00,00,00,00,00,00,00,00,00,00: '19
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,25,00,00,00,00,00,00,00,00,00,00,00,00,00,00: '20
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00: '21
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00: '22
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00: '23
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00: '24
DATA 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00: '25
EIS:
DATA 195,20,161,100,120,180,113,271,102,355,118,433,128,531,488,434: ' equiped inventory slots
TYPE Locations
X AS INTEGER
Y AS INTEGER
R AS _UNSIGNED INTEGER
END TYPE
TYPE player
X AS INTEGER
Y AS INTEGER
R AS _UNSIGNED INTEGER
Dx AS _BYTE
Dy AS _BYTE
Dir AS _BYTE
Inventory_Size AS _BYTE
Currency AS LONG
END TYPE
TYPE GameData
InHand AS _BYTE
Object AS _BYTE
END TYPE
TYPE DroppedItemData
IL AS _BYTE 'ItemList array
IC AS _BYTE 'ItemCount
END TYPE
TYPE ItemData
X AS INTEGER
Y AS INTEGER
Type AS _BYTE
Pow AS _BYTE
Ix AS _BYTE 'inventory location adjustment
Iy AS _BYTE '
END TYPE
CONST TRUE = -1, FALSE = NOT TRUE, NULL = 0
CONST DOWN = 1, LEFT = 2, UP = 8, RIGHT = 4, SELECT_BUTTON = 5, START_BUTTON = 6, BUTTON_B = 7, BUTTON_A = 8
CONST HEAD = 64, NECK = 65, TORSO = 66, WAIST = 67, HANDS = 68, LEGS = 69, FEET = 70
CONST Default_Key_Right = 19712, Default_Key_Left = 19200, Default_Key_Up = 18432, Default_Key_Down = 20480
CONST Default_A_Button = 32, Default_B_Button = 13, Default_Start_Button = 65, Default_Select_Button = 66
SCREEN _NEWIMAGE(800, 600, 32): CLS: RANDOMIZE TIMER
DIM SHARED Layer(16) AS LONG
Layer(0) = _DISPLAY
Layer(1) = _COPYIMAGE(_DISPLAY)
'Layer(2) = _LOADIMAGE("Character.bmp", 32)
'Layer(3) = _LOADIMAGE("MapMaster.bmp", 32)
Layer(4) = _COPYIMAGE(_DISPLAY) 'collision layer
'Layer(5) = _LOADIMAGE("crystals-ore-sheet.bmp", 32)
'Layer(6) = _LOADIMAGE("inventory_TypeA.bmp", 32)
'Layer(7) = _LOADIMAGE("inventory_Box_Base.bmp", 32)
Layer(8) = _COPYIMAGE(_DISPLAY) 'Inventory click layer
'Layer(9) = _LOADIMAGE("BottleCursor_03.bmp", 32)
'Layer(10) = _LOADIMAGE("Inventory_button.bmp", 32)
'Layer(11) = _LOADIMAGE("ItemSheet_01.bmp", 32)
MFI_Loader "DMan.MFI"
_PUTIMAGE (60, 0), Layer(12), Layer(0)
DIM SHARED P AS player, Maps(30) AS Locations
DIM SHARED InventoryLoad(8, 12) AS _BYTE 'aka- The Load!
DIM SHARED g AS GameData
DIM SHARED IL(8) AS Locations 'where eqquiped inventory slots are
DIM SHARED E(8) AS _BYTE 'equiped items array (8th spot is in hands, 5th picked up hands)
DIM SHARED ItemList(65535, 31) AS Locations
DIM SHARED Rooms(41, 26) 'points to room array
DIM SHARED Room(65535) 'contains the map layout of the current room
DIM SHARED Roomitems(65535) AS DroppedItemData
DIM SHARED DoorFlag%%, TreasureFlag%%
DIM SHARED items(127) AS ItemData
Itemsdata:
DATA 0,17,0,0,0,0: ' Nothing
DATA 10,12,1,2,8,0: 'leather cap
DATA 0,11,2,2,8,0: ' leather cape
DATA 2,8,5,1,8,0: ' Branch
_CLEARCOLOR _RGB32(217, 207, 236), Layer(2)
_CLEARCOLOR _RGB32(0), Layer(5)
_CLEARCOLOR _RGB32(64, 128, 128), Layer(9)
_CLEARCOLOR _RGB32(0), Layer(11)
_PRINTMODE _KEEPBACKGROUND , Layer(1)
'set map image locations
FOR y% = 0 TO 2
FOR x% = 0 TO 9
Maps(i%).X = 257 * x%
Maps(i%).Y = 241 * y%
i% = i% + 1
NEXT
NEXT
'------------------------
'load cave map one
i% = 0
FOR y% = 1 TO 25
FOR x% = 1 TO 40
Rooms(x%, y%) = i%
READ Room(i%)
i% = i% + 1
NEXT
NEXT
'------------------------
'Load Equiped inventory slot x\y
RESTORE EIS
FOR i% = 1 TO 8
READ IL(i%).X, IL(i%).Y
NEXT
'-------------------------------
'Load item data
RESTORE Itemsdata
FOR i% = 0 TO 3
READ items(i%).X, items(i%).Y, items(i%).Type, items(i%).Pow, items(i%).Ix, items(i%).Iy
NEXT
'-------------------------------
'FOR y% = 0 TO 10
'FOR x% = 0 TO 18
' IF Room(Rooms(6 + x%, 13 + y%)) > 0 THEN
' _PUTIMAGE (48 * x%, 46 * y%)-STEP(47, 45), Layer(3), Layer(0), (Maps(Room(Rooms(6 + x%, 13 + y%))).X, Maps(Room(Rooms(6 + x%, 13 + y%))).Y)-STEP(255, 239)
'_PRINTSTRING (48 * x%, 45 * y%), STR$(Room(Rooms(6 + x%, 13 + y%))), Layer(0)
'END IF
'NEXT
'NEXT
'END
LOCATE 37, 1: PRINT "Press any key";
_DEST Layer(1)
_SOURCE Layer(4)
'------------------------
P.Dx = 18: P.Dy = 12
P.R = Rooms(P.Dx, P.Dy) 'INT(RND * 25)
P.R = 457
P.X = 430 - 29
P.Y = 300 - 34
Speed%% = 2
P.Inventory_Size = 3 '3-base, 2-upgrade, 1-max upgrade (smallest box)
ItemList(457, 1).X = 550: ItemList(457, 1).Y = 250: ItemList(457, 1).R = 1 'cap
ItemList(457, 2).X = 350: ItemList(457, 2).Y = 450: ItemList(457, 2).R = 2 'cloak
ItemList(457, 3).X = 450: ItemList(457, 3).Y = 350: ItemList(457, 3).R = 3 'branch
Roomitems(457).IC = 3
DO: LOOP UNTIL INKEY$ <> ""
_DELAY .25
_KEYCLEAR
_PUTIMAGE , Layer(3), Layer(4), (Maps(Room(P.R)).X, 722 + Maps(Room(P.R)).Y)-STEP(255, 239)
Place_Object_Collision_Box
Place_Exits Room(P.R)
_MOUSEHIDE
_MOUSEMOVE 760, 20
DO
IF _KEYDOWN(Default_Key_Down) THEN dir%% = _SETBIT(dir%%, 0) ELSE dir%% = _RESETBIT(dir%%, 0)
IF _KEYDOWN(Default_Key_Left) THEN dir%% = _SETBIT(dir%%, 1) ELSE dir%% = _RESETBIT(dir%%, 1)
IF _KEYDOWN(Default_Key_Right) THEN dir%% = _SETBIT(dir%%, 2) ELSE dir%% = _RESETBIT(dir%%, 2)
IF _KEYDOWN(Default_Key_Up) THEN dir%% = _SETBIT(dir%%, 3) ELSE dir%% = _RESETBIT(dir%%, 3)
IF _KEYDOWN(100304) THEN Speed%% = 4 ELSE Speed%% = 2
IF _KEYDOWN(73) OR _KEYDOWN(105) THEN Inventory_Flag%% = TRUE
IF _KEYDOWN(49) THEN P.Inventory_Size = 3
IF _KEYDOWN(50) THEN P.Inventory_Size = 2
IF _KEYDOWN(51) THEN P.Inventory_Size = 1
P.Dir = dir%%
SELECT CASE dir%%
CASE DOWN '(1)
_PUTIMAGE (P.X, P.Y)-STEP(57, 67), Layer(2), Layer(1), (0, 69 * Frame%%)-STEP(57, 67)
IF NOT Collision(P.X, P.Y + Speed%%) THEN P.Y = P.Y + Speed%%
CASE DOWN + RIGHT '(5)
_PUTIMAGE (P.X, P.Y)-STEP(57, 67), Layer(2), Layer(1), (58, 69 * Frame%%)-STEP(57, 67)
IF NOT Collision(P.X, P.Y + Speed%%) THEN P.Y = P.Y + Speed%%
IF NOT Collision(P.X + Speed%%, P.Y) THEN P.X = P.X + Speed%%
CASE RIGHT '(4)
_PUTIMAGE (P.X, P.Y)-STEP(57, 67), Layer(2), Layer(1), (122, 69 * Frame%%)-STEP(57, 67)
IF NOT Collision(P.X + Speed%%, P.Y) THEN P.X = P.X + Speed%%
CASE UP + RIGHT '(12)
_PUTIMAGE (P.X, P.Y)-STEP(57, 67), Layer(2), Layer(1), (186, 69 * Frame%%)-STEP(57, 67)
IF NOT Collision(P.X, P.Y - Speed%%) THEN P.Y = P.Y - Speed%%
IF NOT Collision(P.X + Speed%%, P.Y) THEN P.X = P.X + Speed%%
CASE UP '(8)
_PUTIMAGE (P.X, P.Y)-STEP(57, 67), Layer(2), Layer(1), (250, 69 * Frame%%)-STEP(57, 67)
IF NOT Collision(P.X, P.Y - Speed%%) THEN P.Y = P.Y - Speed%%
CASE DOWN + LEFT '(3)
_PUTIMAGE (57 + P.X, P.Y)-STEP(-57, 67), Layer(2), Layer(1), (58, 69 * Frame%%)-STEP(57, 67)
IF NOT Collision(P.X, P.Y + Speed%%) THEN P.Y = P.Y + Speed%%
IF NOT Collision(P.X - Speed%%, P.Y) THEN P.X = P.X - Speed%%
CASE LEFT '(2)
_PUTIMAGE (57 + P.X, P.Y)-STEP(-57, 67), Layer(2), Layer(1), (122, 69 * Frame%%)-STEP(57, 67)
IF NOT Collision(P.X - Speed%%, P.Y) THEN P.X = P.X - Speed%%
CASE UP + LEFT '(10)
_PUTIMAGE (57 + P.X, P.Y)-STEP(-57, 67), Layer(2), Layer(1), (186, 69 * Frame%%)-STEP(57, 67)
IF NOT Collision(P.X, P.Y - Speed%%) THEN P.Y = P.Y - Speed%%
IF NOT Collision(P.X - Speed%%, P.Y) THEN P.X = P.X - Speed%%
CASE ELSE 'Idle
_PUTIMAGE (P.X, P.Y)-STEP(57, 67), Layer(2), Layer(1), (0 + 57 * Blink%%, 69 * 8)-STEP(57, 67)
END SELECT
' _DEST Layer(1)
' LINE (P.X + 8, P.Y + 60)-STEP(2, 2), _RGB32(255, 2, 2), BF
' LINE (P.X + 48, P.Y + 60)-STEP(2, 2), _RGB32(255, 2, 2), BF
' LINE (P.X + 28, P.Y + 48)-STEP(2, 2), _RGB32(255, 2, 2), BF
IF P.Y < 10 THEN P.Y = 10
IF P.Y > 530 THEN P.Y = 530
IF P.X < 10 THEN P.X = 10
IF P.X > 730 THEN P.X = 730
IF _MOUSEBUTTON(1) THEN 'left click
Clicked~& = POINT(_MOUSEX, _MOUSEY)
IF _RED32(Clicked~&) = 64 THEN Inventory
DO: n = _MOUSEINPUT: LOOP WHILE _MOUSEBUTTON(1)
END IF
_PRINTSTRING (0, 0), STR$(Room(Rooms(P.Dx, P.Dy))), Layer(1)
_PRINTSTRING (0, 16), STR$(P.R), Layer(1)
_PRINTSTRING (0, 32), STR$(Room(P.R)), Layer(1)
_PRINTSTRING (0, 48), STR$(P.Dx), Layer(1)
_PRINTSTRING (0, 64), STR$(P.Dy), Layer(1)
_PRINTSTRING (0, 80), STR$(P.X), Layer(1)
_PRINTSTRING (0, 96), STR$(P.Y), Layer(1)
_PUTIMAGE (700, 0)-STEP(83, 63), Layer(10), Layer(1), (0, 0)-STEP(83, 63) 'place inventory icon
Display_Cursor_Inventory _MOUSEX - 8, _MOUSEY - 8, 0 'display bottle
_PUTIMAGE , Layer(1), Layer(0)
_PUTIMAGE , Layer(3), Layer(1), (Maps(Room(P.R)).X, Maps(Room(P.R)).Y)-STEP(255, 239)
SELECT CASE Room(P.R)
CASE 1
Cover_Cave 494, 160
CASE 8
Cover_Cave 491, 160
CASE 9
Cover_Cave 494, 320
CASE 16
Cover_Cave 191, 240
END SELECT
IF Roomitems(P.R).IC THEN
FOR i% = 1 TO Roomitems(P.R).IC
Display_Item_Room ItemList(P.R, i%).X, ItemList(P.R, i%).Y, ItemList(P.R, i%).R
NEXT
END IF
_LIMIT 60
DO: LOOP WHILE _MOUSEINPUT
F%% = F%% + 1
IF F%% = 4 THEN F%% = 0: Frame%% = Frame%% + 1
IF Frame%% = 8 THEN Frame%% = 0
IF INT(RND * 255) <= 3 AND dir%% = 0 THEN Blinking%% = TRUE
IF Blinking%% THEN
B%% = B%% + 1
IF B%% = 3 THEN B%% = 0: Blink%% = Blink%% + 1
IF Blink%% = 5 THEN Blink%% = 0: Blinking%% = FALSE
END IF
IF DoorFlag%% THEN New_Room
IF TreasureFlag%% THEN Pick_up_object
IF Inventory_Flag%% THEN Inventory: Inventory_Flag%% = FALSE
LOOP UNTIL INKEY$ = CHR$(27)
_PUTIMAGE , Layer(4), Layer(0)
SLEEP
SUB Build_Inventory_Click_Screen
LINE (195, 20)-STEP(59, 47), _RGB32(128, 0, 1), BF 'head
LINE (161, 100)-STEP(59, 47), _RGB32(128, 0, 2), BF 'Neck
LINE (120, 180)-STEP(59, 47), _RGB32(128, 0, 3), BF 'Torso
LINE (113, 271)-STEP(59, 47), _RGB32(128, 0, 4), BF 'Waist
LINE (102, 355)-STEP(59, 47), _RGB32(128, 0, 5), BF 'Hands
LINE (118, 433)-STEP(59, 47), _RGB32(128, 0, 6), BF 'Legs
LINE (128, 531)-STEP(59, 47), _RGB32(128, 0, 7), BF 'Feet
LINE (500, 550)-STEP(285, 39), _RGB32(129, 0, 8), BF 'Currency
LINE (730, 480)-STEP(54, 54), _RGB32(130, 0, 0), BF 'drop item
LINE (0, 0)-STEP(41, 63), _RGB32(131), BF
END SUB
SUB Build_Inventory_Screen (I_Base&, Ys%%, Xs%%)
_PUTIMAGE , Layer(6), I_Base&
SELECT CASE P.Inventory_Size
CASE 1
FOR Iy% = 0 TO 11: FOR Ix% = 0 TO 7
_PUTIMAGE (470 + 36 * Ix%, 32 + 32 * Iy%)-STEP(35, 31), Layer(7), I_Base&
LINE (470 + 36 * Ix%, 32 + 32 * Iy%)-STEP(35, 31), _RGB32(255, Ix%, Iy%), BF 'for click layer
NEXT: NEXT
Ys%% = 11: Xs%% = 7
CASE 2
FOR Iy% = 0 TO 7: FOR Ix% = 0 TO 4
_PUTIMAGE (470 + 54 * Ix%, 32 + 48 * Iy%)-STEP(53, 47), Layer(7), I_Base&
LINE (470 + 54 * Ix%, 32 + 48 * Iy%)-STEP(53, 47), _RGB32(255, Ix%, Iy%), BF 'for click layer
NEXT: NEXT
Ys%% = 7: Xs%% = 4
CASE 3
FOR Iy% = 0 TO 5: FOR Ix% = 0 TO 3
_PUTIMAGE (470 + 72 * Ix%, 32 + 64 * Iy%)-STEP(71, 63), Layer(7), I_Base&
LINE (470 + 72 * Ix%, 32 + 64 * Iy%)-STEP(71, 63), _RGB32(255, Ix%, Iy%), BF 'for click layer
NEXT: NEXT
Ys%% = 5: Xs%% = 3
END SELECT
END SUB
FUNCTION Collision%% (x, y)
STATIC A AS _UNSIGNED LONG, B AS _UNSIGNED LONG, C AS _UNSIGNED LONG
'x,y character to left point
Result%% = FALSE
A = POINT(x + 8, y + 60)
B = POINT(x + 48, y + 60)
C = POINT(x + 28, y + 48)
IF A = _RGB32(255, 0, 0) THEN Result%% = TRUE 'bottom left point
IF B = _RGB32(255, 0, 0) THEN Result%% = TRUE 'bottom right point
IF _BLUE32(A) = 255 THEN DoorFlag%% = TRUE 'bottom left point
IF _BLUE32(B) = 255 THEN DoorFlag%% = TRUE 'bottom right point
IF _GREEN32(C) = 255 AND E(8) = 0 THEN TreasureFlag%% = _BLUE32(C) 'can only pick up more if one hand is empty
Collision = Result%%
END FUNCTION
SUB Display_Item_Room (xp%, yp%, ID%%)
_PUTIMAGE (items(ID%%).Ix + xp%, items(ID%%).Iy + yp%)-STEP(31, 31), Layer(11), Layer(1), (2 + items(ID%%).X * 16, 4 + items(ID%%).Y * 16)-STEP(15, 15)
END SUB
SUB Display_item_Inventory (xp%, yp%, ID%%)
_PUTIMAGE (items(ID%%).Ix + xp%, items(ID%%).Iy + yp%)-STEP(16 * P.Inventory_Size - 1, 16 * P.Inventory_Size - 1), Layer(11), Layer(1), (2 + items(ID%%).X * 16, 4 + items(ID%%).Y * 16)-STEP(15, 15)
END SUB
SUB Display_Equiped_Inventory (xp%, yp%, ID%%)
_PUTIMAGE (items(ID%%).Ix + xp%, items(ID%%).Iy + yp%)-STEP(47, 47), Layer(11), Layer(1), (2 + items(ID%%).X * 16, 4 + items(ID%%).Y * 16)-STEP(15, 15)
END SUB
SUB Display_Cursor_Inventory (xp%, yp%, ID%%)
SELECT CASE ID%%
CASE 0 ' base pointer
_PUTIMAGE (xp%, yp%)-STEP(31, 31), Layer(9), Layer(1), (0, 0)-STEP(15, 15)
CASE ELSE 'items
_PUTIMAGE (xp%, yp%)-STEP(31, 31), Layer(11), Layer(1), (2 + items(ID%%).X * 16, 4 + items(ID%%).Y * 16)-STEP(15, 15)
END SELECT
END SUB
SUB Inventory
STATIC Inhand AS _BYTE, Moving AS _BYTE
Tmp& = _COPYIMAGE(_DISPLAY)
OldS = _SOURCE
OldD = _DEST
_MOUSEHIDE
_DEST Layer(1)
COLOR _RGB32(0) ' set layer(1) text color to black for currency
_DEST Layer(8)
_SOURCE Layer(8)
I_Base& = _COPYIMAGE(Layer(6))
'------------------Build Screen Base---------------------------
Build_Inventory_Screen I_Base&, Ys%%, Xs%%
'--------------------------------------------------------------
'----------------------click layer setup-----------------------
Build_Inventory_Click_Screen
'--------------------------------------------------------------
_MOUSEMOVE 320, 125
DO
REM IF _KEYDOWN(27) THEN ExitFlag%% = TRUE
_PUTIMAGE , I_Base&, Layer(1)
'-----------------------Place Body Inventory-------------------
FOR i% = 1 TO 8
Display_Equiped_Inventory IL(i%).X, IL(i%).Y, E(i%)
NEXT
'--------------------------------------------------------------
'----------------------Place LOAD inventory--------------------
FOR Iy%% = 0 TO Ys%%
FOR Ix%% = 0 TO Xs%%
IF InventoryLoad(Ix%%, Iy%%) THEN Display_item_Inventory 479 + (18 + 18 * P.Inventory_Size) * Ix%%, 40 + (16 + 16 * P.Inventory_Size) * Iy%%, InventoryLoad(Ix%%, Iy%%)
NEXT: NEXT
'--------------------------------------------------------------
IF _MOUSEBUTTON(1) THEN 'left click
Clicked~& = POINT(_MOUSEX, _MOUSEY)
IF _RED32(Clicked~&) = 128 THEN Result%% = Inventory_Equiped_Click(Inhand, Moving, Clicked~&) 'equiped inventory slot selected
IF _RED32(Clicked~&) = 255 THEN Result%% = Inventory_Load_Click(Inhand, Moving, Clicked~&)
IF _RED32(Clicked~&) = 129 THEN Result%% = Inventory_Cash_Out(Inhand, Moving)
IF _RED32(Clicked~&) = 130 THEN Result%% = Drop_Item(Inhand, Moving)
IF _RED32(Clicked~&) = 131 THEN ExitFlag%% = TRUE
DO: n = _MOUSEINPUT: LOOP WHILE _MOUSEBUTTON(1)
END IF
IF Moving THEN Display_Cursor_Inventory _MOUSEX - 30, _MOUSEY - 24, Inhand ELSE Display_Cursor_Inventory _MOUSEX - 8, _MOUSEY - 8, 0
_PRINTSTRING (790 - 9 * LEN(LTRIM$(STR$(P.Currency))), 560), LTRIM$(STR$(P.Currency)), Layer(1) ' ,
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60 'this seems to work better with mouse movement delay
DO: LOOP WHILE _MOUSEINPUT
'if player trys to exit but still has something in moving hand then drop it
IF ExitFlag%% AND Inhand THEN Result%% = Drop_Item(Inhand, Moving)
IF Result%% THEN ExitFlag%% = FALSE 'player tried to exit inventory with item in hand when room is full.
LOOP UNTIL ExitFlag%%
'---------Restore originals---------
_PUTIMAGE , Tmp&, Layer(0)
_SOURCE OldS
_DEST Layer(1)
COLOR _RGB32(255) 'restore print color
_DEST OldD
'-----------Free temps--------------
_FREEIMAGE Tmp&
_FREEIMAGE I_Base&
'----------Clear buffer-------------
_DELAY .25
_KEYCLEAR
_MOUSEMOVE 750, 32
END SUB
SUB Display_Mouse (x%, y%)
Display_item_Inventory x%, y%, 1
END SUB
FUNCTION Drop_Item%% (Inhand AS _BYTE, Moving AS _BYTE)
Result%% = NULL
IF Roomitems(P.R).IC < 31 THEN
Xcheck% = P.X + 8: Ycheck% = P.Y + 64
IF Roomitems(P.R).IC THEN 'check for item overlap
DO
All_Good%% = TRUE
FOR i%% = 1 TO Roomitems(P.R).IC
IF ItemList(P.R, i%%).X = Xcheck% AND ItemList(P.R, i%%).Y = Ycheck% THEN All_Good%% = FALSE
NEXT
IF NOT All_Good%% THEN Xcheck% = Xcheck% + 16 'found an item at the location so shift 4 and try again
IF NOT All_Good%% AND Xcheck% = P.X + 72 THEN Xcheck% = Xcheck% - 64: Ycheck% = Ycheck% + 16 ' shift down after 4x over
LOOP UNTIL All_Good%%
END IF
ItemList(P.R, Roomitems(P.R).IC + 1).X = Xcheck% 'place the item by the players feet.
ItemList(P.R, Roomitems(P.R).IC + 1).Y = Ycheck%
ItemList(P.R, Roomitems(P.R).IC + 1).R = Inhand
Inhand = FALSE 'remove item from hand
Moving = FALSE 'nolonger moving an item
Roomitems(P.R).IC = Roomitems(P.R).IC + 1
Place_Object_Collision_Box 'update the item collide boxes
ELSE
Result%% = TRUE
END IF
Drop_Item = Result%%
END FUNCTION
FUNCTION Inventory_Equiped_Click%% (InHand AS _BYTE, Moving AS _BYTE, Clicked~&)
slot = _BLUE32(Clicked~&)
IF E(slot) THEN ' Is there an Item in the Equiped Slot
IF NOT Moving%% THEN ' Is player Moving an item
SWAP InHand, E(slot) ' Place Item in Equipment Slot into Moving Hand, now Equipment slot is empty
Moving%% = TRUE ' Player is now moving something
'Check to see if player removed Item from Right hand and has item in left hand
IF (NOT E(5)) AND E(8) THEN SWAP E(5), E(8) 'if so move item back to right hand
ELSE ' Player is placing something into a Equipment Slot that Already Has An Item
IF items(InHand).Type = slot THEN 'only place items of correct TYPE for slot (caps - head, Boots - Feet ect.)
SWAP InHand, E(slot) ' Swap Items; this works even if moving hand is empty cause then slot is emptied.
ELSEIF slot = 5 THEN 'anything can go in hands though
SWAP InHand, E(slot) ' Swap Items
END IF
END IF
ELSE ' There is nothing Equipted in this slot
IF Moving%% THEN
IF items(InHand).Type = slot THEN 'only place items of correct TYPE for slot (caps - head, Boots - Feet ect.)
E(slot) = InHand: InHand = FALSE: Moving%% = FALSE
ELSEIF slot = 5 THEN 'anything can go in hands though
E(slot) = InHand: InHand = FALSE: Moving%% = FALSE
END IF
END IF
END IF
Inventory_Equiped_Click = NULL
END FUNCTION
FUNCTION Inventory_Load_Click%% (InHand AS _BYTE, Moving AS _BYTE, Clicked~&)
Xs%% = _GREEN32(Clicked~&)
Ys%% = _BLUE32(Clicked~&)
IF InventoryLoad(Xs%%, Ys%%) THEN ' Is there an Item in the LOAD Slot
IF NOT Moving%% THEN ' Is player Moving an item
SWAP InHand, InventoryLoad(Xs%%, Ys%%) ' Place Item in LOAD Slot into Moving Hand, now LOAD slot is empty
Moving%% = TRUE ' Player is now moving something
ELSE ' Player is placing something into a LOAD Slot that Already Has An Item
SWAP InHand, InventoryLoad(Xs%%, Ys%%) ' Swap Items
END IF
ELSE ' There is nothing in this LOAD slot
IF Moving%% THEN InventoryLoad(Xs%%, Ys%%) = InHand: InHand = FALSE: Moving%% = FALSE
END IF
Inventory_Load_Click = NULL
END FUNCTION
FUNCTION Inventory_Cash_Out%% (InHand AS _BYTE, Moving AS _BYTE)
SELECT CASE InHand
CASE 5 'test crystal
P.Currency = P.Currency + INT(RND * 127) + 1
InHand = FALSE
Moving = FALSE
END SELECT
Inventory_Cash_Out = NULL
END FUNCTION
SUB Place_Exits (ID%%)
DIM Path AS _BYTE
_DEST Layer(4)
LINE (700, 0)-STEP(83, 63), _RGB32(64), BF 'inventory click box
SELECT CASE ID%%
CASE 1
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 4)
CASE 2
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 1)
CASE 3
Path = _SETBIT(Path, 1)
Path = _SETBIT(Path, 2)
CASE 4
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 2)
Path = _SETBIT(Path, 3)
CASE 5
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 1)
Path = _SETBIT(Path, 3)
CASE 6
Path = _SETBIT(Path, 1)
Path = _SETBIT(Path, 2)
Path = _SETBIT(Path, 3)
CASE 7
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 1)
Path = _SETBIT(Path, 2)
CASE 8
Path = _SETBIT(Path, 3)
Path = _SETBIT(Path, 4)
CASE 9
Path = _SETBIT(Path, 1)
Path = _SETBIT(Path, 5)
CASE 10
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 3)
CASE 11
Path = _SETBIT(Path, 2)
CASE 12
Path = _SETBIT(Path, 1)
Path = _SETBIT(Path, 3)
CASE 13
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 2)
CASE 14
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 1)
Path = _SETBIT(Path, 2)
Path = _SETBIT(Path, 3)
CASE 15
Path = _SETBIT(Path, 2)
Path = _SETBIT(Path, 3)
CASE 16
Path = _SETBIT(Path, 2)
'Path = _SETBIT(Path, 6)
CASE 17
Path = _SETBIT(Path, 7)
CASE 18
LINE (510, 130)-STEP(75, 23), _RGB32(0, 0, 255), BF 'Cave exit
Path = _SETBIT(Path, 2)
Path = _SETBIT(Path, 3)
CASE 19 'no exits
CASE 20
Path = _SETBIT(Path, 0)
CASE 21
Path = _SETBIT(Path, 0)
CASE 22
LINE (510, 130)-STEP(81, 23), _RGB32(0, 0, 255), BF 'Cave exit
Path = _SETBIT(Path, 2)
Path = _SETBIT(Path, 3)
CASE 23
Path = _SETBIT(Path, 0)
LINE (110, 370)-STEP(81, 23), _RGB32(0, 0, 255), BF 'Cave exit
CASE 24
Path = _SETBIT(Path, 3)
CASE 25
Path = _SETBIT(Path, 1)
CASE 26
Path = _SETBIT(Path, 0)
Path = _SETBIT(Path, 1)
Path = _SETBIT(Path, 2)
END SELECT
IF _READBIT(Path, 0) THEN LINE (352, 576)-STEP(89, 23), _RGB32(0, 0, 255), BF 'bottom exit
IF _READBIT(Path, 1) THEN LINE (356, 76)-STEP(89, 23), _RGB32(0, 0, 255), BF 'top exit
IF _READBIT(Path, 2) THEN LINE (760, 282)-STEP(23, 83), _RGB32(0, 0, 255), BF 'right exit
IF _READBIT(Path, 3) THEN LINE (20, 282)-STEP(23, 83), _RGB32(0, 0, 255), BF 'left exit
IF _READBIT(Path, 4) THEN LINE (510, 214)-STEP(81, 23), _RGB32(0, 0, 254), BF 'Cave 01 exit
IF _READBIT(Path, 5) THEN LINE (110, 370)-STEP(81, 23), _RGB32(0, 0, 255), BF 'Cave 08 exit
IF _READBIT(Path, 6) THEN LINE (516, 376)-STEP(75, 23), _RGB32(0, 0, 255), BF 'Cave 09 exit
IF _READBIT(Path, 7) THEN LINE (210, 292)-STEP(79, 23), _RGB32(0, 0, 255), BF 'Cave 16 exit
' IF _READBIT(Path, 8) THEN LINE (610, 130)-STEP(81, 23), _RGB32(0, 0, 255), BF 'Cave 17 exit
' IF _READBIT(Path, 9) THEN LINE (510, 130)-STEP(75, 23), _RGB32(0, 0, 255), BF 'Cave 18 exit
' IF _READBIT(Path, 10) THEN LINE (110, 370)-STEP(81, 23), _RGB32(0, 0, 255), BF 'Cave 23 exit
END SUB
SUB New_Room
IF _READBIT(P.Dir, 0) THEN IF P.Y > 500 THEN P.Dy = P.Dy + 1: P.Dir = DOWN 'down
IF _READBIT(P.Dir, 2) THEN IF P.X > 600 THEN P.Dx = P.Dx + 1: P.Dir = RIGHT 'right
IF _READBIT(P.Dir, 1) THEN IF P.X < 60 THEN P.Dx = P.Dx - 1: P.Dir = LEFT 'left
IF _READBIT(P.Dir, 3) THEN IF P.Y < 50 THEN P.Dy = P.Dy - 1: P.Dir = UP 'up
P.R = Rooms(P.Dx, P.Dy)
_PUTIMAGE , Layer(3), Layer(4), (Maps(Room(P.R)).X, 722 + Maps(Room(P.R)).Y)-STEP(255, 239) 'collision image
IF Roomitems(P.R).IC THEN Place_Object_Collision_Box
Place_Exits Room(P.R)
'start pos in new room
Room_Entry_Loc
DoorFlag%% = FALSE
END SUB
SUB Room_Entry_Loc
SELECT CASE P.Dir
CASE DOWN
P.Y = 40
CASE RIGHT
P.X = 50
CASE LEFT
P.X = 700 - 29
CASE UP
P.Y = 530 - 34
END SELECT
END SUB
SUB Place_Object_Collision_Box
_DEST Layer(4)
FOR I% = 1 TO Roomitems(P.R).IC
LINE (ItemList(P.R, I%).X, ItemList(P.R, I%).Y)-STEP(31, 31), _RGB32(0, 255, I%), BF
NEXT I%
_DEST Layer(1)
END SUB
SUB Pick_up_object ()
'if player already has an item in carry hand(right hand) and ALSO has
'an item in their left hand they can not pick up anything else.
' SELECT CASE ItemList(P.R, TreasureFlag%%).R
' CASE 1 ' Crystal-Hold in hand
IF E(5) THEN 'player already has an item in carry hand
E(8) = E(5) 'move carry hand into left hand
E(5) = ItemList(P.R, TreasureFlag%%).R 'pick item up.
ELSE 'player's carry hand is empty
E(5) = ItemList(P.R, TreasureFlag%%).R
END IF
' CASE ELSE
' _DEST Layer(0)
' PRINT TreasureFlag%%, ItemList(P.R, TreasureFlag%%).R
' END
' END SELECT
FOR i%% = TreasureFlag%% TO Roomitems(P.R).IC 'remove item from list
ItemList(P.R, i%%).X = ItemList(P.R, i%% + 1).X
ItemList(P.R, i%%).Y = ItemList(P.R, i%% + 1).Y
ItemList(P.R, i%%).R = ItemList(P.R, i%% + 1).R
NEXT
Roomitems(P.R).IC = Roomitems(P.R).IC - 1 '1 less item in room
'rebuild collision layer
_PUTIMAGE , Layer(3), Layer(4), (Maps(Room(P.R)).X, 722 + Maps(Room(P.R)).Y)-STEP(255, 239) 'collision iamge
Place_Object_Collision_Box
Place_Exits Room(P.R)
TreasureFlag%% = FALSE
END SUB
SUB Cover_Cave (X%, Y%)
_PUTIMAGE (X%, Y%)-STEP(32 * 3.125 - 1, 32 * 2.5 - 1), Layer(3), Layer(1), (2410, 241)-STEP(31, 31)
_PUTIMAGE (X%, Y%)-STEP(32 * 3.125 - 1, 32 * 2.5 - 1), Layer(3), Layer(4), (2410, 723 + 241)-STEP(31, 31)
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~%%
Layer(2) = LoadGFX(FOffset(1), Size(1)) '
Layer(3) = LoadGFX(FOffset(2), Size(2)) '
Layer(5) = LoadGFX(FOffset(3), Size(3)) '
Layer(6) = LoadGFX(FOffset(4), Size(4)) '
Layer(7) = LoadGFX(FOffset(5), Size(5)) '
Layer(9) = LoadGFX(FOffset(6), Size(6)) '
Layer(10) = LoadGFX(FOffset(7), Size(7)) '
Layer(11) = LoadGFX(FOffset(8), Size(8)) '
Layer(12) = LoadGFX(FOffset(9), Size(9)) '
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
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
RE: A new and Exciting Demo! - Pete - 05-23-2025
I'm hoping to have a few more good years before Diperman becomes my hero.
Pete