75 lines
1.7 KiB
Haskell
75 lines
1.7 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module ShapePicture
|
|
( module ShapePicture.Data
|
|
, translateSP
|
|
, translateSPf
|
|
, translateSPz
|
|
, rotateSP
|
|
, noPic
|
|
, noShape
|
|
-- , _spShape
|
|
-- , _spPicture
|
|
, mirrorSPyz
|
|
, mirrorSPxz
|
|
, overPosSP
|
|
) where
|
|
import ShapePicture.Data
|
|
import Shape
|
|
import Picture
|
|
import Geometry
|
|
|
|
import Data.Bifunctor
|
|
import Control.Lens
|
|
|
|
shMap :: (ShapeObj -> ShapeObj) -> Shape -> Shape
|
|
shMap = map
|
|
|
|
-- should all this be inlined/inlinable?
|
|
noPic :: Shape -> SPic
|
|
{-# INLINE noPic #-}
|
|
noPic = (,mempty)
|
|
|
|
noShape :: Picture -> SPic
|
|
{-# INLINE noShape #-}
|
|
noShape = (mempty,)
|
|
|
|
--_spShape :: SPic -> Shape
|
|
--_spShape = fst
|
|
--_spPicture :: SPic -> Picture
|
|
--_spPicture = snd
|
|
|
|
--emptyBlank :: SPic
|
|
--emptyBlank = mempty
|
|
|
|
overPosSP :: (Point3 -> Point3) -> SPic -> SPic
|
|
{-# INLINE overPosSP #-}
|
|
overPosSP f = bimap (overPosSH f) (picMap $ overPos f)
|
|
|
|
translateSPf :: Float -> Float -> SPic -> SPic
|
|
{-# INLINE translateSPf #-}
|
|
translateSPf x y = bimap (translateSH (V3 x y 0)) (translate x y)
|
|
|
|
translateSPz :: Float -> SPic -> SPic
|
|
{-# INLINE translateSPz #-}
|
|
translateSPz z = bimap (translateSH (V3 0 0 z)) (translate3 (V3 0 0 z))
|
|
|
|
translateSP :: Point3 -> SPic -> SPic
|
|
{-# INLINE translateSP #-}
|
|
translateSP v = bimap (translateSH v) (translate3 v)
|
|
|
|
rotateSP :: Float -> SPic -> SPic
|
|
{-# INLINE rotateSP #-}
|
|
rotateSP a = bimap (rotateSH a) (rotate a)
|
|
|
|
mirrorSPxz :: SPic -> SPic
|
|
{-# INLINE mirrorSPxz #-}
|
|
mirrorSPxz = bimap (shMap (over shVs reverse) . overPosSH flipy) mirrorxz
|
|
where
|
|
flipy (V3 x y z) = V3 x (negate y) z
|
|
|
|
mirrorSPyz :: SPic -> SPic
|
|
{-# INLINE mirrorSPyz #-}
|
|
mirrorSPyz = bimap (shMap (over shVs reverse) . overPosSH flipx) mirroryz
|
|
where
|
|
flipx (V3 x y z) = V3 (negate x) y z
|