aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--chelleport.cabal1
-rw-r--r--specs/Main.hs6
-rw-r--r--specs/Mock.hs6
-rw-r--r--specs/Specs/ViewSpec.hs80
-rw-r--r--src/Chelleport/View.hs59
5 files changed, 122 insertions, 30 deletions
diff --git a/chelleport.cabal b/chelleport.cabal
index 8efc16a..e0c1c88 100644
--- a/chelleport.cabal
+++ b/chelleport.cabal
@@ -77,6 +77,7 @@ test-suite specs
Specs.KeySequenceSpec
Specs.AppStateUpdateSpec
Specs.AppEventSpec
+ Specs.ViewSpec
build-depends:
lib-chelleport,
hspec
diff --git a/specs/Main.hs b/specs/Main.hs
index 4308669..91a9e5a 100644
--- a/specs/Main.hs
+++ b/specs/Main.hs
@@ -3,10 +3,12 @@ module Main (main) where
import qualified Specs.AppEventSpec
import qualified Specs.AppStateUpdateSpec
import qualified Specs.KeySequenceSpec
+import qualified Specs.ViewSpec
import Test.Hspec (hspec)
main :: IO ()
main = hspec $ do
- Specs.KeySequenceSpec.test
- Specs.AppStateUpdateSpec.test
Specs.AppEventSpec.test
+ Specs.AppStateUpdateSpec.test
+ Specs.KeySequenceSpec.test
+ Specs.ViewSpec.test
diff --git a/specs/Mock.hs b/specs/Mock.hs
index c44aff3..d0daab1 100644
--- a/specs/Mock.hs
+++ b/specs/Mock.hs
@@ -8,6 +8,7 @@ import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.State (MonadState (state), StateT (runStateT))
import Data.Text (Text)
+import qualified Data.Text as Text
import Foreign.C (CInt)
import Test.Hspec
@@ -63,9 +64,12 @@ mockWindowOffsetX = 200
mockWindowOffsetY :: CInt
mockWindowOffsetY = 100
+mockTextWidth :: Int
+mockTextWidth = 10
+
instance (MonadIO m) => MonadDraw (TestM m) where
drawLine p1 p2 = registerMockCall $ CallDrawLine p1 p2
- drawText p color text = (0, 0) <$ registerMockCall (CallDrawText p color text)
+ drawText p color text = (fromIntegral $ mockTextWidth * Text.length text, 0) <$ registerMockCall (CallDrawText p color text)
drawCircle radius p = registerMockCall $ CallDrawCircle radius p
setDrawColor color = registerMockCall $ CallSetDrawColor color
windowSize = (mockWindowWidth, mockWindowHeight) <$ registerMockCall CallWindowSize
diff --git a/specs/Specs/ViewSpec.hs b/specs/Specs/ViewSpec.hs
new file mode 100644
index 0000000..62b49fd
--- /dev/null
+++ b/specs/Specs/ViewSpec.hs
@@ -0,0 +1,80 @@
+module Specs.ViewSpec where
+
+import Chelleport.Config
+import Chelleport.Types
+import Chelleport.View
+import Mock
+import Test.Hspec
+
+test :: SpecWith ()
+test = do
+ let defaultState =
+ State
+ { stateKeySequence = [],
+ stateIsShiftPressed = False,
+ stateIsMatched = False,
+ stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]],
+ stateIsDragging = False
+ }
+ let drawTextCalls = filter (\case CallDrawText {} -> True; _ -> False) . calls
+
+ describe "#render" $ do
+ context "when key sequence is empty" $ do
+ let currentState = defaultState {stateKeySequence = ""}
+
+ it "draws matching text labels" $ do
+ (_, mock) <- runWithMocks $ render currentState
+ drawTextCalls mock
+ `shouldBe` [ CallDrawText (460, 10) colorWhite "ABC",
+ CallDrawText (1420, 10) colorWhite "DEF",
+ CallDrawText (460, 550) colorWhite "DJK",
+ CallDrawText (1420, 550) colorWhite "JKL"
+ ]
+
+ context "when there is a partial match" $ do
+ let currentState = defaultState {stateKeySequence = "D"}
+
+ it "draws matching text labels" $ do
+ (_, mock) <- runWithMocks $ render currentState
+ drawTextCalls mock
+ `shouldBe` [ CallDrawText (1420, 10) colorLightGray "D",
+ CallDrawText (1430, 10) colorAccent "EF",
+ CallDrawText (460, 550) colorLightGray "D",
+ CallDrawText (470, 550) colorAccent "JK"
+ ]
+
+ context "when key sequence is complete match" $ do
+ let currentState = defaultState {stateKeySequence = "DEF"}
+
+ it "draws only the matching label" $ do
+ (_, mock) <- runWithMocks $ render currentState
+ drawTextCalls mock `shouldBe` [CallDrawText (1420, 10) colorLightGray "DEF"]
+
+ describe "#renderKeySequence" $ do
+ context "when there is a partial match" $ do
+ it "draws the matched section and highlights the remaining characters" $ do
+ (_, mock) <- runWithMocks $ renderKeySequence "ABC" "ABCDE" (0, 0)
+ calls mock
+ `shouldBe` [CallDrawText (0, 0) colorLightGray "ABC", CallDrawText (3 * 10, 0) colorAccent "DE"]
+
+ it "return true as the text is visible" $ do
+ (isVisible, _) <- runWithMocks $ renderKeySequence "ABC" "ABCDE" (0, 0)
+ isVisible `shouldBe` True
+
+ context "when there is no input key sequence" $ do
+ it "draws text as a single chunk" $ do
+ (_, mock) <- runWithMocks $ renderKeySequence "" "ABCD" (0, 0)
+ calls mock `shouldBe` [CallDrawText (0, 0) colorWhite "ABCD"]
+
+ it "return true as the text is visible" $ do
+ (isVisible, _) <- runWithMocks $ renderKeySequence "" "ABCD" (0, 0)
+ isVisible `shouldBe` True
+
+ context "when key sequence does not match" $ do
+ it "does not draw text" $ do
+ (_, mock) <- runWithMocks $ renderKeySequence "AXY" "ABCD" (0, 0)
+ calls mock `shouldBe` []
+
+ it "return false as the text is not visible" $ do
+ (isVisible, _) <- runWithMocks $ renderKeySequence "AXY" "ABCD" (0, 0)
+ isVisible `shouldBe` False
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index 459251b..fe06fd7 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -1,4 +1,4 @@
-module Chelleport.View (render) where
+module Chelleport.View (render, renderKeySequence, renderGranularGrid, renderGridLines) where
import Chelleport.Config
import Chelleport.Draw
@@ -6,7 +6,6 @@ import Chelleport.Types
import Chelleport.Utils (intToCInt, isEmpty, isNotEmpty)
import Control.Monad (forM_, void, when)
import Data.List (isPrefixOf, (\\))
-import Data.Maybe (isJust)
import qualified Data.Text as Text
import Foreign.C (CInt)
@@ -21,7 +20,9 @@ render state = do
let px = colIndex * wcell + wcell `div` 2 - 20
visible <- renderKeySequence (stateKeySequence state) cell (px, py)
when visible $ do
- renderTargetPoints state (rowIndex, colIndex)
+ renderTargetMarker state (rowIndex, colIndex)
+ when (stateIsMatched state) $ do
+ renderGranularGrid state (rowIndex, colIndex)
renderKeySequence :: (MonadDraw m) => KeySequence -> Cell -> (CInt, CInt) -> m Bool
renderKeySequence keySequence cell (px, py) = do
@@ -29,10 +30,10 @@ renderKeySequence keySequence cell (px, py) = do
| keySequence `isPrefixOf` cell = splitAt (length keySequence) cell
| otherwise = ("", cell)
- let textColor
- | isEmpty keySequence = Just colorWhite
- | isNotEmpty matched = Just colorHighlight
- | otherwise = Nothing
+ let (textColor, isVisible)
+ | isEmpty keySequence = (Just colorWhite, True)
+ | isNotEmpty matched = (Just colorHighlight, True)
+ | otherwise = (Nothing, False)
previousTextWidth <-
if isNotEmpty matched
@@ -41,11 +42,10 @@ renderKeySequence keySequence cell (px, py) = do
when (isNotEmpty remaining) $ case textColor of
Just color -> do
- let pos = px + previousTextWidth
- void $ drawText (pos, py) color $ Text.pack remaining
+ void $ drawText (px + previousTextWidth, py) color $ Text.pack remaining
Nothing -> pure ()
- pure (isJust textColor)
+ pure isVisible
renderGridLines :: (MonadDraw m) => State -> m ()
renderGridLines state = do
@@ -69,25 +69,30 @@ renderGridLines state = do
drawHorizontalLine (rows * hcell `div` 2)
drawVerticalLine (columns * wcell `div` 2)
-renderTargetPoints :: (MonadDraw m) => State -> (CInt, CInt) -> m ()
-renderTargetPoints state (row, col) = do
+renderTargetMarker :: (MonadDraw m) => State -> (CInt, CInt) -> m ()
+renderTargetMarker state (row, col) = do
(wcell, hcell) <- cellSize state
let (x, y) = (col * wcell + wcell `div` 2, row * hcell + hcell `div` 2)
setDrawColor colorWhite
drawCircle 2 (x, y)
- when (stateIsMatched state) $ do
- setDrawColor colorFineGrainGrid
- forM_ ([-8 .. 8] \\ [0]) $ \n -> do
- let px = x + n * wcell `div` 16
- drawLine (px, y - hcell `div` 2) (px, y + hcell `div` 2)
- forM_ ([-8 .. 8] \\ [0]) $ \n -> do
- let py = y + n * hcell `div` 16
- drawLine (x - wcell `div` 2, py) (x + wcell `div` 2, py)
- setDrawColor colorLightGray
- let lenx = wcell `div` 4
- let leny = hcell `div` 4
- drawLine (x - wcell `div` 4, y - leny) (x - wcell `div` 4, y + leny)
- drawLine (x + wcell `div` 4, y - leny) (x + wcell `div` 4, y + leny)
- drawLine (x - lenx, y - hcell `div` 4) (x + lenx, y - hcell `div` 4)
- drawLine (x - lenx, y + hcell `div` 4) (x + lenx, y + hcell `div` 4)
+renderGranularGrid :: (MonadDraw m) => State -> (CInt, CInt) -> m ()
+renderGranularGrid state (row, col) = do
+ (wcell, hcell) <- cellSize state
+ let (x, y) = (col * wcell + wcell `div` 2, row * hcell + hcell `div` 2)
+
+ setDrawColor colorFineGrainGrid
+ forM_ ([-8 .. 8] \\ [0]) $ \n -> do
+ let px = x + n * wcell `div` 16
+ drawLine (px, y - hcell `div` 2) (px, y + hcell `div` 2)
+ forM_ ([-8 .. 8] \\ [0]) $ \n -> do
+ let py = y + n * hcell `div` 16
+ drawLine (x - wcell `div` 2, py) (x + wcell `div` 2, py)
+
+ setDrawColor colorLightGray
+ let lenx = wcell `div` 4
+ let leny = hcell `div` 4
+ drawLine (x - wcell `div` 4, y - leny) (x - wcell `div` 4, y + leny)
+ drawLine (x + wcell `div` 4, y - leny) (x + wcell `div` 4, y + leny)
+ drawLine (x - lenx, y - hcell `div` 4) (x + lenx, y - hcell `div` 4)
+ drawLine (x - lenx, y + hcell `div` 4) (x + lenx, y + hcell `div` 4)