diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 + +``` diff --git a/examples/Text.hs b/examples/Text.hs --- a/examples/Text.hs +++ b/examples/Text.hs @@ -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" diff --git a/grid-proto.cabal b/grid-proto.cabal --- a/grid-proto.cabal +++ b/grid-proto.cabal @@ -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 diff --git a/src/GridProto.hs b/src/GridProto.hs --- a/src/GridProto.hs +++ b/src/GridProto.hs @@ -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) diff --git a/src/GridProto/Internal/Core.hs b/src/GridProto/Internal/Core.hs --- a/src/GridProto/Internal/Core.hs +++ b/src/GridProto/Internal/Core.hs @@ -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]