haskgame (empty) → 0.0.1
raw patch · 10 files changed
+537/−0 lines, 10 filesdep +SDLdep +SDL-ttfdep +basesetup-changed
Dependencies added: SDL, SDL-ttf, base, containers, haskell98
Files
- Setup.lhs +3/−0
- haskgame.cabal +41/−0
- src/Graphics/UI/HaskGame.hs +73/−0
- src/Graphics/UI/HaskGame/Color.hs +11/−0
- src/Graphics/UI/HaskGame/Font.hs +33/−0
- src/Graphics/UI/HaskGame/Key.hs +64/−0
- src/Graphics/UI/HaskGame/Keys.hs +194/−0
- src/Graphics/UI/HaskGame/Rect.hs +59/−0
- src/Graphics/UI/HaskGame/Utils.hs +19/−0
- src/Graphics/UI/HaskGame/Vector2.hs +40/−0
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ haskgame.cabal view
@@ -0,0 +1,41 @@+Name: haskgame+Version: 0.0.1+Cabal-Version: >= 1.2+Synopsis: Purely FunctionaL User Interface+Category: graphics+Description:+ This package contains a set of composable purely funcitonal widgets+ and a mainloop adapter to adapt the widgets to run in IO.+ It is currently based on SDL.+ .+ Project wiki page: <http://haskell.org/haskellwiki/HaskGame>+ .+ Git repository is at: <http://github.com/Peaker/haskgame>+ .+ © 2009 by Eyal Lotem; BSD3 license.++Author: Eyal Lotem+Maintainer: eyal.lotem@gmail.com+--Homepage: http://haskell.org/haskellwiki/HaskGame+--Package-Url: http://code.haskell.org/HaskGame+Copyright: (c) 2008 by Eyal Lotem+License: BSD3+Stability: experimental+build-type: Simple++Library+ hs-Source-Dirs: src+ 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+ Exposed-Modules: Graphics.UI.HaskGame,+ Graphics.UI.HaskGame.Color,+ Graphics.UI.HaskGame.Font,+ Graphics.UI.HaskGame.Key,+ Graphics.UI.HaskGame.Keys,+ Graphics.UI.HaskGame.Rect,+ Graphics.UI.HaskGame.Vector2+ Other-Modules: Graphics.UI.HaskGame.Utils+ ghc-options: -Wall+-- ghc-prof-options: -prof -auto-all
+ src/Graphics/UI/HaskGame.hs view
@@ -0,0 +1,73 @@+{-# OPTIONS -Wall -O2 #-}++module Graphics.UI.HaskGame+ (Surface,Event+ ,createRGBSurface,blit,fillRect,fillSurface+ ,withInit,getEvents,surfaceSize,setVideoMode+ )+where++import qualified Graphics.UI.SDL as SDL+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.Color(Color(..))+import Graphics.UI.HaskGame.Vector2(Vector2(..))+import Control.Monad(liftM)++-- Commented out for 6.8's lack of the new Exception+-- import Control.Exception(throwIO)++type Surface = SDL.Surface+type Event = SDL.Event++whileM :: Monad m => (a -> Bool) -> m a -> m [a]+whileM cond element = do+ value <- element+ if cond value+ then liftM (value:) (whileM cond element)+ else return []++createRGBSurface :: Vector2 Int -> IO Surface+createRGBSurface (Vector2 w h) = do+ surface <- SDL.createRGBSurface [SDL.SWSurface]+ w h 32 0xFF 0xFF00 0xFF0000 0x00000000+ SDL.displayFormatAlpha surface++blit :: Surface -> Vector2 Int -> Surface -> IO ()+blit dest pos src = do+ SDL.blitSurface src Nothing dest (Just . Rect.makePosRect $ pos)+ return ()++sdlFillRect :: Surface -> Maybe Rect.Rect -> Color -> IO ()+sdlFillRect surface mRect color = do+ fillerPixel <- pixel surface color+ SDL.fillRect surface mRect fillerPixel+ return ()++fillSurface :: Surface -> Color -> IO ()+fillSurface surface color = sdlFillRect surface Nothing color++fillRect :: Surface -> Rect.Rect -> Color -> IO ()+fillRect surface rect color = sdlFillRect surface (Just rect) color++initKeyRepeat :: IO ()+initKeyRepeat = Utils.ioBoolToError "enableKeyRepeat failed" $ SDL.enableKeyRepeat 150 10++withInit :: IO () -> IO ()+withInit = SDL.withInit [SDL.InitEverything] .+ Utils.bracket__ initKeyRepeat (return ()) .+ Font.withInit++pixel :: Surface -> Color -> IO SDL.Pixel+pixel surface (Color r g b) = SDL.mapRGB (SDL.surfaceGetPixelFormat surface) r g b++getEvents :: IO [Event]+getEvents = whileM (/=SDL.NoEvent) SDL.pollEvent++surfaceSize :: Surface -> Vector2 Int+surfaceSize surface = Vector2 (SDL.surfaceGetWidth surface)+ (SDL.surfaceGetHeight surface)++setVideoMode :: Int -> Int -> Int -> IO Surface+setVideoMode xres yres colorDepth = SDL.setVideoMode xres yres colorDepth [SDL.DoubleBuf]
+ src/Graphics/UI/HaskGame/Color.hs view
@@ -0,0 +1,11 @@+{-# OPTIONS -Wall -O2 #-}++module Graphics.UI.HaskGame.Color(Color(..))+where++import Data.Word(Word8)++data Color+ = Color {colorRed :: Word8,+ colorGreen :: Word8,+ colorBlue :: Word8}
+ src/Graphics/UI/HaskGame/Font.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS -Wall -O2 #-}++module Graphics.UI.HaskGame.Font+ (Font+ ,renderText,textSize+ ,defaultFont,withInit)+where++import qualified Graphics.UI.SDL as SDL+import qualified Graphics.UI.SDL.TTF as TTF+import qualified Graphics.UI.HaskGame.Utils as Utils+import Graphics.UI.HaskGame.Color(Color(..))+import Graphics.UI.HaskGame.Vector2(Vector2(..))++type Font = TTF.Font++renderText :: Font -> String -> Color -> IO SDL.Surface+renderText font text (Color r g b) = if null text+ then+ SDL.createRGBSurface [] 0 0 0 0 0 0 0+ else+ TTF.renderTextBlended font text (SDL.Color r g b)++textSize :: Font -> String -> IO (Vector2 Int)+textSize font text = do+ (w, h) <- TTF.textSize font text+ return $ Vector2 w h++defaultFont :: Int -> IO Font+defaultFont = TTF.openFont "/usr/share/fonts/truetype/freefont/FreeSerifBold.ttf"++withInit :: IO () -> IO ()+withInit = Utils.bracket__ (Utils.ioBoolToError "TTF init failure" TTF.init) TTF.quit
+ src/Graphics/UI/HaskGame/Key.hs view
@@ -0,0 +1,64 @@+{-# OPTIONS_GHC -Wall -O2 #-}++module Graphics.UI.HaskGame.Key+ (keyOfEvent+ ,ModKey(..),KeyGroup(..)+ ,singletonKeyGroup,asKeyGroup,keyName+ ,Mods(..),noMods,shift,ctrl,alt+ ,Keysym)+where++import qualified Graphics.UI.SDL as SDL+import qualified Data.Set as Set++type Keysym = SDL.Keysym+data Mods = MkMods { isShift, isCtrl, isAlt :: Bool }+ deriving (Eq, Ord, Show, Read)+data ModKey = ModKey Mods SDL.SDLKey+ deriving (Eq, Ord, Show)+data KeyGroup = KeyGroup {+ keyGroupName :: String+ , keyGroupKeys :: Set.Set ModKey+}+ deriving (Eq, Ord, Show)++singletonKeyGroup :: ModKey -> KeyGroup+singletonKeyGroup key = KeyGroup (keyName key) (Set.singleton key)++asKeyGroup :: Mods -> SDL.SDLKey -> KeyGroup+asKeyGroup = (fmap . fmap) singletonKeyGroup ModKey++modsName :: Mods -> String+modsName mods =+ let shiftStr = if isShift mods then "Shift+" else ""+ ctrlStr = if isCtrl mods then "Ctrl+" else ""+ altStr = if isAlt mods then "Alt+" else ""+ in concat [shiftStr, ctrlStr, altStr]++keyName :: ModKey -> String+keyName (ModKey mods sdlkey) = modsName mods ++ SDL.getKeyName sdlkey++noMods, shift, ctrl, alt :: Mods+noMods = MkMods False False False+shift = noMods{isShift=True}+ctrl = noMods{isCtrl=True}+alt = noMods{isAlt=True}++modsOf :: [SDL.Modifier] -> Mods+modsOf mods =+ MkMods (any (`elem` mods)+ [SDL.KeyModLeftShift,+ SDL.KeyModRightShift,+ SDL.KeyModShift])+ (any (`elem` mods)+ [SDL.KeyModLeftCtrl,+ SDL.KeyModRightCtrl,+ SDL.KeyModCtrl])+ (any (`elem` mods)+ [SDL.KeyModLeftAlt,+ SDL.KeyModRightAlt,+ SDL.KeyModAlt])++keyOfEvent :: Keysym -> ModKey+keyOfEvent keySym = ModKey (modsOf $ SDL.symModifiers keySym)+ (SDL.symKey keySym)
+ src/Graphics/UI/HaskGame/Keys.hs view
@@ -0,0 +1,194 @@+{-# OPTIONS_GHC -Wall -O2 #-}++module Graphics.UI.HaskGame.Keys+ (KeyGroup(..),allGroups,groupsOfKey,keysUnicode+ ,printableGroup,digitsGroup,lettersGroup+ ,upperCaseGroup,lowerCaseGroup,arrowsGroup+ )+where++import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Graphics.UI.SDL as SDL+import Graphics.UI.HaskGame.Key+ (noMods, shift, ModKey(..), KeyGroup(..)+ ,singletonKeyGroup)++inGroup :: ModKey -> KeyGroup -> Bool+key `inGroup` group = key `Set.member` (keyGroupKeys group)++groupsOfKey :: ModKey -> [KeyGroup]+groupsOfKey key = singletonKeyGroup key :+ filter (key `inGroup`) allGroups++allGroups :: [KeyGroup]+allGroups =+ [printableGroup+ ,digitsGroup+ ,lettersGroup+ ,upperCaseGroup+ ,lowerCaseGroup+ ,arrowsGroup+ ]++combineGroups :: String -> [KeyGroup] -> KeyGroup+combineGroups name groups = KeyGroup name (Set.unions . map keyGroupKeys $ groups)++keysSetOfUnicode :: Map.Map ModKey String -> Set.Set ModKey+keysSetOfUnicode = Set.fromList . Map.keys++printableGroup, digitsGroup, lettersGroup,+ upperCaseGroup, lowerCaseGroup, arrowsGroup :: KeyGroup+lettersGroup = combineGroups "Letters" [upperCaseGroup, lowerCaseGroup]+printableGroup = KeyGroup "Printable" . keysSetOfUnicode $ keysUnicode+digitsGroup = KeyGroup "Digits" . keysSetOfUnicode $ digitsUnicode+upperCaseGroup = KeyGroup "Upper-case letters" . keysSetOfUnicode $ upperCaseUnicode+lowerCaseGroup = KeyGroup "Lower-case letters" . keysSetOfUnicode $ lowerCaseUnicode+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.fromList $+ [(ModKey noMods SDL.SDLK_a, "a")+ ,(ModKey noMods SDL.SDLK_b, "b")+ ,(ModKey noMods SDL.SDLK_c, "c")+ ,(ModKey noMods SDL.SDLK_d, "d")+ ,(ModKey noMods SDL.SDLK_e, "e")+ ,(ModKey noMods SDL.SDLK_f, "f")+ ,(ModKey noMods SDL.SDLK_g, "g")+ ,(ModKey noMods SDL.SDLK_h, "h")+ ,(ModKey noMods SDL.SDLK_i, "i")+ ,(ModKey noMods SDL.SDLK_j, "j")+ ,(ModKey noMods SDL.SDLK_k, "k")+ ,(ModKey noMods SDL.SDLK_l, "l")+ ,(ModKey noMods SDL.SDLK_m, "m")+ ,(ModKey noMods SDL.SDLK_n, "n")+ ,(ModKey noMods SDL.SDLK_o, "o")+ ,(ModKey noMods SDL.SDLK_p, "p")+ ,(ModKey noMods SDL.SDLK_q, "q")+ ,(ModKey noMods SDL.SDLK_r, "r")+ ,(ModKey noMods SDL.SDLK_s, "s")+ ,(ModKey noMods SDL.SDLK_t, "t")+ ,(ModKey noMods SDL.SDLK_u, "u")+ ,(ModKey noMods SDL.SDLK_v, "v")+ ,(ModKey noMods SDL.SDLK_w, "w")+ ,(ModKey noMods SDL.SDLK_x, "x")+ ,(ModKey noMods SDL.SDLK_y, "y")+ ,(ModKey noMods SDL.SDLK_z, "z")+ ]+upperCaseUnicode = Map.fromList $+ [(ModKey shift SDL.SDLK_a, "A")+ ,(ModKey shift SDL.SDLK_b, "B")+ ,(ModKey shift SDL.SDLK_c, "C")+ ,(ModKey shift SDL.SDLK_d, "D")+ ,(ModKey shift SDL.SDLK_e, "E")+ ,(ModKey shift SDL.SDLK_f, "F")+ ,(ModKey shift SDL.SDLK_g, "G")+ ,(ModKey shift SDL.SDLK_h, "H")+ ,(ModKey shift SDL.SDLK_i, "I")+ ,(ModKey shift SDL.SDLK_j, "J")+ ,(ModKey shift SDL.SDLK_k, "K")+ ,(ModKey shift SDL.SDLK_l, "L")+ ,(ModKey shift SDL.SDLK_m, "M")+ ,(ModKey shift SDL.SDLK_n, "N")+ ,(ModKey shift SDL.SDLK_o, "O")+ ,(ModKey shift SDL.SDLK_p, "P")+ ,(ModKey shift SDL.SDLK_q, "Q")+ ,(ModKey shift SDL.SDLK_r, "R")+ ,(ModKey shift SDL.SDLK_s, "S")+ ,(ModKey shift SDL.SDLK_t, "T")+ ,(ModKey shift SDL.SDLK_u, "U")+ ,(ModKey shift SDL.SDLK_v, "V")+ ,(ModKey shift SDL.SDLK_w, "W")+ ,(ModKey shift SDL.SDLK_x, "X")+ ,(ModKey shift SDL.SDLK_y, "Y")+ ,(ModKey shift SDL.SDLK_z, "Z")+ ]+digitsUnicode = Map.fromList $+ [(ModKey noMods SDL.SDLK_0, "0")+ ,(ModKey noMods SDL.SDLK_1, "1")+ ,(ModKey noMods SDL.SDLK_2, "2")+ ,(ModKey noMods SDL.SDLK_3, "3")+ ,(ModKey noMods SDL.SDLK_4, "4")+ ,(ModKey noMods SDL.SDLK_5, "5")+ ,(ModKey noMods SDL.SDLK_6, "6")+ ,(ModKey noMods SDL.SDLK_7, "7")+ ,(ModKey noMods SDL.SDLK_8, "8")+ ,(ModKey noMods SDL.SDLK_9, "9")+ ,(ModKey shift SDL.SDLK_KP0, "0")+ ,(ModKey shift SDL.SDLK_KP1, "1")+ ,(ModKey shift SDL.SDLK_KP2, "2")+ ,(ModKey shift SDL.SDLK_KP3, "3")+ ,(ModKey shift SDL.SDLK_KP4, "4")+ ,(ModKey shift SDL.SDLK_KP5, "5")+ ,(ModKey shift SDL.SDLK_KP6, "6")+ ,(ModKey shift SDL.SDLK_KP7, "7")+ ,(ModKey shift SDL.SDLK_KP8, "8")+ ,(ModKey shift SDL.SDLK_KP9, "9")+ ]++keysUnicode :: Map.Map ModKey String+keysUnicode = Map.unions+ [lowerCaseUnicode+ ,upperCaseUnicode+ ,digitsUnicode,+ Map.fromList+ [(ModKey noMods SDL.SDLK_SPACE, " ")+ ,(ModKey noMods SDL.SDLK_EXCLAIM, "!")+ ,(ModKey noMods SDL.SDLK_QUOTEDBL, "\"")+ ,(ModKey noMods SDL.SDLK_HASH, "#")+ ,(ModKey noMods SDL.SDLK_DOLLAR, "$")+ ,(ModKey noMods SDL.SDLK_AMPERSAND, "&")+ ,(ModKey noMods SDL.SDLK_QUOTE, "'")+ ,(ModKey noMods SDL.SDLK_LEFTPAREN, "(")+ ,(ModKey noMods SDL.SDLK_RIGHTPAREN, ")")+ ,(ModKey noMods SDL.SDLK_ASTERISK, "*")+ ,(ModKey noMods SDL.SDLK_PLUS, "+")+ ,(ModKey noMods SDL.SDLK_COMMA, ",")+ ,(ModKey noMods SDL.SDLK_MINUS, "-")+ ,(ModKey noMods SDL.SDLK_PERIOD, ".")+ ,(ModKey noMods SDL.SDLK_SLASH, "/")+ ,(ModKey noMods SDL.SDLK_COLON, ":")+ ,(ModKey noMods SDL.SDLK_SEMICOLON, ";")+ ,(ModKey noMods SDL.SDLK_LESS, "<")+ ,(ModKey noMods SDL.SDLK_EQUALS, "=")+ ,(ModKey noMods SDL.SDLK_GREATER, ">")+ ,(ModKey noMods SDL.SDLK_QUESTION, "?")+ ,(ModKey noMods SDL.SDLK_AT, "@")+ ,(ModKey noMods SDL.SDLK_LEFTBRACKET, "[")+ ,(ModKey noMods SDL.SDLK_BACKSLASH, "\\")+ ,(ModKey noMods SDL.SDLK_RIGHTBRACKET, "]")+ ,(ModKey noMods SDL.SDLK_UNDERSCORE, "_")+ ,(ModKey noMods SDL.SDLK_BACKQUOTE, "`")++ ,(ModKey shift SDL.SDLK_QUOTE, "\"")+ ,(ModKey shift SDL.SDLK_COMMA, "<")+ ,(ModKey shift SDL.SDLK_MINUS, "_")+ ,(ModKey shift SDL.SDLK_PERIOD, ">")+ ,(ModKey shift SDL.SDLK_SLASH, "?")+ ,(ModKey shift SDL.SDLK_0, ")")+ ,(ModKey shift SDL.SDLK_1, "!")+ ,(ModKey shift SDL.SDLK_2, "@")+ ,(ModKey shift SDL.SDLK_3, "#")+ ,(ModKey shift SDL.SDLK_4, "$")+ ,(ModKey shift SDL.SDLK_5, "%")+ ,(ModKey shift SDL.SDLK_6, "^")+ ,(ModKey shift SDL.SDLK_7, "&")+ ,(ModKey shift SDL.SDLK_8, "*")+ ,(ModKey shift SDL.SDLK_9, "(")+ ,(ModKey shift SDL.SDLK_SEMICOLON, ":")+ ,(ModKey shift SDL.SDLK_EQUALS, "+")+ ,(ModKey shift SDL.SDLK_LEFTBRACKET, "{")+ ,(ModKey shift SDL.SDLK_BACKSLASH, "|")+ ,(ModKey shift SDL.SDLK_RIGHTBRACKET, "}")+ ,(ModKey shift SDL.SDLK_BACKQUOTE, "~")+ ,(ModKey shift SDL.SDLK_KP_PERIOD, ".")+ ,(ModKey shift SDL.SDLK_KP_DIVIDE, "/")+ ,(ModKey shift SDL.SDLK_KP_MULTIPLY, "*")+ ,(ModKey shift SDL.SDLK_KP_MINUS, "-")+ ,(ModKey shift SDL.SDLK_KP_PLUS, "+")+ ,(ModKey shift SDL.SDLK_KP_EQUALS, "=")+ ]]
+ src/Graphics/UI/HaskGame/Rect.hs view
@@ -0,0 +1,59 @@+module Graphics.UI.HaskGame.Rect+ (Rect+ ,rectToVectors+ ,vectorsToRect+ ,makeRect+ ,vectorsToPVectors, pVectorsToVectors+ ,inRect+ ,rectPos, rectSize+ ,rectX, rectY, rectW, rectH+ ,makePosRect+ ,unionRects)+where++import qualified Graphics.UI.SDL as SDL+import Graphics.UI.HaskGame.Vector2(Vector2(..), vector2first, vector2second)+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)++vectorsToRect :: Two (Vector2 Int) -> Rect+vectorsToRect (Vector2 x y, Vector2 w h) = SDL.Rect x y w h++makeRect :: Vector2 Int -> Vector2 Int -> Rect+makeRect = curry vectorsToRect++-- Rect to Positional vectors+vectorsToPVectors, pVectorsToVectors :: Endo (Two (Vector2 Int))+vectorsToPVectors (p, s) = (p, p+s)+pVectorsToVectors (p1, p2) = (p1, p2-p1)++inRect :: Endo (Two (Vector2 Int)) -> Endo Rect+inRect f = vectorsToRect . f . rectToVectors++rectPos, rectSize :: Endo (Vector2 Int) -> Endo Rect+rectPos = inRect . first+rectSize = inRect . second++rectX, rectY, rectW, rectH :: Endo Int -> Endo Rect+rectX = rectPos . vector2first+rectY = rectPos . vector2second+rectW = rectSize . vector2first+rectH = rectSize . vector2second++makePosRect :: Vector2 Int -> Rect+makePosRect (Vector2 x y) = SDL.Rect x y 0 0++unionRects :: Rect -> Rect -> Rect+unionRects r1 r2 =+ let (tl1, br1) = vectorsToPVectors . rectToVectors $ r1+ (tl2, br2) = vectorsToPVectors . rectToVectors $ r2+ in vectorsToRect . pVectorsToVectors $+ ((liftA2 min tl1 tl2),+ (liftA2 max br1 br2))
+ src/Graphics/UI/HaskGame/Utils.hs view
@@ -0,0 +1,19 @@+{-# OPTIONS -Wall -O2 #-}++module Graphics.UI.HaskGame.Utils+ (bracket__,ioBoolToError)+where++import qualified IO++bracket__ :: IO () -> IO () -> IO () -> IO ()+bracket__ pre post code = IO.bracket_ pre (const post) code++ioBoolToError :: String -> IO Bool -> IO ()+ioBoolToError errStr act = do+ isSuccess <- act+ if isSuccess+ then return ()+ else error errStr+-- Commented out for 6.8's lack of the new Exception+-- throwIO . userError $ errStr
+ src/Graphics/UI/HaskGame/Vector2.hs view
@@ -0,0 +1,40 @@+{-# OPTIONS -Wall -O2 #-}++module Graphics.UI.HaskGame.Vector2+ (Vector2(Vector2)+ ,vector2first,vector2second+ ,vector2fst,vector2snd)+where++import Control.Applicative(Applicative(..), liftA2)++data Vector2 a = Vector2 !a !a+ -- Note the Ord instance is obviously not a mathematical one+ -- (Vectors aren't ordinals!). Useful to have in a binary search+ -- tree though.+ deriving (Eq, Ord, Show, Read)++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)++instance Functor Vector2 where+ fmap f (Vector2 x y) = Vector2 (f x) (f y)+instance Applicative Vector2 where+ pure x = Vector2 x x+ Vector2 f g <*> Vector2 x y = Vector2 (f x) (g y)++-- An improper Num instance, for convenience+instance (Eq a, Show a, Num a) => Num (Vector2 a) where+ (+) = liftA2 (+)+ (-) = liftA2 (-)+ (*) = liftA2 (*)+ abs = fmap abs+ negate = fmap negate+ signum = fmap signum+ fromInteger = pure . fromInteger