module Main where import Linear import Data.Matrix as M import Data.List as L 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 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 (\char -> handleInput char s) else return s) outputs <- withMVar state draw withMVar state (\s -> when (not (stop s)) $ do let output = L.intercalate "\n" ( outputs ++ [show char] ++ [show (pos s) ++ " " ++ show (rot s)] ) deepseq output (putStr output) ) -- 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 [String] draw state@(State pos@(V2 x y) rot _ _) = do (Just (Window h w)) <- TS.size 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]) [1 .. fromIntegral dh - 2] return output 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.05 .. 10] collPos a = (pos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h)) `rotVec` (rot - fov / 2 + ddw * fov / w))) in 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 = ' ' 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 rotVec (V2 x y) rad = V2 nx ny where nx = x * cos rad + y * sin rad ny = x * sin rad - y * cos rad 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 ()