~jack/misc

f4b6e68dc788fe7b3d2a5c19b86faf370c5e89f6 — Jack Kelly 7 months ago 8e0fd69
Add a lot of comments
1 files changed, 50 insertions(+), 15 deletions(-)

M consengine/src/App.hs
M consengine/src/App.hs => consengine/src/App.hs +50 -15
@@ 63,6 63,11 @@ guest window manager = do
  eTick <- tickLossyFromPostBuildTime $ 1 / 60
  ePumpedInputs <- performEventAsync $ eTick $> pumpInput window quitF

  -- Construct `bInputs`, a `Behavior (Map GLFW.Key ())` that has a value
  -- at each key only for the keys currently being pressed.
  --
  -- This slightly strange structure lets us use `fanMap` later to
  -- efficiently split out events for each key press.
  let
    toChange :: (GLFW.Key, GLFW.KeyState) -> Map GLFW.Key () -> Map GLFW.Key ()
    toChange (k, GLFW.KeyState'Pressed) = Map.insert k ()


@@ 73,6 78,9 @@ guest window manager = do
    eInputChanges = foldr1 (.) . fmap toChange <$> ePumpedInputs
  bInputs <- current <$> foldDyn ($) Map.empty eInputChanges

  -- We sample `bInputs` on each tick, and then use `fanMap` to get
  -- events for each key that fire once per tick while they are held
  -- down.
  let
    eInputs = bInputs <@ eTick
    eInputSelector = fanMap eInputs


@@ 88,12 96,22 @@ guest window manager = do
    eUp = key GLFW.Key'Up
    eDown = key GLFW.Key'Down

  -- Set up the camera. The `rec` block lets use the camera's position
  -- and facing to determine the movement vectors, which we feed into
  -- the camera config to geet the camera position. This is possible
  -- due to laziness and `MonadFix` magic.
  rec
    let
      moveSize = 0.1
      -- `mkDynPure` is a Template Haskell QuasiQuoter that lets us
      -- write complex expressions involving `Dynamic`s without having
      -- to make a tangle of `Applicative` operators.
      moveVec :: Float -> Dynamic t Vec2
      moveVec offset =
        [mkDynPure| moveSize * V2 (cos ($(cam ^. cdYaw) + offset)) (sin ($(cam ^. cdYaw) + offset)) |]
      moveVec offset = [mkDynPure|
        moveSize * V2
          (cos ($(cam ^. cdYaw) + offset))
          (sin ($(cam ^. cdYaw) + offset))
      |]

      eMoves = mergeWith (.) $ fmap (_xy +~) <$>
        [ current (moveVec 0) <@ eForward


@@ 124,27 142,40 @@ guest window manager = do
      , [ V3 3.5 0 0, V3 8 0 0, V3 8 (-0.5) 0, V3 4 (-0.5) 0 ]
      ]

  -- Construct a vertex buffer for each row of points.
  vertexBuffers <- for haskellLogo $ \points -> do
    vbo <- bufferObject ArrayBufferTarget $ constDyn (StaticDraw, points)
    pure (vbo, genericLength points)

  -- Construct the VAOs, which tell OpenGL how to use each VBO and
  -- use their contents.
  vaos <- for vertexBuffers $ \(vbo, _) -> vertexArray . constDyn $ Map.fromList
    [ (0, (Just $ SomeBuffer vbo, Layout 3 GL_FLOAT False 0 nullPtr)) ]

  -- Build and link our shader program, and store it in `bmProg`.
  dataDir <- liftIO $ canonicalizePath "dat" >>= parseAbsDir
  eProg <- watchShaderProgram manager
    dataDir [relfile|vertex.glsl|] [relfile|fragment.glsl|]
  bmProg <- hold Nothing $ Just <$> eProg

  vaos <- for vertexBuffers $ \(vbo, _) -> vertexArray . constDyn $ Map.fromList
    [ (0, (Just $ SomeBuffer vbo, Layout 3 GL_FLOAT False 0 nullPtr)) ]

  -- Build `bDraws`, our list of things to draw each frame. It is
  -- sampled each time `eTick` fires and redrawn by `draw`.
  let
    bDraws :: Behavior t [Draw]
    bDraws = do
      matrix <- current $ cam ^. cdProjectionMatrix
      bmProg >>= \case
        Nothing -> pure []
        Just prog -> pure $ zip vaos vertexBuffers <&> \(vao, (_, size)) ->
          Draw prog vao (Map.fromList [("proj", Mat4 ==> matrix)]) GL_TRIANGLE_FAN 0 size

      mProg <- bmProg
      -- Draw from each VAO, using the length of each VBO.
      let drawWithProgram p = zip vaos vertexBuffers <&> \(vao, (_, size)) ->
            Draw
              p
              vao
              (Map.fromList [("proj", Mat4 ==> matrix)])
              GL_TRIANGLE_FAN
              0
              size

      pure $ foldMap drawWithProgram mProg
  draw window $ bDraws <@ eTick

  pure quitE


@@ 174,23 205,27 @@ setupGL = do

  pure win

-- | Poll OpenGL for events, and fire the relevant reflex event
-- triggers.
pumpInput
  :: MonadIO m
  => GLFW.Window
  -> (() -> IO ()) -- ^ Fire quit event
  -> (NonEmpty (GLFW.Key, GLFW.KeyState) -> IO ()) -- ^ Fire input event
  -> (() -> IO ()) -- ^ Trigger quit event
  -> (NonEmpty (GLFW.Key, GLFW.KeyState) -> IO ()) -- ^ Trigger input event
  -> m ()
pumpInput window fireQuit fireInput = liftIO $ do
pumpInput window triggerQuit triggerInput = liftIO $ do
  shouldQuit <- GLFW.windowShouldClose window
  if shouldQuit
    then fireQuit ()
    then triggerQuit ()
    else liftIO $ newRef [] >>= \keysR -> do
      let keyCallback _ key _ state _ =
            modifyRef keysR ((key, state):)
      GLFW.setKeyCallback window . Just $ keyCallback
      GLFW.pollEvents
      readRef keysR >>= \keys -> traverse_ fireInput (nonEmpty $ reverse keys)
      readRef keysR >>= \keys ->
        traverse_ triggerInput (nonEmpty $ reverse keys)

-- | Redraw the screen with a new '[Draw]' each time it fires.
draw
  :: (MonadIO m, PerformEvent t m, MonadIO (Performable m), Reflex t)
  => GLFW.Window