justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Simplify ceiling oclusions

Browse Source
This commit is contained in:
justin
2025-11-02 19:20:57 +00:00
parent 0d0c1a72e0
commit 2f0487a424
8 changed files with 178 additions and 171 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/MatrixHelper.hs
+83 -67
View File
@@ -1,92 +1,108 @@
module MatrixHelper
( perspectiveMatrixb
, isoMatrix
, scaleMatrix
) where
module MatrixHelper (
perspectiveMatrixb,
isoMatrix,
scaleMatrix,
) where
import Geometry.Data
import Linear.Matrix
import Graphics.GL.Core45
import Linear.Matrix
perspectiveMatrixb
:: Float -- ^ Rotation
-> Float -- ^ Zoom
-> Point2 -- ^ Translation
-> Point2 -- ^ Window size
-> Point2 -- ^ View froms
-> [GLfloat]
perspectiveMatrixb ::
-- | Rotation
Float ->
-- | Zoom
Float ->
-- | Translation
Point2 ->
-- | Window size
Point2 ->
-- | View froms
Point2 ->
[GLfloat]
perspectiveMatrixb rot zoom (V2 tranx trany) (V2 winx winy) (V2 viewFromx viewFromy) =
concatMap vToL
. vToL
. lmt
$ scaleMat (V2 (2*zoom/winx) (2*zoom/winy))
!*! rotMatr (-rot)
!*! transMat (V2 (viewFromx-tranx) (viewFromy-trany))
!*! perMat 0.4
!*! transMat (V2 (-viewFromx) (-viewFromy))
!*! vertScale (negate 0.005)
!*! vertTrans 20
concatMap vToL
. vToL
. lmt
$ scaleMat (V2 (2 * zoom / winx) (2 * zoom / winy))
!*! rotMatr (- rot)
!*! transMat (V2 (viewFromx - tranx) (viewFromy - trany))
!*! perMat 0.4
!*! transMat (V2 (- viewFromx) (- viewFromy))
!*! vertScale (negate 0.005)
!*! vertTrans 20
isoMatrix
:: Float -- ^ Rotation
-> Float -- ^ Zoom
-> Point2 -- ^ Translation
-> Point2 -- ^ Window size
-> [GLfloat]
isoMatrix rot zoom (V2 tranx trany) (V2 winx winy) = concatMap vToL
. vToL
. lmt
$ scaleMat (V2 (2*zoom/winx) (2*zoom/winy))
!*! rotMatr (-rot)
!*! transMat (V2 (-tranx) (-trany))
isoMatrix ::
-- | Rotation
Float ->
-- | Zoom
Float ->
-- | Translation
Point2 ->
-- | Window size
Point2 ->
[GLfloat]
isoMatrix rot zoom (V2 tranx trany) (V2 winx winy) =
concatMap vToL
. vToL
. lmt
$ scaleMat (V2 (2 * zoom / winx) (2 * zoom / winy))
!*! rotMatr (- rot)
!*! transMat (V2 (- tranx) (- trany))
lmt :: V4 (V4 a) -> V4 (V4 a)
lmt = Linear.Matrix.transpose
vToL :: V4 a -> [a]
vToL (V4 a b c d) = [a,b,c,d]
vToL (V4 a b c d) = [a, b, c, d]
perMat :: Float -> V4 (V4 Float)
perMat x = V4
(V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 0 0 x 1)
perMat x =
V4
(V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 0 0 x 1)
scaleMatrix :: Float -> Float -> [V4 Float]
scaleMatrix x = vToL . scaleMat . V2 x
scaleMat :: Point2 -> V4 (V4 Float)
scaleMat (V2 x y) = V4
(V4 x 0 0 0)
(V4 0 y 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
scaleMat (V2 x y) =
V4
(V4 x 0 0 0)
(V4 0 y 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
rotMatr :: Float -> V4 (V4 Float)
rotMatr a = V4
(V4 (cos a) (sin (-a)) 0 0)
(V4 (sin a) (cos a) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
rotMatr a =
V4
(V4 (cos a) (sin (- a)) 0 0)
(V4 (sin a) (cos a) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
transMat :: Point2 -> V4 (V4 Float)
transMat (V2 x y) = V4
(V4 1 0 0 x)
(V4 0 1 0 y)
(V4 0 0 1 0)
(V4 0 0 0 1)
transMat (V2 x y) =
V4
(V4 1 0 0 x)
(V4 0 1 0 y)
(V4 0 0 1 0)
(V4 0 0 0 1)
vertScale :: Float -> V4 (V4 Float)
vertScale s = V4
(V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 s 0)
(V4 0 0 0 1)
vertScale s =
V4
(V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 s 0)
(V4 0 0 0 1)
vertTrans :: Float -> V4 (V4 Float)
vertTrans z = V4
(V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 (negate z))
(V4 0 0 0 1)
vertTrans z =
V4
(V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 (negate z))
(V4 0 0 0 1)