Questo sito utilizza cookies, anche di terze parti, per mostrare pubblicità e servizi in linea con il tuo account. Leggi l'informativa sui cookies.
Username: Password: oppure
Esempio su Haste - Main.hs

Main.hs

Caricato da: ZioCrocifisso
Scarica il programma completo


Warning: array_keys() expects parameter 1 to be array, null given in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 1925

Warning: Invalid argument supplied for foreach() in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 1925

Warning: Invalid argument supplied for foreach() in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 2290

Warning: implode(): Argument must be an array in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 3242

Warning: array_keys() expects parameter 1 to be array, null given in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 3265

Warning: Invalid argument supplied for foreach() in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 3265

Warning: Invalid argument supplied for foreach() in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 3306

Warning: array_keys() expects parameter 1 to be array, null given in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 3357

Warning: Invalid argument supplied for foreach() in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 3357

Warning: array_keys() expects parameter 1 to be array, null given in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 3502

Warning: Invalid argument supplied for foreach() in /home/pierotofy/pierotofy_stable/etc/lib/geshi/geshi.php on line 3502
  1. module Main where
  2.  
  3. import Data.Maybe
  4.  
  5. import Control.Applicative
  6. import Control.Monad
  7. import Control.Monad.IO.Class
  8. import Control.Monad.Trans.Class
  9. import Control.Monad.Trans.Reader
  10. import Control.Monad.Trans.State
  11.  
  12. import Haste
  13. import Haste.Concurrent
  14. import Haste.Graphics.Canvas
  15.  
  16. speed :: Double
  17. speed = pi / 100
  18.  
  19. nCircles :: Int
  20. nCircles = 7
  21.  
  22. main :: IO ()
  23. main = do
  24.         mCanvas <- elemById "main"
  25.         posRef <- newMVar (0, 0)
  26.  
  27.         case mCanvas of
  28.                 Just elem -> concurrent $ do
  29.                         (Just canvas) <- getCanvas elem
  30.  
  31.                         setCallback' elem OnMouseMove $ modifyMVarIO posRef . const . return . flip (,) ()
  32.                         forkIO $ runReaderT (evalStateT loop 0) (canvas, posRef)
  33.  
  34.                 Nothing -> alert "Canvas?"
  35.  
  36. loop :: StateT Double (ReaderT (Canvas, MVar (Int, Int)) CIO) ()
  37. loop = forever $ do
  38.         angle <- get
  39.         (canvas, posRef) <- lift ask
  40.  
  41.         io (peekMVar posRef) >>= \pos -> case pos of
  42.                 Just (x, y) -> render canvas $ drawCircles x y angle
  43.                 Nothing -> return ()
  44.  
  45.         put $ nextAngle angle
  46.         io $ wait 20
  47.  
  48.         where
  49.                 nextAngle a = if a > pi then - pi else a + speed
  50.                 io = lift . lift
  51.  
  52. drawCircles :: Int -> Int -> Double -> Picture ()
  53. drawCircles x y angle = mapM_ drawCircle [ 0 .. nCircles - 1 ]
  54.         where drawCircle n = color col . fill . circle (sx, sy) $ 10
  55.                 where
  56.                         col = RGB 0 0 $ 155 + 100 * n * n `quot` nCircles
  57.  
  58.                         sx = cos relativeAngle * dist + fx
  59.                         sy = sin relativeAngle * dist + fy
  60.  
  61.                         relativeAngle = angle + 2 * pi * fn / (fromIntegral nCircles)
  62.                         dist = 35
  63.  
  64.                         fx = fromIntegral x
  65.                         fy = fromIntegral y
  66.                         fn = fromIntegral n