module Main where import Linear import Data.Matrix as M import qualified Data.Vector as V import Data.Maybe import Control.Monad import Control.Monad.Loops import Control.Concurrent import Control.Concurrent.Suspend.Lifted import Control.DeepSeq import Control.Parallel.Strategies import System.IO import System.Console.ANSI as CA import System.Console.Terminal.Size as TS -- import Debug.Trace as T import qualified Map import Types delay :: Delay delay = msDelay (fromIntegral msdelay) msdelay :: Int msdelay = 100 step :: V2 Double step = V2 0 0.5 rotStep :: Double rotStep = 0.174533 fov :: Double fov = pi / 2 main :: IO () main = do hSetBuffering stdin NoBuffering hideCursor state <- newMVar (State (V2 10 3) 0 False "") c <- newMVar Nothing whileM_ (not <$> stop <$> readMVar state) $ do CA.clearScreen _ <- takeMVar c char <- getKey putMVar c char modifyMVar_ state (\s -> if (not (stop s)) then withMVar c (\mvchar -> handleInput mvchar s) else return s) outputs <- withMVar state draw withMVar state (\s -> when (not (stop s)) $ do let foutput = V.toList $ V.tail $ V.foldl (\acc a -> acc V.++ V.singleton '\n' V.++ a) V.empty ( outputs V.++ V.singleton (V.fromList $ show char) V.++ V.singleton (V.fromList $ show (pos s) ++ " " ++ show (rot s)) ) deepseq foutput (putStr foutput) ) -- threadDelay msdelay showCursor handleInput :: Maybe Char -> State -> IO State handleInput Nothing state = return state handleInput (Just char) state = do let npos delta = if not (doesCollide (pos state + delta)) then pos state + delta else pos state nstate = case char of 'w' -> state { pos = npos (step `rotVec` rot state) } 's' -> state { pos = npos (- step `rotVec` rot state) } 'd' -> state { rot = rot state + rotStep } 'a' -> state { rot = rot state - rotStep } '\ESC' -> state { stop = True } _ -> state return nstate draw :: State -> IO (V.Vector (V.Vector Char)) 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) out = (V.generate (fromIntegral dh - 2) ((\mh -> V.map (\mw -> drawPixel dims (mw, mh)) (V.generate (fromIntegral dw) fromIntegral) ) . fromIntegral) ) `using` parVector 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 = V.generate (1000) ((/ 100) . fromIntegral) :: V.Vector Double collPos a = (ppos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h)) `rotVec` (prot - fov / 2 + ddw * fov / w))) in V.foldl (\acc a -> if isNothing acc then if doesCollide (collPos a) then Just a else acc else acc ) Nothing iter getPixel l | l <= 3 = '█' | l <= 4.5 = '▓' | l <= 6 = '▒' | l <= 9 = '░' | otherwise = ' ' parVector :: NFData a => Strategy (V.Vector a) parVector vec = let vLen = V.length vec half = vLen `div` 2 minChunk = 10 in if vLen > minChunk then do let v1 = V.unsafeSlice 0 half vec v2 = V.unsafeSlice half (vLen - half) vec parVector v1 parVector v2 return vec else evalChunk (vLen-1) >> return vec where evalChunk 0 = rpar (rdeepseq (vec V.! 0)) >> return vec evalChunk i = rpar (rdeepseq (vec V.! i)) >> evalChunk (i-1) doesCollide :: V2 Double -> Bool doesCollide (V2 x y) = let tile = safeGet (floor x) (floor y) Map.map in case tile of Nothing -> True Just '#' -> True _ -> False {-# INLINE doesCollide #-} rotVec :: V2 Double -> Double -> V2 Double rotVec (V2 x y) rad = V2 nx ny where nx = x * cos rad + y * sin rad ny = x * sin rad - y * cos rad {-# INLINE rotVec #-} getKey :: IO (Maybe Char) getKey = do charMVar <- newEmptyMVar tid <- forkIO (forkGetChar charMVar) threadDelay (msdelay `div` 5) empty <- isEmptyMVar charMVar if (not empty) then do killThread tid Just <$> takeMVar charMVar else do killThread tid return Nothing where forkGetChar mvar = do hSetEcho stdin False cs <- (: []) <$> hGetChar stdin hSetEcho stdin True when (not (null cs)) $ do _ <- putMVar mvar (head cs) return ()