Well here it is, musak! But this is just one example. If allowed it plays five songs at a time, each song is about a minute long. Press [ESC] key to leave.
Code: (Select All)
'by mnrvovrfc 18-June-2023
'requires QB64 Phoenix Edition v3.8 or later
OPTION _EXPLICIT
REDIM scales(1 TO 1) AS STRING
DIM sequ(1 TO 2, 1 TO 20) AS INTEGER
DIM SHARED thiscale(1 TO 5) AS INTEGER, altscale(1 TO 5) AS INTEGER
DIM AS INTEGER i, lscales, song, si, so, u, basenote, numnote, athird
DIM AS INTEGER down
DIM e$
RANDOMIZE TIMER
RESTORE scaleslist
READ e$
DO UNTIL e$ = "END"
lscales = lscales + 1
IF lscales > 1 THEN
REDIM _PRESERVE scales(1 TO lscales) AS STRING
END IF
scales(lscales) = e$
READ e$
LOOP
PRINT "Now if only we have some animation!"
_TITLE "Press [ESC] to quit, [SPACE] for next song."
FOR song = 1 TO 5
PRINT: PRINT "Song"; song
u = Rand(18, 24) * 2
basenote = u
down = 0
si = Random1(lscales)
DO
so = Random1(lscales)
LOOP WHILE si = so
thiscale(1) = basenote
FOR i = 1 TO 4
basenote = basenote + VAL(MID$(scales(si), i, 1))
if basenote > 84 then down = 12
thiscale(i + 1) = basenote
NEXT
for i = 1 to 5
thiscale(i) = thiscale(i) - down
next
basenote = u
down = 0
altscale(1) = basenote
FOR i = 1 TO 4
basenote = basenote + VAL(MID$(scales(so), i, 1))
if basenote > 84 then down = 12
altscale(i + 1) = basenote
NEXT
for i = 1 to 5
altscale(i) = altscale(i) - down
next
DO WHILE PLAY(0) > 0
_LIMIT 600
IF _KEYDOWN(32) THEN EXIT DO
IF _KEYDOWN(27) THEN EXIT DO
LOOP
IF _KEYDOWN(27) THEN EXIT FOR
DO : LOOP WHILE _KEYDOWN(32)
NEXT 'song
SYSTEM
scaleslist:
DATA "3334","3344","3444","3445","3454","3545","4545","4543","3456","4565","4546"
DATA "4556","4666","5666","5444","5334","5355","5463","6444","6445","6366","6463"
DATA "END"
FUNCTION en$ (topval AS INTEGER)
en$ = "N" + _TRIM$(STR$(thiscale(Random1(topval))))
END FUNCTION
FUNCTION enft$ (fromval AS INTEGER, totoval AS INTEGER)
enft$ = "N" + _TRIM$(STR$(thiscale(Rand(fromval, totoval))))
END FUNCTION
FUNCTION anft$ (fromval AS INTEGER, totoval AS INTEGER)
anft$ = "N" + _TRIM$(STR$(altscale(Rand(fromval, totoval))))
END FUNCTION
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
One fault with this program is that it doesn't play phrases (or "hooks", don't know how to say it out of the popular music industry) so one could recognize which song it is LOL. This program creates music which is too random. I programmed the "phrases" thing half-successfully with my Lua script for "1bitr". With "phrases" this program could make a good companion to bplus' program indicated in this thread:
Purposely I set the songs playing fairly fast, ie. using "L32" instead of "L16" that I preferred, however PLAY statement doesn't allow tempos higher than 255. The logic of this program isn't very good for computing music with lengths and amplitude, which could be improved.
To customise the message displayed in the Marquis:
The message displayed in the marquis can be set via a key-value (the key = text) pair provided in the "query string" part added to the URL. For example:
Code: (Select All)
https://basicanywheremachine.neocities.org/Test/Horizontal%20Marquis.prod.run?text=How's she goin', buddy?
To use this program as a "service" for some website or locally-stored HTML files:
A BAM program exported to a single HTML file is very convenient for deploying, whether that be to a web server or file hosting service (whether outside your firewall or inside your firewall), or to any local storage device. Everything is self-contained in the one file, ready to go for online/offline access.
Click on the "Run the marquis program" link above.
(Chrome web browser) For the browser tab/window opened, find your browser's "Save page as" menu item, and save the webpage as HTML.
You'll want that webpage saved to a spot available to your website or locally-stored HTML.
Here's a template for what you need to use the marquis program as a "service":
Code: (Select All)
<iframe src="https://basicanywheremachine.neocities.org/Test/Horizontal%20Marquis.prod.run.html?text=How' she goin', buddy?" width=300px height=200px>
</iframe>
I've made a demo of the physics engine ("fzxNGN") I've been working for the last few years. Its a port of the Impulse engine written by Randy Gaul. Its been 100% ported to QB64 and not a 3rd part wrapper. Some may recognize the demo from a few years back, I've simply updated it to the newer engine, and changed some of the graphics.
Inside the compressed file you will find two directories, "fzxNGN_BASE_v2" and "fzxDemo" The "fzxNGN_BASE" is the core of the engine. The actual demo is located in "fzxDemo/fzxDemo.bas". Hopefully, all you have to do is run the "fzxDemo.bas" to play with the demo. I develop in Linux, so there may be some changes needed for Windows and Mac. And the speed of your machine may vary from mine so adjusting the dt(delta time) and iterations may help. My machine is probably old enough to drive a car in my state.
Code: (Select All)
DIM AS LONG iterations: iterations = 2
DIM SHARED AS DOUBLE dt: dt = 1 / 60
The idea of this mini game is to cross the sketchy bridge and then make the loop-to-loop. Beware the sketchy bridge will break. The more red the bridge is, the more stress its under. This was in part a test of a game mechanic I was kicking around for a driving/platformer.
Current features:
Rigid body simulation
Circle and polygon primitives
Joint simulation
Camera library to help with large play fields
Input Library
Finite State machine helper functions
Perlin noise library
XML parsing library - (not 100% and not fully integrated)
LERP functions
FPS helper functions
Countless vector, matrix math functions
Caveats:
Not documented
Work in progress
Not fully optimized
Possibility of vestigial code, or code that has yet to be updated.
When time permits, I'll work on proper documentation.
As far as license goes:
Quote:This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely.
I will try to use this thread to post more updates for the engine.
I'm experimenting with the PLAY function, and am (once again) confused with one section, the P (for silent pause).
With the string below, I expected to play four notes of staccato duration, four of normal, and four of legato.
It would then pause for 32 quarter-notes and then repeat. But the P32 seems to be ignored.
Pauses of up to 64 quarter-notes are permitted, so why does this happen?
Code: (Select All)
Play "MS CCCC P8 MN CCCC P8 ML CCCC P32 MS CCCC P8 MN CCCC P8 ML CCCC"
InForm-PE is a GUI engine and WYSIWYG interface designer for QB64-PE. It's a fork of InForm, but without any dependencies on falcon.h. All falcon.h function calls have been replaced by the new _U* family of font functions in QB64-PE that were introduced in v3.7.0 and v3.8.0. As such, the minimum required version of QB64-PE that this works with is v3.8.0. This also means that the entire InFrom-PE library is now in pure QB64-PE code.
There are some examples that are included in the "examples" directory to get you started. Also, the old InFrom wiki has been copied here: Home · a740g/InForm-PE Wiki (github.com). Note that the wiki needs work. Pull requests are welcome.
I may not be actively developing new features for this. However, please feel free to submit bug reports and suggestions here: Issues · a740g/InForm-PE (github.com). Pull requests are also welcome.
#339 - Improvements on the various dialog functions. - @a740g
Many mandatory dialog parameters are now optional.
Parsable option string arguments are case-insensitive now (required lower case before).
#341 - Adds _UCHARPOS() to the _U* functions family. - @a740g
Ideally, this should have been added in v3.7.0 but was not due to an oversight. This function calculates the pixel distance of every character in a string from the origin and is especially helpful for variable width fonts.
HI,
I have a problem. When I enter my program, the first thing I do is find out what my external IP is. For that I use a function that I saw from another programmer.
The problem is that depending on the computer, connection, times you enter the program......, sometimes it does it instantly and sometimes it takes a long time to get it (1 minute or more).
Can anyone think of how to set a timer so that if it hasn't responded in, say, 3 seconds, then program continues at another line? or by presing a key if is more easy?
Tanks
Code: (Select All)
Dim miip As String
Cls: Locate 10, 20: Print "COSULTING PUBLIC IP ...."
Function GetPublicIP$
Dim URL As String
Dim URLFile As String
Dim publicip As String
Dim a%
URLFile = "publicip"
URL = "https://api.ipify.org/"
a% = FileDownload(URL, URLFile)
Dim U As Integer
U = FreeFile
Open URLFile For Binary As #U
If LOF(U) <> 0 Then
Line Input #U, publicip
Else
Close #U
Kill URLFile
GetPublicIP = ""
Exit Function
End If
Close #U
Kill URLFile
GetPublicIP = publicip
End Function
Declare Dynamic Library "urlmon"
Function URLDownloadToFileA (ByVal pCaller As Long, szURL As String, szFileName As String, Byval dwReserved As Long, Byval lpfnCB As Long)
End Declare
Function FileDownload (URL As String, File As String)
FileDownload = URLDownloadToFileA(0, URL, File, 0, 0)
End Function
Help!
For all coders like me that are too old to abandon the old Qbasic Keywords vs new QB63pe keywords, it should be a warning AI in the parser!
run this code and you can experimenting what I'm saying.
Code: (Select All)
Dim Shared S1 As Long, S2 As Long
S1 = _NewImage(1200, 900, 32)
S2 = _NewImage(1200, 300, 32)
_SetAlpha 100, 0, S2
Screen S1
Paint (1, 1), _RGBA32(0, 100, 100, 256)
_Delay 1
_Dest S2
Print "If you see color back to this text all is ok"
_PutImage (1, 600), S2, S1
well, if you watch at the output... you see that all that is a screen 0 output (PRINT in this case) has been _putimaged on the application screen without no alpha effect!
At a first time it has been clear to my old mind! Why the part of S2 that brings PRINT output is not under the effect of _setalpha?
Yes PRINT is a keyword of SCREEN 0, but I believe that _setalpha should work on the whole S2 and not only to the part that brings a graphic effect.
In other words I should get this result if I make output directly to the main screen, while if I copy a screen that has a not full grade of trasparency (alpha < 256) I should get that the whole image shows the trasparency effect.
In this case it seems that copying the output of a SCREEN 0 let it at screen 0 level!
Like I cannot use screen function with graphic text (using Fonts).
DIM SHARED grid(16, 16), grid2(16, 16), cur
CONST maxx = 512
CONST maxy = 512
SCREEN _NEWIMAGE(maxx, maxy, 32)
_TITLE "MusicGrid"
cleargrid
DO
IF TIMER - t# > 1 / 8 THEN cur = (cur + 1) AND 15: t# = TIMER
IF cur <> oldcur THEN
figuregrid
drawgrid
playgrid
oldcur = cur
END IF
domousestuff
in$ = INKEY$
IF in$ = "C" OR in$ = "c" THEN cleargrid
LOOP UNTIL in$ = CHR$(27)
SUB drawgrid
scale! = maxx / 16
scale2 = maxx \ 16 - 2
FOR y = 0 TO 15
y1 = y * scale!
FOR x = 0 TO 15
x1 = x * scale!
c& = _RGB32(grid2(x, y) * 64 + 64, 0, 0)
LINE (x1, y1)-(x1 + scale2, y1 + scale2), c&, BF
NEXT x
NEXT y
END SUB
SUB figuregrid
FOR y = 0 TO 15
FOR x = 0 TO 15
grid2(x, y) = grid(x, y)
NEXT x
NEXT y
FOR y = 1 TO 14
FOR x = 1 TO 14
IF grid(x, y) = 1 AND cur = x THEN
grid2(x, y) = 2
IF grid(x - 1, y) = 0 THEN grid2(x - 1, y) = 1
IF grid(x + 1, y) = 0 THEN grid2(x + 1, y) = 1
IF grid(x, y - 1) = 0 THEN grid2(x, y - 1) = 1
IF grid(x, y + 1) = 0 THEN grid2(x, y + 1) = 1
END IF
NEXT x
NEXT y
END SUB
SUB domousestuff
DO WHILE _MOUSEINPUT
IF _MOUSEBUTTON(1) THEN
x = _MOUSEX \ (maxx \ 16)
y = _MOUSEY \ (maxy \ 16)
grid(x, y) = 1 - grid(x, y)
END IF
LOOP
END SUB
SUB playgrid
n$ = "L16 "
'scale$ = "O1CO1DO1EO1FO1GO1AO1BO2CO2DO2EO2FO2GO2AO2BO3CO3D"
scale$ = "o1fo1go1ao2co2do2fo2go2ao3co3do3fo3go3ao4co4do4fo"
FOR y = 15 TO 0 STEP -1
IF grid(cur, y) = 1 THEN
note$ = MID$(scale$, 1 + (15 - y) * 3, 3)
n$ = n$ + note$ + "," 'comma plays 2 or more column notes simultaneously
END IF
NEXT y
n$ = LEFT$(n$, LEN(n$) - 1)
PLAY n$
END SUB
SUB cleargrid
FOR y = 0 TO 15
FOR x = 0 TO 15
grid(x, y) = 0
NEXT x
NEXT y
END SUB