blob: 2c61a3bd792a43120c6c04c20ed0da872e0e699e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
-- Copyright © 2015 Benjamin Barenblat
--
-- Licensed under the Apache License, Version 2.0 (the "License"); you may not
-- use this file except in compliance with the License. You may obtain a copy
-- of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-- License for the specific language governing permissions and limitations under
-- the License.
module Main (main) where
import Prelude hiding (lines, log)
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.MSampleVar
import Control.Monad (forever, void)
import Data.Default.Class (def)
import Data.IORef
import Graphics.Vty (Vty)
import qualified Graphics.Vty as Vty
main :: IO ()
main = do
terminal <- Vty.mkVty def
initialize terminal
jarvis terminal
Vty.shutdown terminal
initialize :: Vty -> IO ()
initialize _ = return ()
jarvis :: Vty -> IO ()
jarvis terminal = do
log <- newIORef Vty.emptyImage
prompt <- newIORef Vty.emptyImage
ready <- newEmptySV
void $ forkIO $ redrawer ready log prompt terminal
void $ forkIO $ prompter prompt ready
void $ forkIO $ logger log ready
void $ Vty.nextEvent terminal
prompter :: IORef Vty.Image -> MSampleVar () -> IO ()
prompter output redraw = prompt' 0
where prompt' :: Integer -> IO ()
prompt' n = do
writeIORef output $ Vty.string def ("jarvis " ++ show n ++ " >")
writeSV redraw ()
threadDelay 1000000
prompt' (n + 1)
logger :: IORef Vty.Image -> MSampleVar () -> IO ()
logger output redraw = log 0 []
where log :: Integer -> [String] -> IO ()
log n lines = do
let lines' = lines ++ ["<" ++ show n ++ ">"]
writeIORef output $ Vty.vertCat $ map (Vty.string def) lines'
writeSV redraw ()
threadDelay 200000
log (n + 1) lines'
redrawer :: MSampleVar () -> IORef Vty.Image -> IORef Vty.Image -> Vty -> IO ()
redrawer ready log prompt terminal = forever $ do
void $ readSV ready
(_maxX, maxY) <- Vty.displayBounds $ Vty.outputIface terminal
images <- sequence $ map readIORef [log, prompt]
let stack = resizeHeight' maxY $ Vty.vertCat images
Vty.update terminal $ Vty.picForImage stack
Vty.refresh terminal
resizeHeight' :: Int -> Vty.Image -> Vty.Image
resizeHeight' h i = case h `compare` Vty.imageHeight i of
LT -> Vty.cropTop h i
EQ -> i
GT -> Vty.translateY (h - Vty.imageHeight i) i
|
