| 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: 747
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 29
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 28
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 1,883
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,187
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 309
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 118
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,317
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 232
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 138
|
|
|
| Steve's Config File System |
|
Posted by: SMcNeill - 04-20-2022, 02:28 AM - Forum: SMcNeill
- No Replies
|
 |
Two little routines which can be used to read and write to a config file. (If you guys want to see an example of what an actual config file would look like using this, look at the config.txt in your QB64/internal folder. This is the exact same config routines which we imported into QB64. :-X)
Code: (Select All) ConfigFile$ = "config.txt"
ConfigBak$ = "config.bak"
WriteConfigSetting "'[COLOR SETTING]", "Background", "_RGB32(255,0,255)"
DisplayConfigFile
WriteConfigSetting "'[COLOR SETTING]", "TextColor", "_RGB32(255,0,0)"
DisplayConfigFile
WriteConfigSetting "'[COLOR SETTING]", "Background", "_RGB32(255,0,0) 'REDONE"
DisplayConfigFile
WriteConfigSetting "'[COLOR SETTING]", "TextColor", "_RGB32(255,0,255) 'REDONE ALSO"
DisplayConfigFile
PRINT
PRINT "============================================="
PRINT
work = ReadConfigSetting("TextColor", value$)
IF work THEN
PRINT "Textcolor value found. It's: "; value$
ELSE
PRINT "No textcolor found"
END IF
SUB DisplayConfigFile
SHARED ConfigFile$
InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile
IF LOF(InFile) THEN
DO UNTIL EOF(InFile)
LINE INPUT #InFile, junk$
PRINT junk$
LOOP
ELSE
KILL "config.txt" 'remove the blank file from the drive
PRINT "No config file found."
END IF
CLOSE InFile
END SUB
SUB WriteConfigSetting (heading$, item$, value$)
SHARED ConfigFile$, ConfigBak$
DIM CRLF AS STRING
IF INSTR(_OS$, "WIN") THEN CRLF = CHR$(13) + CHR$(10) ELSE CRLF = CHR$(10)
_TITLE STR$(LEN(CRLF))
InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile
OutFile = FREEFILE: OPEN ConfigBak$ FOR OUTPUT AS #OutFile
placed = 0
IF LOF(InFile) THEN
DO UNTIL EOF(InFile)
LINE INPUT #InFile, junk$
'we really don't care about heading$ here; it's only used to make things easier for the user to locate in the config file
junk$ = LTRIM$(RTRIM$(junk$))
IF _STRICMP(LEFT$(junk$, LEN(item$)), item$) = 0 THEN
PRINT #OutFile, item$; " = "; value$
placed = -1
ELSE
PRINT #OutFile, junk$
END IF
LOOP
END IF
CLOSE #InFile, #OutFile
IF NOT placed THEN 'we didn't find the proper setting already in the file somewhere.
'Either the file was corrupted, or the user deleted this particulat setting sometime in the past.
'Now we look to see if the heading exists in the file or not.
'If it does, then we place the new setting under that heading.
'If not then we write that heading to the end of the file to make it easier for the user to locate in the future
'and then we write it below there.
OPEN ConfigBak$ FOR BINARY AS #InFile
l = LOF(InFile)
out$ = item$ + " = " + value$ + CRLF
temp$ = SPACE$(l)
GET #InFile, 1, temp$
l1 = INSTR(temp$, heading$)
IF l1 THEN
l1 = l1 + LEN(heading$) + LEN(CRLF)
PUT #InFile, l1, out$
r$ = MID$(temp$, l1)
PUT #InFile, , r$
placed = -1
END IF
IF NOT placed THEN
PUT #InFile, l + 1, CRLF
PUT #InFile, , heading$
PUT #InFile, , CRLF
PUT #InFile, , out$
PUT #InFile, , CRLF
END IF
CLOSE InFile
END IF
KILL ConfigFile$
NAME ConfigBak$ AS ConfigFile$
END SUB
FUNCTION ReadConfigSetting (item$, value$)
SHARED ConfigFile$
value$ = "" 'We start by blanking the value$ as a default return state
InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile
IF LOF(InFile) THEN
found = 0
DO UNTIL EOF(InFile)
LINE INPUT #InFile, temp$
temp$ = LTRIM$(RTRIM$(temp$))
IF LEFT$(UCASE$(temp$), LEN(item$)) = UCASE$(item$) THEN found = -1: EXIT DO
LOOP
CLOSE InFile
IF found THEN 'we found what we're looking for
l = INSTR(temp$, "=") 'return the value after the = sign
IF l THEN
value$ = MID$(temp$, l + 1)
l = INSTR(value$, CHR$(13)) 'we only want what's before a CR
IF l THEN value$ = LEFT$(value$, l)
l = INSTR(value$, CHR$(10)) 'or a LineFeed
'These are basic text files; they shouldn't have stray CHR$(10) or CHR$(13) characters in them!
IF l THEN value$ = LEFT$(value$, l)
value$ = LTRIM$(RTRIM$(value$))
ReadConfigSetting = -1
EXIT FUNCTION
END IF
END IF
END IF
ReadConfigSetting = 0 'failed to find the setting
END FUNCTION
The concept behind the routines here is rather simple:
First, most config files have headings to help make finding and organizing things easier for the user to find if they ever open the file in a simple text editor. This supports those as a purely organizational type object, but they actually don't hold any value except to make things easier for the user in they alter things manually.
For example, a config file might look like the following:
'[COLORS]
RED = 1
BLUE = 2
'[JOYSTICK]
EnableJoystick = FALSE
Now that's easy enough to read and alter in a text editor, but what if the user edits it so that it looks something more like the following:
'[COLORS]
RED = 1
'[JOYSTICK]
EnableJoystick = FALSE
BLUE = 2
That BLUE isn't in the right heading!
So the choice here is: Do we ignore it since it's not in the expected place? Or read it as long as it's anywhere in the file?? I chose to read it no matter where it appears in the config file. 
The only drawback to this is that we can't have two different settings called BLUE under different headings, but that I don't see that as being an issue for us so much just for the simple fact that QB64 really isn't going to have that many settings to use that we can't give them all an unique name.
So honestly, all we're really dealing with here is the item$ which is the setting we're looking for, and the value$ that we want to assign to it, with the heading$ only being there to help with making it all look pretty...
Other point to note:
ReadConfigSetting is a FUNCTION.
It returns a 0 to us if it fails to find a setting, and a -1 if it found it successfully.
the value$ is passed back to us via the 2nd parameter in the FUNCTION.
work = ReadConfigSetting("TextColor", value$)
Now if we have a setting for TextColor, work will be -1 and value$ will be whatever that setting is
If there's no TextColor in the config file, work will be 0 and value$ might be anything....
I'd suggest to ALWAYS check to see if the return value of that function is true or not, before I'd accept the value that it gave us.
work = ReadConfigSetting("TextColor", value$)
IF work THEN
PRINT "Textcolor value found. It's: "; value$
ELSE
PRINT "No textcolor found"
END IF
All in all, I find it easier to use than I do to explain the use. LOL - try out the demo and you'll see how it works for yourself easily enough.
WriteConfigSetting (heading$, item$, value$) writes the headings (just for prettification), item, and value to the proper place in your config file. It searches to see if the setting is already in the file, and if not it adds it to the proper area automatically for you.
ReadConfigSetting (item$, value$) returns a 0 or -1 through the function to tell us if things worked as we expected, and returns our value to use through the second parameter if it can.
It really is basically that simple to use. [/quote]
|
|
|
| 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, ConvertOffset&& '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)
