{-# LANGUAGE FlexibleContexts #-}
module OpenSCAD.Carpentry
(
  place
, placeColored
, placeAlong
, placeTransformed
, at
, spreadEvenly
, v3box
, v3translate
, writeTempSCAD
, openTempSCAD
, assemble
, component
  ) where

import           Control.Applicative
import           Control.Lens        hiding (at)
import           Graphics.OpenSCAD
import           Linear.V3
import           System.IO.Temp
import           System.Process
import           Data.List
import           Data.Functor
import           Data.Maybe
import           Data.Either

v3box :: R3 t => t Double -> Model3d
v3box v = box (v ^. _x) (v ^. _y) (v ^. _z)

v3translate :: (Vector (c, c, c), R3 t) => t c -> Model (c, c, c) -> Model (c, c, c)
v3translate v m = translate (v ^. _x, v ^. _y, v ^. _z) m
--  ^ doesn't work ??

place :: (R3 t1, R3 t2) => t2 Double -> [t1 Double] -> [Model (Double, Double, Double)]
place board coords = map (placeOne board) coords
  where
    boardAt p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board
--    boardAt p = v3translate p $ v3box board

placeOne b c = translate (c ^. _x, c ^. _y, c ^. _z) $ v3box b

placeTransformed t r = t $ place r

-- intended usage: place (V3 2 4 16) $ at [0] [0,4..(20*12)] [0]
-- (which would, e.g., place 2x4 planks next to each other for 20 feet (e.g., floor boards)
at :: Applicative f => f a -> f a -> f a -> f (V3 a)
at = liftA3 V3
--at x y z = V3 <$> x <*> y <*> z -- same as above

placeColored rgb board coords = map boardAt coords
  where
    boardAt p = color rgb $ translate (p ^. _x, p ^. _y, p ^. _z) $ v3box board

-- deprecated due to the superiority of using place in conjunction with at
-- placeAlong (V3 2 4 16) (V3 0 0 0) (_x +~ 4) _x (<= 20)
placeAlong ::
  (R3 t1, R3 t2) =>
  t2 Double
  -> t1 Double
  -> (t1 Double -> t1 Double)
  -> ((t -> Const t t) -> t1 Double -> Const t (t1 Double))
  -> (t -> Bool)
  -> [Model (Double, Double, Double)]
placeAlong board initial shift targ cond =
  place board positions
  where positions =
          let next x =
                let p = x & shift
                in if cond (p ^. targ)
                   then p : next p
                   else []
          in initial : next initial



-- data CarpentryProject = CarpentryProject
--   {   dimensions :: V3 Double
--     , components :: [ProjectCompnent]
--   } deriving (Show)

-- data Component = Component {
--     name :: String,
--   , dim :: V3 Double
--   , orient :: 
--                            }
-- assemble
-- assemble [   component "shelves" (V3 1 8 36) _xyz $ at [0] [0,12,24,36] [0]
--            , component "sides" (V3 1 8 40) _xyz $ at [0] [0,36] [0] ]

assemble c = (cutlist, model)
  where
    model = concatMap (\(_, b, o, p) -> place (b ^. o) p) c
    cutlist = putStrLn $ intercalate "\n" $ map tocut c
    tocut (n, b, _, p) = n ++ " (" ++ (show $ length p) ++ ") @ " ++ v3toStr b
    v3toStr c = show (c ^. _x) ++ " x " ++ show (c ^. _y) ++ " x " ++ show (c ^. _z)

-- assemble' c = (cutlist, model)
--   where
--     model = let placeBoard b p = translate (p ^. _x, p ^. _y, p ^. _z) $ v3box b
--       in concatMap (\(_, b, o, p, tf) placeBoard 
--       boardAt p = 
component name dim orient pos = (name, dim, orient, pos)

-- ass :: 
-- ass v = show v

-- maybeMore :: Either a [a]
-- maybeMore x = either [x] x x

-- count :: Either a0 [a1] -> Int
-- count (Left a) = length [a]
-- count (Right b) = length b

-- maybeMore :: Maybe [a] -> [a]
-- maybeMore x = [x]
-- maybeMore [x] = [x]

-- maybeMore :: Maybe [a] -> [a]
-- maybeMore x = fromMaybe



-- data Many = Left [a] | Right b
-- maybeMany :: Many -> Int
-- maybeMany Left x = x
-- maybeMany Right x = [x]

-- data AlwaysMany = FromOne a | AlreadyMany [a]
-- alwaysMany (FromOne x) = [x]
-- alwaysMany (AlreadyMany x) = x

-- data AlwaysMany a b = Left a | Right b
-- data Many a = Either [a]

-- alwaysMany :: Many a -> Int
-- alwaysMany (Right x) = x

-- type OnceOne a = [a]
-- type AlreadyMany a = [a]
-- data AlwaysMany a = OnceOne a | AlreadyMany a deriving (Foldable, Eq, Ord)

-- alwaysMany :: AlwaysMany a -> Int
-- alwaysMany x = length x


-- data AlwaysMany a = Maybe [a] | Just [a]
-- alwaysMany :: AlwaysMany a -> [a]
-- alwaysMany x = x


-- count x
-- --  where y = if isLeft x then [x] else x
--   | isLeft x = length [x]
--   | otherwise = length x

-- which :: Either String Int -> String
-- which x = either show show x
-- which Left x = "string"
-- which Right x = "int"


-- evenly spread <boardCount> number of boards (of the width <boardWidth>) in <span> space
-- e.g., if you want to have a 20x20 space and want support beams every 16":
-- spreadEvenly 2 20 (20*12/16)
spreadEvenly boardWidth fillSpace boardCount =
  let dist = (fillSpace - boardWidth) / fromIntegral (boardCount - 1)
  in take boardCount $ iterate (+dist) 0

writeTempSCAD :: String -> IO FilePath
writeTempSCAD scadstr = writeSystemTempFile "genscad.scad" scadstr

openTempSCAD :: String -> IO ProcessHandle
openTempSCAD scadstr = do
  fp <- writeTempSCAD scadstr
  runCommand $ "openscad " ++ fp