| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
| File Listing To Arrays |
|
Posted by: SMcNeill - 04-20-2022, 02:22 AM - Forum: SMcNeill
- Replies (7)
|
 |
direntry.h -- Grab this file. It's a C header which QB64 will need to make use of. Without it, the following won't run.
Copied, more or less verbatim, from my post over at QB64.net:
Random1 asked elsewhere:
Quote:Is there a way to save the output of FILES to a string or text file?
FILES "C:\MyFile\*.TXT" to a string or .txt file
So, I worked up this quick little routine to do just that...
Basic usage is rather simple: Copy the header and put it up top in your program. Copy the routine, put it at the end of your program. Make certain "direntry.h" is in your QB64 directory when compiling...
Call the routine with:
GetFileList _CWD$, Dir(), File()
In this case, I'm just getting the file and subdirectory listings for the Current Working Directory (_CWD$), but you can get them for any directory that exists on your system...
Here's a way you can do what you want to, which is compatible for both Linux and Windows users (whereas SHELL may not always work across various platforms).
Code: (Select All) DECLARE CUSTOMTYPE LIBRARY ".\direntry"
FUNCTION load_dir& (s AS STRING)
FUNCTION has_next_entry& ()
SUB close_dir ()
SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
END DECLARE
REDIM Dir(0) AS STRING, File(0) AS STRING
GetFileList _CWD$, Dir(), File()
PRINT "SUBDIRECTORIES"
FOR i = 1 TO UBOUND(dir)
PRINT Dir(i),
NEXT
PRINT
SLEEP
PRINT "FILES": PRINT: PRINT
FOR i = 1 TO UBOUND(file)
PRINT File(i),
NEXT
PRINT
SUB GetFileList (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING)
CONST IS_DIR = 1
CONST IS_FILE = 2
DIM flags AS LONG, file_size AS LONG
REDIM _PRESERVE DirList(100), FileList(100)
DirCount = 0: FileCount = 0
IF load_dir(SearchDirectory) THEN
DO
length = has_next_entry
IF length > -1 THEN
nam$ = SPACE$(length)
get_next_entry nam$, flags, file_size
IF flags AND IS_DIR THEN
DirCount = DirCount + 1
IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
DirList(DirCount) = nam$
ELSEIF flags AND IS_FILE THEN
FileCount = FileCount + 1
IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
FileList(FileCount) = nam$
END IF
END IF
LOOP UNTIL length = -1
close_dir
ELSE
END IF
REDIM _PRESERVE DirList(DirCount)
REDIM _PRESERVE FileList(FileCount)
END SUB
Note, I set this up to separate the search results into files and subdirectories separately.
Note 2. You'll need to download "direntry.h" from the attachment below and copy it into your QB64 folder for this to work. It doesn't need to be with the EXE once you compile it, but it does need to be in the QB64 folder for compiling.
Useage is rather simple (even if it doesn't look it at first).
First, Copy the library declarations into the top of the program where you'd like to make use of this routine.
DECLARE CUSTOMTYPE LIBRARY ".\direntry"
FUNCTION load_dir& (s AS STRING)
FUNCTION has_next_entry& ()
SUB close_dir ()
SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
END DECLARE
Then set two arrays to hold the directory and file information for you:
REDIM Dir(0) AS STRING, File(0) AS STRING
Then when you're ready, call the routine to get that directory's subdirectory list and file list updated:
GetFileList _CWD$, Dir(), File()
At this point, you now have the listing of whichever directory you wanted stored in those two arrays, which you can use for whatever purpose you needed.
In this case, I just cheesily printed them to the screen:
PRINT "SUBDIRECTORIES"
FOR i = 1 TO UBOUND(dir)
PRINT Dir(i),
NEXT
PRINT
SLEEP
PRINT "FILES": PRINT: PRINT
FOR i = 1 TO UBOUND(file)
PRINT File(i),
NEXT
PRINT
And, at the end of your code, don't forget to include the routine itself:
Code: (Select All) SUB GetFileList (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING)
CONST IS_DIR = 1
CONST IS_FILE = 2
DIM flags AS LONG, file_size AS LONG
REDIM _PRESERVE DirList(100), FileList(100)
DirCount = 0: FileCount = 0
IF load_dir(SearchDirectory) THEN
DO
length = has_next_entry
IF length > -1 THEN
nam$ = SPACE$(length)
get_next_entry nam$, flags, file_size
IF flags AND IS_DIR THEN
DirCount = DirCount + 1
IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
DirList(DirCount) = nam$
ELSEIF flags AND IS_FILE THEN
FileCount = FileCount + 1
IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
FileList(FileCount) = nam$
END IF
END IF
LOOP UNTIL length = -1
close_dir
ELSE
END IF
REDIM _PRESERVE DirList(DirCount)
REDIM _PRESERVE FileList(FileCount)
END SUB
direntry.h -- Remember, you need this file. It's a C header which QB64 will need to make use of. Without it, the following won't run.
|
|
|
| Change Floating Point Precision |
|
Posted by: SMcNeill - 04-20-2022, 02:20 AM - Forum: SMcNeill
- No Replies
|
|
A quick example of how to change floating point precision in QB64. This swaps between quick math (which uses hardware math processors) to extended precision math (which uses software processing). Note that the default qbfpu is quite a bit faster, and for most folks this should be more than sufficient for your needs, as it tracks precision down to about the 15th decimal point. IF, however, you absolutely have to have greater levels of precision, you can now swap over to extended precision and have about 20 decimal points worth of precision, at a significant reduction of speed.
And, if you need more than 20 decimal points of precision, you're just shit out of luck. Find a math library for that, or else write a string math handling routine -- your CPU isn't equipped to handle anything more than this, natively.
FPU_Precision.h
Code: (Select All) void set_dpfpu() { unsigned int mode = 0x37F; asm ("fldcw %0" : : "m" (*&mode));}
void set_qbfpu() { unsigned int mode = 0x27F; asm ("fldcw %0" : : "m" (*&mode));}
QB64 Code:
Code: (Select All) ' FPU_Precision.h needs to be in QB64 folder
$CONSOLE:ONLY
_DEST _CONSOLE
DECLARE CUSTOMTYPE LIBRARY ".\FPU_Precision"
SUB set_dpfpu 'to toggle to double precision floating point math
SUB set_qbfpu 'to toggle back to what most folks will see with QB64 64-bit default math
END DECLARE
DIM x AS _FLOAT, y AS _FLOAT
'Let's print our results without screwing with anything first.
x = 5##
y = x / 9##
PRINT USING "QB64 division #.####################"; y
'Set the double precision math
set_dpfpu
x = 5##
y = x / 9##
PRINT USING "QB64 division #.####################"; y
'Set the QB64 precision math
set_qbfpu
x = 5##
y = x / 9##
PRINT USING "QB64 division #.####################"; y
|
|
|
|
| ConvertOffset |
|
Posted by: SMcNeill - 04-20-2022, 02:18 AM - Forum: SMcNeill
- No Replies
|
|
Code: (Select All) DIM x AS INTEGER
DIM m AS _MEM
m = _MEM(x)
PRINT m.OFFSET
PRINT ConvertOffset(m.OFFSET)
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&&
ConvertOffset&& = temp&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
$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
|
|
|
|
| Extended Timer and TimeStamp |
|
Posted by: SMcNeill - 04-20-2022, 02:17 AM - Forum: SMcNeill
- Replies (3)
|
|
Code: (Select All) SHELL "https://www.epochconverter.com/"
PRINT "Compare to time stamps generated at the website which popped up in your browser.https://www.epochconverter.com/"
CONST MyTimeZone## = 4 * 3600
DO
_LIMIT 1
CLS
PRINT TimeStamp(DATE$, TIMER + MyTimeZone) 'Timezone difference with GMT, which is what the webpage sometimes points to.
' If the times seem off from the website, you'll want to change the timezone
' offset to match your current time zone.
PRINT ExtendedTimer 'Unix Epoch Timer based on local time.
_DISPLAY
LOOP
FUNCTION TimeStamp## (d$, t##) 'date and timer
'Based on Unix Epoch time, which starts at year 1970.
DIM l AS _INTEGER64, l1 AS _INTEGER64, m AS _INTEGER64
DIM d AS _INTEGER64, y AS _INTEGER64, i AS _INTEGER64
DIM s AS _FLOAT
l = INSTR(d$, "-")
l1 = INSTR(l + 1, d$, "-")
m = VAL(LEFT$(d$, l))
d = VAL(MID$(d$, l + 1))
y = VAL(MID$(d$, l1 + 1))
IF y < 1970 THEN 'calculate shit backwards
SELECT CASE m 'turn the day backwards for the month
CASE 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days
CASE 2: d = 28 - d 'special 28 or 29.
CASE 4, 6, 9, 11: d = 30 - d '30 days
END SELECT
IF y MOD 4 = 0 AND m < 3 THEN 'check for normal leap year, and we're before it...
d = d + 1 'assume we had a leap year, subtract another day
IF y MOD 100 = 0 AND y MOD 400 <> 0 THEN d = d - 1 'not a leap year if year is divisible by 100 and not 400
END IF
'then count the months that passed after the current month
FOR i = m + 1 TO 12
SELECT CASE i
CASE 2: d = d + 28
CASE 3, 5, 7, 8, 10, 12: d = d + 31
CASE 4, 6, 9, 11: d = d + 30
END SELECT
NEXT
'we should now have the entered year calculated. Now lets add in for each year from this point to 1970
d = d + 365 * (1969 - y) '365 days per each standard year
FOR i = 1968 TO y + 1 STEP -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)
d = d + 1 'subtract an extra day every leap year
IF (i MOD 100) = 0 AND (i MOD 400) <> 0 THEN d = d - 1 'but skipping every year divisible by 100, but not 400
NEXT
s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
TimeStamp## = -(s## + 24 * 60 * 60 - t##)
EXIT FUNCTION
ELSE
y = y - 1970
END IF
FOR i = 1 TO m 'for this year,
SELECT CASE i 'Add the number of days for each previous month passed
CASE 1: d = d 'January doestn't have any carry over days.
CASE 2, 4, 6, 8, 9, 11: d = d + 31
CASE 3 'Feb might be a leap year
IF (y MOD 4) = 2 THEN 'if this year is divisible by 4 (starting in 1972)
d = d + 29 'its a leap year
IF (y MOD 100) = 30 AND (y MOD 400) <> 30 THEN 'unless..
d = d - 1 'the year is divisible by 100, and not divisible by 400
END IF
ELSE 'year not divisible by 4, no worries
d = d + 28
END IF
CASE 5, 7, 10, 12: d = d + 30
END SELECT
NEXT
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
FOR i = 2 TO y - 1 STEP 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)
d = d + 1 'add an extra day every leap year
IF (i MOD 100) = 30 AND (i MOD 400) <> 30 THEN d = d - 1 'but skiping every year divisible by 100, but not 400
NEXT
s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
TimeStamp## = (s## + t##)
END FUNCTION
FUNCTION ExtendedTimer##
'Simplified version of the TimeStamp routine, streamlined to only give positive values based on the current timer.
'Note: Only good until the year 2100, as we don't do all the fancy calculations for leap years.
'A timer should work quickly and efficiently in the background; and the less we do, the less lag we might insert
'into a program.
DIM m AS INTEGER, d AS INTEGER, y AS INTEGER
DIM s AS _FLOAT, day AS STRING
day = DATE$
m = VAL(LEFT$(day, 2))
d = VAL(MID$(day, 4, 2))
y = VAL(RIGHT$(day, 4)) - 1970
SELECT CASE m 'Add the number of days for each previous month passed
CASE 2: d = d + 31
CASE 3: d = d + 59
CASE 4: d = d + 90
CASE 5: d = d + 120
CASE 6: d = d + 151
CASE 7: d = d + 181
CASE 8: d = d + 212
CASE 9: d = d + 243
CASE 10: d = d + 273
CASE 11: d = d + 304
CASE 12: d = d + 334
END SELECT
IF (y MOD 4) = 2 AND m > 2 THEN d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
ExtendedTimer## = (s + TIMER)
END FUNCTION
|
|
|
|
| EllipseFill |
|
Posted by: SMcNeill - 04-20-2022, 02:16 AM - Forum: SMcNeill
- Replies (2)
|
|
Code: (Select All) SUB EllipseFill (cx AS INTEGER, cy AS INTEGER, rx AS INTEGER, ry AS INTEGER, c AS LONG)
DIM a AS LONG, b AS LONG
DIM x AS LONG, y AS LONG
DIM xx AS LONG, yy AS LONG
DIM sx AS LONG, sy AS LONG
DIM e AS LONG
a = 2 * rx * rx
b = 2 * ry * ry
x = rx
xx = ry * ry * (1 - rx - rx)
yy = rx * rx
sx = b * rx
DO WHILE sx >= sy
LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
y = y + 1
sy = sy + a
e = e + yy
yy = yy + a
IF (e + e + xx) > 0 THEN
x = x - 1
sx = sx - b
e = e + xx
xx = xx + b
END IF
LOOP
x = 0
y = ry
xx = rx * ry
yy = rx * rx * (1 - ry - ry)
e = 0
sx = 0
sy = a * ry
DO WHILE sx <= sy
LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
DO
x = x + 1
sx = sx + b
e = e + xx
xx = xx + b
LOOP UNTIL (e + e + yy) > 0
y = y - 1
sy = sy - a
e = e + yy
yy = yy + a
LOOP
END SUB
|
|
|
|
| CircleFill |
|
Posted by: SMcNeill - 04-20-2022, 02:15 AM - Forum: SMcNeill
- Replies (2)
|
|
Code: (Select All) SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS 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
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
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
|
|
|
|
| Tutorial |
|
Posted by: johnno56 - 04-19-2022, 09:45 PM - Forum: Help Me!
- Replies (7)
|
 |
... and yes. Before you ask, I have read and worked my way through Terry's tutorials... but my request is specific. I am looking for a tutorial to create a non-scrolling, multi-level, old fashioned platformer. You remember? Coins; Enemies; Lava; Jump-pads; cheesy sound effects... You 'do' remember, right? Aw, man... Is my age slipping again? I like 'old school'... lol
Any assistance would be appreciated. Thank you.
J
|
|
|
|
|
![[Image: Screenshot-2022-04-19-21-13-45.png]](https://i.ibb.co/0GCcs5P/Screenshot-2022-04-19-21-13-45.png)
![[Image: Screenshot-2022-04-19-21-14-23.png]](https://i.ibb.co/x1fYWsq/Screenshot-2022-04-19-21-14-23.png)
![[Image: Screenshot-2022-04-19-21-15-57.png]](https://i.ibb.co/FBg1QFF/Screenshot-2022-04-19-21-15-57.png)
![[Image: Screenshot-2022-04-19-21-17-03.png]](https://i.ibb.co/sjqr2yK/Screenshot-2022-04-19-21-17-03.png)
![[Image: Screenshot-2022-04-19-21-17-41.png]](https://i.ibb.co/12TGTqn/Screenshot-2022-04-19-21-17-41.png)
