module Wett13 where

--import Transform
import Data.List
import Data.Maybe
import System.IO
import System.Process

data Transform = Transform {
   rotate :: Double ,
   scale :: ( Double , Double ) ,
   translate :: ( Double , Double )
} deriving (Show)

data Object = Ellipse ID RX RY Transform | Rectangle ID W H Fill Transform | Group ID Fill [Object] Transform | Path Fill Op D | Use ID Ref Fill Transform | Pattern ID X Y W H [Object] Transform deriving (Show)
type ID = String
type RX = String
type RY = String
type W = String
type H = String
type Fill = String
type Op = String
type D = String
type Ref = String
type X = String
type Y = String

toPretty :: String -> [(String,[String])]
toPretty x = let xs = (groupBy (\a b -> (isPrefixOf "group" a) && ((not (isPrefixOf "group" b)) && (not (isPrefixOf "pattern" b))) || (isPrefixOf "pattern" a) && ((not (isPrefixOf "group" b)) && (not (isPrefixOf "pattern" b))) ) (lines x)) in map (\y -> curry (id) (head y) (tail y)) xs

toObjectList :: [String] -> [Object]
toObjectList [] = []
toObjectList (x:ys) = let xs = words x in case (head xs) of
                                "ellipse" -> (Ellipse (xs !! 1) (xs !! 2) (xs !! 3) (Transform {rotate=0, scale=(1,1), translate=(0,0)})):(toObjectList ys)
                                "rectangle" -> (Rectangle (xs !! 1) (xs !! 2) (xs !! 3) (if (length xs) >= 5 then (xs !! 4) else "") (Transform {rotate=0, scale=(1,1), translate=(0,0)})):(toObjectList ys)
                                "path" -> (Path (xs !! 1) (xs !! 2) (unwords (drop 3 xs))):(toObjectList ys)
                                "use" -> (Use (xs !! 1) (xs !! 2) (if (length xs) >= 4 then (xs !! 3) else "") (Transform {rotate=0, scale=(1,1), translate=(0,0)})):(toObjectList ys)

toObjects :: [(String,[String])] -> [Object]
toObjects [] = []
toObjects ((x1,x2):ys) = let xs = words x1 in case (head xs) of
                           "group" -> (Group (init (xs !! 1)) (if (length xs) >= 3 then (xs !! 2) else "") (toObjectList x2) (Transform {rotate=0, scale=(1,1), translate=(0,0)})):(toObjects ys)
                           "ellipse" -> (Ellipse (xs !! 1) (xs !! 2) (xs !! 3) (Transform {rotate=0, scale=(1,1), translate=(0,0)})):(toObjects ys)
                           "rectangle" -> (Rectangle (xs !! 1) (xs !! 2) (xs !! 3) (if (length xs) >= 5 then (xs !! 4) else "") (Transform {rotate=0, scale=(1,1), translate=(0,0)})):(toObjects ys)
                           "path" -> (Path (xs !! 1) (xs !! 2) (unwords (drop 3 xs))):(toObjects ys)
                           "use" -> (Use (xs !! 1) (xs !! 2) (if (length xs) >= 4 then (xs !! 3) else "") (Transform {rotate=0, scale=(1,1), translate=(0,0)})):(toObjects ys)
                           "pattern" -> (Pattern (xs !! 1) (xs !! 2) (xs !! 3) (xs !! 4) (xs !! 5) (toObjectList x2) (Transform {rotate=0, scale=(1,1), translate=(0,0)})):(toObjects ys)

applyF :: String -> (Transform -> Transform) -> [Object] -> [Object]
applyF i f [] = []
applyF i f (x:xs) = case x of
                      (Group id fill ys t) -> if i == id then (Group id fill (applyF i f ys) (f t)):(applyF i f xs) else (Group id fill (applyF i f ys) t):(applyF i f xs)
                      (Ellipse id rx ry t) -> if i == id then (Ellipse id rx ry (f t)):(applyF i f xs) else x:(applyF i f xs)
                      (Rectangle id w h fi t) -> if i == id then (Rectangle id w h fi (f t)):(applyF i f xs) else x:(applyF i f xs)
                      (Use id ref fi t) -> if i == id then (Use id ref fi (f t)):(applyF i f xs) else x:(applyF i f xs)
                      _ -> x:(applyF i f xs)


createSVG :: String -> String -> String -> String -> String -> String
createSVG x a b c d = "<svg viewBox=\""++a++" "++b++" "++c++" "++d++"\" xmlns=\"http://www.w3.org/2000/svg\">\n" ++ x ++ "</svg>\n"

animate :: [(String, Transform -> Transform)] -> String -> [String] 
animate ts x = (paint x):(drawMore ts (toObjects (toPretty x)))
                 where drawMore [] ys = []
                       drawMore ((i,f):zs) ys = let n = (applyF i f ys) in (createSVG (transform n) "-50" "-50" "100" "100"):(drawMore zs n)
                       transform [] = ""
                       transform (y:ys) = case y of
                                       (Group id fi es t) -> "<g id=\""++ id ++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++">\n"++(transElems es)++"</g>\n"++(transform ys)
                                       (Pattern id xv yv w h es t) -> "<pattern id=\""++id++"\" x=\""++xv++"\" y=\""++yv++"\" width=\""++ w ++"\" height=\""++h++"\" patternUnits=\"userSpaceOnUse\" "++(paintT t)++">\n"++(transElems es)++"</pattern>\n"++(transform ys)
                                       _ -> (transElems [y]) ++ (transform ys)
                       transElems [] = ""
                       transElems (y:ys) = case y of
                                        (Ellipse id rx ry t) -> "<ellipse id=\""++ id ++"\" rx=\""++ rx ++"\" ry=\""++ ry ++"\" "++(paintT t)++"/>\n" ++ (transElems ys)
                                        (Rectangle id w h fi t) -> "<rect id=\""++ id ++"\" width=\""++ w ++"\" height=\""++ h ++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++"/>\n" ++ (transElems ys)
                                        (Path fi op d) -> "<path fill=\""++fi++"\" fill-opacity=\""++op++"\" d=\""++d++"\"/>\n"++(transElems ys)
                                        (Use id ref fi t) -> "<use id=\""++id++"\" xlink:href=\"#"++ref++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++"/>\n" ++ (transElems ys)
                       paintT (Transform{rotate=r, scale=s, translate=t}) =  "transform=\"rotate("++(show r)++") scale("++(show (fst s))++" "++(show (snd s))++") translate("++(show (fst t))++" "++(show (snd t))++")\""

paint :: String -> String
paint x = let os = (toObjects (toPretty x)) in (createSVG (transform os) "-50" "-50" "100" "100")
            where transform [] = ""
                  transform (y:ys) = case y of
                                       (Group id fi es t) -> "<g id=\""++ id ++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++">\n"++(transElems es)++"</g>\n"++(transform ys)
                                       (Pattern id xv yv w h es t) -> "<pattern id=\""++id++"\" x=\""++xv++"\" y=\""++yv++"\" width=\""++ w ++"\" height=\""++h++"\" patternUnits=\"userSpaceOnUse\" "++(paintT t)++">\n"++(transElems es)++"</pattern>\n"++(transform ys)
                                       _ -> (transElems [y]) ++ (transform ys)
                  transElems [] = ""
                  transElems (y:ys) = case y of
                                        (Ellipse id rx ry t) -> "<ellipse id=\""++ id ++"\" rx=\""++ rx ++"\" ry=\""++ ry ++"\" "++(paintT t)++"/>\n" ++ (transElems ys)
                                        (Rectangle id w h fi t) -> "<rect id=\""++ id ++"\" width=\""++ w ++"\" height=\""++ h ++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++"/>\n" ++ (transElems ys)
                                        (Path fi op d) -> "<path fill=\""++fi++"\" fill-opacity=\""++op++"\" d=\""++d++"\"/>\n"++(transElems ys)
                                        (Use id ref fi t) -> "<use id=\""++id++"\" xlink:href=\"#"++ref++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++"/>\n" ++ (transElems ys)
                  paintT (Transform{rotate=r, scale=s, translate=t}) =  "transform=\"rotate("++(show r)++") scale("++(show (fst s))++" "++(show (snd s))++") translate("++(show (fst t))++" "++(show (snd t))++")\""


{-WETT-}
-- Add any code that generates images or videos between these tags
-- Please also include instructions on how to invoke your code
-- If you need libraries that are not available on the testserver, send your submission to fpv@in.tum.de

{--
I decided to build and animate the Unity 2019 logo.
The Unity is a huge party hosted by the stundent council of Mathematics,Physics,Informatics in cooperation with the student council of chemistry.

Since the logo is a pre-formed graphic, it uses an input file where the kind of the blocks as well as their rotation and positions are defined. The movement of the blocks and how far they actually have to fall are then automatically generated and applied to the previous list of objects, like in the homework.
Because of my laptop being really slow, the code only processes the converting of the pictures file by file, so it takes some time to get the result.

Use 
genUnityAnim "input.unity19" "svgs/"
to generate the svgs, as well as the mp4 and gif.

The Unity will also take place this year on the 14th of Mai. There might be certain specials planned this year for the Unity's 10th birthday. So save the date and go out with your friends! Or even help out, getting in for free and get vouchers for your shift. When opened, you will be able to register on https://helfen.fs.tum.de
--}

-- genDefObjects defines the definitions in the top of the svg creating multiple groups and moving its' elements to the right positions.
genDefObjects :: [Object]
genDefObjects = let pre = "group b:\nrectangle b1 24 24\npath #000 .3 m0,0 3,3 18,0 3,-3\npath #000 .2 m0,0 3,3 0,18 -3,3 m24,-24 -3,3 0,18 3,3\npath #000 .3 m0,24 3,-3 18,0 3,3\npattern bgp 0 0 24 24\nuse bg0 b #1A1A1A\ngroup l: #00FFFF\nuse 0000 b\nuse 2400 b\nuse 4800 b\nuse 7200 b\ngroup q: #f0f000\nuse 0000 b\nuse 2400 b\nuse 0024 b\nuse 2424 b\ngroup p: #a000f0\nuse 0000 b\nuse 0024 b\nuse 0048 b\nuse 2424 b\ngroup o: #FF7F00\nuse 0000 b\nuse 0024 b\nuse 0048 b\nuse 2448 b\ngroup d: #0000f0\nuse 0048 b\nuse 2400 b\nuse 2424 b\nuse 2448 b\ngroup r: #f00000\nuse 0000 b\nuse 0024 b\nuse 2424 b\nuse 2448 b\ngroup g: #00f000\nuse 2400 b\nuse 2424 b\nuse 0024 b\nuse 0048 b\ngroup s: #0000f0\nuse 0000 b\nuse 0024 b\nuse 0048 b\nuse 2448 b\ngroup bg:\nrectangle bg2 456 576 url(#bgp)";mapTranslateSet f (Transform{rotate=r, scale=s, translate=t}) = (Transform{rotate=r, scale=s, translate=(f t)}) in applyFL (toObjects (toPretty pre)) (map (\y -> (y, (mapTranslateSet (\(t1, t2) -> (((read $ fst (splitAt 2 y)) :: Double),(read $ snd (splitAt 2 y)) :: Double))))) ["0000","2400","4800","7200","0024","2424","4824","0048","2448"])

-- genUnitySVG takes an input string (file to read the colored blocks,their rotation and their location from in a custom format) as well as a string describing the output path of the svg. Using paintUnity to actually write the file and its' contents.  
genUnitySVG :: String -> String -> IO ()
genUnitySVG x ou = do ya <- (readFile x)
                      let y = (lines ya) in paintUnity (makeTetris y 0) ou
                          where calcTrans zo = case (head zo) of
                                                  "l" -> if (zo !! 1) == "90" then (((read (zo !! 2) :: Double) * 24 + 24), ((read (zo !! 3) :: Double) * 24)) else (((read (zo !! 2) :: Double) * 24),((read (zo !! 3) :: Double) * 24))
                                                  "q" -> (((read (zo !! 2) :: Double) * 24),((read (zo !! 3) :: Double) * 24))
                                                  _ -> case (zo !! 1) of 
                                                         "90" -> (((read (zo !! 2) :: Double) * 24 + 72),((read (zo !! 3) :: Double) * 24))
                                                         "180" -> (((read (zo !! 2) :: Double) * 24 + 48),((read (zo !! 3) :: Double) * 24 + 72))
                                                         "270" -> (((read (zo !! 2) :: Double) * 24),((read (zo !! 3) :: Double) * 24 + 48))
                                                         _ -> (((read (zo !! 2) :: Double) * 24),((read (zo !! 3) :: Double) * 24))
                                makeTetris [] _ = []
                                makeTetris (z:zs) i = let zo = words z in (Use (show i) (head zo) "" (Transform {rotate=(read (zo !! 1) :: Double), scale=(1,1), translate=(calcTrans zo)})):(makeTetris zs (i+1))

-- This function takes an input string (file to read the colored blocks,their rotation and their location from in a custom format) as well as a string describing the output folder for the svgs. Using paintUnity to actually write the file and its' contents. It then converts all svgs to jpegs and those to a MP4 and a GIF 
genUnityAnim :: String -> String -> IO ()
genUnityAnim x ou = do ya <- (readFile x)
                       let y = (lines ya); funOb = (unzip $ makeTetris y 0) in do drawMany (fst funOb) (concat $ snd funOb) 0 ou; convertJpeg 1027; convertMP4; convertGIF
                          where drawMany zs [] na oa = paintUnity zs (oa++(show na)++".svg")
                                drawMany ys ((i,f):zs) na oa = let n = (applyF i f ys) in do paintUnity n (oa++(show na)++".svg");(drawMany n zs (na+1) oa)
                                mapFall f (Transform{rotate=r, scale=s, translate=t}) = (Transform{rotate=r, scale=s, translate=(f t)})
                                calcTrans zo = case (head zo) of
                                                  "bg" -> (0.0,0.0)
                                                  "l" -> if (zo !! 1) == "90" then (((read (zo !! 2) :: Double) * 24 + 24), -96.0) else (((read (zo !! 2) :: Double) * 24),-96.0)
                                                  "q" -> (((read (zo !! 2) :: Double) * 24),-96.0)
                                                  _ -> case (zo !! 1) of 
                                                         "90" -> (((read (zo !! 2) :: Double) * 24 + 72),-96.0)
                                                         "180" -> (((read (zo !! 2) :: Double) * 24 + 48),-24.0)
                                                         "270" -> (((read (zo !! 2) :: Double) * 24),-48.0)
                                                         _ -> (((read (zo !! 2) :: Double) * 24),-96.0)
                                makeTetris [] _ = []
                                makeTetris (z:zs) 0 = let zo = words z in ((Use "0" (head zo) "" (Transform {rotate=(read (zo !! 1) :: Double), scale=(1,1), translate=(calcTrans zo)})),[]):(makeTetris zs 1)
                                makeTetris (z:zs) i = let zo = words z in ((Use (show i) (head zo) "" (Transform {rotate=(read (zo !! 1) :: Double), scale=(1,1), translate=(calcTrans zo)})),(replicate ((read (zo !! 3) :: Int) + 4) ((show i),mapFall (\(t1, t2) -> (t1, t2+24))))):(makeTetris zs (i+1))


getFinalLine :: Object -> Double
getFinalLine x = case x of
                   (Ellipse _ _ _ (Transform {rotate=r, scale=s, translate=(t1,t2)})) -> t2 / 24
                   (Rectangle _ _ _ _ (Transform {rotate=r, scale=s, translate=(t1,t2)})) -> t2 / 24
                   (Group _ _ _ (Transform {rotate=r, scale=s, translate=(t1,t2)})) -> t2 / 24
                   (Use _ _ _ (Transform {rotate=r, scale=s, translate=(t1,t2)})) -> t2 / 24
                   (Pattern _ _ _ _ _ _ (Transform {rotate=r, scale=s, translate=(t1,t2)})) -> t2 / 24



applyFL :: [Object] -> [(String, Transform -> Transform)] -> [Object]
applyFL xs [] = xs
applyFL xs ((i,f):ys) = applyFL (applyF i f xs) ys

-- paintUnity actually writes the file from a list of objects and an output path converting the objects to the svg commands.
paintUnity :: [Object] -> String -> IO ()
paintUnity x ou = writeFile ou (createSVG (("<defs>\n"++(transform genDefObjects)++"</defs>\n") ++ (transform x)) "0" "0" "456" "576")
            where transform [] = ""
                  transform (y:ys) = case y of
                                       (Group id fi es t) -> "<g id=\""++ id ++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++">\n"++(transElems es)++"</g>\n"++(transform ys)
                                       (Pattern id xv yv w h es t) -> "<pattern id=\""++id++"\" x=\""++xv++"\" y=\""++yv++"\" width=\""++ w ++"\" height=\""++h++"\" patternUnits=\"userSpaceOnUse\" "++(paintT t)++">\n"++(transElems es)++"</pattern>\n"++(transform ys)
                                       _ -> (transElems [y]) ++ (transform ys)
                  transElems [] = ""
                  transElems (y:ys) = case y of
                                        (Ellipse id rx ry t) -> "<ellipse id=\""++ id ++"\" rx=\""++ rx ++"\" ry=\""++ ry ++"\" "++(paintT t)++"/>\n" ++ (transElems ys)
                                        (Rectangle id w h fi t) -> "<rect id=\""++ id ++"\" width=\""++ w ++"\" height=\""++ h ++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++"/>\n" ++ (transElems ys)
                                        (Path fi op d) -> "<path fill=\""++fi++"\" fill-opacity=\""++op++"\" d=\""++d++"\"/>\n"++(transElems ys)
                                        (Use id ref fi t) -> "<use id=\""++id++"\" xlink:href=\"#"++ref++"\" "++(if fi == "" then "" else "fill=\""++fi++"\" ")++(paintT t)++"/>\n" ++ (transElems ys)
                  paintT (Transform{rotate=r, scale=s, translate=t}) =  "transform=\"translate("++(show (fst t))++" "++(show (snd t))++") rotate("++(show r)++") scale("++(show (fst s))++" "++(show (snd s))++")\""

convertJpeg :: Int -> IO ()
convertJpeg 0 = callCommand ("convert svgs/"++(show 0)++".svg svgs/"++(show 0)++".jpeg")
convertJpeg i = do callCommand ("convert svgs/"++(show i)++".svg svgs/"++(show i)++".jpeg")
                   convertJpeg (i-1)

convertMP4 :: IO ()
convertMP4 = callCommand ("ffmpeg -r 60 -f image2 -start_number 0 -i svgs/%d.jpeg -vcodec libx264 -crf 15 unity.mp4")

convertGIF :: IO ()
convertGIF = callCommand ("ffmpeg -i unity.mp4 -loop -1 unity.gif")

{-TTEW-}