{-# LANGUAGE OverloadedStrings #-}
module Waldo.Script (
    Script(..)
  , PanelSizes, PanelData(..), Panel(..)
  , ImagePart(..)
  , TextPart(..)
  , Pos(..)
  , loadImagePanels, mkScript, scriptName
  ) where

import Data.List
import Control.Monad
import Control.Monad.Reader
import qualified Data.Text as T
import qualified Data.Aeson as JS
import qualified Data.ByteString.Lazy.Char8 as BSL8
import Control.Monad.Trans.Resource (runResourceT)
import Data.Conduit (($$))
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.ImageSize as CI
import System.FilePath ((</>), takeFileName, splitExtension)
import System.FilePath.Glob
import Data.Digest.Pure.SHA
import Control.DeepSeq
import System.Directory

import Data.Aeson ((.=))

pad :: Int
pad = 4

panelRightEdge :: Panel -> Int
panelRightEdge p = (pX $ pPos p) + (pWidth p)

scriptName :: Script -> T.Text
scriptName (s@Script {}) = T.concat $ [sName s, " : "] ++ (intersperse "+" $ map pName (sPanels s))
scriptName (ScriptTo goto) = T.concat ["Goto : ", goto]

mkScript :: T.Text -- name
         -> T.Text -- alt-text
         -> [PanelData] -- panels!
         -> Script
mkScript nm alt pds =
  let ps = snd $ mapAccumL (\xstart p ->
                             let newp = panelData2panel xstart p
                             in (panelRightEdge newp, newp)) 0 pds
  in Script {
     sAltText = alt
   , sPanels  = ps
   , sHeight  = 2*pad + (maximum $ map pHeight ps)
   , sWidth   = (1+length ps)*pad + (sum $ map pWidth ps)
   , sName    = nm
   }

hashImgNm :: FilePath -> FilePath
hashImgNm fn =
  let (nm, typ) = splitExtension fn
  in (showDigest $ sha256 (BSL8.pack ("basfd" ++ nm)))++typ

loadImagePanels :: Int -- Story
                -> Int -- Panel
                -> Int -- Choice
                -> ReaderT FilePath IO PanelSizes
loadImagePanels s p c = do
  bp <- ask
  fns <- liftIO $ glob (bp </> "panels" </>
                       ("a1_"++show s++"p"++show p++"s*_"++show c++".*"))
  ps <- liftIO $ forM fns $ \fn -> do
    mImgInf <- runResourceT $ CB.sourceFile fn $$ CI.sinkImageSize
    case mImgInf of
      Nothing -> fail "Couldn't read image."
      Just sz -> do
        let pname = hashImgNm $ takeFileName fn
        d <- BSL8.readFile fn
        createDirectoryIfMissing False "/tmp/loadedPanels"
        BSL8.writeFile ("/tmp/loadedPanels" </> pname) d
        return $
          PanelData {
              pdWidth  = CI.width sz
            , pdHeight = CI.height sz
            , pdImages = [ImagePart { ipPos = Pos 0 0, ipImageUrl = T.pack pname }]
            , pdText   = []
            , pdName   = T.pack ("p"++show p++"s"++show s++"_"++show c)
            }
  if null ps
    then fail ("No panels found for "++show (s, p, c))
    else return ps

panelData2panel :: Int -> PanelData -> Panel
panelData2panel xlast pd = 
  Panel {
      pPos     = Pos (xlast+pad) pad
    , pWidth  = pdWidth  pd
    , pHeight = pdHeight pd
    , pImages = pdImages pd
    , pText   = pdText   pd
    , pName   = pdName pd
    }

type PanelSizes = [PanelData]

data Script =
    ScriptTo {
        sTarget :: !T.Text
      }
  | Script {
      sWidth   :: !Int
    , sHeight  :: !Int
    , sAltText :: !T.Text
    , sPanels  :: [Panel]
    , sName :: !T.Text
    }
  deriving (Eq, Ord, Show)

instance NFData Script where
  rnf (s@ScriptTo {sTarget=t}) = t `seq` s `seq` ()
  rnf (s@Script {sWidth=w, sHeight=h, sAltText=a, sPanels=p, sName=n}) =
    w `seq` h `seq` a `deepseq` p `deepseq` n `deepseq` s `seq` ()

data Panel = Panel {
    pPos    :: !Pos
  , pWidth  :: !Int
  , pHeight :: !Int
  , pImages :: [ImagePart]
  , pText   :: [TextPart]
  , pName   :: !T.Text
  } deriving (Eq, Ord, Show)

instance NFData Panel where
  rnf (pan@Panel {pPos=p, pWidth=w, pHeight=h, pImages=i, pText=t, pName=n}) =
    p `deepseq` w `seq` h `seq` i `deepseq` t `deepseq` n `deepseq` pan `seq` ()

data PanelData = PanelData {
    pdWidth  :: !Int
  , pdHeight :: !Int
  , pdImages :: [ImagePart]
  , pdText   :: [TextPart]
  , pdName   :: !T.Text
  } deriving (Eq, Ord, Show)

data ImagePart = ImagePart {
    ipPos      :: !Pos
  , ipImageUrl :: !T.Text
  } deriving (Eq, Ord, Show)

instance NFData ImagePart where
  rnf (i@ImagePart {ipPos=p, ipImageUrl=u}) =
    p `deepseq` u `deepseq` i `seq` ()

data TextPart = TextPart {
    tpPos    :: !Pos
  , tpString :: !T.Text
  , tpSize   :: !Float
  , tpFont   :: !T.Text
  , tpAngle  :: !Float
  } deriving (Eq, Ord, Show)

instance NFData TextPart where
  rnf (tp@TextPart {tpPos=p, tpString=t, tpSize=s, tpFont=f, tpAngle=a}) = 
    p `deepseq` t `deepseq` s `seq` f `deepseq` a `seq` tp `seq` ()

data Pos = Pos { pX :: !Int, pY :: !Int } deriving (Eq, Ord, Show)

instance NFData Pos where
  rnf (p@Pos {pX=x, pY=y}) = x `seq` y `seq` p `seq` ()

instance JS.ToJSON Script where
  toJSON (ScriptTo t) = JS.object ["goto" .= t]
  toJSON (Script w h alt ps _) = JS.object [ "width" .= w
                                           , "height" .= h
                                           , "alttext" .= alt
                                           , "panels" .= ps
                                           ]

instance JS.ToJSON Panel where
  toJSON (Panel p w h is ts _) = JS.object [ "pos" .= p
                                           , "width" .= w
                                           , "height" .= h
                                           , "images" .= is
                                           , "texts" .= ts
                                           ]

instance JS.ToJSON ImagePart where
  toJSON (ImagePart p url) = JS.object [ "pos" .= p, "url" .= url ]

instance JS.ToJSON TextPart where
  toJSON (TextPart p str sz f r) = JS.object [ "pos" .= p
                                             , "str" .= str
                                             , "size" .= sz
                                             , "font" .= f
                                             , "rad" .= r
                                             ]

instance JS.ToJSON Pos where
  toJSON (Pos x y) = JS.object [ "x" .= x, "y" .= y ]