PureBasic Forums - English

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 

Code: Select all

Procedure.f GetLineAngle(*line.Line2D)

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

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