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

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

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 c board coords = map boardAt coords
  where
    boardAt p = color c $ 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 :: [(String, String, V3 Double,
         (V3 Double -> Const (V3 Double) (V3 Double))
         -> V3 Double -> Const (V3 Double) (V3 Double),
         [V3 Double])] -> (String, [Model3d])
assemble c = (cutlist, model)
  where
    model = concatMap (\(_, c, b, o, p) -> placeColored (safeColor c) (b ^. o) p) c
    safeColor :: String -> Colour Double
    safeColor = runIdentity . readColourName
    cutlist = intercalate "\n" $ map tocut c
    tocut (n, c, b, _, p) = n ++ " (" ++ show (length p) ++ ", " ++ c ++ ") @ " ++ v3toStr b
    v3toStr c = show (c ^. _x) ++ " x " ++ show (c ^. _y) ++ " x " ++ show (c ^. _z)

--component :: a -> b -> c -> d -> e -> (a, b, c, d, e)
--component :: a -> b -> c -> d -> e -> (a, b, c, d, e)
-- component :: String
--           -> String
--           -> V3 Double
--           -> ((f -> Const f f) -> V3 Double -> Const f (V3 Double))
--           -> [V3 Double]
--           -> (String, String, V3 Double,
--                (f -> Const f f) ->
--                V3 Double -> Const f (V3 Double), [V3 Double], f)

-- c :: ([Char], [Char], V3 Integer,
--       (V3 a -> ghc-prim-0.5.3:GHC.Types.Any (V3 a))
--       -> ghc-prim-0.5.3:GHC.Types.Any a
--       -> ghc-prim-0.5.3:GHC.Types.Any (ghc-prim-0.5.3:GHC.Types.Any a),
--       [V3 Integer])
-- component :: (String, String, V3 Double,
--                (V3 Double -> Const (V3 Double) (V3 Double))
--                 -> V3 Double -> Const (V3 Double) (V3 Double), [V3 Double])
-- component :: String -> String, V3 Integer,
--       (V3 Integer -> Const (V3 Integer) (V3 Integer))
--       -> V3 Integer -> Const (V3 Integer) (V3 Integer),
--       [V3 Integer])
--component name col dim orient pos = (name, col, dim, orient, pos, dim ^. orient)

--component name col dim orient pos = (name, col, dim, orient, pos, dim ^. orient)
component
  :: String
     -> String
     -> V3 Double
     -> ((V3 Double -> Const (V3 Double) (V3 Double))
         -> V3 Double -> Const (V3 Double) (V3 Double))
     -> [V3 Double]
     -> (String, String, V3 Double,
         (V3 Double -> Const (V3 Double) (V3 Double))
         -> V3 Double -> Const (V3 Double) (V3 Double),
         [V3 Double])
component name col dim orient pos = (name, col, dim, orient, pos)
--component name col dim orient pos = (name :: String, col :: String, dim :: V3 Double, orient, pos :: [V3 Double])

ass = assemble [component "shelves" "neh" (V3 1 8 36) _xyz [V3 0 0 0, V3 0 0 10] ]



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