tiny 2d line "class" and 2d Point inside a quad example

[Kapslok]

Hi,

I've been a fan of Froggerprogger's 3d Vector Procedures for quite some time now. In some point I needed also plain 2d lines and so here is my implementation.
One could easily create Turtle-style graphics with these.

This 2d line "class" includes also an example is for testing whether a mouse pointer is inside the quadrangle area or not. It has worked well so far, but I'm more concerned about the speed.

Code: Select all

EnableExplicit

; Tiny 2d Line "class" for PureBasic users (25.11.2010)
;
; And a mousepick - example
;
; by Kapslok


#Deg2Rad = 0.01745329 
#Rad2Deg = 57.2957795


Structure Line2D

	x.f
	y.f
	x2.f
	y2.f

EndStructure



Procedure.l DefineLine(*line.Line2D, x.f, y.f, x2.f, y2.f) 
	
	*line\x = x
	*line\y = y
	*line\x2 = x2
	*line\y2 = y2
	ProcedureReturn *line
	
EndProcedure 



Procedure.f GetLineLength(*line.Line2D)
	
	ProcedureReturn Sqr(Pow(*line\x-*line\x2,2)+Pow(*line\y-*line\y2,2))
	
EndProcedure


Procedure.f GetLineAngle(*line.Line2D)

	Static x1.f, y1.f, temp.f 

	x1 = *line\x2 - *line\x 
	y1 = *line\y2 - *line\y
	If y1=0
		If x1<0 : ProcedureReturn 180 : Else : ProcedureReturn 0 : EndIf
	EndIf
	If x1=0
		If y1<0 : ProcedureReturn 90 : Else : ProcedureReturn 270 : EndIf
	EndIf
	temp = ATan(y1 / x1) * #Rad2Deg 
	If y1 <= 0 
		If temp <= 0 
			temp * -1 
		Else 
			temp = 180 - temp 
		EndIf 
	Else 
		If temp < 0 
			temp = 180 - temp 
		Else 
			temp = 360 - temp 
		EndIf 
	EndIf 
	ProcedureReturn temp 

EndProcedure



Procedure.l RotateLine(*line.Line2D,angle.f)
	
	Static dx.f,dy.f
	
	dx.f=*line\x2 - *line\x
	dy.f=*line\y2 - *line\y
	
	angle * #Deg2Rad
	
	*line\x2 = Cos(angle) * dx - Sin(angle)*dy + *line\x
	*line\y2 = Sin(angle) * dx + Cos(angle)*dy + *line\y
	
	ProcedureReturn *line
	
EndProcedure



;
; Here is the actual code, which utilizes the previous
; "class"

Procedure TestMousePick(Xmouse,Ymouse,x1,y1,x2,y2,x3,y3,x4,y4)
	
	Static rot.f, llen.f
	Static MyLin.Line2D
	Static PickLin.Line2D
	
	; Is the pointer on the window?
	If Xmouse<0 : ProcedureReturn 0 : EndIf
	

	; Another quick way out?	
	If Xmouse<x1 And Xmouse<x2 And Xmouse<x3 And Xmouse<x4
		ProcedureReturn 0
	EndIf
	
	If Xmouse>x1 And Xmouse>x2 And Xmouse>x3 And Xmouse>x4
		ProcedureReturn 0
	EndIf
	
	If Ymouse>y1 And Ymouse>y2 And Ymouse>y3 And Ymouse>y4
		ProcedureReturn 0
	EndIf
	
	If Ymouse<y1 And Ymouse<y2 And Ymouse<y3 And Ymouse<y4
		ProcedureReturn 0
	EndIf
	

	; Some coordinates match... let's do more exact inspection
	; One rotation for each side of the quadrangle
	DefineLine(@MyLin,x1,y1,x2,y2)
	DefineLine(@PickLin,x1,y1,Xmouse,Ymouse)
	
	rot=GetLineAngle(@MyLin)
	RotateLine(@PickLin,rot)
	
	llen=GetLineLength(@MyLin)
	
	If PickLin\y2<y1
		ProcedureReturn 0
	EndIf
	
	DefineLine(@MyLin,x2,y2,x3,y3)
	DefineLine(@PickLin,x2,y2,Xmouse,Ymouse)
	
	rot=GetLineAngle(@MyLin)
	RotateLine(@PickLin,rot)
	
	llen=GetLineLength(@MyLin)
	
	If PickLin\y2<y2
		ProcedureReturn 0
	EndIf
	
	DefineLine(@MyLin,x3,y3,x4,y4)
	DefineLine(@PickLin,x3,y3,Xmouse,Ymouse)
	
	rot=GetLineAngle(@MyLin)
	RotateLine(@PickLin,rot)
	
	llen=GetLineLength(@MyLin)
	
	If PickLin\y2<y3
		ProcedureReturn 0
	EndIf
	
	DefineLine(@MyLin,x4,y4,x1,y1)
	DefineLine(@PickLin,x4,y4,Xmouse,Ymouse)
	
	rot=GetLineAngle(@MyLin)
	RotateLine(@PickLin,rot)
	
	llen=GetLineLength(@MyLin)
	
	If PickLin\y2<y4
		ProcedureReturn 0
	EndIf
	
	ProcedureReturn 1
	
EndProcedure




OpenWindow(0,0,0,800,600,"Point Inside Quadrangle",#PB_Window_ScreenCentered | #PB_Window_SystemMenu )

Define x1=550,y1=130,x2=700,y2=400,x3=220,y3=300,x4=250,y4=250
Define ev

Repeat
	
	ev = WindowEvent()
	
	Delay(20)
		
	If StartDrawing(WindowOutput(0))
		If TestMousePick(WindowMouseX(0),WindowMouseY(0),x1,y1,x2,y2,x3,y3,x4,y4)
			FrontColor(RGB(200,20,20))
		Else
			FrontColor(RGB(20,200,20))
		EndIf
		LineXY(x1,y1,x2,y2)
		LineXY(x3,y3,x2,y2)
		LineXY(x3,y3,x4,y4)
		LineXY(x1,y1,x4,y4)
	StopDrawing()
	EndIf

Until ev = #PB_Event_CloseWindow 

I'm using this routine quite intensively in one 3d application which is based on Sprite3D and TransformSprite3D(...) commands. This is also why the points have to be given in the certain order (clockwise).

One morning I started wondering whether there is any faster solution for this?


Greetings for all,
Kapslok

[STARGÅTE]

a smaller GetLineAngle() for PB 4.51:
(with your angle definition)

Code: Select all

Procedure.f GetLineAngle(*line.Line2D)

   ProcedureReturn Degree(ATan2(*line\x2-*line\x,*line\y-*line\y2)) 
 
EndProcedure

[Comtois]

another solution using Winding number

Code: Select all

;http://softsurfer.com/Archive/algorithm_0103/algorithm_0103.htm#Implementations

; Copyright 2001, softSurfer (www.softsurfer.com)
; This code may be freely used And modified For any purpose
; providing that this copyright notice is included With it.
; SoftSurfer makes no warranty For this code, And cannot be held
; liable For any real Or imagined damage resulting from its use.
; Users of this code must verify correctness For their application.

EnableExplicit

; isLeft(): tests If a point is Left|On|Right of an infinite line.
;    Input:  three points P0, P1, And P2
;    Return: >0 For P2 left of the line through P0 And P1
;            =0 For P2 on the line
;            <0 For P2 right of the line
;    See: the January 2001 Algorithm "Area of 2D and 3D Triangles and Polygons"
Procedure isLeft(*P0.point, *P1.point, *P2.point)
  ProcedureReturn ((*P1\x - *P0\x) * (*P2\y - *P0\y) - (*P2\x - *P0\x) * (*P1\y - *P0\y))
EndProcedure

; wn_PnPoly(): winding number test For a point in a polygon
;      Input:   P = a point,
;               V[] = vertex points of a polygon V[n+1] With V[n]=V[0]
;      Return:  wn = the winding number (=0 only If P is outside V[])
Procedure wn_PnPoly(*P.point,Array V.Point(1), n)
  Define i.i
  Define wn.i = 0;    // the winding number counter
  
  ; loop through all edges of the polygon
  For i=0 To n-1                          ; edge from V[i] To V[i+1]
    If V(i)\y <= *P\y                     ; start y <= P.y
      If V(i+1)\y > *P\y                  ; an upward crossing
        If isLeft(@V(i), @V(i+1), *P) > 0 ; P left of edge
          wn + 1                          ; have a valid up intersect
        EndIf
      EndIf    
    Else                                  ; start y > P.y (no test needed)
      If V(i+1)\y <= *P\y                 ; a downward crossing
        If isLeft(@V(i), @V(i+1), *P) < 0 ; P right of edge
          wn - 1                          ; have a valid down intersect
        EndIf 
      EndIf    
    EndIf
  Next i
  ProcedureReturn wn
EndProcedure


OpenWindow(0,0,0,800,600,"Point Inside Quadrangle",#PB_Window_ScreenCentered | #PB_Window_SystemMenu )
#Nb = 4
Dim Polygon.Point(#Nb)
Define i.i, p.point
Define ev

For i=0 To #Nb
  Read.i Polygon(i)\x
  Read.i Polygon(i)\y
Next i

Repeat
  
  ev = WindowEvent()
  
  Delay(20)
  
  If StartDrawing(WindowOutput(0))
    p\x = WindowMouseX(0)
    p\y = WindowMouseY(0)
    If wn_PnPoly(@p, Polygon(), #Nb)
      FrontColor(RGB(200,20,20))
    Else
      FrontColor(RGB(20,200,20))
    EndIf
    For i=0 To #Nb-1
      LineXY(Polygon(i)\x,Polygon(i)\y,Polygon(i+1)\x,Polygon(i+1)\y)
    Next i  
    StopDrawing()
  EndIf
  
Until ev = #PB_Event_CloseWindow

DataSection
  Data.i 550,130
  Data.i 700,400
  Data.i 220,300
  Data.i 250,250 
  Data.i 550,130  
EndDataSection

[Kapslok]

Excellent! That example surely beats my alternative in both speed and size. And it seems to have possibility to change the amount of points used for the polygon. Thanks Comtois! I guess I need to take a look at the softsurfer too.

And thank you too, StarGåte, for the Atan2 optimization. I actually knew it was there but didn't get it quite going.

Kapslok