module System.Utility.H9Clock.Draw
        ( drawClock
        , mkGraphics
        , mkHandsPts
        , hourHandAngle
        , minHandAngle
        , dotsPts
        , darkBlue
        , paleBlue
        , paleBlueGreen
        )
where

import           Graphics.HGL
import           System.Utility.H9Clock.Type   as T
import           System.Utility.H9Clock.Time
import           Control.Monad
import           Control.Concurrent
import           Control.Concurrent.STM

mkHandsPts :: Rectangle -> Int -> Int -> ([Point], [Point])
mkHandsPts wRec hour min =
        let hourAng  = hourHandAngle hour min
            minAng   = minHandAngle min
            c        = center wRec
            hourHand = lineHourHandPts hourAng c wRec
            minHand  = lineMinHandPts minAng c wRec
        in (hourHand, minHand)

mkGraphics :: Rectangle -> Int -> Int -> (Graphic, Graphic, [Graphic])
mkGraphics wRec hour min = (hourHand, minHand, dots 4 4 wRec)
  where (hourHandPts, minHandPts) = mkHandsPts wRec hour min
        hourHand = polygon $ hourHandPts
        minHand = polygon $ minHandPts

hourHandAngle :: Integral a => a -> a -> a
hourHandAngle hour min = 90 - ((hour * 5) + (min `div` 10)) * 6

minHandAngle :: Num a => a -> a
minHandAngle min = 90 - (min * 6)

dotsPts :: Int -> Int -> Rectangle -> [(Point, Point)]
dotsPts w h r = ePts
    where
        c    = center r
        rad' = rad r
        degs = map ((360 `div` 12) *) [0 .. 11]
        cPts = map (circlePt c rad') degs
        ePts = map (ellipsePt w h) cPts

dots :: Int -> Int -> Rectangle -> [Graphic]
dots w h r = map (uncurry ellipse) $ dotsPts w h r

center :: Rectangle -> (Int, Int)
center r = divPt
    where
        addPt = (fst (T.min r) + fst (T.max r), snd (T.min r) + snd (T.max r))
        divPt = (fst addPt `div` 2, snd addPt `div` 2)

dx :: Rectangle -> Int
dx r = fst (T.max r) - fst (T.min r)

dy :: Rectangle -> Int
dy r = snd (T.max r) - snd (T.min r)

rad :: Rectangle -> Int
rad r = rad'
    where
        radD   = if dx r < dy r then dx r else dy r
        radDiv = radD `div` 2
        rad'   = radDiv - 8

circlePt :: (Int, Int) -> Int -> Int -> (Int, Int)
circlePt c r deg =
        let rad' = fromIntegral deg * (pi / 180.0)
            x    = fst c + round (cos rad' * fromIntegral r)
            y    = snd c - round (sin rad' * fromIntegral r)
        in  (x, y)

ellipsePt :: Int -> Int -> (Int, Int) -> (Point, Point)
ellipsePt a b c =
        let x = fst c
            y = snd c
        in  ((x - a, y + b), (x + a, y - b))

lineMinHandPts :: Int -> (Int, Int) -> Rectangle -> [Point]
lineMinHandPts ang c r =
        let
                rad' = (rad r * 3) `div` 4
                cPt  = circlePt c rad' ang
        in
          [ c
          , (fst c + 3  , snd c + 3)
          , (fst cPt + 3, snd cPt + 3)
          , cPt
          ]

lineHourHandPts :: Int -> (Int, Int) -> Rectangle -> [Point]
lineHourHandPts ang c r =
        let
                rad' = rad r `div` 2
                cPt  = circlePt c rad' ang
        in
          [ c
          , (fst c + 3  , snd c + 3)
          , (fst cPt + 3, snd cPt + 3)
          , cPt
          ]

darkBlue :: RGB
darkBlue = RGB 0 0 85

paleBlue :: RGB
paleBlue = RGB 0 0 187

paleBlueGreen :: RGB
paleBlueGreen = RGB 236 254 252

clockGraphic :: Rectangle -> (Int, Int) -> Int -> Int -> IO Graphic
clockGraphic rectangle wSize hour min = do
        let (hourHand, minHand, dots) = mkGraphics rectangle hour min
        return $ overGraphics
                [ withRGB darkBlue hourHand
                , withRGB paleBlue minHand
                , withColor Blue (overGraphics dots)
                , background
                ]
    where
        background =
                withRGB paleBlueGreen $ polygon
                        [(0, 0), (fst wSize, 0), wSize, (0, snd wSize)]

redraw :: Window -> (Int, Int) -> (Int, Int) -> IO ()
redraw w nSize (hour, min) = do g <- clockGraphic (Rectangle (0, 0) nSize) nSize hour min
                                setGraphic w g

milliSleep :: Int -> IO ()
milliSleep = threadDelay . (*) 1000

secSleep :: Int -> IO ()
secSleep = threadDelay . (*) 1000000

timeWorker :: Num a => TMVar a -> IO b
timeWorker var = loop
        where loop = secSleep 30 >> atomically (putTMVar var 0) >> loop

eventWorker :: Window -> TMVar Size -> Size -> IO ()
eventWorker w var wSize = loop
    where
        loop = do
                milliSleep 10
                me <- maybeGetWindowEvent w
                case me of
                        Just Resize -> do
                                size <- getWindowSize w
                                if wSize == size
                                        then loop
                                        else
                                                atomically (putTMVar var size)
                                                        >> loop
                        Just Closed -> closeWindow w
                        otherwise   -> loop

drawClock :: IO ()
drawClock = runGraphics $ do
        w <- openWindowEx "h9clock" Nothing windowSize DoubleBuffered (Just 20)
        (hour, min) <- getHourMin
        clock <- clockGraphic rectangle windowSize hour min
        setGraphic w clock
        t <- newEmptyTMVarIO
        e <- newEmptyTMVarIO
        forkIO $ timeWorker t
        forkIO $ eventWorker w e windowSize
        loop w windowSize t e (hour, min)
    where
        windowSize = (250, 250)
        rectangle  = Rectangle (0, 0) windowSize
        loop w wSize t e hourMin = do
                me <- atomically $ takeEitherTMVar e t
                curHour <- getHourMin
                case me of
                  Left size -> if curHour == hourMin && size == wSize
                               then loop w wSize t e hourMin
                               else redraw w size curHour >> loop w size t e curHour
                  Right _ -> if curHour == hourMin
                             then loop w wSize t e hourMin
                             else redraw w wSize curHour >> loop w wSize t e curHour

takeEitherTMVar :: TMVar a -> TMVar b -> STM (Either a b)
takeEitherTMVar ma mb =
        fmap Left (takeTMVar ma) `orElse` fmap Right (takeTMVar mb)