haskgame 0.0.4 → 0.0.5

raw patch · 7 files changed

+142/−60 lines, 7 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• haskgame.cabal +2/−2
• src/Graphics/UI/HaskGame.hs +14/−7
• src/Graphics/UI/HaskGame/Key.hs +7/−1
• src/Graphics/UI/HaskGame/Keys.hs +14/−3
• src/Graphics/UI/HaskGame/Rect.hs +90/−35
• src/Graphics/UI/HaskGame/Utils.hs +1/−4
• src/Graphics/UI/HaskGame/Vector2.hs +14/−8

@@ -1,5 +1,5 @@ Name:                haskgame-Version:             0.0.4+Version:             0.0.5 Cabal-Version:       >= 1.2 Synopsis:            Haskell game library. Category:            graphics@@ -30,7 +30,7 @@   Extensions: -- SDL-ttf prior to 0.5.5 can be used on x86-32, but on x86-64 bugs -- render it unusable-  Build-Depends:       base, haskell98, containers, SDL, SDL-ttf >= 0.5.5+  Build-Depends:       base >= 4 && < 5, haskell98, containers, SDL, SDL-ttf >= 0.5.5   Exposed-Modules:     Graphics.UI.HaskGame,                        Graphics.UI.HaskGame.Color,                        Graphics.UI.HaskGame.Font,

@@ -1,8 +1,8 @@ {-# OPTIONS -Wall -O2 #-}  module Graphics.UI.HaskGame-    (Surface,Event,Size-    ,createRGBSurface,blit,fillRect,fillSurface+    (Surface,Event+    ,createRGBSurface,blit,blitPart,fillRect,fillSurface     ,withInit,getEvents,surfaceSize,setVideoMode     ) where@@ -11,7 +11,7 @@ import qualified Graphics.UI.HaskGame.Rect as Rect import qualified Graphics.UI.HaskGame.Font as Font import qualified Graphics.UI.HaskGame.Utils as Utils-import Graphics.UI.HaskGame.Utils(Size)+import Graphics.UI.HaskGame.Rect(Rect) import Graphics.UI.HaskGame.Color(Color(..)) import Graphics.UI.HaskGame.Vector2(Vector2(..)) import Control.Monad(liftM)@@ -37,10 +37,17 @@  blit :: Surface -> Vector2 Int -> Surface -> IO () blit dest pos src = do-  SDL.blitSurface src Nothing dest (Just . Rect.makePosRect $ pos)+  SDL.blitSurface src Nothing dest (Just . Rect.makeFromPos $ pos)   return () -sdlFillRect :: Surface -> Maybe Rect.Rect -> Color -> IO ()+blitPart :: Surface -> Vector2 Int -> Surface -> Rect -> IO ()+blitPart dest destPos src srcRect = do+  SDL.blitSurface+     src  (Just . Rect.trunc $ srcRect)+     dest (Just . Rect.makeFromPos $ destPos)+  return ()++sdlFillRect :: Surface -> Maybe Rect -> Color -> IO () sdlFillRect surface mRect color = do   fillerPixel <- pixel surface color   SDL.fillRect surface mRect fillerPixel@@ -49,7 +56,7 @@ fillSurface :: Surface -> Color -> IO () fillSurface surface color = sdlFillRect surface Nothing color -fillRect :: Surface -> Rect.Rect -> Color -> IO ()+fillRect :: Surface -> Rect -> Color -> IO () fillRect surface rect color = sdlFillRect surface (Just rect) color  initKeyRepeat :: IO ()@@ -66,7 +73,7 @@ getEvents :: IO [Event] getEvents = whileM (/=SDL.NoEvent) SDL.pollEvent -surfaceSize :: Surface -> Size+surfaceSize :: Surface -> Vector2 Int surfaceSize surface = Vector2 (SDL.surfaceGetWidth surface)                               (SDL.surfaceGetHeight surface) 

@@ -38,10 +38,16 @@ keyName :: ModKey -> String keyName (ModKey mods sdlkey) = modsName mods ++ SDL.getKeyName sdlkey -noMods, shift, ctrl, alt :: Mods+noMods :: Mods noMods = MkMods False False False++shift :: Mods shift = noMods{isShift=True}++ctrl :: Mods ctrl = noMods{isCtrl=True}++alt :: Mods alt = noMods{isAlt=True}  modsOf :: [SDL.Modifier] -> Mods

@@ -37,20 +37,29 @@ keysSetOfUnicode :: Map.Map ModKey String -> Set.Set ModKey keysSetOfUnicode = Set.fromList . Map.keys -printableGroup, digitsGroup, lettersGroup,-  upperCaseGroup, lowerCaseGroup, arrowsGroup :: KeyGroup+lettersGroup :: KeyGroup lettersGroup = combineGroups "Letters" [upperCaseGroup, lowerCaseGroup]++printableGroup :: KeyGroup printableGroup = KeyGroup "Printable" . keysSetOfUnicode $ keysUnicode++digitsGroup :: KeyGroup digitsGroup = KeyGroup "Digits" . keysSetOfUnicode $ digitsUnicode++upperCaseGroup :: KeyGroup upperCaseGroup = KeyGroup "Upper-case letters" . keysSetOfUnicode $ upperCaseUnicode++lowerCaseGroup :: KeyGroup lowerCaseGroup = KeyGroup "Lower-case letters" . keysSetOfUnicode $ lowerCaseUnicode++arrowsGroup :: KeyGroup arrowsGroup = KeyGroup "Arrows" $               Set.fromList [ModKey noMods SDL.SDLK_LEFT                            ,ModKey noMods SDL.SDLK_RIGHT                            ,ModKey noMods SDL.SDLK_UP                            ,ModKey noMods SDL.SDLK_DOWN] -lowerCaseUnicode, upperCaseUnicode, digitsUnicode :: Map.Map ModKey String+lowerCaseUnicode :: Map.Map ModKey String lowerCaseUnicode = Map.fromList $     [(ModKey noMods SDL.SDLK_a, "a")     ,(ModKey noMods SDL.SDLK_b, "b")@@ -79,6 +88,7 @@     ,(ModKey noMods SDL.SDLK_y, "y")     ,(ModKey noMods SDL.SDLK_z, "z")     ]+upperCaseUnicode :: Map.Map ModKey String upperCaseUnicode = Map.fromList $     [(ModKey shift SDL.SDLK_a, "A")     ,(ModKey shift SDL.SDLK_b, "B")@@ -107,6 +117,7 @@     ,(ModKey shift SDL.SDLK_y, "Y")     ,(ModKey shift SDL.SDLK_z, "Z")     ]+digitsUnicode :: Map.Map ModKey String digitsUnicode = Map.fromList $     [(ModKey noMods SDL.SDLK_0, "0")     ,(ModKey noMods SDL.SDLK_1, "1")

@@ -1,59 +1,114 @@ module Graphics.UI.HaskGame.Rect-    (Rect-    ,rectToVectors-    ,vectorsToRect-    ,makeRect-    ,vectorsToPVectors, pVectorsToVectors+    (Rect(Rect)+    ,toVectors+    ,fromVectors+    ,make+    ,getTopLeft+    ,getSize+    ,getBottomRight+    ,vectorsToPVectors, pVectorsToVectors, toPVectors     ,inRect-    ,rectPos, rectSize-    ,rectX, rectY, rectW, rectH-    ,makePosRect-    ,unionRects)+    ,pos, size+    ,x, y, w, h+    ,makeFromPos,makeFromSize+    ,posInside+    ,trunc+    ,union+    ,intersect) where  import qualified Graphics.UI.SDL as SDL-import Graphics.UI.HaskGame.Vector2(Vector2(..), vector2first, vector2second)+import qualified Graphics.UI.HaskGame.Vector2 as Vector2+import Graphics.UI.SDL(Rect(Rect))+import Graphics.UI.HaskGame.Vector2(Vector2(..)) import Control.Arrow(first, second) import Control.Applicative(liftA2) -type Rect = SDL.Rect type Endo a = a -> a type Two a = (a, a) -rectToVectors :: Rect -> Two (Vector2 Int)-rectToVectors (SDL.Rect x y w h) = (Vector2 x y, Vector2 w h)+toVectors :: Rect -> Two (Vector2 Int)+toVectors (SDL.Rect rx ry rw rh) = (Vector2 rx ry, Vector2 rw rh) -vectorsToRect :: Two (Vector2 Int) -> Rect-vectorsToRect (Vector2 x y, Vector2 w h) = SDL.Rect x y w h+getTopLeft :: Rect -> Vector2 Int+getTopLeft = fst . toVectors -makeRect :: Vector2 Int -> Vector2 Int -> Rect-makeRect = curry vectorsToRect+getSize :: Rect -> Vector2 Int+getSize = snd . toVectors --- Rect to Positional vectors-vectorsToPVectors, pVectorsToVectors :: Endo (Two (Vector2 Int))+getBottomRight :: Rect -> Vector2 Int+getBottomRight = snd . vectorsToPVectors . toVectors++fromVectors :: Two (Vector2 Int) -> Rect+fromVectors (Vector2 rx ry, Vector2 rw rh) = SDL.Rect rx ry rw rh++make :: Vector2 Int -> Vector2 Int -> Rect+make = curry fromVectors++-- To Positional vectors+vectorsToPVectors :: Endo (Two (Vector2 Int)) vectorsToPVectors (p, s) = (p, p+s)++pVectorsToVectors :: Endo (Two (Vector2 Int)) pVectorsToVectors (p1, p2) = (p1, p2-p1) +toPVectors :: Rect -> Two (Vector2 Int)+toPVectors = vectorsToPVectors . toVectors+ inRect :: Endo (Two (Vector2 Int)) -> Endo Rect-inRect f = vectorsToRect . f . rectToVectors+inRect f = fromVectors . f . toVectors -rectPos, rectSize :: Endo (Vector2 Int) -> Endo Rect-rectPos = inRect . first-rectSize = inRect . second+pos :: Endo (Vector2 Int) -> Endo Rect+pos = inRect . first -rectX, rectY, rectW, rectH :: Endo Int -> Endo Rect-rectX = rectPos . vector2first-rectY = rectPos . vector2second-rectW = rectSize . vector2first-rectH = rectSize . vector2second+size :: Endo (Vector2 Int) -> Endo Rect+size = inRect . second -makePosRect :: Vector2 Int -> Rect-makePosRect (Vector2 x y) = SDL.Rect x y 0 0+x :: Endo Int -> Endo Rect+x = pos . Vector2.first -unionRects :: Rect -> Rect -> Rect-unionRects r1 r2 =-    let (tl1, br1) = vectorsToPVectors . rectToVectors $ r1-        (tl2, br2) = vectorsToPVectors . rectToVectors $ r2-    in vectorsToRect . pVectorsToVectors $+y :: Endo Int -> Endo Rect+y = pos . Vector2.second++w :: Endo Int -> Endo Rect+w = size . Vector2.first++h :: Endo Int -> Endo Rect+h = size . Vector2.second++makeFromPos :: Vector2 Int -> Rect+makeFromPos (Vector2 rx ry) = SDL.Rect rx ry 0 0++makeFromSize :: Vector2 Int -> Rect+makeFromSize (Vector2 rw rh) = SDL.Rect 0 0 rw rh++posInside :: Vector2 Int -> Rect -> Bool+posInside point rect =+    let (rpoint, rsize) = toVectors rect+    in point-rpoint < rsize++-- Truncate negative sizes to 0+trunc :: Rect -> Rect+trunc = w (max 0) . h (max 0)++union :: Rect -> Rect -> Rect+union r1 r2 =+    let (tl1, br1) = toPVectors r1+        (tl2, br2) = toPVectors r2+    in fromVectors . pVectorsToVectors $            ((liftA2 min tl1 tl2),             (liftA2 max br1 br2))++intersect :: Rect -> Rect -> Rect+intersect r1 r2 =+    let (Vector2 left1 top1,+         Vector2 right1 bottom1) = toPVectors r1+        (Vector2 left2 top2,+         Vector2 right2 bottom2) = toPVectors r2+        left = max left1 left2+        top = max top1 top2+        right = min right1 right2+        bottom = min bottom1 bottom2+        width = right - left+        height = bottom - top+    in Rect left top width height

@@ -1,13 +1,10 @@ {-# OPTIONS -Wall -O2 #-}  module Graphics.UI.HaskGame.Utils-    (Size, bracket__,ioBoolToError)+    (bracket__,ioBoolToError) where  import qualified IO-import Graphics.UI.HaskGame.Vector2(Vector2)--type Size = Vector2 Int  bracket__ :: IO () -> IO () -> IO () -> IO () bracket__ pre post code = IO.bracket_ pre (const post) code

@@ -2,10 +2,11 @@  module Graphics.UI.HaskGame.Vector2     (Vector2(Vector2)-    ,vector2first,vector2second-    ,vector2fst,vector2snd)+    ,first,second+    ,fst,snd) where +import Prelude hiding (fst, snd) import Control.Applicative(Applicative(..), liftA2)  data Vector2 a = Vector2 !a !a@@ -16,12 +17,17 @@  type Endo a = a -> a -vector2fst, vector2snd :: Vector2 a -> a-vector2fst (Vector2 x _) = x-vector2snd (Vector2 _ y) = y-vector2first, vector2second :: Endo a -> Endo (Vector2 a)-vector2first f (Vector2 x y) = Vector2 (f x) y-vector2second f (Vector2 x y) = Vector2 x (f y)+fst :: Vector2 a -> a+fst (Vector2 x _) = x++snd :: Vector2 a -> a+snd (Vector2 _ y) = y++first :: Endo a -> Endo (Vector2 a)+first f (Vector2 x y) = Vector2 (f x) y++second :: Endo a -> Endo (Vector2 a)+second f (Vector2 x y) = Vector2 x (f y)  instance Functor Vector2 where   fmap f (Vector2 x y) = Vector2 (f x) (f y)