ilyakooo0/vty
1
0
Fork 0
mirror of https://github.com/ilyakooo0/vty.git synced 2024-10-04 11:17:08 +03:00
Code Issues Projects Releases Wiki Activity

change the translate method to allow negative translations.. with a catch.

Browse Source
This commit is contained in:
Corey O'Connor 2013-11-20 11:43:13 -08:00
parent 4fae6a290b
commit 0ccb7dce7e
6 changed files with 226 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/Graphics/Vty/Image.hs
View File

@ -251,9 +251,26 @@ pad in_l in_t in_r in_b in_image
where w = image_width i + l
h = image_height i
-- | "translates" an image by padding the top and left.
-- | translates an image by padding or cropping the top and left.
--
-- TODO: This has an unexpected effect - Translating an image off the screen and then back onto the
-- screen will result in an empty image.
translate :: Int -> Int -> Image -> Image
translate x y i = pad x y 0 0 i
translate x y i = translate_x x (translate_y y i)
-- | translates an image by padding or cropping the left
translate_x :: Int -> Image -> Image
translate_x x i
| x < 0 = let s = abs x in CropLeft i s (image_width i - s) (image_height i)
| x == 0 = i
| otherwise = let h = image_height i in HorizJoin (BGFill x h) i (image_width i + x) h
-- | translates an image by padding or cropping the top
translate_y :: Int -> Image -> Image
translate_y y i
| y < 0 = let s = abs y in CropTop i s (image_width i) (image_height i - s)
| y == 0 = i
| otherwise = let w = image_width i in VertJoin (BGFill w y) i w (image_height i + y)
-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right
-- or bottom.

158
src/Graphics/Vty/Input/Data.hs
View File

@ -1,35 +1,12 @@
-- Copyright Corey O'Connor
module Graphics.Vty.Input.Data where
module Graphics.Vty.Input.Data ( module Graphics.Vty.Input.Data
, module Graphics.Vty.Input.Data.ANSI
, module Graphics.Vty.Input.Events
)
where
-- | Representations of non-modifier keys.
--
-- KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.
data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KNP5 | KUp | KMenu
| KLeft | KDown | KRight | KEnter
deriving (Eq,Show,Ord)
-- | Modifier keys. Key codes are interpreted such that users are more likely to
-- have Meta than Alt; for instance on the PC Linux console, 'MMeta' will
-- generally correspond to the physical Alt key.
data Modifier = MShift | MCtrl | MMeta | MAlt
deriving (Eq,Show,Ord)
-- | Mouse buttons. Not yet used.
data Button = BLeft | BMiddle | BRight
deriving (Eq,Show,Ord)
-- | Generic events.
data Event = EvKey Key [Modifier] | EvMouse Int Int Button [Modifier]
| EvResize Int Int
deriving (Eq,Show,Ord)
-- | representation of mapping from input bytes to output event
--
-- deprecated
type ClassifyTableV1 = [(String, (Key, [Modifier]))]
type ClassifyTable = [(String, Event)]
import Graphics.Vty.Input.Data.ANSI
import Graphics.Vty.Input.Events
map_to_legacy_table :: ClassifyTable -> ClassifyTableV1
map_to_legacy_table = map f
@ -54,124 +31,3 @@ keys_from_caps_table =
function_key_caps_table :: ClassifyTable
function_key_caps_table = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])
-- | Encoding for navigation keys.
--
-- TODO: This is not the same as the input bytes pulled from teh caps table.
nav_keys_0 :: ClassifyTableV1
nav_keys_0 =
[ k "G" KNP5
, k "P" KPause
, k "A" KUp
, k "B" KDown
, k "C" KRight
, k "D" KLeft
, k "H" KHome
, k "F" KEnd
, k "E" KBegin
]
where k c s = ("\ESC["++c,(s,[]))
-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end
nav_keys_1 :: ClassifyTableV1
nav_keys_1 =
[("\ESC[" ++ charCnt ++ show mc++c,(s,m))
| charCnt <- ["1;", ""], -- we can have a count or not
(m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),
([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes
(c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)] -- directions and their codes
]
-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end
nav_keys_2 :: ClassifyTableV1
nav_keys_2 =
let k n s = ("\ESC["++show n++"~",(s,[]))
in zipWith k [2::Int,3,5,6,1,4]
[KIns,KDel,KPageUp,KPageDown,KHome,KEnd]
-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end
nav_keys_3 :: ClassifyTableV1
nav_keys_3 =
let k n s = ("\ESC["++show n++";5~",(s,[MCtrl]))
in zipWith k [2::Int,3,5,6,1,4]
[KIns,KDel,KPageUp,KPageDown,KHome,KEnd]
-- | Support for simple characters.
--
-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this
-- classify table is reached.
--
-- TODO: resolve
-- 1. start at ' '. The earlier characters are all ctrl_char_keys
simple_chars :: ClassifyTableV1
simple_chars = [(x:[],(KASCII x,[])) | x <- [' ' .. toEnum 0xC1]]
-- | VT 100 (?) encoding for shift plus function keys
--
-- TODO: I suspect this should be generated by interpretting the terminals use of meta mode:
-- "If the terminal has a ``meta key'' which acts as a shift key, setting the 8th bit of any
-- character transmitted, this fact can be indicated with km. Other- wise, software will
-- assume that the 8th bit is parity and it will usually be cleared. If strings exist to turn this
-- ``meta mode'' on and off, they can be given as smm and rmm."
--
-- That is more complex than below. I cannot fault the original author for just hard coding a table.
function_keys_1 :: ClassifyTableV1
function_keys_1 =
let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in
concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
-- | VT 100 (?) encoding for meta plus char
--
-- TODO: resolve -
--
-- 1. removed 'ESC' from second list due to duplication with "special_support_keys".
-- 2. removed '[' from second list due to conflict with 7-bit encoding for ESC. Whether meta+[ is
-- the same as ESC should examine km and current encoding.
-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by
-- special_support_keys.
function_keys_2 :: ClassifyTableV1
function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\t':[' ' .. '~'],
x /= '[']
-- | Ctrl+Char
ctrl_char_keys :: ClassifyTableV1
ctrl_char_keys =
[ ([toEnum x],(KASCII y,[MCtrl]))
| (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),
y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.
]
-- | Ctrl+Meta+Char
--
-- TODO: CTRL-i is the same as tab thing
ctrl_meta_keys :: ClassifyTableV1
ctrl_meta_keys =
[ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']),
y /= 'i'
]
-- | Special support
special_support_keys :: ClassifyTableV1
special_support_keys =
[ -- special support for ESC
("\ESC",(KEsc,[])) , ("\ESC\ESC",(KEsc,[MMeta]))
-- Special support for backspace
, ("\DEL",(KBS,[])), ("\ESC\DEL",(KBS,[MMeta]))
-- Special support for Enter
, ("\ESC\^J",(KEnter,[MMeta])), ("\^J",(KEnter,[]))
]
-- | classify table for ANSI terminals
ansi_classify_table :: [ClassifyTableV1]
ansi_classify_table =
[ nav_keys_0
, nav_keys_1
, nav_keys_2
, nav_keys_3
, simple_chars
, function_keys_1
, function_keys_2
, ctrl_char_keys
, ctrl_meta_keys
, special_support_keys
]

125
src/Graphics/Vty/Input/Data/ANSI.hs Normal file
View File

@ -0,0 +1,125 @@
module Graphics.Vty.Input.Data.ANSI where
import Graphics.Vty.Input.Events
-- | Encoding for navigation keys.
--
-- TODO: This is not the same as the input bytes pulled from teh caps table.
nav_keys_0 :: ClassifyTableV1
nav_keys_0 =
[ k "G" KNP5
, k "P" KPause
, k "A" KUp
, k "B" KDown
, k "C" KRight
, k "D" KLeft
, k "H" KHome
, k "F" KEnd
, k "E" KBegin
]
where k c s = ("\ESC["++c,(s,[]))
-- | VT 100 (?) encoding for shift, meta and ctrl plus arrows/home/end
nav_keys_1 :: ClassifyTableV1
nav_keys_1 =
[("\ESC[" ++ charCnt ++ show mc++c,(s,m))
| charCnt <- ["1;", ""], -- we can have a count or not
(m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),
([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes
(c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)] -- directions and their codes
]
-- | VT 100 (?) encoding for ins, del, pageup, pagedown, home, end
nav_keys_2 :: ClassifyTableV1
nav_keys_2 =
let k n s = ("\ESC["++show n++"~",(s,[]))
in zipWith k [2::Int,3,5,6,1,4]
[KIns,KDel,KPageUp,KPageDown,KHome,KEnd]
-- | VT 100 (?) encoding for ctrl + ins, del, pageup, pagedown, home, end
nav_keys_3 :: ClassifyTableV1
nav_keys_3 =
let k n s = ("\ESC["++show n++";5~",(s,[MCtrl]))
in zipWith k [2::Int,3,5,6,1,4]
[KIns,KDel,KPageUp,KPageDown,KHome,KEnd]
-- | Support for simple characters.
--
-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this
-- classify table is reached.
--
-- TODO: resolve
-- 1. start at ' '. The earlier characters are all ctrl_char_keys
simple_chars :: ClassifyTableV1
simple_chars = [(x:[],(KASCII x,[])) | x <- [' ' .. toEnum 0xC1]]
-- | VT 100 (?) encoding for shift plus function keys
--
-- TODO: I suspect this should be generated by interpretting the terminals use of meta mode:
-- "If the terminal has a ``meta key'' which acts as a shift key, setting the 8th bit of any
-- character transmitted, this fact can be indicated with km. Other- wise, software will
-- assume that the 8th bit is parity and it will usually be cleared. If strings exist to turn this
-- ``meta mode'' on and off, they can be given as smm and rmm."
--
-- That is more complex than below. I cannot fault the original author for just hard coding a table.
function_keys_1 :: ClassifyTableV1
function_keys_1 =
let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in
concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
-- | VT 100 (?) encoding for meta plus char
--
-- TODO: resolve -
--
-- 1. removed 'ESC' from second list due to duplication with "special_support_keys".
-- 2. removed '[' from second list due to conflict with 7-bit encoding for ESC. Whether meta+[ is
-- the same as ESC should examine km and current encoding.
-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by
-- special_support_keys.
function_keys_2 :: ClassifyTableV1
function_keys_2 = [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\t':[' ' .. '~'],
x /= '[']
-- | Ctrl+Char
ctrl_char_keys :: ClassifyTableV1
ctrl_char_keys =
[ ([toEnum x],(KASCII y,[MCtrl]))
| (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),
y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.
]
-- | Ctrl+Meta+Char
--
-- TODO: CTRL-i is the same as tab thing
ctrl_meta_keys :: ClassifyTableV1
ctrl_meta_keys =
[ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']),
y /= 'i'
]
-- | Special support
special_support_keys :: ClassifyTableV1
special_support_keys =
[ -- special support for ESC
("\ESC",(KEsc,[])) , ("\ESC\ESC",(KEsc,[MMeta]))
-- Special support for backspace
, ("\DEL",(KBS,[])), ("\ESC\DEL",(KBS,[MMeta]))
-- Special support for Enter
, ("\ESC\^J",(KEnter,[MMeta])), ("\^J",(KEnter,[]))
]
-- | classify table for ANSI terminals
ansi_classify_table :: [ClassifyTableV1]
ansi_classify_table =
[ nav_keys_0
, nav_keys_1
, nav_keys_2
, nav_keys_3
, simple_chars
, function_keys_1
, function_keys_2
, ctrl_char_keys
, ctrl_meta_keys
, special_support_keys
]

33
src/Graphics/Vty/Input/Events.hs Normal file
View File

@ -0,0 +1,33 @@
module Graphics.Vty.Input.Events where
-- | Representations of non-modifier keys.
--
-- KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.
data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KNP5 | KUp | KMenu
| KLeft | KDown | KRight | KEnter
deriving (Eq,Show,Ord)
-- | Modifier keys. Key codes are interpreted such that users are more likely to
-- have Meta than Alt; for instance on the PC Linux console, 'MMeta' will
-- generally correspond to the physical Alt key.
data Modifier = MShift | MCtrl | MMeta | MAlt
deriving (Eq,Show,Ord)
-- | Mouse buttons. Not yet used.
data Button = BLeft | BMiddle | BRight
deriving (Eq,Show,Ord)
-- | Events.
data Event = EvKey Key [Modifier] | EvMouse Int Int Button [Modifier]
| EvResize Int Int
deriving (Eq,Show,Ord)
-- | representation of mapping from input bytes to key and modifier.
--
-- deprecated
type ClassifyTableV1 = [(String, (Key, [Modifier]))]
-- | representation of mapping from input bytes to event
type ClassifyTable = [(String, Event)]

56
test/Rouge.hs
View File

@ -14,8 +14,10 @@ import Control.Monad.Writer
import System.IO
import System.Random
data Dude = Dude Int Int
deriving (Show,Eq)
data Dude = Dude
{ dude_x :: Int
, dude_y :: Int
} deriving (Show,Eq)
data World = World
{ dude :: Dude
@ -41,18 +43,29 @@ main = do
vty <- mkVty
level_0 <- mkLevel 0
let world_0 = World (Dude (fst $ start level_0) (snd $ start level_0)) level_0
(_final_world, ()) <- execRWST (play >> view_world) vty world_0
(_final_world, ()) <- execRWST (play >> view) vty world_0
shutdown vty
mkLevel _difficulty = do
level_width <- randomRIO (10,15)
level_height <- randomRIO (10,15)
level_width <- randomRIO (40,80)
level_height <- randomRIO (40,80)
start <- (,) <$> randomRIO (2, level_width-3) <*> randomRIO (2, level_height-3)
end <- (,) <$> randomRIO (2, level_width-3) <*> randomRIO (2, level_height-3)
-- first the base geography: all rocks
let base_geo = array ((0,0), (level_width, level_height))
[((x,y),Rock) | x <- [0..level_width-1], y <- [0..level_height-1]]
return $ Level start end base_geo
-- next the empty spaces that make the rooms
geo <- add_room start base_geo level_width level_height
return $ Level start end geo
add_room (center_x, center_y) geo level_width level_height = do
size <- randomRIO (5,15)
let x_min = max 0 (center_x - size)
x_max = min level_width (center_x + size)
y_min = max 0 (center_y - size)
y_max = min level_height (center_y + size)
let room = [((x,y), EmptySpace) | x <- [x_min..x_max], y <- [y_min..y_max]]
return $ accum (\_ v -> v) geo room
image_for_geo EmptySpace = char (def_attr `with_back_color` green) ' '
image_for_geo Rock = char (def_attr `with_fore_color` white) 'X'
@ -61,7 +74,7 @@ pieceA = def_attr `with_fore_color` red
dumpA = def_attr `with_style` reverse_video
play = do
view_world
view
done <- process_event
unless done play
@ -88,18 +101,29 @@ move_dude dx dy = do
(min (h - 2) $ max 1 (y + dy))
}
view_world :: Game ()
view_world = do
Dude x y <- gets dude
view :: Game ()
view = do
let info = string def_attr "Move with the arrows keys. Press ESC to exit."
-- determine offsets to place the dude in the center of the level.
DisplayRegion w h <- asks terminal >>= liftIO . display_bounds
the_dude <- gets dude
let ox = (w `div` 2) - dude_x the_dude
oy = (h `div` 2) - dude_y the_dude + image_height info
-- translate the world images to place the dude in the center of the level.
world' <- map (translate ox oy) <$> world
let pic = pic_for_layers $ info : world'
vty <- ask
liftIO $ update vty pic
world :: Game [Image]
world = do
the_dude <- gets dude
the_level <- gets level
let dude_image = translate x y (char pieceA '@')
let (geo_width, geo_height) = snd $ bounds (geo the_level)
let dude_image = translate (dude_x the_dude) (dude_y the_dude) (char pieceA '@')
(geo_width, geo_height) = snd $ bounds (geo the_level)
geo_image = vert_cat [ geo_row | y <- [0..geo_height-1],
let geo_row = horiz_cat [ i | x <- [0..geo_width-1],
let i = image_for_geo (geo the_level ! (x,y))
]
]
info = string def_attr "Move with the arrows keys. Press ESC to exit."
let pic = pic_for_layers [info, translate 0 1 dude_image,translate 0 1 geo_image]
vty <- ask
liftIO $ update vty pic
return [dude_image, geo_image]

2
vty.cabal
View File

@ -86,6 +86,8 @@ library
other-modules: Graphics.Vty.Attributes.Color
Graphics.Vty.Attributes.Color240
Graphics.Vty.Input.Data.ANSI
Graphics.Vty.Input.Events
c-sources: cbits/gwinsz.c
cbits/set_term_timing.c