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
, matrix
, ansi-terminal
, timers
, suspend
, monad-loops
, terminal-size
, deepseq
, parallel
hs-source-dirs: src
ghc-options: -Wall -threaded
default-language: Haskell2010

View file

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

View file

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