affection 0.0.0.3 → 0.0.0.4

raw patch · 4 files changed

+53/−49 lines, 4 filesdep −linearPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: linear

API changes (from Hackage documentation)

Files

• affection.cabal +1/−2
• src/Affection.hs +33/−32
• src/Affection/Particle.hs +18/−14
• src/Affection/Types.hs +1/−1

@@ -6,7 +6,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.0.0.3+version:             0.0.0.4 synopsis:            A simple Game Engine using SDL description:         This package contains Affection, a simple game engine                      written in Haskell using SDL and GEGL.@@ -57,7 +57,6 @@   build-depends:       base >=4.9 && <4.10                      , sdl2                      , text-                     , linear                      , mtl                      , gegl                      , babl

@@ -40,19 +40,36 @@   :: AffectionConfig us -- ^ Configuration of the Game and its engine.   -> IO () withAffection AffectionConfig{..} = do+  -- intialiaze SDL   case initComponents of     All ->       SDL.initializeAll     Only is ->       SDL.initialize is   G.gegl_init+  -- give SDL render quality+  SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear+  -- just checking…+  do+    renderQuality <- SDL.get SDL.HintRenderScaleQuality+    when (renderQuality /= SDL.ScaleLinear) $+      putStrLn "Warning: Linear texture filtering not enabled!"+  -- get current time   execTime <- newIORef =<< getTime Monotonic+  -- construct window   window <- SDL.createWindow windowTitle windowConfig-  -- let surface = (flip SDL.Surface Nothing) rawSurfacePtr-  (oldSurf, surface) <- getSurfaces window+  SDL.showWindow window+  -- create renderer+  renderer <- SDL.createRenderer+    window+    (-1)+    SDL.defaultRenderer+  -- make draw surface+  surface <- SDL.createRGBSurface+    (SDL.windowInitialSize windowConfig)+    SDL.ABGR8888   let (SDL.Surface ptr _) = surface-  rawSurfacePtr <- Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0-  pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek rawSurfacePtr+  pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr   SDL.V2 (CInt rw) (CInt rh) <- liftIO $ SDL.surfaceDimensions surface   let (w, h) = (fromIntegral rw, fromIntegral rh)       stride = (fromIntegral $ Raw.pixelFormatBytesPerPixel pixelFormat) * w@@ -64,7 +81,7 @@     { quitEvent       = False     , userState       = x     , drawWindow      = window-    , windowSurface   = oldSurf+    , windowRenderer  = renderer     , drawSurface     = surface     , drawFormat      = format     , drawPixels      = pixels@@ -76,8 +93,6 @@     }) <$> loadState surface   (_, nState) <- runStateT ( A.runState $ do     preLoop-    pad <- get-    liftIO $ SDL.surfaceBlit (drawSurface pad) Nothing (windowSurface pad) Nothing     whileM_ (do         current <- get         return $ not $ A.quitEvent current@@ -90,6 +105,8 @@         ad <- get         -- clean draw requests from last run         mapM_ (invalidateDrawRequest (drawPixels ad) (drawStride ad) (drawCPP ad)) (drawStack ad)+        -- clean the renderer form last time+        SDL.clear renderer         -- compute dt and update elapsedTime         let dt = (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / (fromIntegral 10 ^ 9)         put $ ad@@ -109,19 +126,20 @@         -- save all draw requests to clear in next run         put $ ad2           { drawStack = clear }-        -- blit surface and update window-        liftIO $ SDL.surfaceBlit-          (drawSurface ad2)-          Nothing-          (windowSurface ad2)-          Nothing-        liftIO $ SDL.updateWindowSurface $ drawWindow ad2+        -- get texture from surface+        texture <- SDL.createTextureFromSurface (windowRenderer ad2) (drawSurface ad2)+        -- actual drawing+        SDL.copy (windowRenderer ad2) texture Nothing Nothing+        SDL.present (windowRenderer ad2)+        -- clean the texture+        SDL.destroyTexture texture         -- save new time         liftIO $ writeIORef execTime $ now       )     ) initContainer   G.gegl_exit   cleanUp $ userState nState+  SDL.destroyWindow window   SDL.quit  getSurfaces :: SDL.Window -> IO (SDL.Surface, SDL.Surface)@@ -131,6 +149,7 @@   let surface = (flip SDL.Surface Nothing) rawSurfacePtr   return (oldSurf, surface) +-- Prehandle SDL events in case any window events occur preHandleEvents :: [SDL.Event] -> Affection us [SDL.Event] preHandleEvents evs =   mapM handle evs@@ -139,27 +158,9 @@       case SDL.eventPayload e of         SDL.WindowMovedEvent _ -> do           liftIO $ traceIO "I was moved"-          putNewSurface           return e         _ ->           return e-    putNewSurface = do-      ad <- get-      (oldSurf, surface) <- liftIO $ getSurfaces $ drawWindow ad-      pixels <- SDL.surfacePixels $ surface-      SDL.V2 (CInt rw) (CInt rh) <- liftIO $ SDL.surfaceDimensions surface-      let (SDL.Surface ptr _) = surface-      rawSurfacePtr <- Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0-      pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek rawSurfacePtr-      let (w, h) = (fromIntegral rw, fromIntegral rh)-          stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w-      put ad-        { windowSurface   = oldSurf-        , drawSurface     = surface-        , drawPixels      = pixels-        , drawDimensions  = (w, h)-        , drawStride      = stride-        }  -- | Return the userstate to the user getAffection :: Affection us us

@@ -117,21 +117,25 @@   -> Affection us ParticleSystem updateParticleSystem sys sec upd draw = do   x <- catMaybes <$> mapM (updateParticle sec upd) (partStorList $ partSysParts sys)+  -- liftIO $ traceIO $ show $ length x   -- x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys)-  when (not $ null x) $ do-    -- liftIO $ G.gegl_node_link_many $ map particleStackCont (partStorList $ partSysParts sys)-    -- liftIO $ traceIO "linking last node to output"-    liftIO $ G.gegl_node_link (particleStackCont $ head x) (partSysNode sys)-  mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x-  return $ sys-    { partSysParts = (partSysParts sys)-      { partStorList = x-      , partStorLatest =-          if null x-          then Nothing-          else partStorLatest (partSysParts sys)-      }-    }+  if (not $ null x)+    then do+      -- liftIO $ G.gegl_node_link_many $ map particleStackCont (partStorList $ partSysParts sys)+      -- liftIO $ traceIO "linking last node to output"+      liftIO $ G.gegl_node_link (particleStackCont $ head x) (partSysNode sys)+      mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x+      return $ sys+        { partSysParts = (partSysParts sys)+          { partStorList = x+          , partStorLatest =+              if null x+              then Nothing+              else partStorLatest (partSysParts sys)+          }+        }+    else+      return sys  -- | Function for inserting a new 'Particle' into its 'PartileSystem' insertParticle

@@ -77,7 +77,7 @@   { quitEvent       :: Bool               -- ^ Loop breaker.   , userState       :: us                 -- ^ State data provided by user   , drawWindow      :: SDL.Window         -- ^ SDL window-  , windowSurface   :: SDL.Surface        -- ^ Internal surface of window+  , windowRenderer  :: SDL.Renderer       -- ^ Internal renderer of window   , drawSurface     :: SDL.Surface        -- ^ SDL surface   , drawFormat      :: B.BablFormatPtr    -- ^ Target format   , drawStack       :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be processed