Welcome, Guest |
You have to register before you can post on our site.
|
Latest Threads |
QBJS v0.9.0 - Release
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
1 minute ago
» Replies: 14
» Views: 162
|
1990's 3D Doom-Like Walls...
Forum: Programs
Last Post: SierraKen
12 minutes ago
» Replies: 7
» Views: 210
|
Fun with Ray Casting
Forum: a740g
Last Post: a740g
3 hours ago
» Replies: 2
» Views: 64
|
Big problem for me.
Forum: General Discussion
Last Post: bplus
5 hours ago
» Replies: 7
» Views: 60
|
discover graphics with xa...
Forum: Programs
Last Post: hsiangch_ong
7 hours ago
» Replies: 0
» Views: 22
|
another variation of "10 ...
Forum: Programs
Last Post: Jack002
7 hours ago
» Replies: 37
» Views: 542
|
Aloha from Maui guys.
Forum: General Discussion
Last Post: doppler
Yesterday, 03:32 PM
» Replies: 14
» Views: 328
|
Cautionary tale of open, ...
Forum: General Discussion
Last Post: doppler
Yesterday, 03:28 PM
» Replies: 0
» Views: 23
|
Extended KotD #22: _MOUSE...
Forum: Keyword of the Day!
Last Post: SMcNeill
Yesterday, 12:29 AM
» Replies: 0
» Views: 49
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: aurel
01-13-2025, 09:10 PM
» Replies: 111
» Views: 5,578
|
|
|
Control Audacious, play last 30 seconds of music |
Posted by: mnrvovrfc - 12-29-2022, 01:41 AM - Forum: Utilities
- No Replies
|
|
If you're on Linux, using Audacious music player and have loads of music that you don't have time to listen to entirely, I have written a tool to make your life a bit easier.
Press escape key at any time in the run to quit the program. This program expects Audacious started with a playlist ready to go. It prints on the screen the filename of the song that it's currently on. If you don't like this then press escape to get away from this QB64 user program, then change the current track in Audacious and try again to run this program.
Each song is first played for its first five seconds, then a seek is performed to about 30 seconds before the end to play that portion. These values could be adjusted in the program. It's easier to seek from the beginning of a song, but to seek from the end, first the playback length of the media file must be acquired.
While the 30 seconds of playback go down, the user could press escape to leave the program, or spacebar or enter to advance to the next track in the playlist.
This program makes use of an utility called "audtool" that should have been installed with Audacious. At the moment it works with one instance of Audacious that was ever opened.
Code: (Select All) ''by mnrvovrfc 2022-dec-28
option _explicit
dim as integer i, j, hm, hs, ff, coln
dim afile$, aname$, ke$, b$
afile$ = "audahelp-thistrak.txt"
_TITLE "Audacious App Helper"
do : loop until _screenexists
print "*** Make sure Audacious is running and with a playlist! ***"
print "Press escape to quit."
for i = 5 to 1 step -1
print "Starting in..."; i
_delay 1
ke$ = inkey$
if ke$ = chr$(27) then system
next
shell _hide "audtool -1 --playback-play"
for i = 1 to 20
shell _hide "audtool -1 --current-song-length > " + afile$
shell _hide "audtool -1 --current-song-filename >> " + afile$
ff = freefile
open afile$ for input as ff
line input #ff, b$
line input #ff, aname$
close ff
coln = instr(b$, ":")
hm = val(left$(b$, coln - 1))
hs = val(mid$(b$, coln + 1))
hs = hs - 32
if hs < 0 then
hm = hm - 1
hs = hs + 60
end if
hs = hs + hm * 60
print i; "name: "; aname$
print i; "for 5 seconds..."
for j = 1 to 5
_delay 1
ke$ = inkey$
if ke$ = chr$(27) then system
next
shell _hide "audtool -1 --playback-seek" + str$(hs)
print i; "final 30 seconds..."
for j = 1 to 30
_delay 1
ke$ = inkey$
if ke$ = chr$(27) then system
if ke$ = chr$(13) or ke$ = " " then exit for
next
if i = 20 then exit for
shell _hide "audtool -1 --playlist-advance"
next
shell _hide "audtool -1 --playback-stop"
print "OVER"
_delay 5
system
|
|
|
Remove Spaces (or other characters) from a String |
Posted by: George McGinn - 12-29-2022, 01:28 AM - Forum: Utilities
- Replies (10)
|
|
Awhile back I needed to remove SPACES (and sometimes other characters) from a string in some of my C code.
The need to do so in QB64 reared its ugly head again today, so I resurrected my code and now have incorporated it into any QB64 program I will need it in.
You pass the function 2 parameters - The string you want to change, and the character(s) you want removed. For example, if I want spaces and periods to be removed from a sentence, I pass " ." in the second argument. You don't need to run this function multiple times to accomplish this.
Here is the C/C++ Header file:
Code: (Select All) #include <stdio.h>
/* search for character(s) */
int string_search_chr(char *tokens,char s){
if (!tokens || s=='\0')
return 0;
for (;*tokens; tokens++)
if (*tokens == s)
return 1;
return 0;
}
char *string_remove_chr(char *str,const char *tokens) {
char *src = str , *dst = str;
/* validate input */
if (!(str && tokens))
return NULL;
while(*src)
if(string_search_chr(tokens,*src))
src++;
else
*dst++ = *src++; /* assign first, then incement */
*dst='\0';
return str;
}
Here is the QB64 program that tests the above:
Code: (Select All) DECLARE LIBRARY "./removeStr"
FUNCTION __REMOVESPACES$ ALIAS string_remove_chr(qString$, charValue$)
END DECLARE
QBMain:
PRINT "QB64: Test #1 - Remove SPACES from 'New York Yankees"
qString$ = "New York Yankees"
retValue$ = __REMOVESPACES$(qString$+CHR$(0), " ")
PRINT "QB64: qString$ = "; qString$
PRINT "QB64: retValue$ = "; retValue$
PRINT
PRINT "QB64: Used in a PRINT stmt, function returns: "; __REMOVESPACES$(qString$+CHR$(0), " ")
PRINT
PRINT "QB64: Test #2 -Remove SPACES and PERIODS from 'New York Yankees."
qString$ = "New York Yankees"
retValue$ = __REMOVESPACES$(qString$+CHR$(0), " .")
PRINT "QB64: qString$ = "; qString$
PRINT "QB64: retValue$ = "; retValue$
PRINT
PRINT "QB64: Used in a PRINT stmt, function returns: "; __REMOVESPACES$(qString$+CHR$(0), " ")
PRINT
SYSTEM 0
This is the output from running the above code:
Quote:QB64: Test #1 - Remove SPACES from 'New York Yankees
QB64: qString$ = New York Yankees
QB64: retValue$ = NewYorkYankees
QB64: Used in a PRINT stmt, function returns: NewYorkYankees
QB64: Test #2 -Remove SPACES and PERIODS from 'New York Yankees.
QB64: qString$ = New York Yankees
QB64: retValue$ = NewYorkYankees
QB64: Used in a PRINT stmt, function returns: NewYorkYankees
------------------
(program exited with code: 0)
Press return to continue
|
|
|
so, there's no more manual built in? |
Posted by: MrCreemy - 12-28-2022, 06:01 PM - Forum: General Discussion
- Replies (8)
|
|
I am assuming, there's no more of that "auto manual" popping up in the IDE?
(I liked that)
looking like workaround, is....
download giant PDF file
do command checks by hand, like old days with manual?
or... is there a workaround to "hook things back up"
|
|
|
Miscellaneous handy goodies |
Posted by: grymmjack - 12-28-2022, 01:44 AM - Forum: One Hit Wonders
- Replies (9)
|
|
Well, damn.
I had a very nicely formatted post all queued up and the browser crashed when I right clicked on a word to check its definition and spelling in this text area.
Anyway.
I will return to this to explain but mostly this is self-explanatory stuff.
Code: (Select All) ' For concatenating integers and stripping spaces
FUNCTION n$ (integ%)
n$ = _TRIM$(STR$(integ%))
END FUNCTION
' For showing friendly versions of my boolean constants
FUNCTION b$ (integ%)
IF integ% = -1 THEN
b$ = "TRUE"
ELSEIF integ% = 0 THEN
b$ = "FALSE"
ENDIF
END FUNCTION
' For concatenating longs and stripping spaces
FUNCTION ln$ (longval!)
ln$ = _TRIM$(STR$(longval!))
END FUNCTION
' For incrementing integers - x=inc(1) takes up 3 more chars than x=x+1 but inc is a bit easier for me to read.
FUNCTION inc% (value%)
inc% = value% + 1
END FUNCTION
' Same as above but decrement
FUNCTION dec% (value%)
dec% = value% - 1
END FUNCTION
' Inverting int
FUNCTION inv% (value%)
inv% = value% * -1
END FUNCTION
' Force int to be not less than min
FUNCTION min% (value%, minimum%)
IF value% < minimum% THEN value% = minimum%
min% = value%
END FUNCTION
' Force int to be not more than max
FUNCTION max% (value%, maximum%)
IF value% > maximum% THEN value% = maximum%
max% = value%
END FUNCTION
' Force int to be between a min and a max, when greater - clamp it between min and max
FUNCTION clamp% (value%, minimum%, maximum%)
IF value% > maximum% THEN
clamp% = maximum%
ELSEIF value% < minimum% THEN
clamp% = minimum%
ELSE
clamp% = value%
END IF
END FUNCTION
' Determine if a int is in range of a min and a max
FUNCTION in_range% (value%, minimum%, maximum%)
IF value% >= minimum% AND value% <= maximum% THEN
in_range% = TRUE
ELSE
in_range% = FALSE
END IF
END FUNCTION
' Randomize the sign of an int
FUNCTION rand_sign% ()
DIM r AS INTEGER
r% = -1 + INT(RND*2)
IF r% = 0 THEN r% = 1
rand_sign% = r%
END FUNCTION
' Create a random integer between min and max
FUNCTION rand_in_range% (minimum%, maximum%)
rand_in_range% = INT(RND * (maximum% - minimum% + 1)) + 1
END FUNCTION
' Randomly choose an int from an array of ints
FUNCTION rand_int_choice% (arr_choices%())
DIM AS INTEGER minimum, maximum
minimum% = LBOUND(arr_choices%) : maximum% = UBOUND(arr_choices%)
rand_int_choice% = arr_choices%(rand_in_range(minimum%, maximum%))
END FUNCTION
' Randomly choose a string from an array of strings
FUNCTION rand_str_choice$ (arr_choices$())
DIM AS INTEGER minimum, maximum
minimum% = LBOUND(arr_choices$) : maximum% = UBOUND(arr_choices$)
rand_str_choice$ = arr_choices$(rand_in_range(minimum%, maximum%))
END FUNCTION
|
|
|
MergeFile |
Posted by: SMcNeill - 12-27-2022, 05:26 PM - Forum: Works in Progress
- Replies (8)
|
|
Code: (Select All) $If WIN Then
Const Slash$ = "\"
$Else
const Slash$ = "/"
$End If
target$ = ".\source\qb64pe.bas"
outfile$ = ".\qb64onefile.bas"
If target$ = "" Then
Print "Give me a QB64 program to unravel => ";
Input target$
Print "Give me a name to save the new file under => ";
Input outfile$
End If
Open outfile$ For Output As #1
MergeFile target$
Sub MergeFile (whatfile$)
f = FreeFile
CurrentDir$ = _CWD$
i = _InStrRev(whatfile$, Slash$)
newdir$ = Left$(whatfile$, i)
If i > 0 Then
ChDir newdir$
whatfile$ = Mid$(whatfile$, i + 1)
End If
Open whatfile$ For Binary As #f
Do
Line Input #f, temp$
If Left$(UCase$(_Trim$(temp$)), 11) = "'$INCLUDE:'" Then
temp$ = _Trim$(temp$)
file$ = Mid$(temp$, 12)
file$ = Left$(file$, Len(file$) - 1)
MergeFile file$
Else
Print #1, temp$
End If
Loop Until EOF(f)
ChDir CurrentDir$
Close #f
End Sub
@grymmjack Was asking for a quick little program to merge $INCLUDE files into a single BAS file, so I sat down and wrote this one up in about 15 minutes. I haven't tested it extensively as I'm kinda distracted with my niece's kids visiting today, but it appeared to work without any issues with QB64PE.BAS and merged it all into one file easily enough.
Give it a try if you're interested in this type of thing, and if you manage to break it, post me a note on how you did so an I'll update it with a fix as soon as I get a little free time later.
|
|
|
Pan around a large screen |
Posted by: mnrvovrfc - 12-27-2022, 05:43 AM - Forum: Works in Progress
- Replies (3)
|
|
The latest topics created are staying firmly with zero views. Also this new annoyance of "related topics" which picks up only one word such as "bug" or "clone" LOL. I hope there's an user preference to disable that.
Ahem! Here I am sharing an incomplete program that could be used by someone else. It allows the user to press the arrow keys to move around in a simple imaginary world created with SCREEN 0. The "world" isn't very complex, just colored boxes. Feel free to add more keypresses, or "automatic movement" although it could spoil the fun.
Code: (Select All) DIM AS LONG bigscr
DIM AS INTEGER i, j, x, y, c, ii, fc, bc, xs, ys
DIM upd AS _BYTE
DIM ke$, ba$, blk$
blk$ = CHR$(219)
ba$ = CHR$(177)
RANDOMIZE TIMER
bigscr = _NEWIMAGE(1200, 1200, 0)
_DEST bigscr
FOR ii = 1 TO 5
FOR i = 1 TO 1000
DO
fc = INT(RND * 16)
bc = INT(RND * 7 + 1)
LOOP WHILE fc = bc
xs = INT(RND * INT(i / 25) + 4)
ys = INT(RND * INT(i / 25) + 4)
x = INT(RND * (1200 - xs) + 1)
y = INT(RND * (1200 - ys) + 1)
COLOR fc, bc
LOCATE y, x: PRINT STRING$(xs, ba$);
LOCATE y + ys - 1, x: PRINT STRING$(xs, ba$);
FOR j = 1 TO ys - 2
LOCATE y + j, x: PRINT STRING$(xs, ba$);
NEXT
NEXT
NEXT
COLOR 15, 0
LOCATE 1, 1: PRINT STRING$(1198, 219);
LOCATE 1200, 1: PRINT STRING$(1198, 219);
FOR j = 2 TO 1199
LOCATE j, 1: PRINT CHR$(219);
LOCATE j, 1200: PRINT CHR$(219);
NEXT
SCREEN _NEWIMAGE(100, 40, 0)
_SCREENMOVE 0, 0
_SOURCE bigscr
upd = 1
x = 576
y = 1201 - _HEIGHT
DO
_LIMIT 50
IF upd THEN
FOR j = 39 TO 1 STEP -1
FOR i = 1 TO 100
c = SCREEN(y + j - 1, x + i - 1, 1)
COLOR c MOD 16, c \ 8
LOCATE j, i: PRINT CHR$(SCREEN(y + j - 1, x + i - 1));
NEXT
NEXT
j = 40
FOR i = 1 TO 98
c = SCREEN(y + j - 1, x + i - 1, 1)
COLOR c MOD 16, c \ 8
LOCATE j, i: PRINT CHR$(SCREEN(y + j - 1, x + i - 1));
NEXT
_DISPLAY
END IF
ke$ = INKEY$
IF ke$ = CHR$(27) THEN EXIT DO
IF LEN(ke$) > 1 THEN
kk = ASC(ke$, 2)
SELECT CASE kk
CASE 72
IF y > 1 THEN y = y - 1: upd = 1
CASE 75
IF x > 1 THEN x = x - 1: upd = 1
CASE 77
IF x <= 1100 THEN x = x + 1: upd = 1
CASE 80
IF y <= 1160 THEN y = y + 1: upd = 1
END SELECT
END IF
LOOP
_AUTODISPLAY
SYSTEM
|
|
|
So... I *think* I found the cheese at the end of the maze? |
Posted by: MrCreemy - 12-27-2022, 04:16 AM - Forum: General Discussion
- Replies (11)
|
|
Good Lord.
I work away from home, and when I am away, I dont have internet
I am apt to be away for a long time.
I came home this time? Found... everything nuked.
freaked out by some tech journal article, how QB64 "blew up"...
I wasnt here, I only know what I *read*
Honestly, the story I found?
someone called someone a "nazi"
some kind of flame war ensued, I guess...
next thing, the wiki, the site, the forum, everything goes down
Question... am I in the right place? (I think I am)
Question #2... are there, like multiple forks of this QB64 language project now?
PS - I would have been "colonel panic" on the old site
|
|
|
Xmas Star |
Posted by: bplus - 12-25-2022, 05:51 PM - Forum: Christmas Code
- Replies (3)
|
|
Code: (Select All) _Title "Xmas Star" ' b+ 2022-12-25
Screen _NewImage(500, 500, 32)
star& = _NewImage(500, 500, 32)
XmasStar _Width / 2, _Height / 2, .1 * _Height, .2 * _Height, .45 * _Height, 125
_PutImage , 0, star&
s2& = _NewImage(500, 500, 32)
XmasStar _Width / 2, _Height / 2, .1 * _Height, .2 * _Height, .45 * _Height, 75
_PutImage , 0, s2&
d = 1
Do
Cls
For r = 0 To .45 * _Height Step 1
fcirc _Width / 2, _Height / 2, r, _RGB32(255, 255, 255, 5)
Next
a = a + d * .05
If Abs(a) < .05 Then
If d < 0 Then a = -.05
If d > 0 Then a = .05
End If
If a < -1 Then a = -1: d = 1
If a > 1 Then a = 1: d = -1
If a > 0 Then RotoZoom3 _Width / 2, _Height / 2, star&, a, 1, 0 Else RotoZoom3 _Width / 2, _Height / 2, s2&, a, 1, 0
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub XmasStar (xc, yc, r1, r2, r3, c As _Unsigned Long)
a = _Pi(2 / 16)
For p = 0 To 200
p1 = p / 200
For i = 0 To 15
If i Mod 2 = 1 Then
x1 = xc + p1 * r1 * Cos(i * a): y1 = yc + p1 * r1 * Sin(i * a)
ElseIf i Mod 4 = 0 Then
x1 = xc + p1 * r3 * Cos(i * a): y1 = yc + p1 * r3 * Sin(i * a)
ElseIf i Mod 4 = 2 Then
x1 = xc + p1 * r2 * Cos(i * a): y1 = yc + p1 * r2 * Sin(i * a)
End If
If i > 0 Then Line (lastx, lasty)-(x1, y1), _RGB32(255 - (p1 * 192), 255 - (p1 * 192), c, 60) Else firstx = x1: firsty = y1
lastx = x1: lasty = y1
Next
Line (lastx, lasty)-(firstx, firsty), _RGB32(255 - (p1 * 192), 255 - (p1 * 192), c, 60)
Next
End Sub
Sub RotoZoom3 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, radianRotation As Single) ' 0 at end means no scaling of x or y
Dim px(3) As Single: Dim py(3) As Single
Dim W&, H&, sinr!, cosr!, i&, x2&, y2&
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation)
For i& = 0 To 3
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle _Seamless(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle _Seamless(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
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
|
|
|
|