diff options
author | Joe Crayne <joe@jerkface.net> | 2019-05-17 13:39:48 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-05-17 13:39:48 -0400 |
commit | 330649949aea845e0472d0d99fbd30fb00bd6183 (patch) | |
tree | 8f32a749ae28b12a48a767abab5a816189cddb51 /MeshSketch.hs | |
parent | b5d68cc4aba82fec53e156a6c0c2d2726ee6ff46 (diff) |
3d coordinate draw.
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r-- | MeshSketch.hs | 47 |
1 files changed, 39 insertions, 8 deletions
diff --git a/MeshSketch.hs b/MeshSketch.hs index 0b3cd05..8f38863 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs | |||
@@ -122,6 +122,17 @@ viewProjection c | |||
122 | pos = camTarget c - scale (camDistance c) (camDirection c) | 122 | pos = camTarget c - scale (camDistance c) (camDirection c) |
123 | proj = perspective 0.1 100 (camHeightAngle c) (camWidth c / camHeight c) | 123 | proj = perspective 0.1 100 (camHeightAngle c) (camWidth c / camHeight c) |
124 | 124 | ||
125 | realToFracMatrix :: (Real a, Fractional t, Element t, Element a) => Matrix a -> Matrix t | ||
126 | realToFracMatrix m = fromLists $ map realToFrac <$> toLists m | ||
127 | |||
128 | invFloat :: Matrix Float -> Matrix Float | ||
129 | invFloat m = realToFracMatrix $ inv (realToFracMatrix m :: Matrix Double) | ||
130 | |||
131 | projectionView :: Camera -> (Camera,Matrix Float) | ||
132 | projectionView c | ||
133 | | Just m <- camScreenToWorld c = (c,m) | ||
134 | | Just w <- camWorldToScreen c = projectionView c{ camScreenToWorld = Just $ invFloat w } | ||
135 | | otherwise = projectionView $ fst $ viewProjection c | ||
125 | 136 | ||
126 | addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) -> IO [LC.Object] | 137 | addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) -> IO [LC.Object] |
127 | addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do | 138 | addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do |
@@ -446,10 +457,17 @@ onEvent w realized ev = do | |||
446 | mev <- get ev #motion | 457 | mev <- get ev #motion |
447 | h <- get mev #x | 458 | h <- get mev #x |
448 | k <- get mev #y | 459 | k <- get mev #y |
460 | -- let d = camPos cam + computeDirection cam h k | ||
461 | pv <- atomicModifyIORef' (stCamera st) projectionView | ||
449 | cam <- readIORef (stCamera st) | 462 | cam <- readIORef (stCamera st) |
450 | let d = camPos cam + computeDirection cam h k | 463 | let d0 = fromList [ 2 * realToFrac h/camWidth cam - 1 |
451 | -- pushBack (stRingBuffer st) (d!0) (d!1) (d!2) | 464 | , 1 - 2 * realToFrac k/camHeight cam |
452 | pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2) | 465 | , 1 |
466 | , 1 | ||
467 | ] :: Vector Float | ||
468 | d1 = pv #> d0 | ||
469 | d = scale (1 /(d1!3) ) d1 | ||
470 | pushBack (stRingBuffer st) (d!0) (d!1) (d!2) | ||
453 | Just win <- getWidgetWindow w | 471 | Just win <- getWidgetWindow w |
454 | windowInvalidateRect win Nothing False | 472 | windowInvalidateRect win Nothing False |
455 | put (etype,(h,k),d) | 473 | put (etype,(h,k),d) |
@@ -468,10 +486,16 @@ onEvent w realized ev = do | |||
468 | bev <- get ev #button | 486 | bev <- get ev #button |
469 | h <- get bev #x | 487 | h <- get bev #x |
470 | k <- get bev #y | 488 | k <- get bev #y |
489 | pv <- atomicModifyIORef' (stCamera st) projectionView | ||
471 | cam <- readIORef (stCamera st) | 490 | cam <- readIORef (stCamera st) |
472 | let d = camPos cam + computeDirection cam h k | 491 | let d0 = fromList [ 2 * realToFrac h/camWidth cam - 1 |
473 | -- pushBack (stRingBuffer st) (d!0) (d!1) (d!2) | 492 | , 1 - 2 * realToFrac k/camHeight cam |
474 | pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2) | 493 | , 1 |
494 | , 1 | ||
495 | ] :: Vector Float | ||
496 | d1 = pv #> d0 | ||
497 | d = scale (1 /(d1!3) ) d1 | ||
498 | pushBack (stRingBuffer st) (d!0) (d!1) (d!2) | ||
475 | Just win <- getWidgetWindow w | 499 | Just win <- getWidgetWindow w |
476 | windowInvalidateRect win Nothing False | 500 | windowInvalidateRect win Nothing False |
477 | put (etype,(h,k),d) | 501 | put (etype,(h,k),d) |
@@ -492,9 +516,16 @@ onEvent w realized ev = do | |||
492 | bev <- get ev #button | 516 | bev <- get ev #button |
493 | h <- get bev #x | 517 | h <- get bev #x |
494 | k <- get bev #y | 518 | k <- get bev #y |
519 | pv <- atomicModifyIORef' (stCamera st) projectionView | ||
495 | cam <- readIORef (stCamera st) | 520 | cam <- readIORef (stCamera st) |
496 | let d = camPos cam + computeDirection cam h k | 521 | let d0 = fromList [ 2 * realToFrac h/camWidth cam - 1 |
497 | pushBack (stRingBuffer st) (2 * realToFrac h/camWidth cam - 1) (1 - 2 * realToFrac k/camHeight cam) 1 -- (d!0) (d!1) (d!2) | 522 | , 1 - 2 * realToFrac k/camHeight cam |
523 | , 1 | ||
524 | , 1 | ||
525 | ] :: Vector Float | ||
526 | d1 = pv #> d0 | ||
527 | d = scale (1 /(d1!3) ) d1 | ||
528 | pushBack (stRingBuffer st) (d!0) (d!1) (d!2) | ||
498 | Just win <- getWidgetWindow w | 529 | Just win <- getWidgetWindow w |
499 | windowInvalidateRect win Nothing False | 530 | windowInvalidateRect win Nothing False |
500 | _ -> do | 531 | _ -> do |