## Spline Curve

Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

### Spline Curve

I made it for the water thing, nice way to make polygons look curvy. Idea came from those little sqaure/dot/draw line things I did way back in 6th grade or so, ya know? that thing where all those lines drawn between two other lines make a curve.

Code: Select all

`Option ExplicitSub Curve(byval Ax as integer, Ay as integer, byval Bx as integer, byval By as integer, byval Cx as integer, Cy as integer)    Dim as double m1x, m1y, m2x, m2y, d1, d2, m, vx1, vy1, vx2, vy2, dx, dy, dm, sm, sam, px1, py1, px2, py2    Dim as double vpx1, vpy1, vpx2, vpy2    m1x = (Ax+Bx) SHR 1    m1y = (Ay+By) SHR 1    m2x = (Bx+Cx) SHR 1    m2y = (By+Cy) SHR 1    vx1 = m1x-Bx: vy1 = m1y-By    vx2 = m2x-Bx: vy2 = m2y-By    d1 = SQR(vx1*vx1 + vy1*vy1)    d2 = SQR(vx2*vx2 + vy2*vy2)    If d1 >= d2 Then        m = d1    Else        m = d2     Endif    vx1 /= m: vy1 /= m    vx2 /= m: vy2 /= m    sm = 1/m    Dim as double i    For i = 0 To m        px1 = (m1x-vpx1): py1 = (m1y-vpy1)        px2 = (Bx+vpx2): py2 = (By+vpy2)        dx = px2-px1        dy = py2-py1        sam += sm        vpx1 += vx1: vpy1 += vy1        vpx2 += vx2: vpy2 += vy2        Pset (px1+dx*sam, py1+dy*sam), &HFFFF00    Next iEnd Sub'_______________________________________________________________'__________________________TEST CODE____________________________Type OPair    as integer x, yEnd TypeDim as OPair A, B, Cscreenres 640,480,32, 2screenset 1,0randomize timerA.x = INT(rnd*640): A.y = int(rnd*480)B.x = int(rnd*640): B.y = int(rnd*480)C.x = int(rnd*640): C.y = int(rnd*480)Dim as integer mx,my,bt,t, sDim as double d1,d2,d3s = 0Doclsgetmouse mx,my,,btIf bt>0 And s = 0 Then    s = 1    d1 = SQR((mx-A.x)^2+(my-A.y)^2)    d2 = SQR((mx-B.x)^2+(my-B.y)^2)    d3 = SQR((mx-C.x)^2+(my-C.y)^2)    If d1 < d2 And d1 < d3 Then         t = 1        GOTO eo    Endif    If d2 < d1 And d2 < d3 Then         t = 2        GOTO eo    Endif    t = 3Elseif bt>0 And s = 1 then    If t=1 Then A.x = mx: A.y = my    If t=2 Then B.x = mx: B.y = my    If t=3 Then C.x = mx: C.y = myElseif bt=0 And s = 1 Then        s = 0    t = 0EndifEO:screenlockLine (A.x, A.y)-(B.x, B.y), RGB(32,32,32)Line (B.x, B.y)-(C.x, C.y), RGB(32,32,32)Line (C.x, C.y)-(A.x, A.y), RGB(32,32,32)Curve A.x, A.y, B.x, B.y, C.x, C.yCurve B.x, B.y, C.x, C.y, A.x, A.yCurve C.x, C.y, A.x, A.y, B.x, B.yLine (A.x-2,A.y-2)-(A.x+2, A.y+2), RGB(128,255,128),BLine (B.x-2,B.y-2)-(B.x+2, B.y+2), RGB(128,255,128),BLine (C.x-2,C.y-2)-(C.x+2, C.y+2), RGB(128,255,128),BscreenunlockFlipLoop until multikey(&H01)end`
Last edited by Zamaster on Dec 10, 2006 19:23, edited 1 time in total.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:
this looks sexy :)
i like moving things around...
DNAarray
Posts: 29
Joined: May 15, 2006 21:17

### looks great

awesome
Pritchard
Posts: 5478
Joined: Sep 12, 2005 20:06
Location: Ohio, USA
Very awesome. Hahah, create an anti-aliased version of this :D
ytwinky
Posts: 217
Joined: Dec 03, 2005 12:44
Location: MD, Germany
hi,
I like this proggram very much but:
..I wanted to get rid of the Goto-Command, which I don't like for some (good) reasons..
..some (not only cosmetical optimizations) followed and here it is, still working as before:

Code: Select all

`#define Real SingleOption ExplicitSub Curve(byVal Ax As Long, byVal Ay As Long, byVal Bx As Long, byVal By As Long, byVal Cx As Long, byVal Cy As Long)  Dim As Real m1x=(Ax+Bx) Shr 1, m1y=(Ay+By) Shr 1, m2x=(Bx+Cx) Shr 1, m2y=(By+Cy) Shr 1  Dim As Real vx1=m1x-Bx, vy1=m1y-By, vx2=m2x-Bx, vy2=m2y-By, d1=Sqr(vx1*vx1+vy1*vy1), d2=Sqr(vx2*vx2+vy2*vy2)  Dim As Real dx, dy, dm, sm, sam, px1, py1, px2, py2, vpx1, vpy1, vpx2, vpy2, m=IIF(d1>=d2, d1, d2)  Dim As Long i  vx1/=m  vy1/=m  vx2/=m  vy2/=m  sm=1/m  For i=0 To m    px1=m1x-vpx1    py1=m1y-vpy1    px2=Bx+vpx2    py2=By+vpy2    dx=px2-px1    dy=py2-py1    sam+=sm    vpx1+=vx1    vpy1+=vy1    vpx2+=vx2    vpy2+=vy2    PSet (px1+dx*sam, py1+dy*sam), &HFFFF00  Next iEnd Sub'__________________________TEST CODE____________________________Type OPair  As Long x, yEnd TypeDim A(1 To 3) As OPair, d(1 To 3) As RealDim As Long mx, my, bt, t, s, lc=RGB(32, 32, 32), sc=RGB(128, 255, 128), sx=640, sy=480, iScreenRes sx, sy, 32, 2ScreenSet 1, 0Randomize TimerFor i=1 To 3  A(i).x=Int(Rnd*sx)  A(i).y=Int(Rnd*sy)Nexts=0Do  Cls  GetMouse mx, my,, bt  If bt>0 And s=0 Then    s=1    For i=1 To 3      d(i)=Sqr((mx-A(i).x)^2+(my-A(i).y)^2)    Next    t=IIF(d(1)<d(2) And d(1)<d(3), 1, IIF(d(2)<d(1) And d(2)<d(3), 2, 3))  ElseIf bt>0 And s=1 Then    A(t).x=mx    A(t).y=my  ElseIf bt=0 And s=1 Then    s=0    t=0  EndIfEO: 'not really needed :D  ScreenLock    Line (A(1).x, A(1).y)-(A(2).x, A(2).y), lc    Line (A(2).x, A(2).y)-(A(3).x, A(3).y), lc    Line (A(3).x, A(3).y)-(A(1).x, A(1).y), lc    Curve A(1).x, A(1).y, A(2).x, A(2).y, A(3).x, A(3).y    Curve A(2).x, A(2).y, A(3).x, A(3).y, A(1).x, A(1).y    Curve A(3).x, A(3).y, A(1).x, A(1).y, A(2).x, A(2).y    Line (A(1).x-2, A(1).y-2)-(A(1).x+2, A(1).y+2), sc, B    Line (A(2).x-2, A(2).y-2)-(A(2).x+2, A(2).y+2), sc, B    Line (A(3).x-2, A(3).y-2)-(A(3).x+2, A(3).y+2), sc, B  ScreenUnlock  FlipLoop Until MultiKey(&H01)End`
..as you can see, I took the color-evaluation off the loop 'cause it's not necessary
to evaluate constant values permanently. Plz note the 'intensive' use of my dearest command:IIF()
Regards
ytwinky
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:
ah, well... the algorithm was optomized by me! lol. coolio yo. I personally like GOTOs... dont know why
DNAarray
Posts: 29
Joined: May 15, 2006 21:17

### alpha blending

From the original code, rather than use pset, i used imagecreate and posted to screen twice with alpha blending of 100 sleep 1 was added in loop so you don't take 98% of the systems resources.

Code: Select all

`Option ExplicitSub Curve(Byval Ax As Integer, Ay As Integer, Byval Bx As Integer, Byval By As Integer, Byval Cx As Integer, Cy As Integer)    Dim As Double m1x, m1y, m2x, m2y, d1, d2, m, vx1, vy1, vx2, vy2, dx, dy, dm, sm, sam, px1, py1, px2, py2    Dim As Double vpx1, vpy1, vpx2, vpy2    DIM zz AS ANY PTR    zz=imagecreate(3,3,&hAAAA33)    m1x = (Ax+Bx) Shr 1    m1y = (Ay+By) Shr 1    m2x = (Bx+Cx) Shr 1    m2y = (By+Cy) Shr 1    vx1 = m1x-Bx: vy1 = m1y-By    vx2 = m2x-Bx: vy2 = m2y-By    d1 = Sqr(vx1*vx1 + vy1*vy1)    d2 = Sqr(vx2*vx2 + vy2*vy2)    If d1 >= d2 Then        m = d1    Else        m = d2    Endif    vx1 /= m: vy1 /= m    vx2 /= m: vy2 /= m    sm = 1/m    Dim As Double i    For i = 0 To m        px1 = (m1x-vpx1): py1 = (m1y-vpy1)        px2 = (Bx+vpx2): py2 = (By+vpy2)        dx = px2-px1        dy = py2-py1        sam += sm        vpx1 += vx1: vpy1 += vy1        vpx2 += vx2: vpy2 += vy2        Put (px1+dx*sam, py1+dy*sam), zz,ALPHA,100        Put (px1+dx*sam, py1+dy*sam), zz,ALPHA,100   Next iEnd Sub'_______________________________________________________________'__________________________TEST CODE____________________________Type OPair    As Integer x, yEnd TypeDim As OPair A, B, Cscreenres 640,480,32, 2screenset 1,0Randomize TimerA.x = Int(Rnd*640): A.y = Int(Rnd*480)B.x = Int(Rnd*640): B.y = Int(Rnd*480)C.x = Int(Rnd*640): C.y = Int(Rnd*480)Dim As Integer mx,my,bt,t, sDim As Double d1,d2,d3s = 0DoClsgetmouse mx,my,,btIf bt>0 And s = 0 Then    s = 1    d1 = Sqr((mx-A.x)^2+(my-A.y)^2)    d2 = Sqr((mx-B.x)^2+(my-B.y)^2)    d3 = Sqr((mx-C.x)^2+(my-C.y)^2)    If d1 < d2 And d1 < d3 Then        t = 1        Goto eo    Endif    If d2 < d1 And d2 < d3 Then        t = 2        Goto eo    Endif    t = 3Elseif bt>0 And s = 1 Then    If t=1 Then A.x = mx: A.y = my    If t=2 Then B.x = mx: B.y = my    If t=3 Then C.x = mx: C.y = myElseif bt=0 And s = 1 Then       s = 0    t = 0EndifEO:screenlockLine (A.x, A.y)-(B.x, B.y), RGB(32,32,32)Line (B.x, B.y)-(C.x, C.y), RGB(32,32,32)Line (C.x, C.y)-(A.x, A.y), RGB(32,32,32)Curve A.x, A.y, B.x, B.y, C.x, C.yCurve B.x, B.y, C.x, C.y, A.x, A.yCurve C.x, C.y, A.x, A.y, B.x, B.yLine (A.x-2,A.y-2)-(A.x+2, A.y+2), RGB(128,255,128),BLine (B.x-2,B.y-2)-(B.x+2, B.y+2), RGB(128,255,128),BLine (C.x-2,C.y-2)-(C.x+2, C.y+2), RGB(128,255,128),BscreenunlockFlipLoop Until multikey(&H01)sleep 1End `
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:
ARGHHHHHHH!!! Everyone is harrassing me about the test code, who CARES?!?!?!?! Its the algorithm that means anything! Yes, I know you can substitute PSET to plot the curve and you can use different test code, but thats totaly not the point. Its the algorithm yo, da math and stuff!
Pritchard
Posts: 5478
Joined: Sep 12, 2005 20:06
Location: Ohio, USA
We're not harrassing you. We're making improvements because that's what we do. People care about things other than the algorithm sometimes. Ex: Better test code . . . :D I don't think these are personal attacks. This is tips & tricks so expect someone to play around with your code a bit.

Although, if someone improved the algorithm that'd be best for this kind of post. Ex: Make a faster/better spline curve math.
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:
exaclty, test code is test code. "test". But im all up for improvements on the actual algorithm.