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