Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Camera rotating, more complex body

  • Loading branch information...
commit e605337ca4b9683bd084e882303885dc400eb11e 1 parent c918d4a
Dmitry Dzhus authored
Showing with 33 additions and 20 deletions.
  1. +33 −20 src/Caster.hs
53 src/Caster.hs
View
@@ -17,12 +17,13 @@ import GHC.Float
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Display
import qualified Graphics.Gloss.Data.Point as G
+import qualified Graphics.Gloss.Interface.Pure.Game as G
import Graphics.Gloss.Field
import System.Console.CmdArgs.Implicit
import DSMC.Traceables
-import DSMC.Types
+import DSMC.Types hiding (position)
import DSMC.Util.Vector
@@ -48,9 +49,37 @@ data World = World
-- | Pixels in meter.
scaleFactor = 200
+origin = Vector 0 0 0
+
+processEvents :: G.Event -> World -> World
+processEvents event world =
+ case event of
+ G.EventKey (G.SpecialKey k) G.Down _ _ ->
+ let
+ cam = camera world
+ (pos, dir) = (position cam, direction cam)
+ (n, sX, sY) = buildCartesian dir
+ newPos =
+ case k of
+ G.KeyLeft -> pos <+> sX
+ G.KeyRight -> pos <-> sX
+ G.KeyUp -> pos <+> sY
+ G.KeyDown -> pos <-> sY
+ _ -> pos
+ in
+ world{camera = cam{position = newPos,
+ direction = origin <-> newPos}}
+ G.EventKey _ _ _ _ -> world
+ G.EventMotion _ -> world
+
main =
let
- body = cylinder (Vector 0.25 1 0) (Vector 0 0 0) 1
+ body = intersection [sphere (Vector 0 0 0) 1,
+ plane (Vector 1 0 1) 0,
+ plane (Vector (-1) 0 1) 0,
+ complement $
+ cylinder (Vector 0 1 0) (Vector 0 0 0) 0.2]
+
(width, height) = (600, 600)
display = InWindow "dsmc-tools CSG raycaster" (width, height) (100, 100)
@@ -84,7 +113,7 @@ main =
playField display (1, 1) 1
world
makePixel
- (\_ w -> w)
+ processEvents
(\_ w -> w)
@@ -99,20 +128,4 @@ main =
-- Options{..} <- cmdArgs $ sample
-- case bodyDef of
-- Just fname -> print fname
--- Nothing -> error "Lol u suck mon"
-
--- -- | Calculate color of ray.
--- rayCast :: Ray -> Body -> Color
--- rayCast ray b =
--- let
--- fullTrace = trace b ray
--- hitTrace = intersectTraces fullTrace [((0, Nothing),
--- (infinityP, Nothing))]
--- in
--- if null hitTrace
--- then white
--- else
--- let
--- n = fromJust (snd (fst (head hitTrace)))
--- in
--- scaleColor red ((reverse n) .* (velocity ray))
+-- Nothing -> error "No body definition given"
Please sign in to comment.
Something went wrong with that request. Please try again.