From 824ca452980844e64172288ace89ddc71ffa39dd Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 25 Apr 2020 14:59:22 +0200 Subject: [PATCH] switch terminal handling library to vty --- raycharles.cabal | 5 ++- shell.nix | 7 ++- src/Main.hs | 109 ++++++++++++++++++++++++++++------------------- src/Types.hs | 2 + 4 files changed, 72 insertions(+), 51 deletions(-) diff --git a/raycharles.cabal b/raycharles.cabal index 7d6097c..72cc5b7 100644 --- a/raycharles.cabal +++ b/raycharles.cabal @@ -23,13 +23,14 @@ executable raycharles build-depends: base >=4.11 && <5 , linear , matrix - , ansi-terminal + -- , ansi-terminal + -- , terminal-size , suspend , monad-loops - , terminal-size , deepseq , parallel , vector + , vty hs-source-dirs: src ghc-options: -Wall -threaded default-language: Haskell2010 diff --git a/shell.nix b/shell.nix index 9847c45..ef5c216 100644 --- a/shell.nix +++ b/shell.nix @@ -4,8 +4,8 @@ let inherit (nixpkgs) pkgs; - f = { mkDerivation, ansi-terminal, base, deepseq, linear, matrix - , monad-loops, parallel, stdenv, suspend, terminal-size, vector + f = { mkDerivation, base, deepseq, linear, matrix, monad-loops + , parallel, stdenv, suspend, vector, vty }: mkDerivation { pname = "raycharles"; @@ -14,8 +14,7 @@ let isLibrary = false; isExecutable = true; executableHaskellDepends = [ - ansi-terminal base deepseq linear matrix monad-loops parallel - suspend terminal-size vector + base deepseq linear matrix monad-loops parallel suspend vector vty ]; description = "A simple raytracer on the Console"; license = stdenv.lib.licenses.bsd3; diff --git a/src/Main.hs b/src/Main.hs index 486a45b..14edc29 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -13,9 +13,11 @@ import Control.Concurrent.Suspend.Lifted import Control.DeepSeq import Control.Parallel.Strategies -import System.IO -import System.Console.ANSI as CA -import System.Console.Terminal.Size as TS +-- import System.IO +-- import System.Console.ANSI as CA +-- import System.Console.Terminal.Size as TS + +import Graphics.Vty -- import Debug.Trace as T @@ -42,21 +44,37 @@ vfov = pi / 2 main :: IO () main = do - hSetBuffering stdin NoBuffering - hSetEcho stdin False - hideCursor - state <- newMVar (State (V2 10 3) 0 False "") - c <- newMVar Nothing + -- hSetBuffering stdin NoBuffering + -- hSetEcho stdin False + -- hideCursor + cfg <- standardIOConfig + vty <- mkVty cfg + hideCursor (outputIface vty) + state <- newMVar (State (V2 10 3) 0 False "" vty) + -- c <- newMVar Nothing whileM_ (not <$> stop <$> readMVar state) $ do - CA.clearScreen - _ <- takeMVar c - char <- getKey - putMVar c char - modifyMVar_ state (\s -> if (not (stop s)) - then - withMVar c (\mvchar -> handleInput mvchar s) - else - return s) + -- CA.clearScreen + -- reserveDisplay (outputIface vty) + -- _ <- takeMVar c + -- char <- getKey + -- putMVar c char + rev <- nextEventNonblocking vty + char <- case rev of + Just (EvKey (KChar c) []) -> do + modifyMVar_ state (\s -> if (not (stop s)) + then do + handleInput c s + else + return s) + return (Just c) + Just (EvKey (KEsc) []) -> do + modifyMVar_ state (\s -> + return s + { stop = True + } + ) + return Nothing + _ -> return Nothing outputs <- withMVar state draw withMVar state (\s -> when (not (stop s)) $ do let foutput = V.toList $ @@ -69,12 +87,13 @@ main = do deepseq foutput (putStr foutput) ) -- threadDelay msdelay - hSetEcho stdin True - showCursor + -- hSetEcho stdin True + -- showCursor + shutdown vty -handleInput :: Maybe Char -> State -> IO State -handleInput Nothing state = return state -handleInput (Just char) state = do +handleInput :: Char -> State -> IO State +-- handleInput Nothing state = return state +handleInput char state = do let npos delta = if not (doesCollide (pos state + delta)) then pos state + delta else pos state @@ -87,14 +106,14 @@ handleInput (Just char) state = do { rot = rot state + rotStep } 'a' -> state { rot = rot state - rotStep } - '\ESC' -> state - { stop = True } + -- '\ESC' -> state + -- { stop = True } _ -> state return nstate draw :: State -> IO (V.Vector (V.Vector Char)) -draw (State ppos prot _ _) = do - (Just (Window h w)) <- TS.size :: IO (Maybe (Window Int)) +draw (State ppos prot _ _ vty) = do + (w, h) <- displayBounds (outputIface vty) let dims@(dw, dh) = (w, (h - 4)) out = (V.generate (fromIntegral dh) ((\mh -> @@ -234,22 +253,22 @@ rotVec (V2 x y) rad = V2 nx ny ny = x * sin rad - y * cos rad {-# INLINE rotVec #-} -getKey :: IO (Maybe Char) -getKey = do - charMVar <- newEmptyMVar - tid <- forkIO (forkGetChar charMVar) - threadDelay (msdelay `div` 5) - empty <- isEmptyMVar charMVar - if (not empty) - then do - killThread tid - Just <$> takeMVar charMVar - else do - killThread tid - return Nothing - where - forkGetChar mvar = do - cs <- (: []) <$> hGetChar stdin - when (not (null cs)) $ do - _ <- putMVar mvar (head cs) - return () +-- getKey :: IO (Maybe Char) +-- getKey = do +-- charMVar <- newEmptyMVar +-- tid <- forkIO (forkGetChar charMVar) +-- threadDelay (msdelay `div` 5) +-- empty <- isEmptyMVar charMVar +-- if (not empty) +-- then do +-- killThread tid +-- Just <$> takeMVar charMVar +-- else do +-- killThread tid +-- return Nothing +-- where +-- forkGetChar mvar = do +-- cs <- (: []) <$> hGetChar stdin +-- when (not (null cs)) $ do +-- _ <- putMVar mvar (head cs) +-- return () diff --git a/src/Types.hs b/src/Types.hs index 6145b41..4750ba3 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,10 +1,12 @@ module Types where import Linear +import Graphics.Vty (Vty) data State = State { pos :: V2 Double , rot :: Double , stop :: Bool , output :: String + , vty :: Vty }