jtdaugherty/brick
1
1
Fork 0
mirror of https://github.com/jtdaugherty/brick.git synced 2024-09-11 15:55:54 +03:00
Code Issues Projects Releases Wiki Activity

Add appStartEvent to support getting scroll requests on the first rendering of the app state before other events have arrived

Browse Source
This commit is contained in:
Jonathan Daugherty 2015-06-30 19:15:29 -07:00
parent 189d340f2c
commit 9601098d46
10 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
programs/AttrDemo.hs
View File

@ -44,6 +44,7 @@ app :: App () Event
app =
App { appDraw = const [ui]
, appHandleEvent = resizeOrQuit
, appStartEvent = return
, appAttrMap = const theMap
, appChooseCursor = neverShowCursor
, appMakeVtyEvent = id

1
programs/CustomEventDemo.hs
View File

@ -47,6 +47,7 @@ theApp =
App { appDraw = drawUI
, appChooseCursor = showFirstCursor
, appHandleEvent = appEvent
, appStartEvent = return
, appAttrMap = def
, appMakeVtyEvent = VtyEvent
}

1
programs/EditDemo.hs
View File

@ -38,6 +38,7 @@ theApp =
App { appDraw = drawUI
, appChooseCursor = showFirstCursor
, appHandleEvent = appEvent
, appStartEvent = return
, appAttrMap = const theMap
, appMakeVtyEvent = id
}

1
programs/ListDemo.hs
View File

@ -75,6 +75,7 @@ theApp =
App { appDraw = drawUI
, appChooseCursor = showFirstCursor
, appHandleEvent = appEvent
, appStartEvent = return
, appAttrMap = const theMap
, appMakeVtyEvent = id
}

1
programs/Main.hs
View File

@ -143,6 +143,7 @@ theApp :: App St Event
theApp =
App { appDraw = drawUI
, appChooseCursor = showFirstCursor
, appStartEvent = return
, appHandleEvent = appEvent
, appAttrMap = const theAttrMap
, appMakeVtyEvent = id

1
programs/MarkupDemo.hs
View File

@ -28,6 +28,7 @@ app =
App { appDraw = const [ui]
, appHandleEvent = resizeOrQuit
, appAttrMap = const theMap
, appStartEvent = return
, appChooseCursor = neverShowCursor
, appMakeVtyEvent = id
}

1
programs/PaddingDemo.hs
View File

@ -26,6 +26,7 @@ app :: App () Event
app =
App { appDraw = const [ui]
, appHandleEvent = resizeOrQuit
, appStartEvent = return
, appAttrMap = const def
, appChooseCursor = neverShowCursor
, appMakeVtyEvent = id

1
programs/Rogue.hs
View File

@ -52,6 +52,7 @@ main = do
let world0 = World (Player (levelStart level0)) level0
app = App { appDraw = updateDisplay
, appHandleEvent = processEvent
, appStartEvent = return
, appChooseCursor = neverShowCursor
, appMakeVtyEvent = id
, appAttrMap = const $ attrMap defAttr []

1
programs/SuspendAndResumeDemo.hs
View File

@ -45,6 +45,7 @@ theApp =
App { appDraw = drawUI
, appChooseCursor = neverShowCursor
, appHandleEvent = appEvent
, appStartEvent = return
, appAttrMap = const def
, appMakeVtyEvent = id
}

10
src/Brick/Main.hs
View File

@ -26,7 +26,6 @@ import Control.Lens ((^.))
import Control.Monad (forever)
import Control.Monad.Trans.State
import Control.Concurrent (forkIO, Chan, newChan, readChan, writeChan, killThread)
import Data.Monoid
import Data.Default
import Data.Maybe (listToMaybe)
import qualified Data.Map as M
@ -56,6 +55,7 @@ data App a e =
App { appDraw :: a -> [Widget]
, appChooseCursor :: a -> [CursorLocation] -> Maybe CursorLocation
, appHandleEvent :: e -> a -> EventM (Next a)
, appStartEvent :: a -> EventM a
, appAttrMap :: a -> AttrMap
, appMakeVtyEvent :: Event -> e
}
@ -73,6 +73,7 @@ simpleMain :: Widget -> IO ()
simpleMain w =
let app = App { appDraw = const [w]
, appHandleEvent = resizeOrQuit
, appStartEvent = return
, appAttrMap = def
, appMakeVtyEvent = id
, appChooseCursor = neverShowCursor
@ -106,8 +107,7 @@ runWithNewVty buildVty chan app initialRS initialSt = do
customMain :: IO Vty -> Chan e -> App a e -> a -> IO a
customMain buildVty chan app initialAppState = do
let initialRS = RS M.empty mempty
run rs st = do
let run rs st = do
result <- runWithNewVty buildVty chan app rs st
case result of
InternalHalt s -> return s
@ -115,7 +115,9 @@ customMain buildVty chan app initialAppState = do
newAppState <- action
run newRS newAppState
run initialRS initialAppState
(st, initialScrollReqs) <- runStateT (appStartEvent app initialAppState) []
let initialRS = RS M.empty initialScrollReqs
run initialRS st
supplyVtyEvents :: Vty -> (Event -> e) -> Chan e -> IO ()
supplyVtyEvents vty mkEvent chan =