Hi all, new to the forum, new to QB64, but have done some coding in QB.
I have a general question on the math capabilities available. I am tied down rright now to a 32-bit Win 11 machine. I would like to do some math operations using 64-bit integers. Will QB 64 be able to give me the full precision of the 64-bits? I realize that I will lose speed on the thunking from 32 to 64 bits, but I can always recompile and run on a 64-bit machine when I get access to one.
I want to start coding again since I have some forced free time so expect some more general under-the-hood type questions.
Hi,
I have several programs that call python programs, the python program writes its results to disk and then the basic reads the results and uses them. (some of the python libraries are very useful). In particular I am using pyephem, a library that calculates astronomical date on stars and planets.
Is there a way to do this without the intermediate step of writing the information to disk? Can the output of an external program be ported directly into a basic array or other structure?
John
Before I go off and try this. I will ask it here to see if "Yes you can and it would work". Generally the best idea's stay private and nobody benefits. I hate that approach.
What i do now: I use a program called Total Commander if you have used Norton commander in the past you know what I mean. It's great for finding all the filenames in a directory (sub-directories) or drive. From the total list show I can select via (numpad +) and subset based on a select pattern ie: *.jpg I can clip and drop that list into another program for processing. In short I have a list dropped into a program.
Is it possible: Using a console window in qb64pe to find all those JPG's list them with paths in the window, select them with ctrl-a and drop them into the program. Using it this way, I save lot's of clicks and steps.
I have done some amazing things I never did with qb45 using qb64pe (and extensions). If it's possible I have another sharp tool for the my toy box. If I figured wrong. Got an idea ?
Thanks
PS.
I never thought of this forum or users to be like Reddit. Everyone here is both helpful and smart as fuck.
Deep in the African jungle, high in his tree-top lab, NakedApe has been hard at work on his next space game. This is my first attempt at 3D - well, 3D Lite for the mathematically challenged anyway. I tried to keep this fast-paced since attention spans are short. This has one-handed mode for easier play too. Thanks to bplus for help with circle aspects, SierraKen for the globe routine and Steve for bits of code off the forum. This looked best at higher rez, so I made it 1920x1080.
It's a work in progress and I plan to take it a little further, so feel free to tell me what it's missing or not. Thanks for playing.
Ted
Posted by: SierraKen - 05-24-2025, 12:38 AM - Forum: Programs
- No Replies
I asked ChatGPT to make me a Pringle. So tinkering around with it I made this animation.
Code: (Select All)
Screen _NewImage(600, 600, 32)
CENTERX = 300
CENTERY = 300
' Pringle parameters
SIZE = 300
STP = 1
Const ZSCALE = 30 ' Controls how much "curve" there is
num = 20
dir = 20
t = 4
Do
If num > 3000 Then
dir = -20
End If
If num < -3000 Then
dir = 20
End If
num = num + dir * t
For x! = -SIZE To SIZE Step STP
For y! = -SIZE To SIZE Step STP
' Hyperbolic paraboloid formula: z = (x^2 - y^2) / scale
z! = ((x! ^ 2) - (y! ^ 2)) / (SIZE * ZSCALE)
' Project to screen (top-down view with z as shading)
screenX = CENTERX + x!
screenY = CENTERY + y!
' Shade based on height (z)
shade = 128 + z! * num
If shade < 0 Then shade = 0
If shade > 255 Then shade = 255
PSet (screenX, screenY), _RGB(shade, shade, 255 - shade)
Next
Next
Loop Until InKey$ = Chr$(27)
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.
'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
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
'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 '-------------------------------
_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
_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_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
_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
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
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~%%
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
I'm trying to find a reasonable font for QB64pe on my Mac. Everything I've tried so far is too faint--the pieces of the glyphs are too narrow and sometimes appear dashed. The best I've found so far is JetBrains Mono Medium (Nerd Font variant or not makes no difference). With this I can most of the charcter distinct enough but the right edge is clipped, so the right vertical of "0" is much thinner than the left.
I can just switch to Vim, but sometimes I like the IDE
Sub SomeRoutine (a$)
Print "processing goes here to determine what was sent..."
Print "If a variable was sent then VariableWasSent% = 1"
Print "Otherwise VariableWasSent%=0"
If VariableWasSent% = 1 Then Print "Variable string was sent"
If VariableWasSent% = 0 Then Print "Static string was sent"
End Sub
If there exists a way to do this, the example above would provide the following results:
Variable string was sent
Static string was sent
The reason I need this is because I am adding functionality to a very old library routine that is entrenched in so many programs that is would be a monumental task to change. In order to bring the new functionality to the old routine I need to be able to determine what was sent.
I have used the logical operator _Andalso in IF...Then statements however I'm not sure if this logical operator works in Select Case.
Is this because Select Case: Case is .. will only accept =,<>,<,>
the logical operators like And, Or, Xor, _Andalso do not work with Case is..?
![[Image: Twizzle-Screenshot.png]](https://i.ibb.co/vCTMbmW4/Twizzle-Screenshot.png)
