diff --git a/TODO b/TODO deleted file mode 100644 --- a/TODO +++ /dev/null @@ -1,49 +0,0 @@ -* Restructure it as a library and upload to hackage. - Export lists everywhere! - * Mention its HaskGame based (it uses its Vector2 type/etc) -* Abstract away SDL keyboard keys, events, flip and delay - * Implement a GLUT-based version - -* Grid with delete row/column, Box with delete item? - -* Animations: - * Draw -> Animate? - * Can use ID's on all drawings, and have it animate stuff moving around - -Questions: - -* After chat with conal: - - * type FontMap = Map String Font - * type Draw = FontMap -> Image - * render :: Font -> (Image, Size) - * unsafePerformIO all font renderings? - * Have Size be an opaque type usable only for Image manipulations? - -* Is the "Clipboard" a good idea? - * Maybe have a "Clipring" instead? - - * Clipring is a list of N items, and showing it shows one line per item - with the "summary" of each. - - * When whole content fits in line it is shown, otherwise, it is - "summarized". Each model needs to be associated with - - * Bottom line of the screen can show summary of top clipring item - * Clipring accessible with some key, animating all the contents up, - allowing to move item to the top - -* What do widget actions do, besides updating the model? - 1. Read and write from the clipboard (Clipboard monad?) - 2. "Signal"? Probably not, as it implies a side-effect. - -* Consider removing the accessor arg and using adapter always - This means child containers have to be parameterized on the child - rather than on the generic model, so Grid is not Widget model - but Widget (Mutable, Map Cursor childModel)? - Then, you can adapt the real model to that tuple. - This is probably less convenient than what I have now - -* Can I create a generic newDelegate method in FocusDelegator instead - of copying it into each widget? Its probably possible by using ugly - accessors/adapters, but less important at the moment. diff --git a/lui.cabal b/lui.cabal --- a/lui.cabal +++ b/lui.cabal @@ -1,5 +1,5 @@ Name: lui -Version: 0.0.1 +Version: 0.0.2 Cabal-Version: >= 1.2 Synopsis: Purely FunctionaL User Interface Category: graphics @@ -27,7 +27,7 @@ Library hs-Source-Dirs: src Extensions: - Build-Depends: base, haskell98, containers, mtl, SDL, haskgame + Build-Depends: base, haskell98, containers, mtl, SDL, haskgame, MaybeT Exposed-Modules: Graphics.UI.LUI.Accessor, Graphics.UI.LUI.Draw, Graphics.UI.LUI.Run, diff --git a/src/Example.hs b/src/Example.hs --- a/src/Example.hs +++ b/src/Example.hs @@ -28,7 +28,9 @@ main :: IO () main = HaskGame.withInit $ do gui <- makeGui - Run.mainLoop gui guiModel + resultModel <- Run.mainLoop gui guiModel + -- Prove that we have the new model here: + print $ gridModel resultModel ^. Grid.aDelegatedMutableCursor return () -- Model: diff --git a/src/Graphics/UI/LUI/Run.hs b/src/Graphics/UI/LUI/Run.hs --- a/src/Graphics/UI/LUI/Run.hs +++ b/src/Graphics/UI/LUI/Run.hs @@ -19,18 +19,11 @@ import qualified Data.Map as Map import Control.Monad(forM, forM_, msum) import Control.Monad.Trans(lift) - --- Commented out for 6.8's lack of the new Exception --- import qualified Control.Exception as Exc --- import Data.Typeable(Typeable) - --- Commented out for 6.8's lack of the new Exception --- data QuitRequest = QuitRequest --- deriving (Typeable, Show) --- instance Exc.Exception QuitRequest where +import Control.Monad.Maybe(MaybeT(..)) handleKeyAction :: WidgetFuncs model -> - Widget.KeyStatus -> Key.Keysym -> Maybe model + Widget.KeyStatus -> Key.Keysym -> + Maybe model handleKeyAction widgetFuncs keyStatus keySym = let key = Key.keyOfEvent keySym keyGroups = Keys.groupsOfKey key @@ -40,41 +33,41 @@ runHandler (_, func) = func key in fmap runHandler mKeyHandler +handleEvent :: HaskGame.Event -> WidgetFuncs model -> Maybe model +handleEvent event widgetFuncs = + case event of + SDL.KeyDown k -> handleKeyAction widgetFuncs Widget.KeyDown k + SDL.KeyUp k -> handleKeyAction widgetFuncs Widget.KeyUp k + _ -> Nothing + handleEvents :: [HaskGame.Event] -> Widget model -> - State.StateT model IO Bool + MaybeT (State.StateT model IO) Bool handleEvents events widget = fmap or $ forM events $ \event -> do - model <- State.get - let mNewModel = case event of - -- 6.8 exceptions :-( - -- lift $ Exc.throwIO QuitRequest - SDL.Quit -> error "Quit" - SDL.KeyDown k -> handleKeyAction (widget model) Widget.KeyDown k - SDL.KeyUp k -> handleKeyAction (widget model) Widget.KeyUp k - _ -> Nothing + model <- lift $ State.get + mNewModel <- + case event of + SDL.Quit -> fail "Quit" + _ -> return . handleEvent event $ widget model case mNewModel of Nothing -> return False - Just newState -> do - State.put newState + Just newModel -> do + lift $ State.put newModel return True --- TODO: Must return the new model mainLoop :: Widget model -> model -> IO model mainLoop widget initModel = do display <- HaskGame.setVideoMode 800 600 16 - (`State.execStateT` initModel) $ + (`State.execStateT` initModel) . runMaybeT $ do forM_ (True:repeat False) $ \shouldDraw -> do - events <- lift $ HaskGame.getEvents + events <- lift . lift $ HaskGame.getEvents handledEvent <- handleEvents events widget model <- State.get - lift $ do + lift . lift $ do HaskGame.fillSurface display (Color 0 0 0) if handledEvent || shouldDraw then do - -- forM_ (Map.assocs $ fromMaybe Map.empty $ Widget.getKeymap widget model) $ - -- \((_, group), (desc, _)) -> do - -- print (MySDLKey.keyGroupName group, desc) let draw = widgetDraw (widget model) (Widget.DrawInfo True) Draw.render display (Vector2 0 0) draw SDL.flip display