105 lines
2.9 KiB
Haskell
105 lines
2.9 KiB
Haskell
module Polyhedra
|
|
where
|
|
import Geometry
|
|
import Geometry.Data
|
|
import Geometry.Vector3D
|
|
import Polyhedra.Data
|
|
import Picture.Data
|
|
import Picture
|
|
|
|
import Data.Maybe
|
|
import Data.List
|
|
import Data.Bifunctor
|
|
import Control.Lens
|
|
|
|
translateXY :: Float -> Float -> Polyhedra -> Polyhedra
|
|
translateXY x y = pyFaces %~ map (map $ first tran)
|
|
where
|
|
tran (a,b,c) = (a+x,b+y,c)
|
|
|
|
rotateXY :: Float -> Polyhedra -> Polyhedra
|
|
rotateXY a = over pyFaces $ map $ map $ first $ rotate3 a
|
|
|
|
-- Another representation of polyhedra is as a list of edges.
|
|
-- Each edge is a tuple containing four points: the first two are the two edge
|
|
-- coordinates, the last two being the normals of two planes of the polyhedra
|
|
-- that the edge connects.
|
|
--, _pyEdges :: [(Point3,Point3,Point3,Point3)]
|
|
|
|
constructEdges :: [[Point3]] -> [(Point3,Point3,Point3,Point3)]
|
|
constructEdges (face:faces) = mapMaybe (findReverseEdge otherEdges) (faceEdges face)
|
|
++ constructEdges faces
|
|
where
|
|
otherEdges = concatMap faceEdges faces
|
|
constructEdges _ = []
|
|
|
|
findReverseEdge
|
|
:: [(Point3,Point3,Point3)]
|
|
-> (Point3,Point3,Point3)
|
|
-> Maybe (Point3,Point3,Point3,Point3)
|
|
findReverseEdge otherEdges (x,y,z) = (\(_,_,n) -> (x,y,z,n))
|
|
<$> find (\(a,b,_) -> (x,y) == (b,a)) otherEdges
|
|
|
|
faceEdges :: [Point3] -> [(Point3,Point3,Point3)]
|
|
faceEdges xs = zipWith addNormal xs (tail xs ++ [head xs])
|
|
where
|
|
addNormal x y = (x,y,n)
|
|
(a:b:c:_) = xs
|
|
n = crossProd (b -.-.- a) (c -.-.- a)
|
|
|
|
rhombus :: Point3 -> Point3 -> [Point3]
|
|
rhombus a b =
|
|
[(0,0,0)
|
|
,a
|
|
,a +.+.+ b
|
|
,b
|
|
]
|
|
|
|
boxXYZ :: Float -> Float -> Float -> [[Point3]]
|
|
boxXYZ x y z =
|
|
[ bottomFace
|
|
, map (+.+.+ (0,0,z)) $ reverse bottomFace
|
|
, frontFace
|
|
, map (+.+.+ (0,y,0)) $ reverse frontFace
|
|
, sideFace
|
|
, map (+.+.+ (x,0,0)) $ reverse sideFace
|
|
]
|
|
where
|
|
bottomFace = rhombus (0,y,0) (x,0,0)
|
|
frontFace = rhombus (x,0,0) (0,0,z)
|
|
sideFace = rhombus (0,0,z) (0,y,0)
|
|
boxABC :: Point3 -> Point3 -> Point3 -> [[Point3]]
|
|
boxABC a b c =
|
|
[ faceNC
|
|
, map (+.+.+ c) $ reverse faceNC
|
|
, faceNB
|
|
, map (+.+.+ b) $ reverse faceNB
|
|
, faceNA
|
|
, map (+.+.+ a) $ reverse faceNA
|
|
]
|
|
where
|
|
faceNC = rhombus b a
|
|
faceNB = rhombus a c
|
|
faceNA = rhombus c b
|
|
|
|
polyToPics :: Polyhedra -> [Picture]
|
|
polyToPics = map helpPoly3D . _pyFaces
|
|
|
|
helpPoly3D vs = zl $ RenderPoly $ polyToTris vs
|
|
where
|
|
zl :: RenderType -> [(Int,RenderType)]
|
|
zl rt = [(0,rt)]
|
|
|
|
polysToPic :: [Polyhedra] -> Picture
|
|
polysToPic = pictures . concatMap polyToPics
|
|
|
|
polyToEdges :: Polyhedra -> [(Point3,Point3,Point3,Point3)]
|
|
polyToEdges = constructEdges . map (map fst) . _pyFaces
|
|
|
|
-- rendering for silhouette
|
|
polyToRender :: Polyhedra -> [RenderType]
|
|
polyToRender = map (Render3 . flat4) . polyToEdges
|
|
-- rendering for shape
|
|
polyToGeoRender :: Polyhedra -> [RenderType]
|
|
polyToGeoRender = map (Render3 . polyToTris . map fst) . _pyFaces
|