- Welcome to Interactive PowerBasic Forum.
Your resource for programming with PowerBASIC™
Recent posts
#1
Code to share / Re: Update halProment-7_13-09-...
Last post by Frank Brübach - Yesterday at 10:12:48 PMHere is the new little update7 of halProment with all new examples, Screenshots, new halPromIde24 IDE and new halProment DLL
#2
Code to share / Re: new: Cube collion openGl
Last post by Frank Brübach - Yesterday at 10:06:40 PMNew: OpenGL Cube Collision (simple)
Info: you must use Arrow Keys to move the Cube and noticed the collision
Arrow Keys: Up down left right
Info: you must use Arrow Keys to move the Cube and noticed the collision
Arrow Keys: Up down left right
Code Select
' cube and collision example, july-august 2024, frank bruebach
' 10-august-2024, halProment Basic
'
' the collision works fine here -> both cubes lays upon each other
' move cube with arrows up,down,left,right
'
$ sFile "cube-and-collision.exe"
$ title "cubes and collision simple"
int width=640
int height=480
uses proglscene ''OpenglSceneFrame
pindex 1
Type BoundingBox
minX As Single
maxX As Single
minY As Single
maxY As Single
minZ As Single
maxZ As Single
End Type
Dim cube1 As BoundingBox
Dim cube2 As BoundingBox
Dim cube1Pos As Single = 2
Dim cube2Pos As Single = -2
Dim cube1PosX As Single = 2
Dim cube1PosY As Single = -2
Dim cube2PosX As Single = 2
Dim cube2PosY As Single = -2
Function CheckCollision(ByRef box1 As BoundingBox, ByRef box2 As BoundingBox) As LONG
' Check if the bounding boxes overlap in the X dimension
If box1.maxX < box2.minX Or box1.minX > box2.maxX Then
Return False
End If
' Check if the bounding boxes overlap in the Y dimension
If box1.maxY < box2.minY Or box1.minY > box2.maxY Then
Return False
End If
' Check if the bounding boxes overlap in the Z dimension
If box1.maxZ < box2.minZ Or box1.minZ > box2.maxZ Then
Return False
End If
' If all dimensions overlap, there is a collision
Return True
End Function
sub Initialize(sys hWnd)
'=======================
end sub
'
'----------------------------------------------------------------------------------- //
sub DrawGlCube(ByRef rotangle As Single, ByVal posX As Single, ByVal posY As Single)
glLoadIdentity
glTranslatef(posX, posY, -7)
'glRotatef ang1,1.0, 1.0, 1.0 'rquad
glBegin GL_QUADS
glColor3f 0.0, 1.0, 0.0
glVertex3f 1.0, 1.0, -1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f 1.0, 1.0, 1.0
glColor3f 1.0, 0.5, 0.0
glVertex3f 1.0, -1.0, 1.0
glVertex3f -1.0, -1.0, 1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f 1.0, -1.0, -1.0
glColor3f 1.0, 0.0, 0.0
glVertex3f 1.0, 1.0, 1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f -1.0, -1.0, 1.0
glVertex3f 1.0, -1.0, 1.0
glColor3f 1.0, 1.0, 0.0
glVertex3f 1.0, -1.0, -1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f 1.0, 1.0, -1.0
glColor3f 0.0, 0.0, 1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f -1.0, -1.0, 1.0
glColor3f 1.0, 0.0, 1.0
glVertex3f 1.0, 1.0, -1.0
glVertex3f 1.0, 1.0, 1.0
glVertex3f 1.0, -1.0, 1.0
glVertex3f 1.0, -1.0, -1.0
glEnd
End sub
'----------------------------------------------------------------------------------- //
sub DrawGlCube2(ByRef rotangle As Single, ByVal posX As Single, ByVal posY As Single)
glLoadIdentity
'glRotatef ang1,1.0, 1.0, 1.0 'rquad
glTranslatef(posX, posY, -7)
glBegin GL_QUADS
glColor3f 0.0, 1.0, 0.0
glVertex3f 1.0, 1.0, -1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f 1.0, 1.0, 1.0
glColor3f 1.0, 0.5, 0.0
glVertex3f 1.0, -1.0, 1.0
glVertex3f -1.0, -1.0, 1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f 1.0, -1.0, -1.0
glColor3f 1.0, 0.0, 0.0
glVertex3f 1.0, 1.0, 1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f -1.0, -1.0, 1.0
glVertex3f 1.0, -1.0, 1.0
glColor3f 1.0, 1.0, 0.0
glVertex3f 1.0, -1.0, -1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f 1.0, 1.0, -1.0
glColor3f 0.0, 0.0, 1.0
glVertex3f -1.0, 1.0, 1.0
glVertex3f -1.0, 1.0, -1.0
glVertex3f -1.0, -1.0, -1.0
glVertex3f -1.0, -1.0, 1.0
glColor3f 1.0, 0.0, 1.0
glVertex3f 1.0, 1.0, -1.0
glVertex3f 1.0, 1.0, 1.0
glVertex3f 1.0, -1.0, 1.0
glVertex3f 1.0, -1.0, -1.0
glEnd
end sub
'------------------ //
sub Scene(sys hWnd)
'==================
'
static single ang1,angi1=1
static Single angle
static int fps
'
glClearColor 0.3, 0.3, 0.5, 0
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
'
glLoadIdentity
'
glClearColor 0.5, 0, 0, 0
glPushMatrix
'
glLoadIdentity
static int framecount
sys x,y
framecount++
gltranslatef -.5,.25,-4.0
glColor3f .99,.50,.50
glscalef .2,.2,.01 ''*** larger scale from ,06
gprint str(framecount)
'
glpopmatrix
'
glLoadIdentity
glpushMatrix
gltranslatef 2.0, 0.0, -4.0
'glClearColor 0.8, 0.3, 0.5, 0
glscalef .2,.2,.01
glRotatef 90.0,0,0,1
gprint "Hello openGL"
glPopMatrix
'
if not key[16] 'shift'
if key[37] then cube1PosX -= 0.1 ' to right side
if key[39] then cube1PosX += 0.1 ''
if key[38] then cube1PosY += 0.1 '' up ''
if key[40] then cube1PosY -= 0.1 '' down ''
if key[33] then cube1PosY += 0.1 '''page up
if key[34] then cube1PosY -= 0.1 '''page down
end if
' Update bounding boxes
cube1.minX = cube1PosX - 1
cube1.maxX = cube1PosX + 1
cube1.minY = cube1PosY - 1
cube1.maxY = cube1PosY + 1
cube1.minZ = -7 - 1
cube1.maxZ = -7 + 1
cube2.minX = cube2PosX - 1
cube2.maxX = cube2PosX + 1
cube2.minY = cube2PosY - 1
cube2.maxY = cube2PosY + 1
cube2.minZ = -7 - 1
cube2.maxZ = -7 + 1
' Clear the screen
glClear(GL_COLOR_BUFFER_BIT)
' Draw the cubes
'glEnable(GL_CULL_FACE)
DrawGlCube(angle, cube1PosX, cube1PosY)
DrawGlCube2(angle, cube2PosX, cube2PosY)
'glDisable(GL_CULL_FACE)
'------------------------------- // solved and corrected ----------- //
' Check for collision
If CheckCollision(cube1, cube2) Then
gltranslatef 4.0, 0.0, -4.0
glscalef .52,.52,.01
glRotatef 90.0,0,0,1
gprint "Collision!"
End If
'------------------------------- // solved and corrected ----------- //
'ang1+=angi1
if ang1>360 then ang1-=360
end sub
sub Release(sys hwnd)
'====================
end sub
#3
Code to share / Re: openGl Axis and coordinate...
Last post by Frank Brübach - Yesterday at 10:03:42 PMOpenGL example: Axis and coordinates
Code Select
' -- opgl test with axis and sin cos curves
' -- halProment by frank bruebach, 15-04-2024, 11-09-2024
'
$ sfile "axis-and-coordinates.exe"
$ title "Triangle and Axis with sin cos curves"
pro width=800
pro height=600
take proglscene
function KeyState(pro k) as pro
===============================
return GetAsyncKeyState(k) and 0x8000 'key down
end function
sub Initialize(sys hWnd)
'=======================
end sub
'
'--------------------------------------------- //
sub Scene(pro hWnd)
static single ang1, angi1 = 1
dim i as integer
dim x, y, angle as single
dim radius as single = 2.0
glClearColor 0.3, 0.3, 0.5, 0
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glLoadIdentity
gltranslatef 0.0, 0.0, -10.0 '-4.0
glrotatef ang1, 0.0, 0.0, 1.0
glBegin GL_TRIANGLES
glColor3f 1.0, 0.0, 0.0 : glVertex3f 0.0, 1.0, 0.0
glColor3f 0.0, 1.0, 0.0 : glVertex3f -1.0, -1.0, 0.0
glColor3f 0.0, 0.0, 1.0 : glVertex3f 1.0, -1.0, 0.0
glEnd
' Draw axis
glBegin GL_LINES
glLineWidth 2.0
gltranslatef 0,0,-6 '-1
glscalef 0.01,0.01,0.01
glColor4ub 250,50,0,0 ' X axis color
glVertex2i -500,0
glVertex2i 500,0
glColor4ub 0,0,255,0 ' Y axis color
glVertex2i 0,500
glVertex2i 0,-500
glEnd
glBegin GL_LINES
gltranslatef 0,0,-6
glscalef 0.5,0.5,0.5
glColor4ub 0,255,255,0
' -- some Marks on axes ---------- //
for i = -5 to 5 step 1.025
glVertex2i i, -0.5001
glVertex2i i, 0.5001
glVertex2i -0.5001, i
glVertex2i 0.5001, i
next
glEnd
' Draw rounded, smooth sine and cosine curves
'pro pi = 3.1415926536
glLineWidth 2.0
glColor4ub 255, 200, 0, 0
glBegin GL_LINE_STRIP
for i = -360 to 360
angle = i * 3.1415926536 / 180 ' Correct conversion from degrees to radians
glVertex2f i / 360.0 * 2.0 * 3.1415926536, sin(angle)
next
glEnd
glBegin GL_LINE_STRIP
glColor4ub 0, 255, 200, 0
for i = -360 to 360 'step 5
angle = i * 3.1415926536 / 180 ' Convert degrees to radians
glVertex2f i / 360.0 * 2.0 * 3.1415926536, cos(angle)
next
glEnd
'
'UPDATE ROTATION ANGLES
'----------------------
'
'ang1+=angi1
'if ang1>360 then ang1-=360
'
end sub
sub Release(sys hwnd)
'====================
end sub
'ends
#4
Code to share / Re: bstring example 2
Last post by Frank Brübach - Yesterday at 10:01:06 PMBstring example 2
You need the new update7 for this example See my Last Post below
You need the new update7 for this example See my Last Post below
Code Select
' -- >bstring example, 09-09-2024, halProment Basic, frank bruebach
'
take kons
dim smytry as bstring
smytry = "A1234@§"
pget smytry
p? STR(LEN(smytry)) ' 7
p? smytry
printl smytry
dim MyStr1 as string
MyStr1="Hello halProment"
p? STR(LEN(MyStr1)) ' 17
printl STR(LEN(MyStr1))
p? MyStr1
printl MyStr1
dim MyStr2 as bstring
MyStr2="Hello halProment2"
pget MyStr2
p? STR(LEN(MyStr2)) ' 18
printl STR(LEN(MyStr2))
p? MyStr2
printl MyStr2
dim str1 as bstring
str1="hello, world"
pget str1
p? str1
printl str1
p? STR(LEN(str1)) 'returns 12, the length of the string it contains
printl STR(LEN(str1))
p? STR(SIZEOF(str1)) 'returns 4
printl STR(SIZEOF(str1))
wait
' ends
#5
Code to share / Re: select a Hero example
Last post by Frank Brübach - Yesterday at 09:57:48 PMSelect a Hero example
Code Select
' input example and select case, halProment
' 21-08-2024, frank bruebach, 10-09-2024
'
take kons
'pindex 0
bstring st
printl "start" st
' Initialize user descriptions
pstring f1 = "I am more like thor " st
pstring f2 = "I am more like ironman " st
pstring f3 = "I am more like black widow " st
pstring f4 = "I am more like superman " st
pstring f5 = "I am more like batman " st
pstring f6 = "I am more like hawkeye " st
pstring f7 = "I am more like spiderman " st
pstring f8 = "I am more like captain america " st
pstring f9 = "I am more like my own heroe " st
' Display the menu
Printl "Choose the kind of heroe you are: " st
Printl "1. "+ f1
Printl "2. "+ f2
Printl "3. "+ f3
Printl "4. "+ f4
Printl "5. "+ f5
Printl "6. "+ f6
Printl "7. "+ f7
Printl "8. "+ f8
Printl "9. "+ f9
printl ""
'int le,i
printl st "Enter your choice (1-9): "
' Get user input
'Dim As string choice
dim choice as integer '' go :-)
color 0xf2
choice=input
color 0xf0
Print ""
' Debug and feedback section
Printl "DEBUG: User input length is "+ Len(choice)+ " character(s)."
Printl "DEBUG: User input is '"+ choice+ "'."
Printl ""
integer number
' Validate and process the user's choice
If Len(choice) = 1 Then
Select Case asc(choice)
Case "1"
Print "You selected: "+ f1
Case "2"
Print "You selected: "+ f2
Case "3"
Print "You selected: "+ f3
Case "4"
Print "You selected: "+ f4
Case "5"
Print "You selected: "+ f5
Case "6"
Print "You selected: "+ f6
Case "7"
Print "You selected: "+ f7
Case "8"
Print "You selected: "+ f8
Case "9"
Print "You selected: "+ f9
Case Else
Print " Invalid choice. Please enter a number between 1 and 9."
End Select
Else
Print " Error: Input length is invalid. Expected 1 character."
End If
Print ""
' End of program
color 0xf0
Print "Press any key to continue..."
wait
' ends
#6
Code to share / Update halProment-7_13-09-2024
Last post by Frank Brübach - Yesterday at 09:55:29 PMLittle example of Data types and size of>>
Code Select
' size of example 2, 11/13-09-2024 halProment, f.bruebach
' data types, part two
'
take kons
pstring st=chr(13,10)
printl "size of example for halProment data types" st
Printl SizeOf(Byte) st ' returns 1
Type mybar
a As Integer '4
b as float '4
c as long '4
d As Double '8
e as ulong '4
f as short '2
g as byte '1
h as char ' 1
j as int '4
End Type
Dim myfoo As mybar
Print SizeOf(myfoo) st ' returns 40
printl SizeOf(myfoo) st
Type mybar1
i as pstring ' 4
ii as p% '4
end type
Dim myfoo1 As mybar1
Print SizeOf(myfoo1) st ' returns 8
printl SizeOf(myfoo1) st
Type mybar2
l as quad '8
m as dword ' 4
n as qword ' 8
o as word ' 2
p as ubyte ' 1
q as string ' 4
r as bstr ' 4
s as zstring ' 1
t as wstring '4
u as bstring ' 4
End Type
Dim myfoo2 As mybar2
Print SizeOf(myfoo2) st ' returns 48
printl SizeOf(myfoo2) st
Type mybar3
v as single '4
w as bool ' 4
x as asciiz ' 4
y as uint ' 4
z as void '0 -> if you are chosing it alone it's 8
end type
Dim myfoo3 As mybar3
Print SizeOf(myfoo3) st ' returns 16
printl SizeOf(myfoo3) st
wait
' ends
#7
General Discussion / Re: The future of ... PowerBas...
Last post by Charles Pegge - Yesterday at 09:46:45 AMThe pwerbasic.com domain name is due to expire is due to expire one month from now:
https://www.whois.com/whois/powerbasic.com
see also:
Power Basic forum maybe going dark soon
https://forum.it-berater.org/index.php/topic,6477.msg27616.html#msg27616
https://www.whois.com/whois/powerbasic.com
see also:
Power Basic forum maybe going dark soon
https://forum.it-berater.org/index.php/topic,6477.msg27616.html#msg27616
#8
Contentious discussions about anything, the world, politics and health topics. / "GENES ARE NOT THE BLUEPRINT F...
Last post by Charles Pegge - Yesterday at 02:44:28 AMTheories of Everything with Curt Jaimungal
6 aug 2024
6 aug 2024
#9
General Discussion / Space X's Space Walk LIVE | Po...
Last post by Charles Pegge - September 12, 2024, 06:36:47 PMElon Musk News | Jared Isaacman | N18G
CNBC-TV18
-->
How SpaceX Mastered Space Suits
Primal Space
25 nov 2022
CNBC-TV18
-->
How SpaceX Mastered Space Suits
Primal Space
25 nov 2022
#10
General Discussion / Japan's Unconventional Solutio...
Last post by Charles Pegge - September 12, 2024, 10:30:07 AMExplained with Dom
10 oct 2023
10 oct 2023