summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/pickInt.hs24
1 files changed, 12 insertions, 12 deletions
diff --git a/examples/pickInt.hs b/examples/pickInt.hs
index 2443c8b..5a499d4 100644
--- a/examples/pickInt.hs
+++ b/examples/pickInt.hs
@@ -20,9 +20,9 @@ import qualified LambdaCube.Linear as LCLin
20-- See: http://lambdacube3d.com/getting-started 20-- See: http://lambdacube3d.com/getting-started
21---------------------------------------------------- 21----------------------------------------------------
22 22
23screenDim :: (,) Int Int 23screenDim :: (Int, Int)
24screenDim = (,) 800 600 24screenDim = (800, 600)
25(,) screenW screenH = screenDim 25(screenW, screenH) = screenDim
26 26
27main :: IO () 27main :: IO ()
28main = do 28main = do
@@ -59,16 +59,16 @@ main = do
59 -- update graphics input 59 -- update graphics input
60 GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h) 60 GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
61 LambdaCubeGL.updateUniforms storage $ do 61 LambdaCubeGL.updateUniforms storage $ do
62 let (,) x y = (,) 0 0 62 let (x, y) = (,) 0 0
63 cvpos = Vec3 x (-y) 0 63 cvpos = Vec3 x (-y) 0
64 toScreen = screenM screenW screenH 64 toScreen = screenM screenW screenH
65 "viewProj" @= pure (mat4ToM44F $! (Vc.fromProjective $! Vc.translation cvpos) Vc..*. toScreen) 65 "viewProj" @= pure (mat4ToM44F $! (Vc.fromProjective $! Vc.translation cvpos) Vc..*. toScreen)
66 66
67 let pickPoints = 67 let pickPoints = -- should be fb 0 fb 1 (pick)
68 [ (0, 0) -- should be black 68 [ (0, 0) -- black 0
69 , (200, 200) -- ..blue, ffff0000 69 , (200, 200) -- ..blue, ffff0000 2
70 , (600, 400) -- ..red, ff0000ff 70 , (600, 400) -- ..red, ff0000ff 1
71 ] :: [(,) Int Int] 71 ] :: [(Int, Int)]
72 72
73 -- render to render texture 73 -- render to render texture
74 LambdaCubeGL.renderFrame pipePick 74 LambdaCubeGL.renderFrame pipePick
@@ -89,7 +89,7 @@ main = do
89 let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k 89 let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
90 escape <- keyIsPressed Key'Escape 90 escape <- keyIsPressed Key'Escape
91 if escape then return () else loop 91 if escape then return () else loop
92 collectPicks :: Int -> [(,) Int Int] -> IO [Int] 92 collectPicks :: Int -> [(Int, Int)] -> IO [Int]
93 collectPicks fb picks = 93 collectPicks fb picks =
94 forM picks $ (fromIntegral <$>) . pickFrameBuffer fb screenDim 94 forM picks $ (fromIntegral <$>) . pickFrameBuffer fb screenDim
95 printPicks pickPoints colorPicks = do 95 printPicks pickPoints colorPicks = do
@@ -146,8 +146,8 @@ screenM w h = scaleM
146 146
147pickFrameBuffer 147pickFrameBuffer
148 :: Int -- ^ framebuffer 148 :: Int -- ^ framebuffer
149 -> (,) Int Int -- ^ FB dimensions 149 -> (Int, Int) -- ^ FB dimensions
150 -> (,) Int Int -- ^ pick coordinates 150 -> (Int, Int) -- ^ pick coordinates
151 -> IO F.Word32 -- ^ resultant pixel value 151 -> IO F.Word32 -- ^ resultant pixel value
152pickFrameBuffer fb (w, h) (x, y) = do 152pickFrameBuffer fb (w, h) (x, y) = do
153 glFinish 153 glFinish