about grable's verlet code and circ-to-line colls

BlitzMax Forums/BlitzMax Programming/about grable's verlet code and circ-to-line colls

aristid (Posted 2006) [#1]

hello all. I've been hugely impressed by grable's simple verlet code http://www.blitzbasic.com/codearcs/codearcs.php?code=1769 probably like many others! and would like to get something working out of it. it seems to me in order to go on, we need circle-to-circle collisions (between particles), but, most importantly, circle-to-line collisions, for collisions between particles and "background" lines, like platforms, ground etc. I suck at it, but gave it a try. I am not a programmer and not familiar with these things though. first, I explored circle-line collisions and line-line collisions. the idea (have no clue how sound it is) is that if a particle collides with a line, project it to outside the line (hopefully on the proper side!). if it doesnt, check its path on this step (oldx,y to newx,y) and see if you get a collision between path line and static line. If those collide, project the particle at the proper spot. (got the proper side working too!) contains functions found in the archives. I modified some so they return a x,y array, or -1,-1 if no collision is happening. use 1,2 to set x,y of line, 3,4 to set x,y of path the circle at mousepoint is the size we're testing. here's my testbed code: (how do I put the code in those neat boxes so they dont take up all this space?) ---------------------------------------------------- Function GetAngDiff#(ang1#,ang2#) Local diff#=ang2-ang1 While diff>180 diff=diff-360 Wend While diff<-180 diff=diff+360 Wend Return diff End Function 'Adapted from Fredborg's code Function LinesCross[]( x0:Float, y0:Float , x1:Float, y1:Float,.. x2:Float ,y2:Float, x3:Float, y3:Float ) Local n:Float=(y0-y2)*(x3-x2)-(x0-x2)*(y3-y2) Local d:Float=(x1-x0)*(y3-y2)-(y1-y0)*(x3-x2) If Abs(d) < 0.0001 ' Lines are parallel! Return [-1,-1] Else ' Lines might cross! Local Sn:Float=(y0-y2)*(x1-x0)-(x0-x2)*(y1-y0) Local AB:Float=n/d If AB>0.0 And AB<1.0 Local CD:Float=Sn/d If CD>0.0 And CD<1.0 ' Intersection Point Local X=x0+AB*(x1-x0) Local Y=y0+AB*(y1-y0) 'SetColor 255,0,255 'DrawOval x-(2),y-(2), 5,5 'DrawText x+","+y, 0,45 Return [x,y] End If End If ' Lines didn't cross, because the intersection was beyond the end points of the lines EndIf ' Lines do Not cross! Return [-1,-1] End Function Function LineToCircle[]( x1:Float, y1:Float, x2:Float, y2:Float, px:Float, py:Float, r:Float ) Local sx:Float = x2-x1 Local sy:Float = y2-y1 Local q:Float = ((px-x1) * (x2-x1) + (py - y1) * (y2-y1)) / (sx*sx + sy*sy) If q < 0.0 Then q = 0.0 If q > 1.0 Then q = 1.0 Local cx:Float=(1-q)*x1+q*x2 Local cy:Float=(1-q)*y1 + q*y2 'DrawText "dist: "+PointToPointDist(px,py,cx,cy), 0,15 'Local ang%=angle%(px,py,cx,cy) 'DrawText "ang: "+ang, 0,30 If PointToPointDist(px,py,cx,cy) < r Return [Int(cx),Int(cy)] Else Return [-1,-1] EndIf End Function Function PointToPointDist:Float( x1:Float, y1:Float, x2:Float, y2:Float ) Local dx:Float = x1-x2 Local dy:Float = y1-y2 Return Sqr(dx*dx + dy*dy) End Function Function angle%(x1#,y1#,x2#,y2#) Local angle%=ATan2(x2-x1,y2-y1) Return 180-angle End Function Function LineToCircle_givepos[]( x1, y1, x2, y2, x, y, r ) 'circle to line Local aha[2] aha = LineToCircle( x1, y1, x2, y2, x, y, r ) If Not(aha[0]=-1 And aha[1]=-1) 'SetColor 255,0,255 'DrawOval aha[0]-(2),aha[1]-(2), 5,5 'DrawLine x,y,aha[0],aha[1] Local ang%=angle%(x,y,aha[0],aha[1]) Local nx# = aha[0]+(r*Cos(ang+90)) Local ny# = aha[1]+(r*Sin(ang+90)) 'DrawOval nx-(2),ny-(2), 5,5 Return [Int(nx),Int(ny)] Else Return [-1,-1] EndIf End Function Function LinesCross_givepos[]( x1, y1, x2, y2, x21, y21, x22, y22, static_ang#, static_xoff#, static_yoff#, r ) Local aha2[2] aha2 = Linescross( x1, y1, x2, y2, x21, y21, x22, y22 ) 'DrawText aha2[0]+","+aha2[1], 0,60 If Not(aha2[0]=-1 And aha2[1]=-1) '..have crossed If static_ang=-1 'no angle given, so calculate it static_ang = angle(x1,y1,x2,y2) static_xoff=(Cos(static_ang+180)) static_yoff=(Sin(static_ang+180)) EndIf Local ang22%=angle%(x21,y21,x22,y22) Local angdif=GetAngDiff#(static_ang,ang22) static_xoff#:*r static_yoff#:*r 'center of circle projection from impact point If angdif<0 Then static_xoff:*-1;static_yoff:*-1 Return [Int(aha2[0]+static_xoff), Int(aha2[1]+static_yoff)] Else Return [-1,-1] EndIf EndFunction ' ' TEST ' Global x1:Float= Rnd(200),x2:Float=Rnd(200)+500,y1:Float=Rnd(200),y2:Float=Rnd(200)+500,x:Float,y:Float,r:Float=100 Global x21:Float= Rnd(200),x22:Float=Rnd(200)+500,y21:Float=Rnd(200),y22:Float=Rnd(200)+500 Global mx:Int,my:Int Graphics 1024,768, 0 Repeat If KeyDown( KEY_SPACE) Then x1= Rnd(1000) x2=Rnd(1000) y1=Rnd(800) y2=Rnd(800) x21= Rnd(1000) x22=Rnd(1000) y21=Rnd(800) y22=Rnd(800) EndIf x=MouseX() y=MouseY() If KeyDown(KEY_1) Then x1=x;y1=y If KeyDown(KEY_2) Then x2=x;y2=y If KeyDown(KEY_3) Then x21=x;y21=y If KeyDown(KEY_4) Then x22=x;y22=y DrawOval x-(r),y-(r), r*2,r*2 SetColor 255,255,255 DrawLine x1,y1,x2,y2 SetColor 155,155,155 DrawLine x21,y21,x22,y22 SetColor 0,255,0 DrawOval x1-(2),y1-(2), 5,5 SetColor 0,155,0 DrawOval x21-(2),y21-(2), 5,5 Local pos[2] pos = LineToCircle_givepos( x1, y1, x2, y2, x, y, r ) If Not(pos[0]=-1 And pos[1]=-1) 'circle in line, position circle at pos SetColor 255,0,255 DrawOval pos[0]-(2),pos[1]-(2), 5,5 'DrawLine x,y,pos[0],pos[1] EndIf Local pos2[2] Local static_ang# = angle(x1,y1,x2,y2) Local static_xoff#=(Cos(static_ang+180)) Local static_yoff#=(Sin(static_ang+180)) pos2 = LinesCross_givepos( x1, y1, x2, y2, x21, y21, x22, y22, static_ang, static_xoff, static_yoff, r ) If Not(pos2[0]=-1 And pos2[1]=-1) 'line on line, position circle at pos2 SetColor 255,0,255 DrawOval pos2[0]-(2),pos2[1]-(2), 5,5 EndIf SetColor 255,255,255 DrawText "press 1,2 for start,end of solid line, 3,4 for path line", 0,0 DrawText "purple point is where circle should be positioned to stay above the solid line.", 0,15 Flip 1 Cls Until KeyHit( KEY_ESCAPE) End then I modified grable's code. created a new object, staticline and staticgroup, to contain the lines. there are also other mdifications in here, you will see a rope hanging ready to be tinkered, plus you can make a constraint soft or hard by pressing 1-6 while making it (1-rubbery, 6-as solid as it gets). you can also use arrow keys to move previously selected verlet. I sort of got the collision working but have no idea what I'm doing wrong. particles go through the lines at high-ish speeds and they also seem to develop a force pushing them left! any pointers or help greatly appreciated. I believe some solid collision code on grable's example can result in a nice and simple verlet engine that can be quite useable! best of all, if we can get grable to properly do it for us!! ;-) cheers to all and merry christmas. modified grable's verlet example code: Strict Const S_TIMESTEP:Float = 0.1 Function GetAngDiff#(ang1#,ang2#) Local diff#=ang2-ang1 While diff>180 diff=diff-360 Wend While diff<-180 diff=diff+360 Wend Return diff End Function 'Adapted from Fredborg's code Function LinesCross[]( x0:Float, y0:Float , x1:Float, y1:Float,.. x2:Float ,y2:Float, x3:Float, y3:Float ) Local n:Float=(y0-y2)*(x3-x2)-(x0-x2)*(y3-y2) Local d:Float=(x1-x0)*(y3-y2)-(y1-y0)*(x3-x2) If Abs(d) < 0.0001 ' Lines are parallel! Return [-1,-1] Else ' Lines might cross! Local Sn:Float=(y0-y2)*(x1-x0)-(x0-x2)*(y1-y0) Local AB:Float=n/d If AB>0.0 And AB<1.0 Local CD:Float=Sn/d If CD>0.0 And CD<1.0 ' Intersection Point Local X=x0+AB*(x1-x0) Local Y=y0+AB*(y1-y0) 'SetColor 255,0,255 'DrawOval x-(2),y-(2), 5,5 'DrawText x+","+y, 0,45 Return [x,y] End If End If ' Lines didn't cross, because the intersection was beyond the end points of the lines EndIf ' Lines do Not cross! Return [-1,-1] End Function Function LineToCircle[]( x1:Float, y1:Float, x2:Float, y2:Float, px:Float, py:Float, r:Float ) Local sx:Float = x2-x1 Local sy:Float = y2-y1 Local q:Float = ((px-x1) * (x2-x1) + (py - y1) * (y2-y1)) / (sx*sx + sy*sy) If q < 0.0 Then q = 0.0 If q > 1.0 Then q = 1.0 Local cx:Float=(1-q)*x1+q*x2 Local cy:Float=(1-q)*y1 + q*y2 'DrawText "dist: "+PointToPointDist(px,py,cx,cy), 0,15 'Local ang%=angle%(px,py,cx,cy) 'DrawText "ang: "+ang, 0,30 If PointToPointDist(px,py,cx,cy) < r Return [Int(cx),Int(cy)] Else Return [-1,-1] EndIf End Function Function PointToPointDist:Float( x1:Float, y1:Float, x2:Float, y2:Float ) Local dx:Float = x1-x2 Local dy:Float = y1-y2 Return Sqr(dx*dx + dy*dy) End Function Function angle%(x1#,y1#,x2#,y2#) Local angle%=ATan2(x2-x1,y2-y1) Return 180-angle End Function Function LineToCircle_givepos[]( x1, y1, x2, y2, x, y, r ) 'circle to line Local aha[2] aha = LineToCircle( x1, y1, x2, y2, x, y, r ) If Not(aha[0]=-1 And aha[1]=-1) 'SetColor 255,0,255 'DrawOval aha[0]-(2),aha[1]-(2), 5,5 'DrawLine x,y,aha[0],aha[1] Local ang%=angle%(x,y,aha[0],aha[1]) Local nx# = aha[0]+(r*Cos(ang+90)) Local ny# = aha[1]+(r*Sin(ang+90)) 'DrawOval nx-(2),ny-(2), 5,5 Return [Int(nx),Int(ny)] Else Return [-1,-1] EndIf End Function Function LinesCross_givepos[]( x1, y1, x2, y2, x21, y21, x22, y22, static_ang#, static_xoff#, static_yoff#, r ) Local aha2[2] aha2 = Linescross( x1, y1, x2, y2, x21, y21, x22, y22 ) 'DrawText aha2[0]+","+aha2[1], 0,60 If Not(aha2[0]=-1 And aha2[1]=-1) '..have crossed If static_ang=-1 'no angle given, so calculate it static_ang = angle(x1,y1,x2,y2) static_xoff=(Cos(static_ang+180)) static_yoff=(Sin(static_ang+180)) EndIf Local ang22%=angle%(x21,y21,x22,y22) Local angdif=GetAngDiff#(static_ang,ang22) static_xoff#:*r static_yoff#:*r 'center of circle projection from impact point If angdif<0 Then static_xoff:*-1;static_yoff:*-1 Return [Int(aha2[0]+static_xoff), Int(aha2[1]+static_yoff)] Else Return [-1,-1] EndIf EndFunction Type TSStaticline Field x1:Float,y1:Float Field x2:Float,y2:Float Field minx:Float, maxx:Float Field miny:Float, maxy:Float Field friction:Float,radius:Float 'unused for now Field static_ang#, static_xoff#, static_yoff# Function Create:TSStaticLine( x1:Float,y1:Float, x2:Float,y2:Float, friction:Float=1.0, radius:Float=1.0) Local l:TSStaticline = New TSStaticline l.x1 = x1 l.y1 = y1 l.x2 = x2 l.y2 = y2 l.friction=friction l.radius=radius If x1<x2 l.minx=x1-radius l.maxx=x2+radius Else l.minx=x2-radius l.maxx=x1+radius EndIf If y1<y2 l.miny=y1-radius l.maxy=y2+radius Else l.miny=y2-radius l.maxy=y1+radius EndIf l.static_ang# = angle(x1,y1,x2,y2) l.static_xoff#=(Cos(l.static_ang+180)) l.static_yoff#=(Sin(l.static_ang+180)) Return l EndFunction Method Render() SetColor 0,100,0 DrawLine x1,y1, x2,y2 EndMethod EndType Type TSStaticGroup Field lines:TList = New TList Field active:Int Field docollisions:Int Function Create:TSStaticGroup(active:Int = True, docollisions:Int = True) Local g:TSStaticGroup = New TSStaticGroup g.active = active g.docollisions = docollisions Return g EndFunction Method AddLine( l:TSStaticLine) If l Then lines.AddLast( l) EndMethod Method Render() For Local l:TSStaticLine = EachIn lines l.Render() Next EndMethod EndType Type TSPoint Field x:Float,y:Float ' current position Field oldx:Float,oldy:Float ' old position Field fx:Float,fy:Float ' impulse force Field mass:Float Field active:Int Field size:Int Function Create:TSPoint( x:Float,y:Float, mass:Float, active:Int = True, size:Int=15) Local p:TSPoint = New TSPoint p.x = x p.y = y p.oldx = x p.oldy = y p.mass = mass p.active = active p.size=size Return p EndFunction Function Create_nonew:TSPoint(poi:TSPoint, x:Float,y:Float, mass:Float, active:Int = True, size:Int=15) 'Local p:TSPoint = New TSPoint poi.x = x poi.y = y poi.oldx = x poi.oldy = y poi.mass = mass poi.active = active poi.size=size 'Return p EndFunction Method Update() If Not active Then Return ' forces Local tmpx1:Float = x Local tmpy1:Float = y Local tmpx2:Float = fx * S_TIMESTEP * S_TIMESTEP Local tmpy2:Float = fy * S_TIMESTEP * S_TIMESTEP oldx :+ tmpx2 oldy :+ tmpy2 x :- oldx y :- oldy x :+ tmpx1 y :+ tmpy1 oldx = tmpx1 oldy = tmpy1 fx = 0 fy = 0 EndMethod Method Check_BG_Collisions(bg:TSStaticGroup) Local b:Float, bx:Float, by:Float,deltalength:Float, diff:Float 'Local steps = Ceil(Sqr( For Local l:TSStaticLine = EachIn bg.lines If x>l.minx - size And x<l.maxx+size And y>l.miny-size And y<l.maxy+size ' in vincinity of line, so run checks Local pos[2] pos = LineToCircle_givepos( l.x1, l.y1, l.x2, l.y2, x, y, size/2 ) If Not(pos[0]=-1 And pos[1]=-1) 'circle in line, position circle at pos 'SetColor 255,0,255 'DrawOval pos[0]-(2),pos[1]-(2), 5,5 'DrawLine x,y,pos[0],pos[1] x=pos[0] y=pos[1] 'oldx=x 'oldy=y Else Local pos2[2] 'Local static_ang# = angle(x1,y1,x2,y2) 'Local static_xoff#=(Cos(static_ang+180)) 'Local static_yoff#=(Sin(static_ang+180)) pos2 = LinesCross_givepos( l.x1, l.y1, l.x2, l.y2, oldx, oldy, x, y, l.static_ang, l.static_xoff, l.static_yoff, size/2 ) If Not(pos2[0]=-1 And pos2[1]=-1) 'line on line, position circle at pos2 'SetColor 255,0,255 'DrawOval pos2[0]-(2),pos2[1]-(2), 5,5 x=pos2[0] y=pos2[1] 'oldx=x 'oldy=y EndIf EndIf EndIf Next EndMethod Method Render() SetColor 0,0,255 If size>1 Then SetColor 0,100,255 If Not active Then SetColor 0,0,80 Local si:Int =5+size DrawOval x-(si/2),y-(si/2), si,si EndMethod Method Translate( x:Float,y:Float, reset:Int = False) Self.x :+ x Self.y :+ y ' reset movement If reset Then oldx = Self.x oldy = Self.y EndIf EndMethod Method Rotate( dir:Float, center:Float[], reset:Int = False) Local xr:Float = x - center[0] Local yr:Float = y - center[1] x = xr * Cos(dir) - yr * Sin(dir) y = xr * Sin(dir) + yr * Cos(dir) x :+ center[0] y :+ center[1] ' reset movement If reset Then oldx = x oldy = y EndIf EndMethod EndType Type TSLink Field p1:TSPoint Field p2:TSPoint Field restLength:Float Field k:Float Field stress:Float Function Create:TSLink( p1:TSPoint, p2:TSPoint, k:Float) Local l:TSLink = New TSLink l.p1 = p1 l.p2 = p2 l.k = k l.CalcRestLength() Return l EndFunction Function Create_nonew:TSLink(l:TSLink, p1:TSPoint, p2:TSPoint, k:Float) 'Local l:TSLink = New TSLink l.p1 = p1 l.p2 = p2 l.k = k l.CalcRestLength() 'Return l EndFunction Function find:TSLink(obj:TSGroup, p1:TSPoint, p2:TSPoint) For Local l:TSLink = EachIn obj.links If (l.p1=p1 And l.p2=p2) Or (l.p1=p2 And l.p2=p1) Return l Exit EndIf Next Return Null EndFunction Method Update() Local dx:Float = p1.x - p2.x Local dy:Float = p1.y - p2.y Local dist:Float = Sqr( dx*dx + dy*dy) Local w:Float = p1.mass + p2.mass If p1.active Then p1.x :- ((dx / dist) * ((dist - restLength) * k)) * (p1.mass / w) p1.y :- ((dy / dist) * ((dist - restLength) * k)) * (p1.mass / w) EndIf If p2.active Then p2.x :+ ((dx / dist) * ((dist - restLength) * k)) * (p2.mass / w) p2.y :+ ((dy / dist) * ((dist - restLength) * k)) * (p2.mass / w) EndIf stress = (dist - restLength) / restLength EndMethod Method Delete() EndMethod Method Render() SetColor 255-(stress*100),k*255,255 DrawLine p1.x,p1.y, p2.x,p2.y EndMethod Method CalcRestLength() restLength = Sqr((p1.x - p2.x) * (p1.x - p2.x) + (p1.y - p2.y) * (p1.y - p2.y)) EndMethod EndType Type TSGroup Field points:TList = New TList Field links:TList = New TList Field gravity:Float Field active:Int Field bbox:Float[4] Field center:Float[2] Function Create:TSGroup( gravity:Float = 0.0, active:Int = True) Local g:TSGroup = New TSGroup g.gravity = gravity g.active = active Return g EndFunction Function Create_nonew:TSGroup(g:TSGroup, gravity:Float = 0.0, active:Int = True) 'Local g:TSGroup = New TSGroup g.gravity = gravity g.active = active 'Return g EndFunction Method AddPoint( p:TSPoint) If p Then points.AddLast( p) EndMethod Method AddLink( l:TSLink) If l Then links.AddLast( l) EndMethod Method Update(bg:TSStaticGroup) If Not active Then Return For Local p:TSPoint = EachIn points p.fy = gravity p.Update() Next For Local l:TSLink = EachIn links l.Update() Next For Local p:TSPoint = EachIn points p.Check_BG_Collisions(bg) Next CalcBoundingBox() CalcCenterPoint() EndMethod Method Render() For Local l:TSLink = EachIn links l.Render() Next For Local p:TSPoint = EachIn points p.Render() Next SetColor 0,192,0 DrawFrame( bbox[0], bbox[1], bbox[2], bbox[3]) SetColor 255,0,0 DrawOval center[0]-2,center[1]-2,4,4 EndMethod Method Translate( x:Float,y:Float, reset:Int = False) For Local p:TSPoint = EachIn points p.Translate( x,y, reset) Next CalcBoundingBox() CalcCenterPoint() EndMethod Method Rotate( dir:Float, reset:Int = False) For Local p:TSPoint = EachIn points p.Rotate( dir, center, reset) Next CalcBoundingBox() CalcCenterPoint() EndMethod Method CalcBoundingBox() bbox[0] = $FFFFFFF bbox[1] = $FFFFFFF bbox[2] = 0 bbox[3] = 0 For Local p:TSPoint = EachIn points bbox[0] = Min( bbox[0], p.x) bbox[1] = Min( bbox[1], p.y) bbox[2] = Max( bbox[2], p.x) bbox[3] = Max( bbox[3], p.y) Next bbox[2] :- bbox[0] bbox[3] :- bbox[1] EndMethod Method CalcCenterPoint() Local xtmp:Float,ytmp:Float, sz:Int = points.Count() For Local p:TSPoint = EachIn points xtmp :+ p.x ytmp :+ p.y Next center[0] = xtmp / sz center[1] = ytmp / sz EndMethod EndType Function DrawFrame( x:Float,y:Float, w:Float,h:Float) DrawLine x,y, x+w,y ' top DrawLine x,y+h, x+w,y+h ' bottom DrawLine x,y, x,y+h ' left DrawLine x+w,y, x+w,y+h ' right EndFunction Function PointInRect:Int( px:Int,py:Int, rect:Int[]) Return (px >= rect[0]) And (py >= rect[1]) And (px < rect[0] + rect[2]) And (py < rect[1] + rect[3]) EndFunction ' ' TEST ' Graphics 1024,768, 0 Const BOX_COEF:Float = 1 Const BOX_MASS:Float = 30 ' statick lines to collide with Local background:TSStaticGroup = TSStaticGroup.Create() Local l1:TSStaticLine = TSStaticLine.Create(0,650,100,700) Local l2:TSStaticLine = TSStaticLine.Create(100,700,600,680) Local l3:TSStaticLine = TSStaticLine.Create(600,680,1024,700) background.AddLine(l1) background.AddLine(l2) background.AddLine(l3) 'goodol' square Local obj:TSGroup = TSGroup.Create( -10, False) Local p1:TSPoint = TSPoint.Create( 0,0, BOX_MASS, True) Local p2:TSPoint = TSPoint.Create( 64,0, BOX_MASS, True) Local p3:TSPoint = TSPoint.Create( 0,64, BOX_MASS, True) Local p4:TSPoint = TSPoint.Create( 64,64, BOX_MASS, True) obj.AddPoint( p1) obj.AddPoint( p2) obj.AddPoint( p3) obj.AddPoint( p4) obj.AddLink( TSLink.Create( p1, p2, BOX_COEF)) ' top obj.AddLink( TSLink.Create( p2, p4, BOX_COEF)) ' right obj.AddLink( TSLink.Create( p4, p3, BOX_COEF)) ' bottom obj.AddLink( TSLink.Create( p3, p1, BOX_COEF)) ' left obj.AddLink( TSLink.Create( p3, p2, BOX_COEF)) ' cross 1 obj.AddLink( TSLink.Create( p1, p4, BOX_COEF)) ' cross 2 ' move it some to the right obj.Translate( 405,32, True) ' rotate it and give it some speed obj.Rotate( 10) obj.Translate( 4,0) 'triangles Global t:Int For t=1 To 2 Local tmp1:TSPoint = TSPoint.Create( Rnd(150)+50,Rnd(150)+50,BOX_MASS, True) Local tmp2:TSPoint = TSPoint.Create( Rnd(150)+50,Rnd(150)+50,BOX_MASS, True) Local tmp3:TSPoint = TSPoint.Create( Rnd(150)+50,Rnd(150)+50,BOX_MASS, True) obj.AddPoint( tmp1) obj.AddPoint( tmp2) obj.AddPoint( tmp3) obj.AddLink( TSLink.Create( tmp1, tmp2, BOX_COEF)) obj.AddLink( TSLink.Create( tmp3, tmp2, BOX_COEF)) obj.AddLink( TSLink.Create( tmp3, tmp1, BOX_COEF)) tmp1.translate(Rnd(10)-3,Rnd(8)-5) Next 'one big particle Local tmp1:TSPoint = TSPoint.Create( Rnd(150)+50,Rnd(150)+50,BOX_MASS, True,70) obj.AddPoint( tmp1) Local obj2:TSGroup = TSGroup.Create( -5, False) 'a rope Local po:TSPoint[30], li:TSLink[30] po[0] = New TSPoint po[0].Create_nonew(po[0],180,180,100,False,10) obj.AddPoint( po[0]) Global te:Int For te=1 To 29 po[te] = New TSPoint po[te].Create_nonew(po[te],180,180+(te*15),100,True,1) obj.AddPoint( po[te]) li[te] = New TSLink li[te].Create_nonew(li[te],po[te],po[te-1],1) obj.AddLink(li[te]) Next 'ignore - second objext 'Local ptemp:TSPoint = TSPoint.Create( 164,164, BOX_MASS, False, 10) 'obj2.AddPoint( ptemp) 'Local p[5]:TSPoint = ptemp 'Local p[6]:TSPoint = TSPoint.Create( 184,184, BOX_MASS, True, 8) 'obj2.AddPoint( p[5]) 'obj2.AddPoint( p[6]) 'obj2.AddLink( TSLink.Create( p1, p[5], 0.05)) ' top 'obj2.AddLink( TSLink.Create( p[6], p[5], 0.05)) ' top ' globals Global mb1:Int,mb2:Int Global mx:Int,my:Int Global mpoint:TSPoint Global last_selected_point:TSPoint = p1 Repeat If KeyHit( KEY_SPACE) Then obj.active = Not obj.active obj2.active = Not obj2.active EndIf ' create points / links If KeyDown( KEY_LCONTROL) And (Not obj.active) Then mx = MouseX() my = MouseY() If MouseHit(1) Then ' create point obj.AddPoint( TSPoint.Create( mx,my, BOX_MASS, True)) ElseIf MouseHit(2) ' create link Local rect:Int[4] If mpoint = Null Then ' select first point For Local p:TSPoint = EachIn obj.points rect[0] = p.x - 4 rect[1] = p.y - 4 rect[2] = 8 rect[3] = 8 If PointInRect( mx,my, rect) Then mpoint = p last_selected_point = p Exit EndIf Next Else ' select second point Local coef:Float=0.9 If KeyDown( KEY_1) Then coef=0.001 If KeyDown( KEY_2) Then coef=0.05 If KeyDown( KEY_3) Then coef=0.25 If KeyDown( KEY_4) Then coef=0.5 If KeyDown( KEY_5) Then coef=0.75 If KeyDown( KEY_6) Then coef=1 'If KeyDown( KEY_0) Then coef=0 For Local p:TSPoint = EachIn obj.points rect[0] = p.x - 4 rect[1] = p.y - 4 rect[2] = 8 rect[3] = 8 If PointInRect( mx,my, rect) Then If coef>0 Then obj.AddLink( TSLink.Create( mpoint, p, COEF)) Exit Else 'remove link Local p1:TSLink = TSLink.find(obj,mpoint,p) 'If p1<>Null Then p1.delete(p1) EndIf EndIf Next mpoint = Null EndIf EndIf FlushMouse() Else ' move single point / modify link If MouseDown(1) Then mx = MouseX() my = MouseY() If Not mb1 Then ' select point Local rectl:Int[4] For Local pa:TSPoint = EachIn obj.points rectl[0] = pa.x - 4 rectl[1] = pa.y - 4 rectl[2] = 8 rectl[3] = 8 If PointInRect( mx,my, rectl) Then mpoint = pa last_selected_point = pa Exit EndIf Next mb1 = True EndIf ' modify point If mpoint Then mpoint.x = mx mpoint.y = my ' modify connected links If Not obj.active Then ' search for links with this point For Local l:TSLink = EachIn obj.links If (l.p1 = mpoint) Or (l.p2 = mpoint) Then l.CalcRestLength() EndIf Next ' cancel allow movement mpoint.oldx = mpoint.x mpoint.oldy = mpoint.y EndIf EndIf Else If mb1 Then ' reset mb1 = False mpoint = Null FlushMouse() EndIf EndIf EndIf If mpoint <> Null Then SetColor 0,200,255 DrawOval mpoint.x-4,mpoint.y-4, 8,8 EndIf ' turn point on/off If KeyHit( KEY_A) Then If mpoint <> Null Then mpoint.active = Not mpoint.active EndIf EndIf ' size If KeyHit( KEY_NUMADD) Then If mpoint <> Null Then mpoint.size =mpoint.size+1 EndIf EndIf If KeyHit( KEY_NUMSUBTRACT) Then If mpoint <> Null Then mpoint.size =mpoint.size-1 EndIf EndIf ' rotate box If KeyDown( KEY_Q) Then obj.Rotate( -0.5, False) ElseIf KeyDown( KEY_W) Then obj.Rotate( 0.5, False) EndIf ' move last selected point Local sp:Int =1 If KeyDown( KEY_UP) Then last_selected_point.translate(0,-sp) If KeyDown( KEY_DOWN) Then last_selected_point.translate(0,sp) If KeyDown( KEY_LEFT) Then last_selected_point.translate(-sp,0) If KeyDown( KEY_RIGHT) Then last_selected_point.translate(sp,0) SetColor 150,100,155 DrawOval last_selected_point.x-4, last_selected_point.y-4, 8,8 obj.Update(background) obj2.Update(background) ' constrain all points to screen edges For Local paa:TSPoint = EachIn obj.points ' bottom If paa.y > GraphicsHeight() Then paa.y = GraphicsHeight() ' full friction paa.oldx = paa.x EndIf ' left, right If paa.x < 0 Then paa.x = 0 ElseIf paa.x > GraphicsWidth() Then paa.x = GraphicsWidth() EndIf Next background.Render() obj.Render() obj2.Render() ' some help SetColor 255,255,255 DrawText "HELP:", 0,0 DrawText " Pause Simulation/Edit mode: SPACE", 0,15 DrawText " Rotate Left/Right: q / w", 0,30 DrawText " Modify Point: MB1 + DRAG", 0,45 DrawText " Create Point: CTRL + MB1", 0,60 DrawText " Create Link: CTRL + MB2 (select 2 points)", 0,75 DrawText " Turn point On/Off: A (on selected point)", 0,90 If mpoint <> Null Then DrawText " size: "+mpoint.size+" (+,- num)", 300,15 DrawText " mass: "+mpoint.mass+" ", 300,30 'DrawText " Modify Point: MB1 + DRAG", 300,45 EndIf Flip 1 Cls Until KeyHit( KEY_ESCAPE) End

Booticus (Posted 2006) [#2]

To post code in code boxes, look at this link http://www.blitzmax.com/faq/faq_entry.php?id=2 Search for the "code goes here" part, you'll see it!