diff options
| -rw-r--r-- | chelleport.cabal | 10 | ||||
| -rw-r--r-- | flake.nix | 16 | ||||
| -rw-r--r-- | src/Chelleport/AppShell.hs | 1 | ||||
| -rw-r--r-- | src/Chelleport/Context.hs | 16 | ||||
| -rw-r--r-- | src/Chelleport/View.hs | 11 |
5 files changed, 30 insertions, 24 deletions
diff --git a/chelleport.cabal b/chelleport.cabal index 1397a33..ceeb2af 100644 --- a/chelleport.cabal +++ b/chelleport.cabal @@ -9,11 +9,6 @@ build-type: Simple synopsis: Mouse control description: Mouse control -Flag release - Description: Release build options - Manual: True - Default: False - common common-config default-extensions: ExplicitForAll @@ -32,6 +27,7 @@ common common-config build-depends: base, text, + time, mtl == 2.3.1, sdl2 == 2.5.5.0, containers @@ -41,9 +37,7 @@ common warnings -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-foralls -Wextra -Wno-unused-do-bind -Wname-shadowing -fwarn-tabs -fprint-explicit-foralls -fprint-explicit-kinds - extra-libraries: Xtst - if flag(release) - ghc-options: -O2 -Werror + extra-libraries: Xtst X11 executable chelleport import: common-config, warnings @@ -25,6 +25,7 @@ otherFiles = [ { source = ./static; target = "static"; } ]; + configurationFlags = [ "--ghc-options=-O2" ]; in { haskellProjects.default = { inherit projectRoot; @@ -32,20 +33,21 @@ packages = {}; settings = { chelleport = { + check = true; deadCodeElimination = true; staticLibraries = true; - # extraBuildFlags = ["+release"]; strip = true; - custom = drv: drv.overrideAttrs(old: { - preBuild = '' - ${toString (map (f: ''cp -r ${f.source} ${f.target};'') otherFiles)} - ''; - }); + custom = drv: + (pkgs.haskell.lib.compose.appendConfigureFlags configurationFlags drv).overrideAttrs (old: { + preBuild = '' + ${toString (map (f: ''cp -r ${f.source} ${f.target};'') otherFiles)} + ''; + }) + ; }; }; devShell = { - # tools = hp: { fourmolu = hp.fourmolu; ghcid = null; }; hlsCheck.enable = false; }; 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) |