gloss-raster-massiv 0.1.0.4 → 0.1.1.4

raw patch · 5 files changed

+309/−2 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• gloss-raster-massiv.cabal +2/−1
• src/Graphics/Gloss/Raster/Array.hs +0/−1
• src/Graphics/Gloss/Raster/Field.hs +296/−0
• src/Graphics/Gloss/Raster/Massiv/Internal.hs +7/−0

@@ -20,3 +20,7 @@ ## 0.1.0.4 -- 2023-07-25  * Removed extraneous print statement in makeFrame function in Graphics.Gloss.Raster.Array.++## 0.1.1.4 -- 2023-08-04++* Added Graphics.Gloss.Raster.Field.

@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.1.0.4+version:            0.1.1.4  -- A short (one-line) description of the package. synopsis:           Massiv-based alternative for gloss-raster@@ -66,6 +66,7 @@      -- Modules exported by the library.     exposed-modules:  Graphics.Gloss.Raster.Array,+                      Graphics.Gloss.Raster.Field,                       Graphics.Gloss.Raster.Massiv.Internal      -- Modules included in this library but not exported.

@@ -7,7 +7,6 @@ {-# LANGUAGE PatternGuards                               #-} {-# LANGUAGE ScopedTypeVariables                         #-} {-# LANGUAGE TypeApplications                            #-}-{-# OPTIONS_GHC -fplugin=Foreign.Storable.Generic.Plugin #-}  -- | -- Module      :  Graphics.Gloss.Raster.Array

@@ -0,0 +1,296 @@+{-# LANGUAGE BangPatterns                                #-}+{-# LANGUAGE DeriveDataTypeable                          #-}+{-# LANGUAGE DeriveGeneric                               #-}+{-# LANGUAGE FlexibleContexts                            #-}+{-# LANGUAGE MagicHash                                   #-}+{-# LANGUAGE MultiWayIf                                  #-}+{-# LANGUAGE PatternGuards                               #-}+{-# LANGUAGE ScopedTypeVariables                         #-}+{-# LANGUAGE TypeApplications                            #-}++-- |+-- Module      :  Graphics.Gloss.Raster.Field+-- Copyright   :  (c) Matthew Mosior 2023+-- License     :  BSD-style+-- Maintainer  :  mattm.github@gmail.com+-- Portability :  portable+--+-- = Massiv-based alternative for gloss-raster+--+-- This library utilizes [massiv](https://hackage.haskell.org/package/massiv-1.0.4.0)'s superb performance characteristics to supply alternative rasterization functionality to that which is provided by the [gloss-raster](https://hackage.haskell.org/package/gloss-raster) package.++module Graphics.Gloss.Raster.Field ( -- * Graphics.Gloss.Raster.Field Replacement functions - Display functions+                                     animateFieldMassiv,+                                     playFieldMassiv,+                                     animateFieldMassivIO,+                                     playFieldMassivIO,+                                     -- * Graphics.Gloss.Raster.Field Replacement functions - Frame creation+                                     makePicture,+                                     makeFrame,+                                     -- * Graphics.Gloss.Raster.Field Replacement functions - Size of Display+                                     sizeOfDisplay +                                   ) where++import Graphics.Gloss.Raster.Massiv.Internal++import Data.Bits+import Data.Word+import Data.Massiv.Array as DMA+import Data.Massiv.Array.Unsafe as DMAU+import Debug.Trace+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Bitmap+import Graphics.Gloss.Interface.Pure.Game+import Graphics.Gloss.Interface.IO.Animate+import Graphics.Gloss.Interface.IO.Game+import Graphics.Gloss.Interface.Environment+import System.IO.Unsafe+import Unsafe.Coerce++-- | A more performant replacement of+-- [animateField](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html#v:animateField)+-- found in [Graphics.Gloss.Raster.Field](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html).+--+-- Animate a continuous 2D function from a Massiv array.+animateFieldMassiv :: Display                         -- ^ Display mode.+                   -> (Int,Int)                       -- ^ Number of pixels to draw per point.+                   -> (Float -> Point -> ColorMassiv) -- ^ Function to compute the color at a particular point.+                                                      --+                                                      --   It is passed the time in seconds since the program started,+                                                      --   and a point between (-1, -1) and (+1, +1).+                   -> IO ()+animateFieldMassiv display (zoomX, zoomY) makePixel =+  zoomX `seq` zoomY `seq`+  if | zoomX < 1 || zoomY < 1+     -> error $ "Graphics.Gloss.Raster.Field: invalid pixel scale factor"+                ++ show (zoomX, zoomY)+     | otherwise+     -> do (winSizeX, winSizeY) <- sizeOfDisplay display+           let  frame !time+                  = return+                    $ makePicture winSizeX winSizeY zoomX zoomY (makePixel time)+           animateFixedIO display black frame (const $ return ())+{-# INLINE animateFieldMassiv #-}++-- | A more performant replacement of+-- [animateFieldIO](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html#v:animateFieldIO)+-- found in [Graphics.Gloss.Raster.Field](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html).+--+-- Animate a continuous 2D function from a Massiv array, via the IO monad.+animateFieldMassivIO :: Display                              -- ^ Display mode.+                     -> (Int,Int)                            -- ^ Number of pixels to draw per point.+                     -> (Float -> IO (Point -> ColorMassiv)) -- ^ Function to compute the color at a particular point.+                                                             --+                                                             --   It is passed the time in seconds since the program started,+                                                             --   and a point between (-1, -1) and (+1, +1).+                     -> IO ()+animateFieldMassivIO display (zoomX, zoomY) makePixel =+  zoomX `seq` zoomY `seq`+  if | zoomX < 1 || zoomY < 1+     -> error $ "Graphics.Gloss.Raster.Field: invalid pixel scale factor"+                ++ show (zoomX, zoomY)+     | otherwise+     -> do (winSizeX, winSizeY) <- sizeOfDisplay display+           let  frame !time+                  = makePicture winSizeX winSizeY zoomX zoomY <$> makePixel time+           animateFixedIO display black frame (const $ return ())+{-# INLINE animateFieldMassivIO #-}++-- | A more performant replacement of+-- [playField](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html#v:playField)+-- found in [Graphics.Gloss.Raster.Field](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html).+--+-- Play a game with a continuous 2D function generated from a Massiv array.+playFieldMassiv :: Display                         -- ^ Display mode.+                -> (Int,Int)                       -- ^ Number of pixels to draw per point.+                -> Int                             -- ^ Number of simulation steps to take+                                                   --   for each second of real time+                -> world                           -- ^ The initial world.+                -> (world -> Point -> ColorMassiv) -- ^ Function to compute the color of the world at the given point.+                -> (Event -> world -> world)       -- ^ Function to handle input events.+                -> (Float -> world -> world)       -- ^ Function to step the world one iteration.+                                                   --   It is passed the time in seconds since the program started.+                -> IO ()+playFieldMassiv !display (zoomX, zoomY) !stepRate+                !initWorld !makePixel !handleEvent !stepWorld =+  zoomX `seq` zoomY `seq`+  if | zoomX < 1 || zoomY < 1+     -> error $ "Graphics.Gloss.Raster.Field: invalid pixel scale factor"+                ++ show (zoomX, zoomY)+     | otherwise+     -> do (winSizeX, winSizeY) <- sizeOfDisplay display+           winSizeX `seq` winSizeY `seq`+             play display black stepRate+                ((winSizeX, winSizeY), initWorld)+                (\((winSizeX', winSizeY'), world) ->+                   winSizeX' `seq` winSizeY' `seq` world `seq`+                   makePicture winSizeX' winSizeY' zoomX zoomY (makePixel world))+                (\event (winSize, world) ->+                   let winSize' =+                         case event of+                           EventResize dims -> dims+                           _                -> winSize+                   in (winSize', handleEvent event world))+                (fmap . stepWorld)+{-# INLINE playFieldMassiv #-}++-- | A more performant replacement of+-- [playFieldIO](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html#v:playFieldIO)+-- found in [Graphics.Gloss.Raster.Field](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html).+--+-- Play a game with a continuous 2D function generated from a Massiv array, via the IO monad.+playFieldMassivIO :: Display                              -- ^ Display mode.+                  -> (Int,Int)                            -- ^ Number of pixels to draw per point.+                  -> Int                                  -- ^ Number of simulation steps to take+                                                          --   for each second of real time+                  -> world                                -- ^ The initial world.+                  -> (world -> IO (Point -> ColorMassiv)) -- ^ Function to compute the color of the world at the given point.+                  -> (Event -> world -> IO world)         -- ^ Function to handle input events.+                  -> (Float -> world -> IO world)         -- ^ Function to step the world one iteration.+                                                          --   It is passed the time in seconds since the program started.+                  -> IO ()+playFieldMassivIO !display (zoomX, zoomY) !stepRate+                !initWorld !makePixel !handleEvent !stepWorld =+  zoomX `seq` zoomY `seq`+  if | zoomX < 1 || zoomY < 1+     -> error $ "Graphics.Gloss.Raster.Field: invalid pixel scale factor "+                ++ show (zoomX, zoomY)+     | otherwise+     -> do (winSizeX, winSizeY) <- sizeOfDisplay display+           winSizeX `seq` winSizeY `seq`+             playIO display black stepRate+                ((winSizeX, winSizeY), initWorld)+                (\((winSizeX', winSizeY'), world) ->+                   winSizeX' `seq` winSizeY' `seq` world `seq`+                   makePicture winSizeX' winSizeY' zoomX zoomY <$> makePixel world)+                (\event (winSize, world) ->+                   let winSize' =+                         case event of+                           EventResize dims -> dims+                           _                -> winSize+                   in (,) winSize' <$> handleEvent event world)+                (\time (winSize, world) -> (,) winSize <$> stepWorld time world)+{-# INLINE playFieldMassivIO #-}++-- | A more performant replacement of+-- [makePicture](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html#v:makePicture)+-- found in [Graphics.Gloss.Raster.Field](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html).+makePicture :: Int               -- Window Size X+            -> Int               -- Window Size Y+            -> Int               -- Pixels X+            -> Int               -- Pixels Y+            -> (Point -> ColorMassiv)+            -> Picture+makePicture !winSizeX !winSizeY !zoomX !zoomY !makePixel =+  let  -- Size of the raw image to render.+       sizeX = winSizeX `div` zoomX+       sizeY = winSizeY `div` zoomY++       {-# INLINE conv #-}+       conv (r, g, b)+        = let  r'      = fromIntegral r+               g'      = fromIntegral g+               b'      = fromIntegral b+               a       = 255++               !w      =   unsafeShiftL r' 24+                       .|. unsafeShiftL g' 16+                       .|. unsafeShiftL b' 8+                       .|. a+          in   w++   in unsafePerformIO $ do++        -- Define the image, and extract out just the RGB color components.+        -- We don't need the alpha because we're only drawing one image.+        traceEventIO "Gloss.Raster[makePicture]: start frame evaluation."+        (arrRGBTriplet :: Array DMA.S Ix2 RGBTriplet) <- makeFrame sizeX+                                                                   sizeY+                                                                   makePixel+        (arrRGB :: Array DMA.S Ix2 Word32) <- DMA.traversePrim (\x -> return $ conv ( (\(RGBTriplet a _ _) -> a) x+                                                                                    , (\(RGBTriplet _ b _) -> b) x+                                                                                    , (\(RGBTriplet _ _ c) -> c) x+                                                                                    )+                                                               )+                                              arrRGBTriplet+        traceEventIO "Gloss.Raster[makePicture]: done, returning picture."++        let arrRGBC = unsafeCoerce arrRGB :: Array DMA.S Ix2 Word8+        let arrRGBCFP = (\(a,_) -> a) $+                        DMAU.unsafeArrayToForeignPtr arrRGBC+        -- Wrap the ForeignPtr from the Array as a gloss picture.+        let picture+                = Scale (fromIntegral zoomX) (fromIntegral zoomY)+                $ bitmapOfForeignPtr+                        sizeX sizeY     -- raw image size+                        (BitmapFormat BottomToTop PxABGR)+                        arrRGBCFP       -- the image data.+                        False           -- don't cache this in texture memory.++        return picture+{-# INLINE makePicture #-}++-- | A more performant replacement of+-- [makeFrame](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html#v:makeFrame)+-- found in [Graphics.Gloss.Raster.Field](https://hackage.haskell.org/package/gloss-raster-1.13.1.2/docs/Graphics-Gloss-Raster-Field.html).+makeFrame :: PrimMonad m+          => Int                  -- Array Size X+          -> Int                  -- Array Size Y+          -> (Point -> ColorMassiv)+          -> m (Array DMA.S Ix2 RGBTriplet)+makeFrame !sizeX !sizeY !makePixel = do+  let !pixelofindexarray = DMA.makeArray Par+                                         (Sz2 sizeY sizeX)+                                         (\(i :. j) -> pixelOfIndex (Ix2 j i)) :: Array DMA.S Ix2 ColorMassiv+  (!rgbtripletarray :: Array DMA.S Ix2 RGBTriplet) <- DMA.traversePrim (\x -> return $ unpackColorMassiv x) pixelofindexarray+  return rgbtripletarray+    where+      fsizeX, fsizeY  :: Float+      !fsizeX          = fromIntegral sizeX+      !fsizeY          = fromIntegral sizeY++      fsizeX2, fsizeY2 :: Float+      !fsizeX2        = fsizeX / 2+      !fsizeY2        = fsizeY / 2++       -- Midpoint of image.+      midX, midY :: Int+      !midX           = sizeX `div` 2+      !midY           = sizeY `div` 2+      +      {-# INLINE pixelOfIndex #-}+      pixelOfIndex (Ix2 y x)+       = let  x'      = fromIntegral (x - midX) / fsizeX2+              y'      = fromIntegral (y - midY) / fsizeY2+         in   makePixel (x',y')+{-# INLINE makeFrame #-}++-- | Float to Word8 conversion because the one in the GHC libraries+-- doesn't have enout specialisations and goes via Integer.+word8OfFloat :: Float+             -> Word8+word8OfFloat f+        = fromIntegral (truncate f :: Int)+{-# INLINE word8OfFloat #-}++-- | Function to unpack a ColorMassiv+-- into a triplet of Word8's (RGBTriplet).+unpackColorMassiv :: ColorMassiv+                  -> RGBTriplet+unpackColorMassiv c+        | (r,g,b,_) <- rgbaOfColorMassiv c+        = RGBTriplet (word8OfFloat (r * 255))+                     (word8OfFloat (g * 255))+                     (word8OfFloat (b * 255))+{-# INLINE unpackColorMassiv #-}++-- | Function that takes a display+-- and returns a tuple of the x and y scale.+sizeOfDisplay :: Display+              -> IO (Int,Int)+sizeOfDisplay display+ = case display of+        InWindow _ s _  -> return s+        FullScreen      -> getScreenSize+{-# INLINE sizeOfDisplay #-}

@@ -38,6 +38,7 @@  module Graphics.Gloss.Raster.Massiv.Internal ( -- * Graphics.Gloss.Raster.Array Replacement functions - INTERNAL                                                ColorMassiv(..),+                                               RGBTriplet(..),                                                rgbMassiv,                                                rgbMassivI,                                                rgbMassiv8w,@@ -86,6 +87,12 @@  {-# INLINE fromInteger #-}  instance GStorable ColorMassiv++-- | Custom data type for makeFrame function in @"Grahpics.Gloss.Raster.Field"@.+data RGBTriplet = RGBTriplet Word8 Word8 Word8+  deriving (Show,Eq,Data,Generic,Typeable)++instance GStorable RGBTriplet  -- | Make a custom color. All components are clamped to the range  [0..1]. makeColorMassiv :: Float        -- ^ Red component.