http://www.purebasic.com
https://www.purebasic.fr/english/
Thanks. I plan to continue with features, then organize into a reusable standalone module. Its a mess in its current form, but it works at least.minimy wrote: Wed Jan 21, 2026 5:41 pm This is very good, over all for 2D games.
Thank for share miso!
Code: Select all
;2d Zone checks against point with structured pointers to avoid parameter hell
;Written by miso 2026.01.19, with 6.30 beta 6 WinX64, [crossplatform]
;Policy: 777, do what you please, no credit required
;Upgrades/additions/extensions/fixes are welcomed in PB forum
EnableExplicit
;================================
;-STRUCTURES
;================================
Structure point2dstructure
x.f
y.f
EndStructure
Structure line2dstructure
a.point2dstructure
b.point2dstructure
EndStructure
Structure triangle2dstructure
a.point2dstructure
b.point2dstructure
c.point2dstructure
EndStructure
Structure quad2dstructure
a.point2dstructure
b.point2dstructure
c.point2dstructure
d.point2dstructure
EndStructure
Structure circle2dstructure
a.point2dstructure ;CenterPoint A
r.f ;Radius
EndStructure
Structure box2dstructure
min.point2dstructure ;TOP LEFT
max.point2dstructure ;BOTTOM RIGHT
EndStructure
Global mouseposition.point2dstructure, collpoint1.point2dstructure,normal1.point2dstructure, collpoint2.point2dstructure, closestcollision.point2dstructure, closestnormal.point2dstructure
;================================
;-PROCEDURES
;================================
Procedure.f min(a.f,b.f)
If a>b : ProcedureReturn b : EndIf
ProcedureReturn a
EndProcedure
Procedure.f max(a.f,b.f)
If a>b : ProcedureReturn a : EndIf
ProcedureReturn b
EndProcedure
Procedure.f dist2d(*p1.point2dstructure,*p2.point2dstructure)
Protected.f dx,dy
dx=*p2\x-*p1\x
dy=*p2\y-*p1\y
ProcedureReturn dx*dx+dy*dy
;ProcedureReturn Sqr(dx*dx+dy*dy)
EndProcedure
;-================================
;-Angle, will be used for shape triangulation later
;-================================
Procedure.f Angle2dAtP1(*tri.triangle2dstructure)
Protected.f v1X, v1Y, V2X, v2Y, dot, lenV1, lenV2, cosTheta.f, theta.f
; 1. Vectors from triangle point A
With *tri
v1X.f = \B\X - \A\X : v1Y.f = \B\Y - \A\Y : v2X.f = \C\X - \A\X : v2Y.f = \C\Y - \A\Y
EndWith
; 2. Scalar
dot.f = v1X * v2X + v1Y * v2Y
; 3. Vector lengths
lenV1.f = Sqr(v1X*v1X + v1Y*v1Y) : lenV2.f = Sqr(v2X*v2X + v2Y*v2Y)
; 4. Computing cos
If lenV1 = 0 Or lenV2 = 0 : ProcedureReturn 0 : EndIf ; Avoid division zero
cosTheta.f = dot / (lenV1 * lenV2)
; 5. Safety
If cosTheta > 1.0 : cosTheta = 1.0 : ElseIf cosTheta < -1.0 : cosTheta = -1.0 : EndIf
; 6. Computing angle and convert from radian
theta.f = ACos(cosTheta) * (180.0 / #PI)
ProcedureReturn theta
EndProcedure
;-================================
;-Point Against a Triangle
;-================================
Procedure.i Point2dInTriangle(*p.point2dstructure, *tri.triangle2dstructure)
Protected d1.f, d2.f, d3.f, has_neg.i, has_pos.i
; Cross products
d1.f = (*p\x - *tri\B\x)*(*tri\a\y - *tri\B\y) - (*tri\A\X - *tri\B\x)*(*p\y - *tri\B\y)
d2.f = (*p\x - *tri\C\x)*(*tri\B\Y - *tri\C\Y) - (*tri\B\X - *tri\C\x)*(*p\y - *tri\C\Y)
d3.f = (*p\x - *tri\a\x)*(*tri\C\Y - *tri\A\Y) - (*tri\C\X - *tri\A\X)*(*p\y - *tri\A\Y)
; Logic variables
has_neg.i = 0 : has_pos.i = 0
If d1 < 0.0 Or d2 < 0.0 Or d3 < 0.0 : has_neg = 1 : EndIf
If d1 > 0.0 Or d2 > 0.0 Or d3 > 0.0 : has_pos = 1 : EndIf
;Result
If has_neg And has_pos : ProcedureReturn #False : EndIf ; Point is outside
ProcedureReturn #True ; Point is inside or on line
EndProcedure
;-================================
;-Point against a Circle
;-================================
Procedure.i Point2dInCircle(*p.point2dstructure, *c.circle2dstructure)
Protected dx.f, dy.f, dist2.f, radius2.f
dx.f = *p\x - *c\a\x : dy.f = *p\y - *c\a\y
dist2.f = dx*dx + dy*dy : radius2.f = *c\r * *c\r
If dist2 <= radius2 : ProcedureReturn #True : EndIf ; Point is inside or on edge of circle
ProcedureReturn #False ; Point outside
EndProcedure
;-================================
;-Point against an aligned Box
;-================================
Procedure.i Point2dInBox(*p.point2dstructure, *b.box2dstructure)
If *p\x >= *b\min\X And *p\x <= *b\max\X And *p\y >= *b\min\Y And *p\y <= *b\max\Y : ProcedureReturn #True : EndIf
ProcedureReturn #False
EndProcedure
;-================================
;-Point against custom quad
;-================================
Procedure.i Point2dInQuad(*p.point2dstructure, *q.quad2dstructure)
Protected d1.f, d2.f, d3.f, d4.f, has_neg.i, has_pos.i, t1, t2
d1.f = (*p\X - *q\A\X)*(*q\B\Y - *q\A\Y) - (*q\B\X - *q\A\X) * (*p\Y - *q\A\Y)
d2.f = (*p\X - *q\B\X)*(*q\C\Y - *q\B\Y) - (*q\C\X - *q\B\X) * (*p\Y - *q\B\Y)
d3.f = (*p\X - *q\C\X)*(*q\D\Y - *q\C\Y) - (*q\D\X - *q\C\X) * (*p\Y - *q\C\Y)
d4.f = (*p\X - *q\D\X)*(*q\A\Y - *q\D\Y) - (*q\A\X - *q\D\X) * (*p\Y - *q\D\Y)
If d1 < 0.0 Or d2 < 0.0 Or d3 < 0.0 Or d4 < 0.0 : has_neg = 1 : EndIf
If d1 > 0.0 Or d2 > 0.0 Or d3 > 0.0 Or d4 > 0.0 : has_pos = 1 : EndIf
If has_neg And has_pos :ProcedureReturn #False : EndIf
ProcedureReturn #True ;
EndProcedure
;-================================
;-Point against custom quad
;-================================
Procedure.i Line2dToBox(*l1.line2dstructure, *b.box2dstructure)
Protected.f dx.f, dy.f, tmin.f, tmax.f, tx1, tx2, t1, t2, ty1, ty2, ix1, iy1, ix2, iy2, nx1, ny1, nx2, ny2
; -------- DIRECTION --------
dx.f = *l1\b\x - *l1\A\x
dy.f = *l1\B\y - *l1\A\y
; -------- INITIAL T --------
tmin.f = 0.0
tmax.f = 1.0
; -------- SLAB X --------
If dx <> 0.0
tx1.f = (*b\min\X - *l1\A\x) / dx
tx2.f = (*b\max\X - *l1\A\x) / dx
t1.f = Min(tx1, tx2)
t2.f = Max(tx1, tx2)
tmin = Max(tmin, t1)
tmax = Min(tmax, t2)
Else
; vertical part
If *l1\A\x < *b\min\X Or *l1\A\x > *b\max\X
tmin = 1.0
tmax = 0.0
EndIf
EndIf
; -------- SLAB Y --------
If dy <> 0.0
ty1.f = (*b\min\Y - *l1\A\y) / dy
ty2.f = (*b\max\Y - *l1\A\y) / dy
t1.f = Min(ty1, ty2)
t2.f = Max(ty1, ty2)
tmin = Max(tmin, t1)
tmax = Min(tmax, t2)
Else
; horizontal part
If *l1\A\y < *b\min\Y Or *l1\A\y > *b\max\Y
tmin = 1.0
tmax = 0.0
EndIf
EndIf
; -------- intersection --------
If tmin <= tmax
; -------- intersection points --------
ix1.f = *l1\A\x + tmin * dx
iy1.f = *l1\A\y + tmin * dy
collpoint1\x = ix1
collpoint1\y = iy1
;second point
;ix2.f = *l1\A\x + tmax * dx
;iy2.f = *l1\A\y + tmax * dy
; -------- normals --------
; Normal1
nx1.f = 0
ny1.f = 0
;epsilon comparison, cant use = with floats
;TODO at slab parts the normals are known, so no comparisons should be needed.
#eps=0.00001
If Abs(tmin - (*b\min\X - *l1\A\x)/dx)<#eps
nx1 = -1 : ny1 = 0
ElseIf Abs(tmin - (*b\max\X - *l1\A\x)/dx)<#eps
nx1 = 1 : ny1 = 0
ElseIf Abs(tmin - (*b\min\Y - *l1\A\y)/dy)<#eps
nx1 = 0 : ny1 = -1
ElseIf Abs(tmin - (*b\max\Y - *l1\A\y)/dy)<#eps
nx1 = 0 : ny1 = 1
EndIf
normal1\x = collpoint1\x+(nx1*50)
normal1\y = collpoint1\y+(ny1*50)
ProcedureReturn #True
; Normal2
;nx2.f = 0
;ny2.f = 0
;If tmax = (*b\min\X - *l1\A\x)/dx
; nx2 = -1 : ny2 = 0
;ElseIf tmax = (*b\max\X - *l1\A\x)/dx
; nx2 = 1 : ny2 = 0
;ElseIf tmax = (*b\min\Y - *l1\A\y)/dy
; nx2 = 0 : ny2 = -1
;ElseIf tmax = (*b\max\Y - *l1\A\y)/dy
; nx2 = 0 : ny2 = 1
;EndIf
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i LineCircleHit_NoSqrt(*l.line2dstructure,*c.circle2dstructure)
Protected.f dx,dy,fx,fy,len2,t.f,px,py,dx2,dy2
dx.f = *l\B\x - *l\A\x
dy.f = *l\B\y - *l\A\y
fx.f = *C\A\x - *l\A\x
fy.f = *C\A\y - *l\A\y
len2.f = dx*dx + dy*dy
If len2 = 0.0
ProcedureReturn #False ; degenerált szakasz
EndIf
; projekció (t)
t.f = (fx*dx + fy*dy) / len2
If t < 0.0
px.f = *l\A\x
py.f = *l\A\y
ElseIf t > 1.0
px.f = *l\B\x
py.f = *l\B\y
Else
px.f = *l\A\x + t * dx
py.f = *l\A\y + t * dy
EndIf
dx2.f = px - *C\A\x
dy2.f = py - *C\A\y
If dx2*dx2 + dy2*dy2 <= *c\r**c\r
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure LineCircleHit(*l.line2dstructure,*c.circle2dstructure)
Protected.f dx,dy,fx,fy,a,b,c,disc,sqrtdisc,t1,t2,ix1,iy1,nx1,ny1,ix2,iy2,nx2,ny2,len1,len2
dx.f = *l\b\x - *l\a\x : dy.f = *l\b\y - *l\a\y
fx.f = *l\a\x - *c\a\x : fy.f = *l\a\y - *c\a\y
a.f = dx*dx + dy*dy : b.f = 2.0 * (fx*dx + fy*dy) : c.f = fx*fx + fy*fy - *c\r**c\r
disc.f = b*b - 4.0*a*c
If disc >= 0.0
sqrtDisc.f = Sqr(disc)
t1.f = (-b - sqrtDisc) / (2.0*a) : t2.f = (-b + sqrtDisc) / (2.0*a)
If t1 >= 0.0 And t1 <= 1.0
ix1.f = *l\a\x + t1 * dx : iy1.f = *l\a\y + t1 * dy
collpoint1\x = ix1 : collpoint1\y = iy1
nx1.f = ix1 - *c\a\x : ny1.f = iy1 - *c\a\y
len1.f = Sqr(nx1*nx1 + ny1*ny1)
If len1 <> 0
nx1 / len1 : ny1 / len1
EndIf
normal1\x = ix1+(nx1*50) : normal1\y = iy1+(ny1*50)
EndIf
ProcedureReturn #True
;second intersection
;If t2 >= 0.0 And t2 <= 1.0 And disc > 0.0
; ix2.f = *l\a\x + t2 * dx : iy2.f = *l\a\y + t2 * dy
; nx2.f = ix2 - *c\a\x : ny2.f = iy2 - *c\a\y
; len2.f = Sqr(nx2*nx2 + ny2*ny2)
; If len2 <> 0
; nx2 / len2 : ny2 / len2
; EndIf
;EndIf
EndIf
EndProcedure
Procedure.i LineLineIntersection(*l1.line2dstructure, *l2.line2dstructure)
Protected.f dx1,dy1,dx2,dy2,dx,dy,t,u,ix,iy,nx,ny,len,det,dot
dx1.f = *l1\B\x - *l1\A\x : dy1.f = *l1\B\y - *l1\A\y
dx2.f = *l2\B\x - *l2\A\x : dy2.f = *l2\B\y - *l2\A\y
det.f = dx1*dy2 - dy1*dx2
If det = 0.0 : ProcedureReturn #False : EndIf
dx.f = *l2\A\x - *l1\a\x : dy.f = *l2\A\y - *l1\a\y
t.f = (dx*dy2 - dy*dx2) / det
u.f = (dx*dy1 - dy*dx1) / det
If t < 0.0 Or t > 1.0 Or u < 0.0 Or u > 1.0
ProcedureReturn #False
EndIf
ix.f = *l1\A\x + t * dx1
iy.f = *l1\A\y + t * dy1
nx.f = -dy2
ny.f = dx2
len.f = Sqr(nx*nx + ny*ny)
If len <> 0
nx / len
ny / len
EndIf
;normal flip toward the caster point
dot.f = nx*dx1 + ny*dy1
If dot > 0
nx * -1 : ny * -1
EndIf
collpoint1\x = ix
collpoint1\y = iy
normal1\x = ix+(nx*50)
normal1\y = iy+(ny*50)
ProcedureReturn #True
EndProcedure
Procedure.i LineTriangleIntersection(*l.line2dstructure, *t.triangle2dstructure)
Protected tl1.line2dstructure,tl2.line2dstructure,tl3.line2dstructure,hit.i, cnorm.point2dstructure, cpoint.point2dstructure
Protected.f dis,cx,cy,nx,ny
tl1\a\x = *t\a\x : tl1\a\y = *t\a\y
tl1\B\x = *t\B\x : tl1\B\y = *t\B\y
If LineLineIntersection(*l,@tl1)
hit = #True
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
EndIf
tl2\a\x = *t\B\x : tl2\A\y = *t\B\y
tl2\B\x = *t\C\x : tl2\B\y = *t\C\y
If LineLineIntersection(*l,@tl2)
If hit <>#True
hit = #True
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
Else
If dis>dist2d(@*l\a,@collpoint1)
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
EndIf
EndIf
EndIf
tl3\a\x = *t\C\x : tl3\A\y = *t\C\y
tl3\B\x = *t\A\x : tl3\B\y = *t\A\y
If LineLineIntersection(*l,@tl3)
If hit <>#True
hit = #True
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
Else
If dis>dist2d(@*l\a,@collpoint1)
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
EndIf
EndIf
EndIf
If hit
collpoint1\x = cx
collpoint1\y = cy
normal1\x = nx
normal1\y = ny
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i LineQuadIntersection(*l.line2dstructure, *q.quad2dstructure)
Protected tl1.line2dstructure,tl2.line2dstructure,tl3.line2dstructure,tl4.line2dstructure,hit.i, cnorm.point2dstructure, cpoint.point2dstructure
Protected.f dis,cx,cy,nx,ny
tl1\a\x = *q\a\x : tl1\a\y = *q\a\y
tl1\B\x = *q\B\x : tl1\B\y = *q\B\y
If LineLineIntersection(*l,@tl1)
hit = #True
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
EndIf
tl2\a\x = *q\B\x : tl2\A\y = *q\B\y
tl2\B\x = *q\C\x : tl2\B\y = *q\C\y
If LineLineIntersection(*l,@tl2)
If hit <>#True
hit = #True
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
Else
If dis>dist2d(@*l\a,@collpoint1)
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
EndIf
EndIf
EndIf
tl3\a\x = *q\C\x : tl3\A\y = *q\C\y
tl3\B\x = *q\D\x : tl3\B\y = *q\D\y
If LineLineIntersection(*l,@tl3)
If hit <>#True
hit = #True
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
Else
If dis>dist2d(@*l\a,@collpoint1)
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
EndIf
EndIf
EndIf
tl4\a\x = *q\D\x : tl4\A\y = *q\D\y
tl4\B\x = *q\A\x : tl4\B\y = *q\A\y
If LineLineIntersection(*l,@tl4)
If hit <>#True
hit = #True
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
Else
If dis>dist2d(@*l\a,@collpoint1)
cx = collpoint1\x
cy = collpoint1\y
nx = normal1\x
ny = normal1\y
dis = dist2d(@*l\a,@collpoint1)
EndIf
EndIf
EndIf
If hit
collpoint1\x = cx
collpoint1\y = cy
normal1\x = nx
normal1\y = ny
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;-================================
;-EXAMPLE USAGE
;-================================
Global dist.f, collided.i
;A Triangle
Define t.triangle2dstructure
t\a\x=100 : t\a\y=100
t\b\x=500 : t\b\y=100
t\c\x=200 : t\c\y=200
;A circle
Define c.circle2dstructure
c\a\x = 800
c\a\y = 400
c\r = 150
;A box
Define b.box2dstructure
b\min\x = 400
b\min\y = 200
b\max\x = 780
b\max\y = 280
;A quad
Define q.quad2dstructure
q\A\X = 500
q\A\Y = 500
q\B\X = 750
q\B\Y = 505
q\C\X = 600
q\C\Y = 550
q\D\X = 500
q\D\Y = 545
Define p.point2dstructure
p\X = 10
p\Y = 40
Define l.line2dstructure
l\A\X = 150
l\A\Y = 190
l\B\X = 400
l\B\Y = 400
Define testline.line2dstructure
;Text display module
DeclareModule petskii
EnableExplicit
;=======================================================================
;system font
;=======================================================================
Declare LoadSyStemFont()
Declare text(x,y,text.s,color.i,intensity.i=255)
Declare centertext(x,y,text.s,color.i,intensity.i=255)
Declare FreeSyStemFont()
EndDeclareModule
;--MODULES, AUXILIARY
Module petskii
;======================================================
;System fonts for displaying system messages on screen
;======================================================
#USED_CHARACTERS="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-_=+[{]};:',<.>/?"+Chr(34)
Global Dim font(370):Global Dim fontimport.i(370)
Procedure LoadSyStemFont()
Protected x.i,i.i,j.i,sprline.a
For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i
Restore sysfont
For x= 1 To 370
If fontimport(x)=1
font(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(font(x)))
DrawingMode(#PB_2DDrawing_AllChannels)
For j=0 To 11
Read.a sprline
For i=0 To 7
If sprline&%1 :Plot(i,j,RGBA(255,255,255,255)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
sprline>>1
Next i
Next j
StopDrawing()
ZoomSprite(font(x),16,24)
EndIf
Next x
EndProcedure
Procedure text(x,y,text.s,color.i,intensity.i=255) : Protected.i textlength,i,character
textlength.i = Len(text.s)
For i = 1 To textlength.i
character.i = Asc(Mid(text.s,i,1))
If character.i>ArraySize(font()) : ProcedureReturn #Null : EndIf
If IsSprite(font(character))
DisplayTransparentSprite(font(character),(x+((i-1) * 16)),(y),intensity,color.i)
EndIf
Next i
EndProcedure
Procedure centertext(x,y,text.s,color.i,intensity=255)
Protected textlength.i
textlength.i = Len(text.s)
x=x-(textlength*8) : y=y-8
text(x,y,text.s,color,intensity)
EndProcedure
Procedure FreeSyStemFont()
Protected i.i
For i = 1 To Len(#USED_CHARACTERS)
If IsSprite(font(i)) : FreeSprite(font(i)) : EndIf
Next i
EndProcedure
DataSection
sysfont:
Data.q $3838383838380000,$EEEE000000003800,$00000000000000EE,$FFEEFFEEEEEE0000,$383800000000EEEE,$0000387EE07C0EFC,$1C3870EECECE0000,$7C7C00000000E6EE,$0000FCEEEE3C7CEE
Data.q $00003870E0E00000,$7070000000000000,$000070381C1C1C38,$707070381C1C0000,$0000000000001C38,$000000EE7CFF7CEE,$38FE383800000000,$0000000000000038,$001C383800000000
Data.q $00FE000000000000,$0000000000000000,$0000383800000000,$3870E0C000000000,$7C7C000000000E1C,$00007CEEEEFEFEEE,$38383C3838380000,$7C7C00000000FE38,$0000FE0E1C70E0EE
Data.q $E078E0EE7C7C0000,$E0E0000000007CEE,$0000E0E0FEEEF8F0,$E0E07E0EFEFE0000,$7C7C000000007CEE,$00007CEEEE7E0EEE,$383870EEFEFE0000,$7C7C000000003838,$00007CEEEE7CEEEE
Data.q $E0FCEEEE7C7C0000,$3838000000007CEE,$0000383800000038,$0000003838380000,$F0F00000001C3838,$0000F0381C0E1C38,$FE00FE0000000000,$1E1E000000000000,$00001E3870E07038
Data.q $3870E0EE7C7C0000,$7C7C000000003800,$00007CCE0EFEFEEE,$EEFEEE7C38380000,$7E7E00000000EEEE,$00007EEEEE7EEEEE,$0E0E0EEE7C7C0000,$3E3E000000007CEE,$00003E7EEEEEEE7E
Data.q $0E3E0E0EFEFE0000,$FEFE00000000FE0E,$00000E0E0E3E0E0E,$EEFE0EEE7C7C0000,$EEEE000000007CEE,$0000EEEEEEFEEEEE,$383838387C7C0000,$F8F8000000007C38,$00003C7E70707070
Data.q $3E1E3E7EEEEE0000,$0E0E00000000EE7E,$0000FE0E0E0E0E0E,$CEFEFEFECECE0000,$EEEE00000000CECE,$0000EEEEFEFEFEFE,$EEEEEEEE7C7C0000,$7E7E000000007CEE,$00000E0E0E7EEEEE
Data.q $EEEEEEEE7C7C0000,$7E7E00000000F07C,$0000EE7E3E7EEEEE,$E07C0EEE7C7C0000,$FEFE000000007CEE,$0000383838383838,$EEEEEEEEEEEE0000,$EEEE000000007CEE,$0000387CEEEEEEEE
Data.q $FEFECECECECE0000,$EEEE00000000CEFE,$0000EEEE7C387CEE,$387CEEEEEEEE0000,$FEFE000000003838,$0000FE0E1C3870E0,$1C1C1C1C7C7C0000,$7C7C000000007C1C,$00007C7070707070
Data.q $3838FE7C38380000,$0000000000003838,$0000FF0000000000,$FCE07C0000000000,$000000000000FCEE,$00007EEEEE7E0E0E,$0E0E7C0000000000,$0000000000007C0E,$0000FCEEEEFCE0E0
Data.q $FEEE7C0000000000,$0000000000007C0E,$0000383838FC38F0,$EEEEFC0000000000,$0E0E0000007EE0FC,$0000EEEEEEEE7E0E,$38383C0038380000,$0000000000007C38,$003C707070700070
Data.q $3E7E0E0E0E0E0000,$3C3C00000000EE7E,$00007C3838383838,$FEFEEE0000000000,$000000000000CEFE,$0000EEEEEEEE7E00,$EEEE7C0000000000,$0000000000007CEE,$000E0E7EEEEE7E00
Data.q $EEEEFC0000000000,$0000000000E0E0FC,$00000E0E0EEE7E00,$7C0EFC0000000000,$0000000000007EE0,$0000F0383838FE38,$EEEEEE0000000000,$000000000000FCEE,$0000387CEEEEEE00
Data.q $FEFECE0000000000,$000000000000FCFC,$0000EE7C387CEE00,$EEEEEE0000000000,$00000000003E70FC,$0000FE1C3870FE00,$381E3838F0F00000,$1E1E00000000F038,$00001E3838F03838
EndDataSection
EndModule
DeclareModule line
Global sprite_ID.i = -1 ;(Sprite used with filledbox:: module also)
Declare init()
Declare destroy()
Declare draw(x1.i , y1.i , x2.i , y2.i , color.i = -1 , width.i=2 , intensity.i = 255)
EndDeclareModule
;******************************************************************
;Special thanks for MijiKai and Stargate for the line snippet
;******************************************************************
;--MODULE
Module line
;******************************************************************
;This procedure initializes the line functions, creates it's sprite
;******************************************************************
Procedure init()
If Not IsSprite( sprite_ID )
sprite_ID = CreateSprite(#PB_Any,1,1,#PB_Sprite_AlphaBlending)
If Not IsSprite( sprite_ID ) : ProcedureReturn #False : EndIf
StartDrawing( SpriteOutput( sprite_ID ) )
DrawingMode( #PB_2DDrawing_AllChannels )
Box(0 , 0 , OutputWidth() , OutputHeight() , RGBA( 255 , 255 , 255 , 255 ))
StopDrawing()
ProcedureReturn #True
EndIf
EndProcedure
;******************************************************************
;This procedure frees the resources (1 sprite) if linedrawing is
;not needed anymore
;******************************************************************
Procedure destroy()
If IsSprite(sprite_ID) : FreeSprite(sprite_ID) : EndIf
EndProcedure
;******************************************************************
;This procedure draws a line to screen either 2d or 3d Ogre screen
;******************************************************************
Procedure draw(x1.i , y1.i , x2.i , y2.i , color.i = -1 , width.i=2 , intensity.i = 255)
;MIJIKAI and STARGATE code
Protected.f length, dx, dy
length = Sqr((X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2))
dy = (X2 - X1) * Width / (2 * length)
dx = (Y1 - Y2) * Width / (2 * length)
;ZoomSprite(sprite_ID , length , length)
TransformSprite(sprite_ID , X1-dx , Y1-dy , X2-dx , Y2-dy , X2+dx , Y2+dy , X1+dx , Y1+dy)
DisplayTransparentSprite(sprite_ID , 0 , 0 , intensity , color)
EndProcedure
EndModule
;-EXAMPLE BEGINS
Global screenspr.i, mousesprite.i, color
InitSprite():InitKeyboard():InitMouse()
ExamineDesktops()
OpenWindow(0, 0,0, DesktopWidth(0)*0.8,DesktopHeight(0)*0.8, "Test",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0)
petskii::LoadSyStemFont()
line::init()
screenspr = CreateSprite(#PB_Any,ScreenWidth(),ScreenHeight(),#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(screenspr))
;draw triangle
LineXY(t\a\x,t\a\y, t\b\x,t\b\y)
LineXY(t\c\x,t\c\y, t\b\x,t\b\y)
LineXY(t\a\x,t\a\y, t\c\x,t\c\y)
;draw box
LineXY(b\min\x,b\min\y, b\max\x,b\min\y)
LineXY(b\min\x,b\max\y, b\max\x,b\max\y)
LineXY(b\min\x,b\min\y, b\min\x,b\max\y)
LineXY(b\max\x,b\min\y, b\max\x,b\max\y)
;draw circle
DrawingMode(#PB_2DDrawing_Outlined)
Circle(c\a\x,c\a\y,c\r)
;draw quad
LineXY(q\a\x,q\a\y, q\b\x,q\b\y)
LineXY(q\c\x,q\c\y, q\b\x,q\b\y)
LineXY(q\d\x,q\d\y, q\c\x,q\c\y)
LineXY(q\d\x,q\d\y, q\a\x,q\a\y)
;draw line
LineXY(l\a\x,l\a\y, l\b\x,l\b\y)
StopDrawing()
mousesprite = CreateSprite(#PB_Any,3,3,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(mousesprite))
Box(0,0,3,3)
StopDrawing()
Structure s_d2camera
pos.point2dstructure
piv.point2dstructure
rotD.f ;degree
rotR.f ;rad
z.f ;zoom
Array T.f(3,3) ;translation
Array R.f(3,3) ;rotation
Array S.f(3,3) ;scale
Array C.f(3,3) ;center, pivot
Array cameramatrix.f(3,3) ; all in one
Array invcameramatrix.f(3,3) ; all in one
EndStructure
Global d2c.s_d2camera
d2c\pos\x = -ScreenWidth()/2
d2c\pos\y = -ScreenHeight()/2
d2c\piv\x = -ScreenWidth()/2
d2c\piv\y = -ScreenHeight()/2
d2c\rotD = 0
d2c\z = 1
Procedure buildcmatrices()
Protected Dim temp1.f(3,3)
Protected Dim temp2.f(3,3)
Protected det.f
With d2c
\rotr=Radian(\rotd)
\T(0,0) = 1 : \T(1,0) = 0 : \T(2,0) = \pos\x
\T(0,1) = 0 : \T(1,1) = 1 : \T(2,1) = \pos\y
\T(0,2) = 0 : \T(1,2) = 0 : \T(2,2) = 1
\R(0,0) = Cos(\RotR) : \R(1,0) = Sin(\rotR) : \R(2,0) = 0
\R(0,1) = -Sin(\RotR) : \R(1,1) = Cos(\rotR) : \R(2,1) = 0
\R(0,2) = 0 : \R(1,2) = 0 : \R(2,2) = 1
\S(0,0) = 1/\Z : \S(1,0) = 0 : \S(2,0) = 0
\S(0,1) = 0 : \S(1,1) = 1/\Z : \S(2,1) = 0
\S(0,2) = 0 : \S(1,2) = 0 : \S(2,2) = 1
\C(0,0) = 1 : \C(1,0) = 0 : \C(2,0) = -\piv\x
\C(0,1) = 0 : \C(1,1) = 1 : \C(2,1) = -\piv\y
\C(0,2) = 0 : \C(1,2) = 0 : \C(2,2) = 1
temp1(0,0) = \R(0,0)*\T(0,0) + \R(1,0)*\T(0,1)
temp1(1,0) = \R(0,0)*\T(1,0) + \R(1,0)*\T(1,1)
temp1(2,0) = \R(0,0)*\T(2,0) + \R(1,0)*\T(2,1) +\R(2,0)
temp1(0,1) = \R(0,1)*\T(0,0) + \R(1,1)*\T(0,1)
temp1(1,1) = \R(0,1)*\T(1,0) + \R(1,1)*\T(1,1)
temp1(2,1) = \R(0,1)*\T(2,0) + \R(1,1)*\T(2,1) +\R(2,1)
temp1(0,2) = 0 : temp1(1,2) = 0 : temp1(2,2) = 1
temp2(0,0) = \S(0,0)*temp1(0,0) + \S(1,0)*temp1(0,1)
temp2(1,0) = \S(0,0)*temp1(1,0) + \S(1,0)*temp1(1,1)
temp2(2,0) = \S(0,0)*temp1(2,0) + \S(1,0)*temp1(2,1) +\S(2,0)
temp2(0,1) = \S(0,1)*temp1(0,0) + \S(1,1)*temp1(0,1)
temp2(1,1) = \S(0,1)*temp1(1,0) + \S(1,1)*temp1(1,1)
temp2(2,1) = \S(0,1)*temp1(2,0) + \S(1,1)*temp1(2,1) +\S(2,1)
temp2(0,2) = 0 : temp2(1,2) = 0 : temp2(2,2) = 1
\cameramatrix(0,0) = \C(0,0)*temp2(0,0) + \C(1,0)*temp2(0,1)
\cameramatrix(1,0) = \C(0,0)*temp2(1,0) + \C(1,0)*temp2(1,1)
\cameramatrix(2,0) = \C(0,0)*temp2(2,0) + \C(1,0)*temp2(2,1) +\C(2,0)
\cameramatrix(0,1) = \C(0,1)*temp2(0,0) + \C(1,1)*temp2(0,1)
\cameramatrix(1,1) = \C(0,1)*temp2(1,0) + \C(1,1)*temp2(1,1)
\cameramatrix(2,1) = \C(0,1)*temp2(2,0) + \C(1,1)*temp2(2,1) +\C(2,1)
\cameramatrix(0,2) = 0 : \cameramatrix(1,2) = 0 : \cameramatrix(2,2) = 1
det.f = \cameramatrix(0,0)*\cameramatrix(1,1) - \cameramatrix(0,1)*\cameramatrix(1,0)
\invcameramatrix(0,0)=\cameramatrix(0,0)/det
\invcameramatrix(0,1)=-\cameramatrix(0,1)/det
\invcameramatrix(1,0)=-\cameramatrix(1,0)/det
\invcameramatrix(1,1)=\cameramatrix(0,0)/det
\invcameramatrix(2,0)=-(\invcameramatrix(0,0)*\cameramatrix(2,0)+\invcameramatrix(1,0)*\cameramatrix(2,1))
\invcameramatrix(2,1)=-(\invcameramatrix(0,1)*\cameramatrix(2,0)+\invcameramatrix(1,1)*\cameramatrix(2,1))
\invcameramatrix(0,2)=0
\invcameramatrix(1,2)=0
\invcameramatrix(2,2)=1
EndWith
EndProcedure
Procedure.f cx(x,y)
ProcedureReturn (d2c\cameramatrix(0,0)*x + d2c\cameramatrix(1,0)*y + d2c\cameramatrix(2,0))
EndProcedure
Procedure.f cy(x,y)
ProcedureReturn (d2c\cameramatrix(0,1)*x + d2c\cameramatrix(1,1)*y + d2c\cameramatrix(2,1))
EndProcedure
Define pw.line2dstructure, tempx, tempy, dz.f = 0.001
Repeat
While WindowEvent():Wend
ClearScreen(0)
ExamineKeyboard()
ExamineMouse()
MouseDeltaX()
mouseposition\x = MouseX()
mouseposition\y = MouseY()
testline\A\x=p\x
testline\A\Y=p\y
testline\B\x=mouseposition\x
testline\B\Y=mouseposition\y
pw\A\X = d2c\invcameramatrix(0,0)*testline\A\x+ d2c\invcameramatrix(1,0)*testline\A\y+d2c\invcameramatrix(2,0)
pw\A\y = d2c\invcameramatrix(0,1)*testline\A\x+ d2c\invcameramatrix(1,1)*testline\A\y+d2c\invcameramatrix(2,1)
pw\B\X = d2c\invcameramatrix(0,0)*testline\B\x+ d2c\invcameramatrix(1,0)*testline\B\y+d2c\invcameramatrix(2,0)
pw\B\y = d2c\invcameramatrix(0,1)*testline\B\x+ d2c\invcameramatrix(1,1)*testline\B\y+d2c\invcameramatrix(2,1)
If d2c\z>1.2
dz = dz*-1
EndIf
If d2c\z<0.8
dz = dz*-1
EndIf
d2c\z +dz
d2c\rotd +0.08
d2c\pos\y+0
buildcmatrices()
TransformSprite(screenspr,cx(0,0),cy(0,0),cx(ScreenWidth(),0),cy(ScreenWidth(),0), cx(ScreenWidth(),ScreenHeight()),cy(ScreenWidth(),ScreenHeight()), cx(0,ScreenHeight()),cy(0,ScreenHeight()))
DisplayTransparentSprite(screenspr,0,0)
DisplayTransparentSprite(mousesprite,p\x,p\y)
petskii::text(10,10,"Press Right Mouse button to relocate the raycast starting position",$00AA00)
petskii::text(10,40,"Circle and aligned box are special, they do not work from the inside.",$00AA00)
DisplayTransparentSprite(mousesprite,mouseposition\x,mouseposition\y)
If Point2dInBox(@pw\b,@b)
petskii::text(mouseposition\x,mouseposition\y,"Mouse Inside the Box",$00AA00)
EndIf
If Point2dIntriangle(@pw\b,@t)
petskii::text(mouseposition\x,mouseposition\y+30,"Mouse Inside the triangle",$00AA00)
EndIf
If Point2dIncircle(@pw\b,@c)
petskii::text(mouseposition\x,mouseposition\y+60,"Mouse Inside the circle",$00AA00)
EndIf
If Point2dInQuad(@pw\b,@q)
petskii::text(mouseposition\x,mouseposition\y+90,"Mouse Inside the quad",$00AA00)
EndIf
;-RAYCASTING PROTOTYPE
dist.f = 0:collided.i =0
If Line2dTobox(@pw,@b)
;petskii::text(p\x,p\y+90,"Line crosses the box",$00AA00)
ZoomSprite(mousesprite,10,10)
DisplayTransparentSprite(mousesprite,cx(collpoint1\x,collpoint1\y)-5,cy(collpoint1\x,collpoint1\y)-5,255,RGB(55,55,255))
ZoomSprite(mousesprite,3,3)
If collided = 0
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
dist = dist2d(@pw\a,@collpoint1)
collided = 1
Else
If dist2d(@pw\a,@collpoint1)<dist
dist = dist2d(@pw\a,@collpoint1)
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
EndIf
EndIf
;Line::draw(collpoint1\x,collpoint1\y,normal1\x,normal1\y,RGB(255,0,0),1)
EndIf
If LineLineIntersection(@pw,@l)
petskii::text(p\x,p\y+30,"Oh no, you crossed the line!",$00AA00)
ZoomSprite(mousesprite,10,10)
DisplayTransparentSprite(mousesprite,cx(collpoint1\x,collpoint1\y)-5,cy(collpoint1\x,collpoint1\y)-5,255,RGB(55,55,255))
ZoomSprite(mousesprite,3,3)
If collided = 0
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
dist = dist2d(@pw\a,@collpoint1)
collided = 1
Else
If dist2d(@pw\a,@collpoint1)<dist
dist = dist2d(@pw\a,@collpoint1)
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
EndIf
EndIf
EndIf
If LineTriangleIntersection(@pw,@t)
;petskii::text(p\x,p\y+30,"Line crossed the triangle!",$00AA00)
ZoomSprite(mousesprite,10,10)
DisplayTransparentSprite(mousesprite,cx(collpoint1\x,collpoint1\y)-5,cy(collpoint1\x,collpoint1\y)-5,255,RGB(55,55,255))
ZoomSprite(mousesprite,3,3)
If collided = 0
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
dist = dist2d(@pw,@collpoint1)
collided = 1
Else
If dist2d(@pw\a,@collpoint1)<dist
dist = dist2d(@pw\a,@collpoint1)
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
EndIf
EndIf
EndIf
If LineQuadIntersection(@pw,@q)
;petskii::text(p\x,p\y+120,"Line crossed the Quad!",$00AA00)
ZoomSprite(mousesprite,10,10)
DisplayTransparentSprite(mousesprite,cx(collpoint1\x,collpoint1\y)-5,cy(collpoint1\x,collpoint1\y)-5,255,RGB(55,55,255))
ZoomSprite(mousesprite,3,3)
If collided = 0
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
dist = dist2d(@pw\a,@collpoint1)
collided = 1
Else
If dist2d(@pw\a,@collpoint1)<dist
dist = dist2d(@pw,@collpoint1)
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
EndIf
EndIf
EndIf
If LineCircleHit_NoSqrt(@pw,@c)
;petskii::text(p\x,p\y+60,"Line crosses the circle",$00AA00)
If LineCircleHit(@pw,@c)
ZoomSprite(mousesprite,10,10)
DisplayTransparentSprite(mousesprite,cx(collpoint1\x,collpoint1\y)-5,cy(collpoint1\x,collpoint1\y)-5,255,RGB(55,55,255))
ZoomSprite(mousesprite,3,3)
;Line::draw(collpoint1\x,collpoint1\y,normal1\x,normal1\y,RGB(55,55,55),1)
If collided = 0
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
dist = dist2d(@pw\a,@collpoint1)
collided = 1
Else
If dist2d(@pw\a,@collpoint1)<dist
dist = dist2d(@pw\a,@collpoint1)
closestcollision\x = collpoint1\x : closestcollision\y = collpoint1\y
closestnormal\x=normal1\x :closestnormal\y=normal1\y
EndIf
EndIf
EndIf
EndIf
If collided
tempx = cx(closestcollision\x,closestcollision\y)
tempy = cy(closestcollision\x,closestcollision\y)
closestcollision\x = tempx
closestcollision\y = tempy
tempx = cx(closestnormal\x,closestnormal\y)
tempy = cy(closestnormal\x,closestnormal\y)
closestnormal\x = tempx
closestnormal\y = tempy
ZoomSprite(mousesprite,10,10)
DisplayTransparentSprite(mousesprite,closestcollision\x-5,closestcollision\y-5,255,RGB(255,0,0))
ZoomSprite(mousesprite,3,3)
line::draw(p\x,p\y,closestcollision\x-1,closestcollision\y,RGB(255,0,0),1)
line::draw(closestcollision\x,closestcollision\y,mouseposition\x,mouseposition\y,RGB(55,55,55),1)
Line::draw(closestcollision\x,closestcollision\y,closestnormal\x,closestnormal\y,RGB(255,0,0),1)
Else
line::draw(p\x,p\y,mouseposition\x,mouseposition\y,$AAAAAA)
EndIf
If MouseButton(#PB_MouseButton_Right)
p\x = mouseposition\x : p\y = mouseposition\y
EndIf
FlipBuffers() : Delay(0)
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(3)
Thanks, Minimy! Still work in progress.minimy wrote: Fri Jan 23, 2026 4:44 pm Really nice miso! This one works very well and is better organized.
Thanks for share friend!!