git.iko.soy/vty
on master help sign in
change the translate method to allow negative translations.. with a catch.
0ccb7dcCorey O'Connor
src/Graphics/Vty/Image.hs+19−2
compare with master
unifiedsplit
@@ -251,9 +251,26 @@ pad in_l in_t in_r in_b in_image
251 where w = image_width i + l
251 where w = image_width i + l
252 h = image_height i
252 h = image_height i
253
253
254−-- | "translates" an image by padding the top and left.
254+-- | translates an image by padding or cropping the top and left.
255+--
256+-- TODO: This has an unexpected effect - Translating an image off the screen and then back onto the
257+-- screen will result in an empty image.
255translate :: Int -> Int -> Image -> Image
258translate :: Int -> Int -> Image -> Image
256−translate x y i = pad x y 0 0 i
259+translate x y i = translate_x x (translate_y y i)
260+
261+-- | translates an image by padding or cropping the left
262+translate_x :: Int -> Image -> Image
263+translate_x x i
264+ | x < 0 = let s = abs x in CropLeft i s (image_width i - s) (image_height i)
265+ | x == 0 = i
266+ | otherwise = let h = image_height i in HorizJoin (BGFill x h) i (image_width i + x) h
267+
268+-- | translates an image by padding or cropping the top
269+translate_y :: Int -> Image -> Image
270+translate_y y i
271+ | y < 0 = let s = abs y in CropTop i s (image_width i) (image_height i - s)
272+ | y == 0 = i
273+ | otherwise = let w = image_width i in VertJoin (BGFill w y) i w (image_height i + y)
257
274
258-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right
275-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right
259-- or bottom.
276-- or bottom.
src/Graphics/Vty/Input/Data.hs+7−151
@@ -1,35 +1,12 @@
1-- Copyright Corey O'Connor
1-- Copyright Corey O'Connor
2−module Graphics.Vty.Input.Data where
2+module Graphics.Vty.Input.Data ( module Graphics.Vty.Input.Data
3+ , module Graphics.Vty.Input.Data.ANSI
4+ , module Graphics.Vty.Input.Events
5+ )
6+where
3
7
4−-- | Representations of non-modifier keys.
8+import Graphics.Vty.Input.Data.ANSI
5−--
9+import Graphics.Vty.Input.Events
6−-- KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.
7−data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns
8− | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KNP5 | KUp | KMenu
9− | KLeft | KDown | KRight | KEnter
10− deriving (Eq,Show,Ord)
11−
12−-- | Modifier keys. Key codes are interpreted such that users are more likely to
13−-- have Meta than Alt; for instance on the PC Linux console, 'MMeta' will
14−-- generally correspond to the physical Alt key.
15−data Modifier = MShift | MCtrl | MMeta | MAlt
16− deriving (Eq,Show,Ord)
17−
18−-- | Mouse buttons. Not yet used.
19−data Button = BLeft | BMiddle | BRight
20− deriving (Eq,Show,Ord)
21−
22−-- | Generic events.
23−data Event = EvKey Key [Modifier] | EvMouse Int Int Button [Modifier]
24− | EvResize Int Int
25− deriving (Eq,Show,Ord)
26−
27−-- | representation of mapping from input bytes to output event
28−--
29−-- deprecated
30−type ClassifyTableV1 = [(String, (Key, [Modifier]))]
31−
32−type ClassifyTable = [(String, Event)]
33
10
34map_to_legacy_table :: ClassifyTable -> ClassifyTableV1
11map_to_legacy_table :: ClassifyTable -> ClassifyTableV1
35map_to_legacy_table = map f
12map_to_legacy_table = map f
@@ -54,124 +31,3 @@ keys_from_caps_table =
54function_key_caps_table :: ClassifyTable
31function_key_caps_table :: ClassifyTable
55function_key_caps_table = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])
32function_key_caps_table = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])
56
33
57−-- | Encoding for navigation keys.
58−--
59−-- TODO: This is not the same as the input bytes pulled from teh caps table.
60−nav_keys_0 :: ClassifyTableV1
61−nav_keys_0 =
62− [ k "G" KNP5
63− , k "P" KPause
64− , k "A" KUp
65− , k "B" KDown
66− , k "C" KRight
67− , k "D" KLeft
68− , k "H" KHome
69− , k "F" KEnd
70− , k "E" KBegin
71− ]
72− where k c s = ("\ESC["++c,(s,[]))
73−
74−-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end
75−nav_keys_1 :: ClassifyTableV1
76−nav_keys_1 =
77− [("\ESC[" ++ charCnt ++ show mc++c,(s,m))
78− | charCnt <- ["1;", ""], -- we can have a count or not
79− (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),
80− ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes
81− (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)] -- directions and their codes
82− ]
83−
84−-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end
85−nav_keys_2 :: ClassifyTableV1
86−nav_keys_2 =
87− let k n s = ("\ESC["++show n++"~",(s,[]))
88− in zipWith k [2::Int,3,5,6,1,4]
89− [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]
90−
91−-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end
92−nav_keys_3 :: ClassifyTableV1
93−nav_keys_3 =
94− let k n s = ("\ESC["++show n++";5~",(s,[MCtrl]))
95− in zipWith k [2::Int,3,5,6,1,4]
96− [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]
97−
98−-- | Support for simple characters.
99−--
100−-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this
101−-- classify table is reached.
102−--
103−-- TODO: resolve
104−-- 1. start at ' '. The earlier characters are all ctrl_char_keys
105−simple_chars :: ClassifyTableV1
106−simple_chars = [(x:[],(KASCII x,[])) | x <- [' ' .. toEnum 0xC1]]
107−
108−-- | VT 100 (?) encoding for shift plus function keys
109−--
110−-- TODO: I suspect this should be generated by interpretting the terminals use of meta mode:
111−-- "If the terminal has a ``meta key'' which acts as a shift key, setting the 8th bit of any
112−-- character transmitted, this fact can be indicated with km. Other- wise, software will
113−-- assume that the 8th bit is parity and it will usually be cleared. If strings exist to turn this
114−-- ``meta mode'' on and off, they can be given as smm and rmm."
115−--
116−-- That is more complex than below. I cannot fault the original author for just hard coding a table.
117−function_keys_1 :: ClassifyTableV1
118−function_keys_1 =
119− let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in
120− concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
121−
122−-- | VT 100 (?) encoding for meta plus char
123−--
124−-- TODO: resolve -
125−--
126−-- 1. removed 'ESC' from second list due to duplication with "special_support_keys".
127−-- 2. removed '[' from second list due to conflict with 7-bit encoding for ESC. Whether meta+[ is
128−-- the same as ESC should examine km and current encoding.
129−-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by
130−-- special_support_keys.
131−function_keys_2 :: ClassifyTableV1
132−function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\t':[' ' .. '~'],
133− x /= '[']
134−
135−-- | Ctrl+Char
136−ctrl_char_keys :: ClassifyTableV1
137−ctrl_char_keys =
138− [ ([toEnum x],(KASCII y,[MCtrl]))
139− | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),
140− y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.
141− ]
142−
143−-- | Ctrl+Meta+Char
144−--
145−-- TODO: CTRL-i is the same as tab thing
146−ctrl_meta_keys :: ClassifyTableV1
147−ctrl_meta_keys =
148− [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']),
149− y /= 'i'
150− ]
151−
152−-- | Special support
153−special_support_keys :: ClassifyTableV1
154−special_support_keys =
155− [ -- special support for ESC
156− ("\ESC",(KEsc,[])) , ("\ESC\ESC",(KEsc,[MMeta]))
157− -- Special support for backspace
158− , ("\DEL",(KBS,[])), ("\ESC\DEL",(KBS,[MMeta]))
159− -- Special support for Enter
160− , ("\ESC\^J",(KEnter,[MMeta])), ("\^J",(KEnter,[]))
161− ]
162−
163−-- | classify table for ANSI terminals
164−ansi_classify_table :: [ClassifyTableV1]
165−ansi_classify_table =
166− [ nav_keys_0
167− , nav_keys_1
168− , nav_keys_2
169− , nav_keys_3
170− , simple_chars
171− , function_keys_1
172− , function_keys_2
173− , ctrl_char_keys
174− , ctrl_meta_keys
175− , special_support_keys
176− ]
177−
src/Graphics/Vty/Input/Data/ANSI.hsnew file+125
@@ -0,0 +1,125 @@
1+module Graphics.Vty.Input.Data.ANSI where
2+
3+import Graphics.Vty.Input.Events
4+
5+-- | Encoding for navigation keys.
6+--
7+-- TODO: This is not the same as the input bytes pulled from teh caps table.
8+nav_keys_0 :: ClassifyTableV1
9+nav_keys_0 =
10+ [ k "G" KNP5
11+ , k "P" KPause
12+ , k "A" KUp
13+ , k "B" KDown
14+ , k "C" KRight
15+ , k "D" KLeft
16+ , k "H" KHome
17+ , k "F" KEnd
18+ , k "E" KBegin
19+ ]
20+ where k c s = ("\ESC["++c,(s,[]))
21+
22+-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end
23+nav_keys_1 :: ClassifyTableV1
24+nav_keys_1 =
25+ [("\ESC[" ++ charCnt ++ show mc++c,(s,m))
26+ | charCnt <- ["1;", ""], -- we can have a count or not
27+ (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),
28+ ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes
29+ (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)] -- directions and their codes
30+ ]
31+
32+-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end
33+nav_keys_2 :: ClassifyTableV1
34+nav_keys_2 =
35+ let k n s = ("\ESC["++show n++"~",(s,[]))
36+ in zipWith k [2::Int,3,5,6,1,4]
37+ [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]
38+
39+-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end
40+nav_keys_3 :: ClassifyTableV1
41+nav_keys_3 =
42+ let k n s = ("\ESC["++show n++";5~",(s,[MCtrl]))
43+ in zipWith k [2::Int,3,5,6,1,4]
44+ [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]
45+
46+-- | Support for simple characters.
47+--
48+-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this
49+-- classify table is reached.
50+--
51+-- TODO: resolve
52+-- 1. start at ' '. The earlier characters are all ctrl_char_keys
53+simple_chars :: ClassifyTableV1
54+simple_chars = [(x:[],(KASCII x,[])) | x <- [' ' .. toEnum 0xC1]]
55+
56+-- | VT 100 (?) encoding for shift plus function keys
57+--
58+-- TODO: I suspect this should be generated by interpretting the terminals use of meta mode:
59+-- "If the terminal has a ``meta key'' which acts as a shift key, setting the 8th bit of any
60+-- character transmitted, this fact can be indicated with km. Other- wise, software will
61+-- assume that the 8th bit is parity and it will usually be cleared. If strings exist to turn this
62+-- ``meta mode'' on and off, they can be given as smm and rmm."
63+--
64+-- That is more complex than below. I cannot fault the original author for just hard coding a table.
65+function_keys_1 :: ClassifyTableV1
66+function_keys_1 =
67+ let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in
68+ concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
69+
70+-- | VT 100 (?) encoding for meta plus char
71+--
72+-- TODO: resolve -
73+--
74+-- 1. removed 'ESC' from second list due to duplication with "special_support_keys".
75+-- 2. removed '[' from second list due to conflict with 7-bit encoding for ESC. Whether meta+[ is
76+-- the same as ESC should examine km and current encoding.
77+-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by
78+-- special_support_keys.
79+function_keys_2 :: ClassifyTableV1
80+function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\t':[' ' .. '~'],
81+ x /= '[']
82+
83+-- | Ctrl+Char
84+ctrl_char_keys :: ClassifyTableV1
85+ctrl_char_keys =
86+ [ ([toEnum x],(KASCII y,[MCtrl]))
87+ | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),
88+ y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.
89+ ]
90+
91+-- | Ctrl+Meta+Char
92+--
93+-- TODO: CTRL-i is the same as tab thing
94+ctrl_meta_keys :: ClassifyTableV1
95+ctrl_meta_keys =
96+ [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']),
97+ y /= 'i'
98+ ]
99+
100+-- | Special support
101+special_support_keys :: ClassifyTableV1
102+special_support_keys =
103+ [ -- special support for ESC
104+ ("\ESC",(KEsc,[])) , ("\ESC\ESC",(KEsc,[MMeta]))
105+ -- Special support for backspace
106+ , ("\DEL",(KBS,[])), ("\ESC\DEL",(KBS,[MMeta]))
107+ -- Special support for Enter
108+ , ("\ESC\^J",(KEnter,[MMeta])), ("\^J",(KEnter,[]))
109+ ]
110+
111+-- | classify table for ANSI terminals
112+ansi_classify_table :: [ClassifyTableV1]
113+ansi_classify_table =
114+ [ nav_keys_0
115+ , nav_keys_1
116+ , nav_keys_2
117+ , nav_keys_3
118+ , simple_chars
119+ , function_keys_1
120+ , function_keys_2
121+ , ctrl_char_keys
122+ , ctrl_meta_keys
123+ , special_support_keys
124+ ]
125+
src/Graphics/Vty/Input/Events.hsnew file+33
@@ -0,0 +1,33 @@
1+module Graphics.Vty.Input.Events where
2+
3+-- | Representations of non-modifier keys.
4+--
5+-- KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.
6+data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns
7+ | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KNP5 | KUp | KMenu
8+ | KLeft | KDown | KRight | KEnter
9+ deriving (Eq,Show,Ord)
10+
11+-- | Modifier keys. Key codes are interpreted such that users are more likely to
12+-- have Meta than Alt; for instance on the PC Linux console, 'MMeta' will
13+-- generally correspond to the physical Alt key.
14+data Modifier = MShift | MCtrl | MMeta | MAlt
15+ deriving (Eq,Show,Ord)
16+
17+-- | Mouse buttons. Not yet used.
18+data Button = BLeft | BMiddle | BRight
19+ deriving (Eq,Show,Ord)
20+
21+-- | Events.
22+data Event = EvKey Key [Modifier] | EvMouse Int Int Button [Modifier]
23+ | EvResize Int Int
24+ deriving (Eq,Show,Ord)
25+
26+-- | representation of mapping from input bytes to key and modifier.
27+--
28+-- deprecated
29+type ClassifyTableV1 = [(String, (Key, [Modifier]))]
30+
31+-- | representation of mapping from input bytes to event
32+type ClassifyTable = [(String, Event)]
33+
test/Rouge.hs+40−16
@@ -14,8 +14,10 @@ import Control.Monad.Writer
14import System.IO
14import System.IO
15import System.Random
15import System.Random
16
16
17−data Dude = Dude Int Int
17+data Dude = Dude
18+ { dude_x :: Int
19+ , dude_y :: Int
18− deriving (Show,Eq)
20+ } deriving (Show,Eq)
19
21
20data World = World
22data World = World
21 { dude :: Dude
23 { dude :: Dude
@@ -41,18 +43,29 @@ main = do
41 vty <- mkVty
43 vty <- mkVty
42 level_0 <- mkLevel 0
44 level_0 <- mkLevel 0
43 let world_0 = World (Dude (fst $ start level_0) (snd $ start level_0)) level_0
45 let world_0 = World (Dude (fst $ start level_0) (snd $ start level_0)) level_0
44− (_final_world, ()) <- execRWST (play >> view_world) vty world_0
46+ (_final_world, ()) <- execRWST (play >> view) vty world_0
45 shutdown vty
47 shutdown vty
46
48
47mkLevel _difficulty = do
49mkLevel _difficulty = do
48− level_width <- randomRIO (10,15)
50+ level_width <- randomRIO (40,80)
49− level_height <- randomRIO (10,15)
51+ level_height <- randomRIO (40,80)
50 start <- (,) <$> randomRIO (2, level_width-3) <*> randomRIO (2, level_height-3)
52 start <- (,) <$> randomRIO (2, level_width-3) <*> randomRIO (2, level_height-3)
51 end <- (,) <$> randomRIO (2, level_width-3) <*> randomRIO (2, level_height-3)
53 end <- (,) <$> randomRIO (2, level_width-3) <*> randomRIO (2, level_height-3)
52 -- first the base geography: all rocks
54 -- first the base geography: all rocks
53 let base_geo = array ((0,0), (level_width, level_height))
55 let base_geo = array ((0,0), (level_width, level_height))
54 [((x,y),Rock) | x <- [0..level_width-1], y <- [0..level_height-1]]
56 [((x,y),Rock) | x <- [0..level_width-1], y <- [0..level_height-1]]
57+ -- next the empty spaces that make the rooms
58+ geo <- add_room start base_geo level_width level_height
55− return $ Level start end base_geo
59+ return $ Level start end geo
60+
61+add_room (center_x, center_y) geo level_width level_height = do
62+ size <- randomRIO (5,15)
63+ let x_min = max 0 (center_x - size)
64+ x_max = min level_width (center_x + size)
65+ y_min = max 0 (center_y - size)
66+ y_max = min level_height (center_y + size)
67+ let room = [((x,y), EmptySpace) | x <- [x_min..x_max], y <- [y_min..y_max]]
68+ return $ accum (\_ v -> v) geo room
56
69
57image_for_geo EmptySpace = char (def_attr `with_back_color` green) ' '
70image_for_geo EmptySpace = char (def_attr `with_back_color` green) ' '
58image_for_geo Rock = char (def_attr `with_fore_color` white) 'X'
71image_for_geo Rock = char (def_attr `with_fore_color` white) 'X'
@@ -61,7 +74,7 @@ pieceA = def_attr `with_fore_color` red
61dumpA = def_attr `with_style` reverse_video
74dumpA = def_attr `with_style` reverse_video
62
75
63play = do
76play = do
64− view_world
77+ view
65 done <- process_event
78 done <- process_event
66 unless done play
79 unless done play
67
80
@@ -88,18 +101,29 @@ move_dude dx dy = do
88 (min (h - 2) $ max 1 (y + dy))
101 (min (h - 2) $ max 1 (y + dy))
89 }
102 }
90
103
91−view_world :: Game ()
104+view :: Game ()
92−view_world = do
105+view = do
106+ let info = string def_attr "Move with the arrows keys. Press ESC to exit."
107+ -- determine offsets to place the dude in the center of the level.
108+ DisplayRegion w h <- asks terminal >>= liftIO . display_bounds
109+ the_dude <- gets dude
110+ let ox = (w `div` 2) - dude_x the_dude
111+ oy = (h `div` 2) - dude_y the_dude + image_height info
112+ -- translate the world images to place the dude in the center of the level.
113+ world' <- map (translate ox oy) <$> world
114+ let pic = pic_for_layers $ info : world'
115+ vty <- ask
116+ liftIO $ update vty pic
117+
118+world :: Game [Image]
119+world = do
93− Dude x y <- gets dude
120+ the_dude <- gets dude
94 the_level <- gets level
121 the_level <- gets level
95− let dude_image = translate x y (char pieceA '@')
122+ let dude_image = translate (dude_x the_dude) (dude_y the_dude) (char pieceA '@')
96− let (geo_width, geo_height) = snd $ bounds (geo the_level)
123+ (geo_width, geo_height) = snd $ bounds (geo the_level)
97 geo_image = vert_cat [ geo_row | y <- [0..geo_height-1],
124 geo_image = vert_cat [ geo_row | y <- [0..geo_height-1],
98 let geo_row = horiz_cat [ i | x <- [0..geo_width-1],
125 let geo_row = horiz_cat [ i | x <- [0..geo_width-1],
99 let i = image_for_geo (geo the_level ! (x,y))
126 let i = image_for_geo (geo the_level ! (x,y))
100 ]
127 ]
101 ]
128 ]
102− info = string def_attr "Move with the arrows keys. Press ESC to exit."
103− let pic = pic_for_layers [info, translate 0 1 dude_image,translate 0 1 geo_image]
129+ return [dude_image, geo_image]
104− vty <- ask
105− liftIO $ update vty pic
vty.cabal+2
@@ -86,6 +86,8 @@ library
86
86
87 other-modules: Graphics.Vty.Attributes.Color
87 other-modules: Graphics.Vty.Attributes.Color
88 Graphics.Vty.Attributes.Color240
88 Graphics.Vty.Attributes.Color240
89+ Graphics.Vty.Input.Data.ANSI
90+ Graphics.Vty.Input.Events
89
91
90 c-sources: cbits/gwinsz.c
92 c-sources: cbits/gwinsz.c
91 cbits/set_term_timing.c
93 cbits/set_term_timing.c