{-# 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