9845406ce73cccf4b2d9cbe69515f75577cfa301
[packages/dph.git] / dph-examples / examples / spectral / Pluecker / MainGloss.hs
1 {-# LANGUAGE BangPatterns #-}
2
3 import Common
4 import Solver
5
6 import Graphics.Gloss
7 import Graphics.Gloss.Interface.IO.Animate
8
9 import System.Environment
10 import Data.Maybe
11 import qualified Data.Vector as V
12 import qualified Data.Vector.Unboxed as VU
13
14 import System.Random
15
16 model :: Int -> Int -> IO (VU.Vector Vec3, VU.Vector (Int,Int,Int))
17 model numverts numtris
18 = do
19 vs <- VU.generateM numverts mkvec
20 ts <- VU.generateM numtris mktri
21 return (vs,ts)
22 where
23 mkvec _ = do
24 x <- randomRIO (-30,30)
25 y <- randomRIO (-30,30)
26 z <- randomRIO (0,10)
27 return (x,y,z)
28 mktri _ = do
29 a <- randomRIO (0,numverts - 1)
30 b <- randomRIO (0,numverts - 1)
31 c <- randomRIO (0,numverts - 1)
32 return (a,b,c)
33
34
35 main :: IO ()
36 main
37 = do args <- getArgs
38 mainWithArgs args
39
40
41 mainWithArgs :: [String] -> IO ()
42 mainWithArgs [solverName,numv,numt,numr]
43 = let -- The solver we're using to calculate the acclerations.
44 solver = fromMaybe (error $ unlines
45 [ "unknown solver " ++ show solverName
46 , "choose one of " ++ (show $ map fst solvers) ])
47 $ lookup solverName solvers
48 in do
49 (v,t) <- model (read numv) (read numt)
50 --let v = VU.fromList [(0,0,0),(1,1,1),(1,0,1)]
51 --let t = VU.fromList [(0,1,2)]
52 mainGloss v t (read numr) solver 400
53
54 mainWithArgs [solverName] = mainWithArgs [solverName,"100","100","1000"]
55
56 mainWithArgs _ = putStrLn "Usage: pluecker <vector|vectorised> <verts=100> <tris=100> <rays=1000>"
57
58
59 -- | Run the simulation in a gloss window.
60 mainGloss
61 :: VU.Vector Vec3
62 -> VU.Vector (Int,Int,Int)
63 -> Int -- ^ number of rays
64 -> Solver -- ^ Fn to calculate accels of each point.
65 -> Int -- ^ Size of window.
66 -> IO ()
67
68 mainGloss v t numr solver windowSize
69 = let mkray _
70 = do x <- randomRIO (-10,10)
71 y <- randomRIO (-10,10)
72 return (x,y,1)
73
74 draw _
75 = do rays <- VU.generateM numr mkray
76 let pts = solver v t rays
77 return $ Pictures $ map drawPoint $ VU.toList pts
78
79 in animateIO
80 (InWindow "Silly" -- window name
81 (windowSize, windowSize) -- window size
82 (10, 10)) -- window position
83 black -- background color
84 draw -- fn to convert a world to a picture
85
86
87
88 pointSize = 20
89
90 drawPoint :: (Vec3, Double) -> Picture
91 drawPoint ((x,y,z), d)
92 = Translate (realToFrac x * 50) (realToFrac y * 50)
93 $ Color (makeColor d' d' d' 1)
94 $ ThickCircle (pointSize / 2) pointSize
95 where d' = 1 - (realToFrac $ d / 10)