Post by bplus on May 6, 2021 14:46:40 GMT -5
My latest mod of Yin Yang:
With a little glimpse inside QB64 IDE
_Title "Yin Yang Color Balls" 'b+ 2020-08-19 balls mod 2021-05-04
' 2020-08-19 pulled this one out of my files for QB64 trans
'Ying yang color.bas 2015-07-08 I know I updated sdlbas version how about SmallBASIC?
'from Ying Yang v3.sdlbas 2015-06-03 MGA
Const sq = 500, rc = sq / 4 - 40, xc = sq / 2, yc = sq / 2
Screen _NewImage(sq, sq, 32)
_Delay .25
_ScreenMove _Middle
Dim c As _Unsigned Long
nc = 1
d = .1
dir = 1
i = 0
acc = .01 'radians
Do
x1 = xc + rc * Sin(i)
y1 = yc + rc * Cos(i)
If nc > 254 Then d = -1 * d
If nc < 1 Then d = -1 * d
nc = nc + d * dir
If nc > 255 Then dir = dir * -1: d = d * dir
If nc < 1 Then dir = dir * -1: d = d * dir
c = _RGB32(nc, 0, 255 - nc)
drawBall x1, y1, rc, c
c = _RGB32(0, 255 - nc, nc)
drawBall x1, y1, rc / 3, c
x2 = xc + rc * Sin(i + 3.1415)
y2 = yc + rc * Cos(i + 3.1415)
drawBall x2, y2, rc, c
c = _RGB32(nc, 0, 255 - nc)
drawBall x2, y2, rc / 3, c
i = i + acc
_Display
Loop Until _KeyDown(27)
Sub drawBall (x, y, r, c As _Unsigned Long)
Dim rred As Long, grn As Long, blu As Long, rr As Long, f
rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
For rr = r To 0 Step -4
f = 1 - (rr / r) * .5
fcirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)
Next
End Sub
'from Steve Gold standard
Sub fcirc (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
With a little glimpse inside QB64 IDE
