[bb] Movement Pegs by Picklesworth [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:38

Previous topic - Next topic

BlitzBot

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 :
Code: blitzbasic
;;;;;;;;;;;;;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
Code: BASIC
; 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]