cleaning and parallelizing

This commit is contained in:
nek0 2018-10-26 03:05:32 +02:00
parent cd097c7f58
commit 8c585767ec
3 changed files with 20 additions and 17 deletions

View file

@ -24,10 +24,11 @@ executable raycharles
, linear , linear
, matrix , matrix
, ansi-terminal , ansi-terminal
, timers
, suspend , suspend
, monad-loops , monad-loops
, terminal-size , terminal-size
, deepseq , deepseq
, parallel
hs-source-dirs: src hs-source-dirs: src
ghc-options: -Wall -threaded
default-language: Haskell2010 default-language: Haskell2010

View file

@ -5,7 +5,7 @@ let
inherit (nixpkgs) pkgs; inherit (nixpkgs) pkgs;
f = { mkDerivation, ansi-terminal, base, deepseq, linear, matrix f = { mkDerivation, ansi-terminal, base, deepseq, linear, matrix
, monad-loops, stdenv, suspend, terminal-size, timers , monad-loops, parallel, stdenv, suspend, terminal-size, timers
}: }:
mkDerivation { mkDerivation {
pname = "raycharles"; pname = "raycharles";
@ -14,9 +14,11 @@ let
isLibrary = false; isLibrary = false;
isExecutable = true; isExecutable = true;
executableHaskellDepends = [ executableHaskellDepends = [
ansi-terminal base deepseq linear matrix monad-loops suspend ansi-terminal base deepseq linear matrix monad-loops parallel
terminal-size timers suspend terminal-size timers
]; ];
enableLibraryProfiling = true;
enableExecutableProfiling = true;
description = "A simple raytracer on the Console"; description = "A simple raytracer on the Console";
license = stdenv.lib.licenses.bsd3; license = stdenv.lib.licenses.bsd3;
}; };

View file

@ -9,10 +9,9 @@ import Data.Maybe
import Control.Monad import Control.Monad
import Control.Monad.Loops import Control.Monad.Loops
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.Timer
import Control.Concurrent.Suspend.Lifted import Control.Concurrent.Suspend.Lifted
import Control.Concurrent.MVar
import Control.DeepSeq import Control.DeepSeq
import Control.Parallel.Strategies
import System.IO import System.IO
import System.Console.ANSI as CA import System.Console.ANSI as CA
@ -46,22 +45,22 @@ main = do
c <- newMVar Nothing c <- newMVar Nothing
whileM_ (not <$> stop <$> readMVar state) $ do whileM_ (not <$> stop <$> readMVar state) $ do
CA.clearScreen CA.clearScreen
takeMVar c _ <- takeMVar c
char <- getKey char <- getKey
putMVar c char putMVar c char
modifyMVar_ state (\s -> if (not (stop s)) modifyMVar_ state (\s -> if (not (stop s))
then then
withMVar c (\char -> handleInput char s) withMVar c (\mvchar -> handleInput mvchar s)
else else
return s) return s)
outputs <- withMVar state draw outputs <- withMVar state draw
withMVar state (\s -> when (not (stop s)) $ do withMVar state (\s -> when (not (stop s)) $ do
let output = L.intercalate "\n" let foutput = L.intercalate "\n"
( outputs ( outputs
++ [show char] ++ [show char]
++ [show (pos s) ++ " " ++ show (rot s)] ++ [show (pos s) ++ " " ++ show (rot s)]
) )
deepseq output (putStr output) deepseq foutput (putStr foutput)
) )
-- threadDelay msdelay -- threadDelay msdelay
showCursor showCursor
@ -87,21 +86,21 @@ handleInput (Just char) state = do
return nstate return nstate
draw :: State -> IO [String] draw :: State -> IO [String]
draw state@(State pos@(V2 x y) rot _ _) = do draw (State ppos prot _ _) = do
(Just (Window h w)) <- TS.size (Just (Window h w)) <- TS.size :: IO (Maybe (Window Int))
let dims@(dw, dh) = (min 160 w, min 60 h) -- if w >= h then (w, w `div` 2) else (w, h) let dims@(dw, dh) = (min 160 w, min 60 h) -- if w >= h then (w, w `div` 2) else (w, h)
output = map out = parMap rpar
(\mh -> map (\mw -> drawPixel dims (mw, mh)) [1 .. fromIntegral dw]) (\mh -> map(\mw -> drawPixel dims (mw, mh)) [1 .. fromIntegral dw])
[1 .. fromIntegral dh - 2] [1 .. fromIntegral dh - 2]
return output return out
where where
drawPixel (w, h) (ddw, ddh) = drawPixel (w, h) (ddw, ddh) =
let rayLength = castRay (fromIntegral w) (fromIntegral h) ddw ddh let rayLength = castRay (fromIntegral w) (fromIntegral h) ddw ddh
in getPixel (fromMaybe 11 rayLength) in getPixel (fromMaybe 11 rayLength)
castRay w h ddw ddh = castRay w h ddw ddh =
let iter = [0, 0.01 .. 10] let iter = [0, 0.01 .. 10]
collPos a = (pos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h)) collPos a = (ppos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h))
`rotVec` (rot - fov / 2 + ddw * fov / w))) `rotVec` (prot - fov / 2 + ddw * fov / w)))
in foldl (\acc a -> in foldl (\acc a ->
if isNothing acc if isNothing acc
then then
@ -125,6 +124,7 @@ doesCollide (V2 x y) =
Just '#' -> True Just '#' -> True
_ -> False _ -> False
rotVec :: Floating a => V2 a -> a -> V2 a
rotVec (V2 x y) rad = V2 nx ny rotVec (V2 x y) rad = V2 nx ny
where where
nx = x * cos rad + y * sin rad nx = x * cos rad + y * sin rad