Files
loop/src/ShapePicture.hs
T
2022-05-23 15:50:49 +01:00

60 lines
1.2 KiB
Haskell

{-# LANGUAGE TupleSections #-}
module ShapePicture
( emptyBlank
, translateSP
, translateSPf
, translateSPz
, rotateSP
, SPic
, noPic
, noShape
, _spShape
, _spPicture
, mirrorSPyz
, mirrorSPxz
) where
import Shape
import Picture
import Geometry
import Data.Bifunctor
type SPic = (Shape, Picture)
-- should all this be inlined/inlinable?
noPic :: Shape -> SPic
noPic = (,mempty)
noShape :: Picture -> SPic
noShape = (mempty,)
_spShape :: SPic -> Shape
_spShape = fst
_spPicture :: SPic -> Picture
_spPicture = snd
emptyBlank :: SPic
emptyBlank = mempty
translateSPf :: Float -> Float -> SPic -> SPic
translateSPf x y = bimap (translateSH (V3 x y 0)) (translate x y)
translateSPz :: Float -> SPic -> SPic
translateSPz z = bimap (translateSH (V3 0 0 z)) (translate3 (V3 0 0 z))
translateSP :: Point3 -> SPic -> SPic
translateSP v = bimap (translateSH v) (translate3 v)
rotateSP :: Float -> SPic -> SPic
rotateSP a = bimap (rotateSH a) (rotate a)
mirrorSPxz :: SPic -> SPic
mirrorSPxz = bimap (reverse . overPosSH flipy) mirrorxz
where
flipy (V3 x y z) = V3 x (negate y) z
mirrorSPyz :: SPic -> SPic
mirrorSPyz = bimap (reverse . overPosSH flipx) mirroryz
where
flipx (V3 x y z) = V3 (negate x) y z