aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Chelleport/AppShell.hs1
-rw-r--r--src/Chelleport/Context.hs16
-rw-r--r--src/Chelleport/View.hs11
3 files changed, 19 insertions, 9 deletions
diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 382f61e..8f8a19d 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -24,6 +24,7 @@ instance (MonadIO m) => MonadAppShell (AppM m) where
SDL.destroyRenderer $ ctxRenderer ctx
SDL.destroyWindow $ ctxWindow ctx
releaseMouseButton
+ SDL.quit
liftIO $ do
X11.closeDisplay $ ctxX11Display ctx
exitSuccess
diff --git a/src/Chelleport/Context.hs b/src/Chelleport/Context.hs
index 15c0b6a..3c2c850 100644
--- a/src/Chelleport/Context.hs
+++ b/src/Chelleport/Context.hs
@@ -3,6 +3,8 @@ module Chelleport.Context (initializeContext) where
import Chelleport.Types
import Data.ByteString (ByteString)
import Data.FileEmbed (embedFileRelative)
+-- import Data.Time.Clock.System
+-- import qualified Debug.Trace as Debug
import Foreign.C (CFloat)
import qualified Graphics.X11 as X11
import SDL (($=))
@@ -15,10 +17,18 @@ windowOpacity = 0.5
fontSize :: Int
fontSize = 24
+-- benchmark :: String -> IO a -> IO a
+-- benchmark msg m = do
+-- start <- systemNanoseconds <$> getSystemTime
+-- result <- m
+-- end <- systemNanoseconds <$> getSystemTime
+-- Debug.traceM $ msg ++ ": " ++ show (end - start)
+-- pure result
+
initializeContext :: IO DrawContext
initializeContext = do
-- Initialize SDL
- SDL.initializeAll
+ SDL.initialize [SDL.InitVideo, SDL.InitEvents]
TTF.initialize
window <- initializeWindow
@@ -60,6 +70,4 @@ initializeWindow = do
SDL.windowInitialSize = SDL.V2 0 0,
SDL.windowBorder = False
}
- window <- SDL.createWindow "Chelleport" windowCfg
- SDL.showWindow window
- pure window
+ SDL.createWindow "Chelleport" windowCfg
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index 4007bdc..069e49c 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -22,7 +22,7 @@ render state = do
when visible $ do
renderTargetPoints state (rowIndex, colIndex)
-renderKeySequence ::(MonadDraw m) => KeySequence -> Cell -> (CInt, CInt) -> m Bool
+renderKeySequence :: (MonadDraw m) => KeySequence -> Cell -> (CInt, CInt) -> m Bool
renderKeySequence keySequence cell (px, py) = do
let (matched, remaining)
| keySequence `isPrefixOf` cell = splitAt (length keySequence) cell
@@ -33,9 +33,10 @@ renderKeySequence keySequence cell (px, py) = do
| isNotEmpty matched = Just colorHighlight
| otherwise = Nothing
- previousTextWidth <- if isNotEmpty matched
- then fst <$> drawText (px, py) colorLightGray (Text.pack matched)
- else pure 0
+ previousTextWidth <-
+ if isNotEmpty matched
+ then fst <$> drawText (px, py) colorLightGray (Text.pack matched)
+ else pure 0
when (isNotEmpty remaining) $ case textColor of
Just color -> do
@@ -67,7 +68,7 @@ renderGridLines state = do
drawHorizontalLine (rows * hcell `div` 2)
drawVerticalLine (columns * wcell `div` 2)
-renderTargetPoints :: (MonadDraw m) =>State -> (CInt, CInt) -> m ()
+renderTargetPoints :: (MonadDraw m) => State -> (CInt, CInt) -> m ()
renderTargetPoints state (row, col) = do
(wcell, hcell) <- cellSize state
let (x, y) = (col * wcell + wcell `div` 2, row * hcell + hcell `div` 2)