Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: _vince on February 01, 2022, 04:35:33 pm

Title: Curves
Post by: _vince on February 01, 2022, 04:35:33 pm
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


 
Title: Re: Curves
Post by: SierraKen on February 01, 2022, 05:32:11 pm
That's awesome for designing! Just remember, one letter at a time though or the whole word turns into a squiggle. lol
Title: Re: Curves
Post by: bplus on February 01, 2022, 06:49:08 pm
 


Code: QB64: [Select]
  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?
  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
  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
  121.  
  122.  

Works best with slowly printed letters.
Title: Re: Curves
Post by: _vince on February 01, 2022, 10:35:07 pm
nice mod,
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Curves
Post by: Phlashlite on February 01, 2022, 10:41:07 pm
Very cool!
Text Only | Text with Attachments