;
Const gravity# = 0.99
Global NumberOfPoints ,NumberOfSticks ,mouseClick ,create ,joint ,numberJoint ,show ,render
Global offsetX# ,offsetY#, tension# = 0.5
Type Stick
Field one.Point , two.Point
Field lenght#
End Type
Type point Field x# , y# , selecte= False , lock = False End Type
Global CurentPoint.Point ,OldPoint.Point
Global grx,gry
Global mx#,my#,mz#
Graphics 800,600,32,2
SetBuffer BackBuffer()
grx = GraphicsWidth()/2 : gry = GraphicsHeight()/2
ClsColor 128,128,130
While Not KeyHit(1)
Cls
mx = MouseX() : my = MouseY() : tension= (MouseZ() +50)*0.01
If KeyHit (20) create = -1 ;T перемещение с изменением длинны
If KeyHit (46) create = 0 ;C откидывание до основного взаимодействия
If KeyHit (25) create = 1 ;P создать точку
If KeyHit (31) create = 2 ;S создать линию
If KeyHit (36) create = 3 ;J объединить точки
If KeyHit (38) create = 4 ;L блокировать\разблокировать точку
If KeyHit (18) ClearPoints( ) :ClearSticks( ) ;E стереть всё
If KeyHit (2) show = Not show ; 1
If KeyHit (19) render = Not render ;R начать\приостановить симуляцию
MouseActions()
If render VerletMath( )
DrawPoint(2)
DrawStick( )
Text 20,20,"Number of Points "+NumberOfPoints+" , Number of Sticks "+NumberOfSticks
Text 20,40,"create "+create+" , render "+render +" , numberJoint "+numberJoint+" , tension "+tension
Flip
Wend
ClearPoints( )
ClearSticks( )
End
Function MouseSelectPoint( )
For this.Point = Each Point
If NumberOfPoints >0
If Distance (MouseX(),MouseY(),this\x,this\y )<5 And this\selecte = False
this\selecte = True
numberJoint =numberJoint + 1
If numberJoint =1 OldPoint = this
If numberJoint =2
JointPoints(OldPoint ,this) : numberJoint = 0 : this\selecte = False : OldPoint\selecte = False
EndIf
EndIf
EndIf
Next
End Function
Function MouseActions()
If MouseDown(1) And mouseClick = False
mouseClick = True
Select create
Case -1
For this.Point = Each Point
If NumberOfPoints >0
If Distance (MouseX(),MouseY(),this\x,this\y )<5
OldPoint = this : OldPoint\selecte = True
EndIf
EndIf
Next
Case 0
For this.Point = Each Point
If NumberOfPoints >0
If Distance (MouseX(),MouseY(),this\x,this\y )<5
OldPoint = this : OldPoint\selecte = True
EndIf
EndIf
Next
Case 2
OldPoint= NewPoint(MouseX(),MouseY())
Case 3
MouseSelectPoint( )
Case 4
For this.Point = Each Point
If NumberOfPoints >0
If Distance (MouseX(),MouseY(),this\x,this\y )<5
OldPoint = this : OldPoint\lock = Not OldPoint\lock
EndIf
EndIf
Next
End Select
EndIf
If MouseDown(1) And mouseClick = True
Select create
Case -1
If OldPoint\selecte = True OldPoint\x = MouseX() : OldPoint\y = MouseY()
For this2.Stick = Each Stick
If NumberOfSticks >0
If this2\one = OldPoint Or this2\two = OldPoint
this2\lenght = Distance (this2\one\x,this2\one\y ,this2\two\x,this2\two\y)
EndIf
EndIf
Next
Case 0
If OldPoint\selecte = True OldPoint\x = MouseX() : OldPoint\y = MouseY()
Case 2
Line OldPoint\x ,OldPoint\y,MouseX(),MouseY()
Oval OldPoint\x-2,OldPoint\y-2,4,4,1
Oval MouseX()-2,MouseY()-2,4,4,1
End Select
EndIf
If MouseDown(1) = False And mouseClick = True
mouseClick = False
Select create
Case -1
OldPoint\selecte = False : create = 0
Case 0
OldPoint\selecte = False
Case 1
NewPoint(MouseX(),MouseY())
create = 0
Case 2
CurentPoint= NewPoint(MouseX(),MouseY())
JointPoints(OldPoint,CurentPoint)
create = 0
Case 3
If numberJoint =0 create = 0
Case 4
create = 0
End Select
EndIf
End Function
; ==[ Point Functions ]==
; ===============
Function NewPoint.point(pointX,pointY )
this.point = New point
this\x =pointX
this\y =pointY
NumberOfPoints = NumberOfPoints +1
Return this
End Function
Function DeletePoint(this.Point )
If this <> Null Delete this
NumberOfPoints = NumberOfPoints -1
End Function
Function ClearPoints( )
Delete Each point
NumberOfPoints = 0
End Function
Function DrawPoint(radius# = 1 , solid = True )
For this.Point = Each Point
If NumberOfPoints >0
If this\lock = True Color 255,0,0 Else Color 255,255,255
If this\Selecte = 0
Oval this\x - radius , this\y -radius , radius*2,radius*2 , solid
Else
Oval this\x - radius , this\y -radius , radius*2,radius*2 , solid
radius2 =radius +2
Oval this\x - radius2 , this\y -radius2 , radius2*2,radius2*2 , 0
EndIf
EndIf
Next
End Function
; ==[ Stick Functions ]==
; ===============
Function JointPoints.Stick(onePoint.Point,twoPoint.Point )
this.stick = New stick
this\one = onePoint
this\two = twoPoint
this\lenght = Distance (onePoint\x,onePoint\y ,twoPoint\x,twoPoint\y)
NumberOfSticks = NumberOfSticks +1
Return this
End Function
Function DeleteStick(this.Stick )
If this <> Null Delete this
NumberOfSticks = NumberOfSticks -1
End Function
Function ClearSticks( )
Delete Each stick
NumberOfSticks = 0
End Function
Function DrawStick( )
For this.Stick = Each Stick
If NumberOfSticks >0
Line this\one\x , this\one\y , this\two\x , this\two\y
If show Text (this\two\x+ this\one\x)/2-2,(this\two\y+ this\one\y)/2-2,this\lenght
EndIf
Next
End Function
; ==[ Verlet Functions ]==
; ===============
Function VerletMath( )
For this.Stick = Each Stick
If NumberOfSticks >0
dx# = this\two\x -this\one\x
dy# = this\two\y -this\one\y
MathPoint(dx#,dy#,this\lenght )
If this\one\lock = False
this\one\x = this\one\x - offsetX *tension;
this\one\y = this\one\y - offsetY*tension +gravity
EndIf
If this\two\lock = False
this\two\x = this\two\x + offsetX*tension
this\two\y = this\two\y + offsetY*tension+gravity
EndIf
If this\one\y > GraphicsHeight()-10 this\one\y = GraphicsHeight()-10
If this\two\y > GraphicsHeight()-10 this\two\y = GraphicsHeight()-10
EndIf
Next
End Function
Function MathPoint#(dx#,dy#,length# )
dis# =Distance2(dx#, dy#)
diff# =Different( length#, dis )
offsetX# = Offset(diff , dx, dis)
offsetY# = Offset(diff , dy, dis)
End Function
Function Different#( length#, distance# )
Return length - distance
End Function
Function Offset#(differente#,diffs # ,distance# )
Return (differente* diffs / distance) /2
End Function
; ==[ Other Functions ]==
; ===============
Function Distance#( X1#, Y1#, X2#, Y2# )
Return ((X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2))^0.5
End Function
Function Distance2#(dx#, dy#)
Return (dx * dx + dy * dy)^0.5
End Function