Proggies

[bplus]

Donut with Code Sprinkles

Code: (Select All)

_Title "Donut with code sprinkles by bplus 2018-03-09"
Const xmax = 700
Const ymax = 700
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 0
Const cx = xmax / 2
Const cy = ymax / 2
Const tw = 8
Const th = 16
Open "donut code.bas" For Input As #1
While EOF(1) = 0
    Line Input #1, fline$
    f$ = f$ + LTrim$(fline$) + " : "
Wend
Close #1
f$ = Left$(f$, Len(f$) - 3)
lenF = Len(f$)
tArea = tw * th * lenF / 2
r = Sqr(9 / 4 * tArea / _Pi)
For y = 0 To ymax
    For x = 0 To xmax
        d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^ .5
        If r / 3 < d + 20 And d - 20 < r Then
            midInk 180, 90, 55, 80, 40, 20, 1 - Abs(2 / 3 * r - d) / (.335 * r), 0
            PSet (x + 5, y + 10)
        End If
    Next
Next
idx = 0
For y = 0 To ymax Step th
    For x = 0 To xmax Step tw
        d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^ .5
        If r / 3 < d And d < r Then
            idx = idx + 1
            midInk 180, 90, 55, 80, 40, 20, Abs(2 / 3 * r - d) / (.335 * r), 1
            If idx <= lenF Then this$ = Mid$(f$, idx, 1) Else this$ = " "
            Color , 0
            _PrintString (x, y), this$
        End If
    Next
Next
Print
Sleep
Function rand% (lo%, hi%)
    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function
Function rclr&&
    rclr&& = _RGB32(rand%(64, 255), rand%(64, 255), rand%(64, 255))
End Function
Sub midInk (r1, g1, b1, r2, g2, b2, fr, tf)
    If tf Then
        fc&& = rclr&&
    Else
        fc&& = _RGB32(r1 + (r2 - r1) * (1 - fr), g1 + (g2 - g1) * (1 - fr), b1 + (b2 - b1) * (1 - fr))
    End If
    bc&& = _RGB32(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
    Color fc&&, bc&&
End Sub
'XOXOXOXO