diff options
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r-- | MeshSketch.hs | 29 |
1 files changed, 20 insertions, 9 deletions
diff --git a/MeshSketch.hs b/MeshSketch.hs index 16c8284..0b3cd05 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs | |||
@@ -48,7 +48,7 @@ import LoadMesh | |||
48 | import InfinitePlane | 48 | import InfinitePlane |
49 | import MtlParser (ObjMaterial(..)) | 49 | import MtlParser (ObjMaterial(..)) |
50 | import Matrix | 50 | import Matrix |
51 | import TextureBufferRing | 51 | import PointPrimitiveRing |
52 | 52 | ||
53 | 53 | ||
54 | prettyDebug :: GL.DebugMessage -> String | 54 | prettyDebug :: GL.DebugMessage -> String |
@@ -96,6 +96,8 @@ data Camera = Camera | |||
96 | , camScreenToWorld :: Maybe (Matrix Float) | 96 | , camScreenToWorld :: Maybe (Matrix Float) |
97 | } | 97 | } |
98 | 98 | ||
99 | camPos c = camTarget c - scale (camDistance c) (camDirection c) | ||
100 | |||
99 | initCamera :: Camera | 101 | initCamera :: Camera |
100 | initCamera = Camera | 102 | initCamera = Camera |
101 | { camHeightAngle = pi/6 | 103 | { camHeightAngle = pi/6 |
@@ -251,7 +253,7 @@ new = do | |||
251 | defObjectArray "plane" Triangles $ do | 253 | defObjectArray "plane" Triangles $ do |
252 | "position" @: Attribute_V4F | 254 | "position" @: Attribute_V4F |
253 | defObjectArray "Points" Points $ do | 255 | defObjectArray "Points" Points $ do |
254 | "position" @: Attribute_Float | 256 | "position" @: Attribute_V3F |
255 | defUniforms $ do | 257 | defUniforms $ do |
256 | "PointBuffer" @: FTextureBuffer | 258 | "PointBuffer" @: FTextureBuffer |
257 | "CubeMap" @: FTextureCube | 259 | "CubeMap" @: FTextureCube |
@@ -309,7 +311,8 @@ onRealize mesh pipeline schema mm = do | |||
309 | , EventMaskScrollMask | 311 | , EventMaskScrollMask |
310 | , EventMaskKeyPressMask -- , EventMaskKeyReleaseMask | 312 | , EventMaskKeyPressMask -- , EventMaskKeyReleaseMask |
311 | ] | 313 | ] |
312 | _ <- on w #event $ onEvent w r | 314 | _ <- on w #event $ \ev -> do gLAreaMakeCurrent w |
315 | onEvent w r ev | ||
313 | _ <- on w #render $ onRender w r | 316 | _ <- on w #render $ onRender w r |
314 | _ <- on w #resize $ onResize w r | 317 | _ <- on w #resize $ onResize w r |
315 | writeIORef (mmRealized mm) $ Just r | 318 | writeIORef (mmRealized mm) $ Just r |
@@ -444,8 +447,11 @@ onEvent w realized ev = do | |||
444 | h <- get mev #x | 447 | h <- get mev #x |
445 | k <- get mev #y | 448 | k <- get mev #y |
446 | cam <- readIORef (stCamera st) | 449 | cam <- readIORef (stCamera st) |
447 | let d = computeDirection cam h k | 450 | let d = camPos cam + computeDirection cam h k |
448 | pushBack (stRingBuffer st) (d!0) (d!1) (d!2) | 451 | -- pushBack (stRingBuffer st) (d!0) (d!1) (d!2) |
452 | pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2) | ||
453 | Just win <- getWidgetWindow w | ||
454 | windowInvalidateRect win Nothing False | ||
449 | put (etype,(h,k),d) | 455 | put (etype,(h,k),d) |
450 | _ -> do | 456 | _ -> do |
451 | mev <- get ev #motion | 457 | mev <- get ev #motion |
@@ -463,8 +469,11 @@ onEvent w realized ev = do | |||
463 | h <- get bev #x | 469 | h <- get bev #x |
464 | k <- get bev #y | 470 | k <- get bev #y |
465 | cam <- readIORef (stCamera st) | 471 | cam <- readIORef (stCamera st) |
466 | let d = computeDirection cam h k | 472 | let d = camPos cam + computeDirection cam h k |
467 | pushBack (stRingBuffer st) (d!0) (d!1) (d!2) | 473 | -- pushBack (stRingBuffer st) (d!0) (d!1) (d!2) |
474 | pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2) | ||
475 | Just win <- getWidgetWindow w | ||
476 | windowInvalidateRect win Nothing False | ||
468 | put (etype,(h,k),d) | 477 | put (etype,(h,k),d) |
469 | _ -> do | 478 | _ -> do |
470 | bev <- get ev #button | 479 | bev <- get ev #button |
@@ -484,8 +493,10 @@ onEvent w realized ev = do | |||
484 | h <- get bev #x | 493 | h <- get bev #x |
485 | k <- get bev #y | 494 | k <- get bev #y |
486 | cam <- readIORef (stCamera st) | 495 | cam <- readIORef (stCamera st) |
487 | let d = computeDirection cam h k | 496 | let d = camPos cam + computeDirection cam h k |
488 | pushBack (stRingBuffer st) (d!0) (d!1) (d!2) | 497 | pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2) |
498 | Just win <- getWidgetWindow w | ||
499 | windowInvalidateRect win Nothing False | ||
489 | _ -> do | 500 | _ -> do |
490 | bev <- get ev #button | 501 | bev <- get ev #button |
491 | h <- get bev #x | 502 | h <- get bev #x |