blank-canvas-0.6: wiki-suite/Square.hs

{-# LANGUAGE OverloadedStrings #-}
module Square where

import Graphics.Blank
import Wiki -- (512,512)

main :: IO ()
main = blankCanvas 3000 { events = ["mousedown"] } $ \ context -> do
          let loop (x,y) (color:colors) = do
                send context $ saveRestore $ do
                        translate (x,y)
                        beginPath()
                        moveTo(-100,-100)
                        lineTo(-100,100)
                        lineTo(100,100)
                        lineTo(100,-100)
                        closePath()
                        lineWidth 10
                        strokeStyle color
                        stroke()


                wiki $ counter (\ _ -> True) $ \ n -> do
                    file <- wiki $ anim_png "Square"
                    wiki $ snapShot context $ file
                    let e (x',y') = wiki $ send context $ trigger $ Event {
                        eMetaKey = False
                      , ePageXY = return (x',y')
                      , eType = "mousedown"
                      , eWhich = Nothing
                    }
                    wiki $ whenM (n == 1) $ e (x-100,y+50)
                    wiki $ whenM (n == 2) $ e (x+20, y-60)
                    wiki $ whenM (n == 3) $ e (x+40, y+20)
                    wiki $ whenM (n == 4) $ e (x+60, y-60)
                    wiki $ whenM (n >= 5) $ do { build_anim "Square" 100; close context }

                event <- wait context
                case ePageXY event of
                        Nothing -> loop (x,y) colors
                        Just (x',y') -> loop (x',y') colors

          putStrLn "calling size"                
          loop (width context / 2,height context / 2)
               (cycle [ "#749871", "#1887f2", "#808080", "f01234"])