content: module ActionKid.Internal where
  import ActionKid.Types
  import ActionKid.Utils
  import Control.Applicative
  import Control.Monad
  import Data.List
  import Data.Maybe
  import Text.Printf
  import Graphics.Gloss hiding (display)
  import Data.Monoid ((<>), mconcat)
  import Graphics.Gloss.Interface.IO.Game
  import Data.Ord
  import ActionKid.Globals
  import Data.StateVar
  import Control.Lens
  import qualified Debug.Trace as D
  
  -- bounding box for a series of points
  pathBox points =
      let minx = minimum $ map fst points
          miny = minimum $ map snd points
          maxx = maximum $ map fst points
          maxy = maximum $ map snd points
      in ((minx, miny), (maxx, maxy))
  
  catPoints :: (Point, Point) -> [Point]
  catPoints (p1, p2) = [p1, p2]
  
  -- | Code borrowed from https://hackage.haskell.org/package/gloss-game-0.3.0.0/docs/src/Graphics-Gloss-Game.html
  -- Calculate bounding boxes for various `Picture` types.
  type Rect = (Point, Point)     -- ^origin & extent, where the origin is at the centre
  boundingBox :: Picture -> Rect
  boundingBox Blank                    = ((0, 0), (0, 0))
  boundingBox (Polygon path)           = pathBox path
  boundingBox (Line path)              = pathBox path
  boundingBox (Circle r)               = ((0, 0), (2 * r, 2 * r))
  boundingBox (ThickCircle t r)        = ((0, 0), (2 * r + t, 2 * r + t))
  boundingBox (Arc _ _ _)              = error "ActionKid.Core.boundingbox: Arc not implemented yet"
  boundingBox (ThickArc _ _ _ _)       = error "ActionKid.Core.boundingbox: ThickArc not implemented yet"
  boundingBox (Text _)                 = error "ActionKid.Core.boundingbox: Text not implemented yet"
  boundingBox (Bitmap w h _ _)         = ((0, 0), (fromIntegral w, fromIntegral h))
  boundingBox (Color _ p)              = boundingBox p
  boundingBox (Translate dx dy p)      = ((x1 + dx, y1 + dy), (x2 + dx, y2 + dy))
      where ((x1, y1), (x2, y2)) = boundingBox p
  boundingBox (Rotate _ang _p)         = error "Graphics.Gloss.Game.boundingbox: Rotate not implemented yet"
  
  -- TODO fix scale, this implementation is incorrect (only works if scale
  -- = 1). Commented out version is incorrect too
  boundingBox (Scale xf yf p)          = boundingBox p
      -- let ((x1, y1), (x2, y2)) = boundingBox p
      --     w = x2 - x1
      --     h = y2 - y1
      --     scaledW = w * xf
      --     scaledH = h * yf
      -- in ((x1, x2), (x1 + scaledW, y1 + scaledH))
  boundingBox (Pictures ps) = pathBox points
      where points = concatMap (catPoints . boundingBox) ps
  
  -- | Check if one rect is touching another.
  intersects :: Rect -> Rect -> Bool
  intersects ((min_ax, min_ay), (max_ax, max_ay)) ((min_bx, min_by), (max_bx, max_by))
      | max_ax < min_bx = False
      | min_ax > max_bx = False
      | min_ay > max_by = False
      | max_ay < min_by = False
      | otherwise = True
  
  -- | For future, if I want to inject something into the step function,
  -- I'll do it here. Right now I just call the step function.
  onEnterFrame :: MovieClip a => (Float -> a -> IO a) -> Float -> a -> IO a
  onEnterFrame stepFunc num state = stepFunc num state
  
  -- | Called to draw the game. Translates the coordinate system.
  draw :: Renderable a => a -> IO Picture
  draw gs = do
    w <- get boardWidth
    h <- get boardHeight
    return $ translate (-(fromIntegral $ w // 2)) (-(fromIntegral $ h // 2)) $
             display gs
  