Simple Smooth mouse drawing.
Simple Smooth mouse drawing.
Hi, first time on this forum and first day getting to know freebasic. I'm very familiar with Qbasic and SmileBasic(DS/3DS Petite computer app).
I'm sure this is simple to do but the solution eludes me. I can use the old Qbasic graphic commands i remember from long ago, however it's now easy to use the mouse as input. What I'm trying to do is get simple drawing output from the mouse, not a bunch of dots that space out more as you move the mouse faster. I'm thinking PSET is not the way to go here. Is there a command to use for simply drawing with the mouse ? Will i have to use the line command to connect as i go. I'm not confident this will give a nice smooth output. Hope this is an active forum.
Thanks in advance
I'm sure this is simple to do but the solution eludes me. I can use the old Qbasic graphic commands i remember from long ago, however it's now easy to use the mouse as input. What I'm trying to do is get simple drawing output from the mouse, not a bunch of dots that space out more as you move the mouse faster. I'm thinking PSET is not the way to go here. Is there a command to use for simply drawing with the mouse ? Will i have to use the line command to connect as i go. I'm not confident this will give a nice smooth output. Hope this is an active forum.
Thanks in advance
Re: Simple Smooth mouse drawing.
Hi Dez, welcome to the forum!
If have working mouse drawing code based on PSET and you find that it is producing a dusting of spaced out dots, this is normal. Mice usually don't have very high sample rates. Use of the LINE command to connect them is indeed the typical solution. Most drawing programs will do exactly this. Although many drawing programs are also able to use thicker anti-aliased lines depending on their brush settings. If you still think the output looks jagged after using the line function, with a little math we can try using a B-Spline curve to smooth it out.
If have working mouse drawing code based on PSET and you find that it is producing a dusting of spaced out dots, this is normal. Mice usually don't have very high sample rates. Use of the LINE command to connect them is indeed the typical solution. Most drawing programs will do exactly this. Although many drawing programs are also able to use thicker anti-aliased lines depending on their brush settings. If you still think the output looks jagged after using the line function, with a little math we can try using a B-Spline curve to smooth it out.
-
- Posts: 3906
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: Simple Smooth mouse drawing.
@Dez
Code: Select all
screenres 640,480,32
dim shared as integer mx,my,ox,oy,btn 'mouse variables
cls
print "mouse button down do draw will exit on release"
getmouse mx,my,,btn
ox = mx
oy = my
'setmouse mx,my,0 'turn off windows pointer image
'wait for mouse press
while btn<>1
getmouse mx,my,,btn
ox = mx
oy = my
wend
while btn=1
getmouse mx,my,,btn
if mx<>ox or my<>oy then
Line(ox,oy)-(mx,my),rgb(0,255,0) 'green color
ox = mx
oy = my
end if
wend
setmouse mx,my,1 'turn on windows pointer image
end
Last edited by BasicCoder2 on Feb 15, 2014 16:01, edited 1 time in total.
Re: Simple Smooth mouse drawing.
I have modified BasicCoder2's example to use a cubic spline.
To draw a segment of a cubic spline 4 input points are needed (2 points on either side of the segment), so I keep track of 3 old points in an array. Because of the symmetry the curve segment needs an input point beyond the segment drawn and is one full segment behind the mouse cursor. However this fact doesn't seem to be very noticeable.
The curve segment is currently drawn using by sampling 16 points on the curve and drawing 16 line segments to connect them. It is drawn on top the lines connecting the input points (and the input points), so that you can compare them. You can modify the code to see the curve alone. Most of the time there is little difference between the curve and the line, but the difference is quite apparent if you are moving the cursor at high speed while changing directions.
Code: Select all
screenres 800,600,32
dim shared as integer mx,my,ox(2),oy(2),btn 'mouse variables
Sub DrawCurve()
'Determine control points
var x1 = (ox(0)-ox(2))/6 + ox(1)
var x2 = (ox(1) - mx) /6 + ox(0)
var y1 = (oy(0)-oy(2))/6 + oy(1)
var y2 = (oy(1) - my) /6 + oy(0)
'Draw curve
var px = ox(1)
var py = oy(1)
For T As Single = 0.0625 To 1.0001 Step 0.0625
var S = 1 - T
var x = ox(0)*T^3 + 3*T*S*(x2*T + x1*S) + ox(1)*S^3
var y = oy(0)*T^3 + 3*T*S*(y2*T + y1*S) + oy(1)*S^3
Line(px,py)-(x,y),rgb(0,0,255) 'blue color
px = x
py = y
Next T
End Sub
cls
print "mouse button down do draw will exit on release"
'Initialize mouse variables
getmouse mx,my,,btn
For I As Integer = 0 To 2
ox(I) = mx
oy(I) = my
Next I
'wait for mouse press
while btn<>1
getmouse mx,my,,btn
ox(2) = ox(1): oy(2) = oy(1)
ox(1) = ox(0): oy(1) = oy(0)
ox(0) = mx
oy(0) = my
wend
while btn=1
getmouse mx,my,,btn
if mx<>ox(0) or my<>oy(0) then
Circle (ox(0),oy(0)), 1,rgb(255,0,0),,,,F 'red dot
Line(ox(1),oy(1))-(ox(0),oy(0)),rgb(0,255,0) 'green line
DrawCurve 'blue curve
ox(2) = ox(1): oy(2) = oy(1)
ox(1) = ox(0): oy(1) = oy(0)
ox(0) = mx
oy(0) = my
end if
wend
end
The curve segment is currently drawn using by sampling 16 points on the curve and drawing 16 line segments to connect them. It is drawn on top the lines connecting the input points (and the input points), so that you can compare them. You can modify the code to see the curve alone. Most of the time there is little difference between the curve and the line, but the difference is quite apparent if you are moving the cursor at high speed while changing directions.
Re: Simple Smooth mouse drawing.
Thanks for getting back quickly. I had thought this might be a week or so on response and was ready for that. I have played around with both examples. Thank you BasicCoder2 and gothon. The output really isn't as bad as I imagined it would be using the connect the dots method. I can understand how a math function could smooth out corners but i don't understand the exact details of how splines work just yet. I am not trying to sound sarcastic here just curious. Are there other uses for spline math functions in programming outside of graphs or rough lines. Would this be considered Trig ?
Re: Simple Smooth mouse drawing.
Splines and other piece-wise polynomial functions are widely used in graphics, modeling and CAD/engineering applications for modeling both curves and surfaces. I'm not sure where else they would be used. These functions are entirely polynomial (and sometimes the ratio of polynomials), so you would not normally need to use trig functions to work with them.
You might encounter trig functions if you were to try to compute curve intersections algebraically, but you normally wouldn't do it that way because geometric methods to compute intersections are way less involved. Some generalizations (eg NURBS) can exactly represent conic sections (eg circles) with no approximation error. Conic sections often involve trigonometry when modeled using conventional polar equations, however represented as a properly modeled spline curve everything is a polynomial function and no use of trig is necessary if you are careful.
You might encounter trig functions if you were to try to compute curve intersections algebraically, but you normally wouldn't do it that way because geometric methods to compute intersections are way less involved. Some generalizations (eg NURBS) can exactly represent conic sections (eg circles) with no approximation error. Conic sections often involve trigonometry when modeled using conventional polar equations, however represented as a properly modeled spline curve everything is a polynomial function and no use of trig is necessary if you are careful.
Re: Simple Smooth mouse drawing.
@Dez
You've been splined, on your very first day here. Is good, you may use them (splines) later.
The getmouse() function is quick enough for most purposes. The combination of getmouse(), pset(), and line() should work for whatever draw functions you wish to implement.
This below is the shortest "draw" code I have that uses getmouse(). Short but somewhat convoluted. I present it for your amusement. It accomodates both single-point "draws" and non-contiguous lines.
If you were coding 100% Windows API then you could (would) check for mouse status messages in the main WinProc message pump. You CAN hook those Windows mouse messages directly (?) from a "normal" FreeBASIC program using a "mousehook" API procedure, probably a bit faster than getmouse(), but here we go from semi-intelligble code to gibberish if you aren't familiar with it. I'll post an example just... as an example.
Now you've been splined and hooked ;-)
ETA to correct my mangling of Dez's handle.
And please see my FINAL getmouse() version below...
You've been splined, on your very first day here. Is good, you may use them (splines) later.
The getmouse() function is quick enough for most purposes. The combination of getmouse(), pset(), and line() should work for whatever draw functions you wish to implement.
This below is the shortest "draw" code I have that uses getmouse(). Short but somewhat convoluted. I present it for your amusement. It accomodates both single-point "draws" and non-contiguous lines.
Code: Select all
'getmouse() "Draw": inline : reqs gfx mode
'
dim as integer bdown,buttons,x,y,ox,oy
'
screenres 640,480,32
WindowTitle "Hold Left mouse button to draw, Right-click to EXIT"
'
do
' these are "short circuits"
' are we in client window and click! and has mouse moved
while (getmouse(x,y,,buttons)=0) andAlso (buttons) andAlso (ox<>x orElse oy<>y)
if buttons=1 then
if bdown=0 then
pset(x,y)
bdown=1
while bdown=1
line -(x,y)
getmouse(x,y,,buttons)
if buttons<>1 then bdown=0
sleep 1 'save cpu cycles
wend
bdown=0
endif
ox=x:oy=y 'movement test for while loop
end if
if buttons=2 then exit do
wend
'
sleep 1 'don't remove sleep in loops
'
loop
'
while inkey<>"":wend
'
beep:beep
WindowTitle "Done, sleeping..."
locate 1,1
print "Done, sleeping..."
sleep
Code: Select all
'On_Mouse in fb GFX (not console), Windows only
' "Draw Test" - hold left-mouse down to draw...
' tested last using fb v0.90.1 (07-17-2013) for win32
'
#include once "windows.bi"
#include once "fbgfx.bi"
Using fb
'
declare function On_Mouse(lpfn as HOOKPROC) as integer
'
declare function MSProc1(ByVal Code As integer,_
ByVal wParam As integer,_
ByVal lParam As integer) As integer
'
'mousehook vars
dim shared MSHandle as HHOOK
dim shared hwnd as HANDLE
dim shared as integer xoff,yoff
'
'GFX setup
screenres 640,480,32
ScreenControl (GET_WINDOW_HANDLE,cast(integer,hwnd))
windowtitle "Left-mouse down to draw, <Esc> to Quit.."
'
'this determines the client window offsets
xoff=GetSystemMetrics(SM_CXFIXEDFRAME)
yoff=GetSystemMetrics(SM_CYCAPTION)
'
'invoke the mouse hook
On_Mouse(cast(HOOKPROC,@MSProc1))
'
while inkey<>chr(27)' <Esc> to end
sleep 500
wend
'
'release the mouse hook
UnhookWindowsHookEx(MSHandle)
'
beep:beep
locate 1,1
print "Sleeping to Exit.. press a key"
windowtitle "Sleeping to Exit.. press a key"
sleep
'
'end
'
'=================================
function On_Mouse(lpfn as HOOKPROC) as integer
'
MSHandle=SetWindowsHookEx(WH_MOUSE,_
lpfn,_
NULL,_
GetWindowThreadProcessId(hwnd,NULL))
return 0
'
End function
'
function MSProc1(ByVal Code As integer, _
ByVal wParam As integer,_
ByVal lParam As integer) As integer
'
static as integer mdown
if mdown<0 then mdown=0
'
if (Code=HC_ACTION) then
'
dim MStruct as MOUSEHOOKSTRUCT ptr
MStruct=cast(MOUSEHOOKSTRUCT ptr,lparam)
'
dim as integer x,y,absy
'
dim as RECT rc
GetWindowRect(hwnd,@rc)
x=MStruct->pt.x - rc.left
y=MStruct->pt.y - rc.top
'
x-=xoff 'force to client window coords
y-=yoff 'ditto
'
select case wparam
case 513
'left down
if mdown=0 then
pset(x,y)
mdown=1
end if
case 514
'left up
mdown=0
end select
if mdown=1 then line -(x,y)' try: pset(x,y)
'
end if
'
'pass-on all other mouse messes
MSProc1=CallNextHookEx(MSHandle,_
Code, wParam, lParam)
'
End Function
ETA to correct my mangling of Dez's handle.
And please see my FINAL getmouse() version below...
Last edited by Zippy on Feb 14, 2014 22:14, edited 1 time in total.
Re: Simple Smooth mouse drawing.
Interesting. I know different forms of basic pretty well but when it get's to Object Oriented Programming, calling function library's ect, I have a lot to learn. This is getting a little bit complex. Here i was thinking i would just jump right into to plotting the mandlebrot set after learning the difference in QB to FB math functions. I think I'll hold off a bit on that heh.
Re: Simple Smooth mouse drawing.
Don't worry, that second example is WinAPI, an elaborate trap set out by Microsoft to ensnare unwitting developers who are unfortunate enough to walk over it.
Seriously though, you'll be able to go pretty far by keeping it much simpler than that. :)
Seriously though, you'll be able to go pretty far by keeping it much simpler than that. :)
Re: Simple Smooth mouse drawing.
@cha0s
Heh. The Microsoft mystique. Mystifies me.
In the interest (no one cares, surely) of completeness I'll add a "Draw" version that subclasses the fbGFX WndProc. This - after I stumbled about a bit - is simpler than using a MOUSEHOOK.
Done.
Zzzzzzz...
Heh. The Microsoft mystique. Mystifies me.
In the interest (no one cares, surely) of completeness I'll add a "Draw" version that subclasses the fbGFX WndProc. This - after I stumbled about a bit - is simpler than using a MOUSEHOOK.
Code: Select all
'"Draw" using WinAPI and subclassed WndProc
'
#include once "windows.bi"
#include once "fbgfx.bi"
using fb
'
dim shared as HWND hwnd
dim shared as WNDPROC OrgWndProc
'
'used to subclass the fbGFX WndProc
declare function _
NewWndProc(_
hWnd as HWND,_
uMsg as uinteger,_
wParam as WPARAM,_
lParam as LPARAM) as LRESULT
'
screenres 640,480,32
windowtitle "Left-mouse to draw, <Esc> to exit"
ScreenControl GET_WINDOW_HANDLE,cast(integer,hwnd)
'
OrgWndProc=cast(WNDPROC,GetWindowLong(hwnd,GWL_WNDPROC))
'now we subclass the fbGFX WndProc...
SetWindowLong(hwnd,GWL_WNDPROC,cast(Integer,@NewWndProc))
'
while inkey<>chr(27)
sleep 100
wend
'
'end
'
function _
NewWndProc(_
hWnd as HWND,_
uMsg as uinteger,_
wParam as WPARAM,_
lParam as LPARAM) as LRESULT
'
static as integer mdown=0
dim as integer x,y
'
select case uMsg
'
case WM_LBUTTONDOWN
if mdown=0 then
x=LOWORD (lParam)
y=HIWORD (lParam)
pset(x,y)
mdown=1
end if
'
case WM_LBUTTONUP
mdown=0
'
case WM_MOUSEMOVE
if mdown=1 then
x=LOWORD (lParam)
y=HIWORD (lParam)
if x<64000 and y<64000 then
line -(x,y)
end if
end if
'
end select
'
return CallWindowProc(OrgWndProc,hWnd,uMsg,wParam,lParam)
'
end function
'
'onmouse-subclassed-WndProc-1.bas
Zzzzzzz...
Re: Simple Smooth mouse drawing.
@Dez
[note I got your handle correct this time... I had been channeling "Dexter"]
I now have a truly SIMPLE "Draw" using getmouse(). Using ONE getmouse() [every invocation of getmouse() slows down the polling loop]. I've tried to do this (using ONE...) in the past but the logic has always escaped me. This will allow single-pixel "plots" and non-contiguous lines.
Now I'm done.
[note I got your handle correct this time... I had been channeling "Dexter"]
I now have a truly SIMPLE "Draw" using getmouse(). Using ONE getmouse() [every invocation of getmouse() slows down the polling loop]. I've tried to do this (using ONE...) in the past but the logic has always escaped me. This will allow single-pixel "plots" and non-contiguous lines.
Code: Select all
'getmouse() "Draw": inline : reqs gfx mode
' the FINAL & simplest version, using a single getmouse()
'
dim as integer buttons,lastbutton,x,y
'
screenres 640,480,32
WindowTitle "Hold Left mouse button to draw, Right-click to EXIT"
SetMouse(320,240,1,1) 'init & keep mouse in client area - needed!
sleep 100 'let the window settle down...
'
while (GetMouse(x,y,,buttons)=0)
'
if buttons=1 then
if lastbutton=1 then
line -(x,y)
else
pset(x,y)
lastbutton=1
end if
else
lastbutton=0
end if
'
if buttons=2 then exit while
'
sleep 1
'
wend
'
beep
sleep 100
'end
'onmouse-single-getmouse-1
Re: Simple Smooth mouse drawing.
Something slightly different.
I use this to draw polygons, and write the points to a file (not here).
Not a smooth drawing here, but a sharp click where you want a point.
Right click if you change your mind.
(I've included a spline to spice it up a bit, it is VERY boring otherwise, or maybe still.)
Please note that the spline requires a next click point in order to calculate the last, sorry, that's just the way of it!
I use this to draw polygons, and write the points to a file (not here).
Not a smooth drawing here, but a sharp click where you want a point.
Right click if you change your mind.
(I've included a spline to spice it up a bit, it is VERY boring otherwise, or maybe still.)
Please note that the spline requires a next click point in order to calculate the last, sorry, that's just the way of it!
Code: Select all
Type Point
As Single x,y,z
as integer counter
End Type
'======= Basic operations with type point ==============
Operator * (f As Single,v1 As Point) As Point
Return type<point>(f*v1.x,f*v1.y,f*v1.z)
End Operator
operator *(V1 as point,f as single) as point
return f*v1
end operator
Operator + (v1 As Point,v2 As Point) As Point
Return type<point>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(v1 As Point,v2 As Point) As Point
Return type<point>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
'=====================================================
'================== Spline functions and drawing =================
Function catmull(p() As Point,t As Single) As Point
Return 0.5 *( (2 * P(2)) +_
(-1*P(1) + P(3)) * t +_
(2*P(1) - 5*P(2) + 4*P(3) - P(4)) * t*t +_
(-1*P(1) + 3*P(2)- 3*P(3) + P(4)) * t*t*t)
End Function
Sub FetchCatmull(v() As Point,outarray() As Point,arraysize As Integer=500)
Dim As Point p(1 To 4)
Redim outarray(0)
Dim As Single stepsize=(Ubound(v)-1)/(arraysize)
If stepsize>1 Then stepsize=1
For n As Integer=2 To Ubound(v)-2
p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)
For t As Single=0 To 1 Step stepsize
Var temp=catmull(p(),t)
Redim Preserve outarray(1 To Ubound(outarray)+1)
outarray(Ubound(outarray))=temp
Next t
Next n
End Sub
Sub DrawCatmullPoints(a() As Point,col As Uinteger,ydisp As Integer=0)
Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),col
For z As Integer=Lbound(a)+1 To Ubound(a)
Line-(a(z).x,a(z).y+ydisp),col
Next z
End Sub
'============= SET UP DRAWING LOOP =============
Redim As Point s(0)
Redim As Point catmullpts(0)
Dim As Integer xres,yres
Screeninfo xres,yres
Screenres xres,yres,32,,64
Dim As Integer mx,my,mb,flag1,counter,flag2
Do
Getmouse mx,my,,mb
Screenlock
Cls
'================= GRID =======================
For x As Integer=0 To xres Step 50
Line(x,0)-(x,yres),Rgba(255,255,255,100)
Next x
For y As Integer=0 To yres Step 50
Line(0,y)-(xres,y),Rgba(255,255,255,100)
Next y
'==============================================
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'============ Text ===========================
draw string(xres/3,20),"mouse " & mx &" " & my
draw string(10,10),"Points"
for n as integer=1 to ubound(s)
'edge of screen
draw string(20,20+12*n)," " & s(n).counter &" " &s(n).x & " , " &s(n).y
'At circles
draw string(s(n).x,s(n).y-16),"" &s(n).counter
next n
'===============================================
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'======= Mouse events ================================
If mb=1 And flag1=0 Then
flag1=1:counter+=1
Redim Preserve s(1 To Ubound(s)+1)
s(Ubound(s))=Type<Point>(mx,my,0,counter)
'redo the spline at a change of s()
fetchcatmull(s(),catmullpts())
End If
flag1=mb
if mb=2 and flag2=0 then
flag2=1
if counter>1 then redim preserve s(1 to ubound(s)-1):counter-=1
if counter=1 then redim s(0):counter=0
'redo the spline at a change of s()
fetchcatmull(s(),catmullpts())
end if
flag2=mb
'=================================================
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'================== Lines and circles ============
If Ubound(s) Then Circle(s(1).x,s(1).y),2,,,,,f
For n As Integer=2 To Ubound(s)
Line -(s(n).x,s(n).y),rgba(200,200,200,100)'optional straight lines
circle (s(n).x,s(n).y),2,,,,,f 'the points
Next n
'Draw the spline
DrawCatmullPoints(catmullpts(),rgba(200,0,0,255))
'=================================================
Screenunlock
Sleep 1,1
Loop Until Len(Inkey)
Re: Simple Smooth mouse drawing.
@zippy
I've played around with all the programs here zippy. It is extremely simple to copy and paste something then compile it to see if there is any difference in performance while coding something one way over another. I'm impressed with the last program because I understand it and it's very efficient. When I run your last program and the first one posted by BasicCoder2, there is quite a difference in response time, even without calling outside library functions.
@dodicat
Your program nicely illustrates spline curves. Very sharp looking demo. What I didn't realize before this demo was that the spline curves seem to be dynamic. If i click a spiral design, I notice all the spline curves changing subtly. Was it coded to be dynamic on the splines or does the math for splines automatically make them all dynamic ? I'm not a math wiz but i see array's in your code. If i had to guess, you are using array's to track all points along the splines in order to make all the curves dynamic ?
I've played around with all the programs here zippy. It is extremely simple to copy and paste something then compile it to see if there is any difference in performance while coding something one way over another. I'm impressed with the last program because I understand it and it's very efficient. When I run your last program and the first one posted by BasicCoder2, there is quite a difference in response time, even without calling outside library functions.
@dodicat
Your program nicely illustrates spline curves. Very sharp looking demo. What I didn't realize before this demo was that the spline curves seem to be dynamic. If i click a spiral design, I notice all the spline curves changing subtly. Was it coded to be dynamic on the splines or does the math for splines automatically make them all dynamic ? I'm not a math wiz but i see array's in your code. If i had to guess, you are using array's to track all points along the splines in order to make all the curves dynamic ?
Re: Simple Smooth mouse drawing.
Hi Dez.
Yes, the points are dynamic, they are re-formulated at each extra point clicked on or off.
The Catmull Rom type of spline is well known and easy to implement:
http://www.mvps.org/directx/articles/catmull/
There are loads of different splines, all based on polynomial interpolation.
However, here's one based on asteroids, but with a slight difference.
This asteroid travels from the first point, attracted by a gravity of sorts towards the next point, but when it gets a certain distance from the next point, it switches it's attention to the next next point, and heads for it instead, it does this with all points.
In this way it doesn't actually pass through each point, but has a close approach.
All asteroids should behave like this IMHO, it would save all these ugly pock marks on the planets and moons.
A word of warning though, if the curvature is set too high, it might just go into orbit around a point in ever decreasing circles.
In this case you must minimize the window and close the console.
Yes, the points are dynamic, they are re-formulated at each extra point clicked on or off.
The Catmull Rom type of spline is well known and easy to implement:
http://www.mvps.org/directx/articles/catmull/
There are loads of different splines, all based on polynomial interpolation.
However, here's one based on asteroids, but with a slight difference.
This asteroid travels from the first point, attracted by a gravity of sorts towards the next point, but when it gets a certain distance from the next point, it switches it's attention to the next next point, and heads for it instead, it does this with all points.
In this way it doesn't actually pass through each point, but has a close approach.
All asteroids should behave like this IMHO, it would save all these ugly pock marks on the planets and moons.
A word of warning though, if the curvature is set too high, it might just go into orbit around a point in ever decreasing circles.
In this case you must minimize the window and close the console.
Code: Select all
const curvature=50
Type Point
As Single x,y,z
as integer counter
End Type
Type particle
As Point position,velocity
End Type
'======= Basic operations with type point ==============
Operator * (f As Single,v1 As Point) As Point
Return type<point>(f*v1.x,f*v1.y,f*v1.z)
End Operator
operator *(V1 as point,f as single) as point
return f*v1
end operator
Operator + (v1 As Point,v2 As Point) As Point
Return type<point>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(v1 As Point,v2 As Point) As Point
Return type<point>(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Function length(v As Point) As Single
Return Sqr(v.x*v.x+v.y*v.y+v.z*v.z)
End Function
Function normalize(v As Point) As Point
Dim n As Single=length(v)
If n=0 Then n=1e-20
Return (1/n)*v
End Function
'=====================================================
'================== Trace functions and drawing =================
Sub trace(In() As Point,Outarray() As Point,roundedness As Single=60)
Redim Outarray(0)
Dim As particle p:roundedness=roundedness/10
If roundedness<1 Then roundedness=1
If roundedness>100 Then roundedness=10
p.position=In(Lbound(In))
p.velocity=normalize(Type<Point>(In(Lbound(In)+1)-In(Lbound(In))))
Redim Preserve Outarray(1 To Ubound(Outarray)+1)
Outarray(Ubound(Outarray))=Type<Point>(In(Lbound(In)).x,In(Lbound(In)).y)
Dim As Point f
For n As Integer=Lbound(In) To Ubound(In)-1
Do
Var dist=length(p.position-In(n+1))
f=(1/(Ubound(In)))*f+normalize(In(n+1)-p.position)
p.velocity= roundedness*normalize(p.velocity+f)
p.position=p.position+p.velocity
Redim Preserve Outarray(1 To Ubound(Outarray)+1)
Outarray(Ubound(Outarray))=Type<Point>(p.position.x,p.position.y)
If dist<5*roundedness Then Exit Do
Loop Until Len(Inkey)
Next n
Redim Preserve Outarray(1 To Ubound(Outarray)+1)
Outarray(Ubound(Outarray))=Type<Point>(In(Ubound(In)).x,In(Ubound(In)).y)
End Sub
Sub DrawTracePoints(a() As Point,col As Uinteger,ydisp As Integer=0)
Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),col
For z As Integer=Lbound(a)+1 To Ubound(a)
Line-(a(z).x,a(z).y+ydisp),col
Next z
End Sub
'============= SET UP DRAWING LOOP =============
Redim As Point s(0)
Redim As Point Tracepts(0)
Dim As Integer xres,yres
Screeninfo xres,yres
Screenres xres,yres,32,,64
Dim As Integer mx,my,mb,flag1,counter,flag2
Do
Getmouse mx,my,,mb
Screenlock
Cls
'================= GRID =======================
For x As Integer=0 To xres Step 50
Line(x,0)-(x,yres),Rgba(255,255,255,100)
Next x
For y As Integer=0 To yres Step 50
Line(0,y)-(xres,y),Rgba(255,255,255,100)
Next y
'==============================================
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'============ Text ===========================
draw string(xres/3,20),"mouse " & mx &" " & my
draw string(xres/3,50),"Number of interpolatein points " &(ubound(Tracepts))
draw string(10,10),"Points"
for n as integer=1 to ubound(s)
'edge of screen
draw string(20,20+12*n)," " & s(n).counter &" " &s(n).x & " , " &s(n).y
'At circles
draw string(s(n).x,s(n).y-16),"" &s(n).counter
next n
'===============================================
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'======= Mouse events ================================
If mb=1 And flag1=0 Then
flag1=1:counter+=1
Redim Preserve s(1 To Ubound(s)+1)
s(Ubound(s))=Type<Point>(mx,my,0,counter)
'redo the spline at a change of s()
if ubound(s)>1 then trace(s(),Tracepts(),curvature)
End If
flag1=mb
if mb=2 and flag2=0 then
flag2=1
if counter>1 then redim preserve s(1 to ubound(s)-1):counter-=1
if counter=1 then redim s(0):counter=0
'redo the spline at a change of s()
if ubound(s)>1 then trace(s(),Tracepts(),curvature)
end if
flag2=mb
'=================================================
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'================== Lines and circles ============
If Ubound(s) Then Circle(s(1).x,s(1).y),2,,,,,f
For n As Integer=2 To Ubound(s)
Line -(s(n).x,s(n).y),rgba(200,200,200,100)'optional straight lines
circle (s(n).x,s(n).y),2,,,,,f 'the points
Next n
'Draw the spline
if ubound(tracepts) then DrawTracePoints(Tracepts(),rgba(200,0,0,255))
'=================================================
Screenunlock
Sleep 1,1
Loop Until Len(Inkey)
Re: Simple Smooth mouse drawing.
I can see the orbits you're talking about if i make a triangle wave stay between two grid lines(one triangle shape per grid box). I find this stuff interesting.