grid-proto 0.2.0.0 → 0.2.0.1
raw patch · 5 files changed
+203/−36 lines, 5 files
Files
- README.md +169/−1
- examples/Text.hs +1/−5
- grid-proto.cabal +1/−1
- src/GridProto.hs +12/−12
- src/GridProto/Internal/Core.hs +20/−17
README.md view
@@ -1,1 +1,169 @@-# grid-proto+# Grid Proto++### Game Engine for Prototyping on a Grid++Quickly prototype a graphical program with basic input, colors, shapes, and text.+Grid Proto follows an 'anti-polished' philosophy. It exposes a heavily limited API over SDL2 which doesn't allow for any user media.+*No images, fonts, or audio can be loaded.*+This usage is one step above prototyping within the terminal. So, just write a function for updating state, a pure function for rendering, and a pure function for sound effects.++---++### Hello World++```haskell+import GridProto++main :: IO ()+main = runGridProto helloWorld ()++helloWorld :: GridProto ()+helloWorld = defaultGridProto+ { title = "Hello World"+ , viewFn = \_ ->+ drawString wh1 (0,0) "hello" <> drawString wh1 (0,1) "world"+ }+````++## API++```haskell+-- The main type with config and callbacks+data GridProto state = GridProto+ -- Window name+ { title :: String+ -- Grid size+ , rows :: Int -- Default: 18+ , cols :: Int -- Default: 32+ -- Scaling and clear color+ , tilePixelSize :: Int -- Default: 24 minimum for readable text+ , backgroundColor :: Color -- Default: Black2+ -- Callbacks which are called each frame+ , updateFn :: Input -> state -> IO (state, [String]) -- [String] is user logging+ , viewFn :: state -> View+ , sfxFn :: state -> [Sfx]+ , quitFn :: state -> Bool+ }++defaultGridProto :: GridProto s -- Easy to update fields++runGridProto -- Loops until exited+ :: GridProto s -- Main type+ -> s -- Initial state+ -> IO ()++--+-- View+--++type View = Map (Int, Int) Tile -- Map (X,Y) Tile++emptyView :: View++data Tile = Tile+ { symbol :: Maybe (Char, Color) -- At front+ , shape :: Maybe (Shape, Color) -- In middle+ , fill :: Maybe Color -- At back+ }++data Color -- 15 base colors with 3 variations from tint, regular, and shaded. 45 Total.+-- Shorten constructors+-- Tint Reg. Shade+ rd0, rd1, rd2 -- Red+ or0, or1, or2 -- Orange+ yw0, yw1, yw2 -- Yellow+ ch0, ch1, ch2 -- Chartreuse+ gn0, gn1, gn2 -- Green+ sp0, sp1, sp2 -- Spring+ cn0, cn1, cn2 -- Cyan+ az0, az1, az2 -- Azure+ bu0, bu1, bu2 -- Blue+ vt0, vt1, vt2 -- Violet+ mg0, mg1, mg2 -- Magenta+ rs0, rs1, rs2 -- Rose+ br0, br1, br2 -- Brown+ gy0, gy1, gy2 -- Gray+ wh0, wh1, wh2 -- White+ bk0, bk1, bk2 -- Black++data Shape+ = Circle | FillCircle+ | Triangle | FillTriangle+ | Square | FillSquare+ | Plus | Dash+ | Bar | Cross++drawString :: Color -> (Int, Int) -> String -> View+drawTile :: View -> (Int, Int) -> Tile -> View++drawView :: View -> (Int, Int) -> View -> View+mergeViews :: View -> View -> View++rainbow, warms, cools, colorWheel0, colorWheel1, colorWheel2 :: [Color]+shade, tint :: Color -> Color++data Viewport = Viewport+ { vpView :: View+ , vpXY :: (Int, Int)+ , vpDim :: (Int, Int)+ }++mergeViewport :: View -> Viewport -> View+mergeViewports :: View -> [Viewport] -> View++-- instances of MapTile on Tile, View, Viewport+mapTile :: MapTile a+ => ((Char, Color) -> (Char, Color)) -> ((Shape, Color) -> (Shape, Color))+ -> (Color -> Color) -> a -> a+mapSymbol :: MapTile a => ((Char, Color) -> (Char, Color)) -> a -> a+mapShape :: MapTile a => ((Shape, Color) -> (Shape, Color)) -> a -> a+mapFill :: MapTile a => (Color -> Color) -> a -> a++--+-- Input+--++data Input = Input+ { mouse :: Mouse, keys :: Keys+ , controller1, controller2, controller3, controller4 :: Controller+ }++data Key+ = Char Char+ | UpArrow | DownArrow | LeftArrow | RightArrow+ | Enter | Escape+ | LeftShift | RightShift | LeftControl | RightControl+ | LeftAlt | RightAlt+ | Tab | Backspace | Meta++data KeyState = Pressed | Held | Released | Untouched++newtype Keys++lookupKey :: Keys -> Key -> KeyState++data Mouse = Mouse { mousePosition :: (Int, Int), mouseButton :: KeyState }++data Controller = Controller+ { isConnected :: Bool+ , startButton, backButton :: KeyState+ , dpadUp, dpadDown, dpadLeft, dpadRight :: KeyState+ , aButton, bButton, xButton, yButton :: KeyState+ , leftStick , rightStick :: KeyState+ , leftShoulder, rightShoulder :: KeyState+ , leftAxis, rightAxis :: Axis+ }++data Axis = Axis { xAxis :: Float, yAxis :: Float }++--+-- Sfx+--++data Sfx+ = SfxSuccess | SfxBell | SfxSelect+ | SfxNoSelect | SfxScroll | SfxChimes+ | SfxLaser | SfxPowerUp | SfxJump+ | SfxDamage | SfxExplosion | SfxNoise++```
examples/Text.hs view
@@ -12,8 +12,4 @@ } view :: View-view = fromList $ line 0 "hello" ++ line 1 "world"- where- line y str = zipWith (tile y) [0..] str- tile y x sym = ((x, y), Tile (Just (sym, wh1)) Nothing Nothing)-+view = drawString wh1 (0,0) "hello" <> drawString wh1 (0,1) "world"
grid-proto.cabal view
@@ -1,5 +1,5 @@ name: grid-proto-version: 0.2.0.0+version: 0.2.0.1 synopsis: Game engine for Prototyping on a Grid description: Exposes a heavily constrained and simple API around SDL2 with builtin font and sound effects. category: Game
src/GridProto.hs view
@@ -3,7 +3,6 @@ , runGridProto , defaultGridProto --- , Map, fromList, lookupMap, (!), delete, alter, insert, filterWithKey, member, notMember, toList , Color(..) , Shape(..) , Input(..)@@ -16,16 +15,17 @@ , Tile(..) , Sfx(..) , Viewport(..)- , Viewports- , View , MapTile(..)+ --+ , View, Map+ , fromList, lookupMap, (!), delete, alter, insert, filterWithKey, member, notMember, toList , emptyView+ --+ , drawTile, drawView, mergeViews+ , mergeViewport, mergeViewports+ -- , lookupKey- , placeTilesAt- , mergeTiles- , mergeViewport- , mergeViewports- , shade, tint+ -- , rd0, rd1, rd2 , or0, or1, or2 , yw0, yw1, yw2@@ -42,11 +42,11 @@ , gy0, gy1, gy2 , wh0, wh1, wh2 , bk0, bk1, bk2- , rainbow- , warms, cools- , colorValue- , sdlColor+ , rainbow, warms, cools , colorWheel0, colorWheel1, colorWheel2+ , shade, tint+ --+ , drawString ) where import Data.Map (Map, fromList, (!), delete, alter, insert, filterWithKey, member, notMember, toList)
src/GridProto/Internal/Core.hs view
@@ -214,8 +214,6 @@ , vpDim :: (Int, Int) } deriving (Show, Eq, Generic) -type Viewports = [Viewport]- class MapTile a where mapTile :: ((Char, Color) -> (Char, Color))@@ -822,33 +820,33 @@ SDL.freeSurface surface return texture -placeTile :: (Int, Int) -> Tile -> View -> View-placeTile xy tile m = Map.insertWith (flip (<>)) xy tile m+drawTile :: View -> (Int, Int) -> Tile -> View+drawTile m xy tile = Map.insertWith (flip (<>)) xy tile m -placeTilesAt- :: View -- | Base tiles- -> (Int, Int) -- | Offset+drawView+ :: View -- | Base view+ -> (Int, Int) -- | Offset -> View -- | Tiles to be placed -> View-placeTilesAt old (x,y) new = foldr (\((x',y'), tile) m' -> placeTile (x+x', y+y') tile m') old (Map.toList new)+drawView old (x,y) new = foldr (\((x',y'), tile) m' -> drawTile m' (x+x', y+y') tile) old (Map.toList new) -mergeTiles- :: View -- | Base tiles- -> View -- | Tiles to be placed+mergeViews+ :: View -- | Base view+ -> View -- | View to be placed -> View-mergeTiles old new = placeTilesAt old (0,0) new+mergeViews old new = drawView old (0,0) new mergeViewport- :: View- -> Viewport+ :: View -- | Base view+ -> Viewport -- | To be placed -> View-mergeViewport old vp = placeTilesAt old (vpXY vp) (Map.filterWithKey (\(x,y) _ -> x < w && y < h) (vpView vp))+mergeViewport old vp = drawView old (vpXY vp) (Map.filterWithKey (\(x,y) _ -> x < w && y < h) (vpView vp)) where (w,h) = vpDim vp mergeViewports- :: View- -> Viewports+ :: View -- | Base view+ -> [Viewport] -- | To be placed -> View mergeViewports = L.foldl' mergeViewport @@ -888,6 +886,11 @@ return $ Just (sym, off * width', width') where offsets = Map.fromList $ zip symbolList [0..]++drawString :: Color -> (Int,Int) -> String -> View+drawString color (x,y) str = fromList $ zipWith tile [0..] str+ where+ tile i sym = ((x + i, y), Tile (Just (sym, color)) Nothing Nothing) colorWheel0 :: [Color] colorWheel0 = [Red0, Orange0, Yellow0, Chartreuse0, Green0, Spring0, Cyan0, Azure0, Blue0, Violet0, Magenta0, Rose0]