04-27-2022, 12:29 AM (This post was last modified: 04-27-2022, 12:43 AM by bplus.)
Screen Savers - you are welcome to post your own favorites in this thread!
________________________________________________________________________________________________
Pete's post of The Bob's Mystic version of a Screen Saver brought back memories of my own version and even today I continue to Modify. I didn't want to go Full Screen on this one because the Title bar has help for keys you can press to play with screen saver a bit add or subtract triangles, draw a mirror image and not toggle, change color scheme (Plasma of Course!)
Code: (Select All)
_Title "Mystic Memories by bplus, d toggles duplicate on/off, spacebar resets color, m = more, l = less triangles"
'posted 2017-09-29 for QB64, Mystic screen saver as I remember it plus...
' 2022-04-26 fix up a few things for post
Randomize Timer
Const xmax = 1280
Const ymax = 720
Type point
x As Integer
y As Integer
dx As Single
dy As Single
End Type
Common Shared pR, pG, pB, cN
Randomize Timer
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 60, 0
Dim tri(2) As point
For i = 0 To 2
newPoint tri(i)
Next
Dim saveP1 As point
Dim saveP2 As point
Dim saveP3 As point
saveP1 = tri(0): saveP2 = tri(1): saveP3 = tri(2)
dmode = 0: nT = 50
resetPlasma
While _KeyDown(27) = 0
Cls , 0
cN = cN - nT
tri(0) = saveP1: tri(1) = saveP2: tri(2) = saveP3
For i = 0 To 2
updatePoint tri(i)
Next
saveP1 = tri(0): saveP2 = tri(1): saveP3 = tri(2)
For j = 1 To nT
For i = 0 To 2
updatePoint tri(i)
Next
changePlasma
For i = 0 To 2
Line (tri(i).x, tri(i).y)-(tri((i + 1) Mod 3).x, tri((i + 1) Mod 3).y)
Next
If dmode Then
For i = 0 To 2
Line (xmax - tri(i).x, ymax - tri(i).y)-(xmax - tri((i + 1) Mod 3).x, ymax - tri((i + 1) Mod 3).y)
Next
End If
Next
_Display
'The following commented code worked (works) like a charm
k$ = InKey$
If k$ = " " Then
resetPlasma
ElseIf k$ = "d" Then
dmode = Not dmode
ElseIf k$ = "m" Then
nT = nT + 1: If nT > 500 Then nT = 500
ElseIf k$ = "l" Then
nT = nT - 1: If nT < 1 Then nT = 1
End If
_Limit 10
Wend
Sub newPoint (p As point)
p.x = Rnd * xmax
p.y = Rnd * ymax
p.dx = (Rnd * 10 + 1) * rdir
p.dy = (Rnd * 6 + 1) * rdir
End Sub
Sub updatePoint (p As point)
If p.x + p.dx < 0 Then p.dx = p.dx * -1
If p.y + p.dy < 0 Then p.dy = p.dy * -1
If p.x + p.dx > xmax Then p.dx = p.dx * -1
If p.y + p.dy > ymax Then p.dy = p.dy * -1
p.x = p.x + p.dx
p.y = p.y + p.dy
End Sub
Sub changePlasma ()
cN = cN + 1
Color _RGB(127 + 127 * Sin(pR * .5 * cN), 127 + 127 * Sin(pG * .5 * cN), 127 + 127 * Sin(pB * .5 * cN))
End Sub
Sub resetPlasma ()
pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2
End Sub
Function rdir% ()
If Rnd < .5 Then rdir% = -1 Else rdir% = 1
End Function
A similar thing with rectangles but not as elegant I think:
Code: (Select All)
_Title " *** Screen Saver #3 - Mystic Rectangles *** " ' by bplus 2018-03-01
' 2022-04-26 a couple mod before posting again use full screen and alpha coloring
' translated from
' Screen Saver #3 Mystic Rectangles.bas SmallBASIC 0.12.11 (B+=MGA) 2018-02-28
' instead of wire frame triangles try solid color rectangles
' arrays? we don't need no dang arrays!
' oh to share everything use GOSUBs instead of SUBs
Here's something I found collecting dust. Made it when I started playing around with RotoZoom3. Generates pages of clusters of balls and spins them around in various size, speed and transparency.
- Dav
Code: (Select All)
'====================
'SWIRLINGCLUSTERS.BAS
'====================
'Swirling clusters of colored balls
'Code by Dav, FEB/2021
'(I didn't make RotoZoom3 SUB)
SCREEN _NEWIMAGE(800, 800, 32)
RANDOMIZE TIMER
NumberOfClusters = 30
DIM Cluster(NumberOfClusters) AS LONG
ballsize = 20
balls = 80
FOR d = 1 TO NumberOfClusters
Cluster(d) = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
_DEST Cluster(d)
FOR i = 1 TO balls
x = RND * _WIDTH
IF x < ballsize * 2 THEN x = x + (ballsize * 2)
y = RND * _HEIGHT
IF y < ballsize * 2 THEN y = y + (ballsize * 2)
ball x, y, RND * ballsize, RND * 128, RND * 128, 255, RND * 150
NEXT
NEXT
_DEST 0
DIM ClusterX(NumberOfClusters), ClusterY(NumberOfClusters), ClusterSize(NumberOfClusters)
DIM ClusterRotate(NumberOfClusters), ClusterSpeed(NumberOfClusters)
FOR G = 1 TO NumberOfClusters
ClusterX(G) = RND * _WIDTH
ClusterY(G) = RND * _HEIGHT
ClusterSize(G) = RND * 1.3
ClusterRotate(G) = 2
ClusterSpeed(G) = RND * 2
NEXT
DO
CLS , _RGB(0, 0, 64)
FOR G = 1 TO NumberOfClusters
RotoZoom3 ClusterX(G), ClusterY(G), Cluster(G), ClusterSize(G), ClusterSize(G), _D2R(ClusterRotate(G))
ClusterRotate(G) = ClusterRotate(G) + ClusterSpeed(G): IF ClusterRotate(G) > 360 THEN ClusterRotate(G) = 1
NEXT
_DISPLAY
_LIMIT 30
LOOP UNTIL INKEY$ <> ""
FOR d = 1 TO NumberOfClusters
_FREEIMAGE Cluster(d)
NEXT
END
' Description:
' Started from a mod of Galleon's in Wiki that both scales and rotates an image.
' This version scales the x-axis and y-axis independently allowing rotations of image just by changing X or Y Scales
' making this tightly coded routine a very powerful and versatile image tool.
SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
' This assumes you have set your drawing location with _DEST or default to screen.
' X, Y - is where you want to put the middle of the image
' Image - is the handle assigned with _LOADIMAGE
' xScale, yScale - are shrinkage < 1 or magnification > 1 on the given axis, 1 just uses image size.
' These are multipliers so .5 will create image .5 size on given axis and 2 for twice image size.
' radianRotation is the Angle in Radian units to rotate the image
' note: Radian units for rotation because it matches angle units of other Basic Trig functions
' and saves a little time converting from degree.
' Use the _D2R() function if you prefer to work in degree units for angles.
DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
DIM W&, H&, sinr!, cosr!, i&, x2&, y2& ' variables for image manipulation
W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
px(2) = W& / 2: py(2) = H& / 2 ' right bottom
px(3) = W& / 2: py(3) = -H& / 2 ' right top
sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
NEXT
_MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
SUB ball (BallX, BallY, size, r&, g&, b&, a&)
FOR s = 1 TO size STEP .2
CIRCLE (BallX, BallY), s, _RGBA(r&, g&, b&, a&)
r& = r& - 2: g& = g& - 2: b& = b& - 2
NEXT
END SUB
Randomize Timer
ff = 2.03: maxi = 25000
Color &HFFFFFFFF, 0: Cls
x = xmax / 2: y = ymax / 2
While _KeyDown(27) = 0
loopcnt = loopcnt + 1
Line (0, 0)-(xmax, ymax), _RGBA(0, 0, 0, 3), BF 'Fells trick
ff = ff + 100.431
If Rnd < .1 Then c = 0 Else c = Int(Rnd * 16) 'need more black oh ALPHA my friend!!!
For i = 0 To maxi
f = f + ff
x = min(xmax, -1 * x + Cos(f * i))
y = min(ymax, -1 * y + Sin(f * i))
PSet (x, y), qb(c)
Next
cc = cc + 1
If loopcnt Mod 1000 = 0 Then
Locate 1, 1: Print Space$(10)
Locate 1, 1: Print loopcnt: _Delay 1
End If
If loopcnt Mod 1800 = 0 Then x = xmax / 2: y = ymax / 2: ff = 0: f = 0 'jiggle this sucker
If Rnd < .001 Then Paint (Rnd * xmax, Rnd * ymax), _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 255)
_Display
_Limit 200 'oh man my fan is hot
Wend
Function min (a, b)
If a < b Then min = a Else min = b
End Function
Eye Candy #9B
Code: (Select All)
_Title " Eye Candy #9B Closer" ' b+ 2022-03-09
DefDbl A-Z
xmax = _DesktopWidth: ymax = _DesktopHeight
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 0, 0
xc = xmax / 2
yc = ymax / 2
diag = Sqr(xc * xc + yc * yc)
p2 = _Pi * 2
Dim colr(-100 To diag + 1000) As _Unsigned Long
Dim Shared cN, pR, pG, pB
While 1
resetPlasma
For i = -100 To diag + 1000
colr(i) = Plasma~&
Next
ro = 950: s = 0
While ro > -50 And _KeyDown(27) = 0
k$ = InKey$
If Len(k$) Then Exit While
Cls
For a = 0 To p2 / 64 Step p2 / (16 * 360)
i = 50 * Sin(s) ' 2 * s or just s
For r = 0 To diag
PSet (xc + r * Cos(a), yc + r * Sin(a)), colr(r + i + ro)
Next
s = s + p2 / 180
Next
sx1 = xc: sy1 = yc: sx2 = xc + diag * Cos(.002): sy2 = yc + diag * Sin(.002): sx3 = xc + diag * Cos(p2 / 64 - .002): sy3 = yc + diag * Sin(p2 / 64 - .002)
For a = p2 / 64 To p2 - p2 / 64 Step p2 / 64
dx1 = xc: dy1 = yc: dx2 = xc + diag * Cos(a): dy2 = yc + diag * Sin(a): dx3 = xc + diag * Cos(a + p2 / 64): dy3 = yc + diag * Sin(a + p2 / 64)
_MapTriangle (sx1, sy1)-(sx2, sy2)-(sx3, sy3), source& To(dx1, dy1)-(dx2, dy2)-(dx3, dy3), 0
Next
Line (0, 0)-(xc - 1.5 * yc, _Height), &HFF000000, BF
Line (xc + 1.5 * yc, 0)-(_Width, _Height), &HFF000000, BF
toggle = 1 - toggle
If toggle Then _Display
'_Limit 80
ro = ro - 1
Wend
If _KeyDown(27) Then System
Wend
05-01-2022, 07:22 PM (This post was last modified: 07-15-2023, 02:23 AM by Dav.)
Here's another Screen Saver using RotoZoom. Click on the mouse buttons to zoom gears in and out. I used BASIMAGE to include the pic. Making this I realized that .PNG images can be 16 color and still maintain transparency info, so on simple small images like this one I can lower them to 16 colors instead of 256 and reduce the pic size. That's helpful when including images in code.
- Dav
Code: (Select All)
'================
'ROTOZOOMGEAR.BAS
'================
'Showcase speed of RotoZoom3 Function(not by me) by
'rotating a number of gears on the screen in various sizes.
'Coded by Dav
'Push Mouse Buttons for Zoom effects
SCREEN _NEWIMAGE(700, 700, 32)
gear& = BASIMAGE1& 'decode image included this BAS code
NumOfGears = 11 'number of gears shown on screen
DIM Gearx(NumOfGears), Geary(NumOfGears), GearSize(NumOfGears)
DIM GearRot(NumOfGears), GearSpeed(NumOfGears), GearDir(NumOfGears)
'assign random values for each gear
FOR G = 1 TO NumOfGears
Gearx(G) = _WIDTH / 2
Geary(G) = _HEIGHT / 2
GearSize(G) = .1 + G / 2
GearRot(G) = 1
GearSpeed(G) = RND * 2.5
GearDir(G) = INT(RND * 2)
NEXT
DO
CLS , _RGB(0, 0, 64)
FOR G = NumOfGears TO 1 STEP -1
RotoZoom3 Gearx(G), Geary(G), gear&, GearSize(G), GearSize(G), _D2R(GearRot(G))
IF GearDir(G) = 1 THEN
GearRot(G) = GearRot(G) + GearSpeed(G): IF GearRot(G) > 360 THEN GearRot(G) = 1
ELSE
GearRot(G) = GearRot(G) - GearSpeed(G): IF GearRot(G) < 1 THEN GearRot(G) = 360
END IF
mi = _MOUSEINPUT
IF _MOUSEBUTTON(1) THEN GearSize(G) = GearSize(G) + .1
IF _MOUSEBUTTON(2) THEN GearSize(G) = GearSize(G) - .1
IF GearSize(G) > 19 THEN GearSize(G) = .1
IF GearSize(G) < .1 THEN GearSize(G) = 19
NEXT
_DISPLAY
_LIMIT 30
LOOP UNTIL INKEY$ <> ""
_FREEIMAGE gear&
END
' Description:
' Started from a mod of Galleon's in Wiki that both scales and rotates an image.
' This version scales the x-axis and y-axis independently allowing rotations of image just by changing X or Y Scales
' making this tightly coded routine a very powerful and versatile image tool.
SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
' This assumes you have set your drawing location with _DEST or default to screen.
' X, Y - is where you want to put the middle of the image
' Image - is the handle assigned with _LOADIMAGE
' xScale, yScale - are shrinkage < 1 or magnification > 1 on the given axis, 1 just uses image size.
' These are multipliers so .5 will create image .5 size on given axis and 2 for twice image size.
' radianRotation is the Angle in Radian units to rotate the image
' note: Radian units for rotation because it matches angle units of other Basic Trig functions
' and saves a little time converting from degree.
' Use the _D2R() function if you prefer to work in degree units for angles.
DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
DIM W&, H&, sinr!, cosr!, i&, x2&, y2& ' variables for image manipulation
W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
px(2) = W& / 2: py(2) = H& / 2 ' right bottom
px(3) = W& / 2: py(3) = -H& / 2 ' right top
sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
NEXT
_MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
_Title "Tanks Battle - The Movie" 'from bplus 2018-02-03"
'from: Tanks Battle.sdlbas (B+=MGA) 2016-10-29
' let the projectiles fly!
' 2022-05-? fix color const for Sky
' 2022-05-09 Make a Movie / Screen Saver
Randomize Timer
'tank stuff
Const tN = 15 'number of tanks
Const tNm1 = tN - 1 ' for loops and arrays
Const tW = 20 'width of tank
Const tH = 8 'height of tank
Type tank
x As Single
y As Single
da As Single
v As Single 'velocity
c As _Integer64 'color
bx As Single 'barrel
by As Single
f As _Byte 'finished
End Type
'hole stuff
Const hR = tW + 3
Const topHole = 1000
Type hole
x As Integer
y As Integer
End Type
change = 1
While change 'get tanks landed before start shooting
change = 0
Cls
_PutImage , land&, 0 'land the tanks and reland the tanks if the dirt is shot out under them
For i = 0 To tNm1
If Point(tanks(i).x + tW / 2, tanks(i).y + tH + 1) = SkyC Then
tanks(i).y = tanks(i).y + 2
change = 1
End If
drawTank i
Next
_Display
Wend
While _KeyDown(27) = 0 '< main loop start
Cls
_PutImage , land&, 0
'the land with holes
If holeIndex > -1 Then
For ii = 0 To holeIndex
drawHole holes(ii).x, holes(ii).y
Next
End If
'reland the tanks if the dirt is shot out under them
For i = 0 To tNm1
If tanks(i).f = 0 Then
While Point(tanks(i).x + tW / 2, tanks(i).y + tH + 1) = SkyC
tanks(i).y = tanks(i).y + 2
Wend
'repoint barrels and reset velocitys
If Rnd < .5 Then 'avoid straight up and down suicide shots
tanks(i).da = rand(leftA, -92)
Else
tanks(i).da = rand(rightA, -88)
End If
tanks(i).v = rand(lVel, hVel) 'velocity
drawTank i
End If
Next
_Display
_Delay .1
''whose turn to shoot
lastMan = hotTank
hotTank = hotTank + 1
hotTank = hotTank Mod tN
While tanks(hotTank).f = 1 'look for a tank still alive
hotTank = hotTank + 1 'whose turn to shoot
hotTank = hotTank Mod tN
'did we cycle through all the dead tanks?
If hotTank = lastMan Then 'game over, last man standing
_Display
_Delay 5
GoTo restart
End If
Wend
'setup hotTank's shot
rAngle = tanks(hotTank).da * rad 'convert here to radians for SIN and COS
pX = tanks(hotTank).bx
pY = tanks(hotTank).by
pX_change = tanks(hotTank).v * Cos(rAngle) 'this is the cuurent X vector of the projectile
pY_change = tanks(hotTank).v * Sin(rAngle) ' this is the current Y vector of the projectile
pActive = 0 ' do not Activate until projectile sees the skyC
While 1
pY_change = pY_change + gravity ' pY starts in upward direction but will eventually fall due to gravity
pX = pX + pX_change
pY = pY + pY_change
'show projectile progress, hit or air
If pX >= 0 And pX <= SW And pY <= SH Then ' still active
'check for tank hit
For iTank = 0 To tNm1
If tanks(iTank).f <> 1 And pActive Then 'tanks can blow up themselves
If dist(pX, pY, tanks(iTank).x + tW / 2, tanks(iTank).y + tH / 2) < hR Then
tanks(iTank).f = 1
Color _RGB32(255, 0, 0)
For rr = 1 To hR
fcirc pX, pY, rr
_Display
_Delay .01
If rr Mod 2 Then
Color _RGB32(128, 255, 0)
Else
Color _RGB32(255, 0, 0)
End If
Next
If holeIndex < topHole Then
holeIndex = holeIndex + 1
holes(holeIndex).x = pX
holes(holeIndex).y = pY
drawHole pX, pY
_Display
End If
pX = SW + 10
pY = SH + 10
Exit While
End If
End If
Next
If Point(pX, pY) = SkyC Then
pActive = 1
Color pC
fcirc pX, pY, 2 ' <<<<<<<<<<<<<<<< to see round projectiles that could be replaced by image
ElseIf pY < 0 Then
'still hot but cant see
ElseIf Point(pX, pY) <> SkyC And Point(pX, pY) <> pC And pActive Then 'hit ground?
Color _RGB(255, 0, 0)
For rr = 1 To hR
fcirc pX, pY, rr
_Display
_Delay .01
If rr Mod 2 Then
Color _RGB32(128, 255, 0)
Else
Color _RGB32(255, 0, 0)
End If
Next
If holeIndex < topHole Then
holeIndex = holeIndex + 1
holes(holeIndex).x = pX
holes(holeIndex).y = pY
drawHole pX, pY
_Display
End If
pX = SW + 10
pY = SH + 10
Exit While
End If
Else 'not active
Exit While
End If
_Display
_Delay .03
Wend
Wend
Sub drawHole (xx, yy)
Color SkyC
For i = yy To 300 Step -1
fcirc xx, i, hR
Next
End Sub
Sub drawLandscape
'the sky
Line (0, 0)-(SW, SH), SkyC, BF
'the land
startH = SH - 100
rr = 70: gg = 70: bb = 90
For mountain = 1 To 6
Xright = 0
y = startH
While Xright < SW
' upDown = local up / down over range, change along Y
' range = how far up / down, along X
upDown = (Rnd * (.8) - .35) * (mountain * .5)
range = Xright + rand%(15, 25) * 2.5 / mountain
For x = Xright - 1 To range
y = y + upDown
Line (x, y)-(x + 1, SH), _RGB32(rr, gg, bb), BF
Next
Xright = range
Wend
rr = rand(rr - 15, rr): gg = rand(gg - 15, gg): bb = rand(bb - 25, bb)
If rr < 0 Then rr = 0
If gg < 0 Then gg = 0
If bb < 0 Then bb = 0
startH = startH + rand(5, 20)
Next
End Sub
Sub initializeTanks ' x, y, barrel angle, velocity, color
tl = (SW - tW) / tN: tl2 = tl / 2: tl4 = .8 * tl2
For i = 0 To tNm1
tanks(i).x = rand%(tl2 + tl * i - tl4 - tW, tl2 + tl * i + tl4 - tW)
tanks(i).y = 300 '<<<<<<<<<<<<<<<<<<<<<<<<<< for testing
tanks(i).da = rand%(-180, 0) 'degree Angle
tanks(i).v = rand%(10, 20) 'velocity
If tanks(i).da < -90 Then 'barrel is pointed left
tanks(i).v = -1 * tanks(i).v
End If
tc = i * Int(200 / (3 * tN)) 'maximize color difference between tanks
tanks(i).c = _RGB32(55 + 2 * tc, 13 + tc, 23 + tc) ' first tank is darkest
Next
'shuffle color order
For i = tNm1 To 1 Step -1
r = rand%(0, i)
Swap tanks(i).x, tanks(r).x
Next
End Sub
Function rand% (lo%, hi%)
rand% = (Rnd * (hi% - lo% + 1)) \ 1 + lo%
End Function
Function rdir% ()
If Rnd < .5 Then rdir% = -1 Else rdir% = 1
End Function
Function dist# (x1%, y1%, x2%, y2%)
dist# = ((x1% - x2%) ^ 2 + (y1% - y2%) ^ 2) ^ .5
End Function
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): 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), , 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), , BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
Wend
End Sub
Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
Dim scale As Single, x As Long, y As Long
scale = yRadius / xRadius
Line (CX, CY - yRadius)-(CX, CY + yRadius), , BF
For x = 1 To xRadius
y = scale * Sqr(xRadius * xRadius - x * x)
Line (CX + x, CY - y)-(CX + x, CY + y), , BF
Line (CX - x, CY - y)-(CX - x, CY + y), , BF
Next
End Sub
Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
Dim scale As Single, xs As Long, x As Long, y As Long
Dim lastx As Long, lasty As Long
scale = yRadius / xRadius: xs = xRadius * xRadius
PSet (CX, CY - yRadius): PSet (CX, CY + yRadius)
lastx = 0: lasty = yRadius
For x = 1 To xRadius
y = scale * Sqr(xs - x * x)
Line (CX + lastx, CY - lasty)-(CX + x, CY - y)
Line (CX + lastx, CY + lasty)-(CX + x, CY + y)
Line (CX - lastx, CY - lasty)-(CX - x, CY - y)
Line (CX - lastx, CY + lasty)-(CX - x, CY + y)
lastx = x: lasty = y
Next
End Sub