Finally a Spring Banner I can sink my few remaining teeth into...
You know the irony of it is I've been working the past couple of weeks with two graphics project, and just the other day I put together something quick and simple in text mode... and it wouldn't run. Turns out I typed SCREEN 0 with 3E's!
The QB64PE developers were recently discussing the creation of a home page for QB64PE project, and I volunteered.
I've built it and published it. You can find it here https://www.qb64phoenix.com - it's nothing special but it's a start and a place to grow from. We have some plans for the site to make it a more robust resource for learning, sharing, and finding stuff about QB64PE.
I was very careful to not disrupt any existing web stuff hosted on qb64phoenix.com and all existing links and stuff should work. I should state also that this has nothing to do with any recent issues happening with the SSL cert @SMcNeill may have spoken about - I wasn't even involved in that.
We discussed and made the decision to host the site using GitHub pages because:
1. It's free forever - GitHub Pages is free hosting for public repositories / FOSS projects!
2. It can scale on it's own without any cost or load balancing considerations. We don't maintain anything but the web code and automation. Server-less.
3. It can use GitHub Actions (CI/CD automation) which we also use already for the project to build releases, testing, etc.
4. Implementation was trivial and the change required to qb64phoenix.com was DNS specific adding a simple CNAME for www subdomain, so non-disruptive.
5. It honors the existing open source way so that if something happens to the team others can pick up where old team left off.
6. Jekyll and static site generation is flexible enough to afford us future growth without toil (includes, data structures, collection, ruby plugins, etc.)
We are leveraging Jekyll since it's built-in to GitHub Pages as well, which is a static site generation system. TL;DR: no database needed, everything is file based and you run a command to build the site. Once you push to gh-pages branch (or whatever branch we setup), via a PR from master or any other branch, the automation runs and builds and deploys the site. Simple.
Posted by: Petr - 03-30-2024, 08:50 PM - Forum: Petr
- Replies (3)
The following program performs a sound effect by rapidly changing the frequency of the sound being played. It's a small thing that occurred to me today while traveling by car. It does not have filtered harmonic frequencies, so even lower frequencies creep into the sound above 1000Hz (well, that's how I explain it). I'm writing something completely different now, this was just an escape attempt for distraction.
Try value 10, 300, use MP3 (need single array type created with MemSound)
Code: (Select All)
$NoPrefix
Screen _NewImage(600, 600, 32)
S = SndOpen("belfast.mp3")
Dim m As MEM
Dim As Single L, R, L2, R2
Dim As Long X, f
m = MemSound(S, 0)
If m.ELEMENTSIZE <> 8 Then
Print "Try another music file, program required SINGLE array. Try MP3."
Sleep
SndClose S
MemFree m
System
End If
Input "Insert start and end freq (start, end); 2 to 10600:"; U, D
If D > U Then Swap D, U
If D > 10600 Then D = 10600
If U < 2 Then U = 2
'try U = 10, D = 300
X = D
Stp = 4 'frequency step
Y = Stp
Do Until n& >= m.SIZE - SndRate
If n& Mod SndRate \ 6 = 0 Then 'set speed for setting freq
X = X + Y
If X > U Then Y = -Stp
If X < D Then Y = Stp
End If
f = _SndRate / X 'get freqency in samples
Do Until f Mod 4 = 0 'set f dividible by 4 for use with mem
f = f + 1
Loop
MemGet m, m.OFFSET + n&, L
MemGet m, m.OFFSET + n& + 4, R
MemGet m, m.OFFSET + n& + f, L2
MemGet m, m.OFFSET + n& + f + 4, R2
SndRaw (L2 - L), (R2 - R)
Do Until SndRawLen <= .2
Locate 2
Print X
Limit 20
Loop
I was thinking and wondering how one might skew 2D Space Invaders to look 3D, like
and also have photoreal stars scrolling in the background, like
simularly skewed, playing in a loop.
With the scene sometimes flying through space dust clouds, like
Just something I imagined.
The actual game play would similar to the classic game except the aliens might move in more interesting ways, like have the entire formation move around at times or have rows or columns of them move on & off screen, and let the player fire 2 or more shots.
But mainly I'm curious how you would skew the 2D to look 3D and do the 3D scrolling and moving through clouds (which could at times obscure the view)... The game itself would be programmed and behave like a 2D game though.
I've made some really nice popup menus in SCREEN 0, but since I started that graphics text app, I thought, oh hell, why not throw together something a little more along the lines that Notepad uses for cut/copy/paste options...
Updated to include right-click to open and close menu. (You need to right click somewhere on the blank screen.) Also, it opens approximately where you make your right click on the screen. A left click off the popup will close it.
Final update: Tightened up the code a bit and put the menu items into a data statement; so they can be easily added to or edited. The program keeps count of the items, so there is no need to change anything, except the data. Just be sure to keep the last data statement as "eof".
Code: (Select All)
Type popup
nmi As Integer
setup As Integer
status As Integer
pr1 As Integer
pr2 As Integer
pc1 As Integer
pc2 As Integer
phshadow As Integer
pvshadow As Integer
pwdth As Integer
phght As Integer
pbgcolor As Integer
pbbxcolor As Integer
pbshdcolor As Integer
col_matrix As String
row_matrix As String
End Type
Dim pop As popup
Type textvar
nof As Integer ' Number of Fonts.
fsize As Integer ' Font Size.
chr_wdth As Integer ' Character Width in Pixels.
chr_hght As Integer ' Character Height in Pixels.
End Type
Dim tx As textvar
Type mousevar
mx As Integer
my As Integer
wh As Integer
lb As Integer
rb As Integer
action As Integer
lb_status As Integer
rb_status As Integer
oldmx As Integer
End Type
Dim m As mousevar
Do
_Limit 30
mouse_driver m
popup_main tx, m, pop
_Display
Loop
Sub popup_main (tx As textvar, m As mousevar, pop As popup)
Static menu_item$(), fnum()
If m.rb_status = 1 And pop.status = 0 Then
m.rb_status = -1
pop.status = 1
End If
If pop.status = 2 Then
popup_engine tx, m, pop, menu_item$() ' Only to clear variables.
pop.status = 0
PCopy 100, _Display ' Removes popup and restores underlying screen.
Exit Sub
End If
If pop.status = 1 Then
pop.status = -1
PCopy _Display, 100
If pop.setup = 0 Then
pop.setup = -1
$Color:32
tx.nof = 4
Dim fnum(tx.nof) As Long
tx.fsize = 16
load_font tx, fnum()
_Font fnum(1)
tx.chr_wdth = _PrintWidth("A")
tx.chr_hght = _FontHeight
Restore popdata
pop.nmi = 0
Do
Read temp$
If LCase$(temp$) = "eof" Then Exit Do
pop.nmi = pop.nmi + 1
ReDim _Preserve menu_item$(pop.nmi)
menu_item$(pop.nmi) = temp$
Loop
temp$ = ""
End If
' Draw popup window.
pop.pbgcolor = 240
pop.pbbxcolor = 190
pop.pbshdcolor = 86
pop.phght = 2.5 * tx.chr_hght * (pop.nmi - 1) - tx.chr_hght \ 2
pop.pwdth = tx.chr_wdth * 16
pop.pc1 = m.mx + 1: If pop.pc1 + pop.pwdth > _Width - 5 Then pop.pc1 = _Width - 5 - pop.pwdth
pop.pr1 = m.my + 1: If pop.pr1 + pop.phght > _Height - 5 Then pop.pr1 = _Height - 5 - pop.phght
pop.pc2 = pop.pc1 + pop.pwdth
pop.pr2 = pop.pr1 + pop.phght
Line (pop.pc1, pop.pr1)-(pop.pc2, pop.pr2), _RGB32(pop.pbbxcolor, pop.pbbxcolor, pop.pbbxcolor, 255), B
Line (pop.pc1 + 2, pop.pr1 + 2)-(pop.pc2 - 2, pop.pr2 - 2), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255), BF
Line (pop.pc2 + 1, pop.pr1 + 7)-(pop.pc2 + 1, pop.pr2 + 0), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc2 + 2, pop.pr1 + 7)-(pop.pc2 + 2, pop.pr2 + 0), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc1 + 5, pop.pr2 + 1)-(pop.pc2 + 2, pop.pr2 + 1), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc1 + 5, pop.pr2 + 2)-(pop.pc2 + 2, pop.pr2 + 2), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Color _RGB32(0, 0, 0, 190), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255)
pop.col_matrix = String$(_Width, Chr$(0)): pop.row_matrix = pop.col_matrix
j% = 2
For i% = 1 To pop.nmi
Mid$(pop.col_matrix, pop.pc1, pop.pwdth) = String$(pop.pwdth, "*")
Mid$(pop.row_matrix, pop.pr1 + tx.chr_hght \ 2 + ((i% - 1) * tx.chr_hght * 2)) = String$(tx.chr_hght, Chr$(i%))
_PrintString (pop.pc1 + tx.chr_wdth * 2, pop.pr1 + tx.chr_hght \ 2 + ((i% - 1) * tx.chr_hght * 2)), menu_item$(i%)
Next
Color _RGB32(230, 190), _RGB32(230, 190)
For i% = 1 To pop.nmi - 1
Line (pop.pc1 + tx.chr_wdth * 2, pop.pr1 + i% * tx.chr_hght * 2)-(pop.pc2 - tx.chr_wdth * 2, pop.pr1 + i% * tx.chr_hght * 2), _RGB32(200, 255)
Next
Else
If pop.status = -1 Then
popup_engine tx, m, pop, menu_item$()
End If
End If
popdata:
Data Cut
Data Copy
Data Paste
Data Delete
Data Select All
Data Hyperlink
Data eof
End Sub
Sub popup_engine (tx As textvar, m As mousevar, pop As popup, menu_item$())
Static c1, r1, c2, r2, oldmenu_item%
If pop.status = 2 Then ' Close popup.
c1 = 0: c2 = 0: r1 = 0: r2 = 0: oldmenu_item% = 0: pop.col_matrix$ = "": pop.row_matrix$ = ""
Exit Sub
End If
If pop.status = 0 Then Exit Sub
If m.mx < pop.pc1 Or m.mx > pop.pc2 Or m.my < pop.pr1 Or m.my > pop.pr2 Then ' Mouse is outside of popup window.
If m.lb_status = 1 Then pop.status = 2: Exit Sub ' Left click outside of popup will close window.
If m.rb_status = 1 Then m.rb_status = -1: pop.status = 2: Exit Sub ' Right click outside of popup will close wndow.
If oldmenu_item% Then
If m.mx < pop.pc1 Or m.mx > pop.pc2 Or m.my < pop.pr1 Or m.my > pop.pr2 Then
GoSub remove_menu_item_highlighting
End If
End If
Else ' Mouse is inside popup window.
If m.rb_status Then m.rb_status = 0: Exit Sub ' Disables right mouse click insdie menu.
If Mid$(pop.col_matrix, m.mx + 1, 1) = "*" And Mid$(pop.row_matrix, m.my + 1, 1) <> Chr$(0) Then
menu_item% = Asc(Mid$(pop.row_matrix, m.my + 1, 1))
If menu_item% <> oldmenu_item% Or m.lb_status = 1 Then
Select Case m.lb_status
Case -1: Exit Sub ' Do not repeat action until mouse button is released.
Case 1: If m.lb_status = 1 Then m.lb_status = -1
End Select
h% = _InStrRev(m.mx, pop.col_matrix, Chr$(0)) + 1
temp$ = Mid$(pop.col_matrix, h%)
temp$ = Mid$(temp$, 1, InStr(temp$, Chr$(0)) - 1)
i% = Len(temp$)
j% = _InStrRev(m.my, pop.row_matrix, Chr$(0)) + 1
temp$ = Mid$(pop.row_matrix, j%)
temp$ = Mid$(temp$, 1, InStr(temp$, Chr$(0)) - 1)
k% = Len(temp$)
GoSub remove_menu_item_highlighting
c1 = h% + tx.chr_wdth \ 2
r1 = j% - tx.chr_hght \ 4
c2 = h% + i% - tx.chr_wdth \ 2
r2 = j% + k% + tx.chr_hght \ 4
If m.lb_status = -1 Then _Display: _Delay .1
Line (c1, r1)-(c2, r2), _RGB32(0, 170, 250, 255), BF
Color _RGB32(0, 0, 0, 190), _RGB32(0, 170, 250, 255)
_PrintString (pop.pc1 + tx.chr_wdth * 2, pop.pr1 + tx.chr_hght \ 2 + ((menu_item% - 1) * tx.chr_hght * 2)), menu_item$(menu_item%)
If m.lb_status = -1 Then
Color _RGB32(120, 0, 0, 255), _RGB32(255, 255, 255, 255)
_PrintString (10, 1), "You selected: " + menu_item$(menu_item%) + " "
_Display: _Delay 1 Rem REMOVE LATER AFTER DEMO IS COMPLETED.
pop.status = 2 ' Close popup.
End If
oldmenu_item% = menu_item%
End If
End If
End If
Exit Sub '-------------------------------->
remove_menu_item_highlighting:
If c1 Then Line (c1, r1)-(c2, r2), _RGB32(pop.pbgcolor, 255), BF
Color _RGB32(0, 0, 0, 190), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255)
_PrintString (pop.pc1 + tx.chr_wdth * 2, pop.pr1 + tx.chr_hght \ 2 + ((oldmenu_item% - 1) * tx.chr_hght * 2)), menu_item$(oldmenu_item%)
Return
End Sub
Sub load_font (tx As textvar, fnum() As Long)
fnum(1) = _LoadFont("RobotoMono-regular.ttf", tx.fsize)
fnum(2) = _LoadFont("RobotoMono-bold.ttf", tx.fsize)
fnum(3) = _LoadFont("RobotoMono-italic.ttf", tx.fsize)
fnum(4) = _LoadFont("RobotoMono-bolditalic.ttf", tx.fsize)
For i% = 1 To tx.nof
If fnum(i%) <= 0 Then ' Try to load the Windows Lucida Console font.
fnum(1) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", tx.fsize)
Exit For
End If
Next
If fnum(1) <= 0 Then
tx.fsize = 16 ' Default 8 x 16 font.
fnum(1) = tx.fsize
End If
End Sub
Sub mouse_driver (m As mousevar)
' Local vars: i%,j%
While _MouseInput
m.wh = m.wh + _MouseWheel
Wend
m.mx = _MouseX
m.my = _MouseY
m.lb = _MouseButton(1)
m.rb = _MouseButton(2)
Select Case m.lb
Case 0
Select Case m.lb_status
Case -1
m.lb_status = 0 ' An action occurred and the button was released.
Case 0
' Button has not been pressed yet.
Case 1
m.lb_status = 0 ' Button was released wth no action occurring.
End Select
Case -1
Select Case m.lb_status
Case -1
' An action occurred and the button is still down.
Case 0
m.lb_status = 1
Case 1
' The button is still down but no action occurred.
End Select
End Select
Select Case m.rb
Case 0
Select Case m.rb_status
Case -1
m.rb_status = 0 ' An action occurred and the button was released.
Case 0
' Button has not been pressed yet.
Case 1
m.rb_status = 0 ' Button was released wth no action occurring.
End Select
Case -1
Select Case m.rb_status
Case -1
' An action occurred and the button is still down.
Case 0
m.rb_status = 1
Case 1
' The button is still down but no action occurred.
End Select
End Select
m.oldmx = m.mx
End Sub
Now what's neat is you can easily go into the code and change the font size, where the popup appears, etc. Changing just the font size automatically keeps the popup proportions and dividers, plus all the hot spots for the mouse all together. Like Notepad, it uses mouse hover and click to select. I'll add some more improvements later, but the goal is to get it incorporated into the text routine.
You can download the font files, below or run it without and it will default to lucida console. If you don't have that one, it defaults to the QB 8x16 font.
Now if you will excuse me, one of my DEI hires is working on some sort of SELF DESTRUCT button. I have to keep a constant eye on him...
An interesting code snippet to get a string variable from print using:
Code: (Select All)
'sample assigning formatted string from print using to a variable:
Rem x$ = Print Using "###"; 100
X = FreeFile
F$ = "tempfile.bak"
Print "Enter value";
Input Z#: If Z# = 0# Then Z# = 100#
Print "Enter format";
Input Z$: If Z$ = "" Then Z$ = "###"
'write print using value
Open F$ For Output As #X
Print #X, Using Z$; Z#
'read print using value
Close
Open F$ For Input As #X
If EOF(X) = 0 Then
Line Input #X, S$
Print S$ ' this is the output value
End If
Close
End
Although I cannot find a more efficient way to do this..
![[Image: IMG-6833.png]](https://i.ibb.co/H76FBHC/IMG-6833.png)
![[Image: IMG-6834.jpg]](https://i.ibb.co/kBpj8yQ/IMG-6834.jpg)
![[Image: IMG-6835.jpg]](https://i.ibb.co/w6NR7yK/IMG-6835.jpg)
![[Image: IMG-6836.webp]](https://i.ibb.co/qDdBSrw/IMG-6836.webp)
![[Image: IMG-6837.jpg]](https://i.ibb.co/nLq7BzX/IMG-6837.jpg)
![[Image: IMG-6838.gif]](https://i.ibb.co/8cJ6VHL/IMG-6838.gif)
