TYPE ChessPiece
id AS INTEGER
team AS INTEGER
END TYPE
TYPE GameArbiter
Turn AS INTEGER ' 0: White, 1: Black
SelectedX AS INTEGER ' -1 for none
SelectedZ AS INTEGER ' -1 for none
IsActive AS INTEGER ' 1 if a piece is selected
Timer AS SINGLE ' Used for the "Bounce" animation
PlayerTeam AS INTEGER ' 0 or 1 (Randomized at start)
' Future AI Agro/Difficulty metrics could go here
END TYPE
' --- EXPLICIT SHARED HANDLES & VARS ---
DIM SHARED Board(7, 7) AS ChessPiece
DIM SHARED AS LONG ListBoard, PieceLists(1, 6)
DIM SHARED Arbiter AS GameArbiter
DIM SHARED ValidMoves(7, 7) AS INTEGER ' 1 if square is a valid target
DIM SHARED AS INTEGER hoverX, hoverZ
' --- SETUP ---
IF GDK_Boot(800, 600, "TITAN GDK 2026 | 3D Chess", GDK_MODE_LEGACY) = 0 THEN END
Bake '// Build the board and pieces as gllists
Setup_Board '// setup the piece positions
' Initialize the Arbiter State
Arbiter.SelectedX = -1
Arbiter.SelectedZ = -1
Arbiter.IsActive = 0
Arbiter.Turn = 0 ' White always starts in Chess
Arbiter.PlayerTeam = 0 ' INT(RND * 2) ' Start as White Human player for testing
GDK_Scene_Clear 0.8, 0.8, 0.8, .8 '// Set ambient light
' --- MAIN LOOP ---
DO
GDK_UpdateSystem '// Updates input handlers screen etc
'// Logic
Get_Grid_Hack ' 1. Map mouse to board - Hecked version - need to make raycasting work to do it right!
Handle_Selection_Interaction ' 2. Process clicks and piece bounces
' --- RENDER SCENE SETUP ---
GDK_Clear 0.1, 0.1, 0.15 '// CLS but with background colour values
GDK_Perspective 70, 0.1, 200 '// gluperspective clone but GLM based
glLoadIdentity '// reset us to 0,0,0 '// Note - non legacy mode will require GDK_ functions
GDK_LookAt 0, 30, 10, 0, 0, 0 '// gluLookAt clone but using the glm lib which is way better
GDK_Scene_Apply '// Apply ambient light, camera etc
' --- RENDER ---
glCallList ListBoard '// Draw chess board
Render_Highlights '// if piece is selected by himan player then moves are highlighted
Render_Pieces '// Draw the chess pieces
Debug_Info '// Mouse data
GDK_Display '// Swaps the buffers so you can see whats happend - same as _DISPLAY functions but for our custom window
SUB Render_Pieces
' Renders all pieces, including the "bounce" effect on the selected piece
FOR x = 0 TO 7: FOR z = 0 TO 7
IF Board(x, z).id <> P_EMPTY THEN
y_off! = 0
IF x = Arbiter.SelectedX AND z = Arbiter.SelectedZ THEN y_off! = ABS(SIN(TIMER * 6)) * 1.2
glPushMatrix
glTranslatef (x * 4) - 14, y_off!, (z * 4) - 14
DrawPiece Board(x, z).team, Board(x, z).id
glPopMatrix
END IF
NEXT: NEXT
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////
'// resets the board to deafults
SUB Setup_Board
FOR x = 0 TO 7: FOR z = 0 TO 7: Board(x, z).id = P_EMPTY: NEXT: NEXT
FOR i = 0 TO 7
Board(i, 1).id = P_PAWN: Board(i, 1).team = T_WHITE
Board(i, 6).id = P_PAWN: Board(i, 6).team = T_BLACK
NEXT
FOR t = 0 TO 1
IF t = 0 THEN rw = 0: tm = T_WHITE ELSE rw = 7: tm = T_BLACK
Board(0, rw).id = P_ROOK: Board(0, rw).team = tm
Board(7, rw).id = P_ROOK: Board(7, rw).team = tm
Board(1, rw).id = P_KNIGHT: Board(1, rw).team = tm
Board(6, rw).id = P_KNIGHT: Board(6, rw).team = tm
Board(2, rw).id = P_BISHOP: Board(2, rw).team = tm
Board(5, rw).id = P_BISHOP: Board(5, rw).team = tm
Board(3, rw).id = P_QUEEN: Board(3, rw).team = tm
Board(4, rw).id = P_KING: Board(4, rw).team = tm
NEXT
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////
SUB Bake '// Converts all the pieces and the board into gllists (fastest way 1.x can handle) .0001 msecs(so quite fast!)
ListBoard = glGenLists(1)
glNewList ListBoard, &H1300
FOR x = 0 TO 7: FOR z = 0 TO 7
glPushMatrix
glTranslatef (x * 4) - 14, -0.01, (z * 4) - 14
IF (x + z) MOD 2 = 0 THEN GDK_Quad_Clr 0.9, 0.9, 0.8, 1, 4, 4 ELSE GDK_Quad_Clr 0.2, 0.3, 0.2, 1, 4, 4
glPopMatrix
NEXT: NEXT
glEndList
FOR t = 0 TO 1
IF t = T_WHITE THEN r_team! = 1.0: g_team! = 1.0: b_team! = 1.0 ELSE r_team! = 0.8: g_team! = 0.1: b_team! = 0.1
FOR i = P_PAWN TO P_KING
PieceLists(t, i) = glGenLists(1)
glNewList PieceLists(t, i), &H1300
glColor4f r_team!, g_team!, b_team!, 1.0
SELECT CASE i
CASE P_PAWN
GDK_Cone_Clr r_team!, g_team!, b_team!, 1, 0.8, 2.2, 16
glPushMatrix: glTranslatef 0, 2.2, 0: GDK_Sphere_Clr r_team!, g_team!, b_team!, 1, 0.6, 12: glPopMatrix
CASE P_ROOK
GDK_Cylinder_Clr r_team!, g_team!, b_team!, 1, 1.2, 3.5, 20
CASE P_KNIGHT
GDK_Cone_Clr r_team!, g_team!, b_team!, 1, 0.7, 4.5, 16
glPushMatrix: glTranslatef 0, 2.8, 0: glRotatef 90, 0, 0, 1: GDK_Torus_Clr r_team!, g_team!, b_team!, 1, 1.1, 0.2, 12, 8: glPopMatrix
CASE P_BISHOP
glPushMatrix: glTranslatef 0, 2.25, 0: GDK_Box_Clr r_team!, g_team!, b_team!, 1, 1.2, 4.5, 0.6: glPopMatrix
CASE P_QUEEN
GDK_Pyramid_Clr r_team!, g_team!, b_team!, 1, 1.4, 5.5, 4
glPushMatrix: glTranslatef 0, 5.5, 0: GDK_Sphere_Clr r_team!, g_team!, b_team!, 1, 0.6, 12: glPopMatrix
CASE P_KING
GDK_Pyramid_Clr r_team!, g_team!, b_team!, 1, 1.6, 6.5, 3
END SELECT
glEndList
NEXT i
NEXT t
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////
'// Draws a single piece via index using the gllist handle
SUB DrawPiece (team AS INTEGER, id AS INTEGER)
glCallList PieceLists(team, id)
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////
'// Uses Qb64 screen for mouse and grid settings/info
SUB Debug_Info
'// Get_Grid_Hack - This gets called in the main loop so no need for second call
CLS
PRINT "Raw Mouse: "; GDK_MouseX; ","; GDK_MouseY
IF hoverX <> -1 THEN '// over a specific cell on the board
PRINT "Grid: ["; hoverX; ","; hoverZ; "]"
ELSE
PRINT "Grid: [OUT OF BOUNDS]"
END IF
PRINT "--------------------------------"
PRINT "FPS : "; GDK_GetFPS
_DISPLAY
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////
'// A workaround to detect what cell the mouse is over - Not perfect but good enough - need to fix raycasting stuff to make perfect
SUB Get_Grid_Hack
mx! = GDK_MouseX: my! = GDK_MouseY
' --- AXIS TWEAKERS ---
' Row_Bias: If the "hit" is too high on the board, decrease this (e.g., 0.9)
' Row_Squish: Higher numbers (1.2+) stretch the back rows more.
Row_Bias! = 1.0
Row_Squish! = 1
' --- VERTICAL (ROW) CALC ---
' Target: Screen Y range 109 to 508
y_range! = 508 - 109
raw_v! = (my! - 109) / y_range!
' Crash protection for the exponent
IF raw_v! < 0 THEN raw_v! = 0
IF raw_v! > 1 THEN raw_v! = 1
IF hoverX < 0 OR hoverX > 7 OR hoverZ < 0 OR hoverZ > 7 THEN
hoverX = -1: hoverZ = -1
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////
'// Either sets ir unsets a selected piece - selected pieces bounce and should eventually highlight their possible routes
SUB Handle_Selection_Interaction
' 1. Check for Left Mouse Hit (GDK_MouseHit(1))
IF GDK_MouseClicked(1) = 0 THEN EXIT SUB
' 2. Ensure we are actually over a board tile
IF hoverX = -1 OR hoverZ = -1 THEN EXIT SUB
' 3. Check current board state at hover location
clicked_piece_id = Board(hoverX, hoverZ).id
clicked_piece_team = Board(hoverX, hoverZ).team
' 4. LOGIC: Selection Toggle
IF Arbiter.IsActive THEN
' If clicking the SAME piece again, deselect it
IF hoverX = Arbiter.SelectedX AND hoverZ = Arbiter.SelectedZ THEN
Arbiter.IsActive = 0
Arbiter.SelectedX = -1: Arbiter.SelectedZ = -1
ELSE
' If clicking a DIFFERENT piece belonging to you, switch selection
IF clicked_piece_id <> P_EMPTY AND clicked_piece_team = Arbiter.PlayerTeam THEN
Arbiter.SelectedX = hoverX
Arbiter.SelectedZ = hoverZ
END IF
' (Future logic: If clicking an empty square or enemy, try to MOVE)
END IF
ELSE
' If nothing is active, select the piece if it belongs to you
IF clicked_piece_id <> P_EMPTY AND clicked_piece_team = Arbiter.PlayerTeam THEN
Arbiter.IsActive = 1
Arbiter.SelectedX = hoverX
Arbiter.SelectedZ = hoverZ
END IF
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////
'// When a piece is chosen this function will highlight the places it can move too
SUB Render_Highlights
' Renders blue highlight tiles if a human player is active
IF Arbiter.IsActive AND Arbiter.Turn = Arbiter.PlayerTeam THEN
FOR x = 0 TO 7: FOR z = 0 TO 7
IF ValidMoves(x, z) = 1 THEN
glPushMatrix
glTranslatef (x * 4) - 14, 0.5, (z * 4) - 14
GDK_Quad_Clr 0.1, 0.3, 0.8, 0.5, 4, 4 ' Cool blue highlight
glPopMatrix
END IF
NEXT: NEXT
END IF
END SUB
' --- SETUP ---
IF GDK_Boot(800, 600, "TITAN GDK 2026 | S-Tier Terrain Demo", 0) = 0 THEN END
' Handle for the terrain
DIM myTerrain AS LONG
myTerrain = GDK_LoadTerrain("gdk\resources\Hill_hmap.png" + CHR$(0), "gdk\resources\hill_texture.png" + CHR$(0), 15.0, 50.0)
' Camera and Movement Variables
camX = 100.0
camZ = 500.0
speed = 120.0
rad = 0.01745329
' Clamp pitch to stop cartwheels
IF camPitch > 89.0 THEN camPitch = 89.0
IF camPitch < -89.0 THEN camPitch = -89.0
' Movement Vectors (Yaw Only)
fX = SIN(camYaw * rad)
fZ = -COS(camYaw * rad)
' Use the captured DT variable for all physics
IF GDK_Key(ASC("W")) OR GDK_Key(ASC("w")) THEN
camX = camX + fX * dt * speed
camZ = camZ + fZ * dt * speed
END IF
IF GDK_Key(ASC("S")) OR GDK_Key(ASC("s")) THEN
camX = camX - fX * dt * speed
camZ = camZ - fZ * dt * speed
END IF
' --- TEST THE TORCH SYSTEM ---
' Parameters: lightIndex, posX, posY, posZ, dirX, dirY, dirZ
' In Eye Space (after LookAt), 0,0,0 is the camera eye.
GDK_Torch_Test 1, camX, groundY, camZ, fX, SIN(camPitch * rad), fZ
SUB Light_Type
TYPE GDKLightPreset
PositionX AS SINGLE
PositionY AS SINGLE
PositionZ AS SINGLE
Power AS SINGLE
ColorR AS SINGLE
ColorG AS SINGLE
ColorB AS SINGLE
Ambient AS SINGLE
DirX AS SINGLE
DirY AS SINGLE
DirZ AS SINGLE
LightType AS LONG
Enabled AS LONG
Range AS SINGLE
InnerCutoff AS SINGLE
OuterCutoff AS SINGLE
END TYPE
END SUB
SUB GDK_Torch_Test (index, x, y, z, dx, dy, dz)
' This single SUB handles the UDT setup and the API calls
DIM tPreset AS GDKLightPreset
' Position and Direction passed from the main loop
tPreset.PositionX = x
tPreset.PositionY = y
tPreset.PositionZ = z
tPreset.DirX = dx
tPreset.DirY = dy
tPreset.DirZ = dz
' Commit to the GDK Indexed Light System
GDK_Light_SetType index, tPreset.LightType
GDK_Light_SetColor index, tPreset.ColorR, tPreset.ColorG, tPreset.ColorB, tPreset.Power
GDK_Light_SetRange index, tPreset.Range
GDK_Light_SetSpot index, tPreset.InnerCutoff, tPreset.OuterCutoff
GDK_Light_SetPos index, tPreset.PositionX, tPreset.PositionY, tPreset.PositionZ
GDK_Light_SetDir index, tPreset.DirX, tPreset.DirY, tPreset.DirZ
END SUB
For now TITAN GDK supports,
mdl, md2, md3, prm (Re Volt models (not finalised on placing springs and axles yet!)), stl and obj will follow soon but I've still not finished it!
Terrain from heightmaps (gonna add erosion methods and change the smoothing to be optional soon)
bsp(quake 1) maps
a simple 3d shapes library
PLEASE NOTE : ONLY WINDOWS COMPATIABLE ATM! (Though as the current dev is only legacy GL the features that aren't window/input based should be usable in native QB64 without much modification (please let me know if this is something you guys would like and ill make it happen).
It is still very much a work in progress but its getting there! Any comments, ideas or feedback (and negative is fine!) is welcomed! (For those not in the know, this is a culmination of like 15 years of dev work, learning and failing over and over, but now finally I think I'm on the right track!)
As part of another project I'm working on, I wanted to find a chess engine that I could use from QBJS. I ended up creating a simple wrapper for the js-chess-engine. I created the following simple screen 0 chess UI to test it out. Thought I would share it here.
I've tried to bring to life a my old application made with the oldest version of Inform.
But I have had no success, so I decided to make a new version... for not wasting my time I'm using InformPe in Windows11.
So I got no surprise!
It is a simple demo (not playable) of the classical Pong game. The ancient Pong!
Here you can get the source files distribution in 7zip file:
NewPongClone.7z (Size: 125.88 KB / Downloads: 7)
and here a .ZIP made under Kubuntu with its application Ark.
To get the application :
1 download the file
2 unpack the 7zip in your QB64pe folder
3 go in the NewPongClone folder
4 open NewPongClone.bas with QB64peIDE
5 compile hitting F5 or clicking on the Run menu
It is a demo for showing how using basic features of InformPE:
how to set colors (Background, Foreground, BorderColor) of items of application,
how to use disable items,
how to make animation with items,
how to use an image in Button item,
how to use the Frame item,
how to implement User routines in main module,
how to declare Global variable in main module
how to change on fly the properties of items of InformPE.
Welcome feedbacks
Lucky TempodiBasic
PS: I have followed the rule put informpe included files and folders into the folder of application to compile for distributing it.
Posted by: BlameTroi - 02-07-2026, 06:18 PM - Forum: Help Me!
- No Replies
Hi. 4.4.0 on a current M2 Mac. I was able to use the debugger yesterday (and thanks for it, very nice) but today I ran into problems. I was getting "Debug session aborted. Connection timed out."
It turns out that I had some dangling prior run screens that I hadn't closed correctly. I closed them and the debugger connects and runs well.
Hello team! I thought I would share a bit of fun code with graphical statements, to draw planets randomly. Trying to make it as beautiful as possible.
Code: (Select All)
Screen _NewImage(800, 600, 32)
_Title "20 Beautiful Planets in QB64PE"
Randomize Timer
Type PlanetData
x As Integer
y As Integer
radius As Integer
r As Integer
g As Integer
b As Integer
hasRings As Integer
ringAngle As Single
atmosphere As Integer
spots As Integer
End Type
Dim Shared Planets(1 To 20) As PlanetData
Dim Shared i As Integer
Dim Shared f As Long
f = _LoadFont("Arial.ttf", 16, "MONOSPACE")
If f > 0 Then _Font f
For i = 1 To 20
Planets(i).x = 70 + ((i - 1) Mod 5) * 150
Planets(i).y = 70 + ((i - 1) \ 5) * 120
Planets(i).radius = 20 + Rnd * 25
Planets(i).hasRings = IIf(Rnd > 0.5, -1, 0)
Planets(i).ringAngle = Rnd * _Pi
Planets(i).atmosphere = IIf(Rnd > 0.3, -1, 0)
Planets(i).spots = Int(Rnd * 8) + 2
Select Case i
Case 1: ' Blue gas giant
Planets(i).r = 50: Planets(i).g = 100: Planets(i).b = 200
Case 2: ' Red desert planet
Planets(i).r = 180: Planets(i).g = 80: Planets(i).b = 60
Case 3: ' Green jungle planet
Planets(i).r = 60: Planets(i).g = 150: Planets(i).b = 80
Case 4: ' Purple crystal planet
Planets(i).r = 150: Planets(i).g = 70: Planets(i).b = 200
Case 5: ' Orange lava planet
Planets(i).r = 220: Planets(i).g = 120: Planets(i).b = 40
Case 6: ' Ice planet
Planets(i).r = 200: Planets(i).g = 230: Planets(i).b = 250
Case 7: ' Brown rocky planet
Planets(i).r = 140: Planets(i).g = 110: Planets(i).b = 90
Case 8: ' Pink nebula planet
Planets(i).r = 230: Planets(i).g = 150: Planets(i).b = 200
Case 9: ' Yellow sun-like
Planets(i).r = 240: Planets(i).g = 220: Planets(i).b = 100
Case 10: ' Teal ocean planet
Planets(i).r = 70: Planets(i).g = 180: Planets(i).b = 170
Case 11: ' Maroon volcanic
Planets(i).r = 120: Planets(i).g = 40: Planets(i).b = 50
Case 12: ' Cyan gas giant
Planets(i).r = 80: Planets(i).g = 200: Planets(i).b = 220
Case 13: ' Gold metallic
Planets(i).r = 210: Planets(i).g = 180: Planets(i).b = 80
Case 14: ' Emerald green
Planets(i).r = 40: Planets(i).g = 180: Planets(i).b = 120
Case 15: ' Deep blue
Planets(i).r = 30: Planets(i).g = 70: Planets(i).b = 150
Case 16: ' Rust planet
Planets(i).r = 170: Planets(i).g = 90: Planets(i).b = 70
Case 17: ' Lilac planet
Planets(i).r = 180: Planets(i).g = 140: Planets(i).b = 220
Case 18: ' Turquoise
Planets(i).r = 70: Planets(i).g = 210: Planets(i).b = 190
Case 19: ' Copper
Planets(i).r = 190: Planets(i).g = 130: Planets(i).b = 100
Case 20: ' Violet storm
Planets(i).r = 130: Planets(i).g = 80: Planets(i).b = 180
End Select
Next i
Cls , _RGB32(5, 5, 20)
For i = 1 To 200
PSet (Rnd * 800, Rnd * 600), _RGB32(200 + Rnd * 55, 200 + Rnd * 55, 200 + Rnd * 55)
Next i
For i = 1 To 5
DrawNebula Rnd * 800, Rnd * 600, Int(Rnd * 100) + 50
Next i
For i = 1 To 20
DrawPlanet Planets(i)
Next i
Color _RGB32(180, 180, 255)
_PrintMode _KeepBackground
_PrintString (320, 550), "Press SPACE to regenerate"
_PrintString (350, 570), "Press ESC to exit"
Do
k$ = InKey$
If k$ = " " Then
Randomize Timer
For i = 1 To 20
Planets(i).radius = 20 + Rnd * 25
Planets(i).hasRings = IIf(Rnd > 0.5, -1, 0)
Planets(i).ringAngle = Rnd * _Pi
Planets(i).atmosphere = IIf(Rnd > 0.3, -1, 0)
Planets(i).spots = Int(Rnd * 8) + 2
Next i
Cls , _RGB32(5, 5, 20)
For i = 1 To 200
PSet (Rnd * 800, Rnd * 600), _RGB32(200 + Rnd * 55, 200 + Rnd * 55, 200 + Rnd * 55)
Next i
For i = 1 To 5
DrawNebula Rnd * 800, Rnd * 600, Int(Rnd * 100) + 50
Next i
For i = 1 To 20
DrawPlanet Planets(i)
Next i
Color _RGB32(180, 180, 255)
_PrintString (320, 550), "Press SPACE to regenerate"
_PrintString (350, 570), "Press ESC to exit"
End If
_Limit 30
Loop Until k$ = Chr$(27)
System
Sub DrawPlanet (p As PlanetData)
For r = p.radius To 0 Step -1
intensity = 0.3 + 0.7 * (r / p.radius)
Circle (p.x - 3, p.y - 3), r, _RGB32(p.r * intensity * 0.3, p.g * intensity * 0.3, p.b * intensity * 0.3)
Next r
For r = p.radius To 0 Step -1
intensity = 0.5 + 0.5 * (r / p.radius)
gradient = 0.7 + 0.3 * Sin(r * _Pi / p.radius)
Circle (p.x, p.y), r, _RGB32(p.r * intensity * gradient, p.g * intensity * gradient, p.b * intensity * gradient)
Next r
If p.atmosphere Then
For r = p.radius + 3 To p.radius + 10 Step 1
alpha = 50 - (r - p.radius - 3) * 7
If alpha > 0 Then
Circle (p.x, p.y), r, _RGBA32(p.r, p.g, p.b, alpha)
End If
Next r
End If
If p.hasRings Then
DrawRings p.x, p.y, p.radius, p.ringAngle, p.r, p.g, p.b
End If
DrawSurfaceDetails p.x, p.y, p.radius, p.spots, p.r, p.g, p.b
For r = p.radius \ 3 To 0 Step -1
intensity = 0.8 + 0.2 * (r / (p.radius \ 3))
Circle (p.x - p.radius \ 3, p.y - p.radius \ 3), r, _RGBA32(255, 255, 255, 100 * intensity)
Next r
End Sub
Sub DrawRings (x, y, radius, angle, r, g, b)
For ring = 1 To 3
ringRadius = radius + 15 + ring * 5
ringWidth = 3
For w = -ringWidth To ringWidth
For a = 0 To _Pi(2) Step 0.01
rx = ringRadius * Cos(a)
ry = (ringRadius + w) * Sin(a) * 0.3
rx2 = rx * Cos(angle) - ry * Sin(angle)
ry2 = rx * Sin(angle) + ry * Cos(angle)
distFromCenter = Abs(w) / ringWidth
alpha = 150 * (1 - distFromCenter)
ringColor = _RGBA32(r + 30, g + 30, b + 30, alpha)
PSet (x + rx2, y + ry2), ringColor
Next a
Next w
Next ring
End Sub
Sub DrawSurfaceDetails (x, y, radius, numSpots, baseR, baseG, baseB)
For spot = 1 To numSpots
angle = Rnd * _Pi(2)
distance = Rnd * radius * 0.8
spotX = x + distance * Cos(angle)
spotY = y + distance * Sin(angle)
spotSize = radius * (0.1 + Rnd * 0.2)
spotType = Int(Rnd * 3)
Select Case spotType
Case 0:
spotR = baseR * 0.5
spotG = baseG * 0.5
spotB = baseB * 0.5
Case 1:
spotR = _Min(255, baseR * 1.3)
spotG = _Min(255, baseG * 1.3)
spotB = _Min(255, baseB * 1.3)
Case 2:
spotR = _Min(255, baseG * 1.2)
spotG = _Min(255, baseB * 1.2)
spotB = _Min(255, baseR * 1.2)
End Select
For r = spotSize To 0 Step -1
alpha = 200 * (r / spotSize)
Circle (spotX, spotY), r, _RGBA32(spotR, spotG, spotB, alpha)
Next r
If Rnd > 0.7 Then
craterSize = spotSize * 0.5
Circle (spotX + craterSize * 0.3, spotY + craterSize * 0.3), craterSize, _RGB32(baseR * 0.3, baseG * 0.3, baseB * 0.3)
Circle (spotX + craterSize * 0.2, spotY + craterSize * 0.2), craterSize * 0.7, _RGB32(baseR * 0.7, baseG * 0.7, baseB * 0.7)
End If
Next spot
End Sub
Sub DrawNebula (x, y, size)
For i = 1 To 5
nx = x + (Rnd - 0.5) * size
ny = y + (Rnd - 0.5) * size
ns = size * (0.3 + Rnd * 0.3)
nr = 50 + Rnd * 100
ng = 50 + Rnd * 100
nb = 100 + Rnd * 100
For r = ns To 0 Step -1
alpha = 30 * (r / ns)
Circle (nx, ny), r, _RGBA32(nr, ng, nb, alpha)
Next r
Next i
End Sub
Function IIf% (condition, trueValue, falseValue)
If condition Then
IIf = trueValue
Else
IIf = falseValue
End If
End Function
I have tried it on two separate days with many variations on each day and failed to get the needed exe's to create new FRM file with the BAS file started.
Posted by: Magdha - 02-04-2026, 10:19 AM - Forum: In-Form
- No Replies
Start, stop & determine lap times - it's a stopwatch.
The program uses the following InForm objects:
Form
Button
ListBox
Unzip the file and extract the folder into your PEQB64 directory. In the IDE make sure that you have the Run Option “Save EXE in source folder” checked.
': Program by Fellippe Heitor
': This program uses
': InForm-PE for QB64-PE - v1.5.8 based upon InForm by Fellippe Heitor
': Copyright (c) 2025 QB64 Phoenix Edition Team
': https://github.com/QB64-Phoenix-Edition/InForm-PE
'-----------------------------------------------------------
OPTION _EXPLICIT
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED Stopwatch AS LONG
DIM SHARED TimeLB AS LONG
DIM SHARED StartBT AS LONG
DIM SHARED LapBT AS LONG
DIM SHARED StopBT AS LONG
DIM SHARED ListBox1 AS LONG
DIM SHARED start AS SINGLE, Running AS _BYTE
DIM SHARED second AS INTEGER, minute AS INTEGER, hour AS INTEGER
DIM SHARED elapsed AS SINGLE
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
END SUB
SUB __UI_OnLoad
__UI_DefaultButtonID = StartBT
END SUB
SUB __UI_BeforeUpdateDisplay
IF Running THEN
DIM theTime$
elapsed = TIMER - start
IF elapsed >= 1 THEN
second = second + 1
elapsed = elapsed - 1
start = start + 1
IF second >= 60 THEN
second = second - 60
minute = minute + 1
IF minute >= 60 THEN
minute = minute - 60
hour = hour + 1
END IF
END IF
END IF
DIM hour$: hour$ = RIGHT$("00" + LTRIM$(STR$(hour)), 2)
DIM min$: min$ = RIGHT$("00" + LTRIM$(STR$(minute)), 2)
DIM sec$: sec$ = RIGHT$("00" + LTRIM$(STR$(second)), 2)
DIM elapsed$: elapsed$ = MID$(STR$(elapsed), INSTR(STR$(elapsed), ".") + 1) + "000"
If you want to test it, remember to go to the first post to download the small lib and header file.
What's weird is that the code in the function should produce two parent strings in the output, Fruit123 and Meat. Instead, it produces Fruit123 and Meatt123. Note the extra t. Interesting that both are at different memory addresses, but I have a hunch, unless I goofed up something, the Var_SetString library function is somehow writing the second string over the longer first string, and then putting that Meatt123 into memory. Now if you run the third code box, where I simply moved the guts of the function (unchanged) into the main, the darn thing works. Why it fails to work properly if in the functions is not apparent to me at this time. Maybe a bug, or me being buggy.
It doesn't seem to matter if the variables are passed or changed to global. It does give some even weirder results if we put anotehr string variable in the function where we change...
a = Var_New: Var_SetString a, Parent: Var_Push MemSystem, a: Parent_Node = a
to...
q$ = Parent: Var_SetString a, q$: Var_Push MemSystem, a: Parent_Node = a
That outputs:
MeatFruit123
Weird. It combines them with this variable substitution, but overwrites the first characters of the fruit string when left in the original form. That's why I suspect this is the problem, and possibly a bug or maybe there is a way to clear the Var_SetString function.
BTW - Everything works fine with "Child" subroutine.
Any thoughts, or should we wait for John on this one?
Changing the program flow won't change the outcome. Call FOO: INT or INT: FOO and the results will be the same. It' the flipping of the SUB codes that influence the outcome. The coding order in the first example treats x as an integer, because the sub containing DEFINT was placed before the sub containing the Print statement. The results of Len(x) will be 2 bytes. Switch the subs in the code and x remains an undeclared default single, (so Len(x) will be 4 bytes) even if you call INT first.
Now here's one that nailed me decades ago, my first encounter with "Duplicate Definition".
Code: (Select All)
GoSub pete
Print MyArray(1)
End
pete:
ReDim MyArray(10)
MyArray(1) = 5
Return
So again the program flow seems like it should handle the situation, as the Gosub statement leads us to the Redim of the array, before we print the array value. Ah, but the coding order shows that from top down, we tried to print the value before we dimensioned the array. So the fix is simple, just remember to...
Code: (Select All)
ReDim MyArray(0) ' We'll increase this value in the Gosub.
GoSub pete
Print MyArray(1)
End
pete:
ReDim MyArray(10)
MyArray(1) = 5
Return
So please share other examples where coding order effects outcome, regardless of program flow, in this thread.
![[Image: immagine-2026-02-08-024146896.png]](https://i.ibb.co/gMSp4Xm0/immagine-2026-02-08-024146896.png)
