Vince's Corner Takeout

[vince]

B+ mods vince fine Curves code

Code: (Select All)

Option _Explicit
_Title "b+ mods vince fine Curves code" ' b+ 2022-02-01
DefLng A-Z
Const sw = 1024, sh = 600 ' const shared everywhere
Screen _NewImage(sw, sh, 32)
_ScreenMove 150, 60 'center stage

'put 'em all here
Dim As Long n, r, mx, my, mb, omx, omy, i, j, vs
Dim As Double bx, by, t, bin
Dim k$
ReDim x(n) As Long, y(n) As Long

vs = _NewImage(sw, sh, 32) ' vs for virtual screen
r = 5 'gap checker?
Do
    Cls
    k$ = InKey$
    If k$ = "c" Then
        _Dest vs
        Line (0, 0)-(sw, sh), &HFF000000, BF
        _Dest 0
        Cls
    End If
    _PutImage , vs, 0
    While _MouseInput: Wend ' poll mouse update mouse variables
    mx = _MouseX: my = _MouseY: mb = _MouseButton(1)


    If mb Then
        n = 1
        ReDim _Preserve x(n)
        ReDim _Preserve y(n)

        x(0) = mx - sw / 2
        y(0) = sh / 2 - my

        PSet (mx, my)
        Do While mb
            While _MouseInput: Wend ' poll mouse update mouse variables
            mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
            Line -(mx, my), _RGB(30, 30, 30)

            If (mx - omx) ^ 2 + (my - omy) ^ 2 > r ^ 2 Then
                circlef mx, my, 3, _RGB(30, 30, 30)
                omx = mx
                omy = my

                x(n) = mx - sw / 2
                y(n) = sh / 2 - my
                n = n + 1
                ReDim _Preserve x(n)
                ReDim _Preserve y(n)
            End If

            _Display
            '_Limit 30
        Loop

        'close the contour
        'x(n) = x(0)
        'y(n) = y(0)
        'n = n + 1
        'redim _preserve x(n)
        'redim _preserve y(n)


        'redraw spline
        'pset (sw/2 + x(0), sh/2 - y(0))
        'for i=0 to n
        'line -(sw/2 + x(i), sh/2 - y(i)), _rgb(255,0,0)
        'circlef sw/2 + x(i), sh/2 - y(i), 3, _rgb(255,0,0)
        'next
        _Dest vs
        PSet (sw / 2 + x(0), sh / 2 - y(0))
        For t = 0 To 1 Step 0.001
            bx = 0
            by = 0

            For i = 0 To n
                bin = 1
                For j = 1 To i
                    bin = bin * (n - j) / j
                Next

                bx = bx + bin * ((1 - t) ^ (n - 1 - i)) * (t ^ i) * x(i)
                by = by + bin * ((1 - t) ^ (n - 1 - i)) * (t ^ i) * y(i)
            Next

            Line -(sw / 2 + bx, sh / 2 - by), _RGB(255, 0, 0)
        Next
        _Dest 0
    End If

    _Display
    _Limit 30
Loop Until _KeyHit = 27
System

Sub circlef (x As Long, y As Long, r As Long, c As Long)
    Dim As Long x0, y0, e
    x0 = r
    y0 = 0
    e = -r

    Do While y0 < x0
        If e <= 0 Then
            y0 = y0 + 1
            Line (x - x0, y + y0)-(x + x0, y + y0), c, BF
            Line (x - x0, y - y0)-(x + x0, y - y0), c, BF
            e = e + 2 * y0
        Else
            Line (x - y0, y - x0)-(x + y0, y - x0), c, BF
            Line (x - y0, y + x0)-(x + y0, y + x0), c, BF
            x0 = x0 - 1
            e = e - 2 * x0
        End If
    Loop
    Line (x - r, y)-(x + r, y), c, BF
End Sub