import Graphics.UI.Gtk as Gtk
import Graphics.Rendering.Cairo as Cairo
import Graphics.Rendering.Cairo.Matrix as Matrix
import Complex
import Data.IORef
import Monad

-- {{{1 data
-- 環境。
data Env	= Env
		{ envWindow :: Gtk.Window
		, envCanvas :: Gtk.DrawingArea
		, envTimes :: IORef Int		-- 写像適用回数
		, envPictIndex :: IORef Int	-- 図の種類
		}
-- 点はめんどいので複素数そのまま
type Pt		= Complex Double
-- 図 = 点のリスト
type Pict	= [Pt]
-- }}}1

-- {{{1 step :: [Pict -> Pict] -> [Pict] -> [Pict]
-- 写像の集合を、すべての図に適応する。
-- 写像適用。
step :: [Pt -> Pt] -> [Pict] -> [Pict]
step fs xs = [ map f x | f <- fs, x <- xs ]
-- }}}1

-- {{{1 deg :: Double -> Double
-- 弧度法からラジアンに変更する
deg :: Double -> Double
deg n = 2 * pi * n / 360

-- {{{1 cisDeg :: Double -> Complex Double
-- 弧度法から単位円上の点を得る。
cisDeg :: Double -> Complex Double
cisDeg = cis . deg

-- コッホ曲線
koch :: [[Pict]]
koch = iterate (step fs) k0
	where
		alpha :: Pt
		alpha = (cisDeg 30) / sqrt 3
		k0 :: [Pict]
		k0 = [ [ 0.0:+0.0, 1.0:+0.0, alpha ] ]
		f0 :: Pt -> Pt
		f0 z = alpha * (conjugate z)
		f1 :: Pt -> Pt
		f1 z = (conjugate alpha) * (conjugate z) + alpha
		fs :: [Pt -> Pt]
		fs = [f0, f1]

-- シェルピンスキーのギャスケット
sTri :: [[Pict]]
sTri = iterate (step fs) k0
	where
		k0 :: [Pict]
		k0 = (:[]) $ map (\n -> cisDeg $ 120 * n + 90) [0..2] -- 正三角形
		fn :: Double -> (Pt -> Pt)
		fn n = \z -> (z + (0:+1)) / 2 * (cisDeg $ 120 * n) -- 平行移動(+i)して、縮小(/2)して、回転(*cis 120n)
		fs :: [Pt -> Pt]
		fs = map fn [0..2]

-- メンガーのスポンジ
mRect :: [[Pict]]
mRect = iterate (step fs) k0
	where
		k0 :: [Pict]
		k0 = (:[]) $ map (\n -> cisDeg $ 90 * n + 45) [0..3] -- 正方形
		fn1 :: Double -> (Pt -> Pt)
		fn1 n = \z -> (z + (cisDeg $ 90 * n) * sqrt 2) / 3 -- 平行移動(+cis 90n...)して、縮小(/3)
		fn2 :: Double -> (Pt -> Pt)
		fn2 n = \z -> (z + (cisDeg $ 90 * n + 45) * 2) / 3 -- 平行移動(+cis 90n+45...)して、縮小(/3)
		fs = map fn1 [0..3] ++ map fn2 [0..3]


-- 六角形
hexes :: [[Pict]]
hexes = iterate (step fs) k0
	where
		k0 :: [Pict]
		k0 = (:[]) $ map (\n -> cisDeg $ 60 * n) [0..5] -- 正六角形
		fn :: Double-> (Pt -> Pt)
		fn n = \z -> (z + 2) / 3 * (cisDeg $ 60 * n) -- 平行移動(+2)して、縮小して(/3)、回転(*cis 60n)
		fs :: [Pt -> Pt]
		fs = ((/3):) $ map fn [0..5] -- 単純縮小(/3)と、六方向へ移動縮小(fn)

-- cross
cross :: [[Pict]]
cross = iterate (step fs) k0
	where
		k0 :: [Pict]
		k0 = [ [ 1:+1, 1:+(-1), (-1):+(-1), (-1):+1 ] ]
		f0 :: Pt -> Pt
		f0 z = z / 3
		f1 :: Pt -> Pt
		f1 z = z / 3 + ((2/3):+(0/3))
		f2 :: Pt -> Pt
		f2 z = z / 3 + ((-2/3):+(0/3))
		f3 :: Pt -> Pt
		f3 z = z / 3 + ((0/3):+(2/3))
		f4 :: Pt -> Pt
		f4 z = z / 3 + ((0/3):+(-2/3))
		fs :: [Pt -> Pt]
		fs = [f0,f1,f2,f3,f4]

pictures :: [[[Pict]]]
pictures = [ koch, mRect, sTri, cross, hexes ]

-- {{{1 main :: IO ()
-- main。
-- Envの作成とWindowの作成が終わったらイベントループへ。
main :: IO ()
main = do

	Gtk.initGUI

	window <- Gtk.windowNew
	canvas <- Gtk.drawingAreaNew
	times <- newIORef 0
	index <- newIORef 0

	let env = Env	{ envWindow = window
			, envCanvas = canvas
			, envTimes = times
			, envPictIndex = index
			}

	Gtk.widgetSetSizeRequest window 600 400
	Gtk.windowSetResizable window True

	Gtk.onDestroy window $ Gtk.mainQuit
	Gtk.onKeyPress window $ keyPress env
	Gtk.onExpose canvas $ const (updateCanvas env)

	Gtk.set window [Gtk.containerChild := canvas]
	Gtk.widgetShowAll window
	Gtk.mainGUI
-- }}}1

-- {{{1 updateCanvas :: Env -> IO Bool
-- 画面更新。
updateCanvas :: Env -> IO Bool
updateCanvas e	= do
	win <- Gtk.widgetGetDrawWindow (envCanvas e)
	(w,h) <- Gtk.widgetGetSize (envCanvas e)
	n <- readIORef (envTimes e)
	i <- liftM (`mod` length pictures) $ readIORef (envPictIndex e)
	Gtk.renderWithDrawable win $ do
		prologue w h
		renderIt $ (pictures !! i ) !! n
	Cairo.withImageSurface Cairo.FormatARGB32 512 512 $ \result -> do
		Cairo.renderWith result $ do
			prologue 512 512
			renderIt $ (pictures !! i) !! n
		Cairo.surfaceWriteToPNG result $ "frac.out." ++ show i ++ "." ++ show n ++ ".png"
	return True
-- }}}1

-- {{{1 prologue :: Int -> Int -> Render ()
-- 座標変換を行い、数学的に扱いやすい値でRenderできるようにする。
prologue :: Int -> Int -> Render ()
prologue wWidth wHeight = do
	let	xmax = 1.0
		xmin = -1.0
		ymax = 1.0
		ymin = -1.0
		width = xmax - xmin
		height = ymax - ymin
		scaleX = realToFrac wWidth / width
		scaleY = realToFrac wHeight / height
	Cairo.setLineWidth $ 1 / max scaleX scaleY
	Cairo.scale scaleX scaleY
	Cairo.translate (-xmin) (-ymin)
	Cairo.transform (Matrix.Matrix 1 0 0 (-1) 0 0)
-- }}}1

-- {{{1 renderIt :: [Pict] -> Render ()
-- リストの図を描く。
renderIt :: [Pict] -> Render ()
renderIt picts = do
	Cairo.save
	Cairo.setSourceRGBA 1.0 1.0 1.0 1.0
	Cairo.paint
	Cairo.setSourceRGBA 0.0 0.0 0.0 0.5
	mapM_ renderPicture picts
	Cairo.restore
-- }}}1

-- {{{1 renderPicture :: Pict -> Render ()
-- 図をRenderする。
renderPicture :: Pict -> Render ()
renderPicture (x:xs)	= do
	Cairo.save
	Cairo.moveTo (realPart x) (imagPart x)
	mapM_ (\y -> Cairo.lineTo (realPart y) (imagPart y)) xs
	Cairo.closePath
	Cairo.fill
	Cairo.restore
renderPicture _		= error "Picture must have 3 or over points."
-- }}}1

-- {{{1 keyPress :: Env -> Gtk.Event -> IO Bool
-- キー入力の処理。
-- q Esc で終了
-- Up で写像の適用回数をあげる。
-- Up で写像の適用回数をさげる。
keyPress :: Env -> Gtk.Event -> IO Bool
keyPress e (Key {eventKeyName = key})
	| key == "q"	|| key == "Escape"	= Gtk.widgetDestroy (envWindow e) >> return True
	| key == "Up"				= modifyIORef (envTimes e) (+1) >> updateCanvas e
	| key == "Down"				= modifyIORef (envTimes e) dec >> updateCanvas e
	| key == "Left"				= modifyIORef (envPictIndex e) (subtract 1) >> updateCanvas e
	| key == "Right"			= modifyIORef (envPictIndex e) (+ 1) >> updateCanvas e
	| otherwise				= putStrLn ("KeyPress: " ++ key) >> return True
		where	dec n			= if n <= 0 then 0 else n-1
keyPress _ _					= error "Why I got non-Key Event?"
-- }}}1