| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
| _Hypot() Function |
|
Posted by: bplus - 06-24-2023, 03:38 PM - Forum: Keyword of the Day!
- Replies (7)
|
 |
Wiki help: https://qb64phoenix.com/qb64wiki/index.php/HYPOT
What wiki doesn't say is that this function contains a very useful Distance Formula between two points on a 2D plane.
Distance between two points (x1, y1) and (x2, y2) ( a diagram would be helpful here, sorry I am going to attempt in words only).
Distance = SQR((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
(x1 - x2) represents the length of one leg of a right triangle
(y1 - y2) represents the other leg
So by the Pythagorean Theorem the Hypotenuse (length) equals the SQR of the square (^2) of both sides.
ie Distance = _Hypot(x1 - x2), (y1 - y2))
The point is we have a Distance formula built-into the QB64 Functions and don't need to carry a Distance Function from our Toolbox of Subs and Functions.
I bring this up because I am kicking myself for missing it yesterday in the enRitchied Code for Missile Command here:
https://qb64phoenix.com/forum/showthread...8#pid17088
I shoulda, coulda, done it better like this:
Code: (Select All)
Option _Explicit ' Get into this habit and save yourself grief from Typos
_Title "Missile Command EnRitchied" ' another b+ mod 2023-06-24, replace distance with _Hypot.
' I probably picked up this game at the JB forum some years ago.
' Get Constants, Shared Variables and Arrays() declared. These Will Start with Capital Letters.
' Get Main module variables and arrays declared with starting lower case letters for local.
' This is what Option _Explicit helps, by forcing us to at least declare these before use.
' While declaring, telling QB64 the Type we want to use, we can also give brief description.
Const ScreenWidth = 800, ScreenHeight = 600 ' for our custom screen dimensions
Dim As Integer bombX, bombY ' incoming bomb screen position to shoot down
Dim As Single bombDX, bombDY ' DX and DY mean change in X position and Y position
Dim As Integer missileX, missileY ' missile position
Dim As Single missileDX, missileDY ' change X and Y of Missile position
Dim As Integer hits, misses ' score hits and misses
Dim As Integer mouseDistanceX, mouseDistanceY ' for calculations of missile DX, DY direction
Dim As Single distance ' ditto
Dim As Integer radius ' drawing hits with target like circles
Dim As Integer boolean ' to shorten the code line with a bunch of OR tests
Screen _NewImage(ScreenWidth, ScreenHeight, 32) ' sets up a graphics screen with custom dimensions
' the 32 is for _RGB32(red, green, blue, alpha) coloring.
'
_ScreenMove 250, 60 ' this centers screen in my laptop, you may need different numbers
InitializeForRound: ' reset game and start a round with a bomb falling
Cls
bombX = Rnd * ScreenWidth ' starts bomb somewhere across the screen
bombY = 0 ' starts bomb at top of screen
bombDX = Rnd * 6 - 3 ' pick rnd dx = change in x between -3 and 3
bombDY = Rnd * 3 + 3 ' pick rnd dy = change in y between 3 and 6, > 0 for falling
missileX = ScreenWidth / 2 ' missile base at middle across screen
missileY = ScreenHeight - 4 ' missile launch point at missile base is nearly at bottom of screen
missileDX = 0 ' missile is not moving awaiting mouse click for direction
missileDY = 0 ' ditto
distance = 0 ' distance of mouse click to missile base
Do
'what's the score?
_Title "Click mouse to intersect incoming Hits:" + Str$(hits) + ", misses:" + Str$(misses)
_PrintString (400, 594), "^" ' draw missle base = launch point
While _MouseInput: Wend ' poll mouse to get update
If _MouseButton(1) Then ' the mouse was clicked calc the angle from missile base
mouseDistanceX = _MouseX - missileX
mouseDistanceY = _MouseY - missileY
distance = (mouseDistanceX ^ 2 + mouseDistanceY ^ 2) ^ .5
missileDX = 5 * mouseDistanceX / distance
missileDY = 5 * mouseDistanceY / distance
End If
missileX = missileX + missileDX ' update missile position
missileY = missileY + missileDY ' ditto
bombX = bombX + bombDX ' update bomb position
bombY = bombY + bombDY ' ditto
' I am about to use a boolean variable to shorten a very long IF code line
' boolean is either 0 or -1 when next 2 statements are execued
' -1/0 or True/False is everything still in screen?
boolean = missileX < 0 Or missileY < 0 Or bombX < 0 Or bombY < 0
boolean = boolean Or missileX > ScreenWidth Or bombX > ScreenWidth Or bombY > ScreenHeight
If boolean Then ' done with this boolean
' reuse boolean to shorten another long code line checking if bomb and missile in screen
boolean = bombY > ScreenHeight Or missileX < 0 Or missileY < 0 Or missileX > ScreenWidth
If boolean Then misses = misses + 1
GoTo InitializeForRound
End If
' if the distance between missle and bomb < 20 pixels then the missile got the bomb, a hit
'If ((missileX - bombX) ^ 2 + (missileY - bombY) ^ 2) ^ .5 < 20 Then ' show a strike as target
'rewrite the above line using _Hypot() which is hidden distance forumla
If _Hypot(missileX - bombX, missileY - bombY) < 20 Then
For radius = 1 To 20 Step 4 ' draw concetric circles to show strike
Circle ((missileX + bombX) / 2, (missileY + bombY) / 2), radius
_Limit 60
Next
hits = hits + 1 ' add hit to hits score
GoTo InitializeForRound
Else
PSet (missileX, missileY), &HFFFFFF00 ' draw your missle yellow
PSet (bombX, bombY), &HFF0000FF ' draw bomb blue
End If
_Limit 20
Loop
Update: testing what happens when I edit this post and save.
Update again: lost the nice edge on right side, can I get it back? No I guess not.
|
|
|
Fake space music |
|
Posted by: mnrvovrfc - 06-23-2023, 06:55 PM - Forum: Utilities
- Replies (2)
|
 |
I was supposed to go further with my "musak" creators for PLAY, but decided this time to provide something different. This was an idea I already revealed. I would like to thank Mr.Why from the old forum, from the one Galleon was administrator, for inspiring me many years ago into stuff like this.
This is a program that does silly "space music". It creates an empty QB64 screenie because I'm not a good artist, I focused only on the sound. Press [ESC] to quit. Don't panic if it doesn't leave straight away, give it 3 seconds at least until the sound dies away.
This purposely does 440 samples to generate sound or not, then checks if it could create a new voice. Usually the "space dot" is created which is very brief. At other times, it could create a whitenoise wash (would like to be able to produce a brown or pink noise here instead), or it could create a "space rumble" although not a very good one maybe because the pitches are a bit too high.
There are two constants that could be adjusted near the top of the program. I don't recommend changing "NUMNOISE" to a value near "NUMSOUNDS", otherwise the program will choose the "deep" noises more often than the "dots".
Code: (Select All)
'by mnrvovrfc 23-June-2023
OPTION _EXPLICIT
CONST NUMSOUNDS = 50, NUMNOISE = 10
'active = the voice is active (1=dot random sine; 2=whitenoise; 3=deep space "rumble" sine)
'enable = the voice is being sent to audio output
' (after amplitude envelope goes through attack and release, this is set to zero and "hold" is updated)
'freq = voice frequency, could be changed by "tun"
'acount = amplitude attack increment in degrees
'rcount = amplitude release increment in degrees
' these two operate over half a sinewave to do an amplitude envelope
'a = degrees for amplitude envelope
't = time according to computation in QB64 Wiki example for _SNDRAW
'vol = volume adjustment for the voice
'tun = small change in frequency only for active=3
'hold = after the voice stops being enabled, how long to hold until making this voice available again
' this is a count in samples so depends on sampling rate
' I assumed 44100Hz so this could go for as long as four seconds but not less than 1/4-second
' this is to prevent the sound scape from being too thick
TYPE spacemtype
AS _BYTE active, enable
AS SINGLE freq, acount, rcount, tun, vol, a
AS LONG t, hold
END TYPE
DIM SHARED s(1 TO NUMSOUNDS) AS spacemtype
DIM AS INTEGER kount, i, j, o
DIM AS SINGLE twopi, ao, ag, samprate
twopi = _PI * 2
samprate = _SNDRATE
RANDOMIZE TIMER
_TITLE "Fake Cosmos!"
DO
IF kount < NUMNOISE THEN
kount = kount + 1
createnewsound Rand(2, 3)
ELSE
createnewsound 1
END IF
FOR o = 1 TO 440
ag = 0
FOR i = 1 TO NUMSOUNDS
IF s(i).active THEN
s(i).t = s(i).t + 1
IF s(i).a > 90 THEN
s(i).a = s(i).a + s(i).rcount
ELSE
s(i).a = s(i).a + s(i).acount
END IF
IF s(i).a > 180 THEN
s(i).enable = 0
s(i).hold = s(i).hold - 1
IF s(i).hold < 1 THEN
IF s(i).active > 1 THEN kount = kount - 1
s(i).active = 0
EXIT FOR
END IF
END IF
IF s(i).enable THEN
IF s(i).freq THEN
ao = s(i).freq
IF s(i).tun THEN s(i).freq = s(i).freq + s(i).tun
ELSE
ao = Random1(7900) + 100
END IF
ao = ao / samprate
ao = (SIN(ao * twopi * s(i).t) * s(i).vol * SIN(_D2R(s(i).a)))
ag = ag + ao
END IF
END IF
NEXT 'i
IF ag < -1.0 THEN ag = -1.0
IF ag > 1.0 THEN ag = 1.0
_SNDRAW ag
NEXT 'o
DO WHILE _SNDRAWLEN > 3
_LIMIT 100
IF _KEYDOWN(27) THEN EXIT DO
LOOP
LOOP UNTIL _KEYDOWN(27)
DO WHILE _SNDRAWLEN
_LIMIT 100
LOOP
SYSTEM
SUB createnewsound (which)
DIM AS INTEGER i, j
FOR i = 1 TO NUMSOUNDS
IF s(i).active = 0 THEN j = i: EXIT FOR
NEXT i
IF j = 0 THEN EXIT SUB
s(j).active = which
s(j).enable = 1
s(j).a = 0
IF which = 1 THEN
s(j).freq = Rand(5, 80) * 50
s(j).acount = Rand(30, 100) / 100
s(j).rcount = Rand(30, 100) / 100
s(j).tun = 0
s(j).vol = Rand(10, 50) / 100
s(j).hold = 0
ELSEIF which = 2 THEN
s(j).freq = 0
s(j).tun = 0
s(j).acount = Rand(7, 50) / 10000
s(j).rcount = Rand(25, 100) / 2000
s(j).vol = 0.0625
s(j).hold = Rand(11025, 88200)
ELSEIF which = 3 THEN
s(j).freq = Rand(80, 240)
s(j).acount = Rand(25, 100) / 2000
s(j).rcount = Rand(7, 50) / 10000
s(j).vol = 0.125
s(j).hold = Rand(22050, 176400)
IF Random1(3) = 1 THEN
IF s(j).freq > 160 THEN s(j).tun = -1 ELSE s(j).tun = 1
s(j).tun = s(j).tun * Random1(100) / 1E+6
ELSE
s(j).tun = 0
END IF
END IF
END SUB
FUNCTION Rand& (fromval&, toval&)
DIM sg%, f&, t&
IF fromval& = toval& THEN
Rand& = fromval&
EXIT FUNCTION
END IF
f& = fromval&
t& = toval&
IF (f& < 0) AND (t& < 0) THEN
sg% = -1
f& = f& * -1
t& = t& * -1
ELSE
sg% = 1
END IF
IF f& > t& THEN SWAP f&, t&
Rand& = INT(RND * (t& - f& + 1) + f&) * sg%
END FUNCTION
FUNCTION Random1& (maxvaluu&)
DIM sg%
sg% = SGN(maxvaluu&)
IF sg% = 0 THEN
Random1& = 0
ELSE
IF sg% = -1 THEN maxvaluu& = maxvaluu& * -1
Random1& = INT(RND * maxvaluu& + 1) * sg%
END IF
END FUNCTION
|
|
|
|
| Problem with DRAW or my "scanning" routine? |
|
Posted by: James D Jarvis - 06-23-2023, 04:34 PM - Forum: Help Me!
- Replies (9)
|
 |
Is the problem with my scanning/conversion routine or how DRAW actually draws?
(The draw statements it produces could be optimized to be briefer, I just haven't done that here. I want to get the scanning and rendered correctly first).
Code: (Select All) '***************************************************************
'scanning a section of the screen converting and writing it with DRAW
'why doesn't it work?
'***************************************************************
Screen _NewImage(480, 400, 256)
$Console
_Console Off
Randomize Timer
Cls
_PrintMode _KeepBackground
_PrintString (0, 0), "AB"
'Line (1, 1)-(1, 14), 15
_Delay 0.5
msg$ = "<-- scanning this as a sample image"
_PrintString (40, 0), msg$
x = 0: y = 0
dd$ = ""
wid = 16
ht = 16
Draw "s4"
dd$ = Scan_draw$(x, y, ht, wid)
_Delay 1
Locate 4, 4
Line (40, 0)-(40 + Len(msg$) * 8, 15), 0, BF
msg$ = "ready (press any key)"
_PrintString (0, 100), msg$
Sleep
Line (0, 100)-(Len(msg$) * 8, 115), 0, BF
Locate 4, 4
Print "Draw Scanned image, Why isn't it drawing correctly?"
Print "Is the problem in the scanning routine or in how draw functions?"
putdraw 50, 0, dd$
drawto_console dd$
Input alldone$
End
'***************************************************************
' subroutines for making use of draw strings in 256 color mode.
' color 0 is treated as transpaernt
Sub putdraw (xx, yy, dd$)
Draw "bm" + Str$(xx) + "," + Str$(yy) + dd$
End Sub
Sub drawto_console (dd$)
'program must have console output activated earlier
'prints the string in a clean console window so it may be copied and pasted on any system with console support
sd& = _Dest
_Console On
_Dest _Console
Cls
Print dd$
Print
Print "Copy and Paste the above text for future use in DRAW commands"
_Dest sd&
End Sub
Function Scan_draw$ (sx, sy, ht, wid)
'scan a screen area starting at point sx,sy and saving it to the string DRW$ for use in later draw commands
'simply scans each row and tracks color changes
For y = 0 To ht - 1
x = 0
Do
klr = Point(sx + x, sy + y)
n = -1
Do
n = n + 1
nklr = Point(x + n, y)
Loop Until nklr <> klr Or x + n >= wid
If klr = 0 Then
dd$ = dd$ + "br" + _Trim$(Str$(n))
Else
dd$ = dd$ + "C" + _Trim$(Str$(klr)) + " " + "R" + _Trim$(Str$(n))
End If
x = x + n
Loop Until x >= wid
dd$ = dd$ + "bd1bl" + Str$(wid)
Next y
Scan_draw$ = dd$
End Function
|
|
|
|
| Numbers at end of Play strings |
|
Posted by: PhilOfPerth - 06-23-2023, 05:41 AM - Forum: Terry Ritchie
- Replies (13)
|
 |
In some music strings (eg. the William Tell Overture presented in the Tutorial), quite a lot of lines
end with a number (mostly 4 or 8), that's not related to length or anything that I can identify.
Are they just "strays", or is there a function that's not documented?
|
|
|
|
| What extra features does VARPTR provide? |
|
Posted by: PhilOfPerth - 06-22-2023, 03:53 AM - Forum: Help Me!
- Replies (10)
|
|
I'm in trouble again!
I'm experimenting with VARPTR$ and built the experimental prog below, to compare with a sample given in Help that uses VARPTR$.
It seems I can get the same result without VARPTR$, so I don't see the reason for using it.
What am I missing?
Code: (Select All) Screen 2
Cls
WIND$ = "r10 d7 l10 u7 br20" ' wind$ is a rectangle and "blind" move to right
ROW$ = WIND$ + WIND$ + WIND$ + WIND$ + "bl80 bd11" ' row$ is four wind$, and "blind" moves left and down
For a = 1 To 4: Draw ROW$: Next ' draw four rows of wind$
Sleep: Cls ' and to include the TA feature...
WIND$ = "ta45 r10 d7 l10 u7 br20"
ROW$ = WIND$ + WIND$ + WIND$ + WIND$ + "bl80 bd11"
For a = 1 To 4: Draw ROW$: Next
|
|
|
|
| Console Multi_prompt Input |
|
Posted by: James D Jarvis - 06-20-2023, 02:21 PM - Forum: Utilities
- Replies (4)
|
|
Use the Console for multi-prompt inputs.
The routine is shown here with a simple example.
Code: (Select All) 'Console multi_input
'
'an example program for a routine to use the console window for multi-line input prompts
$Console
_Console Off 'turn off the console for now
_Delay 0.1
Print "Press any key when ready."
Sleep
Cls
Dim p$(5), aa$(5)
'setup the input prompts
p$(1) = "First Name : "
p$(2) = "Middle : "
p$(3) = "Last Name : "
p$(4) = "Street : "
p$(5) = "City/Town : "
multi_input "Multi_Input Sample", p$(), aa$()
Print aa$(3); ", "; aa$(1); " "; aa$(2)
Print aa$(4); ", "; aa$(5)
End
Sub multi_input (cptitle$, prompt$(), ia$())
'cptitle$ is the console prompt title
'prompt$() array of prompts
'ia$() array of input data
ind& = _Dest 'get the screen
_Console On 'turn the console back on
If cptitle$ = "" Then _ConsoleTitle "Prompt" Else _ConsoleTitle cptitle$ 'set the console title
_ScreenHide 'hide the mainscreen
_Dest _Console
Cls 'clear the console
mi = UBound(prompt$) 'check how many entries are being asked for
For n = 1 To mi 'print the prompts
Print prompt$(n)
Next n
Locate 1, 1 'reset cursor to top left corner
For n = 1 To mi 'reprint prompts and get the input
Print prompt$(n);
Input ia$(n)
Next n
_ScreenShow
_Dest ind&
_Console Off
End Sub
|
|
|
|
|
![[Image: 7-JRace-QB64-PE-Summer-Edition-created-w...itchie.png]](https://i.ibb.co/QPRkDdV/7-JRace-QB64-PE-Summer-Edition-created-with-qb64pe-program-modification-of-terry-ritchie.png)
![[Image: screenshot2.png]](https://i.ibb.co/jhCp8YS/screenshot2.png)
![[Image: screenshot3.png]](https://i.ibb.co/Xb7f52p/screenshot3.png)
![[Image: screenshot4.png]](https://i.ibb.co/xgXyJTM/screenshot4.png)
![[Image: Screenshot-2023-07-23-042302.png]](https://i.ibb.co/H2cfnnG/Screenshot-2023-07-23-042302.png)
