gloss-examples 1.7.4.1 → 1.7.4.2
raw patch · 4 files changed
+696/−30 lines, 4 filesnew-component:exe:gloss-mandel
Files
- gloss-examples.cabal +25/−7
- raster/Mandel/Main.hs +322/−0
- raster/Mandel/Solver.hs +231/−0
- raster/Ray/Main.hs +118/−23
gloss-examples.cabal view
@@ -1,5 +1,5 @@ Name: gloss-examples-Version: 1.7.4.1+Version: 1.7.4.2 License: MIT License-file: LICENSE Author: Ben Lippmeier@@ -193,7 +193,7 @@ Main-is: Main.hs hs-source-dirs: raster/Crystal ghc-options: - -Wall -threaded -eventlog+ -Wall -threaded -rtsopts -eventlog -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000@@ -209,7 +209,7 @@ other-modules: Light Object Trace Vec3 World hs-source-dirs: raster/Ray ghc-options: - -Wall -threaded -eventlog+ -Wall -threaded -rtsopts -eventlog -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000@@ -224,7 +224,7 @@ Main-is: Main.hs hs-source-dirs: raster/Pulse ghc-options:- -Wall -threaded -eventlog+ -Wall -threaded -rtsopts -eventlog -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000@@ -241,7 +241,7 @@ Main-is: Main.hs hs-source-dirs: raster/Wave ghc-options:- -Wall -threaded -eventlog+ -Wall -threaded -rtsopts -eventlog -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000@@ -265,7 +265,7 @@ Stage.Linear Stage.Project Stage.Sources hs-source-dirs: raster/Fluid ghc-options:- -Wall -threaded -eventlog -rtsopts+ -Wall -threaded -rtsopts -eventlog -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000@@ -282,10 +282,28 @@ Main-is: Main.hs hs-source-dirs: raster/Snow ghc-options:- -Wall -threaded -eventlog -rtsopts+ -Wall -threaded -rtsopts -eventlog -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -fllvm -optlo-O3+++Executable gloss-mandel+ Build-depends+ base == 4.*,+ gloss == 1.7.*,+ repa >= 3.1.4.2 && < 3.2+ Main-is: Main.hs+ other-modules: Solver+ hs-source-dirs: raster/Mandel+ ghc-options:+ -Wall -threaded -rtsopts -eventlog+ -Odph -fno-liberate-case+ -funfolding-use-threshold1000+ -funfolding-keeness-factor1000+ -fllvm -optlo-O3+ extensions:+ PatternGuards
+ raster/Mandel/Main.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}++import Graphics.Gloss.Interface.IO.Game+import Solver+import Data.Array.Repa.IO.BMP+import System.Exit+import System.Environment+import Data.Maybe+import Data.Char+++main :: IO ()+main + = do args <- getArgs+ config <- parseArgs args defaultConfig+ let world = configPreset config+ $ (initWorld (configSizeX config)+ (configSizeY config))+ { worldPixelsDynamic = configPixelsDynamic config}++ case configFileName config of+ -- Run interactively.+ Nothing+ -> playIO (configDisplay config)+ black+ 100+ (updateWorld world)+ draw handle advance++ -- Render image and write to .bmp file.+ Just filePath+ -> do arr <- mandelArray + (worldSizeX world) (worldSizeY world)+ (worldPosX world) (worldPosY world)+ (worldZoom world) (worldRadius world)+ (truncate $ worldIterations world)++ writeImageToBMP filePath arr+++-- Config ---------------------------------------------------------------------+data Config + = Config+ { configDisplay :: Display + , configFileName :: Maybe FilePath+ , configPreset :: World -> World+ , configPixelsDynamic :: Int+ , configSizeX :: Int+ , configSizeY :: Int }+++defaultConfig :: Config+defaultConfig+ = Config+ { configDisplay = InWindow "Mandelbrot" (800, 600) (10, 10) + , configFileName = Nothing+ , configPreset = id+ , configPixelsDynamic = 4+ , configSizeX = 800+ , configSizeY = 600 }+++parseArgs :: [String] -> Config -> IO Config+parseArgs args config+ | [] <- args+ = return config++ | "-fullscreen" : sizeX : sizeY : rest <- args+ , all isDigit sizeX+ , all isDigit sizeY+ = parseArgs rest + $ config { configDisplay = FullScreen (read sizeX, read sizeY) + , configSizeX = read sizeX+ , configSizeY = read sizeY }++ | "-window" : sizeX : sizeY : rest <- args+ , all isDigit sizeX+ , all isDigit sizeY+ = parseArgs rest+ $ config { configDisplay = InWindow "MandelBrot" (read sizeX, read sizeY) (0, 0)+ , configSizeX = read sizeX+ , configSizeY = read sizeY }++ | "-bmp" : sizeX : sizeY : fileName : rest <- args+ , all isDigit sizeX+ , all isDigit sizeY+ = parseArgs rest+ $ config { configFileName = Just fileName+ , configSizeX = read sizeX+ , configSizeY = read sizeY }++ | "-dynamic" : num : rest <- args+ , all isDigit num+ = parseArgs rest+ $ config { configPixelsDynamic = read num }++ | "-preset" : num : rest <- args+ , length num == 1+ , all isDigit num+ = parseArgs rest+ $ config { configPreset = presets !! read num }++ | otherwise+ = do printUsage+ exitWith $ ExitFailure 1++printUsage :: IO ()+printUsage+ = putStrLn + $ unlines+ [ "Usage: gloss-mandel [flags]"+ , " -fullscreen <width::INT> <height::INT>"+ , " -window <width::INT> <height::INT>" + , " -bmp <width::INT> <height::INT> <FILE>" + , " -dynamic <INT> Level of detail reduction when zooming and panning. (4) "+ , ""+ , " Controls:"+ , " ESC Quit"+ , " mouse drag Centerpoint"+ , " w/s Zoom"+ , " a/d Maximum interations"+ , " q/e Pixels per point"+ , " z/c Escape radius for iteration"+ , " 0 .. 9 Select presets"+ , " r Reset"+ , " . Print current location to stdout" ]++++-- World ----------------------------------------------------------------------+data World+ = World+ { worldPicture :: Picture+ , worldSizeX :: Int+ , worldSizeY :: Int+ , worldPixels :: Int+ , worldPixelsDynamic :: Int++ , worldPosX :: Double+ , worldPosY :: Double + , worldZoom :: Double++ , worldIterations :: Double+ , worldRadius :: Double++ , worldDragging :: Maybe (Float, Float) + , worldZooming :: Maybe Double } +++initWorld :: Int -> Int -> World+initWorld sizeX sizeY + = World+ { worldPicture = Blank++ , worldSizeX = sizeX+ , worldSizeY = sizeY+ , worldPixels = 1+ , worldPixelsDynamic = 4++ , worldPosX = -0.5+ , worldPosY = 0 + , worldZoom = 2++ , worldIterations = 100+ , worldRadius = 2+ , worldDragging = Nothing + , worldZooming = Nothing }+++draw :: World -> IO Picture+draw world + = return $ worldPicture world+++handle :: Event -> World -> IO World+handle event world ++ -- Pan+ | EventKey (MouseButton LeftButton) Down _ (x, y) <- event+ = return $ updateWorld $ world { worldDragging = Just (x, y)}++ | EventKey (MouseButton LeftButton) Up _ _ <- event+ = return $ updateWorld $ world { worldDragging = Nothing }++ | EventMotion (x, y) <- event+ , Just (x0, y0) <- worldDragging world+ = let x' = 2 * (f2d (x0 - x)) * worldZoom world / (fromIntegral $ worldSizeX world)+ y' = 2 * (f2d (y0 - y)) * worldZoom world / (fromIntegral $ worldSizeX world)+ in return $ moveWorld x' y'+ $ world { worldDragging = Just (x, y) }++ -- Zoom+ | EventKey (Char 's') Down _ _ <- event+ = return $ world { worldZooming = Just 1.01 }++ | EventKey (Char 'w') Down _ _ <- event+ = return $ world { worldZooming = Just 0.99 }++ -- Iterations+ | EventKey (Char 'a') Down _ _ <- event+ , iters <- worldIterations world * 0.8+ , iters' <- if iters < 1 then 1 else iters+ = return $ world { worldIterations = iters' }++ | EventKey (Char 'd') Down _ _ <- event+ = return $ world { worldIterations = worldIterations world * 1.2 }++ -- Radius + | EventKey (Char 'z') Down _ _ <- event+ = return $ world { worldRadius = worldRadius world * 0.5 }++ | EventKey (Char 'c') Down _ _ <- event+ = return $ world { worldRadius = worldRadius world * 2 }++ -- Pixels+ | EventKey (Char 'q') Down _ _ <- event+ , worldPixels world > 1+ = return $ world { worldPixels = worldPixels world - 1 }++ | EventKey (Char 'e') Down _ _ <- event+ = return $ world { worldPixels = worldPixels world + 1 }++ -- Reset+ | EventKey (Char 'r') Down _ _ <- event+ = return $ initWorld (worldSizeX world) (worldSizeY world)++ -- Dump preset+ | EventKey (Char 'p') Down _ _ <- event+ = do putStrLn $ showWorld world+ return world++ -- Load preset+ | EventKey (Char d) Down _ _ <- event+ , isDigit d+ = return $ updateWorld ((presets !! read [d]) world)++ -- Cancel zoom+ | EventKey _ Up _ _ <- event+ = return $ updateWorld $ world { worldZooming = Nothing }++ | otherwise+ = return world+++advance :: Float -> World -> IO World+advance _ world + | Just factor <- worldZooming world+ = return $ zoomWorld factor world++ | otherwise+ = return world+++moveWorld :: Double -> Double -> World -> World+moveWorld bumpX bumpY world+ = updateWorld+ $ world { worldPosX = worldPosX world + bumpX+ , worldPosY = worldPosY world + bumpY }+++zoomWorld :: Double -> World -> World+zoomWorld zoom world+ = updateWorld+ $ world { worldZoom = worldZoom world * zoom }+++updateWorld :: World -> World+updateWorld world+ = let dynamic = isJust (worldDragging world)+ || isJust (worldZooming world)++ pixels+ | dynamic = worldPixels world + worldPixelsDynamic world+ | otherwise = worldPixels world++ in world { worldPicture + = mandelPicture+ (worldSizeX world) (worldSizeY world)+ pixels pixels+ (worldPosX world) (worldPosY world)+ (worldZoom world) + (worldRadius world)+ (truncate $ worldIterations world)+ }+++-- Presets --------------------------------------------------------------------+-- | Show the current state of the world, in preset form.+showWorld :: World -> String+showWorld world+ = show ( worldPosX world+ , worldPosY world+ , worldZoom world+ , worldIterations world+ , worldRadius world)+++-- | Load a preset into the world.+loadWorld :: (Double, Double, Double, Double, Double) -> World -> World+loadWorld (posX, posY, zoom, iters, radius) world+ = world+ { worldPosX = posX+ , worldPosY = posY+ , worldZoom = zoom+ , worldIterations = iters+ , worldRadius = radius }+++presets :: [World -> World]+presets + = map loadWorld + $ [ (-0.5, 0, 2, 100, 2)+ , (0.20508818500545423, 0.9014915666351141 * 900/1440,6.375321937544527e-6, 629.3354966759534, 16.0)+ , (0.4510757067879078, 0.6144133202705898 * 900/1440,7.632248223018773e-5, 253.61352386150395, 2.0)+ , (0.3469337523117071, 0.6866350870407725 * 900/1440,3.508380713647269e-5, 168.61054759193718, 1024.0)+ , (-0.7902001921590814, 0.24910667566731381 * 900/1440,5.071115028132377e-4, 1176.757810813391, 3.4359738368e10)+ , (2.3127178455019423e-2,-1.301205470975472 * 900/1440,3.6349313304610088e-9, 343.0390372557315, 2.0)+ , (2.3127176148480418e-2,-1.3012054707668765 * 900/1440,2.71444790387451e-10, 604.1620768089155, 2.0)+ , (2.3127176156746785e-2,-1.301205470242045 * 900/1440,4.49615119202067e-12, 1731.8575629678642, 2.0)+ , (0.2550376327692795, 8.962363618058007e-4 * 900/1440,7.351698819132829e-5, 1412.1093729760698, 16.0)+ , (0.25498593633806477, 8.726424280526077e-4 * 900/1440,1.6858526052251987e-10,10492.090844482025, 2.0) ]+
+ raster/Mandel/Solver.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}+module Solver + ( mandelPicture+ , mandelArray+ , f2d+ , d2f)+where+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture+import Data.Word+import System.IO.Unsafe+import Unsafe.Coerce+import Data.Bits+import GHC.Float+import Data.Array.Repa as R+import Data.Array.Repa.Repr.ForeignPtr as R+import Data.Array.Repa.Repr.HintInterleave as R+import Data.Array.Repa.Algorithms.ColorRamp as R+import Prelude as P+++mandelPicture+ :: Int -- Window Size X+ -> Int -- Window Size Y+ -> Int -- Pixels X+ -> Int -- Pixels Y+ -> Double -- Offset X+ -> Double -- Offset Y+ -> Double -- zoom+ -> Double -- radius+ -> Int -- iterations+ -> Picture+mandelPicture winX winY pixelsX pixelsY offX offY zoom radius iters+ = let scaleX :: Double = 1+ scaleY :: Double = fromIntegral winY / fromIntegral winX+ in makePicture+ winX winY+ pixelsX pixelsY+ (mandelPixel scaleX scaleY offX offY zoom iters radius)+{-# NOINLINE mandelPicture #-}++++mandelArray+ :: Int -- Window Size X+ -> Int -- Window Size Y+ -> Double -- Offset X+ -> Double -- Offset Y+ -> Double -- zoom+ -> Double -- radius+ -> Int -- iterations+ -> IO (Array U DIM2 (Word8, Word8, Word8))++mandelArray winX winY offX offY zoom radius iters+ = let scaleX :: Double = 1+ scaleY :: Double = fromIntegral winY / fromIntegral winX++ arr = makeFrame winX winY 1 1+ $ mandelPixel scaleX scaleY offX offY zoom iters radius++ in R.computeP arr+{-# NOINLINE mandelArray #-}+++-- Picture --------------------------------------------------------------------+makePicture+ :: Int -- Window Size X+ -> Int -- Window Size Y+ -> Int -- Pixels X+ -> Int -- Pixels Y+ -> (Double -> Double -> Color)+ -> 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.+ (arrRGB :: Array F DIM2 Word32)+ <- R.computeP + $ R.map conv+ $ makeFrame winSizeX winSizeY zoomX zoomY makePixel++ -- Wrap the ForeignPtr from the Array as a gloss picture.+ let picture + = Scale (fromIntegral zoomX) (fromIntegral zoomY)+ $ bitmapOfForeignPtr+ sizeX sizeY -- raw image size+ (R.toForeignPtr $ unsafeCoerce arrRGB) + -- the image data.+ False -- don't cache this in texture memory.++ return picture+{-# INLINE makePicture #-}+++-- Frame ----------------------------------------------------------------------+makeFrame+ :: Int -- Window Size X+ -> Int -- Window Size Y+ -> Int -- Pixels X+ -> Int -- Pixels Y+ -> (Double -> Double -> Color)+ -> Array (I D) DIM2 (Word8, Word8, Word8)++makeFrame !winSizeX !winSizeY !zoomX !zoomY !makePixel+ = let -- Size of the raw image to render.+ sizeX = winSizeX `div` zoomX+ sizeY = winSizeY `div` zoomY++ fsizeX, fsizeY :: Double+ !fsizeX = fromIntegral sizeX+ !fsizeY = fromIntegral sizeY++ fsizeX2, fsizeY2 :: Double+ !fsizeX2 = fsizeX / 2+ !fsizeY2 = fsizeY / 2++ -- Midpoint of image.+ midX, midY :: Int+ !midX = sizeX `div` 2+ !midY = sizeY `div` 2++ {-# INLINE pixelOfIndex #-}+ pixelOfIndex (Z :. y :. x)+ = let x' = fromIntegral (x - midX) / fsizeX2+ y' = fromIntegral (y - midY) / fsizeY2+ in makePixel x' y'++ in R.hintInterleave+ $ R.map unpackColor + $ R.fromFunction (Z :. sizeY :. sizeX)+ $ pixelOfIndex+{-# INLINE makeFrame #-}+++-- Mandel ---------------------------------------------------------------------+mandelPixel + :: Double -- Scale X+ -> Double -- Scale Y+ -> Double -- Offset X+ -> Double -- Offset Y+ -> Double -- Zoom+ -> Int -- iterations+ -> Double -- max radius+ -> Double -- X (Real)+ -> Double -- Y (Imaginary)+ -> Color+mandelPixel scaleX scaleY x0 y0 zoom cMax rMax x y + = let+ !x' = x0 + x * zoom * scaleX+ !y' = y0 + y * zoom * scaleY++ !count = mandelRun (fromIntegral cMax) rMax x' y'+ !v = fromIntegral count / fromIntegral cMax++ color'+ | v > 0.99 = rgb 0 0 0+ | (r, g, b) <- rampColorHotToCold 0 1 v+ = rgb r g b+ in color'+{-# INLINE mandelPixel #-}+++mandelRun :: Int -> Double -> Double -> Double -> Int+mandelRun countMax rMax cr ci+ = go cr ci 0+ where+ go :: Double -> Double -> Int -> Int+ go !zr !zi !count+ | count >= countMax = count+ | sqrt (zr * zr + zi * zi) > rMax = count++ | otherwise + = let !z2r = zr*zr - zi*zi+ !z2i = 2 * zr * zi+ !yr = z2r + cr+ !yi = z2i + ci+ in go yr yi (count + 1)+{-# INLINE mandelRun #-}+++-- Conversion -----------------------------------------------------------------+f2d :: Float -> Double+f2d = float2Double+{-# INLINE f2d #-}+++d2f :: Double -> Float+d2f = double2Float+{-# INLINE d2f #-}+++-- | Construct a color from red, green, blue components.+rgb :: Float -> Float -> Float -> Color+rgb r g b = makeColor' r g b 1.0+{-# INLINE rgb #-}+++-- | 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 #-}+++unpackColor :: Color -> (Word8, Word8, Word8)+unpackColor c+ | (r, g, b, _) <- rgbaOfColor c+ = ( word8OfFloat (r * 255)+ , word8OfFloat (g * 255)+ , word8OfFloat (b * 255))+{-# INLINE unpackColor #-}+
raster/Ray/Main.hs view
@@ -8,26 +8,105 @@ import qualified Graphics.Gloss as G import qualified Graphics.Gloss.Interface.Pure.Game as G import qualified Graphics.Gloss.Raster.Field as G+import qualified Data.Array.Repa as R+import qualified Data.Array.Repa.IO.BMP as R+import Data.Char+import System.Exit + main :: IO () main = do args <- getArgs- case args of- [] -> run 800 600 4 100 4+ config <- parseArgs args defaultConfig - [sizeX, sizeY, zoom, fov, bounces]- -> run (read sizeX) (read sizeY) (read zoom) (read fov) (read bounces)+ case configFileName config of+ Nothing+ -> runInteractive+ (configSizeX config) (configSizeY config)+ (configZoom config)+ (configFieldOfView config) (configBounces config) - _ -> putStr $ unlines- [ "trace <sizeX::Int> <sizeY::Int> <zoom::Int> (fov::Int) (bounces::Int)"- , " sizeX, sizeY - visualisation size (default 800, 600)"- , " zoom - pixel replication factor (default 4)"- , " fov - field of view (default 100)"- , " bounces - ray bounce limit (default 4)"+ Just file + -> runBmp+ file+ (configSizeX config) (configSizeY config)+ (configFieldOfView config) (configBounces config)++ +-- Config ---------------------------------------------------------------------+data Config+ = Config+ { configSizeX :: Int+ , configSizeY :: Int+ , configFieldOfView :: Int+ , configBounces :: Int+ , configZoom :: Int+ , configFileName :: Maybe FilePath }+ deriving Show+++defaultConfig :: Config+defaultConfig+ = Config+ { configSizeX = 800+ , configSizeY = 600+ , configFieldOfView = 100+ , configBounces = 4+ , configZoom = 4+ , configFileName = Nothing }+++parseArgs :: [String] -> Config -> IO Config+parseArgs args config+ | [] <- args+ = return config++ | "-window" : sizeX : sizeY : zoom : rest <- args+ , all isDigit sizeX+ , all isDigit sizeY+ , all isDigit zoom+ = parseArgs rest+ $ config { configSizeX = read sizeX+ , configSizeY = read sizeY+ , configZoom = read zoom+ , configFileName = Nothing }++ | "-bmp" : sizeX : sizeY : file : rest <- args+ , all isDigit sizeX+ , all isDigit sizeY+ = parseArgs rest+ $ config { configSizeX = read sizeX+ , configSizeY = read sizeY+ , configZoom = 1+ , configFileName = Just file }++ | "-fov" : fov : rest <- args+ , all isDigit fov+ = parseArgs rest+ $ config { configFieldOfView = read fov }++ | "-bounces" : bounces : rest <- args+ , all isDigit bounces+ = parseArgs rest+ $ config { configBounces = read bounces }++ | otherwise+ = do printUsage+ exitWith $ ExitFailure 1++printUsage :: IO ()+printUsage + = putStrLn $ unlines+ [ "gloss-ray [flags]"+ , " -window <sizeX::INT> <sizeY::INT> <zoom::INT> (800, 400, 4)"+ , " -bmp <sizeX::INT> <sizeY::INT> <FILE>"+ , " -fov <INT> Field of view (100)"+ , " -bounces <INT> Ray bounce limit (4)" , "" , " You'll want to run this with +RTS -N to enable threads" ]- ++-- World ---------------------------------------------------------------------- -- | World and interface state. data State = State@@ -53,10 +132,10 @@ -- | Initial world and interface state.-initState :: State-initState+initState :: Float -> State+initState time = State- { stateTime = 0+ { stateTime = time , stateEyePos = Vec3 50 (-100) (-700) , stateEyeLoc = Vec3 (-50) 200 1296 @@ -68,27 +147,43 @@ , stateMovingLeft = False , stateMovingRight = False - , stateObjects = makeObjects 0- , stateObjectsView = makeObjects 0+ , stateObjects = makeObjects time+ , stateObjectsView = makeObjects time - , stateLights = makeLights 0- , stateLightsView = makeLights 0 }+ , stateLights = makeLights time+ , stateLightsView = makeLights time } --- | Run the game.-run :: Int -> Int -> Int -> Int -> Int -> IO () -run sizeX sizeY zoom fov bounces+-- Run ------------------------------------------------------------------------+-- | Run the simulation interactively.+runInteractive :: Int -> Int -> Int -> Int -> Int -> IO () +runInteractive sizeX sizeY zoom fov bounces = G.playField (G.InWindow "Ray" (sizeX, sizeY) (10, 10)) (zoom, zoom) 100- initState+ (advanceState 1 $ initState 0) (tracePixel sizeX sizeY fov bounces) handleEvent advanceState-{-# NOINLINE run #-}+{-# NOINLINE runInteractive #-} +-- BMP ------------------------------------------------------------------------+-- | Write the first frame to a .bmp file+runBmp :: FilePath -> Int -> Int -> Int -> Int -> IO ()+runBmp file sizeX sizeY fov bounces+ = do img <- R.computeUnboxedP + $ G.makeFrame sizeX sizeY+ $ tracePixel sizeX sizeY fov bounces + $ advanceState 1 + $ initState 0++ R.writeImageToBMP file img+{-# NOINLINE runBmp #-}+++-- Trace ---------------------------------------------------------------------- -- | Render a single pixel of the image. tracePixel :: Int -> Int -> Int -> Int -> State -> G.Point -> G.Color tracePixel !sizeX !sizeY !fov !bounces !state (x, y)