diff options
| author | Akshay Nair <phenax5@gmail.com> | 2024-12-15 18:13:03 +0530 |
|---|---|---|
| committer | Akshay Nair <phenax5@gmail.com> | 2024-12-15 18:13:03 +0530 |
| commit | 60b4a0fafebfc0351b3d0a6be13474d0f76e284a (patch) | |
| tree | 0829ca8bfd836c8f26b5301a41c70c1423c8ad66 /src | |
| parent | 1d07e554284593cdca804404d1d9f68a473ee986 (diff) | |
| download | chelleport-60b4a0fafebfc0351b3d0a6be13474d0f76e284a.tar.gz chelleport-60b4a0fafebfc0351b3d0a6be13474d0f76e284a.zip | |
UI changes for grid
Diffstat (limited to 'src')
| -rw-r--r-- | src/Chelleport.hs | 12 | ||||
| -rw-r--r-- | src/Chelleport/Draw.hs | 4 | ||||
| -rw-r--r-- | src/Chelleport/Types.hs | 2 | ||||
| -rw-r--r-- | src/Chelleport/Utils.hs | 6 | ||||
| -rw-r--r-- | src/Chelleport/View.hs | 56 |
5 files changed, 55 insertions, 25 deletions
diff --git a/src/Chelleport.hs b/src/Chelleport.hs index c1547d7..82188b9 100644 --- a/src/Chelleport.hs +++ b/src/Chelleport.hs @@ -3,7 +3,7 @@ module Chelleport where import Chelleport.AppShell (Action (AppAction, SysQuit), EventHandler, Update, hideWindow, setupAppShell) import Chelleport.Control (isKeyPress, isKeyPressWith, moveMouse, triggerMouseLeftClick) import Chelleport.Draw (windowSize) -import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateKeyCells, isValidKey, nextChars, toKeyChar) +import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar) import Chelleport.Types import Chelleport.Utils (intToCInt) import qualified Chelleport.View @@ -14,8 +14,8 @@ open = setupAppShell initialState update eventToAction Chelleport.View.render initialState :: DrawContext -> IO State initialState _ctx = do - let cells = generateKeyCells (rows, columns) hintKeys - pure $ State {stateCells = cells, stateKeySequence = []} + let cells = generateGrid (rows, columns) hintKeys + pure $ State {stateGrid = cells, stateKeySequence = []} where rows = 12 columns = 12 @@ -27,14 +27,14 @@ update state _ctx (FilterSequence key) = Just (keyChar, validChars') | keyChar `elem` validChars' -> do let newKeySequence = stateKeySequence state ++ [keyChar] - let matchPosition = findMatchPosition newKeySequence $ stateCells state + let matchPosition = findMatchPosition newKeySequence $ stateGrid state pure ( state {stateKeySequence = newKeySequence}, AppAction . MoveMousePosition <$> matchPosition ) _ -> pure (state, Nothing) where - validChars = nextChars (stateKeySequence state) (stateCells state) + validChars = nextChars (stateKeySequence state) (stateGrid state) update state ctx (MoveMousePosition (row, col)) = do (x, y) <- getPosition moveMouse ctx x y @@ -42,7 +42,7 @@ update state ctx (MoveMousePosition (row, col)) = do where cellDimensions = do (SDL.V2 width height) <- windowSize ctx - let rows = stateCells state + let rows = stateGrid state let wcell = width `div` intToCInt (length $ head rows) let hcell = height `div` intToCInt (length rows) pure (wcell, hcell) diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs index 530713a..9ace9da 100644 --- a/src/Chelleport/Draw.hs +++ b/src/Chelleport/Draw.hs @@ -26,14 +26,14 @@ colorGridLines :: SDL.V4 Word8 colorGridLines = SDL.V4 127 29 29 150 colorAxisLines :: SDL.V4 Word8 -colorAxisLines = SDL.V4 239 68 68 255 +colorAxisLines = colorAccent colorBackground :: SDL.V4 Word8 colorBackground = SDL.V4 15 12 25 0 drawText :: DrawContext -> SDL.V2 CInt -> SDL.V4 Word8 -> Text -> IO (CInt, CInt) drawText ctx@(DrawContext {ctxRenderer = renderer}) position color text = do - surface <- TTF.solid (ctxFont ctx) color text -- TTF.blended + surface <- TTF.blended (ctxFont ctx) color text texture <- SDL.createTextureFromSurface renderer surface SDL.freeSurface surface diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs index 222a011..8c86d03 100644 --- a/src/Chelleport/Types.hs +++ b/src/Chelleport/Types.hs @@ -11,7 +11,7 @@ type KeySequence = [Char] type KeyGrid = [[Cell]] data State = State - { stateCells :: KeyGrid, + { stateGrid :: KeyGrid, stateKeySequence :: KeySequence } diff --git a/src/Chelleport/Utils.hs b/src/Chelleport/Utils.hs index 5977039..0e7dabc 100644 --- a/src/Chelleport/Utils.hs +++ b/src/Chelleport/Utils.hs @@ -2,10 +2,12 @@ module Chelleport.Utils where import Data.List (nub) import Foreign.C (CInt) -import Unsafe.Coerce (unsafeCoerce) intToCInt :: Int -> CInt -intToCInt = unsafeCoerce +intToCInt = fromIntegral + +cIntToInt :: CInt -> Int +cIntToInt = fromIntegral findWithIndex :: (x -> Maybe r) -> Int -> [x] -> Maybe (Int, r) findWithIndex _predicate _index [] = Nothing diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs index c02e704..2ac90a7 100644 --- a/src/Chelleport/View.hs +++ b/src/Chelleport/View.hs @@ -3,39 +3,43 @@ module Chelleport.View (render) where import Chelleport.Draw import Chelleport.Types import Chelleport.Utils (intToCInt, isEmpty, isNotEmpty) -import Control.Monad (forM_, unless, void) +import Control.Monad (forM_, unless, void, when) import Data.IORef (modifyIORef', newIORef, readIORef) import Data.List (isPrefixOf) import qualified Data.Text as Text +import qualified Data.Vector.Storable as Vector import Foreign.C (CInt) import SDL (($=)) import qualified SDL +import Data.Maybe (isJust) render :: State -> DrawContext -> IO () render state ctx = do renderGridLines state ctx (SDL.V2 width height) <- windowSize ctx - let grid = stateCells state + let grid = stateGrid state let wcell = width `div` intToCInt (length $ head grid) let hcell = height `div` intToCInt (length grid) forM_ (zip [0 ..] grid) $ \(rowIndex, row) -> do forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do - let py = rowIndex * hcell - let px = colIndex * wcell - renderKeySequence ctx (stateKeySequence state) cell (px, py) + let py = rowIndex * hcell + 10 + let px = colIndex * wcell + wcell `div` 2 - 20 + visible <- renderKeySequence ctx (stateKeySequence state) cell (px, py) + when visible $ do + renderTargetPoint ctx (colIndex * wcell + wcell `div` 2, rowIndex * hcell + hcell `div` 2) -renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO () +renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO Bool renderKeySequence ctx keySequence cell (px, py) = do let (matched, remaining) | keySequence `isPrefixOf` cell = splitAt (length keySequence) cell | otherwise = ("", cell) let textColor - | isEmpty keySequence = colorWhite - | isNotEmpty matched = colorHighlight - | otherwise = colorGray + | isEmpty keySequence = Just colorWhite + | isNotEmpty matched = Just colorHighlight + | otherwise = Nothing widthRef <- newIORef 0 unless (isEmpty matched) $ do @@ -43,25 +47,49 @@ renderKeySequence ctx keySequence cell (px, py) = do modifyIORef' widthRef (const textWidth) unless (isEmpty remaining) $ do - prevTextWidth <- readIORef widthRef - let pos = px + prevTextWidth - void $ drawText ctx (SDL.V2 pos py) textColor $ Text.pack remaining + case textColor of + Just color -> do + prevTextWidth <- readIORef widthRef + let pos = px + prevTextWidth + void $ drawText ctx (SDL.V2 pos py) color $ Text.pack remaining + Nothing -> pure () + + pure (isJust textColor) renderGridLines :: State -> DrawContext -> IO () renderGridLines state ctx@(DrawContext {ctxRenderer = renderer}) = do (SDL.V2 width height) <- windowSize ctx - let grid = stateCells state + let grid = stateGrid state let wcell = width `div` intToCInt (length $ head grid) let hcell = height `div` intToCInt (length grid) - SDL.rendererDrawColor renderer $= colorGridLines let rows = intToCInt $ length grid let columns = intToCInt $ length $ head grid forM_ [0 .. rows] $ \rowIndex -> do + SDL.rendererDrawColor renderer $= colorGray + drawHorizontalLine ctx (rowIndex * hcell + hcell `div` 2) + SDL.rendererDrawColor renderer $= colorGridLines drawHorizontalLine ctx $ rowIndex * hcell forM_ [0 .. columns] $ \colIndex -> do + SDL.rendererDrawColor renderer $= colorGray + drawVerticalLine ctx (colIndex * wcell + wcell `div` 2) + SDL.rendererDrawColor renderer $= colorGridLines drawVerticalLine ctx $ colIndex * wcell SDL.rendererDrawColor renderer $= colorAxisLines drawHorizontalLine ctx (rows * hcell `div` 2) drawVerticalLine ctx (columns * wcell `div` 2) + +renderTargetPoint :: DrawContext -> (CInt, CInt) -> IO () +renderTargetPoint (DrawContext {ctxRenderer = renderer}) (x, y) = do + let renderedPoints = 16 + let radius = 2.0 :: Double + let toTheta n = fromIntegral n * (2 * pi) / fromIntegral renderedPoints + toPointOnCircle n = + SDL.V2 + (x + round (radius * cos (toTheta n))) + (y + round (radius * sin (toTheta n))) + let points = Vector.generate renderedPoints (SDL.P . toPointOnCircle) + SDL.rendererDrawColor renderer $= colorWhite + SDL.drawPoints renderer points + pure () |
