├── assets ├── up.bmp ├── x.bmp ├── dots.png ├── down.bmp ├── foo.png ├── lazy.ttf ├── left.bmp ├── walk.png ├── arrow.png ├── colors.png ├── fadein.png ├── fadeout.png ├── loaded.png ├── press.bmp ├── right.bmp ├── stretch.bmp ├── texture.png ├── viewport.png ├── background.png ├── hello_world.bmp └── mouse_states.png ├── .gitignore ├── examples ├── lesson12 │ ├── src │ │ ├── Lesson12 │ │ │ ├── Intents.hs │ │ │ ├── Rendering.hs │ │ │ └── World.hs │ │ └── Lesson12.hs │ └── lesson12.cabal ├── lesson02 │ ├── src │ │ └── Lesson02.hs │ └── lesson02.cabal ├── lesson01 │ ├── lesson01.cabal │ └── src │ │ └── Lesson01.hs ├── lesson03 │ ├── lesson03.cabal │ └── src │ │ └── Lesson03.hs ├── lesson04 │ ├── lesson04.cabal │ └── src │ │ └── Lesson04.hs ├── lesson05 │ ├── lesson05.cabal │ └── src │ │ └── Lesson05.hs ├── lesson10 │ ├── lesson10.cabal │ └── src │ │ └── Lesson10.hs ├── lesson11 │ ├── lesson11.cabal │ └── src │ │ └── Lesson11.hs ├── lesson18 │ ├── lesson18.cabal │ └── src │ │ └── Lesson18.hs ├── lesson15 │ ├── lesson15.cabal │ └── src │ │ └── Lesson15.hs ├── lesson17 │ ├── lesson17.cabal │ └── src │ │ └── Lesson17.hs ├── lesson06 │ ├── lesson06.cabal │ └── src │ │ └── Lesson06.hs ├── lesson07 │ ├── lesson07.cabal │ └── src │ │ └── Lesson07.hs ├── lesson09 │ ├── lesson09.cabal │ └── src │ │ └── Lesson09.hs ├── lesson14 │ ├── lesson14.cabal │ └── src │ │ └── Lesson14.hs ├── lesson13 │ ├── lesson13.cabal │ └── src │ │ └── Lesson13.hs ├── lesson08 │ ├── lesson08.cabal │ └── src │ │ └── Lesson08.hs ├── lesson16 │ ├── lesson16.cabal │ └── src │ │ └── Lesson16.hs └── lesson19 │ ├── lesson19.cabal │ └── src │ └── Lesson19.hs ├── common ├── common.cabal └── lib │ └── Common.hs ├── stack.yaml.lock ├── stack.yaml ├── README.md └── LICENSE /assets/up.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/up.bmp -------------------------------------------------------------------------------- /assets/x.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/x.bmp -------------------------------------------------------------------------------- /assets/dots.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/dots.png -------------------------------------------------------------------------------- /assets/down.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/down.bmp -------------------------------------------------------------------------------- /assets/foo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/foo.png -------------------------------------------------------------------------------- /assets/lazy.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/lazy.ttf -------------------------------------------------------------------------------- /assets/left.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/left.bmp -------------------------------------------------------------------------------- /assets/walk.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/walk.png -------------------------------------------------------------------------------- /assets/arrow.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/arrow.png -------------------------------------------------------------------------------- /assets/colors.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/colors.png -------------------------------------------------------------------------------- /assets/fadein.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/fadein.png -------------------------------------------------------------------------------- /assets/fadeout.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/fadeout.png -------------------------------------------------------------------------------- /assets/loaded.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/loaded.png -------------------------------------------------------------------------------- /assets/press.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/press.bmp -------------------------------------------------------------------------------- /assets/right.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/right.bmp -------------------------------------------------------------------------------- /assets/stretch.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/stretch.bmp -------------------------------------------------------------------------------- /assets/texture.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/texture.png -------------------------------------------------------------------------------- /assets/viewport.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/viewport.png -------------------------------------------------------------------------------- /assets/background.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/background.png -------------------------------------------------------------------------------- /assets/hello_world.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/hello_world.bmp -------------------------------------------------------------------------------- /assets/mouse_states.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/palf/haskell-sdl2-examples/HEAD/assets/mouse_states.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | dist 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | .virtualenv 9 | .hsenv 10 | .cabal-sandbox/ 11 | cabal.sandbox.config 12 | cabal.config 13 | *.hp 14 | *.prof 15 | *.aux 16 | *.ps 17 | .stack-work 18 | vendor 19 | tags 20 | -------------------------------------------------------------------------------- /examples/lesson12/src/Lesson12/Intents.hs: -------------------------------------------------------------------------------- 1 | module Lesson12.Intents where 2 | 3 | 4 | data Color = Red | Green | Blue 5 | deriving (Show) 6 | 7 | 8 | data Intent 9 | = Increase Color 10 | | Decrease Color 11 | | Toggle Color 12 | | Idle 13 | | Quit 14 | deriving (Show) 15 | -------------------------------------------------------------------------------- /examples/lesson02/src/Lesson02.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | 8 | 9 | main :: IO () 10 | main = C.withSDL $ C.withWindow "Lesson 02" (640, 480) $ 11 | \w -> do 12 | 13 | screen <- SDL.getWindowSurface w 14 | image <- SDL.loadBMP "./assets/hello_world.bmp" 15 | 16 | C.renderSurfaceToWindow w screen image 17 | 18 | SDL.delay 2000 19 | SDL.freeSurface image 20 | SDL.freeSurface screen 21 | -------------------------------------------------------------------------------- /common/common.cabal: -------------------------------------------------------------------------------- 1 | name: common 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | library 9 | hs-source-dirs: lib 10 | exposed-modules: Common 11 | build-depends: base 12 | , sdl2 13 | , sdl2-image 14 | , text 15 | default-language: Haskell2010 16 | default-extensions: OverloadedStrings 17 | 18 | -------------------------------------------------------------------------------- /examples/lesson01/lesson01.cabal: -------------------------------------------------------------------------------- 1 | name: lesson01 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson01 10 | hs-source-dirs: src 11 | main-is: Lesson01.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , sdl2 16 | default-language: Haskell2010 17 | -------------------------------------------------------------------------------- /examples/lesson02/lesson02.cabal: -------------------------------------------------------------------------------- 1 | name: lesson02 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson02 10 | hs-source-dirs: src 11 | main-is: Lesson02.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , sdl2 16 | default-language: Haskell2010 17 | -------------------------------------------------------------------------------- /examples/lesson03/lesson03.cabal: -------------------------------------------------------------------------------- 1 | name: lesson03 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson03 10 | hs-source-dirs: src 11 | main-is: Lesson03.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /examples/lesson04/lesson04.cabal: -------------------------------------------------------------------------------- 1 | name: lesson04 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson04 10 | hs-source-dirs: src 11 | main-is: Lesson04.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /examples/lesson05/lesson05.cabal: -------------------------------------------------------------------------------- 1 | name: lesson05 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson05 10 | hs-source-dirs: src 11 | main-is: Lesson05.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /examples/lesson10/lesson10.cabal: -------------------------------------------------------------------------------- 1 | name: lesson10 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson10 10 | hs-source-dirs: src 11 | main-is: Lesson10.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /examples/lesson11/lesson11.cabal: -------------------------------------------------------------------------------- 1 | name: lesson11 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson11 10 | hs-source-dirs: src 11 | main-is: Lesson11.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /examples/lesson18/lesson18.cabal: -------------------------------------------------------------------------------- 1 | name: lesson18 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson18 10 | hs-source-dirs: src 11 | main-is: Lesson18.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /examples/lesson15/lesson15.cabal: -------------------------------------------------------------------------------- 1 | name: lesson15 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson15 10 | hs-source-dirs: src 11 | main-is: Lesson15.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , monad-loops 16 | , sdl2 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /examples/lesson17/lesson17.cabal: -------------------------------------------------------------------------------- 1 | name: lesson17 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson17 10 | hs-source-dirs: src 11 | main-is: Lesson17.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , monad-loops 16 | , sdl2 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: b37c0abab16c7de352c45b85f8ecc8530b084209a2c42987a96c92b4a5e3cd65 10 | size: 648924 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/13.yaml 12 | original: 13 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/13.yaml 14 | -------------------------------------------------------------------------------- /examples/lesson06/lesson06.cabal: -------------------------------------------------------------------------------- 1 | name: lesson06 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson06 10 | hs-source-dirs: src 11 | main-is: Lesson06.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | , sdl2-image 18 | default-language: Haskell2010 19 | -------------------------------------------------------------------------------- /examples/lesson07/lesson07.cabal: -------------------------------------------------------------------------------- 1 | name: lesson07 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson07 10 | hs-source-dirs: src 11 | main-is: Lesson07.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | , sdl2-image 18 | default-language: Haskell2010 19 | -------------------------------------------------------------------------------- /examples/lesson09/lesson09.cabal: -------------------------------------------------------------------------------- 1 | name: lesson09 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson09 10 | hs-source-dirs: src 11 | main-is: Lesson09.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | , sdl2-image 18 | default-language: Haskell2010 19 | -------------------------------------------------------------------------------- /examples/lesson14/lesson14.cabal: -------------------------------------------------------------------------------- 1 | name: lesson14 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson14 10 | hs-source-dirs: src 11 | main-is: Lesson14.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , sdl2 17 | , sdl2-image 18 | default-language: Haskell2010 19 | -------------------------------------------------------------------------------- /examples/lesson01/src/Lesson01.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | 8 | 9 | main :: IO () 10 | main = C.withSDL $ C.withWindow "Lesson 01" (640, 480) $ 11 | \w -> do 12 | 13 | screen <- SDL.getWindowSurface w 14 | -- pixelFormat <- SDL.surfaceFormat `applyToPointer` screen 15 | -- color <- SDL.mapRGB pixelFormat 0xFF 0xFF 0xFF 16 | SDL.surfaceFillRect screen Nothing (SDL.V4 maxBound maxBound maxBound maxBound) 17 | SDL.updateWindowSurface w 18 | 19 | SDL.delay 2000 20 | 21 | SDL.freeSurface screen 22 | -------------------------------------------------------------------------------- /examples/lesson13/lesson13.cabal: -------------------------------------------------------------------------------- 1 | name: lesson13 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson13 10 | hs-source-dirs: src 11 | main-is: Lesson13.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , monad-loops 16 | , sdl2 17 | , sdl2-image 18 | default-language: Haskell2010 19 | -------------------------------------------------------------------------------- /examples/lesson08/lesson08.cabal: -------------------------------------------------------------------------------- 1 | name: lesson08 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson08 10 | hs-source-dirs: src 11 | main-is: Lesson08.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , mtl 17 | , sdl2 18 | , transformers 19 | default-language: Haskell2010 20 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: 2 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/13.yaml 3 | 4 | packages: 5 | - common 6 | - examples/lesson01 7 | - examples/lesson02 8 | - examples/lesson03 9 | - examples/lesson04 10 | - examples/lesson05 11 | - examples/lesson06 12 | - examples/lesson07 13 | - examples/lesson08 14 | - examples/lesson09 15 | - examples/lesson10 16 | - examples/lesson11 17 | - examples/lesson12 18 | - examples/lesson13 19 | - examples/lesson14 20 | - examples/lesson15 21 | - examples/lesson16 22 | - examples/lesson17 23 | - examples/lesson18 24 | - examples/lesson19 25 | -------------------------------------------------------------------------------- /examples/lesson16/lesson16.cabal: -------------------------------------------------------------------------------- 1 | name: lesson16 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson16 10 | hs-source-dirs: src 11 | main-is: Lesson16.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , extra 16 | , monad-loops 17 | , sdl2 18 | , sdl2-ttf 19 | , text 20 | default-language: Haskell2010 21 | -------------------------------------------------------------------------------- /examples/lesson12/lesson12.cabal: -------------------------------------------------------------------------------- 1 | name: lesson12 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson12 10 | hs-source-dirs: src 11 | main-is: Lesson12.hs 12 | other-modules: Lesson12.Intents 13 | , Lesson12.Rendering 14 | , Lesson12.World 15 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 16 | build-depends: base 17 | , common 18 | , monad-loops 19 | , sdl2 20 | , sdl2-image 21 | default-language: Haskell2010 22 | -------------------------------------------------------------------------------- /examples/lesson19/lesson19.cabal: -------------------------------------------------------------------------------- 1 | name: lesson19 2 | version: 0.1.0.0 3 | author: Jack Palfrey 4 | maintainer: jack.palf@gmail.com 5 | cabal-version: >=1.10 6 | build-type: Simple 7 | 8 | 9 | executable lesson19 10 | hs-source-dirs: src 11 | main-is: Lesson19.hs 12 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 13 | build-depends: base 14 | , common 15 | , monad-loops 16 | , sdl2 17 | , sdl2-image 18 | , vector 19 | , text 20 | , mtl 21 | , transformers 22 | default-language: Haskell2010 23 | -------------------------------------------------------------------------------- /examples/lesson12/src/Lesson12/Rendering.hs: -------------------------------------------------------------------------------- 1 | module Lesson12.Rendering 2 | ( renderWorld 3 | ) where 4 | 5 | import Lesson12.World 6 | 7 | import qualified SDL 8 | 9 | import Control.Monad.IO.Class (MonadIO) 10 | import SDL (($=)) 11 | 12 | 13 | modifyTexture :: (MonadIO m) => SDL.Texture -> World -> m () 14 | modifyTexture t w = SDL.textureColorMod t $= rgb 15 | where 16 | convert v = floor . v . colors 17 | r = convert redV w 18 | g = convert greenV w 19 | b = convert blueV w 20 | rgb = SDL.V3 r g b 21 | 22 | 23 | renderWorld :: (MonadIO m) => SDL.Renderer -> SDL.Texture -> World -> m () 24 | renderWorld r t w = do 25 | SDL.clear r 26 | modifyTexture t w 27 | SDL.copy r t Nothing Nothing 28 | SDL.present r 29 | -------------------------------------------------------------------------------- /examples/lesson07/src/Lesson07.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | import qualified SDL.Image 8 | 9 | import Control.Monad.Extra (whileM) 10 | import Control.Monad.IO.Class (MonadIO) 11 | 12 | 13 | draw :: (MonadIO m) => SDL.Renderer -> SDL.Texture -> m () 14 | draw r t = do 15 | SDL.clear r 16 | SDL.copy r t Nothing Nothing 17 | SDL.present r 18 | 19 | 20 | main :: IO () 21 | main = C.withSDL $ do 22 | C.setHintQuality 23 | C.withWindow "Lesson 07" (640, 480) $ \w -> 24 | C.withRenderer w $ \r -> do 25 | 26 | t <- SDL.Image.loadTexture r "./assets/texture.png" 27 | 28 | draw r t 29 | whileM $ not . C.hasQuitEvent <$> SDL.pollEvents 30 | 31 | SDL.destroyTexture t 32 | -------------------------------------------------------------------------------- /examples/lesson05/src/Lesson05.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | 8 | import Control.Monad.Extra (whileM) 9 | import Control.Monad.IO.Class (MonadIO) 10 | 11 | 12 | draw :: (MonadIO m) => SDL.Window -> SDL.Surface -> SDL.Surface -> m () 13 | draw w s t 14 | = SDL.surfaceBlitScaled t Nothing s Nothing 15 | >> SDL.updateWindowSurface w 16 | 17 | 18 | main :: IO () 19 | main = C.withSDL $ C.withWindow "Lesson 05" (640, 480) $ 20 | \w -> do 21 | 22 | screen <- SDL.getWindowSurface w 23 | pixelFormat <- SDL.surfaceFormat screen 24 | 25 | image <- SDL.loadBMP "./assets/stretch.bmp" 26 | surface <- SDL.convertSurface image pixelFormat 27 | 28 | draw w screen surface 29 | whileM $ not . C.hasQuitEvent <$> SDL.pollEvents 30 | 31 | mapM_ SDL.freeSurface [image, surface, screen] 32 | -------------------------------------------------------------------------------- /examples/lesson06/src/Lesson06.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | import qualified SDL.Image 8 | 9 | import Control.Monad.Extra (whileM) 10 | import Control.Monad.IO.Class (MonadIO) 11 | 12 | 13 | draw :: (MonadIO m) => SDL.Window -> SDL.Surface -> SDL.Surface -> m () 14 | draw w s t 15 | = SDL.surfaceBlitScaled t Nothing s Nothing 16 | >> SDL.updateWindowSurface w 17 | 18 | 19 | main :: IO () 20 | main = C.withSDL $ C.withWindow "Lesson 06" (640, 480) $ 21 | \w -> do 22 | 23 | screen <- SDL.getWindowSurface w 24 | pixelFormat <- SDL.surfaceFormat screen 25 | 26 | image <- SDL.Image.load "./assets/loaded.png" 27 | surface <- SDL.convertSurface image pixelFormat 28 | 29 | draw w screen surface 30 | whileM $ not . C.hasQuitEvent <$> SDL.pollEvents 31 | 32 | SDL.freeSurface image 33 | SDL.freeSurface surface 34 | SDL.freeSurface screen 35 | -------------------------------------------------------------------------------- /examples/lesson03/src/Lesson03.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Main (main) where 5 | 6 | import qualified Common as C 7 | import qualified SDL 8 | 9 | import Control.Monad.IO.Class (MonadIO) 10 | 11 | 12 | data Status = Quit | Idle 13 | 14 | 15 | withBitmap :: (MonadIO m) => FilePath -> (SDL.Surface -> m a) -> m () 16 | withBitmap path op = do 17 | image <- SDL.loadBMP path 18 | _ <- op image 19 | SDL.freeSurface image 20 | 21 | 22 | untilQuit :: (Monad m) => m Status -> m () 23 | untilQuit op = loop 24 | where 25 | loop = op >>= \case Idle -> loop 26 | Quit -> pure () 27 | 28 | 29 | mapEventsToStatus :: [SDL.Event] -> Status 30 | mapEventsToStatus evs = 31 | if C.hasQuitEvent evs 32 | then Quit 33 | else Idle 34 | 35 | 36 | appLoop :: (MonadIO m) => m () 37 | appLoop = untilQuit $ mapEventsToStatus <$> SDL.pollEvents 38 | 39 | 40 | main :: IO () 41 | main = C.withSDL $ C.withWindow "Lesson 03" (640, 480) $ 42 | \w -> do 43 | screen <- SDL.getWindowSurface w 44 | 45 | let draw image = SDL.surfaceBlit image Nothing screen Nothing >> SDL.updateWindowSurface w 46 | 47 | withBitmap "./assets/x.bmp" $ \image -> do 48 | draw image 49 | appLoop 50 | 51 | SDL.freeSurface screen 52 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell SDL2 Examples 2 | 3 | Some simple SDL2 examples in Haskell 4 | 5 | Check out the inspiration [here](http://lazyfoo.net/tutorials/SDL/index.php) 6 | 7 | ## Setup 8 | 9 | You'll need a working SDL2 installation 10 | 11 | We're using [Stack](https://docs.haskellstack.org) 12 | 13 | ```sh 14 | stack setup 15 | stack build --pedantic 16 | ``` 17 | 18 | ## Running Examples 19 | 20 | List available examples: 21 | 22 | ```sh 23 | stack ide targets 24 | ``` 25 | 26 | Run an example: 27 | ```sh 28 | stack exec lesson01 29 | ``` 30 | 31 | ## Lesson Output 32 | 33 | * Lesson 01 - a white box which remains for two seconds 34 | * Lesson 02 - "Hello World" text taken from a bitmap (remains for 2 seconds) 35 | * Lesson 03 - a window with instructions to close it (remains until closed) 36 | * Lesson 04 - instructions to press arrow keys, followed by content changing on key press 37 | * Lesson 05 - a stretched image in the window 38 | * Lesson 06 - a "png loaded" message, loaded from a png (!) 39 | * Lesson 07 - a "rendering texture" message 40 | * Lesson 08 - a red box with a green outline, a blue strikethrough and yellow vertical dots 41 | * Lesson 09 - the text "Here's a viewport" in three different locations 42 | * Lesson 10 - a stick figure sitting on a hill 43 | * Lesson 11 - a different coloured dot in each corner of the window 44 | * Lesson 12 - a coloured window that changes when pressing any of Q, W, E, A, S, D 45 | * Lesson 13 - press 'w' and 's' to fade in or out the foreground 46 | * Lesson 14 - a walking animation 47 | * Lesson 15 - an arrow that rotates with the Q, W, E, A and D keys 48 | -------------------------------------------------------------------------------- /examples/lesson09/src/Lesson09.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | import qualified SDL.Image 8 | 9 | import Control.Monad.Extra (whileM) 10 | import Control.Monad.IO.Class (MonadIO) 11 | import Foreign.C.Types (CInt) 12 | import SDL (($=)) 13 | 14 | 15 | screenWidth :: CInt 16 | screenWidth = 640 17 | 18 | 19 | screenHeight :: CInt 20 | screenHeight = 480 21 | 22 | 23 | setViewport :: (MonadIO m) => SDL.Renderer -> SDL.Rectangle CInt -> m () 24 | setViewport r s = SDL.rendererViewport r $= Just s 25 | 26 | 27 | drawTexture :: (MonadIO m) => SDL.Renderer -> SDL.Texture -> m () 28 | drawTexture r t = SDL.copy r t Nothing Nothing 29 | 30 | 31 | draw :: (MonadIO m) => SDL.Renderer -> SDL.Texture -> m () 32 | draw r t = do 33 | SDL.clear r 34 | 35 | setViewport r topLeft 36 | drawTexture r t 37 | 38 | setViewport r topRight 39 | drawTexture r t 40 | 41 | setViewport r bottom 42 | drawTexture r t 43 | 44 | SDL.present r 45 | 46 | where 47 | topLeft = C.mkRect 0 0 (screenWidth `div` 2) (screenHeight `div` 2) 48 | topRight = C.mkRect (screenWidth `div` 2) 0 (screenWidth `div` 2) (screenHeight `div` 2) 49 | bottom = C.mkRect 0 (screenHeight `div` 2) screenWidth (screenHeight `div` 2) 50 | 51 | 52 | main :: IO () 53 | main = C.withSDL $ 54 | C.withWindow "Lesson 09" (640, 480) $ \w -> 55 | C.withRenderer w $ \r -> do 56 | 57 | SDL.rendererDrawColor r $= SDL.V4 maxBound maxBound maxBound maxBound 58 | t <- SDL.Image.loadTexture r "./assets/viewport.png" 59 | 60 | draw r t 61 | whileM $ not . C.hasQuitEvent <$> SDL.pollEvents 62 | 63 | SDL.destroyTexture t 64 | 65 | -------------------------------------------------------------------------------- /examples/lesson16/src/Lesson16.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TypeSynonymInstances #-} 5 | 6 | module Main (main) where 7 | 8 | import qualified Common as C 9 | import qualified SDL 10 | import qualified SDL.Font 11 | 12 | import Control.Monad.Extra (whileM) 13 | import Control.Monad.IO.Class (MonadIO) 14 | import Data.Text 15 | import Foreign.C.Types 16 | import GHC.Word 17 | import SDL (($=)) 18 | 19 | 20 | colorBlack :: SDL.V4 Word8 21 | colorBlack = SDL.V4 0 0 0 0 22 | 23 | 24 | colorWhite :: SDL.V4 Word8 25 | colorWhite = SDL.V4 maxBound maxBound maxBound maxBound 26 | 27 | 28 | loadFontSurface :: (MonadIO m) => FilePath -> SDL.Font.PointSize -> Text -> m (SDL.Surface , SDL.V2 CInt) 29 | loadFontSurface path size text = do 30 | font <- SDL.Font.load path size 31 | surf <- SDL.Font.shaded font colorBlack colorWhite text 32 | dim <- SDL.surfaceDimensions surf 33 | 34 | pure (surf, dim) 35 | 36 | 37 | draw :: (MonadIO m) => SDL.Renderer -> (SDL.Texture, SDL.V2 CInt) -> m () 38 | draw r (t, SDL.V2 tw th) = do 39 | SDL.rendererDrawColor r $= colorWhite 40 | SDL.clear r 41 | 42 | SDL.copy r t Nothing (Just pos) 43 | SDL.present r 44 | 45 | where 46 | s = C.mkRect 0 0 (fromIntegral tw :: Double) (fromIntegral th) 47 | w = C.mkRect 0 0 640 480 48 | pos = round <$> C.centerWithin s w 49 | 50 | 51 | main :: IO () 52 | main = C.withSDL $ do 53 | SDL.Font.initialize 54 | 55 | C.setHintQuality 56 | C.withWindow "Lesson 16" (640, 480) $ \w -> 57 | C.withRenderer w $ \r -> do 58 | 59 | (surf, dim) <- loadFontSurface "./assets/lazy.ttf" 32 "some fish are delicious" 60 | t <- SDL.createTextureFromSurface r surf 61 | 62 | draw r (t, dim) 63 | whileM $ not . C.hasQuitEvent <$> SDL.pollEvents 64 | 65 | SDL.destroyTexture t 66 | 67 | SDL.Font.quit 68 | -------------------------------------------------------------------------------- /examples/lesson12/src/Lesson12.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified Lesson12.Rendering as R 7 | import qualified Lesson12.World as W 8 | import qualified SDL 9 | import qualified SDL.Image 10 | 11 | import Control.Monad.Loops (iterateUntilM) 12 | import Lesson12.Intents 13 | 14 | 15 | payloadToIntent :: SDL.EventPayload -> Intent 16 | payloadToIntent SDL.QuitEvent = Quit 17 | payloadToIntent (SDL.KeyboardEvent k) = getKey k 18 | payloadToIntent _ = Idle 19 | 20 | 21 | updateWorld :: W.World -> [SDL.Event] -> W.World 22 | updateWorld w 23 | = W.updateWorld w 24 | . fmap (payloadToIntent . SDL.eventPayload) 25 | 26 | 27 | getKey :: SDL.KeyboardEventData -> Intent 28 | getKey (SDL.KeyboardEventData _ SDL.Released _ _) = Idle 29 | getKey (SDL.KeyboardEventData _ SDL.Pressed True _) = Idle 30 | getKey (SDL.KeyboardEventData _ SDL.Pressed False keysym) = 31 | case SDL.keysymKeycode keysym of 32 | SDL.KeycodeEscape -> Quit 33 | SDL.KeycodeQ -> Increase Red 34 | SDL.KeycodeW -> Increase Green 35 | SDL.KeycodeE -> Increase Blue 36 | SDL.KeycodeA -> Decrease Red 37 | SDL.KeycodeS -> Decrease Green 38 | SDL.KeycodeD -> Decrease Blue 39 | SDL.KeycodeZ -> Toggle Red 40 | SDL.KeycodeX -> Toggle Green 41 | SDL.KeycodeC -> Toggle Blue 42 | _ -> Idle 43 | 44 | 45 | 46 | main :: IO () 47 | main = C.withSDL $ C.withSDLImage $ do 48 | C.setHintQuality 49 | C.withWindow "Lesson 12" (640, 480) $ \w -> 50 | C.withRenderer w $ \r -> do 51 | t <- SDL.Image.loadTexture r "./assets/colors.png" 52 | 53 | let doRender = R.renderWorld r t 54 | 55 | _ <- iterateUntilM 56 | W.exiting 57 | (\x -> 58 | updateWorld x <$> SDL.pollEvents 59 | >>= \x' -> x' <$ doRender x' 60 | ) 61 | W.initialWorld 62 | 63 | SDL.destroyTexture t 64 | -------------------------------------------------------------------------------- /examples/lesson10/src/Lesson10.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFoldable #-} 2 | {-# LANGUAGE DeriveTraversable #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module Main (main) where 6 | 7 | import qualified Common as C 8 | import qualified SDL 9 | 10 | import Control.Monad.Extra (whileM) 11 | import Control.Monad.IO.Class (MonadIO) 12 | import SDL (($=)) 13 | 14 | 15 | data AssetMap a = AssetMap 16 | { background :: a 17 | , foreground :: a 18 | } deriving (Functor, Foldable, Traversable) 19 | 20 | 21 | type PathMap = AssetMap FilePath 22 | type TextureMap = AssetMap (SDL.Texture, SDL.TextureInfo) 23 | 24 | 25 | assetPaths :: PathMap 26 | assetPaths = AssetMap 27 | { background = "./assets/background.png" 28 | , foreground = "./assets/foo.png" 29 | } 30 | 31 | 32 | loadTextures :: (MonadIO m) => SDL.Renderer -> PathMap -> m TextureMap 33 | loadTextures r = mapM (C.loadTextureWithInfo r) 34 | 35 | 36 | renderTexture 37 | :: (Num a, RealFrac a, MonadIO m) 38 | => SDL.Renderer 39 | -> (SDL.Texture, SDL.TextureInfo) 40 | -> (a, a) 41 | -> m () 42 | 43 | renderTexture r (t, ti) (x, y) 44 | = SDL.copy r t Nothing (Just $ C.mkRect x' y' a b) 45 | 46 | where 47 | x' = floor x 48 | y' = floor y 49 | a = SDL.textureWidth ti 50 | b = SDL.textureHeight ti 51 | 52 | 53 | draw :: (MonadIO m) => SDL.Renderer -> TextureMap -> m () 54 | draw r ts = do 55 | SDL.rendererDrawColor r $= SDL.V4 maxBound maxBound maxBound maxBound 56 | SDL.clear r 57 | 58 | renderTexture r (background ts) (0, 0 :: Double) 59 | renderTexture r (foreground ts) (240, 190 :: Double) 60 | 61 | SDL.present r 62 | 63 | 64 | main :: IO () 65 | main = C.withSDL $ C.withSDLImage $ do 66 | C.setHintQuality 67 | C.withWindow "Lesson 10" (640, 480) $ \w -> 68 | C.withRenderer w $ \r -> do 69 | ts <- loadTextures r assetPaths 70 | 71 | draw r ts 72 | whileM $ not . C.hasQuitEvent <$> SDL.pollEvents 73 | 74 | mapM_ (SDL.destroyTexture . fst) ts 75 | -------------------------------------------------------------------------------- /examples/lesson11/src/Lesson11.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | 8 | import Common (moveTo) 9 | import Control.Monad.Extra (whileM) 10 | import Control.Monad.IO.Class (MonadIO) 11 | import SDL (($=)) 12 | 13 | 14 | windowSize :: (Num a) => (a, a) 15 | windowSize = (640, 480) 16 | 17 | 18 | renderTexture 19 | :: (Integral a, MonadIO m) 20 | => SDL.Renderer 21 | -> SDL.Texture 22 | -> SDL.Rectangle a 23 | -> SDL.Rectangle a 24 | -> m () 25 | 26 | renderTexture r t mask pos = 27 | SDL.copy r t (Just $ fromIntegral <$> mask) (Just $ fromIntegral <$> pos) 28 | 29 | 30 | draw :: (MonadIO m) => SDL.Renderer -> (SDL.Texture, SDL.TextureInfo) -> m () 31 | draw r (t, ti) = do 32 | SDL.rendererDrawColor r $= SDL.V4 maxBound maxBound maxBound maxBound 33 | SDL.clear r 34 | 35 | renderTexture r t (d `moveTo` mTL) (d `moveTo` pTL) 36 | renderTexture r t (d `moveTo` mTR) (d `moveTo` pTR) 37 | renderTexture r t (d `moveTo` mBL) (d `moveTo` pBL) 38 | renderTexture r t (d `moveTo` mBR) (d `moveTo` pBR) 39 | 40 | SDL.present r 41 | 42 | where 43 | (sw, sh) = windowSize 44 | 45 | tw = fromIntegral ( SDL.textureWidth ti ) :: Double 46 | th = fromIntegral ( SDL.textureHeight ti ) :: Double 47 | 48 | d = C.mkRect 0 0 (round $ tw / 2) (round $ th / 2) 49 | 50 | mTL = ( 0 , 0) 51 | mTR = (100 , 0) 52 | mBL = ( 0 , 100) 53 | mBR = (100 , 100) 54 | 55 | px = sw - round (tw / 2) :: Int 56 | py = sh - round (th / 2) :: Int 57 | 58 | pTL = ( 0 , 0) 59 | pTR = (px , 0) 60 | pBL = ( 0 , py) 61 | pBR = (px , py) 62 | 63 | 64 | main :: IO () 65 | main = C.withSDL $ C.withSDLImage $ do 66 | C.setHintQuality 67 | C.withWindow "Lesson 11" windowSize $ \w -> 68 | C.withRenderer w $ \r -> do 69 | t <- C.loadTextureWithInfo r "./assets/dots.png" 70 | 71 | draw r t 72 | whileM $ not . C.hasQuitEvent <$> SDL.pollEvents 73 | 74 | SDL.destroyTexture (fst t) 75 | -------------------------------------------------------------------------------- /common/lib/Common.hs: -------------------------------------------------------------------------------- 1 | module Common where 2 | 3 | import qualified SDL 4 | import qualified SDL.Image 5 | 6 | import Control.Monad (void) 7 | import Control.Monad.IO.Class (MonadIO) 8 | import Data.Text (Text) 9 | 10 | import SDL (($=)) 11 | 12 | 13 | -- NOTE: can throw 14 | withSDL :: (MonadIO m) => m a -> m () 15 | withSDL op = do 16 | SDL.initializeAll 17 | _ <- op 18 | SDL.quit 19 | 20 | 21 | -- NOTE: probably not required 22 | withSDLImage :: (MonadIO m) => m a -> m () 23 | withSDLImage op 24 | = SDL.Image.initialize [] >> void op >> SDL.Image.quit 25 | 26 | 27 | withWindow :: (MonadIO m) => Text -> (Int, Int) -> (SDL.Window -> m a) -> m () 28 | withWindow title (x, y) op = do 29 | w <- SDL.createWindow title p 30 | SDL.showWindow w 31 | void $ op w 32 | SDL.destroyWindow w 33 | 34 | where 35 | p = SDL.defaultWindow { SDL.windowInitialSize = z } 36 | z = SDL.V2 (fromIntegral x) (fromIntegral y) 37 | 38 | 39 | withRenderer :: (MonadIO m) => SDL.Window -> (SDL.Renderer -> m a) -> m () 40 | withRenderer w op = do 41 | r <- SDL.createRenderer w (-1) rendererConfig 42 | void $ op r 43 | SDL.destroyRenderer r 44 | 45 | 46 | rendererConfig :: SDL.RendererConfig 47 | rendererConfig = SDL.RendererConfig 48 | { SDL.rendererType = SDL.AcceleratedVSyncRenderer 49 | , SDL.rendererTargetTexture = False 50 | } 51 | 52 | 53 | renderSurfaceToWindow :: (MonadIO m) => SDL.Window -> SDL.Surface -> SDL.Surface -> m () 54 | renderSurfaceToWindow w s i 55 | = SDL.surfaceBlit i Nothing s Nothing 56 | >> SDL.updateWindowSurface w 57 | 58 | 59 | hasQuitEvent :: [SDL.Event] -> Bool 60 | hasQuitEvent = elem SDL.QuitEvent . map SDL.eventPayload 61 | 62 | 63 | setHintQuality :: (MonadIO m) => m () 64 | setHintQuality = SDL.HintRenderScaleQuality $= SDL.ScaleNearest 65 | 66 | 67 | loadTextureWithInfo :: (MonadIO m) => SDL.Renderer -> FilePath -> m (SDL.Texture, SDL.TextureInfo) 68 | loadTextureWithInfo r p = do 69 | t <- SDL.Image.loadTexture r p 70 | i <- SDL.queryTexture t 71 | pure (t, i) 72 | 73 | 74 | mkPoint :: a -> a -> SDL.Point SDL.V2 a 75 | mkPoint x y = SDL.P (SDL.V2 x y) 76 | 77 | 78 | mkRect :: a -> a -> a -> a -> SDL.Rectangle a 79 | mkRect x y w h = SDL.Rectangle o z 80 | where 81 | o = SDL.P (SDL.V2 x y) 82 | z = SDL.V2 w h 83 | 84 | 85 | moveTo :: SDL.Rectangle a -> (a, a) -> SDL.Rectangle a 86 | moveTo (SDL.Rectangle _ d) (x, y) = SDL.Rectangle (mkPoint x y) d 87 | 88 | 89 | centerWithin :: (Fractional a) => SDL.Rectangle a -> SDL.Rectangle a -> SDL.Rectangle a 90 | centerWithin (SDL.Rectangle _ iz) (SDL.Rectangle (SDL.P op) oz) 91 | = SDL.Rectangle p iz 92 | where 93 | p = SDL.P $ op + (oz - iz) / 2 94 | 95 | -------------------------------------------------------------------------------- /examples/lesson08/src/Lesson08.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module Main (main) where 6 | 7 | import qualified Common as C 8 | import qualified SDL 9 | 10 | import Control.Monad.Extra (whileM) 11 | import Control.Monad.IO.Class (MonadIO) 12 | import Control.Monad.Reader (MonadReader, ask, runReaderT) 13 | import Data.Word 14 | import Foreign.C.Types (CInt) 15 | import SDL (($=)) 16 | 17 | 18 | data Colour = White | Red | Blue | Green | Yellow 19 | 20 | 21 | type HasRenderer m = ( MonadIO m, MonadReader SDL.Renderer m) 22 | 23 | 24 | setColour :: (HasRenderer m) => Colour -> m () 25 | setColour c = do 26 | r <- ask 27 | SDL.rendererDrawColor r $= getColour c 28 | 29 | where 30 | getColour :: Colour -> SDL.V4 Word8 31 | getColour White = SDL.V4 maxBound maxBound maxBound maxBound 32 | getColour Red = SDL.V4 maxBound 0 0 maxBound 33 | getColour Green = SDL.V4 0 maxBound 0 maxBound 34 | getColour Blue = SDL.V4 0 0 maxBound maxBound 35 | getColour Yellow = SDL.V4 maxBound maxBound 0 maxBound 36 | 37 | 38 | clearScreen :: (HasRenderer m) => m () 39 | clearScreen = do 40 | r <- ask 41 | setColour White 42 | SDL.clear r 43 | 44 | 45 | drawRectangle :: (HasRenderer m) => SDL.Rectangle CInt -> m () 46 | drawRectangle s = ask >>= \r -> SDL.drawRect r (Just s) 47 | 48 | 49 | fillRectangle :: (HasRenderer m) => SDL.Rectangle CInt -> m () 50 | fillRectangle s = ask >>= \r -> SDL.fillRect r (Just s) 51 | 52 | 53 | drawLine :: (HasRenderer m) => (CInt, CInt) -> (CInt, CInt) -> m () 54 | drawLine (ox, oy) (tx, ty) = 55 | ask >>= \r -> SDL.drawLine r (C.mkPoint ox oy) (C.mkPoint tx ty) 56 | 57 | 58 | drawDot :: (HasRenderer m) => (CInt, CInt) -> m () 59 | drawDot (x, y) = ask >>= \r -> SDL.drawPoint r (SDL.P (SDL.V2 x y)) 60 | 61 | 62 | mkRect :: t -> t -> t -> t -> SDL.Rectangle t 63 | mkRect x y w h = SDL.Rectangle o s 64 | where o = SDL.P (SDL.V2 x y) 65 | s = SDL.V2 w h 66 | 67 | 68 | screenWidth :: (Num a) => a 69 | screenWidth = 640 70 | 71 | 72 | screenHeight :: (Num a) => a 73 | screenHeight = 480 74 | 75 | 76 | draw :: (HasRenderer m) => m () 77 | draw = do 78 | clearScreen 79 | setColour Red >> fillRectangle innerRect 80 | setColour Green >> drawRectangle outerRect 81 | setColour Blue >> drawLine (0, h `div` 2) (w, h `div` 2) 82 | setColour Yellow >> mapM_ (\y -> drawDot (w `div` 2, y)) [ 0, 4 .. h ] 83 | 84 | ask >>= SDL.present 85 | 86 | where 87 | w = screenWidth 88 | h = screenHeight 89 | innerRect = mkRect (w `div` 4) (h `div` 4) (w `div` 2) (h `div` 2) 90 | outerRect = mkRect (w `div` 6) (h `div` 6) (2 * w `div` 3) (2 * h `div` 3) 91 | 92 | 93 | main :: IO () 94 | main = C.withSDL $ do 95 | C.setHintQuality 96 | C.withWindow "Lesson 08" (screenWidth, screenHeight) $ \w -> 97 | C.withRenderer w $ \r -> do 98 | 99 | runReaderT (setColour White) r 100 | runReaderT draw r 101 | 102 | whileM $ not . C.hasQuitEvent <$> SDL.pollEvents 103 | -------------------------------------------------------------------------------- /examples/lesson14/src/Lesson14.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TypeSynonymInstances #-} 5 | 6 | module Main (main) where 7 | 8 | import qualified Common as C 9 | import qualified SDL 10 | import qualified SDL.Image 11 | import qualified SDL.Raw.Timer as Raw 12 | 13 | import Control.Monad (unless) 14 | import Control.Monad.IO.Class (MonadIO, liftIO) 15 | import Data.List.Extra 16 | 17 | 18 | data World = World 19 | { exiting :: Bool 20 | , frame :: Int 21 | } deriving (Show) 22 | 23 | 24 | data Intent = Quit deriving (Show) 25 | 26 | 27 | initialApp :: World 28 | initialApp = World 29 | { exiting = False 30 | , frame = 0 31 | } 32 | 33 | 34 | repeatUntil :: (Monad m) => (a -> m a) -> (a -> Bool) -> a -> m () 35 | repeatUntil f p = loop 36 | where loop a = f a >>= \b -> unless (p b) (loop b) 37 | 38 | 39 | runApp :: (Monad m) => (World -> m World) -> World -> m () 40 | runApp f = repeatUntil f exiting 41 | 42 | 43 | -- TODO: this should be in common 44 | measureFPS :: (MonadIO m) => m a -> m a 45 | measureFPS op = do 46 | start <- Raw.getPerformanceCounter 47 | x <- op 48 | end <- Raw.getPerformanceCounter 49 | 50 | freq <- Raw.getPerformanceFrequency 51 | let elapsed = (fromIntegral (end - start) / fromIntegral freq) :: Double 52 | liftIO $ print (1 / elapsed) 53 | pure x 54 | 55 | 56 | pollIntents :: (MonadIO m) => m (Maybe Intent) 57 | pollIntents = firstJust f . fmap SDL.eventPayload <$> SDL.pollEvents 58 | where 59 | f :: SDL.EventPayload -> Maybe Intent 60 | f SDL.QuitEvent = Just Quit 61 | f _ = Nothing 62 | 63 | 64 | updateApp :: World -> Maybe Intent -> World 65 | updateApp a Nothing = a { frame = frame a + 1 } 66 | updateApp a (Just Quit) = a { exiting = True } 67 | 68 | 69 | appLoop :: (MonadIO m) => (World -> m ()) -> World -> m World 70 | appLoop r w = do 71 | xs <- pollIntents 72 | let w' = updateApp w xs 73 | r w' 74 | pure w' 75 | 76 | 77 | renderApp :: (MonadIO m) => SDL.Renderer -> SDL.Texture -> World -> m () 78 | renderApp r t a = do 79 | SDL.clear r 80 | SDL.copy r t (Just mask) (Just pos) 81 | SDL.present r 82 | 83 | where 84 | framesPerSecond = 60 :: Double 85 | animDurationSeconds = 0.8 :: Double 86 | animFrames = 8 :: Int 87 | 88 | -- ax :: seconds for one frame of animation 89 | -- fx :: number of seconds total 90 | ax = fromIntegral animFrames / animDurationSeconds 91 | fx = fromIntegral (frame a) / framesPerSecond 92 | 93 | x = floor (ax * fx) `mod` animFrames 94 | 95 | mask = C.mkRect (fromIntegral x * 48) 0 48 48 96 | s = C.mkRect 0 0 192 (192 :: Double) 97 | w = C.mkRect 0 0 640 480 98 | pos = round <$> C.centerWithin s w 99 | 100 | 101 | main :: IO () 102 | main = C.withSDL $ C.withSDLImage $ do 103 | C.setHintQuality 104 | C.withWindow "Lesson 14" (640, 480) $ \w -> 105 | C.withRenderer w $ \r -> do 106 | t <- SDL.Image.loadTexture r "./assets/walk.png" 107 | let doRender = renderApp r t 108 | runApp (appLoop doRender) initialApp 109 | SDL.destroyTexture t 110 | -------------------------------------------------------------------------------- /examples/lesson18/src/Lesson18.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFoldable #-} 2 | 3 | {-# LANGUAGE DeriveTraversable #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | module Main (main) where 7 | 8 | import qualified Common as C 9 | import qualified SDL 10 | 11 | import Control.Monad.Extra (whileM) 12 | import Control.Monad.IO.Class (MonadIO) 13 | import Data.Functor 14 | import Data.List.Extra 15 | import Prelude hiding (Left, Right) 16 | 17 | 18 | data Direction 19 | = Help 20 | | Up 21 | | Down 22 | | Left 23 | | Right 24 | deriving (Show, Eq) 25 | 26 | 27 | data Intent 28 | = Render Direction 29 | | Quit 30 | deriving (Show, Eq) 31 | 32 | 33 | data AssetMap a = AssetMap 34 | { help :: a 35 | , up :: a 36 | , down :: a 37 | , left :: a 38 | , right :: a 39 | } deriving (Foldable, Traversable, Functor) 40 | 41 | 42 | type RenderFunction m = (Direction -> m ()) 43 | 44 | 45 | surfacePaths :: AssetMap FilePath 46 | surfacePaths = AssetMap 47 | { help = "./assets/press.bmp" 48 | , up = "./assets/up.bmp" 49 | , down = "./assets/down.bmp" 50 | , left = "./assets/left.bmp" 51 | , right = "./assets/right.bmp" 52 | } 53 | 54 | 55 | readEventIntents :: (MonadIO m) => m (Maybe Intent) 56 | readEventIntents = firstJust payloadToIntent . fmap SDL.eventPayload <$> SDL.pollEvents 57 | where 58 | payloadToIntent :: SDL.EventPayload -> Maybe Intent 59 | payloadToIntent SDL.QuitEvent = Just Quit 60 | payloadToIntent _ = Nothing 61 | 62 | 63 | readKeyboardIntents :: (MonadIO m) => m Intent 64 | readKeyboardIntents = mapScansToIntents <$> SDL.getKeyboardState 65 | where 66 | scans = 67 | [ ( SDL.ScancodeEscape, Quit ) 68 | , ( SDL.ScancodeUp, Render Up ) 69 | , ( SDL.ScancodeDown, Render Down ) 70 | , ( SDL.ScancodeLeft, Render Left ) 71 | , ( SDL.ScancodeRight, Render Right ) 72 | ] 73 | 74 | mapScansToIntents checkKey = 75 | case filter (checkKey . fst) scans of 76 | [] -> Render Help 77 | ts -> head $ snd <$> ts 78 | 79 | 80 | appLoop :: (MonadIO m) => RenderFunction m -> m Bool 81 | appLoop render = do 82 | xs <- readEventIntents 83 | 84 | case xs of 85 | Just Quit -> 86 | pure False 87 | 88 | _ -> do 89 | ks <- readKeyboardIntents 90 | applyIntent ks 91 | 92 | where 93 | applyIntent (Render key) = render key $> True 94 | applyIntent Quit = pure False 95 | 96 | 97 | draw :: (MonadIO m) => SDL.Window -> SDL.Surface -> AssetMap SDL.Surface -> RenderFunction m 98 | draw w screen assets d = do 99 | let x = selectSurface d assets 100 | C.renderSurfaceToWindow w screen x 101 | 102 | where 103 | selectSurface :: Direction -> AssetMap a -> a 104 | selectSurface Help = help 105 | selectSurface Up = up 106 | selectSurface Down = down 107 | selectSurface Left = left 108 | selectSurface Right = right 109 | 110 | 111 | main :: IO () 112 | main = C.withSDL $ C.withWindow "Lesson 18" (640, 480) $ 113 | \w -> do 114 | 115 | screen <- SDL.getWindowSurface w 116 | assets <- mapM SDL.loadBMP surfacePaths 117 | 118 | let doRender = draw w screen assets 119 | 120 | doRender Help 121 | whileM $ appLoop doRender 122 | 123 | mapM_ SDL.freeSurface assets 124 | SDL.freeSurface screen 125 | -------------------------------------------------------------------------------- /examples/lesson04/src/Lesson04.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFoldable #-} 2 | 3 | {-# LANGUAGE DeriveTraversable #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | module Main (main) where 7 | 8 | import qualified Common as C 9 | import qualified SDL 10 | 11 | import Control.Monad.Extra (whileM) 12 | import Control.Monad.IO.Class (MonadIO) 13 | import Data.Maybe 14 | import Prelude hiding (Left, Right) 15 | 16 | 17 | data Direction 18 | = Help 19 | | Up 20 | | Down 21 | | Left 22 | | Right 23 | deriving (Show, Eq) 24 | 25 | 26 | data Intent 27 | = Render Direction 28 | | Quit 29 | deriving (Show, Eq) 30 | 31 | 32 | data AssetMap a = AssetMap 33 | { help :: a 34 | , up :: a 35 | , down :: a 36 | , left :: a 37 | , right :: a 38 | } deriving (Foldable, Traversable, Functor) 39 | 40 | 41 | type RenderFunction m = (Direction -> m ()) 42 | 43 | 44 | surfacePaths :: AssetMap FilePath 45 | surfacePaths = AssetMap 46 | { help = "./assets/press.bmp" 47 | , up = "./assets/up.bmp" 48 | , down = "./assets/down.bmp" 49 | , left = "./assets/left.bmp" 50 | , right = "./assets/right.bmp" 51 | } 52 | 53 | 54 | getKey :: SDL.KeyboardEventData -> Maybe Intent 55 | getKey (SDL.KeyboardEventData _ SDL.Released _ _) = Nothing 56 | getKey (SDL.KeyboardEventData _ SDL.Pressed True _) = Nothing 57 | getKey (SDL.KeyboardEventData _ SDL.Pressed False keysym) = Just $ 58 | case SDL.keysymKeycode keysym of 59 | SDL.KeycodeEscape -> Quit 60 | SDL.KeycodeUp -> Render Up 61 | SDL.KeycodeDown -> Render Down 62 | SDL.KeycodeLeft -> Render Left 63 | SDL.KeycodeRight -> Render Right 64 | _ -> Render Help 65 | 66 | 67 | mapEventsToIntents :: [SDL.Event] -> [Intent] 68 | mapEventsToIntents = mapMaybe (payloadToIntent . SDL.eventPayload) 69 | where 70 | payloadToIntent :: SDL.EventPayload -> Maybe Intent 71 | payloadToIntent (SDL.KeyboardEvent k) = getKey k 72 | payloadToIntent SDL.QuitEvent = Just Quit 73 | payloadToIntent _ = Nothing 74 | 75 | 76 | appLoop :: (MonadIO m) => RenderFunction m -> m Bool 77 | appLoop render = do 78 | xs <- mapEventsToIntents <$> SDL.pollEvents 79 | 80 | let shouldQuit = Quit `elem` xs 81 | if shouldQuit 82 | then pure False 83 | else do 84 | applyIntent `mapM_` xs 85 | pure True 86 | 87 | where 88 | applyIntent (Render key) = render key 89 | applyIntent Quit = pure () 90 | 91 | 92 | draw :: (MonadIO m) => SDL.Window -> SDL.Surface -> AssetMap SDL.Surface -> RenderFunction m 93 | draw w screen assets d = do 94 | let x = selectSurface d assets 95 | C.renderSurfaceToWindow w screen x 96 | 97 | where 98 | selectSurface :: Direction -> AssetMap a -> a 99 | selectSurface Help = help 100 | selectSurface Up = up 101 | selectSurface Down = down 102 | selectSurface Left = left 103 | selectSurface Right = right 104 | 105 | 106 | main :: IO () 107 | main = C.withSDL $ C.withWindow "Lesson 04" (640, 480) $ 108 | \w -> do 109 | 110 | screen <- SDL.getWindowSurface w 111 | assets <- mapM SDL.loadBMP surfacePaths 112 | 113 | let doRender = draw w screen assets 114 | 115 | doRender Help 116 | whileM $ appLoop doRender 117 | 118 | mapM_ SDL.freeSurface assets 119 | SDL.freeSurface screen 120 | -------------------------------------------------------------------------------- /examples/lesson13/src/Lesson13.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFoldable #-} 2 | {-# LANGUAGE DeriveTraversable #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module Main (main) where 6 | 7 | import qualified Common as C 8 | import qualified SDL 9 | import qualified SDL.Image 10 | 11 | import Control.Monad.IO.Class (MonadIO) 12 | import Control.Monad.Loops (iterateUntilM) 13 | import Data.Foldable (foldl') 14 | import GHC.Word (Word8) 15 | import SDL (($=)) 16 | 17 | 18 | data World = World 19 | { exiting :: Bool 20 | , alpha :: Word8 21 | } 22 | 23 | data Intent 24 | = Increase 25 | | Decrease 26 | | Idle 27 | | Quit 28 | 29 | 30 | data AssetMap a = AssetMap 31 | { background :: a 32 | , foreground :: a 33 | } deriving (Foldable, Traversable, Functor) 34 | 35 | 36 | assetPaths :: AssetMap FilePath 37 | assetPaths = AssetMap 38 | { background = "./assets/fadein.png" 39 | , foreground = "./assets/fadeout.png" 40 | } 41 | 42 | 43 | initialWorld :: World 44 | initialWorld = World 45 | { exiting = False 46 | , alpha = 0 47 | } 48 | 49 | mkIntent :: [SDL.Event] -> [Intent] 50 | mkIntent = fmap (payloadToIntent . extractPayload) 51 | 52 | 53 | extractPayload :: SDL.Event -> SDL.EventPayload 54 | extractPayload (SDL.Event _t p) = p 55 | 56 | 57 | payloadToIntent :: SDL.EventPayload -> Intent 58 | payloadToIntent SDL.QuitEvent = Quit 59 | payloadToIntent (SDL.KeyboardEvent k) = keyEventToIntent k 60 | payloadToIntent _ = Idle 61 | 62 | 63 | keyEventToIntent :: SDL.KeyboardEventData -> Intent 64 | keyEventToIntent (SDL.KeyboardEventData _ SDL.Released _ _) = Idle 65 | keyEventToIntent (SDL.KeyboardEventData _ SDL.Pressed _ keysym) = 66 | case SDL.keysymKeycode keysym of 67 | SDL.KeycodeEscape -> Quit 68 | SDL.KeycodeW -> Increase 69 | SDL.KeycodeS -> Decrease 70 | _ -> Idle 71 | 72 | 73 | increase :: World -> World 74 | increase w = w { alpha = alpha w + 8 } 75 | 76 | 77 | decrease :: World -> World 78 | decrease w = w { alpha = alpha w - 8 } 79 | 80 | 81 | quit :: World -> World 82 | quit w = w { exiting = True } 83 | 84 | 85 | runIntent :: Intent -> World -> World 86 | runIntent Increase = increase 87 | runIntent Decrease = decrease 88 | runIntent Idle = id 89 | runIntent Quit = quit 90 | 91 | 92 | renderWorld :: (MonadIO m) => SDL.Renderer -> AssetMap SDL.Texture -> World -> m () 93 | renderWorld r ts w = do 94 | let fg = foreground ts 95 | let bg = background ts 96 | 97 | SDL.textureAlphaMod fg $= alpha w 98 | 99 | SDL.clear r 100 | SDL.copy r bg Nothing Nothing 101 | SDL.copy r fg Nothing Nothing 102 | SDL.present r 103 | 104 | 105 | main :: IO () 106 | main = C.withSDL $ C.withSDLImage $ do 107 | C.setHintQuality 108 | C.withWindow "Lesson 13" (640, 480) $ \w -> 109 | C.withRenderer w $ \r -> do 110 | SDL.rendererDrawBlendMode r $= SDL.BlendAlphaBlend 111 | 112 | ts <- mapM (SDL.Image.loadTexture r) assetPaths 113 | mapM_ (\t -> SDL.textureBlendMode t $= SDL.BlendAlphaBlend) ts 114 | 115 | let doRender = renderWorld r ts 116 | 117 | _ <- iterateUntilM 118 | exiting 119 | (\x -> 120 | foldl' (flip runIntent) x . mkIntent <$> SDL.pollEvents 121 | >>= \x' -> x' <$ doRender x' 122 | ) 123 | initialWorld 124 | 125 | mapM_ SDL.destroyTexture ts 126 | -------------------------------------------------------------------------------- /examples/lesson12/src/Lesson12/World.hs: -------------------------------------------------------------------------------- 1 | module Lesson12.World 2 | ( World 3 | 4 | , exiting 5 | , colors 6 | , ColorValues (..) 7 | 8 | , initialWorld 9 | , updateWorld 10 | ) where 11 | 12 | import Data.Foldable (foldl') 13 | import Lesson12.Intents 14 | 15 | 16 | data Lens a b = Lens 17 | { getL :: a -> b 18 | , setL :: b -> a -> a 19 | } 20 | 21 | 22 | data ColorValues = ColorValues 23 | { redV :: Double 24 | , greenV :: Double 25 | , blueV :: Double 26 | } deriving (Show) 27 | 28 | 29 | data ColorToggles = ColorToggles 30 | { redT :: Bool 31 | , greenT :: Bool 32 | , blueT :: Bool 33 | } deriving (Show) 34 | 35 | 36 | data World = World 37 | { colors :: ColorValues 38 | , toggles :: ColorToggles 39 | , exiting :: Bool 40 | } deriving (Show) 41 | 42 | 43 | initialWorld :: World 44 | initialWorld = World 45 | { colors = ColorValues 46 | { redV = 128 47 | , greenV = 128 48 | , blueV = 128 49 | } 50 | , toggles = ColorToggles 51 | { redT = False 52 | , greenT = False 53 | , blueT = False 54 | } 55 | , exiting = False 56 | } 57 | 58 | 59 | redLens :: Lens ColorValues Double 60 | redLens = Lens redV setRed 61 | where setRed x w = w { redV = x } 62 | 63 | 64 | greenLens :: Lens ColorValues Double 65 | greenLens = Lens greenV setGreen 66 | where setGreen x w = w { greenV = x } 67 | 68 | 69 | blueLens :: Lens ColorValues Double 70 | blueLens = Lens blueV setBlue 71 | where setBlue x w = w { blueV = x } 72 | 73 | 74 | updateColorValue :: Bool -> Double -> Double 75 | updateColorValue p v = if p then v + 4 else v 76 | 77 | 78 | stepWorld :: World -> World 79 | stepWorld w = w { colors = newColors } 80 | where 81 | newColors = (colors w) { redV = newRedV, greenV = newGreenV, blueV = newBlueV } 82 | newRedV = updateColorValue (redT (toggles w)) (redV (colors w)) 83 | newGreenV = updateColorValue (greenT (toggles w)) (greenV (colors w)) 84 | newBlueV = updateColorValue (blueT (toggles w)) (blueV (colors w)) 85 | 86 | 87 | modL :: Lens a b -> a -> (b -> b) -> a 88 | modL lens record func = setL lens newValue record 89 | where value = getL lens record 90 | newValue = func value 91 | 92 | 93 | modifyColor :: Lens ColorValues Double -> (Double -> Double) -> World -> World 94 | modifyColor lens func w = w { colors = colors' } 95 | where colors' = modL lens (colors w) func 96 | 97 | 98 | increase :: Color -> World -> World 99 | increase Red = modifyColor redLens (+ 16) 100 | increase Green = modifyColor greenLens (+ 16) 101 | increase Blue = modifyColor blueLens (+ 16) 102 | 103 | 104 | decrease :: Color -> World -> World 105 | decrease Red = modifyColor redLens (flip (-) 16) 106 | decrease Green = modifyColor greenLens (flip (-) 16) 107 | decrease Blue = modifyColor blueLens (flip (-) 16) 108 | 109 | 110 | toggle :: Color -> World -> World 111 | toggle Red w = w { toggles = newToggles } 112 | where newRedT = not $ redT (toggles w) 113 | newToggles = (toggles w) { redT = newRedT } 114 | 115 | 116 | toggle Green w = w { toggles = newToggles } 117 | where newGreenT = not $ greenT (toggles w) 118 | newToggles = (toggles w) { greenT = newGreenT } 119 | 120 | 121 | toggle Blue w = w { toggles = newToggles } 122 | where newBlueT = not $ blueT (toggles w) 123 | newToggles = (toggles w) { blueT = newBlueT } 124 | 125 | 126 | exit :: World -> World 127 | exit w = w { exiting = True } 128 | 129 | 130 | runIntent :: Intent -> World -> World 131 | runIntent (Increase color) = increase color 132 | runIntent (Decrease color) = decrease color 133 | runIntent (Toggle color) = toggle color 134 | runIntent Idle = id 135 | runIntent Quit = exit 136 | 137 | 138 | updateWorld :: World -> [Intent] -> World 139 | updateWorld w 140 | = stepWorld 141 | . foldl' (flip runIntent) w 142 | -------------------------------------------------------------------------------- /examples/lesson15/src/Lesson15.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | 8 | import Control.Monad.IO.Class (MonadIO) 9 | import Control.Monad.Loops (iterateUntilM) 10 | import Data.Foldable (foldl') 11 | 12 | 13 | data FlipDirection 14 | = Horizontal 15 | | Vertical 16 | 17 | 18 | data RotateDirection 19 | = Clock 20 | | Counter 21 | 22 | 23 | data Intent 24 | = Idle 25 | | Flip FlipDirection 26 | | Rotate RotateDirection 27 | | Reset 28 | | Quit 29 | 30 | 31 | data World = World 32 | { exiting :: Bool 33 | , degrees :: Int 34 | , flipped :: (Bool, Bool) 35 | } 36 | 37 | 38 | initialWorld :: World 39 | initialWorld = World 40 | { exiting = False 41 | , degrees = 0 42 | , flipped = (False, False) 43 | } 44 | 45 | 46 | keyEventToIntent :: SDL.KeyboardEventData -> Intent 47 | keyEventToIntent (SDL.KeyboardEventData _ SDL.Pressed _ keysym) = 48 | case SDL.keysymKeycode keysym of 49 | 50 | SDL.KeycodeEscape -> Quit 51 | 52 | SDL.KeycodeQ -> Rotate Counter 53 | SDL.KeycodeE -> Rotate Clock 54 | 55 | SDL.KeycodeA -> Flip Horizontal 56 | SDL.KeycodeD -> Flip Vertical 57 | 58 | SDL.KeycodeR -> Reset 59 | _ -> Idle 60 | 61 | keyEventToIntent _ = Idle 62 | 63 | 64 | payloadToIntent :: SDL.EventPayload -> Intent 65 | payloadToIntent SDL.QuitEvent = Quit 66 | payloadToIntent (SDL.KeyboardEvent k) = keyEventToIntent k 67 | payloadToIntent _ = Idle 68 | 69 | 70 | flipWorld :: FlipDirection -> World -> World 71 | flipWorld Horizontal w = w { flipped = (h', v') } 72 | where h' = not ( fst (flipped w) ) 73 | v' = snd (flipped w) 74 | 75 | flipWorld Vertical w = w { flipped = (h', v') } 76 | where h' = fst (flipped w) 77 | v' = not (snd (flipped w)) 78 | 79 | 80 | rotateWorld :: RotateDirection -> World -> World 81 | rotateWorld Clock w = w { degrees = degrees w + 15 } 82 | rotateWorld Counter w = w { degrees = degrees w - 15 } 83 | 84 | 85 | resetWorld :: World -> World 86 | resetWorld _ = initialWorld 87 | 88 | 89 | quitWorld :: World -> World 90 | quitWorld w = w { exiting = True } 91 | 92 | 93 | applyIntent :: Intent -> World -> World 94 | applyIntent (Flip d) = flipWorld d 95 | applyIntent (Rotate d) = rotateWorld d 96 | applyIntent Reset = resetWorld 97 | applyIntent Idle = id 98 | applyIntent Quit = quitWorld 99 | 100 | 101 | updateWorld :: World -> [SDL.Event] -> World 102 | updateWorld w 103 | = foldl' (flip applyIntent) w 104 | . fmap (payloadToIntent . SDL.eventPayload) 105 | 106 | 107 | renderWorld 108 | :: (MonadIO m) 109 | => SDL.Renderer 110 | -> (SDL.Texture, SDL.TextureInfo) 111 | -> World 112 | -> m () 113 | 114 | renderWorld r (t, ti) w = do 115 | SDL.clear r 116 | SDL.copyEx r t (Just mask) (Just pos) deg Nothing flips 117 | SDL.present r 118 | 119 | where 120 | tw :: Double 121 | th :: Double 122 | tw = fromIntegral $ SDL.textureWidth ti 123 | th = fromIntegral $ SDL.textureHeight ti 124 | 125 | s :: SDL.Rectangle Double 126 | s = C.mkRect 0 0 640 480 127 | box = C.mkRect 0 0 tw th 128 | 129 | mask = floor <$> s 130 | pos = round <$> C.centerWithin box s 131 | 132 | deg = fromIntegral $ degrees w 133 | flips = uncurry SDL.V2 (flipped w) 134 | 135 | 136 | main :: IO () 137 | main = C.withSDL $ C.withSDLImage $ do 138 | C.setHintQuality 139 | C.withWindow "Lesson 15" (640, 480) $ \w -> 140 | C.withRenderer w $ \r -> do 141 | 142 | tx <- C.loadTextureWithInfo r "./assets/arrow.png" 143 | 144 | let doRender = renderWorld r tx 145 | 146 | _ <- iterateUntilM 147 | exiting 148 | (\x -> 149 | updateWorld x <$> SDL.pollEvents 150 | >>= \x' -> x' <$ doRender x' 151 | ) 152 | initialWorld 153 | 154 | SDL.destroyTexture (fst tx) 155 | -------------------------------------------------------------------------------- /examples/lesson19/src/Lesson19.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | 8 | import Control.Monad.IO.Class 9 | import Control.Monad.Loops (iterateUntilM) 10 | import Data.Foldable (foldl') 11 | import Data.Text hiding (foldl') 12 | import Data.Vector ((!?)) 13 | import Foreign.C.Types 14 | 15 | 16 | loggerInfo :: (MonadIO m) => Text -> m () 17 | loggerInfo = liftIO . print 18 | 19 | 20 | -- Setup 21 | 22 | data Intent 23 | = Idle 24 | | Quit 25 | | ChangeAngle Double 26 | 27 | 28 | data World = World 29 | { exiting :: Bool 30 | , angle :: Double 31 | } 32 | 33 | 34 | initialWorld :: World 35 | initialWorld = World 36 | { exiting = False 37 | , angle = 0 38 | } 39 | 40 | 41 | -- Actions 42 | 43 | payloadToIntent :: SDL.EventPayload -> Intent 44 | payloadToIntent SDL.QuitEvent = Quit 45 | payloadToIntent _ = Idle 46 | 47 | 48 | getControllerState :: (MonadIO m) => SDL.Joystick -> m (Double, Double) 49 | getControllerState controller = do 50 | xValue <- SDL.axisPosition controller 0 51 | yValue <- SDL.axisPosition controller 1 52 | pure (fromIntegral xValue, fromIntegral yValue) 53 | 54 | 55 | setAngle :: Double -> World -> World 56 | setAngle x w = w { angle = x } 57 | 58 | 59 | quitWorld :: World -> World 60 | quitWorld w = w { exiting = True } 61 | 62 | 63 | applyIntent :: Intent -> World -> World 64 | applyIntent Idle = id 65 | applyIntent Quit = quitWorld 66 | applyIntent (ChangeAngle p) = setAngle p 67 | 68 | 69 | updateWorld :: World -> [Intent] -> World 70 | updateWorld = foldl' (flip applyIntent) 71 | 72 | 73 | runUpdate :: (MonadIO m) => SDL.Joystick -> World -> m World 74 | runUpdate g w = do 75 | es <- SDL.pollEvents 76 | let es' = payloadToIntent . SDL.eventPayload <$> es 77 | 78 | s <- getControllerState g 79 | let s' = mkTarget s 80 | 81 | liftIO $ print s 82 | pure $ updateWorld w (es' <> [ChangeAngle s']) 83 | 84 | where 85 | mkTarget ( a, b) 86 | | safe a && safe b = 0 87 | | otherwise = (360 / (2 * pi) ) * atan2 b a 88 | 89 | safe x = -4096 < x && x < 4096 90 | 91 | 92 | -- Rendering 93 | 94 | drawWorld :: (MonadIO m) => SDL.Renderer -> (SDL.Texture, SDL.TextureInfo) -> World -> m () 95 | drawWorld r (t, ti) w 96 | = SDL.copyEx r t (Just mask) (Just pos) deg Nothing flips 97 | 98 | where 99 | tw :: Double 100 | tw = fromIntegral $ SDL.textureWidth ti 101 | th :: Double 102 | th = fromIntegral $ SDL.textureHeight ti 103 | 104 | s :: SDL.Rectangle Double 105 | s = C.mkRect 0 0 640 480 106 | box = C.mkRect 0 0 tw th 107 | 108 | mask = floor <$> s 109 | pos = floor <$> C.centerWithin box s 110 | 111 | deg = CDouble $ angle w 112 | flips = SDL.V2 False False 113 | 114 | 115 | renderWorld :: (MonadIO m) => SDL.Renderer -> (SDL.Texture, SDL.TextureInfo) -> World -> m () 116 | renderWorld r tx w = do 117 | SDL.clear r 118 | drawWorld r tx w 119 | SDL.present r 120 | 121 | 122 | -- Main 123 | 124 | sideEffect :: (Monad m) => (a -> m b) -> (b -> m ()) -> a -> m b 125 | sideEffect op ef x = do 126 | x' <- op x 127 | ef x' 128 | pure x' 129 | 130 | 131 | openJoystick :: (MonadIO m) => m (Maybe SDL.Joystick) 132 | openJoystick = do 133 | js <- SDL.availableJoysticks 134 | maybe (pure Nothing) (fmap Just . SDL.openJoystick) (js !? 0) 135 | 136 | 137 | -- disableEventPolling :: (MonadIO m) => [Word32] -> m () 138 | -- disableEventPolling = mapM_ (`SDL.eventState` 0) 139 | 140 | 141 | main :: IO () 142 | main = C.withSDL $ C.withSDLImage $ do 143 | C.setHintQuality 144 | C.withWindow "Lesson 19" (640, 480) $ \w -> 145 | C.withRenderer w $ \r -> do 146 | tx <- C.loadTextureWithInfo r "./assets/arrow.png" 147 | 148 | g <- openJoystick 149 | 150 | case g of 151 | Nothing -> 152 | loggerInfo "no controller found" 153 | 154 | Just g' -> do 155 | loggerInfo "found controller" 156 | 157 | -- disableEventPolling [SDL.SDL_CONTROLLERAXISMOTION, SDL.SDL_JOYAXISMOTION] 158 | 159 | let doRender = renderWorld r tx 160 | 161 | _ <- iterateUntilM 162 | exiting 163 | (sideEffect (runUpdate g') doRender) 164 | initialWorld 165 | 166 | SDL.closeJoystick g' 167 | SDL.destroyTexture (fst tx) 168 | -------------------------------------------------------------------------------- /examples/lesson17/src/Lesson17.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | import qualified Common as C 6 | import qualified SDL 7 | 8 | import Common (moveTo) 9 | import Control.Monad.IO.Class (MonadIO) 10 | import Control.Monad.Loops (iterateUntilM) 11 | import Data.Foldable (foldl') 12 | 13 | 14 | -- Setup 15 | 16 | data Quadrant 17 | = TopLeft 18 | | TopRight 19 | | BottomLeft 20 | | BottomRight 21 | 22 | 23 | data Intent 24 | = Idle 25 | | Quit 26 | | Press Quadrant 27 | | Release Quadrant 28 | | Hover Quadrant 29 | | Leave Quadrant 30 | 31 | 32 | data Pane 33 | = Out 34 | | Over 35 | | Down 36 | | Up 37 | 38 | 39 | data PaneMap = PaneMap 40 | { topLeft :: Pane 41 | , topRight :: Pane 42 | , bottomLeft :: Pane 43 | , bottomRight :: Pane 44 | } 45 | 46 | 47 | data World = World 48 | { exiting :: Bool 49 | , panes :: PaneMap 50 | } 51 | 52 | 53 | initialPanes :: PaneMap 54 | initialPanes = PaneMap 55 | { topLeft = Out 56 | , topRight = Out 57 | , bottomLeft = Out 58 | , bottomRight = Out 59 | } 60 | 61 | 62 | initialWorld :: World 63 | initialWorld = World 64 | { exiting = False 65 | , panes = initialPanes 66 | } 67 | 68 | 69 | -- Actions 70 | 71 | selectQuadrant :: (Num a, Ord a) => a -> a -> Quadrant 72 | selectQuadrant x y 73 | | x < 320 && y < 240 = TopLeft 74 | | x >= 320 && y < 240 = TopRight 75 | | x < 320 && y >= 240 = BottomLeft 76 | | x >= 320 && y >= 240 = BottomRight 77 | | otherwise = undefined 78 | 79 | 80 | motionIntent :: SDL.MouseMotionEventData -> Intent 81 | motionIntent e = Hover q 82 | where 83 | q = selectQuadrant x y 84 | (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos e 85 | 86 | 87 | -- | SDL.mouseButtonEventMotion e == SDL.Pressed -> Down 88 | -- 89 | buttonIntent :: SDL.MouseButtonEventData -> Intent 90 | buttonIntent e = t q 91 | where 92 | q = selectQuadrant x y 93 | (SDL.P (SDL.V2 x y)) = SDL.mouseButtonEventPos e 94 | t = if SDL.mouseButtonEventMotion e == SDL.Pressed 95 | then Press 96 | else Release 97 | 98 | 99 | payloadToIntent :: SDL.EventPayload -> Intent 100 | payloadToIntent SDL.QuitEvent = Quit 101 | payloadToIntent (SDL.MouseMotionEvent e) = motionIntent e 102 | payloadToIntent (SDL.MouseButtonEvent e) = buttonIntent e 103 | payloadToIntent _ = Idle 104 | 105 | 106 | setOut :: Pane -> Pane 107 | setOut Down = Down 108 | setOut _ = Out 109 | 110 | 111 | setOver :: Pane -> Pane 112 | setOver Down = Down 113 | setOver Up = Up 114 | setOver _ = Over 115 | 116 | 117 | setDown :: Pane -> Pane 118 | setDown _ = Down 119 | 120 | 121 | setUp :: Pane -> Pane 122 | setUp Down = Up 123 | setUp p = p 124 | 125 | 126 | updatePaneMap :: (Pane -> Pane) -> (Pane -> Pane) -> Quadrant -> PaneMap -> PaneMap 127 | updatePaneMap f g TopLeft (PaneMap tl tr bl br) = PaneMap (f tl) (g tr) (g bl) (g br) 128 | updatePaneMap f g TopRight (PaneMap tl tr bl br) = PaneMap (g tl) (f tr) (g bl) (g br) 129 | updatePaneMap f g BottomLeft (PaneMap tl tr bl br) = PaneMap (g tl) (g tr) (f bl) (g br) 130 | updatePaneMap f g BottomRight (PaneMap tl tr bl br) = PaneMap (g tl) (g tr) (g bl) (f br) 131 | 132 | 133 | pressWorld :: Quadrant -> World -> World 134 | pressWorld q w = w { panes = panes' } 135 | where panes' = updatePaneMap setDown id q (panes w) 136 | 137 | 138 | releaseWorld :: Quadrant -> World -> World 139 | releaseWorld q w = w { panes = panes' } 140 | where panes' = updatePaneMap setUp id q (panes w) 141 | 142 | 143 | hoverWorld :: Quadrant -> World -> World 144 | hoverWorld q w = w { panes = panes' } 145 | where panes' = updatePaneMap setOver setOut q (panes w) 146 | 147 | 148 | leaveWorld :: Quadrant -> World -> World 149 | leaveWorld q w = w { panes = panes' } 150 | where panes' = updatePaneMap setOut setOver q (panes w) 151 | 152 | 153 | quitWorld :: World -> World 154 | quitWorld w = w { exiting = True } 155 | 156 | 157 | applyIntent :: Intent -> World -> World 158 | applyIntent (Press q) = pressWorld q 159 | applyIntent (Release q) = releaseWorld q 160 | applyIntent (Hover q) = hoverWorld q 161 | applyIntent (Leave q) = leaveWorld q 162 | applyIntent Idle = id 163 | applyIntent Quit = quitWorld 164 | 165 | 166 | updateWorld :: World -> [SDL.Event] -> World 167 | updateWorld w 168 | = foldl' (flip applyIntent) w 169 | . fmap (payloadToIntent . SDL.eventPayload) 170 | 171 | 172 | -- Rendering 173 | 174 | getMask :: (Num a) => Pane -> (a, a) 175 | getMask Out = ( 0, 0) 176 | getMask Over = (320, 0) 177 | getMask Down = ( 0, 240) 178 | getMask Up = (320, 240) 179 | 180 | 181 | getPosition :: (Num a) => Quadrant -> (a, a) 182 | getPosition TopLeft = ( 0, 0) 183 | getPosition TopRight = (320, 0) 184 | getPosition BottomLeft = ( 0, 240) 185 | getPosition BottomRight = (320, 240) 186 | 187 | 188 | drawWorld :: (MonadIO m) => SDL.Renderer -> (SDL.Texture, SDL.TextureInfo) -> World -> m () 189 | drawWorld r (t, ti) w = do 190 | renderPane (topLeft $ panes w) TopLeft 191 | renderPane (topRight $ panes w) TopRight 192 | renderPane (bottomLeft $ panes w) BottomLeft 193 | renderPane (bottomRight $ panes w) BottomRight 194 | 195 | where 196 | tw :: Double 197 | tw = fromIntegral $ SDL.textureWidth ti 198 | th = fromIntegral $ SDL.textureHeight ti 199 | 200 | s = C.mkRect 0 0 (tw / 2) (th / 2) 201 | 202 | mFor c = s `moveTo` getMask c 203 | pFor c = s `moveTo` getPosition c 204 | 205 | renderPane p q 206 | = SDL.copy r t 207 | (Just $ floor <$> mFor p) 208 | (Just $ floor <$> pFor q) 209 | 210 | 211 | renderWorld :: (MonadIO m) => SDL.Renderer -> (SDL.Texture, SDL.TextureInfo) -> World -> m () 212 | renderWorld r t w = do 213 | SDL.clear r 214 | drawWorld r t w 215 | SDL.present r 216 | 217 | 218 | -- Main 219 | 220 | main :: IO () 221 | main = C.withSDL $ C.withSDLImage $ do 222 | C.setHintQuality 223 | C.withWindow "Lesson 17" (640, 480) $ \w -> 224 | C.withRenderer w $ \r -> do 225 | t <- C.loadTextureWithInfo r "./assets/mouse_states.png" 226 | 227 | let doRender = renderWorld r t 228 | 229 | _ <- iterateUntilM 230 | exiting 231 | (\x -> 232 | updateWorld x <$> SDL.pollEvents 233 | >>= \x' -> x' <$ doRender x' 234 | ) 235 | initialWorld 236 | 237 | SDL.destroyTexture (fst t) 238 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | {description} 294 | Copyright (C) {year} {fullname} 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | {signature of Ty Coon}, 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. 340 | --------------------------------------------------------------------------------