aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--TODO.norg2
-rw-r--r--bin/Main.hs8
-rw-r--r--chelleport.cabal6
-rw-r--r--src/Chelleport.hs82
-rw-r--r--src/Chelleport/AppShell.hs3
-rw-r--r--src/Chelleport/Context.hs18
-rw-r--r--src/Chelleport/Control.hs10
-rw-r--r--src/Chelleport/Draw.hs12
-rw-r--r--src/Chelleport/KeySequence.hs17
-rw-r--r--src/Chelleport/Types.hs25
-rw-r--r--src/Chelleport/View.hs67
11 files changed, 127 insertions, 123 deletions
diff --git a/TODO.norg b/TODO.norg
index 4932fd9..1d50b08 100644
--- a/TODO.norg
+++ b/TODO.norg
@@ -1,5 +1,5 @@
* Current
- - ( ) Center cursor in grid
+ - ( ) Center cursor inside grid cells
- ( ) After 3 keys, 2nd level navigation (allow hjkl to move)
* Later
diff --git a/bin/Main.hs b/bin/Main.hs
index 9cecd67..c7dc225 100644
--- a/bin/Main.hs
+++ b/bin/Main.hs
@@ -1,12 +1,6 @@
module Main where
import qualified Chelleport
-import Data.Text (Text, splitOn)
-import qualified Data.Text as Text
-import System.Environment (getArgs)
-import System.Exit (exitFailure)
main :: IO ()
-main = do
- putStrLn "Wow"
- Chelleport.open
+main = Chelleport.open
diff --git a/chelleport.cabal b/chelleport.cabal
index 8955e58..488898e 100644
--- a/chelleport.cabal
+++ b/chelleport.cabal
@@ -48,10 +48,12 @@ library lib-chelleport
exposed-modules:
Chelleport
Chelleport.AppShell
- Chelleport.Draw
- Chelleport.KeySequence
Chelleport.Context
Chelleport.Control
+ Chelleport.Draw
+ Chelleport.KeySequence
+ Chelleport.Types
+ Chelleport.View
test-suite specs
import: common-config
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 3e8718e..7c44e26 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -1,28 +1,15 @@
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 (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)
-import Data.List (isPrefixOf)
-import qualified Data.Text as Text
-import Foreign.C (CInt)
-import SDL (($=))
+import Chelleport.Control (isKeyPress, isKeyPressWith, moveMouse, triggerMouseLeftClick)
+import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateKeyCells, isValidKey, nextChars, toKeyChar)
+import Chelleport.Types
+import qualified Chelleport.View
import qualified SDL
import Unsafe.Coerce (unsafeCoerce)
-data State = State
- { stateCells :: KeyGrid,
- stateKeySequence :: KeySequence
- }
-
-data AppAction = FilterSequence SDL.Keycode | TriggerLeftClick | SetupGrid
-
open :: IO ()
-open = setupAppShell initialState update eventToAction render
+open = setupAppShell initialState update eventToAction Chelleport.View.render
initialState :: DrawContext -> IO State
initialState _ctx = do
@@ -33,57 +20,6 @@ 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) =
- if keySequence `isPrefixOf` cell
- then splitAt (length keySequence) cell
- else ("", cell)
-
- widthRef <- newIORef 0
- unless (null matched) $ do
- (textWidth, _h) <- renderText ctx (SDL.V2 px py) colorLightGray $ Text.pack matched
- modifyIORef' widthRef (const textWidth)
-
- unless (null remaining) $ do
- prevTextWidth <- readIORef widthRef
- let pos = px + prevTextWidth
- void $ renderText ctx (SDL.V2 pos py) colorWhite $ Text.pack remaining
-
-renderGridLines :: State -> DrawContext -> IO ()
-renderGridLines 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)
-
- 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
-
- 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
update state ctx TriggerLeftClick = do
@@ -121,11 +57,3 @@ eventToAction _state event =
| isKeyPress ev && isValidKey (eventToKeycode ev) ->
Just $ AppAction $ FilterSequence $ eventToKeycode ev
_ -> Nothing
-
-isKeyPress :: SDL.KeyboardEventData -> Bool
-isKeyPress keyboardEvent =
- SDL.keyboardEventKeyMotion keyboardEvent == SDL.Pressed
-
-isKeyPressWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
-isKeyPressWith keyboardEvent keyCode =
- isKeyPress keyboardEvent && SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent) == keyCode
diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 0a65ce2..9b8a284 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -1,7 +1,8 @@
module Chelleport.AppShell where
-import Chelleport.Context (DrawContext (ctxRenderer, ctxWindow, ctxX11Display), createContext)
+import Chelleport.Context (createContext)
import Chelleport.Draw (colorBackground)
+import Chelleport.Types
import Control.Monad (foldM, unless)
import qualified Graphics.X11 as X11
import SDL (($=))
diff --git a/src/Chelleport/Context.hs b/src/Chelleport/Context.hs
index 1dd764f..d62cd7e 100644
--- a/src/Chelleport/Context.hs
+++ b/src/Chelleport/Context.hs
@@ -1,35 +1,23 @@
module Chelleport.Context where
+import Chelleport.Types
import qualified Graphics.X11 as X11
import SDL (($=))
import qualified SDL
import qualified SDL.Font as TTF
-data DrawContext = DrawContext
- { ctxWindow :: SDL.Window,
- ctxRenderer :: SDL.Renderer,
- ctxFont :: TTF.Font,
- ctxX11Display :: X11.Display
- }
-
createContext :: IO DrawContext
createContext = do
- -- bounds <- fmap SDL.displayBoundsSize <$> SDL.getDisplays
- -- let windowSize = case bounds of
- -- (x : _) -> x
- -- _ -> SDL.V2 800 600
- let windowSize = SDL.V2 0 0
-
let windowCfg =
SDL.defaultWindow
{ SDL.windowMode = SDL.FullscreenDesktop,
SDL.windowPosition = SDL.Absolute $ SDL.P $ SDL.V2 0 0,
- SDL.windowInitialSize = windowSize,
+ SDL.windowInitialSize = SDL.V2 0 0,
SDL.windowBorder = False
}
window <- SDL.createWindow "Chelleport" windowCfg
renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
- font <- TTF.load "Inter-Regular.ttf" 16
+ font <- TTF.load "Inter-Regular.ttf" 24
SDL.windowOpacity window $= 0.6
SDL.rendererDrawBlendMode renderer $= SDL.BlendAlphaBlend
diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs
index 2fb4f6c..94acf40 100644
--- a/src/Chelleport/Control.hs
+++ b/src/Chelleport/Control.hs
@@ -1,6 +1,6 @@
module Chelleport.Control where
-import Chelleport.Context (DrawContext (ctxX11Display))
+import Chelleport.Types
import Control.Concurrent (threadDelay)
import Foreign.C (CInt)
import qualified Graphics.X11 as X11
@@ -18,3 +18,11 @@ triggerMouseLeftClick ctx = do
moveMouse :: DrawContext -> CInt -> CInt -> IO ()
moveMouse _ctx x y = do
SDL.warpMouse SDL.WarpGlobal (SDL.P $ SDL.V2 x y)
+
+isKeyPress :: SDL.KeyboardEventData -> Bool
+isKeyPress keyboardEvent =
+ SDL.keyboardEventKeyMotion keyboardEvent == SDL.Pressed
+
+isKeyPressWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
+isKeyPressWith keyboardEvent keyCode =
+ isKeyPress keyboardEvent && SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent) == keyCode
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index 6375997..fff5d0d 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, ctxWindow))
+import Chelleport.Types
import Data.Text (Text)
import Data.Word (Word8)
import Foreign.C (CInt)
@@ -13,6 +13,12 @@ colorWhite = SDL.V4 255 255 255 255
colorLightGray :: SDL.V4 Word8
colorLightGray = SDL.V4 100 100 100 255
+colorGray :: SDL.V4 Word8
+colorGray = SDL.V4 55 52 65 200
+
+colorAccent :: SDL.V4 Word8
+colorAccent = SDL.V4 110 112 247 255
+
colorGridLines :: SDL.V4 Word8
colorGridLines = SDL.V4 127 29 29 150
@@ -22,8 +28,8 @@ 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
+drawText :: DrawContext -> SDL.V2 CInt -> SDL.V4 Word8 -> Text -> IO (CInt, CInt)
+drawText ctx position color text = do
surface <- TTF.blended (ctxFont ctx) color text
texture <- SDL.createTextureFromSurface (ctxRenderer ctx) surface
SDL.freeSurface surface
diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs
index 1bc50a5..52e3a54 100644
--- a/src/Chelleport/KeySequence.hs
+++ b/src/Chelleport/KeySequence.hs
@@ -1,25 +1,10 @@
module Chelleport.KeySequence where
+import Chelleport.Types (KeyGrid, KeySequence)
import Data.List (isPrefixOf, nub)
import qualified Data.Map as Map
import qualified SDL
-type Cell = [Char]
-
-type KeySequence = [Char]
-
-type KeyGrid = [[Cell]]
-
--- padded :: Int -> a -> [a] -> [a]
--- padded 0 _ ls = ls
--- padded n x ls
--- | length ls > n = ls
--- | otherwise = padded (n - 1) x (ls ++ [x])
-
--- safeHead :: a -> [a] -> a
--- safeHead def [] = def
--- safeHead _ (x : _) = x
-
nextChars :: KeySequence -> KeyGrid -> Maybe [Char]
nextChars keys cells =
case matches of
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
new file mode 100644
index 0000000..766348b
--- /dev/null
+++ b/src/Chelleport/Types.hs
@@ -0,0 +1,25 @@
+module Chelleport.Types where
+
+import qualified Graphics.X11 as X11
+import qualified SDL
+import qualified SDL.Font as TTF
+
+type Cell = [Char]
+
+type KeySequence = [Char]
+
+type KeyGrid = [[Cell]]
+
+data State = State
+ { stateCells :: KeyGrid,
+ stateKeySequence :: KeySequence
+ }
+
+data AppAction = FilterSequence SDL.Keycode | TriggerLeftClick | SetupGrid
+
+data DrawContext = DrawContext
+ { ctxWindow :: SDL.Window,
+ ctxRenderer :: SDL.Renderer,
+ ctxFont :: TTF.Font,
+ ctxX11Display :: X11.Display
+ }
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
new file mode 100644
index 0000000..f1e941f
--- /dev/null
+++ b/src/Chelleport/View.hs
@@ -0,0 +1,67 @@
+module Chelleport.View (render) where
+
+import Chelleport.Draw
+import Chelleport.Types
+import Control.Monad (forM_, unless, void)
+import Data.IORef (modifyIORef', newIORef, readIORef)
+import Data.List (isPrefixOf)
+import qualified Data.Text as Text
+import Foreign.C (CInt)
+import SDL (($=))
+import qualified SDL
+import Unsafe.Coerce (unsafeCoerce)
+
+render :: State -> DrawContext -> IO ()
+render state ctx = do
+ renderGridLines state ctx
+
+ (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)
+
+ 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)
+ | keySequence `isPrefixOf` cell = splitAt (length keySequence) cell
+ | otherwise = ("", cell)
+
+ let textColor
+ | null keySequence = colorWhite
+ | not (null matched) = colorAccent
+ | otherwise = colorGray
+
+ widthRef <- newIORef 0
+ unless (null matched) $ do
+ (textWidth, _h) <- drawText ctx (SDL.V2 px py) colorLightGray $ Text.pack matched
+ modifyIORef' widthRef (const textWidth)
+
+ unless (null remaining) $ do
+ prevTextWidth <- readIORef widthRef
+ let pos = px + prevTextWidth
+ void $ drawText ctx (SDL.V2 pos py) textColor $ Text.pack remaining
+
+renderGridLines :: State -> DrawContext -> IO ()
+renderGridLines 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)
+
+ 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
+
+ SDL.rendererDrawColor (ctxRenderer ctx) $= colorAxisLines
+ drawHorizontalLine ctx (rows * hcell `div` 2)
+ drawVerticalLine ctx (columns * wcell `div` 2)