aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Chelleport.hs51
-rw-r--r--src/Chelleport/AppShell.hs3
-rw-r--r--src/Chelleport/Draw.hs21
3 files changed, 54 insertions, 21 deletions
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 450ea0a..3e8718e 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -3,7 +3,7 @@ module Chelleport where
import Chelleport.AppShell (Action (AppAction, SysQuit), hideWindow, setupAppShell, shutdownApp)
import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow))
import Chelleport.Control (moveMouse, triggerMouseLeftClick)
-import Chelleport.Draw (colorLightGray, colorWhite, renderText)
+import Chelleport.Draw (colorAxisLines, colorGridLines, colorLightGray, colorWhite, drawHorizontalLine, drawVerticalLine, renderText)
import Chelleport.KeySequence (Cell, KeyGrid, KeySequence, eventToKeycode, findMatchPosition, generateKeyCells, isValidKey, nextChars, toKeyChar)
import Control.Monad (forM_, unless, void)
import Data.IORef (modifyIORef', newIORef, readIORef)
@@ -33,6 +33,21 @@ initialState _ctx = do
columns = 16
hintKeys = "ABCDEFGHIJKLMNOPRSTUVWXYZ1234567890"
+render :: State -> DrawContext -> IO ()
+render state ctx = do
+ (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
+ let grid = stateCells state
+ let wcell = width `div` unsafeCoerce (length $ head grid)
+ let hcell = height `div` unsafeCoerce (length grid)
+
+ renderGridLines state ctx
+
+ forM_ (zip [0 ..] grid) $ \(rowIndex, row) -> do
+ let py = rowIndex * hcell
+ forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do
+ let px = colIndex * wcell
+ renderKeySequence ctx (stateKeySequence state) cell (px, py)
+
renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO ()
renderKeySequence ctx keySequence cell (px, py) = do
let (matched, remaining) =
@@ -50,26 +65,24 @@ renderKeySequence ctx keySequence cell (px, py) = do
let pos = px + prevTextWidth
void $ renderText ctx (SDL.V2 pos py) colorWhite $ Text.pack remaining
-render :: State -> DrawContext -> IO ()
-render state ctx = do
+renderGridLines :: State -> DrawContext -> IO ()
+renderGridLines state ctx = do
(SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
- let rows = stateCells state
- let wcell = width `div` unsafeCoerce (length $ head rows)
- let hcell = height `div` unsafeCoerce (length rows)
-
- SDL.rendererDrawColor (ctxRenderer ctx) $= SDL.V4 255 0 0 255
- SDL.drawLine (ctxRenderer ctx) (SDL.P $ SDL.V2 (width `div` 2) 0) (SDL.P $ SDL.V2 (width `div` 2) height)
- SDL.drawLine (ctxRenderer ctx) (SDL.P $ SDL.V2 0 (height `div` 2)) (SDL.P $ SDL.V2 width (height `div` 2))
+ let grid = stateCells state
+ let wcell = width `div` unsafeCoerce (length $ head grid)
+ let hcell = height `div` unsafeCoerce (length grid)
- SDL.rendererDrawColor (ctxRenderer ctx) $= SDL.V4 100 0 0 200
- forM_ (zip [0 ..] rows) $ \(rowIndex, row) -> do
- let py = rowIndex * hcell
- SDL.drawLine (ctxRenderer ctx) (SDL.P $ SDL.V2 0 py) (SDL.P $ SDL.V2 width py)
+ SDL.rendererDrawColor (ctxRenderer ctx) $= colorGridLines
+ let rows = unsafeCoerce $ length grid
+ let columns = unsafeCoerce $ length $ head grid
+ forM_ [0 .. rows] $ \rowIndex -> do
+ drawHorizontalLine ctx $ rowIndex * hcell
+ forM_ [0 .. columns] $ \colIndex -> do
+ drawVerticalLine ctx $ colIndex * wcell
- forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do
- let px = colIndex * wcell
- SDL.drawLine (ctxRenderer ctx) (SDL.P $ SDL.V2 px 0) (SDL.P $ SDL.V2 px height)
- renderKeySequence ctx (stateKeySequence state) cell (px, py)
+ SDL.rendererDrawColor (ctxRenderer ctx) $= colorAxisLines
+ drawHorizontalLine ctx (rows * hcell `div` 2)
+ drawVerticalLine ctx (columns * wcell `div` 2)
update :: State -> DrawContext -> AppAction -> IO State
update state _ctx SetupGrid = pure state
@@ -82,7 +95,7 @@ update state ctx (FilterSequence key) =
case validChars >>= (\chars -> (,chars) <$> toKeyChar key) of
Just (keyChar, validChars')
| keyChar `elem` validChars' -> do
- (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx :: IO (SDL.V2 CInt)
+ (SDL.V2 width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
let newKeySequence = stateKeySequence state ++ [keyChar]
let rows = stateCells state
let wcell = width `div` unsafeCoerce (length $ head rows)
diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 6a0195d..0a65ce2 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -1,6 +1,7 @@
module Chelleport.AppShell where
import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow, ctxX11Display), createContext)
+import Chelleport.Draw (colorBackground)
import Control.Monad (foldM, unless)
import qualified Graphics.X11 as X11
import SDL (($=))
@@ -32,7 +33,7 @@ setupAppShell initState update eventHandler draw = do
appLoop drawCtx (state, sysState) = do
events <- SDL.pollEvents
- SDL.rendererDrawColor (ctxRenderer drawCtx) $= SDL.V4 0 0 0 0
+ SDL.rendererDrawColor (ctxRenderer drawCtx) $= colorBackground
SDL.clear $ ctxRenderer drawCtx
draw state drawCtx
SDL.present $ ctxRenderer drawCtx
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index 3c2e2a8..6375997 100644
--- a/src/Chelleport/Draw.hs
+++ b/src/Chelleport/Draw.hs
@@ -1,6 +1,6 @@
module Chelleport.Draw where
-import Chelleport.Context (DrawContext (ctxFont, ctxRenderer))
+import Chelleport.Context (DrawContext (ctxFont, ctxRenderer, ctxWindow))
import Data.Text (Text)
import Data.Word (Word8)
import Foreign.C (CInt)
@@ -13,6 +13,15 @@ colorWhite = SDL.V4 255 255 255 255
colorLightGray :: SDL.V4 Word8
colorLightGray = SDL.V4 100 100 100 255
+colorGridLines :: SDL.V4 Word8
+colorGridLines = SDL.V4 127 29 29 150
+
+colorAxisLines :: SDL.V4 Word8
+colorAxisLines = SDL.V4 239 68 68 255
+
+colorBackground :: SDL.V4 Word8
+colorBackground = SDL.V4 15 12 25 0
+
renderText :: DrawContext -> SDL.V2 CInt -> SDL.V4 Word8 -> Text -> IO (CInt, CInt)
renderText ctx position color text = do
surface <- TTF.blended (ctxFont ctx) color text
@@ -30,3 +39,13 @@ renderText ctx position color text = do
SDL.destroyTexture texture
pure (textWidth, textHeight)
+
+drawHorizontalLine :: DrawContext -> CInt -> IO ()
+drawHorizontalLine ctx x = do
+ (SDL.V2 width _height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
+ SDL.drawLine (ctxRenderer ctx) (SDL.P $ SDL.V2 0 x) (SDL.P $ SDL.V2 width x)
+
+drawVerticalLine :: DrawContext -> CInt -> IO ()
+drawVerticalLine ctx x = do
+ (SDL.V2 _width height) <- SDL.get $ SDL.windowSize $ ctxWindow ctx
+ SDL.drawLine (ctxRenderer ctx) (SDL.P $ SDL.V2 x 0) (SDL.P $ SDL.V2 x height)