diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..96a8635 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +dist/** +.*.swp diff --git a/raycharles.cabal b/raycharles.cabal index 194de06..e30d615 100644 --- a/raycharles.cabal +++ b/raycharles.cabal @@ -17,8 +17,17 @@ cabal-version: >=1.10 executable raycharles main-is: Main.hs - -- other-modules: + other-modules: Map + , Types -- other-extensions: - build-depends: base >=4.11 && <4.12 + build-depends: base >=4.11 && <5 + , linear + , matrix + , ansi-terminal + , timers + , suspend + , monad-loops + , terminal-size + , deepseq hs-source-dirs: src default-language: Haskell2010 diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..55e2794 --- /dev/null +++ b/shell.nix @@ -0,0 +1,34 @@ +{ nixpkgs ? import {}, compiler ? "default", doBenchmark ? false }: + +let + + inherit (nixpkgs) pkgs; + + f = { mkDerivation, ansi-terminal, base, deepseq, linear, matrix + , monad-loops, stdenv, suspend, terminal-size, timers + }: + mkDerivation { + pname = "raycharles"; + version = "0.0.0.0"; + src = ./.; + isLibrary = false; + isExecutable = true; + executableHaskellDepends = [ + ansi-terminal base deepseq linear matrix monad-loops suspend + terminal-size timers + ]; + description = "A simple raytracer on the Console"; + license = stdenv.lib.licenses.bsd3; + }; + + haskellPackages = if compiler == "default" + then pkgs.haskellPackages + else pkgs.haskell.packages.${compiler}; + + variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id; + + drv = variant (haskellPackages.callPackage f {}); + +in + + if pkgs.lib.inNixShell then drv.env else drv diff --git a/src/Main.hs b/src/Main.hs index 65ae4a0..72daede 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,128 @@ 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 = putStrLn "Hello, Haskell!" +main = do + hSetBuffering stdin NoBuffering + hideCursor + state <- newMVar (State (V2 10 3) 0 False "") + c <- newMVar ' ' + putStrLn "starting loop, press button" + whileM_ (not <$> stop <$> readMVar state) $ do + CA.clearScreen + takeMVar c + char <- getChar + putMVar c char + modifyMVar_ state (\s -> if (not (stop s)) + then + withMVar c (\char -> handleInput (Just char) s) + else + return s) + outputs <- withMVar state draw + withMVar state (\s -> when (not (stop s)) $ do + let output = L.intercalate "\n" outputs + deepseq output (putStr output) + putStrLn ("\n" ++ [char] ++ "\n" ++ show (pos s) ++ " " ++ show (rot s))) + 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) = (w, 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.02 .. 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 diff --git a/src/Map.hs b/src/Map.hs new file mode 100644 index 0000000..03febfb --- /dev/null +++ b/src/Map.hs @@ -0,0 +1,22 @@ +module Map where + +import Data.Matrix as M + +map :: Matrix Char +map = fromLists + [ ['#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', '#', '#', ' ', ' ', '#', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', '#', '#', ' ', ' ', '#', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', '#', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', '#', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#'] + , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#'] + , ['#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#'] + ] diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..6145b41 --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,10 @@ +module Types where + +import Linear + +data State = State + { pos :: V2 Double + , rot :: Double + , stop :: Bool + , output :: String + }