module Ex03_Solution where
import Prelude hiding (log)
import Data.List
  
import LogTypes
import Canvas

-- |--------------------|
-- | Highscores
-- |--------------------|

  
instance Ord HighScoreEntry where
  compare (HSE _ won) (HSE _ won') = compare won won'

data Game = G { start :: Time, end :: Time, players :: (Player, Player),
                res1 :: Maybe Choice, res2 :: Maybe Choice }
  deriving (Show, Eq)

                 
reconstructHS :: Log -> HighScore
reconstructHS log@(Log glog _) = reverse $ sort winStats
  where -- map players to win-count
        winStats = [ HSE p (winsOf p) | p <- allPlayers ]
        -- calculate win-count
        winsOf p = length $ filter (==p) wins 
        -- list of wins players
        wins = [p | Just p <- gameResults ]
        wins' = map fromJust $ filter isJust gameResults
        wins'' = catMaybes gameResults


        -- evaluate each game
        gameResults = map evalGame $ reconstructGames log

        -- collect all the players
        allPlayers = nub $ map player1 glog ++ map player2 glog
                         
        -- Determine if a game was one, and by whom
        evalGame (G _ _ (p1, p2) (Just r1) (Just r2))
          | r1 `beats` r2 = Just p1
          | r2 `beats` r1 = Just p2
          | otherwise = Nothing
        evalGame _ = Nothing


        beats Schere Papier = True
        beats Papier Stein = True
        beats Stein Schere = True
        beats _ _ = False
                             
-- re-implementation from Data.Maybe
fromJust (Just x) = x
fromJust _ = error "Not Just!"

isJust (Just _) = True
isJust Nothing = False

catMaybes [] = []
catMaybes (Just x:xs) = x : catMaybes xs
catMaybes (Nothing:xs) = catMaybes xs



-- collect the game events that belong to one game (we assume that a
-- player always participates at only one game at a time)
matchupGames glog = [ preGame g (find (doesStop g) glog) | g <- glog ]
  where doesStop (GLE st p1 p2 Start) (GLE et p1' p2' Stop) =
          p1 == p1' && p2 == p2' && et >= st
        doesStop _ _ = False

        preGame (GLE st p1 p2 _) (Just (GLE et _ _ _)) =
          Just $ (st, et, p1, p2)
        preGame _ Nothing = Nothing

                     
-- reconstruct the games from the logs
reconstructGames (Log glog pls) =
  [ G st et (p1, p2)(result $ sliceLog st et pl1)
                    (result $ sliceLog st et pl2)
  | Just (st, et, p1, p2) <- matchupGames glog
  -- alternative
  -- , (st', et', p1', p2') <- catMaybes $ matchupGames glog
  , (p1'', pl1) <-  pls, p1'' == p1
  , (p2'', pl2) <-  pls, p2'' == p2
  ]
  where sliceLog :: Time -> Time -> PlayerLog -> PlayerLog
        sliceLog st et pl = [ ple | ple@(t, _) <- pl, t >= st && t <= et ]

        doesStop (GLE st p1 p2 Start) (GLE et p1' p2' Stop) =
          p1 == p1' && p2 == p2' && et >= st
        doesStop _ _ = False

        result :: PlayerLog -> Maybe Choice
        result [] = Nothing
        result xs = Just $ snd $ last xs



-- |--------------------|
-- | Vector
-- |--------------------|

data V2 a = V { vX :: a, vY :: a}
  deriving (Show, Eq)


-- Some Operations on vectors
toTuple :: V2 a -> (a, a)
toTuple (V x y) = (x, y)

vPlus :: Num a => V2 a -> V2 a -> V2 a
vPlus (V x1 y1) (V x2 y2) = V (x1 + x2) (y1 + y2)

vFromScalar :: Num a => a -> V2 a
vFromScalar i = V i 0

vMult :: Num a => V2 a -> V2 a -> V2 a
vMult (V a b) (V c d) = V (a * c - b * d) (a * d + b * c)

vNeg :: Num a => V2 a -> V2 a
vNeg (V x y) = V (-x) (-y)

vAbs :: Floating a => V2 a -> V2 a
vAbs (V x y) = vFromScalar (sqrt (x*x + y*y))

vSig :: Num a => V2 a -> V2 a
vSig (V x y) = vFromScalar (signum x)

instance Floating a => Num (V2 a) where
  (+) = vPlus
  (*) = vMult
  negate = vNeg
  abs = vAbs
  signum = vSig
  fromInteger = vFromScalar . fromInteger
                            
type V2D = V2 Double


-- |--------------------|
-- | Pictures
-- |--------------------|

-- The picture datatype
data Picture = Line V2D -- ^ from, to defined by vector
             | Rect Double Double -- ^ width, height
             | Circle Double -- ^ radius
             | Ontop Picture Picture -- ^ put first picture above the second
             | Translate V2D Picture -- ^ Move a picture by a vector
  deriving (Show, Eq)

(<+>) = Ontop

ex_pic1 :: Picture
ex_pic1 = Line (V 7 7) <+> (Translate (V 5 5) (Circle 5)) <+> Rect 10 10

cross :: Double -> Double -> Picture
cross w h = Line (V w h) <+> (Translate (V 0 h) (Line (V w (-h))))

triangle :: Double -> Double -> Picture
triangle w h = Line (V w 0)
               <+> Line (V half h)
               <+> (Translate (V half h) (Line (V half (-h))))
  where half = w/2
                                                                 
centeredTriangle w h = Translate (V (-halfW) (-halfH)) (triangle w h)
  where halfW = w/2
        halfH = h/2

-- Das Haus vom Nikolaus
ex_pic2 :: Picture
ex_pic2 = Rect 10 10
          <+> 
          cross 10 10
          <+> 
          (Translate (V 0 10) $ triangle 10 5)
        


scale :: Double -> Picture -> Picture
scale f (Line v) = Line (vFromScalar f * v)
scale f (Rect w h) = Rect (f*w) (f*h)
scale f (Circle r) = Circle (f*r)
scale f (Ontop p1 p2) = Ontop (scale f p1) (scale f p2)
scale f (Translate v p) = Translate (vFromScalar f * v) (scale f p)

ex_pic3 :: Picture
ex_pic3 = scale 10 $ ex_pic1 <+> Translate (V 20 0) ex_pic2


draw :: V2D -> Picture -> Script
draw from (Line to) = drawLine (toTuple from) (toTuple (from `vPlus` to))
draw from (Rect w h) = drawRect (toTuple from) w h
draw from (Circle r) = drawCircle (toTuple from) r
draw from (Ontop p1 p2) = draw from p1 ++ draw from p2
draw from (Translate v p) = draw (from `vPlus` v) p