| 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,034
|
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
|
|
|
| Customizable Program Display |
|
Posted by: SMcNeill - 08-02-2022, 05:00 AM - Forum: Works in Progress
- Replies (14)
|
 |
Here's a little showcase of something which I'm working on for a personal little project of mine, which I thought folks might like to take a look at -- an user customizable-display program.
Code: (Select All) 'Set compiler and global progeam options
'All variables and arrays are dynamic by default
'$Dynamic
'Allow the use of color names for 32-bit screen mode
$Color:32
''$INCLUDE:'Keyboard Library.BI'
_Define A-Z As LONG 'default variable type is long
_Title "Title TBD"
'Types and global variables
Dim Shared As Long ScreenWidth, ScreenHeight, DisplayScreen, WorkScreen, ReDrawScreen
Dim Shared As Long Font(10), FontSize, Brightness
Dim Shared As Long True, False
'Defaut vaues for global variables
ScreenWidth = 1280
ScreenHeight = 720
DisplayScreen = _NewImage(ScreenWidth, ScreenHeight, 32)
WorkScreen = _NewImage(ScreenWidth, 32000, 32)
True = -1: False = 0
ReDrawScreen = 0
Font(0) = _LoadFont("courbd.ttf", 6, "monospace")
Font(1) = _LoadFont("courbd.ttf", 8, "monospace")
Font(2) = _LoadFont("courbd.ttf", 10, "monospace")
Font(3) = _LoadFont("courbd.ttf", 12, "monospace")
Font(4) = _LoadFont("courbd.ttf", 14, "monospace")
Font(5) = _LoadFont("courbd.ttf", 16, "monospace")
Font(6) = _LoadFont("courbd.ttf", 18, "monospace")
Font(7) = _LoadFont("courbd.ttf", 22, "monospace")
Font(8) = _LoadFont("courbd.ttf", 28, "monospace")
Font(9) = _LoadFont("courbd.ttf", 36, "monospace")
Font(10) = _LoadFont("courbd.ttf", 48, "monospace")
FontSize = 8 'starting font size
Brightness = 5
Screen DisplayScreen
_Delay .2
_Dest WorkScreen
_Font Font(FontSize)
Color _RGB32(255 \ Brightness), 0
Do
ProcessInput
Cls , 0
Print _Width(DisplayScreen), _Height(DisplayScreen)
_PutImage , WorkScreen, DisplayScreen, (0, 0)-Step(_Width(DisplayScreen), _Height(DisplayScreen))
_Limit 60
_Display
Loop
Sub ProcessInput
While _MouseInput: MouseScroll = MouseScroll + _MouseWheel: Wend
K = _KeyHit
If _KeyDown(100306) Or _KeyDown(100305) Then CTRL = True Else CTRL = False
If _KeyDown(100304) Or _KeyDown(100303) Then SHIFT = True Else SHIFT = False
If _KeyDown(100308) Or _KeyDown(100307) Then ALT = True Else ALT = False
Select Case K
Case 19200 'left
If CTRL Then
If ScreenWidth >= 650 Then ScreenWidth = ScreenWidth - _FontWidth: AutoResize
ElseIf ALT Then
If FontSize > 0 Then FontSize = FontSize - 1: _Font Font(FontSize): AutoResize
End If
Case 18432 'up
If CTRL Then
If ScreenHeight >= 410 Then ScreenHeight = ScreenHeight - _FontHeight: AutoResize
ElseIf ALT Then
If Brightness > 1 Then Brightness = Brightness - 1: Color _RGB32(255 \ Brightness), 0
End If
Case 19712 'right
If CTRL Then
If ScreenWidth <= _DesktopWidth - 10 Then ScreenWidth = ScreenWidth + _FontWidth: AutoResize
ElseIf ALT Then
If FontSize < 10 Then FontSize = FontSize + 1: _Font Font(FontSize): AutoResize
End If
Case 20480 'down
If CTRL Then
If ScreenHeight <= _DesktopHeight - 10 Then ScreenHeight = ScreenHeight + _FontHeight: AutoResize
ElseIf ALT Then
If Brightness < 10 Then Brightness = Brightness + 1: Color _RGB32(255 \ Brightness), 0
End If
Case 27
System
End Select
End Sub
Sub AutoResize
Static OldFontSize
W = _Width(DisplayScreen): H = _Height(DisplayScreen)
FW = _FontWidth: FH = _FontHeight
RW = ScreenWidth: RH = ScreenHeight
RW = _Round(RW / FW) * FW
RH = _Round(RH / FH) * FH
ScreenWidth = RW: ScreenHeight = RH
tempscreen = _NewImage(RW, RH, 32)
Screen tempscreen
_FreeImage DisplayScreen
DisplayScreen = tempscreen
tempscreen = _NewImage(RW, 32000, 32) 'create the newly sized WorkScreen
_Dest tempscreen 'can't freeimage a screen if it's in use?
_FreeImage WorkScreen 'free the old WorkScreen
WorkScreen = tempscreen
_Dest WorkScreen
_Font Font(FontSize)
Color _RGB32(255 \ Brightness), 0
OldFontSize = FontSize
ReDrawScreen = -1
End Sub
''$INCLUDE:'Keyboard Library.BM'
Now, since I couldn't get $RESIZE:ON to work the way I was wanting, with a limit for size, I took it out of this program. Instead, the user here now has several options, all of which are keyboard operated:
CTRL + Arrow Keys = Resize the screen. You can make this program bigger or smaller, on the fly.
ALT + Left/Right Arrow = Increase or Decrease the size of the font on the screen. Notice that this can also change the size of the screen slightly to suit the new fontwidth and fontheight.
ALT + Up/Down Arrow = Increase or Decrease the brightness of the text on the screen. Late at night, I tend to do things with the lights off and while sitting in the dark a lot of the times, and a bright display ends up hurting my eyes. This corrects that issue by allowing us to adjust the brightness of the text so that we can might it more intense in times of high surrounding light, or turn it waaay down, if we prefer, for use in the dark.
Now, we're not actually doing anything with this program as of yet, but it does use two distinct screens for us -- a WorkScreen and a DisplayScreen. The WorkScreen is 32000 pixels in height, so we can print multiple pages of text upon it, and then display segments upon the DisplayScreen, for ease of scrolling up and down with screens which hold more than a single page of information.
I'll be adding word wrap along with the auto-resizing features, and then the basic interface will more-or-less be done for my needs. If you guys want, I'll post a version of this with a nice long page of junk and word wrap to bring it all together, but I thought I'd go ahead and share it as it is, in case anyone else would ever be interested in making use of this type of user-interactive interface. Personally, I think it'd make a nice little way to allow the user some display options for something like a text-adventure game, or any type of program which would be heavy on text usage.
As I get older, I find it's always nice to be able to make text a little bigger/smaller and brighter/dimmer, depending on the state of my poor eyes. What we have here is basically just a little plug-in routine which is ready built to handle most of that for us already. With just a few minor enhancements, I imagine this will be something which I might end up making a lot of use of in the future. 
|
|
|
| Resize breaking |
|
Posted by: SMcNeill - 08-01-2022, 07:01 PM - Forum: Help Me!
- Replies (11)
|
|
An example of some code which I'm having issues with, which may be a glitch in QB64, or might be a glitch in poor Steve. I thought I'd post it here to share so others could test it out and see what's wrong with it.
Code: (Select All) 'Set compiler and global progeam options
'All variables and arrays are dynamic by default
'$Dynamic
'Allow the screen to be resized, but handle operations manually.
$Resize:On
'Allow the use of color names for 32-bit screen mode
$Color:32
_Define A-Z As LONG 'default variable type is long
_Title "Test Glitch"
'Types and global variables
Dim Shared As Long ScreenWidth, ScreenHeight, DisplayScreen, WorkScreen, ReDrawScreen
Dim Shared As Long Font(10), FontSize
'Defaut vaues for global variables
ScreenWidth = 1280
ScreenHeight = 720
DisplayScreen = _NewImage(1024, 720, 32)
WorkScreen = _NewImage(1024, 32000, 32)
ReDrawScreen = 0
Font(0) = _LoadFont("courbd.ttf", 6, "monospace")
Font(1) = _LoadFont("courbd.ttf", 8, "monospace")
Font(2) = _LoadFont("courbd.ttf", 10, "monospace")
Font(3) = _LoadFont("courbd.ttf", 12, "monospace")
Font(4) = _LoadFont("courbd.ttf", 14, "monospace")
Font(5) = _LoadFont("courbd.ttf", 16, "monospace")
Font(6) = _LoadFont("courbd.ttf", 18, "monospace")
Font(7) = _LoadFont("courbd.ttf", 22, "monospace")
Font(8) = _LoadFont("courbd.ttf", 28, "monospace")
Font(9) = _LoadFont("courbd.ttf", 36, "monospace")
Font(10) = _LoadFont("courbd.ttf", 48, "monospace")
FontSize = 8 'starting font size
Screen DisplayScreen
_Delay .2
_Dest WorkScreen
_Font Font(FontSize)
clearFlag = _Resize
Do
AutoResize
Cls , 0
Print _Width(DisplayScreen), _Height(DisplayScreen)
_PutImage , WorkScreen, DisplayScreen, (0, 0)-Step(_Width(DisplayScreen), _Height(DisplayScreen))
_Limit 60
_Display
Loop
Sub AutoResize
Static OldFontSize
W = _Width(DisplayScreen): H = _Height(DisplayScreen)
FW = _FontWidth: FH = _FontHeight
If _Resize Then
Do
_Delay .1
Loop Until _Resize = 0 'wait for the user to finish their resize event
RW = _ResizeWidth: RH = _ResizeHeight
If RW < 640 Then RW = 640
If RW > _DesktopWidth Then RW = _DesktopWidth
If RH < 400 Then RH = 400
If RH > _DesktopHeight Then RH = _DesktopHeight
GoTo resize_event
End If
If OldFontSize <> FontSize Then
RW = W: RH = H
GoTo resize_event
End If
Exit Sub
resize_event:
RW = (RW \ FW) * FW
RH = (RH \ FH) * FH
tempscreen = _NewImage(RW, 32000, 32) 'create the newly sized WorkScreen
_Dest tempscreen 'can't freeimage a screen if it's in use?
_FreeImage WorkScreen 'free the old WorkScreen
WorkScreen = tempscreen
_Dest WorkScreen
_Font Font(FontSize)
tempscreen = _NewImage(RW, RH, 32)
Screen tempscreen
_FreeImage DisplayScreen
DisplayScreen = tempscreen
OldFontSize = FontSize
ReDrawScreen = -1
Do
_Delay .1
Loop Until _Resize = 0
End Sub
Now, at the moment, this doesn't do much except print the width and height of the screen for us. Generally, it works as it should, with one exception -- if we drag the size below the minimum bounds set by the program (640x400).
The first time we snap below 640 width, the program does as it should and resizes back up to 640.
If we then grab it and resize it down below 640 width a second time, the screen loses that snap-ability and refuses to resize. Oddest thing however, is that it still reports itself as being 640 wide, even when it's obviously not.
I've no clue where the glitch is in the matrix on this one!
To add to the oddness, you can then drag the width back to the right a few times, and pass that 640 mark, and after a few attempts, the resize routine will start working just peachy fine again -- as long as you don't go below the 640 limit.
So what's the glitch here guys? Is QB64 doing something oddish, or is it just me with a broken head? 
|
|
|
|
| File path within program |
|
Posted by: james2464 - 08-01-2022, 05:52 PM - Forum: Help Me!
- Replies (2)
|
 |
Hi,
I'm following the tutorial at qb64sourcecode.com and because the sound files don't work I'm trying to understand why. Can anyone explain the way this command works? I've copied and pasted the tutorial folder in a few places and I got it working on one computer but not on a second one. So I clearly don't get it. The folder containing qb64.exe is where the tutorial folder is pasted, yet the "piano" and task 14 programs don't work.
Phaser& = _SndOpen(".\tutorial\task14\Phaser.ogg")
I was under the impression that this points to a location relative to the qb64.exe itself. But yeah I have no idea now.
Edit: I can get this to work by removing all the folder info and just leaving the file name. Example ("Phaser.ogg") So I'm still unclear about ".\" At this point I'm assuming I must have installed qb64 in the wrong place in order for the tutorial paths to work as is. Either way thanks to the wiki I can test this with the '_fileexists' command.
|
|
|
|
| Don't make me REPETEND myself... |
|
Posted by: Pete - 07-31-2022, 08:57 PM - Forum: General Discussion
- Replies (23)
|
 |
So Jack got me working on string math again. I don't know whether to thank him or shoot him (refers to avatar) but, here we go again...
I was thinking if I ever want to address using repetends (repeating decimals) to make even simple string equations like 1 / 3 * 3 = 1, instead of .999... then I might need to explore how to identify those repeating decimal occurrences.
Below is a sample program (non idiot-proof so don't post it accepted invalid data) that I hope detects all instances of repetends. I coded the first part, and then added (pasted) in the division routine from my string math program.
Try inputting 1 as the numerator and 97 as the denominator and you will largest repetend I know of, 96 digits befor the sequence repeats!
Code: (Select All) WIDTH 170, 42
_SCREENMOVE 0, 0
DO
DIM SHARED runningtotal$, limit&&
limit&& = 200
LINE INPUT "Numerator: "; a$
LINE INPUT "Denominator: "; b$
calcdiv a$, b$
COLOR 14, 0: PRINT runningtotal$; " ";: COLOR 7, 0
IF INSTR(runningtotal$, ".") THEN
x$ = MID$(runningtotal$, INSTR(runningtotal$, ".") + 1)
x$ = MID$(x$, LEN(b$) - LEN(a$) + 2)
FOR i = 1 TO LEN(x$)
k = j
j = INSTR(i + 1, x$, MID$(x$, 1, i))
IF j = k THEN EXIT FOR
NEXT
SELECT CASE j
CASE 0
IF MID$(x$, 1, 2) <> MID$(x$, 2, 2) OR LEN(x$) < 2 THEN
msg$ = "Non-repetend."
ELSE
IF MID$(runningtotal$, INSTR(runningtotal$, ".") + 1, 1) <> MID$(x$, 1, 1) THEN
msg$ = "Eventual infinite repetend."
ELSE
msg$ = "Repetend infinite."
END IF
END IF
CASE ELSE
msg$ = "Repetend length: " + LTRIM$(STR$(j - 1))
END SELECT
ELSE
msg$ = "Non-decimal"
END IF
PRINT msg$
CLEAR
PRINT
LOOP
SUB calcdiv (a$, b$)
stringmatha$ = a$
stringmathb$ = b$
operationdivision% = -1
divbuffer& = LEN(stringmathb$) - LEN(stringmatha$)
IF divbuffer& < 0 THEN divbuffer& = 0
d2dividend$ = stringmatha$
d1divisor$ = stringmathb$
IF LEFT$(d1divisor$, 1) = "0" AND LEN(d1divisor$) = 1 THEN PRINT "Division by zero not allowed.": EXIT SUB
IF LEFT$(d1divisor$, 1) = "-" THEN divsign% = -1: d1divisor$ = MID$(d1divisor$, 2)
IF LEFT$(d2dividend$, 1) = "-" THEN
IF divsign% THEN
divsign% = 0
ELSE
divsign% = -1
END IF
d2dividend$ = MID$(d2dividend$, 2)
END IF
IF INSTR(d1divisor$, ".") <> 0 THEN
DO UNTIL RIGHT$(d1divisor$, 1) <> "0"
d1divisor$ = MID$(d1divisor$, 1, LEN(d1divisor$) - 1) ' Strip off trailing zeros
LOOP
divplace& = LEN(d1divisor$) - INSTR(d1divisor$, ".")
d1divisor$ = MID$(d1divisor$, 1, INSTR(d1divisor$, ".") - 1) + MID$(d1divisor$, INSTR(d1divisor$, ".") + 1) ' Strip off decimal point.
DO UNTIL LEFT$(d1divisor$, 1) <> "0"
d1divisor$ = MID$(d1divisor$, 2) ' Strip off leading zeros for divisors smaller than .1
LOOP
END IF
IF INSTR(d2dividend$, ".") <> 0 THEN
d2dividend$ = d2dividend$ + STRING$(divplace& - LEN(d2dividend$) - INSTR(d2dividend$, "."), "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
divplace2& = INSTR(d2dividend$, ".")
DO UNTIL RIGHT$(d2dividend$, 1) <> "0"
d2dividend$ = MID$(d2dividend$, 1, LEN(d2dividend$) - 1) ' Strip off trailing zeros
LOOP
d2dividend$ = MID$(d2dividend$, 1, INSTR(d2dividend$, ".") - 1) + MID$(d2dividend$, INSTR(d2dividend$, ".") + 1) ' Strip off decimal point.
ELSE
d2dividend$ = d2dividend$ + STRING$(divplace&, "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
divplace& = 0
END IF
DO
DO
divremainder& = divremainder& + 1: divremainder$ = divremainder$ + MID$(d2dividend$, divremainder&, 1)
IF MID$(d2dividend$, divremainder&, 1) = "" THEN
IF divremainder$ = STRING$(LEN(divremainder$), "0") AND LEN(quotient$) > LEN(d2dividend$) THEN divflag% = -1: EXIT DO
divcarry& = divcarry& + 1
IF divcarry& = 1 THEN divplace3& = divremainder& - 1
IF divcarry& > limit&& + 1 + divbuffer& THEN
divflag% = -2: EXIT DO
END IF
divremainder$ = divremainder$ + "0" ' No more digits to bring down.
END IF
IF LEN(divremainder$) > LEN(d1divisor$) OR LEN(divremainder$) = LEN(d1divisor$) AND divremainder$ >= d1divisor$ THEN EXIT DO
quotient$ = quotient$ + "0"
LOOP
IF divflag% THEN divflag% = 0: EXIT DO
FOR div_i% = 9 TO 1 STEP -1
stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
m_product$ = "": GOSUB string_multiply
tempcutd$ = divremainder$ ' divremainder$ can be 00 or other leading zero values.
DO
IF LEN(tempcutd$) = 1 THEN EXIT DO
IF LEFT$(tempcutd$, 1) = "0" THEN
tempcutd$ = MID$(tempcutd$, 2)
ELSE
EXIT DO
END IF
LOOP
IF LEN(tempcutd$) > LEN(m_product$) OR LEN(tempcutd$) = LEN(m_product$) AND m_product$ <= tempcutd$ THEN EXIT FOR
NEXT
quotient$ = quotient$ + LTRIM$(STR$(div_i%))
stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
m_product$ = "": GOSUB string_multiply
operator$ = "-"
stringmatha$ = divremainder$
stringmathb$ = m_product$
GOSUB string_add_subtract
divremainder$ = stringmatha$
operator$ = "/"
LOOP
IF divplace& = 0 AND divplace2& = 0 THEN divplace& = divplace3&
IF divplace2& THEN divplace& = divplace& + divplace2& - 1
IF quotient$ = "" THEN divplace& = 0 ' dividend is zero.
IF divplace& OR divplace2& THEN
quotient$ = MID$(quotient$, 1, divplace&) + "." + MID$(quotient$, divplace& + 1)
DO UNTIL RIGHT$(quotient$, 1) <> "0"
quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off trailing zeros
LOOP
IF RIGHT$(quotient$, 1) = "." THEN quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off abandoned decimal.
END IF
DO UNTIL LEFT$(quotient$, 1) <> "0"
quotient$ = MID$(quotient$, 2) ' Strip off leading zeros
LOOP
IF quotient$ = "" THEN quotient$ = "0": divsign% = 0
operationdivision% = 0
stringmathb$ = quotient$: quotient$ = ""
'''GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN divsign% = 0: EXIT SUB
'''GOSUB sm_converter
runningtotal$ = stringmathb$: stringmathb$ = ""
IF divsign% THEN runningtotal$ = "-" + runningtotal$
IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
EXIT SUB
string_multiply:
fac1$ = stringmatha$: fac2$ = stringmathb$ ' Make numbers whole numbers and remove any - sign.
IF LEFT$(fac1$, 1) = "-" THEN fac1$ = MID$(fac1$, 2): m_sign% = -1
IF LEFT$(fac2$, 1) = "-" THEN fac2$ = MID$(fac2$, 2): IF m_sign% THEN m_sign% = 0 ELSE m_sign% = -1
IF INSTR(fac1$, ".") <> 0 THEN m_decimal_places& = LEN(fac1$) - INSTR(fac1$, "."): fac1$ = MID$(fac1$, 1, INSTR(fac1$, ".") - 1) + MID$(fac1$, INSTR(fac1$, ".") + 1)
IF INSTR(fac2$, ".") <> 0 THEN m_decimal_places& = m_decimal_places& + LEN(fac2$) - INSTR(fac2$, "."): fac2$ = MID$(fac2$, 1, INSTR(fac2$, ".") - 1) + MID$(fac2$, INSTR(fac2$, ".") + 1)
FOR m_i& = LEN(fac2$) TO 1 STEP -1 ' Multiply each charter top and bottom.
m_k& = m_l&
m_x2$ = MID$(fac2$, m_i&, 1)
FOR m_j& = LEN(fac1$) TO 1 STEP -1
m_x1$ = MID$(fac1$, m_j&, 1)
IF m_product$ <> "" THEN
m_add$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0")
m_t& = 0: m_xproduct$ = "": m_carry% = 0
DO ' Add multiplied characters together.
m_x3$ = MID$(m_add$, LEN(m_add$) - m_t&, 1)
m_x4$ = MID$(m_product$, LEN(m_product$) - m_t&, 1)
IF m_x3$ = "" AND m_x4$ = "" THEN
IF m_carry% THEN m_xproduct$ = "1" + m_xproduct$
EXIT DO
END IF
m_g% = VAL(m_x3$) + VAL(m_x4$) + m_carry%
IF m_g% >= 10 THEN m_g% = m_g% - 10: m_carry% = 1 ELSE m_carry% = 0
m_xproduct$ = LTRIM$(STR$(m_g%)) + m_xproduct$
m_t& = m_t& + 1
LOOP
m_product$ = m_xproduct$: m_xproduct$ = ""
ELSE
m_product$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0") ' First loop makes variable here.
END IF
m_k& = m_k& + 1 ' Adds trailing zeros multiplication
NEXT
m_l& = m_l& + 1 ' Used to reset value for m_k& adding one trailing zer for each loop.
NEXT
fac1$ = "": fac2$ = "": m_l& = 0: m_k& = 0: m_t& = 0
IF m_decimal_places& > LEN(m_product$) THEN m_product$ = STRING$(m_decimal_places& - LEN(m_product$), "0") + m_product$ ' Add any leading zeros to a decimal. Ex: .02 * .01 is factored as 002. It needs one leading zero before adding the decimal point, .0002.
IF m_decimal_places& AND m_product$ <> "0" THEN ' Replace any decimal point.
m_product$ = MID$(m_product$, 1, LEN(m_product$) - m_decimal_places&) + "." + MID$(m_product$, LEN(m_product$) - m_decimal_places& + 1)
END IF
DO UNTIL LEFT$(m_product$, 1) <> "0" ' Remove leading zeros.
m_product$ = MID$(m_product$, 2)
LOOP
IF m_decimal_places& THEN
DO UNTIL RIGHT$(m_product$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1)
LOOP
END IF
IF m_product$ = "" THEN m_product$ = "0": m_sign% = 0
IF RIGHT$(m_product$, 1) = "." THEN m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1) ' Remove decimal from the end of an integer total.
IF operationdivision% THEN m_sign% = 0: RETURN
stringmathb$ = m_product$: m_product$ = ""
'''GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN EXIT SUB
'''GOSUB sm_converter
runningtotal$ = stringmathb$: stringmathb$ = ""
IF m_sign% THEN runningtotal$ = "-" + runningtotal$: m_sign% = 0
RETURN
string_add_subtract:
IF INSTR(stringmatha$, ".") <> 0 THEN ' Evaluate sum for decimal fraction.
sumplace& = LEN(stringmatha$) - INSTR(stringmatha$, ".")
stringmatha$ = MID$(stringmatha$, 1, INSTR(stringmatha$, ".") - 1) + MID$(stringmatha$, INSTR(stringmatha$, ".") + 1) ' Strip out decimal
END IF
IF INSTR(stringmathb$, ".") <> 0 THEN ' Evaluate number for decimal fraction.
numplace& = LEN(stringmathb$) - INSTR(stringmathb$, ".")
stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Strip out decimal
END IF
IF sumplace& > numplace& THEN addsubplace& = sumplace& ELSE addsubplace& = numplace&
IF sumplace& > addsubplace& THEN
stringmatha$ = stringmatha$ + STRING$(sumplace& - addsubplace&, "0")
ELSEIF addsubplace& > sumplace& THEN
stringmatha$ = stringmatha$ + STRING$(addsubplace& - sumplace&, "0")
END IF
IF numplace& > addsubplace& THEN
stringmathb$ = stringmathb$ + STRING$(numplace& - addsubplace&, "0")
ELSEIF addsubplace& > numplace& THEN
stringmathb$ = stringmathb$ + STRING$(addsubplace& - numplace&, "0")
END IF ' END Decimal evaluations.
IF LEFT$(stringmatha$, 1) = "-" THEN sign_input$ = "-" ELSE sign_input$ = "+"
IF LEFT$(stringmathb$, 1) = "-" THEN sign_total$ = "-" ELSE sign_total$ = "+"
addsubsign% = 0
SELECT CASE sign_input$ + operator$ + sign_total$
CASE "+++", "+--"
operator$ = "+"
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
CASE "++-", "+-+"
operator$ = "-"
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
IF VAL(stringmathb$) > VAL(stringmatha$) THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
CASE "---", "-++"
operator$ = "-"
IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
IF VAL(stringmathb$) > VAL(stringmatha$) THEN SWAP stringmatha$, stringmathb$ ELSE addsubsign% = -1
CASE "--+", "-+-"
operator$ = "+"
IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
addsubsign% = -1
END SELECT
IF LEN(stringmatha$) > LEN(stringmathb$) THEN
stringmathb$ = STRING$(LEN(stringmatha$) - LEN(stringmathb$), "0") + stringmathb$
ELSEIF LEN(stringmatha$) < LEN(stringmathb$) THEN
stringmatha$ = STRING$(LEN(stringmathb$) - LEN(stringmatha$), "0") + stringmatha$
END IF
addsubx1$ = ""
SELECT CASE operator$
CASE "+", "="
FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) + VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
IF addsubx1% > 9 THEN addsubx1% = addsubx1% - 10: addsubcarry% = 1 ELSE addsubcarry% = 0
addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
NEXT
IF addsubcarry% THEN addsubx1$ = "1" + addsubx1$: addsubcarry% = 0
GOSUB replace_decimal
CASE "-"
FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) - VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
IF addsubx1% < 0 THEN addsubx1% = addsubx1% + 10: addsubcarry% = -1 ELSE addsubcarry% = 0
addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
NEXT
IF addsubx1$ <> "" AND addsubx1$ <> STRING$(LEN(addsubx1$), "0") THEN GOSUB replace_decimal
DO UNTIL LEFT$(addsubx1$, 1) <> "0" ' Remove leading zeros.
addsubx1$ = MID$(addsubx1$, 2)
LOOP
IF addsubx1$ = "" THEN
addsubx1$ = "0": addsubsign% = 0
ELSE
IF addsubcarry% THEN addsubx1$ = "-" + addsubx1$: addsubcarry% = 0
END IF
END SELECT
IF addsubsign% THEN
IF LEFT$(addsubx1$, 1) = "-" THEN addsubx1$ = MID$(addsubx1$, 2) ELSE addsubx1$ = "-" + addsubx1$
END IF
stringmatha$ = addsubx1$: addsubx1$ = ""
IF operationdivision% THEN RETURN
stringmathb$ = stringmatha$: stringmatha$ = ""
IF LEFT$(stringmathb$, 1) = "-" THEN
stringmathb$ = MID$(stringmathb$, 2)
n2sign$ = "-"
ELSE
n2sign$ = ""
END IF
''' GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN n2sign$ = "": EXIT SUB
''' GOSUB sm_converter
runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
RETURN
replace_decimal:
IF addsubplace& THEN
addsubx1$ = STRING$(addsubplace& - LEN(addsubx1$), "0") + addsubx1$
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - addsubplace&) + "." + MID$(addsubx1$, LEN(addsubx1$) - addsubplace& + 1)
DO UNTIL RIGHT$(addsubx1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1)
addsubplace& = addsubplace& - 1
LOOP
IF RIGHT$(addsubx1$, 1) = "." THEN addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1) ' Number is now an integer.
END IF
RETURN
END SUB
For you math folks, if you have a more elegant way to do this, I'd love to see it. Also, please excuse the message for "Eventual infinite repetend." I used this made up term to describe fractions like 1 / 6 where the digits repeat, but not immediately following the decimal point like 1 / 3 does. If you know the correct term for this type of repetend, please let me know.
Pete
|
|
|
|
| Grave Dayz |
|
Posted by: James D Jarvis - 07-31-2022, 06:12 PM - Forum: Programs
- Replies (2)
|
 |
A simple text-mode zombie surviving game.
You're trapped in a graveyard with the newly risen dead all you can do is dig fresh holes and trick them to fall in.
It's a pretty simple "robotron" style game with no shooting. I've only made it to level 4 myself.
Code: (Select All) 'GRAVE DAYZ
'By James D. Jarvis
' inspired by a game from usborne books (but sharing no code)
Randomize Timer
_ControlChr Off
Dim Shared g(60, 30)
Dim Shared D$(6)
Type zombietype
x As Integer 'x position
y As Integer 'y position
k As Integer 'color
m As Integer 'mobility
s As Integer 'strength
End Type
Dim Shared zom(20) As zombietype
Dim Shared zombies, zombiecount
Dim Shared px, py, psta, holes, score, lvl
Dim Shared gameflag$
gameflag$ = "playon"
Width 80, 43
_FullScreen
D$(1) = Chr$(1) 'player
D$(2) = Chr$(2) ' zombies
D$(3) = Chr$(206) 'gravestone
D$(4) = Chr$(35) 'wall
D$(5) = Chr$(177) 'hole
D$(6) = Chr$(42) 'bush
lvl = 1
psta = 250
newgame:
zombies = 5 + Int((1 + lvl) / 2)
zombiecount = zombies
px = Int(30 + Rnd * 3): py = Int(14 + Rnd * 3)
holes = 0
For x = 1 To 60
For y = 1 To 30
g(x, y) = 0
If Rnd * 20 <= lvl Then
p = Int(Rnd * 6) + 1
Select Case p
Case 3
g(x, y) = 3
Case 4
g(x, y) = 3
Case 5
If lvl < 5 Then
If holes < 6 Then
g(x, y) = 3
holes = holes + 1
End If
End If
Case 6
g(x, y) = 6
End Select
End If
If y = 1 Then g(x, y) = 4
If y = 30 Then g(x, y) = 4
If x = 1 Then g(x, y) = 4
If x = 60 Then g(x, y) = 4
Next y
Next x
If g(px, py) <> 0 Then g(px, py) = 0
For z = 1 To zombies
If lvl < 10 Then
c = Int(1 + Rnd * 4)
Select Case c
Case 1
zom(z).x = Int(Rnd * 6) + 2
zom(z).y = Int(Rnd * 6) + 2
Case 2
zom(z).x = Int(Rnd * 6) + 45
zom(z).y = Int(Rnd * 6) + 2
Case 3
zom(z).x = Int(Rnd * 6) + 2
zom(z).y = Int(Rnd * 6) + 24
Case 4
zom(z).x = Int(Rnd * 6) + 45
zom(z).y = Int(Rnd * 6) + 24
End Select
Else
c = Int(1 + Rnd * 4)
Select Case c
Case 1
zom(z).x = Int(Rnd * 59) + 2
zom(z).y = Int(Rnd * 12) + 2
Case 2
zom(z).x = Int(Rnd * 20) + 2
zom(z).y = Int(Rnd * 12) + 2
Case 3
zom(z).x = Int(Rnd * 59) + 2
zom(z).y = Int(Rnd * 12) + 2
Case 4
zom(z).x = Int(Rnd * 20) + 2
zom(z).y = Int(Rnd * 12) + 16
End Select
End If
zom(z).m = Int(1 + (1 + Rnd * lvl) / 5)
zom(z).s = Int(1 + Int((1 + Rnd * lvl) / 4))
zom(z).k = 10
Next z
Do
drawscreen
If psta > 0 Then
waitforK:
kk$ = InKey$
If kk$ = "" Then GoTo waitforK
End If
playermove (kk$)
zombiemove
For z = 1 To zombies
If zom(z).x = px And zom(z).y = py Then gameflag$ = "gotyou"
If g(zom(z).x, zom(z).y) = 5 And zom(z).s > 0 Then
score = score + 50
zombiecount = zombiecount - 1
If Rnd * 25 < lvl Then g(zom(z).x, zom(z).y) = 0 'zombies filling the holes more and more likely as the game goes on
drawscreen
Color 26, 0
For r = 1 To 6
_Limit 10
If r Mod 2 <> 0 Then
_PrintString (zom(z).x, zom(z).y), D$(2)
Else
_PrintString (zom(z).x, zom(z).y), "X"
End If
zom(z).s = 0
Next r
Color 15, 0
End If
Next z
If zombiecount = 0 Then gameflag$ = "nextlevel"
Loop Until gameflag$ <> "playon"
If gameflag$ = "gotyou" Then
For x = 5 To 11
_PrintString (15, x), "*************************************"
Next x
For x = 6 To 10
_PrintString (16, x), "..................................."
Next x
_PrintString (26, 7), "The Zombies Got You"
_PrintString (26, 9), "Play again? (Y/N)"
playask:
aa$ = InKey$
If aa$ = "" Then GoTo playask
aa$ = UCase$(aa$)
If aa$ = "Y" Then
lvl = 1
psta = 200
gameflag$ = "playon"
GoTo newgame
End If
If aa$ = "N" Then
System
Else
GoTo playask
End If
End If
If gameflag$ = "nextlevel" Then
score = lvl * 100
drawscreen
For x = 5 To 11
_PrintString (15, x), "*************************************"
Next x
For x = 6 To 10
_PrintString (16, x), "..................................."
Next x
T$ = "Completed Level " + Str$(level)
_PrintString (22, 7), T$
lvl = lvl + 1
T$ = "Press amy key for level " + Str$(lvl)
_PrintString (22, 9), T$
playask2:
aa$ = InKey$
If aa$ = "" Then GoTo playask
psta = psta + 150
gameflag$ = "playon"
GoTo newgame
End If
Sub drawscreen
Cls
For x = 1 To 60
For y = 1 To 30
If g(x, y) > 0 Then _PrintString (x, y), D$(g(x, y))
Next y
Next x
Color 14, 0
_PrintString (px, py), D$(1)
Color 15, 0
For z = 1 To zombies
Color zom(z).k, 0
If zom(z).s > 0 Then _PrintString (zom(z).x, zom(z).y), D$(2)
Next z
Color 12, 0
_PrintString (65, 3), "GRAVE DAYZ"
Color 15, 0
T$ = "Level " + Str$(lvl)
_PrintString (65, 5), T$
T$ = "Score " + Str$(score)
_PrintString (65, 8), T$
T$ = "Stamina" + Str$(psta)
If psta < 50 Then Color 12, 0
_PrintString (65, 11), T$
Color 10, 0
T$ = "Zombies " + Str$(zombiecount)
_PrintString (65, 13), T$
Color 7, 0
_PrintString (2, 32), "W,A,S,D to move (cost 1 Stamina)"
_PrintString (2, 34), "H to dig a hole (cost 10 stamina)"
_PrintString (2, 36), "You can't walk through walls, gravestones or bushes"
_PrintString (2, 38), "Avoid the zombies, get them all to return to the grave and advance a level!"
Color 15, 0
End Sub
Sub zombiemove
For z = 1 To zombies
zgx = 0
zgy = 0
If zom(z).s > 0 Then
If zom(z).y = py Then
If zom(z).x < px Then
zgx = 1
zgy = 0
End If
If zom(z).x > px Then
zgx = -1
zgy = 0
End If
Else If zom(z).x = px Then
If zom(z).y < py Then
zgx = 0
zgy = 1
End If
If zom(z).y > py Then
zgx = 0
zgy = -1
End If
End If
End If
If g(zom(z).x + zgx, zom(z).y + zgy) < 3 Or g(zom(z).x + zgx, zom(z).y + zgy) > 4 Then
zom(z).x = zom(z).x + zgx
zom(z).y = zom(z).y + zgy
End If
If Int(Rnd * 8) <= zom(z).m And zgx = 0 And zgy = 0 Then
Select Case Int(Rnd * 4)
Case 0
zgy = -1
zgx = 0
Case 1
zgy = 1
zgx = 0
Case 2
zgy = 0
zgx = 1
Case 3
zgy = 0
zgx = -1
End Select
If Int(Rnd * 6) < zom(z).m Then
If px < zom(z).x Then
zgx = -1
zgy = 0
End If
If px > zom(z).x Then
zgx = 1
zgy = 0
End If
End If
If Int(Rnd * 6) < zom(z).m And zgx = 0 Then
If py < zom(z).y Then zgy = -1
If py > zom(z).y Then zgy = 1
End If
If g(zom(z).x + zgx, zom(z).y + zgy) < 3 Or g(zom(z).x + zgx, zom(z).y + zgy) > 4 Then
zom(z).x = zom(z).x + zgx
zom(z).y = zom(z).y + zgy
End If
End If
End If
Next z
End Sub
Sub playermove (kk$)
kk$ = UCase$(kk$)
pgy = 0: pgx = 0
If psta > 0 Then
Select Case kk$
Case "W"
pgy = -1
pgx = 0
Case "A"
pgy = 0
pgx = -1
Case "S"
pgy = 1
pgx = 0
Case "D"
pgy = 0
pgx = 1
Case "H"
If psta > 9 Then
g(px, py) = 5
psta = psta - 10
End If
End Select
If pgy <> 0 Or pgx <> 0 Then
If g(px + pgx, py + pgy) < 3 Then
px = px + pgx
py = py + pgy
psta = psta - 1
End If
End If
End If
End Sub
|
|
|
|
| Hello world! |
|
Posted by: return_to_zork - 07-31-2022, 05:38 PM - Forum: General Discussion
- Replies (8)
|
 |
Hello all,
I didn't see a specific thread for introductions, so I just wanted to take a second to introduce myself. My name is Joe and and I'm a mail carrier by day, aspiring adventure game writer by night. I'm sure this is a common story around here, but I first discovered QBasic on the family computer back when I was in Elementary school (Windows 3.1 days) and instantly fell in love. I remember scouring the early internet and my local library for anything I could read on QB.
I spent a lot of years downloading other peoples' games and programs, learning the ins and outs of the software, and eventually even tried to write my own games. Ultimately, though, I was just a little kid and nothing of substance ever came to fruition. I don't remember the exact day it happened, but at some point I closed QBasic for the final time and never went back to it.
Until now.
Sitting in my home some 25 years later, reflecting back on the good ol' days and I got bit by the bug. The itch to write that text adventure game I always wanted to but never did. I started exploring all the different options for writing an adventure game in 2022 and came across the usual suspects---Quest, Inform, Twine. But none of those were exactly what I was looking for. Until I came across a guy on YouTube doing exactly what I was looking to do myself: Going back and writing the text adventure game he always wanted to, but never did...in QBasic!
My mind was blown. I had no idea QB was even still being used. Then I found QB64, read about the incident that happened, and eventually found my way here. I'm currently working my way through Terry Ritchie's QB64 Game Programming Guide and getting all this rust off (Hey, it's been 25 years!). But I just wanted to say that I'm so glad I found this place.
I was wondering if anyone else on the forum has or is making their own text adventure games (either finished or unfinished) that I might check out while I'm getting my chops back. I'd love to see what other people in the community are working on.
But either way, nice to meet everyone and I hope to be a regular face around here!
|
|
|
|
| DNA Animation |
|
Posted by: SierraKen - 07-31-2022, 01:28 AM - Forum: Programs
- Replies (26)
|
 |
Well, I decided to fill in the circles in this animation because I came at a crossroads in trying to use the CIRCLE command with a black fill. The problem was that I could make the top 2 and the bottom 2 overlap in the right places, but not the 2nd and the 3rd. I have a Star Trek screen saver that shows something like this with a black fill (or no fill) and they overlap perfectly. I think I would have to try to use SIN and COS to make the circles instead of using the CIRCLE command and with that and possibly using POINT or another way to detect the math coordinates.
So anyway lol, here is my DNA animation with blue filled circles. I've never made this before because I'm still brand new with 3D stuff, but I thought I would have some fun with it.
Code: (Select All) _Title "DNA Animation by SierraKen"
Screen _NewImage(800, 600, 32)
Dim c As Long
t = 180
tt = 45
c = _RGB32(0, 127, 255)
Do
_Limit 50
x = (Sin(t) * 180) + 400
y = (Cos(t) * 180) / _Pi / 10 + 100
r = (Cos(t) * 180) / _Pi / 10 + 40
x2 = (Sin(t + .7) * 180) + 400
y2 = (Cos(t + .7) * 180) / _Pi / 10 + 165
r2 = (Cos(t + .7) * 180) / _Pi / 10 + 40
x3 = (Sin(t + 1.4) * 180) + 400
y3 = (Cos(t + 1.4) * 180) / _Pi / 10 + 230
r3 = (Cos(t + 1.4) * 180) / _Pi / 10 + 40
x4 = (Sin(t + 2.1) * 180) + 400
y4 = (Cos(t + 2.1) * 180) / _Pi / 10 + 295
r4 = (Cos(t + 2.1) * 180) / _Pi / 10 + 40
x5 = (Sin(t + 2.8) * 180) + 400
y5 = (Cos(t + 2.8) * 180) / _Pi / 10 + 360
r5 = (Cos(t + 2.8) * 180) / _Pi / 10 + 40
x6 = (Sin(t + 3.5) * 180) + 400
y6 = (Cos(t + 3.5) * 180) / _Pi / 10 + 425
r6 = (Cos(t + 3.5) * 180) / _Pi / 10 + 40
xx = (Sin(tt) * 180) + 400
yy = (Cos(tt) * 180) / _Pi / 10 + 100
rr = (Cos(tt) * 180) / _Pi / 10 + 40
xx2 = (Sin(tt + .7) * 180) + 400
yy2 = (Cos(tt + .7) * 180) / _Pi / 10 + 165
rr2 = (Cos(tt + .7) * 180) / _Pi / 10 + 40
xx3 = (Sin(tt + 1.4) * 180) + 400
yy3 = (Cos(tt + 1.4) * 180) / _Pi / 10 + 230
rr3 = (Cos(tt + 1.4) * 180) / _Pi / 10 + 40
xx4 = (Sin(tt + 2.1) * 180) + 400
yy4 = (Cos(tt + 2.1) * 180) / _Pi / 10 + 295
rr4 = (Cos(tt + 2.1) * 180) / _Pi / 10 + 40
xx5 = (Sin(tt + 2.8) * 180) + 400
yy5 = (Cos(tt + 2.8) * 180) / _Pi / 10 + 360
rr5 = (Cos(tt + 2.8) * 180) / _Pi / 10 + 40
xx6 = (Sin(tt + 3.5) * 180) + 400
yy6 = (Cos(tt + 3.5) * 180) / _Pi / 10 + 425
rr6 = (Cos(tt + 3.5) * 180) / _Pi / 10 + 40
t = t - .05
tt = tt - .05
cx = x: cy = y
fillCircle cx, cy, r, c
cx = x2: cy = y2
fillCircle cx, cy, r2, c
cx = x3: cy = y3
fillCircle cx, cy, r3, c
cx = x4: cy = y4
fillCircle cx, cy, r4, c
cx = x5: cy = y5
fillCircle cx, cy, r5, c
cx = x6: cy = y6
fillCircle cx, cy, r6, c
cx = xx: cy = yy
fillCircle cx, cy, rr, c
cx = xx2: cy = yy2
fillCircle cx, cy, rr2, c
cx = xx3: cy = yy3
fillCircle cx, cy, rr3, c
cx = xx4: cy = yy4
fillCircle cx, cy, rr4, c
cx = xx5: cy = yy5
fillCircle cx, cy, rr5, c
cx = xx6: cy = yy6
fillCircle cx, cy, rr6, c
_Display
Cls
Loop Until InKey$ = Chr$(27)
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
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
|
|
|
|
| Neverending loop |
|
Posted by: SMcNeill - 07-30-2022, 03:18 AM - Forum: Help Me!
- Replies (15)
|
|
So here's one that has me scratching my head, that maybe you guys can take a look at with a fresh set of eyes and sort out:
Code: (Select All) Screen _NewImage(1280, 720, 32)
$Color:32
f = _LoadFont("courbd.ttf", 128, "monospace")
_Font f
Color Red, Transparent
_PrintString (284, 200), "Steve is" '284 - 644
_PrintString (284, 328), "Awesome!"
Sleep
_Font 8
Explode 284, 200, 644, 456, 16, 16
Print "FINISHED!!"
Sub Explode (x1, y1, x2, y2, pw, ph)
tempScreen = _NewImage(_Width, _Height, 32)
_PutImage , 0, tempScreen
w = x2 - x1 + 1: h = y2 - y1 + 1
ax = 2 * w \ pw + 1: ay = 2 * h \ ph + 1
cx = x1 + w \ 2: cy = y1 + h \ 2
Type box
x As Single
y As Single
handle As Long
rotation As Single
changex As Single
changey As Single
End Type
Dim Array(0 To ax, 0 To ay) As box
For x = 0 To ax
For y = 0 To ay
Array(x, y).handle = _NewImage(pw, ph, 32)
Array(x, y).x = x1 + pw * x
Array(x, y).y = y1 + ph * y
_PutImage , 0, Array(x, y).handle, (x1 + pw * x, y1 + ph * y)-Step(pw, ph)
Array(x, y).changex = -(cx - Array(x, y).x) / 10
Array(x, y).changey = -(cy - Array(x, y).y) / 10
Next
Next
Do
Cls , 0
finished = -1
For x = 0 To ax
For y = 0 To ay
Array(x, y).x = Array(x, y).x + Array(x, y).changex
Array(x, y).y = Array(x, y).y + Array(x, y).changey
If Array(x, y).x >= 0 And Array(x, y).y >= 0 And _
Array(x, y).x <= _Width And Array(x, y).y <= _Height Then finished = 0
_PutImage (Array(x, y).x, Array(x, y).y)-Step(pw, ph), Array(x, y).handle, 0, (0, 0)-(pw, ph)
Next
Next
_Display
_Limit 60
Loop Until finished
_AutoDisplay
End Sub
This is supposed to be just a simple little routine which explodes a portion of the screen off the screen. It works as intended, except for the simple fact that it doesn't know when to stop working, resulting in an endless loop!
Our main logic here comes from this little snippet of code:
Do
Cls , 0
finished = -1
For x = 0 To ax
For y = 0 To ay
Array(x, y).x = Array(x, y).x + Array(x, y).changex
Array(x, y).y = Array(x, y).y + Array(x, y).changey
If Array(x, y).x >= 0 And Array(x, y).y >= 0 And _
Array(x, y).x <= _Width And Array(x, y).y <= _Height Then finished = 0
_PutImage (Array(x, y).x, Array(x, y).y)-Step(pw, ph), Array(x, y).handle, 0, (0, 0)-(pw, ph)
Next
Next
_Display
_Limit 60
Loop Until finished
Our DO loop.
We clear the screen
Set a flag for being finished
The FOR loops
change the X/Y coordinates
IF we still have an X/Y coordinate on the screen, then we're not finished
Draw the image in its new positon
NEXT
Display
LOOP until finished
*********************************************
So the question becomes, "Why isn't this simple logic working?" We set the flag by default every time, and only if we draw on screen do we clear that flag... Why is this running as a non-terminating loop? Enquiring, tired old eyes are going to bed, and hoping that maybe someone here will figure out what the heck is going wrong with such a simple process.
|
|
|
|
| updated QB64.org forums/wiki link updater |
|
Posted by: madscijr - 07-29-2022, 09:56 PM - Forum: Programs
- Replies (3)
|
 |
The interface now uses InKey$ instead of Input, woohoo!
Code: (Select All) ' Opens google qb64.rip links in mirror site.
' https://staging.qb64phoenix.com/showthread.php?tid=429
' DATE WHO-DONE-IT DID-WHAT
' 2022-05-18 Pete Created QB64.org URL redirector.
' 2022-07-22 madscijr Added options menu and support for wiki.
' 2022-07-29 madscijr Changed input from Input to Inkey$.
' TEST LINKS:
' https://www.qb64.org/forum/index.php?topic=3348.0
' https://www.qb64.org/forum/index.php?topic=896.0
' https://www.qb64.org/forum/index.php?topic=1073.0
' http://www.qb64.org/wiki/SCREEN#Legacy_Screen_Modes
' http://www.qb64.org/wiki/TIMER_(statement)
' http://www.qb64.org/wiki/ON_TIMER(n)
' http://www.qb64.org/wiki/COLOR
Const FALSE = 0
Const TRUE = Not FALSE
Dim in$
Dim iCount%: iCount% = 0
Dim oldURL$
Dim parse$
Dim newURL$
Dim bUpdateClipboard%
Dim sOpenBrowser$
Dim sValue$
Dim sMessage$
Dim iPos%
Dim sKey$
Dim bChrome%
Dim bFirefox%
Dim bDontNavigate%
Dim bScreenUpdate%
bScreenUpdate% = TRUE
bUpdateClipboard% = TRUE
sOpenBrowser$ = "c"
sMessage$ = ""
Do
bChrome% = (sOpenBrowser$ = "g")
bFirefox% = (sOpenBrowser$ = "f")
bDontNavigate% = ((bChrome% = FALSE) And (bFirefox% = FALSE))
If (bScreenUpdate% = TRUE) Then
Cls
Print "QB64.org link updater by Pete, modified by madscijr"
Print
Print "1. Copy old link to clipboard first"
Print "2. Select options (see below)"
Print "3. Press ENTER to convert link and do something."
Print
Print "ESC = quit"
Print
Print "---------------------------------------------------"
Print "Clipboard options:"
Print "C = Enable update clipboard.........." + IIFSTR$(bUpdateClipboard%, "<---", " ")
Print "D = Disable update clipboard.........." + IIFSTR$(bUpdateClipboard%, " ", "<---")
Print
Print "Navigation options:"
Print "G = Navigates to new link in Chrome..." + IIFSTR$(bChrome%, "<---", " ")
Print "F = Navigates to new link in Firefox.." + IIFSTR$(bFirefox%, "<---", " ")
Print "N = Don't navigate to new link........" + IIFSTR$(bDontNavigate%, "<---", " ")
Print "---------------------------------------------------"
Print sMessage$: If Len(sMessage$) > 0 Then sMessage$ = ""
bScreenUpdate% = FALSE
End If
sKey$ = InKey$
If UCase$(sKey$) = "C" Then
If bUpdateClipboard% = FALSE Then
bUpdateClipboard% = TRUE
bScreenUpdate% = TRUE
End If
ElseIf UCase$(sKey$) = "D" Then
If bUpdateClipboard% = TRUE Then
bUpdateClipboard% = FALSE
bScreenUpdate% = TRUE
End If
ElseIf UCase$(sKey$) = "G" Then
If sOpenBrowser$ <> "g" Then
sOpenBrowser$ = "g"
bScreenUpdate% = TRUE
End If
ElseIf UCase$(sKey$) = "F" Then
If sOpenBrowser$ <> "f" Then
sOpenBrowser$ = "f"
bScreenUpdate% = TRUE
End If
ElseIf UCase$(sKey$) = "N" Then
If sOpenBrowser$ <> "n" Then
sOpenBrowser$ = "n"
bScreenUpdate% = TRUE
End If
ElseIf sKey$ = Chr$(27) Then
Exit Do
ElseIf sKey$ = Chr$(13) Then
If Len(_Clipboard$) Then
oldURL$ = LCase$(_Clipboard$)
' FORUMS:
' OLD: https://www.qb64.org/forum/index.php?topic={topic}
' NEW: https://qb64forum.alephc.xyz/index.php?topic={topic}
' WIKI:
' OLD: http://www.qb64.org/wiki/{topic}
' NEW: https://qb64phoenix.com/qb64wiki/index.php/{topic}
If InStr(oldURL$, "/www.qb64.org/forum/index.php") > 0 Then
' URL IS FROM FORUMS...
If InStr(oldURL$, "?topic=") > 0 Then
sMessage$ = sMessage$ + "Detected forum link." + Chr$(13)
parse$ = Mid$(oldURL$, InStr(oldURL$, "index"))
newURL$ = "https://qb64forum.alephc.xyz/" + parse$
Else
sMessage$ = sMessage$ + "Detected forum link, no topic." + Chr$(13)
' GOTO THE ROOT FORUMS URL
newURL$ = "https://qb64forum.alephc.xyz/index.php"
End If
iCount% = iCount% + 1
ElseIf InStr(oldURL$, "/www.qb64.org/wiki") > 0 Then
' URL IS FROM WIKI...
If InStr(oldURL$, "/www.qb64.org/wiki/") > 0 Then
sMessage$ = sMessage$ + "Detected wiki link." + Chr$(13)
iPos% = _InStrRev(oldURL$, "/wiki/")
If iPos% > 0 Then
parse$ = Right$(oldURL$, Len(oldURL$) - (iPos% + 5))
End If
newURL$ = "https://qb64phoenix.com/qb64wiki/index.php/" + parse$
Else
sMessage$ = sMessage$ + "Detected wiki link, no topic." + Chr$(13)
' GOTO THE ROOT WIKI URL
newURL$ = "https://qb64phoenix.com/qb64wiki/index.php"
End If
iCount% = iCount% + 1
Else
sMessage$ = sMessage$ + "Link not recognized." + Chr$(13)
newURL$ = ""
End If
If Len(newURL$) > 0 Then
sMessage$ = sMessage$ + "Converted, new URL is:" + Chr$(13) + newURL$ + Chr$(13)
If sOpenBrowser$ = "g" Then
sMessage$ = sMessage$ + "Opening new link in Chrome." + Chr$(13)
Shell _DontWait "chrome " + newURL$
ElseIf sOpenBrowser$ = "f" Then
sMessage$ = sMessage$ + "Opening new link in Firefox." + Chr$(13)
Shell _DontWait "firefox " + newURL$
End If
If bUpdateClipboard% = TRUE Then
sMessage$ = sMessage$ + "Copying new link to clipboard." + Chr$(13)
_Clipboard$ = newURL$
End If
End If
Else
sMessage$ = sMessage$ + "Clipboard is empty!" + Chr$(13)
End If
bScreenUpdate% = TRUE
End If
If bScreenUpdate% = TRUE Then
While InKey$ <> "": Wend ' Clear the keyboard buffer
End If
_Limit 60
Loop
'System
End
' /////////////////////////////////////////////////////////////////////////////
' IIF function for QB for strings
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Redirect old-forum and wiki search results to Pheonix as appropriate.
' https://staging.qb64phoenix.com/showthread.php?tid=429
' mpgcan
' 05-18-2022, 10:37 AM
'
' You know how it goes. Searching for a QB64 solution, search engines return
' results to the old-forum or old-wiki. Clicking the link only to be informed the
' server is not found.
'
' With the link returned, you can use part of it to search in either the new-wiki
' or old-backup forum. This has become very tedious. I thought there must be a
' better way.
'
' A simple solution is to use Einar Egilsson's Redirector for this. It is a
' browser add-on for Firefox, Chrome, Edge and Opera. The Redirector allows you
' to search for a specific URL, substitute it for another URL and force the
' browser to redirect to this new URL.
'
' How to install redirector on Firefox:
'
' 1) Use the following link to get the add-on
' https://addons.mozilla.org/en-GB/firefox/addon/redirector/
'
' 2) Note: This add-on is not actively monitored for security by Mozilla.
' Check out the "Learn more" link. After reading your choice
' if you wish to continue.
'
' 3) Click the Add to Firefox button.
'
' 4) Add Redirector? This extension will have permission to:
' Click Add button
'
' 5) Redirector was added.
' Click the check box. Allow this extension to run in Private Windows
' Click Okay button.
'
' 6) A redirector symbol is displayed at the top right of the browser
' confirming it is successfully installed.
'
' Configuring redirector:
' Redirect from the old QB64 forum to Phoenix's old-archived read only
' working forum.
'
' 1) Click on the redirector symbol in the drop down click
' "Edit Redirects" button.
' 2) On the new browser page that opens, click "Create New Redirect"
' 3) Fill in the form with the following information:
' Configuration information:
' Description........: QB64_forum_old_to_archive
' Example URL........: https://forum.qb64.org/
' Include pattern....: https://forum.qb64.org/*
' Redirect to........: https://qb64forum.alephc.xyz/$1
' Pattern type.......: Wildcard click radio buttom
' Pattern Description: Leave blank
' Example result: https://qb64forum.alephc.xyz/
' To complete it, click the "Save" button.
' 4) Click "Create New Redirect"
' 5) Fill in the form with the following information:
' Configuration information:
' Redirect from the old QB64 Wiki to Pheonix's new QB64 Wiki.
' Description : QB64_Wiki_old_to_new
' Example URL : https://wiki.qb64.org/wiki/
' Include pattern : https://wiki.qb64.org/wiki/*
' Redirect to : https://qb64phoenix.com/qb64wiki/index.php/$1
' Pattern type : Wildcard click radio buttom
' Pattern Description: Leave blank
' Example result: https://qb64phoenix.com/qb64wiki/index.php/
' To complete it, click the "Save" button.
' 6) Finally disable the first configuration
' "Example redirect, try going to http://example.com/anywordhere"
' By clicking the "Disable" button.
'
' Test:
' Try the following two links in your browser:
' https://forum.qb64.org/index.php?topic=456.0
' https://wiki.qb64.org/wiki/$IF
'
' All the best
' MPGCAN
'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' madscijr
' 05-19-2022, 11:39 AM
' (05-18-2022, 10:37 AM) mpgcan Wrote:
' >A simple solution is to use Einar Egilsson's Redirector for this.
' >It is a browser add-on for Firefox, Chrome, Edge and Opera.
' >The Redirector allows you to search for a specific URL,
' >substitute it for another URL and force the browser to redirect
' >to this new URL.
'
' Thanks for sharing this and explaining how to use it.
' This can come in handy for any number of things...
'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Pete, Administrator
' 05-19-2022, 01:21 AM
'
' Looks like a useful plugin.
' I made my own in QB64...
'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' madscijr
' 05-19-2022, 11:38 AM
'
' (05-19-2022, 01:21 AM) Pete Wrote:
' >Looks like a useful plugin.
' >I made my own in QB64...
'
' Very cool!
' Not only does it work and is useful, but I never knew QB64 could do that,
' and learned something knew.
' Thanks Pete
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
| Math's Trig Versus Basic's Trig Functions |
|
Posted by: bplus - 07-29-2022, 03:41 PM - Forum: bplus
- Replies (45)
|
 |
As if Trig is not confusing enough, the confusion is made far worse because in the Basic screen Y increases going down screen whereas in math graphing, you learned Y increases going up.
To make matters still more confusing, there are 2 unit measures for angles, Degrees and Radians.
Degrees go full circle from 0 to 360 in nice easy to understand way with integers giving a pretty accurate picture of the angle.
Radians go full circle from 0 to 2 * _Pi and with not so easy to picture angle measures unless you express them in fractions of 2*_Pi eg _Pi is 180 Degrees half a circle = 2*Pi / 2 which is just _Pi, _Pi / 2 = 90 one quarter of a circle 2*_PI / 4 same as _PI / 2.
120 Degrees is 1/3 of circle same as 2*_Pi / 3
60 Degrees is 1/6 of circle same as 2*_PI /6 = _Pi / 3
30 Degrees is 1/12 of circle same as 2 *_Pi / 12 = _PI / 6
Anyway here is maybe a Rosetta Stone for Math's Trig Comparing to Basic's Trig with pictures to show WTH? is what!
Code: (Select All) Option _Explicit
_Title "A Look at Math's Trig and Comparing to Basic's Trig Functions" 'b+ trans from:
' Another look at Trig functions.bas SmallBASIC 0.12.2 [B+=MGA] 2016-05-01
' inspired by PeterMaria's simple code for Atan2 on Aurels' forum BasicPro
' 2017-09-23 Modified to run again on Android
' Here is another effort in a continuing series to demystify Trig functions:
' Move your mouse around the center point of the screen and see the right triangles
' created with the mouse and a horizontal line from the center.
' See all the parts of the triangle expressed in numbers:
' Angles to the horizontal line, lengths of the sides and hypotenuse of the right
' and the COS, SIN and TAN ratios
'============================== Main
Const Xmax = 800, Ymax = 700
Const Thick = 2
Const Arc_radius = 100
Const Sin_color = _RGB32(0, 0, 255)
Const Cos_color = _RGB32(255, 0, 0)
Const Hyp_color = _RGB32(0, 192, 0)
Const Ang_color = _RGB32(255, 255, 0)
Const White = _RGB32(255, 255, 255)
Dim cx, cy, mx, my, stepX, stepY, hyp, dAng, startA, endA, reportA
cx = Xmax / 2: cy = Ymax / 2
Screen _NewImage(Xmax, Ymax, 32)
_ScreenMove 60, 0
_PrintMode _KeepBackground
_MouseMove cx + 100, cy + 100 ' get ball rolling
While 1
Cls
'draw horizontal through center of screen
Line (0, cy)-(Xmax, cy), Cos_color
' draw vertical line through center of screen
Line (cx, 0)-(cx, Ymax), Sin_color
'poll mouse
While _MouseInput: Wend ' updates all mouse stuff except wheel
mx = _MouseX: my = _MouseY 'get mouse location
'draw our Color Coded Trig Triangle
ThickLine cx, cy, mx, cy, Thick, Cos_color
ThickLine mx, cy, mx, my, Thick, Sin_color
ThickLine cx, cy, mx, my, Thick, Hyp_color
stepX = Abs(cx - mx): stepY = Abs(cy - my)
hyp = Int(((stepX ^ 2 + stepY ^ 2) ^ .5))
'to draw angle need to do some math
'dAng = mouse angle to 0 degrees due East
' other Angles: StartA, EndA and reportA are for the Trig Ratios of triangle
dAng = Int(_R2D(_Atan2(my - cy, mx - cx)) + .5)
If dAng < 0 Then dAng = dAng + 360
If dAng <= 90 Then
startA = 0: endA = dAng: reportA = dAng
ElseIf dAng <= 180 Then
startA = dAng: endA = 180: reportA = 90 - (dAng - 90)
ElseIf dAng <= 270 Then
startA = 180: endA = dAng: reportA = dAng - 180
ElseIf dAng <= 360 Then
startA = dAng: endA = 360: reportA = 90 - (dAng - 270)
End If
Color Ang_color
ThickArc cx, cy, Arc_radius, startA, endA, Thick
'report all numbers color coded
Color Ang_color
Locate 1, 1: Print " Yellow Angle (in degrees) ~ "; reportA
Color White
Locate 3, 1: Print " Lengths:"
Color Hyp_color
Locate 4, 1: Print " green Hyp ~ "; hyp
Color Sin_color
Locate 5, 1: Print " blue Opp ~ "; stepY \ 1
Color Cos_color
Locate 6, 1: Print " red Adj ~ "; stepX \ 1
Color White
Locate 8, 1: Print " Ratios: (if no division by 0)"
If hyp <> 0 Then
Color Cos_color
Locate 9, 2: Print "COS = Adj ";
Color Hyp_color
Print "/ Hyp ";
Color White
Print "~ "; Left$(Str$(stepX / hyp), 6)
Color Sin_color
Locate 10, 2: Print "SIN = Opp ";
Color Hyp_color
Print "/ Hyp ";
Color White
Print "~ "; Left$(Str$(stepY / hyp), 6)
End If
If stepX <> 0 Then
Locate 11, 2: Print "TAN = ";
Color Sin_color
Print "Opp ";
Color Cos_color
Print "/ Adj ";
Color White
Print "~ "; Left$(Str$(stepY / stepX), 6)
End If
Color &H55FFFFFF
Locate 33, 2: Print "QB64 Coding Notes for Basic Graphics without Window( ):"
Print " The Screen center Center X, Center Y is "; _Trim$(Str$(cx)); ", "; _Trim$(Str$(cy))
Print " Mouse X ="; mx; " MouseX - Center X = "; _Trim$(Str$(mx - cx))
Print " Mouse Y ="; my; " MouseY = Center Y = "; _Trim$(Str$(my - cx))
Print " So Mouse Angle in Radians = _Atan2(my - cy, mx - cx) ="; _Atan2(my - cy, mx - cx)
Print " Mouse Angle converted to Degrees rounding to nearest 1 = Int(_R2D(Radian Angle) +.5) = ";
Print _Trim$(Str$(Int(_R2D(_Atan2(my - cy, mx - cx)) + .5)))
Print " BUT! if Degrees < 0 add 360 to see angle in postive numbers from Basic's 0 (due East) = ";
If Int(_R2D(_Atan2(my - cy, mx - cx)) + .5) < 0 Then
Print _Trim$(Str$(Int(_R2D(_Atan2(my - cy, mx - cx)) + .5) + 360))
Else
Print _Trim$(Str$(Int(_R2D(_Atan2(my - cy, mx - cx)) + .5)))
End If
Print
Print " Move your mouse clockwise starting at 0 due East to see Basics Angle in Degrees increase."
_Display
_Limit 60
Wend
Sub ThickArc (xCenter, yCenter, arcRadius, dAngleStart, dAngleEnd, rThick)
Dim rAngle, rAngleStart, rAngleEnd, x1, y1, Stepper
'draws an Arc with center at xCenter, yCenter, radius from center is arcRadius
'for SmallBASIC angle 0 degrees is due East and angle increases clockwise towards South
'THIS SUB IS SETUP TO DRAW AN ARC IN CLOCKWISE DIRECTION
'dAngleStart is where to start Angle in degrees
' so make the dAngleStart the first ray clockwise from 0 degrees that starts angle drawing clockwise
'dAngleEnd is where the arc ends going clockwise with positive degrees
' so if the arc end goes past 0 degrees clockwise from dAngleStart
' express the end angle as 360 + angle
'rThick is the radius of the many,many tiny circles this will draw to make the arc thick
' so if rThick = 2 the circles will have a radius of 2 pixels and arc will be 4 pixels thick
If arcRadius < 1 Then PSet (xCenter, yCenter): Exit Sub
rAngleStart = _D2R(dAngleStart): rAngleEnd = _D2R(dAngleEnd)
If Int(rThick) = 0 Then Stepper = 1 / (arcRadius * _Pi) Else Stepper = rThick / (arcRadius * _Pi / 2)
For rAngle = rAngleStart To rAngleEnd Step Stepper
x1 = arcRadius * Cos(rAngle): y1 = arcRadius * Sin(rAngle)
If Int(rThick) < 1 Then
PSet (xCenter + x1, yCenter + y1)
Else
fcirc xCenter + x1, yCenter + y1, rThick, Ang_color
End If
Next
End Sub
Sub ThickLine (x1, y1, x2, y2, rThick, K As _Unsigned Long)
Dim length, stepx, stepy, dx, dy, i
'x1,y1 is one endpoint of line
'x2,y2 is the other endpoint of the line
'rThick is the radius of the tiny circles that will be drawn
' from one end point to the other to create the thick line
'Yes, the line will then extend beyond the endpoints with circular ends.
stepx = x2 - x1
stepy = y2 - y1
length = (stepx ^ 2 + stepy ^ 2) ^ .5
If length Then
dx = stepx / length: dy = stepy / length
For i = 0 To length
fcirc x1 + dx * i, y1 + dy * i, rThick, K
Next
End If
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
I sure hope this helps and does not add to the confusion.
|
|
|
|
|
