| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
| Explosions - Handy Drawing Tool |
|
Posted by: bplus - 02-09-2023, 04:27 AM - Forum: Utilities
- Replies (1)
|
 |
I got tired of reinventing the wheel for explosions so I made a handy drawing tool. Just give it the x, y location, the diameter = spread to cover and red, green, blue colors to use. It will calculate the number of dots, frames and speeds needed for decent explosion and set that up with DrawDots sub.
This is my test code for developing Explode:
Code: (Select All) Option _Explicit
_Title "Explosions test" 'b+ revisit 2023-02-08
Const xmax = 800, ymax = 600
Screen _NewImage(xmax, ymax, 32)
_ScreenMove (1280 - xmax) / 2 + 30, (760 - ymax) / 2
Randomize Timer
Type particle ' ===================================== Explosions Setup
As Long life, death
As Single x, y, dx, dy, r
As _Unsigned Long c
End Type
Dim Shared nDots
nDots = 2000
ReDim Shared dots(nDots) As particle ' ==============================
Dim As Long mx, my, mb
Do
Cls
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
Circle (mx, my), 5
If mb Then
' explode sets up dots and runs them out over several loops
Explode mx, my, 100, 0, 120, 40
Circle (mx, my), 100
_Display
_Delay .2 ' alittle delay for user to release mousebutton
End If
DrawDots
_Display
_Limit 30 ' or 60
Loop
Print "done"
' explode sets up old dead particles for display for a life
' This sub sets up Dots to display with DrawDots
' this sub uses rndCW
Sub Explode (x, y, spread, cr, cg, cb)
' x, y explosion origin
' spread is diameter of area to cover from it number of dots, number of frames and speed are calculated
' setup for explosions in main
'Type particle
' As Long life, death
' As Single x, y, dx, dy, r
' As _Unsigned Long c
'End Type
'Dim Shared nDots
'nDots = 2000
'ReDim Shared dots(nDots) As particle
Dim As Long i, dotCount, newDots
Dim angle, speed, rd, rAve, frames
newDots = spread / 2 ' quota
frames = spread / 5
speed = spread / frames ' 0 to spread in frames
rAve = .5 * spread / Sqr(newDots)
For i = 1 To nDots ' find next available dot
If dots(i).life = 0 Then
dots(i).life = 1 ' turn on display
dots(i).death = frames
angle = _Pi(2 * Rnd)
dots(i).x = x: dots(i).y = y ' origin
rd = Rnd
dots(i).dx = rd * speed * Cos(angle) ' moving
dots(i).dy = rd * speed * Sin(angle)
dots(i).r = RndCW(rAve, rAve) ' radius
dots(i).c = _RGB32(cr + Rnd * 40 - 20, cg + Rnd * 40 - 20, cb + Rnd * 40 - 20) 'color
dotCount = dotCount + 1
If dotCount >= newDots Then Exit Sub
End If
Next
End Sub
Sub DrawDots ' this sub needs fcirc to Fill Circles and Sub Explode sets up the Dots to draw.
' setup in main for explosions
'Type particle
' As Long life, death
' As Single x, y, dx, dy, r
' As _Unsigned Long c
'End Type
'Dim Shared nDots
'nDots = 2000
'ReDim Shared dots(nDots) As particle
Dim As Long i
For i = 1 To nDots ' display of living particles
If dots(i).life Then
FCirc dots(i).x, dots(i).y, dots(i).r, dots(i).c
' update dot
If dots(i).life + 1 >= dots(i).death Then
dots(i).life = 0
Else
dots(i).life = dots(i).life + 1
' might want air resistence or gravity added to dx or dy
dots(i).x = dots(i).x + dots(i).dx
dots(i).y = dots(i).y + dots(i).dy
If dots(i).x < 0 Or dots(i).x > xmax Then dots(i).life = 0
If dots(i).y < 0 Or dots(i).y > ymax Then dots(i).life = 0
dots(i).r = dots(i).r * 1 - (dots(i).life / dots(i).death) ' puff!
If dots(i).r <= 0 Then dots(i).life = 0
End If
End If
Next
End Sub
'from Steve Gold standard
Sub FCirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Function RndCW (C As Single, range As Single) 'center +/-range weights to center
RndCW = C + Rnd * range - Rnd * range
End Function
|
|
|
| The Window Closer X |
|
Posted by: Ron - 02-08-2023, 06:58 PM - Forum: Help Me!
- Replies (7)
|
 |
Hello everyone, I am using the QB64 for windows compatibility converted all the QB 4.5 to QB64 it has been working for 6 years now. Anyway one of my users asked me to disable the X on closing the program because they didn't want it to close in the middle of what they were doing so I put in the the command 'ex = _EXIT'. This works like it states you can't close the program with the X on the window. Now to kill the program when it freezes they have to kill the process in windows. Is there a why to use ON KEY to close it? I have tried ON KEY(1) with a subroutine and GOSUB it will not do the code when I press F1 so somehow the ON KEY is not working for me. I am using QB64 Version 1.1 Revision 20170120/51 does it work in more recent versions and where do I find them now. Alt + F4 should be what the Window close X button uses I think but maybe I am wrong.
Is there anyone that may know something to help me or should I leave it the way it is.
|
|
|
|
| Welcome to 2023. |
|
Posted by: eoredson - 02-08-2023, 03:39 AM - Forum: Help Me!
- Replies (5)
|
 |
Hi,
Happy belated 2023! This is a program to display the factors of 2023:
Code: (Select All) Year = 2023
z = Year - 1
Do Until z = Year
z = z + 1
x = z
Print x; "=";
l = 1
q = 0
Do Until x = 1
l = l + 1
Do While x / l = x \ l ' continue to divide number
q = q + 1
If q > 1 Then
Print "*";
End If
Print l;
x = x / l
Loop
If l > Int(z / 2) Then ' test for maximum divisor
Exit Do
End If
If l > Int(Sqr(x)) Then ' test maximum divisor is prime
If q = 0 Then
Exit Do
End If
End If
Loop
If q = 0 Then ' display number is prime
Print " (prime)";
End If
Print
Loop
End
|
|
|
|
| some suggestions / requests for anyone looking to port a classic game to QB64PE |
|
Posted by: madscijr - 02-07-2023, 10:20 PM - Forum: General Discussion
- Replies (12)
|
 |
Hey all!
After Terry's killer version of Pac Man and RokCoder's Galaga, I'm compelled to list a few that may be beyond my current skillset, patience level, and/or free time, but which would make the world a better place if they existed...
- Pinball Construction Set
- Zaxxon / Super Zaxxon - except let the player have full freedom of motion to fly in any direction (i.e. the plane can turn 360 degrees like in Time Pilot or Asteroids) and maybe even land and the player can get out and run around isometrically (like Realm of Impossibility), and maybe pilot other vehicles (like Frontline)! And a level editor!
- Gravitar - the vector game, but maybe with multiplayer (split screen or quad split screen) options and a level editor of course.
- Cliff Hanger - the C64 game which is basically like the old Road Runner cartoon
- Sprint 8 / Super Sprint - top down racing fun
- Jumpman / Jumpman Jr. / Ultimate Wizard - with level editor
- Tempest with level editor
- Defender / Stargate
- Mr. Do! / Dig Dug or maybe a combination of the 2
- Lode Runner (the 8-bit C64 or IBM version) with editor
- Racing Destruction Set
- Spy vs Spy
- Ultima III Construction Set
- a Zork game construction set
- Berzerk / Outlaw / Gunfighter but for 2-4 players with an editor
- Atari Adventure Construction Set (maybe multiplayer option too)
- Pitfall! and/or Pitfall II (with editor)
- Mail Order Monsters
(I would happily program all of the above but I'm still working on Spacewar! and maybe a Lunar Lander / Asteroids mashup, and a Pong Construction Set, maybe eventually one for multiplayer controllable with multiple USB mice plugged into a single PC!)
That's all I got for now -
Cheers
|
|
|
|
| SEEK with INPUT for variable length strings |
|
Posted by: SMcNeill - 02-07-2023, 07:28 PM - Forum: SMcNeill
- Replies (2)
|
 |
Code: (Select All) OPEN "data.txt" FOR OUTPUT AS #1
OPEN "data.ndx" FOR RANDOM AS #2 LEN = 4 'one long variable in size
DIM ndx AS LONG 'that long variable I mentioned above
DIM text AS STRING 'and a random length string
DIM count AS LONG 'and a counter for which element we want
DO
ndx = LOF(1) + 1
PUT #2, , ndx
READ text$
PRINT #1, text$
LOOP UNTIL text$ = "EOD"
CLOSE #1
OPEN "data.txt" FOR INPUT AS #1
'now we have a data file that we can use input with and read any record out of at will
DO
INPUT "Which record would you like to retrieve =>"; count
IF count = 0 THEN SYSTEM
GET #2, count, ndx
SEEK #1, ndx
INPUT #1, text
PRINT "That record was: "; text
LOOP
1
DATA one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve
DATA thirteen,fourteen,fiveteen,sixteen,seventeen,eighteen,nineteen,tenteen,eleventeen,twelveteen,EOD
|
|
|
|
| Spoilers |
|
Posted by: SMcNeill - 02-07-2023, 02:08 AM - Forum: Site Suggestions
- Replies (8)
|
|
mnrv posted elsewhere about "It'd be nice if this site offered spoiler type code to hide stuff"... (Or similar as I didn't bother to find the exact quote. I'm lazy.)
We do!!
Show Content
SpoilerThis is a default spoiler
Show Content
You guys will never believe this! This is a spoiler with a custom highlight title!
And that's basically it for the two formats our spoiler command supports. Code to produce the above is in the code box below:
Code: (Select All) [spoiler]This is a default spoiler[/spoiler]
[spoiler=You guys will never believe this! ]This is a spoiler with a custom highlight title![/spoiler]
It's not part of the quick edit box buttons, but it *is* something we support. 
|
|
|
|
| JSON in QB64 |
|
Posted by: SpriggsySpriggs - 02-06-2023, 09:26 PM - Forum: General Discussion
- Replies (3)
|
 |
You all can mostly ignore this. I'm posting this so I don't lose it. However, I'll make a full post once I make it better.
Code: (Select All) Option Explicit
$NoPrefix
$Console:Only
Print GetEdiSchemaKey("$edi.transactionSets.heading.beginning_segment_for_ship_notice_BSN")
Function GetEdiSchemaKey$ (keyPath As String)
GetEdiSchemaKey = pipecom_lite("PowerShell -NoProfile $edi = (Get-Content -Path " + Chr$(34) + "C:\Users\zspriggs\Downloads\edi856.json" + Chr$(34) + " ^| ConvertFrom-Json);" + keyPath + " ^| ConvertTo-Json")
End Function
'$Include:'pipecomqb64.bas'
|
|
|
|
| Why does my Loop end after 11 Loops? |
|
Posted by: Dimster - 02-06-2023, 07:08 PM - Forum: Help Me!
- Replies (69)
|
|
I have a file with over 28,000 data items. They are stored in the file in groups of 7. I have often OPENed this file, Inputed 7 items at a time and worked on each item before grabbing the next 7 data items.
The code goes
Open File
Do While Not EOF
For i = 1 to 7:Input DataItem(i): Next
Call Subroutine to work on these 7 data items
Loop
I have never had a problem looping thru the entire data file however recently I been working with Recursion and changed the routine to
Open File
Recur
Sub Recur
LoopRecur = LoopRecur + 1
Seek #1, 1
for i = 1 to 7:Input DataItem(i):Next
DataCount = DataCount + 7
Call Subroutine to work on these 7 data items
if DataCount < 4000 then Recur
End Sub
So I'm scratching my head when this recursive routine only performs 11 loops and the program just stops running. That number 11 brings to mind a possible un-dimensioned variable or perhaps a dynamic array that has gobbled up memory. I can't find anything like that in my program (which has thousands of lines of code so I could be missing it). On the other hand, could this recursive code simply be the culprit in memory munch whereas the original Do While did not munch memory?
|
|
|
|
|
