SyntaxBomb - Indie Coders

Title : Movement Pegs
Author : Picklesworth
Posted : 1+ years ago

Description : It's a bit of a simple system, but it hasn't been posted in the code archives before so I may as well save somebody some time.
It may be made in 2d, but it is built for 3d stuff. You can make it for 2d stuff rather easily, by removing all referances to the Z axis in the function MovePegs_Update().
It does not currently adjust the appearance of the lines based on what camera perspective is being used, but that shouldn't be too hard to do.
If you have any questions, feel free to email me.

Code :
;;;;;;;;;;;;;Example code;;;;;;;;;;;;;
;Movement Pegs v 0.4, example program
;2004, Dylan McCall
;(Mr. Picklesworth)

Graphics3D 1024,768,False,2
SetBuffer BackBuffer()

AmbientLight 200,200,200
light = CreateLight()
PositionEntity light,-10,5,-10

cam = CreateCamera()
PositionEntity cam,0,0,-10

cube = CreateCube()

MovePegs=MovePegs_Create(700,500,5,1,8,80)

While Not KeyDown(1)
TranslateEntity cube,MovePegs_GetOutputX(MovePegs),MovePegs_GetOutputY(MovePegs),MovePegs_GetOutputZ(MovePegs)
TurnEntity cube,MovePegs_GetOutputPitch(MovePegs),MovePegs_GetOutputYaw(MovePegs),MovePegs_GetOutputRoll(MovePegs)

RenderWorld
MovePegs_Update()
Flip
Cls
Wend
End

;;;;;;;;;;;;;System code;;;;;;;;;;;;;
;Movement Pegs v 0.4
;2004, Dylan McCall
;(Mr. Picklesworth)

Type MovePegs
Field BaseX,BaseY
Field BaseDrag
Field PegXDrag,PegYDrag,PegZDrag
Field RotXDrag,RotYDrag,RotZDrag
Field LastX,LastY
Field XSpeed#,YSpeed#,ZSpeed#
Field PitchSpeed#,YawSpeed#,RollSpeed#
Field MoveScale#
Field RotScale#
Field Size#
Field BaseSize
Field CircleSize
End Type

Function RectOverLine(x1#,y1#,x2#,y2#,rx#,ry#,rw#,rh#)
For h = -rh/2 To rh
For w = -rw/2 To rw
If PointOverLine(x1#,y1#,x2#,y2#,rx#+w,ry#+h) = True Then Return True
Next
Next
End Function

Function PointOverLine(x1#,y1#,x2#,y2#,px#,py#)
;m1# = (y2-y1)/(x2-x1)
m1# = (y2-y1)/(x2-x1)
m2# = (py-y1)/(px-x1)
If m1=m2 And Distance(x1,y1,px,py) <= Distance(x1,y1,x2,y2)
If px => x1 And py <= y1 Return True
EndIf
End Function

;Quick note regarding moveScale and RotationScale - I was asleep when I programmed the
;movement scale, and so it is the reverse of what scale would normally mean. Rather
;than multiply by movescale or rotscale, it divides. Consider this a good thing,
;because the numbers can get rather high so it would be confusing with decimals.
Function MovePegs_Create(x,y,moveScale#=1,rotationScale#=0.5,BaseSize=8,size#=80)
m.movepegs = New movepegs
mMoveScale = moveScale
mRotScale = rotationScale
maseX = x
maseY = y
mBaseSize=BaseSize

msize=size
mCircleSize#=msize / 8

Return Handle(m)
End Function

Function MovePegs_Position(entity,x,y,Glob=True)
m.movepegs=Object.movepegs(entity)
If Glob
maseX = x
maseY = y
Else
maseX = maseX + x
maseY = maseY + y
EndIf
End Function

Function MovePegs_SetBaseSize(entity,size#)
m.movepegs=Object.movepegs(entity)
mBaseSize=Size
End Function

Function MovePegs_SetSize(entity,size#)
m.movepegs=Object.movepegs(entity)
msize# = size
mCircleSize#=msize / 8
End Function

Function MovePegs_SetMoveScale(entity,scale#)
m.movepegs=Object.movepegs(entity)
mMoveScale# = scale
End Function

Function MovePegs_SetRotationScale(entity,scale#)
m.movepegs=Object.movepegs(entity)
mRotScale# = scale
End Function

Function MovePegs_Update()
For m.movepegs = Each movepegs

CircleXX=mBaseX+(msize/1.6)
CircleXY=mBaseY-((mCircleSize*1.4)/2)
CircleYX=mBaseX-((mCircleSize*1.4)/2)
CircleYY=mBaseY-(msize/8)-(msize/1.6)
CircleZX=mBaseX+(msize/2.8)
CircleZY=mBaseY-(msize/2)

If mpegXdrag Then Color 255,255,0 Else Color 255,0,0 ;X line
Line mBaseX,mBaseY,mBaseX+msize,mBaseY

If motXDrag Then Color 255,255,0 Else Color 255,0,0 ;X circle
Oval CircleXX,CircleXY,mCircleSize,mCircleSize*1.4

If mpegYdrag Then Color 255,255,0 Else Color 0,255,0 ;Y line
Line mBaseX,mBaseY,mBaseX,mBaseY-msize

If motYDrag Then Color 255,255,0 Else Color 0,255,0 ;Y circle
Oval CircleYX,CircleYY,mCircleSize*1.4,mCircleSize

If mpegZdrag Then Color 255,255,0 Else Color 0,0,255 ;Z line
Line mBaseX,mBaseY,mBaseX+(msize/1.6),mBaseY-(msize/1.6)

If motZDrag Then Color 255,255,0 Else Color 0,0,255 ;Z circle
Oval CircleZX,CircleZY,mCircleSize*1.4,mCircleSize

Color 100,100,100 ;Base
Rect mBaseX-(mBaseSize/2),mBaseY-(mBaseSize/2),mBaseSize,mBaseSize

;Color 255,255,255
;Line maseX+4,maseY-4,mBaseX+50,mBaseY-50

;mpegXdrag=0 And mpegYdrag=0 And mpegZdrag=0

If MouseHit(1)
If RectsOverlap(MouseX(),MouseY(),1,1,mBaseX-(mBaseSize/2),mBaseY-(mBaseSize/2),mBaseSize,mBaseSize)
mBaseDrag = True
Goto skipclick ;Clicking on base
EndIf

If RectsOverlap(MouseX(),MouseY(),1,1,CircleXX,CircleXY,mCircleSize,mCircleSize*1.4)
mRotXDrag = True
Goto skipclick ;Clicking on X axis Rotate (Pitch)
EndIf
If RectsOverlap(MouseX(),MouseY(),1,1,CircleYX,CircleYY,mCircleSize*1.4,mCircleSize)
mRotYDrag = True
Goto skipclick ;Clicking on Y axis Rotate (Yaw)
EndIf
If RectsOverlap(MouseX(),MouseY(),1,1,CircleZX,CircleZY,mCircleSize*1.4,mCircleSize)
mRotZDrag = True
Goto skipclick ;Clicking on Z axis Rotate (Roll)
EndIf

If RectOverLine(maseX,maseY,mBaseX+(msize/1.6),mBaseY-(msize/1.6),MouseX(),MouseY(),8,8)
mPegZDrag = True
mLastx=MouseX() : mLastY=MouseY()
Goto skipclick ;Z Axis Click
EndIf
If RectOverLine(mBaseX,mBaseY,mBaseX+msize,mBaseY,MouseX(),MouseY(),8,8)
mPegXDrag = True
mLastx=MouseX() : mLastY=MouseY()
Goto skipclick ;X Axis Click
EndIf
If RectOverLine(mBaseX,mBaseY,mBaseX,mBaseY-msize,MouseX(),MouseY(),8,8)
mPegYDrag = True
mLastx=MouseX() : mLastY=MouseY()
Goto skipclick ;Y Axis Click
EndIf

ElseIf Not MouseDown(1)
mBaseDrag = False
mPegXDrag = False : mPegYDrag = False : mPegZDrag = False
mRotXDrag = False : mRotYDrag = False : mRotZDrag = False
mXSpeed# = 0 : mYSpeed# = 0 : mSpeed# = 0
mPitchSpeed# = 0 : mYawSpeed# = 0 : mRollSpeed# = 0
mLastX = mousex() : mLastY = mousey()
EndIf
.skipclick
If mBaseDrag
maseX = MouseX()
maseY = MouseY()
EndIf

If mpegXDrag
;mXSpeed = Distance(mLastX,mLastY,MouseX(),MouseY())
;If MouseX() < mLastX Or MouseY() < mLastY Then mXSpeed= -mXSpeed
mXSpeed = MouseX() - mLastX
mLastX = MouseX()
mLastY = MouseY()
EndIf
If mpegYDrag
;mYSpeed = Distance(mLastX,mLastY,MouseX(),MouseY())
;If MouseX() < mLastX Or MouseY() < mLastY Then mYSpeed= -mYSpeed
mYSpeed = mLastY - MouseY()
mLastX = MouseX()
mLastY = MouseY()
EndIf
If mpegZDrag
;ZSpeedA = MouseY() - mLastY
;ZSpeedB = MouseX() - mLastX
mSpeed = mLastY - MouseY()
mLastX = MouseX()
mLastY = MouseY()
EndIf

If mRotXDrag
mPitchSpeed = Distance2(mLastX,mLastY,MouseX(),MouseY())

;Checks if we should go backwards, or forwards, in the rotation.
mLastX = MouseX()
mLastY = MouseY()
EndIf
If mRotYDrag
mYawSpeed = Distance2(mLastX,mLastY,MouseX(),MouseY())
mLastX = MouseX()
mLastY = MouseY()
EndIf
If mRotZDrag
mRollSpeed = Distance2(mLastX,mLastY,MouseX(),MouseY())
mLastX = MouseX()
mLastY = MouseY()
EndIf

Next
End Function

function MovePegs_IsActive(entity) ;This is grammatically correct. Honest!
;Note: Does not return anything is it is just being moved by the base
m.movepegs = Object.movepegs(entity)
if mPegXDrag or mPegYDrag or mPegZDrag or mRotXDrag or mRotYDrag or mRotZDrag then return 1
end function

Function MovePegs_GetOutputX#(entity)
m.movepegs = Object.movepegs(entity)
Return mXSpeed# / mMoveScale
End Function
Function MovePegs_GetOutputY#(entity)
m.movepegs = Object.movepegs(entity)
Return mYSpeed# / mMoveScale
End Function
Function MovePegs_GetOutputZ#(entity)
m.movepegs = Object.movepegs(entity)
Return mSpeed# / mMoveScale
End Function


Function MovePegs_GetOutputPitch#(entity)
m.movepegs = Object.movepegs(entity)
Return mPitchSpeed# / mRotScale
End Function
Function MovePegs_GetOutputYaw#(entity)
m.movepegs = Object.movepegs(entity)
Return mYawSpeed# / mRotScale
End Function
Function MovePegs_GetOutputRoll#(entity)
m.movepegs = Object.movepegs(entity)
Return mRollSpeed# / mRotScale
End Function

Function EntityProject(camera,entity)
CameraProject camera,EntityX(entity,1),EntityY(entity,1),EntityZ(entity,1)
End Function

Function GetGreatest(a#,b#)
If a#>b# Then Return a# Else Return b#
End Function

Function Distance#(x1#,y1#,x2#,y2#)
;Uses Pythagorus theorum
Return Sqr(((x2-x1)^2)+((y2-y1)^2))
End Function

Function Distance2#(x1#,y1#,x2#,y2#)
;Returns negative or positive numbers
X# = x1-x2
Y# = y1-y2
Return X+Y
End Function

Comments :


Techlord(Posted 1+ years ago)

 Corrected the Distance function with Distance2; ID: 1238
; Author: Mr. Picklesworth
; Date: 2004-12-15 18:26:37
; Title: Movement Pegs
; Description: These are commonly used in 3d modelling tools to move objects about

;;;;;;;;;;;;;Example code;;;;;;;;;;;;;
;Movement Pegs v 0.4, example program
;2004, Dylan McCall
;(Mr. Picklesworth)

Graphics3D 1024,768,False,2
SetBuffer BackBuffer()

AmbientLight 200,200,200
light = CreateLight()
PositionEntity light,-10,5,-10

cam = CreateCamera()
PositionEntity cam,0,0,-10

cube = CreateCube()

MovePegs=MovePegs_Create(700,500,5,1,8,80)

While Not KeyDown(1)
TranslateEntity cube,MovePegs_GetOutputX(MovePegs),MovePegs_GetOutputY(MovePegs),MovePegs_GetOutputZ(MovePegs)
TurnEntity cube,MovePegs_GetOutputPitch(MovePegs),MovePegs_GetOutputYaw(MovePegs),MovePegs_GetOutputRoll(MovePegs)

RenderWorld
MovePegs_Update()
Flip
Cls
Wend
End

;;;;;;;;;;;;;System code;;;;;;;;;;;;;
;Movement Pegs v 0.4
;2004, Dylan McCall
;(Mr. Picklesworth)

Type MovePegs
Field BaseX,BaseY
Field BaseDrag
Field PegXDrag,PegYDrag,PegZDrag
Field RotXDrag,RotYDrag,RotZDrag
Field LastX,LastY
Field XSpeed#,YSpeed#,ZSpeed#
Field PitchSpeed#,YawSpeed#,RollSpeed#
Field MoveScale#
Field RotScale#
Field Size#
Field BaseSize
Field CircleSize
End Type

Function RectOverLine(x1#,y1#,x2#,y2#,rx#,ry#,rw#,rh#)
For h = -rh/2 To rh
For w = -rw/2 To rw
If PointOverLine(x1#,y1#,x2#,y2#,rx#+w,ry#+h) = True Then Return True
Next
Next
End Function

Function PointOverLine(x1#,y1#,x2#,y2#,px#,py#)
m1# = (y2-y1)/(x2-x1)
m2# = (py-y1)/(px-x1)
If m1=m2 And Distance2(x1,y1,px,py) <= Distance2(x1,y1,x2,y2) Then Return True Else Return False
End Function

;Quick note regarding moveScale and RotationScale - I was asleep when I programmed the
;movement scale, and so it is the reverse of what scale would normally mean. Rather
;than multiply by movescale or rotscale, it divides. Consider this a good thing,
;because the numbers can get rather high so it would be confusing with decimals.
Function MovePegs_Create(x,y,moveScale#=1,rotationScale#=0.5,BaseSize=8,size#=80)
m.movepegs = New movepegs
mMoveScale = moveScale
mRotScale = rotationScale
maseX = x
maseY = y
mBaseSize=BaseSize

msize=size
mCircleSize#=msize / 8

Return Handle(m)
End Function

Function MovePegs_Position(entity,x,y,Glob=True)
m.movepegs=Object.movepegs(entity)
If Glob
maseX = x
maseY = y
Else
maseX = maseX + x
maseY = maseY + y
EndIf
End Function

Function MovePegs_SetBaseSize(entity,size#)
m.movepegs=Object.movepegs(entity)
mBaseSize=Size
End Function

Function MovePegs_SetSize(entity,size#)
m.movepegs=Object.movepegs(entity)
msize# = size
mCircleSize#=msize / 8
End Function

Function MovePegs_SetMoveScale(entity,scale#)
m.movepegs=Object.movepegs(entity)
mMoveScale# = scale
End Function

Function MovePegs_SetRotationScale(entity,scale#)
m.movepegs=Object.movepegs(entity)
mRotScale# = scale
End Function

Function MovePegs_Update()
For m.movepegs = Each movepegs

CircleXX=mBaseX+(msize/1.6)
CircleXY=mBaseY-((mCircleSize*1.4)/2)
CircleYX=mBaseX-((mCircleSize*1.4)/2)
CircleYY=mBaseY-(msize/8)-(msize/1.6)
CircleZX=mBaseX+(msize/2.8)
CircleZY=mBaseY-(msize/2)

If mpegXdrag Then Color 255,255,0 Else Color 255,0,0 ;X line
Line mBaseX,mBaseY,mBaseX+msize,mBaseY

If motXDrag Then Color 255,255,0 Else Color 255,0,0 ;X circle
Oval CircleXX,CircleXY,mCircleSize,mCircleSize*1.4

If mpegYdrag Then Color 255,255,0 Else Color 0,255,0 ;Y line
Line mBaseX,mBaseY,mBaseX,mBaseY-msize

If motYDrag Then Color 255,255,0 Else Color 0,255,0 ;Y circle
Oval CircleYX,CircleYY,mCircleSize*1.4,mCircleSize

If mpegZdrag Then Color 255,255,0 Else Color 0,0,255 ;Z line
Line mBaseX,mBaseY,mBaseX+(msize/1.6),mBaseY-(msize/1.6)

If motZDrag Then Color 255,255,0 Else Color 0,0,255 ;Z circle
Oval CircleZX,CircleZY,mCircleSize*1.4,mCircleSize

Color 100,100,100 ;Base
Rect mBaseX-(mBaseSize/2),mBaseY-(mBaseSize/2),mBaseSize,mBaseSize

;Color 255,255,255
;Line maseX+4,maseY-4,mBaseX+50,mBaseY-50

;mpegXdrag=0 And mpegYdrag=0 And mpegZdrag=0

If MouseHit(1)
If RectsOverlap(MouseX(),MouseY(),1,1,mBaseX-(mBaseSize/2),mBaseY-(mBaseSize/2),mBaseSize,mBaseSize)
mBaseDrag = True
Goto skipclick ;Clicking on base
EndIf

If RectsOverlap(MouseX(),MouseY(),1,1,CircleXX,CircleXY,mCircleSize,mCircleSize*1.4)
mRotXDrag = True
Goto skipclick ;Clicking on X axis Rotate (Pitch)
EndIf
If RectsOverlap(MouseX(),MouseY(),1,1,CircleYX,CircleYY,mCircleSize*1.4,mCircleSize)
mRotYDrag = True
Goto skipclick ;Clicking on Y axis Rotate (Yaw)
EndIf
If RectsOverlap(MouseX(),MouseY(),1,1,CircleZX,CircleZY,mCircleSize*1.4,mCircleSize)
mRotZDrag = True
Goto skipclick ;Clicking on Z axis Rotate (Roll)
EndIf

If RectOverLine(maseX,maseY,mBaseX+(msize/1.6),mBaseY-(msize/1.6),MouseX(),MouseY(),8,8)
mPegZDrag = True
mLastx=MouseX() : mLastY=MouseY()
Goto skipclick ;Z Axis Click
EndIf
If RectOverLine(mBaseX,mBaseY,mBaseX+msize,mBaseY,MouseX(),MouseY(),8,8)
mPegXDrag = True
mLastx=MouseX() : mLastY=MouseY()
Goto skipclick ;X Axis Click
EndIf
If RectOverLine(mBaseX,mBaseY,mBaseX,mBaseY-msize,MouseX(),MouseY(),8,8)
mPegYDrag = True
mLastx=MouseX() : mLastY=MouseY()
Goto skipclick ;Y Axis Click
EndIf

ElseIf Not MouseDown(1)
mBaseDrag = False
mPegXDrag = False : mPegYDrag = False : mPegZDrag = False
mRotXDrag = False : mRotYDrag = False : mRotZDrag = False
mXSpeed# = 0 : mYSpeed# = 0 : mSpeed# = 0
mPitchSpeed# = 0 : mYawSpeed# = 0 : mRollSpeed# = 0
mLastX = mousex() : mLastY = mousey()
EndIf
.skipclick
If mBaseDrag
maseX = MouseX()
maseY = MouseY()
EndIf

If mpegXDrag
;mXSpeed = Distance2(mLastX,mLastY,MouseX(),MouseY())
;If MouseX() < mLastX Or MouseY() < mLastY Then mXSpeed= -mXSpeed
mXSpeed = MouseX() - mLastX
mLastX = MouseX()
mLastY = MouseY()
EndIf
If mpegYDrag
;mYSpeed = Distance2(mLastX,mLastY,MouseX(),MouseY())
;If MouseX() < mLastX Or MouseY() < mLastY Then mYSpeed= -mYSpeed
mYSpeed = mLastY - MouseY()
mLastX = MouseX()
mLastY = MouseY()
EndIf
If mpegZDrag
;ZSpeedA = MouseY() - mLastY
;ZSpeedB = MouseX() - mLastX
mSpeed = mLastY - MouseY()
mLastX = MouseX()
mLastY = MouseY()
EndIf

If mRotXDrag
mPitchSpeed = Distance2(mLastX,mLastY,MouseX(),MouseY())

;Checks if we should go backwards, or forwards, in the rotation.
mLastX = MouseX()
mLastY = MouseY()
EndIf
If mRotYDrag
mYawSpeed = Distance2(mLastX,mLastY,MouseX(),MouseY())
mLastX = MouseX()
mLastY = MouseY()
EndIf
If mRotZDrag
mRollSpeed = Distance2(mLastX,mLastY,MouseX(),MouseY())
mLastX = MouseX()
mLastY = MouseY()
EndIf

Next
End Function

function MovePegs_IsActive(entity) ;This is grammatically correct. Honest!
;Note: Does not return anything is it is just being moved by the base
m.movepegs = Object.movepegs(entity)
if mPegXDrag or mPegYDrag or mPegZDrag or mRotXDrag or mRotYDrag or mRotZDrag then return 1
end function

Function MovePegs_GetOutputX#(entity)
m.movepegs = Object.movepegs(entity)
Return mXSpeed# / mMoveScale
End Function
Function MovePegs_GetOutputY#(entity)
m.movepegs = Object.movepegs(entity)
Return mYSpeed# / mMoveScale
End Function
Function MovePegs_GetOutputZ#(entity)
m.movepegs = Object.movepegs(entity)
Return mSpeed# / mMoveScale
End Function


Function MovePegs_GetOutputPitch#(entity)
m.movepegs = Object.movepegs(entity)
Return mPitchSpeed# / mRotScale
End Function
Function MovePegs_GetOutputYaw#(entity)
m.movepegs = Object.movepegs(entity)
Return mYawSpeed# / mRotScale
End Function
Function MovePegs_GetOutputRoll#(entity)
m.movepegs = Object.movepegs(entity)
Return mRollSpeed# / mRotScale
End Function

Function EntityProject(camera,entity)
CameraProject camera,EntityX(entity,1),EntityY(entity,1),EntityZ(entity,1)
End Function

Function GetGreatest(a#,b#)
If a#>b# Then Return a# Else Return b#
End Function

Function Distance2#(x1#,y1#,x2#,y2#)
;Returns negative or positive numbers
X# = x1-x2
Y# = y1-y2
Return X+Y
End Function


Picklesworth(Posted 1+ years ago)

 Ah, right.Actually, Distance2 was only for the rotation stuff, which is why the x axis move is probably not working for you now :DI thought I included a non-userlib version of Distance (I got Distance in some magic dll which I can't locate), but I must have removed it by accident.It's been fixed now, and should be happy.Repaired version is at the top.


Picklesworth(Posted 1+ years ago)

 Fixed a small bug with the PointOverLine function. I probably cut a corner, but it works for me


WildCat(Posted 1+ years ago)

 Oh, you're doing useful instrument, man! Then you can program the Shift key (as it's done in Wings modeller) to turn object with 15 deg. steps. [/i]