Tema 27: Programación de animaciones en Haskell con Gloss

import Graphics.Gloss

main :: IO ()
main = animate (InWindow "Rotando un cuadrado" (500,500) (20,20))
               green animacion

animacion :: Float -> Picture
animacion t = rotate (60 * t) (rectangleSolid 100 100)

import Graphics.Gloss

main :: IO ()
main = animate (InWindow "Moviendo un circulo" (1800,820) (90,90)) green animacion

animacion :: Float -> Picture
animacion t = translate (50 * t - 900) 0 (color red (circleSolid 25))

import Graphics.Gloss

main :: IO ()
main = animate (InWindow "Expandiendo un circulo" (1800,820) (90,90)) green animacion

animacion :: Float -> Picture
animacion t = circle (800 * sin (t / 4))

main :: IO ()
main = animate (InWindow "Rotacion alrededor de un punto" (1800,820) (90,90))
               green animacion

animacion :: Float -> Picture
animacion t = rotate (60 * t) (translate 400 0 (circleSolid 10))

import Graphics.Gloss

main :: IO ()
main = animate (InWindow "Reloj" (1800,820) (90,90))
               green animacion

animacion :: Float -> Picture
animacion t = reloj t

reloj :: Float -> Picture
reloj t = pictures [ fondo,
                     minutero t,
                     segundero t ]

fondo :: Picture
fondo = color (dark white) (circleSolid 250)

minutero :: Float -> Picture
minutero t = rotate (0.1 * t) (line [(0,0), (0,250)])

segundero :: Float -> Picture
segundero t = rotate (6 * t) (line [(0,0), (0,250)])

import Graphics.Gloss

main :: IO ()
main = animate (InWindow "Arbol animado" (1800,820) (90,90))
               blue animacion

animacion :: Float -> Picture
animacion t =
  Pictures [ Translate 0 150    rectanguloDeFondo
           , Translate 0 0      rectanguloDeFondo
           , Translate 0 (-150) rectanguloDeFondo
           , Translate 0 (-150) (fractalArbol 7 t)
           ]

rectanguloDeFondo :: Picture
rectanguloDeFondo =
  Pictures [ Color red   (rectangleSolid 400 100)
           , Color white (rectangleWire  400 100) ]

colorContornoRamas :: Color
colorContornoRamas = makeColor 0.3 0.3 1.0 1.0

colorRamas :: Color
colorRamas = makeColor 0.0 1.0 0.0 0.5

fractalArbol :: Int -> Float -> Picture
fractalArbol 0 _ = Blank
fractalArbol n t =
  Pictures [ Color colorRamas (rectangleUpperSolid 20 300)
           , Color colorContornoRamas (rectangleUpperWire 20 300)
           , Translate 0 30
             $ Rotate  (200 * sin t / fromIntegral n)
             $ Scale   0.9 0.9
             $ fractalArbol (n-1) t
           , Translate 0 70
             $ Rotate  (-200 * sin t / fromIntegral n)
             $ Scale      0.8 0.8
             $ fractalArbol (n-1) t ]

import Graphics.Gloss

main :: IO ()
main = animate (InWindow "Relojes animados" (1800,820) (90,90))
               black animacion

animacion :: Float -> Picture
animacion t = Color white
            $ Scale 110 110
            $ Rotate (t * 2*pi)
            $ fractalReloj 5 t

-- El fractal básico está formado por tres círculos desplazados desde el
-- origen de la siguiente manera.
--
--         1
--         |
--         .
--       /   \
--      2     3
--
-- El sentido de giro cambia a medida que aumenta n. Los componentes de
-- las iteraciones más altas también giran más rápido.

fractalReloj :: Int -> Float -> Picture
fractalReloj 0 _ = Blank
fractalReloj n s = Pictures [circ1, circ2, circ3, lineas] where
  a       = 1 / sin (2 * pi / 6)
  b       = a * cos (2 * pi / 6)
  n'      = fromIntegral n
  rot     = if even n
            then   50 * s * log (1 + n')
            else (-50 * s * log (1 + n'))
  circNm1 = Pictures [ circle 1
                     , Scale (a/2.5) (a/2.5) (fractalReloj (n-1) s)
                     , if n > 2
                       then Color cyan
                            $ Translate (-0.15) 1
                            $ Scale 0.001 0.001
                            $ Text (show s)
                       else Blank ]
  circ1   = Translate 0 a         $ Rotate rot    circNm1
  circ2   = Translate 1 (-b)      $ Rotate (-rot)         circNm1
  circ3   = Translate (-1) (-b)   $ Rotate rot    circNm1
  lineas  = Pictures [ Line [(0, 0), ( 0,  a)]
                     , Line [(0, 0), ( 1, -b)]
                     , Line [(0, 0), (-1, -b)] ]