{-# LANGUAGE NoMonomorphismRestriction #-}

import Graphics.UI.SDL as SDL
 
(xRes, yRes) = (1366, 768)
(a, b)       = (1.4, 0.3)

main = withInit [InitVideo] $ do
  w <- setVideoMode xRes yRes 32 [NoFrame]
  s <- createRGBSurface [] 1 1 32 0 0 0 0
  fillRect s Nothing $ Pixel 0xFFFFFF
  enableEvent SDLMouseMotion False
  setCaption "Hénon" "Hénon"
  render w s henon
  SDL.flip w
  run w

run w = do
  e <- pollEvent
  delay 64
  case e of
   KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
   _                              -> run w

render w s = mapM_ draw
 where
  rect (x,y) = Just $ Rect (round x) (round y) 1 1
  g (x,y)    = (500*x + xRes / 2, 900*y + yRes / 2)
  draw (x,y) = blitSurface s Nothing w $ rect $ g (x,y)

henon = take 99999 $ filter g $ iterate f (0,0)
 where
  f (x,y) = (1 - a*x^2 + y, b*x)
  g (x,y) = -1.5 < x && x < 1.5 && -0.45 < y && y < 0.45