Movement Arrows/Pegs/Things

Picklesworth

I did it :)
Basically, it uses arrows drawn in 2d to drag 3d objects about (handy for 3d editors of all sorts). I still have to implement rotation, but here it is so far. It also has a rectangle over line function in case you don't have one already, (and some exerts from the "Picklesworth Stupid 1 Line Functions" collection).

Graphics3D 800,600,False,2
SetBuffer BackBuffer()

Type MovePegs
	Field BaseX,BaseY	
	Field BaseDrag
	Field PegXDrag,PegYDrag,PegZDrag
	Field LastX#,LastY#	
	Field XSpeed#,YSpeed#,ZSpeed#
	Field MoveScale
	Field Size#
End Type

AmbientLight 255,255,255

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

cube = CreateCube()

;movement pegs
;Base = CreatePivot()
;X = CreatePivot(Base)
;PositionEntity X,2,0,0
;Y = CreatePivot(Base)
;PositionEntity Y,0,2,0
;Z = CreatePivot(Base)
;PositionEntity Z,1.5,1.5,2

MovePegs=MovePegs_Create(700,500,5)

While Not KeyDown(1)		
	MoveEntity cube,GetPegOutputX(MovePegs),GetPegOutputY(MovePegs),GetPegOutputZ(MovePegs)	
	RenderWorld
	updateMovePegs()
	Flip
	Cls
Wend
End

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 Distance(x1,y1,px,py) <= Distance(x1,y1,x2,y2) Then Return True Else Return False
End Function

Function MovePegs_Create(x,y,moveScale=1,size#=80)
	m.movepegs = New movepegs
	m\MoveScale = moveScale
	m\baseX = x
	m\baseY = y
	m\size=size
	Return Handle(m)
End Function

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

Function MovePegs_SetSize(entity,size#)
	m.movepegs=Object.movepegs(entity)
	m\size# = size
End Function

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

Function UpdateMovePegs()
	For m.movepegs = Each movepegs
		
		If m\pegXdrag Then Color 255,255,0 Else Color 255,0,0 ;X line
		Line m\BaseX,m\BaseY,m\BaseX+m\size,m\BaseY
		If m\pegYdrag Then Color 255,255,0 Else Color 0,255,0 ;Y line
		Line m\BaseX,m\BaseY,m\BaseX,m\BaseY-m\size
		If m\pegZdrag Then Color 255,255,0 Else Color 0,0,255 ;Z line
		Line m\BaseX,m\BaseY,m\BaseX+(m\size/1.6),m\BaseY-(m\size/1.6)
		
		Color 100,100,100
		Rect m\BaseX-3,m\BaseY-3,6,6
		
		;Color 255,255,255		
		;Line m\baseX+4,m\baseY-4,m\BaseX+50,m\BaseY-50
		
		;m\pegXdrag=0 And m\pegYdrag=0 And m\pegZdrag=0
				
		If MouseHit(1)
			If RectsOverlap(MouseX(),MouseY(),1,1,m\BaseX-4,m\BaseY-4,8,8) Then m\BaseDrag = True : Goto skipclick
			
			If RectOverLine(m\baseX,m\baseY,m\BaseX+(m\size/1.6),m\BaseY-(m\size/1.6),MouseX(),MouseY(),8,8) Then m\PegZDrag = True : m\Lastx=MouseX() : m\LastY=MouseY() : Goto skipclick ;Z Axis
			If RectOverLine(m\BaseX,m\BaseY,m\BaseX+m\size,m\BaseY,MouseX(),MouseY(),8,8) Then m\PegXDrag = True : m\Lastx=MouseX() : m\LastY=MouseY() : Goto skipclick ;X Axis
			If RectOverLine(m\BaseX,m\BaseY,m\BaseX,m\BaseY-m\size,MouseX(),MouseY(),8,8) Then m\PegYDrag = True : m\Lastx=MouseX() : m\LastY=MouseY() : Goto skipclick ;Y Axis

			ElseIf Not MouseDown(1)
				m\BaseDrag = False : m\PegXDrag = False : m\PegYDrag = False : m\PegZDrag = False
				m\XSpeed# = 0 : m\YSpeed# = 0 : m\ZSpeed# = 0
		EndIf
		.skipclick
		If m\BaseDrag
			m\baseX = MouseX()
			m\baseY = MouseY()			
		EndIf
		
		If m\pegXDrag
			;m\XSpeed# = GetGreatest(MouseXSpeed() ,MouseYSpeed())
			m\XSpeed# = (MouseX() - m\LastX#) / m\MoveScale
			m\LastX# = MouseX()
			m\LastY# = MouseY()
			DebugLog "Dragging X " + m\XSpeed#					
		EndIf
		If m\pegYDrag
			;m\YSpeed# = GetGreatest(MouseXSpeed(),MouseYSpeed())
			m\YSpeed# = (m\LastY# - MouseY()) / m\MoveScale
			m\LastX# = MouseX()
			m\LastY# = MouseY()
			DebugLog "Dragging Y " + m\YSpeed#				
		EndIf
		If m\pegZDrag
			;m\ZSpeed# = GetGreatest(MouseXSpeed(),MouseYSpeed())
			m\ZSpeed# = (m\LastY# - MouseY()) / m\MoveScale
			m\LastX# = MouseX()
			m\LastY# = MouseY()
			DebugLog "Dragging Z " + m\ZSpeed#				
		EndIf
	Next
End Function

Function GetPegOutputX#(entity)
	m.movepegs = Object.movepegs(entity)
	Return m\XSpeed#
End Function
Function GetPegOutputY#(entity)
	m.movepegs = Object.movepegs(entity)
	Return m\YSpeed#
End Function
Function GetPegOutputZ#(entity)
	m.movepegs = Object.movepegs(entity)
	Return m\ZSpeed#
End Function

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

Function GetGreatest(a#,b#)
        ;An advanced sorting algorithm to grab the highest number of two possibilities.
	If a#>b# Then Return a# Else Return b#
End Function

It's all quite simple, but nothing like this has had its source code posted yet so I may as well save someone a bit of time.
Is there anything I'm missing here that I should add? I plan to put this in the code archives for fun, but may as well have everything I need first time round, and may as well be forced to add it before I tell myself I'm done (it works better that way, regardless of how small the project is).

John Blackledge

I'm really interested in this, but your gives an error 'Function "distance" not found'.

Picklesworth

Oh, that's a dll... (GLBlitz if you want to know. I don't know where I got it but it basically fills a few holes in the b3d command set)
Just use this function:

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

Picklesworth

Full finished (to the extent I needed it plus a bit more) thing in the code archives now :D
Yay, my first code archive entry!!
http://www.blitzbasic.com/codearcs/codearcs.php?code=1238