74 lines
1.7 KiB
Haskell
74 lines
1.7 KiB
Haskell
module ShapePicture
|
|
( module ShapePicture.Data
|
|
, translateSP
|
|
, translateSPxy
|
|
, translateSPz
|
|
, rotateSP
|
|
, noPic
|
|
, noShape
|
|
-- , _spShape
|
|
-- , _spPicture
|
|
-- , mirrorSPyz
|
|
-- , mirrorSPxz
|
|
, overPosSP
|
|
) where
|
|
|
|
import ShapePicture.Data
|
|
import Shape
|
|
import Picture
|
|
import Geometry
|
|
import Data.Strict.Tuple
|
|
import Data.Bifunctor
|
|
--import Control.Lens
|
|
|
|
-- 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)
|
|
|
|
translateSPxy :: Float -> Float -> SPic -> SPic
|
|
{-# INLINE translateSPxy #-}
|
|
translateSPxy x y = translateSP (V3 x y 0)
|
|
|
|
translateSPz :: Float -> SPic -> SPic
|
|
{-# INLINE translateSPz #-}
|
|
translateSPz z = translateSP (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)
|
|
|
|
-- Be careful when mirroring: remember the first vertices may indicate the
|
|
-- center of the object or other guides
|
|
--mirrorSPxz :: SPic -> SPic
|
|
--{-# INLINE mirrorSPxz #-}
|
|
--mirrorSPxz = bimap (map (over sfVs reverse) . overPosSH flipy) mirrorxz
|
|
-- where
|
|
-- flipy (V3 x y z) = V3 x (negate y) z
|
|
--
|
|
--mirrorSPyz :: SPic -> SPic
|
|
--{-# INLINE mirrorSPyz #-}
|
|
--mirrorSPyz = bimap (map (over sfVs reverse) . overPosSH flipx) mirroryz
|
|
-- where
|
|
-- flipx (V3 x y z) = V3 (negate x) y z
|