on 71cd98f help sign in
vty/test/Test.hs
44 lines 2.2 kB history raw
1{-# LANGUAGE ScopedTypeVariables #-}
2module Main where
4import Graphics.Vty
6import qualified Data.ByteString as B
7import Data.Word
9import System.IO
12main = do
13 vt <- mkVty
14 DisplayRegion w h <- display_bounds $ terminal vt
15 putStrLn $ show $ DisplayRegion w h
16 play vt 0 1 w h ""
18pieceA = def_attr `with_fore_color` red
19dumpA = def_attr `with_style` reverse_video
21play :: Vty -> Word -> Word -> Word -> Word -> String -> IO ()
22play vt x y sx sy btl = do update vt (current_pic x y sx sy btl)
23 k <- next_event vt
24 case k of EvKey (KASCII 'r') [MCtrl] -> refresh vt >> play vt x y sx sy btl
25 EvKey KLeft [] | x /= 0 -> play vt (x-1) y sx sy btl
26 EvKey KRight [] | x /= (sx-1) -> play vt (x+1) y sx sy btl
27 EvKey KUp [] | y /= 1 -> play vt x (y-1) sx sy btl
28 EvKey KDown [] | y /= (sy-2) -> play vt x (y+1) sx sy btl
29 EvKey KEsc [] -> shutdown vt >> return ()
30 EvResize nx ny -> play vt (min x (toEnum nx - 1))
31 (min y (toEnum ny - 2))
32 (toEnum nx)
33 (toEnum ny)
34 btl
35 _ -> play vt x y sx sy (take (fromEnum sx) (show k ++ btl))
38current_pic :: Word -> Word -> Word -> Word -> String -> Picture
39current_pic x y sx sy btl = pic_for_image i
40 where i = string def_attr "Move the @ character around with the arrow keys. Escape exits."
41 <-> char_fill pieceA ' ' sx (y - 1)
42 <-> char_fill pieceA ' ' x 1 <|> char pieceA '@' <|> char_fill pieceA ' ' (sx - x - 1) 1
43 <-> char_fill pieceA ' ' sx (sy - y - 2)
44 <-> iso_10646_string dumpA btl