lui 0.0.4 → 0.0.5
raw patch · 3 files changed
+125/−33 lines, 3 files
Files
- lui.cabal +2/−1
- src/Example.hs +35/−32
- src/Graphics/UI/LUI/Widgets/Scroll.hs +88/−0
lui.cabal view
@@ -1,5 +1,5 @@ Name: lui-Version: 0.0.4+Version: 0.0.5 Cabal-Version: >= 1.2 Synopsis: Purely FunctionaL User Interface Category: graphics@@ -39,6 +39,7 @@ Graphics.UI.LUI.Widgets.KeysTable, Graphics.UI.LUI.Widgets.Space, Graphics.UI.LUI.Widgets.TextEdit,+ Graphics.UI.LUI.Widgets.Scroll, Graphics.UI.LUI.Widgets.TextView, Graphics.UI.LUI.Widgets.Unfocusable Other-Modules: Example,
src/Example.hs view
@@ -29,6 +29,9 @@ isSorted :: (Ord a) => [a] -> Bool isSorted xs = and $ zipWith (<=) xs (tail xs) +simpleRead :: Read a => String -> Maybe a+simpleRead = listToMaybe . map fst . filter (null . snd) . reads+ main :: IO () main = HaskGame.withInit $ do gui <- makeGui@@ -101,15 +104,10 @@ textEditColor $ atextEditModels ^> aMapValue cursor -textView :: String -> Font -> Widget Model-textView text font =- TextView.new textViewColor font text- gridSize :: Grid.Cursor gridSize = (2, 2) -grid, scrollBox, vbox, withKeysTable, proxy1, proxy2 :: Fonts -> Widget Model-+grid :: Fonts -> Widget Model grid fonts = Grid.newDelegated gridSize items agridModel where@@ -117,35 +115,10 @@ [((x, y), Grid.Item (textEdit (x, y) fonts) (0.5, 1)) | x <- [0..1], y <- [0..1]] -scrollBox fonts = Scroll.new (Vector2 200 200) box scrollerModel- where- font = defaultFont fonts- box = Box.new Box.Vertical items $ Box.noAcc 0- items = [Box.Item (Adapter.adaptImage- (Image.cropRect $ Rect i 0 (w-i-i) h) $- textView text font) 0.5- | i <- [0,20..250]- , let text = "THIS IS A TRUNCATED VIEW: " ++ show i- Vector2 w h = Image.textSize font text]--vbox fonts = Box.newDelegated Box.Vertical items avboxModel- where- items = [Box.Item (grid fonts) 1- ,Box.Item (Space.newH 100) 0.5- ,Box.Item (proxy1 fonts) 0.5- ,Box.Item (proxy2 fonts) 0.5- ,Box.Item (scrollBox fonts) 0.5- ]---withKeysTable fonts = KeysTable.newBoxedWidget Box.Horizontal 50 (keysFont fonts) (descFont fonts) (vbox fonts)-+proxy1 :: Fonts -> Widget Model proxy1 fonts model = textEdit (model ^. agridModel ^. Grid.aDelegatedMutableCursor) fonts model -simpleRead :: Read a => String -> Maybe a-simpleRead = listToMaybe . map fst . filter (null . snd) . reads- readCursor :: String -> Maybe Grid.Cursor readCursor text = let (xCount, yCount) = gridSize@@ -156,6 +129,11 @@ else Nothing in verifyCursor =<< simpleRead text +textView :: String -> Font -> Widget Model+textView text font =+ TextView.new textViewColor font text++proxy2 :: Fonts -> Widget Model proxy2 fonts model = let cursor = model ^. agridModel ^. Grid.aDelegatedMutableCursor text = model ^. atextEditModels ^. aMapValue cursor ^.@@ -164,6 +142,31 @@ (textViewFont fonts) model) (\cur -> textEdit cur fonts model) $ readCursor text++scrollBox :: Fonts -> Widget Model+scrollBox fonts = Scroll.new (Vector2 200 200) box scrollerModel+ where+ font = defaultFont fonts+ box = Box.new Box.Vertical items $ Box.noAcc 0+ items = [Box.Item (Adapter.adaptImage+ (Image.cropRect $ Rect i 0 (w-i-i) h) $+ textView text font) 0.5+ | i <- [0,20..250]+ , let text = "THIS IS A TRUNCATED VIEW: " ++ show i+ Vector2 w h = Image.textSize font text]++vbox :: Fonts -> Widget Model+vbox fonts = Box.newDelegated Box.Vertical items avboxModel+ where+ items = [Box.Item (grid fonts) 1+ ,Box.Item (Space.newH 100) 0.5+ ,Box.Item (proxy1 fonts) 0.5+ ,Box.Item (proxy2 fonts) 0.5+ ,Box.Item (scrollBox fonts) 0.5+ ]++withKeysTable :: Fonts -> Widget Model+withKeysTable fonts = KeysTable.newBoxedWidget Box.Horizontal 50 (keysFont fonts) (descFont fonts) (vbox fonts) makeGui :: IO (Widget Model) makeGui = do
+ src/Graphics/UI/LUI/Widgets/Scroll.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_GHC -Wall -O2+ #-}++module Graphics.UI.LUI.Widgets.Scroll+ (new+ ,Mutable(..))+where++import qualified Graphics.UI.LUI.Widget as Widget+import qualified Graphics.UI.LUI.Image as Image+import Graphics.UI.LUI.Widget(Widget, WidgetFuncs(..))+import Graphics.UI.HaskGame.Key(asKeyGroup, noMods)+import Graphics.UI.LUI.Accessor(Accessor, (^.), write)++import qualified Graphics.UI.HaskGame.Vector2 as Vector2+import Graphics.UI.HaskGame.Vector2(Vector2(..))++import qualified Graphics.UI.SDL as SDL++import qualified Data.Map as Map+import Data.Monoid(Monoid(..))+import Control.Applicative(liftA2)++data Mutable = Mutable+ {+ mutablePos :: Vector2 Int+ }++leftKeyGroup,+ rightKeyGroup,+ upKeyGroup,+ downKeyGroup :: Widget.KeyAction++leftKeyGroup = (Widget.KeyDown, asKeyGroup noMods SDL.SDLK_LEFT)+rightKeyGroup = (Widget.KeyDown, asKeyGroup noMods SDL.SDLK_RIGHT)+upKeyGroup = (Widget.KeyDown, asKeyGroup noMods SDL.SDLK_UP)+downKeyGroup = (Widget.KeyDown, asKeyGroup noMods SDL.SDLK_DOWN)++hjump :: Int+hjump = 10++vjump :: Int+vjump = 10++makeKeymap :: Vector2 Int -> Vector2 Int ->+ model -> Accessor model Mutable -> Maybe (Widget.ActionHandlers model)+makeKeymap minScroll maxScroll model acc =+ let Mutable pos = model ^. acc+ clip = liftA2 max minScroll . liftA2 min maxScroll+ doesMove delta = pos /= clip (delta + pos)+ newModel delta = write acc (Mutable . clip $ delta + pos) model+ handlers =+ concat+ [if doesMove delta then+ [(keyGroup, (desc, const $ newModel delta))]+ else+ []+ | (keyGroup, delta, desc) <-+ [(leftKeyGroup, Vector2 (-hjump) 0, "Scroll left")+ ,(rightKeyGroup, Vector2 vjump 0 , "Scroll right")+ ,(upKeyGroup, Vector2 0 (-hjump), "Scroll up")+ ,(downKeyGroup, Vector2 0 vjump , "Scroll down")+ ]+ ]+ in if null handlers then+ Nothing+ else+ Just . Map.fromList $ handlers++-- TODO: REMOVE THIS!+noFocusDrawInfo :: Widget.DrawInfo+noFocusDrawInfo = Widget.DrawInfo False++new :: Vector2 Int -> Widget model -> Widget.New model Mutable+new size widget acc model =+ let childFuncs = widget model+ in WidgetFuncs+ {+ widgetGetKeymap = widgetGetKeymap childFuncs `mappend`+ makeKeymap (Vector2 0 0)+ (widgetSize childFuncs noFocusDrawInfo - size)+ model acc+ , widgetImage = \drawInfo ->+ Image.crop size .+ Image.move (negate . mutablePos $ model ^. acc) $+ widgetImage childFuncs drawInfo+ , widgetSize = const size+ }