diff options
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r-- | MeshSketch.hs | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/MeshSketch.hs b/MeshSketch.hs index 273c3dc..099f8d4 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs | |||
@@ -122,7 +122,7 @@ viewProjection c | |||
122 | where | 122 | where |
123 | m' = proj <> cam | 123 | m' = proj <> cam |
124 | cam = lookat pos (camTarget c) (camUp c) | 124 | cam = lookat pos (camTarget c) (camUp c) |
125 | pos = camTarget c - scale (camDistance c) (camDirection c) | 125 | pos = camPos c |
126 | proj = perspective 0.1 100 (camHeightAngle c) (camWidth c / camHeight c) | 126 | proj = perspective 0.1 100 (camHeightAngle c) (camWidth c / camHeight c) |
127 | 127 | ||
128 | realToFracVector :: ( Real a | 128 | realToFracVector :: ( Real a |
@@ -374,7 +374,11 @@ computeDirection cam h k | Just pv <- camScreenToWorld cam = | |||
374 | , 1 | 374 | , 1 |
375 | ] :: Vector Float | 375 | ] :: Vector Float |
376 | d1 = pv #> d0 | 376 | d1 = pv #> d0 |
377 | in scale (1 /(d1!3) ) $ G.init d1 | 377 | d2 = scale (1 /(d1!3)) $ G.init d1 |
378 | p = camPos cam | ||
379 | d3 = d2 - p | ||
380 | d4 = scale (1/realToFrac (norm_2 d3)) d3 | ||
381 | in d2 | ||
378 | computeDirection cam h k = | 382 | computeDirection cam h k = |
379 | let d̂ = camDirection cam -- forward | 383 | let d̂ = camDirection cam -- forward |
380 | û = camUp cam -- upward | 384 | û = camUp cam -- upward |
@@ -466,6 +470,7 @@ sanitizeCamera st = do | |||
466 | , camScreenToWorld = Nothing | 470 | , camScreenToWorld = Nothing |
467 | } | 471 | } |
468 | 472 | ||
473 | |||
469 | worldCoordinates :: State -> Double -> Double -> IO (Vector Float) | 474 | worldCoordinates :: State -> Double -> Double -> IO (Vector Float) |
470 | worldCoordinates st h k = do | 475 | worldCoordinates st h k = do |
471 | pv <- atomicModifyIORef' (stCamera st) projectionView | 476 | pv <- atomicModifyIORef' (stCamera st) projectionView |
@@ -476,7 +481,11 @@ worldCoordinates st h k = do | |||
476 | , 1 | 481 | , 1 |
477 | ] :: Vector Float | 482 | ] :: Vector Float |
478 | d1 = pv #> d0 | 483 | d1 = pv #> d0 |
479 | return $ scale (1 /(d1!3) ) d1 | 484 | d2 = scale (1 /(d1!3)) $ G.init d1 |
485 | p = camPos cam | ||
486 | d3 = d2 - p | ||
487 | d4 = scale (camDistance cam/realToFrac (norm_2 d3)) d3 | ||
488 | return $ p + d4 | ||
480 | 489 | ||
481 | pushRing :: IsWidget w => w -> State -> Double -> Double -> IO (Vector Float) | 490 | pushRing :: IsWidget w => w -> State -> Double -> Double -> IO (Vector Float) |
482 | pushRing w st h k = do | 491 | pushRing w st h k = do |
@@ -532,9 +541,9 @@ onEvent w realized ev = do | |||
532 | bev <- get ev #button | 541 | bev <- get ev #button |
533 | h <- get bev #x | 542 | h <- get bev #x |
534 | k <- get bev #y | 543 | k <- get bev #y |
535 | d <- G.init <$> worldCoordinates st h k | 544 | _ {- d -} <- worldCoordinates st h k |
536 | cam <- readIORef (stCamera st) | 545 | cam <- readIORef (stCamera st) |
537 | -- let d = computeDirection cam h k | 546 | let d = computeDirection cam h k |
538 | writeIORef (stDragFrom st) $ Just (d,cam) | 547 | writeIORef (stDragFrom st) $ Just (d,cam) |
539 | put (etype,(h,k),d) | 548 | put (etype,(h,k),d) |
540 | return () | 549 | return () |