Movement Arrows/Pegs/Things

Blitz3D Forums/Blitz3D Programming/Movement Arrows/Pegs/Things

Picklesworth

(Posted 2004) [#1]

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

(Posted 2004) [#2]

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

Picklesworth

(Posted 2004) [#3]

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

(Posted 2004) [#4]

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