phew. works somehow.

.gitignore

@@ -0,0 +1,2 @@
+dist/**
+.*.swp

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

shell.nix

@@ -0,0 +1,34 @@
+{ nixpkgs ? import <nixpkgs> {}, 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

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

src/Map.hs

@@ -0,0 +1,22 @@
+module Map where
+
+import Data.Matrix as M
+
+map :: Matrix Char
+map = fromLists
+  [ ['#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', '#', '#', ' ', ' ', '#', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', '#', '#', ' ', ' ', '#', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', '#', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', '#', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#']
+  , ['#', ' ', ' ', ' ', ' ', ' ', ' ', ' ', '#', '#', ' ', ' ', '#']
+  , ['#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#', '#']
+  ]

src/Types.hs

@@ -0,0 +1,10 @@
+module Types where
+
+import Linear
+
+data State = State
+  { pos    :: V2 Double
+  , rot    :: Double
+  , stop   :: Bool
+  , output :: String
+  }