phew. works somehow.

This commit is contained in:
nek0 2018-10-25 23:31:21 +02:00
parent b1602ba7a1
commit 56425c2396
6 changed files with 204 additions and 3 deletions

2
.gitignore vendored Normal file
View file

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

View file

@ -17,8 +17,17 @@ cabal-version: >=1.10
executable raycharles executable raycharles
main-is: Main.hs main-is: Main.hs
-- other-modules: other-modules: Map
, Types
-- other-extensions: -- 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 hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

34
shell.nix Normal file
View file

@ -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

View file

@ -1,4 +1,128 @@
module Main where 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 :: 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

22
src/Map.hs Normal file
View file

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

10
src/Types.hs Normal file
View file

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