| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,033
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
_LOADFONT example omission |
|
Posted by: mnrvovrfc - 04-24-2023, 02:46 PM - Forum: Wiki Discussion
- Replies (1)
|
 |
From this page:
https://qb64phoenix.com/qb64wiki/index.php/LOADFONT
The second example has "_FONT" statement missing. If the font doesn't exist, largely due to mistyping (which was driving me crazy just now trying to load "cyberbit.ttf" in current directory), then the example as it's presented right now isn't going to do anything about it.
The code example should read like the following:
Code: (Select All) i& = _NEWIMAGE(800, 600, 32)
SCREEN i&
COLOR &HC0FFFF00, &H200000FF
f& =_LOADFONT("C:\Windows\Fonts\times.ttf", 25) 'normal style
_FONT f&
PRINT "Hello!"
TIP: If you have Wine in your Linux installation and have run "winetricks corefonts", or any other way to populate the "Windows/Fonts" directory, then this statement could be used to load Times New Roman:
Code: (Select All) f& = _LOADFONT("/home/user/.wine/drive_c/windows/Fonts/times.ttf", 25) 'normal style
(replace "user" without double-quotation marks with the name of the user that is linked with the password for your regular account.)
|
|
|
| BAM feature in the works: two voices for SOUND |
|
Posted by: CharlieJV - 04-24-2023, 04:44 AM - Forum: QBJS, BAM, and Other BASICs
- Replies (2)
|
 |
Although the WebAudio API is a tough thing to figure out, I've managed to get two voices (oscillators) working without too much clicking between sounds.
Loads to do (like figuring out how to adjust volume, and getting more voices working without buzzing sounds), but this will have to do for a near-future release of BAM.
If you have a moment to give the following a try on your device with your particular browser, please let me know how it goes:
(EDIT: ARG! I forgot to mention: turn down your volume!!!)
|
|
|
|
| Why element size is not 2? |
|
Posted by: Petr - 04-23-2023, 11:57 AM - Forum: Help Me!
- Replies (9)
|
 |
Code: (Select All) Type snd1
l As Integer
r As Integer
End Type
Type snd2
l As _Unsigned _Byte
r As _Unsigned _Byte
End Type
ReDim s(0) As snd2 '1
ReDim s(0) As snd1 '2
Print Len(s(0).l) 'expected is 2
Is there any way to fix this, or does that mean I have to completely rewrite 90 percent of the program that relied on this?
|
|
|
|
| Chuck Norris Facts! |
|
Posted by: dbox - 04-21-2023, 08:11 PM - Forum: QBJS, BAM, and Other BASICs
- Replies (15)
|
 |
Have you ever wished you had a desktop background that would tell you random Chuck Norris facts? Haven't we all?
Well now your wish has become a reality:
Code: (Select All) Dim img
img = _LoadImage("https://images01.military.com/sites/default/files/styles/full/public/2021-04/chucknorris.jpeg.jpg?itok=2b4A6n29")
_PutImage , img
_Fullscreen
Do
_Delay 2
Dim result As Object
result = Fetch("https://api.chucknorris.io/jokes/random")
If result.ok Then
Dim obj As Object
obj = JSON.parse(result.text)
Say obj.value
End If
Loop
Sub Say (text As String)
$If Javascript Then
var synth = window.speechSynthesis;
if (synth) {
var utterance = new SpeechSynthesisUtterance(text);
synth.speak(utterance);
while (synth.speaking) {
await QB.sub__Delay(.5);
}
success = -1;
}
$End If
End Sub
View in QBJS
|
|
|
|
| How to Restart a Bogged Down Program |
|
Posted by: NakedApe - 04-21-2023, 06:40 PM - Forum: Help Me!
- Replies (18)
|
 |
Hey coding wizards,
Help! The game I'm working on is misbehaving and I don't understand why. When I go to a certain subroutine it all runs fine, but then if I go back to the beginning of the program - the main loop - the game slows to a crawl and starts crashing over issues that ran perfectly well before that subroutine. I tried using CLEAR, ERASE and RUN in different ways to wipe the slate clean and reload assets, but each of those commands just crashes the program. Thoughts? Suggestions? I'm using QB64 Version 2.0.2 because it runs well on an older Mac I use for coding.
Thanks very much,
Befuddled Ted
|
|
|
|
| Cut Music Files |
|
Posted by: Petr - 04-21-2023, 05:58 PM - Forum: Petr
- No Replies
|
|
A simple program for cuting music files according to data in a text file. It supports all audio formats supported in QB64PE as source, WAV file as output.
Code: (Select All) 'wav cut
'extended version, based on https://staging.qb64phoenix.com/showthread.php?tid=1631&pid=15348#pid15348
'unlocked for all QB64PE compatible sound formats
'
'The program is used to cut audio files based on data in a text file.
'For example - the original audio file contains 10 songs (for example, when backing up vinyl records or audio cassettes to your computer)
'and you know the length of the audio track and want to cut it into your own file, or you just want to get a piece of the audio file.
'The program cuts the specified section of sound and saves it in WAV format to a file named according to the entry in the text file.
'
'split.txt file content:
'
'5 <---- how much files create
'"allinone.mp3" <---- sound file, which contains your sounds, can be all, what QB64 support (XM, MOD, IT, MP3, WAV, S3M....)
'"Track 01", 1:10 <---- cut from allinone.mp3 sound to file Track 01.wav in lenght 1 minute, 10 seconds (output format is just one - WAV 16bit, stereo)
'"Silent 1", 0:3 <---- cut next sound from allinone.mp3 (start after the end position previous Track 01)
'"Track 02", 2:20
'"Silent 2", 0:3
'"Track 03", 3:00
'end of txt file
'
Type TrackType
Time As Single
Song As String
End Type
Type WAVHead
chunk As String * 4 ' 4 bytes (RIFF)
size As _Unsigned Long ' 4 bytes (file size) velikost souboru
fomat As String * 4 ' 4 bytes (WAVE)
sub1 As String * 4 ' 4 bytes (fmt )
subchunksize As Long ' 4 bytes (lo / hi), $00000010 for PCM audio
format As Integer ' 2 bytes (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
channels As Integer ' 2 bytes (1 = mono, 2 = stereo)
rate As Long ' 4 bytes (sample rate, standard is 44100)
ByteRate As Long ' 4 bytes (= sample rate * number of channels * (bits per channel /8))
Block As Integer ' 2 bytes (block align = number of channels * bits per sample /8)
Bits As Integer ' 2 bytes (bits per sample. 8 = 8, 16 = 16)
subchunk2 As String * 4 ' 4 bytes ("data") contains begin audio samples
lenght As _Unsigned Long ' 4 bytes Data block size
End Type ' 44 bytes total
Dim WavHead As WAVHead
Dim WavNew As WAVHead
SplitTxt$ = "split.txt"
ff = FreeFile
If _FileExists(SplitTxt$) Then
Open SplitTxt$ For Input As ff
If LOF(ff) > 0 Then
Input #ff, tracks$
Tracks = Val(tracks$)
If Tracks <= 0 Then
Print "Can not create negative or zero new tracks.": End
Else
Input #ff, source$
' If LCase$(Right$(source$, 4)) <> ".wav" Then source$ = source$ + ".wav" 'IN THIS VERSION IS IT EXTENDED FOR ALL QB64PE SUPPORTED FORMATS
If _FileExists(source$) Then
Dim tracks(Tracks) As TrackType
While Not EOF(ff)
Input #ff, TrackName$, TrackTime$
If LCase$(Right$(TrackName$, 4)) <> ".wav" Then TrackName$ = TrackName$ + ".wav"
tracks(ti).Song = TrackName$
separator = InStr(1, TrackTime$, ":")
If separator = 0 Then Print "Invalid track time. Use format Min:Sec": End
Min = Val(Left$(TrackTime$, separator - 1))
Sec = Val(Right$(TrackTime$, separator))
tracks(ti).Time = Min * 60 + Sec
ti = ti + 1
If ti > Tracks Then Print "Txt file contains more records than is declared on line 1 in txt file "; SplitTxt$; Tracks; ti: End
Wend
Else
Print "Source file: "; source$; " not exists.": End
End If
End If
Else
Print "File lenght "; SplitTxt$; " is not valid.": End
End If
Else
Print "File: "; SplitTxt$; " not exists."
End If
Print "Total declared tracks:"; Tracks
Print "Source sound file: "; source$
Close ff
Dim As _MEM O, L, R, NwSnd
snd& = _SndOpen(source$)
O = _MemSound(snd&, 0)
BackCompatible O, L, R 'convert all QB64PE sound option as 16 bit stereo, but use real _SndRate as in QB64PE
_MemFree O
NwSnd = _MemNew(L.SIZE * 2)
Mix_Left_Right_as_Wav L, R, NwSnd
_MemFree L
_MemFree R
For TimeTest = 0 To Tracks
TotalTime = TotalTime + tracks(TimeTest).Time
Next
Print "Total Time in "; Tracks; " tracks is:"; TotalTime
SAFLEN = _SndLen(snd&)
If SAFLEN < TotalTime Then Print "Source audio file is shorter than the total required length. Some audio tracks may therefore have silence at the end."
Print "Source audio file lenght:"; SAFLEN
Print "Source audio file format: 16 bits" 'BakcCompatible static outputs
Print "Source audio file channels: 2"
For split = 0 To Tracks - 1
Print "Creating track "; tracks(split).Song; " ["; LTrim$(Str$(tracks(split).Time)); "S]"
DataSize& = 4 * _SndRate * tracks(split).Time
If nwsndi& + DataSize& > NwSnd.SIZE Then Print "Memory out of range prevent: Program try read out of memory block!": DataSize& = ConvertOffset(NwSnd.SIZE) - nwsndi&
datas$ = Space$(DataSize&)
_MemGet NwSnd, NwSnd.OFFSET + nwsndi&, datas$
nwsndi& = nwsndi& + DataSize&
WavNew.Bits = 16
WavNew.channels = 2
WavNew.rate = _SndRate
WavNew.chunk = "RIFF"
WavNew.size = DataSize& + 44
WavNew.fomat = "WAVE"
WavNew.sub1 = "fmt "
WavNew.subchunksize = &H10
WavNew.ByteRate = _SndRate * 4
WavNew.Block = 4
WavNew.subchunk2 = "data"
WavNew.format = 1
WavNew.lenght = DataSize&
' Print "New WAV bits: "; WavNew.Bits
' Print "New WAV channels: "; WavNew.channels
' Print "New WAV sound rate: "; WavNew.rate
' Print "New WAV size: "; WavNew.size
ff2 = FreeFile
Open tracks(split).Song For Binary As ff2
Put ff2, , WavNew
Put ff2, , datas$
Close ff2
datas$ = ""
Next
_SndClose snd&
_MemFree NwSnd
Sub Mix_Left_Right_as_Wav (left As _MEM, right As _MEM, wav As _MEM)
Dim As Integer LData, RData
Do Until i& = left.SIZE
_MemGet left, left.OFFSET + i&, LData
_MemGet right, right.OFFSET + i&, RData
_MemPut wav, wav.OFFSET + j&, LData
_MemPut wav, wav.OFFSET + j& + 2, RData
i& = i& + 2
j& = j& + 4
Loop
End Sub
Sub BackCompatible (Snd As _MEM, Left As _MEM, Right As _MEM)
If Snd.SIZE = 0 Then
Print "Original sample data array is empty."
Exit Sub
End If
Dim SndChannels As Long, ChannelLenght As _Offset
Select Case Snd.TYPE
Case 260 ' 32-bit floating point
If Snd.ELEMENTSIZE = 4 Then
SndChannels = 1
ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
ElseIf Snd.ELEMENTSIZE = 8 Then
SndChannels = 2
ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
End If
Case 132 ' 32-bit integer
If Snd.ELEMENTSIZE = 4 Then
SndChannels = 1
ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
ElseIf Snd.ELEMENTSIZE = 8 Then
SndChannels = 2
ChannelLenght = Snd.SIZE \ 4 'return size in INTEGERS
End If
Case 130: ' 16-bit integer
If Snd.ELEMENTSIZE = 2 Then
SndChannels = 1
ChannelLenght = Snd.SIZE 'return size in INTEGERS
ElseIf Snd.ELEMENTSIZE = 4 Then
SndChannels = 2
ChannelLenght = Snd.SIZE \ 2 'return size in INTEGERS
End If
Case 1153: ' 8-bit unsigned integer
If Snd.ELEMENTSIZE = 1 Then
SndChannels = 1
ChannelLenght = Snd.SIZE * 2 'return size in INTEGERS
ElseIf Snd.ELEMENTSIZE = 2 Then
SndChannels = 2
ChannelLenght = Snd.SIZE * 4 'return size in INTEGERS This option is not tested
End If
End Select
Left = _MemNew(ChannelLenght)
Right = _MemNew(ChannelLenght)
Dim As Integer LI, RI
Dim As Long Oi
Dim i As _Offset
Do Until i = Snd.SIZE - Snd.ELEMENTSIZE 'Read Phoenix MEMSOUND and convert it as back-compatible as QB64 2.02 MEMSOUND's output.
Select Case SndChannels
Case 10 'this is out of order this time - program create always 2 channels - stereo or mono/mono
Select Case Snd.TYPE
Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single) ' 32-bit floating point
Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648 ' 32-bit integer
Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768 ' 16-bit integer
Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
End Select
Case 1, 2
Select Case Snd.TYPE
Case 260: sampL = _MemGet(Snd, Snd.OFFSET + i, Single): sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Single) ' 32-bit floating point
Case 132: sampL = _MemGet(Snd, Snd.OFFSET + i, Long) / 2147483648: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Long) / 2147483648 ' 32-bit integer
Case 130: sampL = _MemGet(Snd, Snd.OFFSET + i, Integer) / 32768: sampR = _MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, Integer) / 32768 ' 16-bit integer
Case 1153: sampL = (_MemGet(Snd, Snd.OFFSET + i, _Unsigned _Byte) - 128) / 128: sampR = (_MemGet(Snd, Snd.OFFSET + i + Snd.ELEMENTSIZE \ 2, _Unsigned _Byte) - 128) / 128 ' 8-bit unsigned integer
End Select
End Select
If SndChannels Mod 2 = 0 Then
LI = sampL * 32767
RI = sampR * 32767
_MemPut Left, Left.OFFSET + Oi, LI
_MemPut Right, Right.OFFSET + Oi, RI
Else
LI = sampL * 32767
_MemPut Left, Left.OFFSET + Oi, LI
_MemPut Right, Right.OFFSET + Oi, RI
End If
i = i + Snd.ELEMENTSIZE
Oi = Oi + 2
Loop
End Sub
Function ConvertOffset&& (value As _Offset)
$Checking:Off
Dim m As _MEM 'Define a memblock
m = _Mem(value) 'Point it to use value
$If 64BIT Then
'On 64 bit OSes, an OFFSET is 8 bytes in size. We can put it directly into an Integer64
_MEMGET m, m.OFFSET, temp&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
ConvertOffset&& = temp&&
$Else
'However, on 32 bit OSes, an OFFSET is only 4 bytes. We need to put it into a LONG variable first
_MemGet m, m.OFFSET, temp& 'Like this
ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
$End If
_MemFree m 'Free the memblock
$Checking:On
End Function
|
|
|
|
| WAV file splitter program? |
|
Posted by: madscijr - 04-20-2023, 02:01 PM - Forum: General Discussion
- Replies (13)
|
 |
Has anyone done or seen any QB/QB64/QB64PE code that takes a WAV file "MyAlbum.wav" and a text file with track times, in a format like:
0:00 song title #1
3:01 my song #2
4:18 another track
9:49 a long one
etc.
and cuts up the WAV file into separate files for each track based on the track times, with the files named after the titles, like:
MyAlbum 01 song title #1.wav
MyAlbum 02 my song #2.wav
MyAlbum 03 another track.wav
MyAlbum 04 a long one.wav
etc.
?
I need to go back and study the WAV file format, but it would help if there is some working code to study.
|
|
|
|
| Processing key input on a do loop |
|
Posted by: NasaCow - 04-20-2023, 11:39 AM - Forum: Help Me!
- Replies (9)
|
 |
I am working on the GUI for my gradebook and I am having a tough time to figure out how to code this though...
First what I am looking at:
![[Image: image.png]](https://i.ibb.co/J7pW5Dk/image.png)
I can move around the screen quite easily using this code:
Code: (Select All) 'Main Gradebook loop
PAUSE TIME
DO
'Inital highlight and execute command loop
Sel.X = 1: Sel.Y = 1
LoopX = LongName + 11: LoopY = StartY - 4
PauseFlag = FALSE
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
'Selection loop
DO
LIMIT LIMITRATE
'Down case
IF KEYDOWN(20480) OR KEYDOWN(13) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.Y < CurrentPageCount THEN LoopY = LoopY + FONTHEIGHT + 8: Sel.Y = Sel.Y + 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Up case
IF KEYDOWN(18432) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.Y > 1 THEN LoopY = LoopY - FONTHEIGHT - 8: Sel.Y = Sel.Y - 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Right case
IF KEYDOWN(19712) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.X < GridCount THEN LoopX = LoopX + 50: Sel.X = Sel.X + 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Left case
IF KEYDOWN(19200) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.X > 1 THEN LoopX = LoopX - 50: Sel.X = Sel.X - 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
IF PauseFlag THEN PAUSE TIME: PauseFlag = FALSE
DISPLAY
LOOP UNTIL KEYDOWN(34304)
PAUSE TIME
LOOP UNTIL KEYDOWN(34304) 'F12 key to close the gradebook
You can see I am currently using F12 to exit both loops.
This is what I am trying to do: I want to exit the first loop when any number, period, or any other vaild F## key is pressed. Given an F## key, I can use selectcase to call various subroutines to do the commands, that seems straight forward. The next part I am not sure how to process is if it is a number or a decimal point, I want to capture and print it to screen, similar to an input statement. Any thoughts....
I know the beginning of my first loop will need to be recoded to work properly. I am just realizing as I am chugging along that the input is quickly gonna become a problem I believe.
Quick Edit: What I am trying to avoid is a double enter for input: enter -> input -> enter -> accepted and save. What I am trying to do is vaild input-> enter -> accepted and save.
|
|
|
|
|
