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