Curves

[_vince]

Code: [Select]

deflng a-z
dim shared sw, sh
sw = 1024
sh = 600
dim shared pi as double
pi = 4*atn(1)

screen _newimage(sw, sh, 32)

dim as long n, r, mx, my, mb, omx, omy
n = 0
redim x(n) as long, y(n) as long

r = 5
do
getmouse mx, my, mb

if mb = 1 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 = 1
getmouse mx, my, mb

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 50
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

dim as double bx, by, t, bin
pset (sw/2 + x(0), sh/2 - y(0))
for t=0 to 1 step 0.0001
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
end if

_display
_limit 50
loop until _keyhit = 27
system

sub getmouse (mx as long, my as long, mb as long)
do
mx = _mousex
my = _mousey
mb = -_mousebutton(1)
loop while _mouseinput
end sub
 
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


 

[SierraKen]

That's awesome for designing! Just remember, one letter at a time though or the whole word turns into a squiggle. lol

[bplus]

 

Code: QB64: [Select]

1. Option _Explicit
2. _Title "b+ mods vince fine Curves code" ' b+ 2022-02-01
3. DefLng A-Z
4. Const sw = 1024, sh = 600 ' const shared everywhere
5. Screen _NewImage(sw, sh, 32)
6. _ScreenMove 150, 60 'center stage
7.  
8. 'put 'em all here
9. Dim As Long n, r, mx, my, mb, omx, omy, i, j, vs
10. Dim As Double bx, by, t, bin
11. Dim k$
12. ReDim x(n) As Long, y(n) As Long
13.  
14. vs = _NewImage(sw, sh, 32) ' vs for virtual screen
15. r = 5 'gap checker?
16. Do
17.     Cls
18.     k$ = InKey$
19.     If k$ = "c" Then
20.         _Dest vs
21.         Line (0, 0)-(sw, sh), &HFF000000, BF
22.         _Dest 0
23.         Cls
24.     End If
25.     _PutImage , vs, 0
26.     While _MouseInput: Wend ' poll mouse update mouse variables
27.     mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
28.  
29.  
30.     If mb Then
31.         n = 1
32.         ReDim _Preserve x(n)
33.         ReDim _Preserve y(n)
34.  
35.         x(0) = mx - sw / 2
36.         y(0) = sh / 2 - my
37.  
38.         PSet (mx, my)
39.         Do While mb
40.             While _MouseInput: Wend ' poll mouse update mouse variables
41.             mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
42.             Line -(mx, my), _RGB(30, 30, 30)
43.  
44.             If (mx - omx) ^ 2 + (my - omy) ^ 2 > r ^ 2 Then
45.                 circlef mx, my, 3, _RGB(30, 30, 30)
46.                 omx = mx
47.                 omy = my
48.  
49.                 x(n) = mx - sw / 2
50.                 y(n) = sh / 2 - my
51.                 n = n + 1
52.                 ReDim _Preserve x(n)
53.                 ReDim _Preserve y(n)
54.             End If
55.  
56.             _Display
57.             '_Limit 30
58.         Loop
59.  
60.         'close the contour
61.         'x(n) = x(0)
62.         'y(n) = y(0)
63.         'n = n + 1
64.         'redim _preserve x(n)
65.         'redim _preserve y(n)
66.  
67.  
68.         'redraw spline
69.         'pset (sw/2 + x(0), sh/2 - y(0))
70.         'for i=0 to n
71.         'line -(sw/2 + x(i), sh/2 - y(i)), _rgb(255,0,0)
72.         'circlef sw/2 + x(i), sh/2 - y(i), 3, _rgb(255,0,0)
73.         'next
74.         _Dest vs
75.         PSet (sw / 2 + x(0), sh / 2 - y(0))
76.         For t = 0 To 1 Step 0.0001
77.             bx = 0
78.             by = 0
79.  
80.             For i = 0 To n
81.                 bin = 1
82.                 For j = 1 To i
83.                     bin = bin * (n - j) / j
84.                 Next
85.  
86.                 bx = bx + bin * ((1 - t) ^ (n - 1 - i)) * (t ^ i) * x(i)
87.                 by = by + bin * ((1 - t) ^ (n - 1 - i)) * (t ^ i) * y(i)
88.             Next
89.  
90.             Line -(sw / 2 + bx, sh / 2 - by), _RGB(255, 0, 0)
91.         Next
92.         _Dest 0
93.     End If
94.  
95.     _Display
96.     _Limit 30
97. Loop Until _KeyHit = 27
98. System
99.  
100. Sub circlef (x As Long, y As Long, r As Long, c As Long)
101.     Dim As Long x0, y0, e
102.     x0 = r
103.     y0 = 0
104.     e = -r
105.  
106.     Do While y0 < x0
107.         If e <= 0 Then
108.             y0 = y0 + 1
109.             Line (x - x0, y + y0)-(x + x0, y + y0), c, BF
110.             Line (x - x0, y - y0)-(x + x0, y - y0), c, BF
111.             e = e + 2 * y0
112.         Else
113.             Line (x - y0, y - x0)-(x + y0, y - x0), c, BF
114.             Line (x - y0, y + x0)-(x + y0, y + x0), c, BF
115.             x0 = x0 - 1
116.             e = e - 2 * x0
117.         End If
118.     Loop
119.     Line (x - r, y)-(x + r, y), c, BF
120. End Sub
121.  
122.  

Works best with slowly printed letters.

[_vince]

nice mod,
 

[Phlashlite]

Very cool!