Main.hs

module Main where
	
import Graphics.ChalkBoard as CB
--import Control.Applicative
import Data.Array
import System.Cmd
import System.Environment
import Graphics.ChalkBoard
--	(white,  black,  red,   green,  blue,  cyan,  purple,  yellow, RGB(..), RGBA(..))

import Graphics.ChalkBoard.CBIR as CBIR

-- A rather messy test, tries out various aspects of our compiler and render engine.

-- normal test
main = do
	args <- getArgs
	case args of
	  ["server"] -> do
		cb <- openChalkBoard [BoardSize 100 100]
		cbMain cb
	  _ -> startChalkBoard [BoardSize 100 100] $ cbMain

-- server test
--main = do cb <- openChalkBoard []
--          cbMain cb

colors :: [(O RGB,String)]
colors = zip 
	[white,  black,  red,   green,  blue,  cyan,  purple,  yellow]
	["white","black","red","green","blue","cyan","purple","yellow"]

cbMain cb = do

	-- first examples, pure colors.
	sequence_ [ do drawChalkBoard cb (boardOf col)
		       writeChalkBoard cb ("test1-" ++ nm ++ ".png")
		  | (col,nm) <- colors
		  ]

	-- load an image to use for rotations, etc.
	(x,y,imgBrd) <- readBoard ("images/cb-text.png")
	let xy = fromIntegral $ max x y
	let sc = 1 / xy
	let xd = fromIntegral x / xy
	let yd = fromIntegral y / xy
	let img = unAlpha <$> move (-0.5 * yd,-0.5 * xd)  (scale sc imgBrd)

	-- next, test basic shapes with rotations, scalings, etc.
        sequence_ [ do
	   	sequence_ [ do drawChalkBoard cb (scale n shape)
		               writeChalkBoard cb ("test2-scale-" ++ shape_name ++ "-" ++ show n ++ ".png")
	                  | n <- [1,0.5]
		          ]
	   	sequence_ [ do drawChalkBoard cb ((rotate r (scale 0.5 shape))
					 )
		               writeChalkBoard cb ("test2-rotate-" ++ shape_name ++ "-" ++ nm ++ ".png")
	             	  | (r,nm) <- zip
				[0,0.1,-0.1,pi/10,pi,2*pi]
				["0","0.1","neg0.1","pi_div10","pi","2pi"]
		          ]
	   	sequence_ [ do drawChalkBoard cb ((move (x,y) (scale 0.5 shape))
					 )
		               writeChalkBoard cb ("test2-move-" ++ shape_name ++ "-" ++ nmY ++ nmX ++ ".png")
	 	     	  | let amount = 0.25
		          , (x,nmX) <- [(-amount,"left"),(0,"center"),(amount,"right")]
	 	          , (y,nmY) <- [(amount,"top"),(0,"middle"),(-amount,"bottom")]
		          ]
		sequence_ [ do  drawChalkBoard cb ((scaleXY (x,y) shape)
					 )
		                writeChalkBoard cb ("test2-scaleXY-" ++ shape_name ++ "_" ++ nmX ++ "_" ++ nmY ++ "_.png")
			  | let ranges =  [(1,"1"),(0.5,"0.5"),(0.1,"0.1"),(-0.1,"neg0.1")]
			  , (x,nmX) <- ranges
			  , (y,nmY) <- ranges
			  ]
		sequence_ [ do  drawChalkBoard cb ((f (scale 0.5 shape))
					 )
		                writeChalkBoard cb ("test2-chain-" ++ shape_name ++ "-" ++ chain ++ ".png")
			  | let ranges =  [(1,"1"),(0.5,"0.5"),(0.1,"0.1"),(-0.1,"neg0.1")]
			  , (f,chain) <- [ (move (0.2,0.2) . rotate 1, "move-after-rot")
					 , (rotate 1 . move (0.2,0.2), "rot-after-move")
					 , (move (0.2,0.2) . scale 0.9, "move-after-scale")
					 , (scale 0.9 . move (0.2,0.2), "scale-after-move")
					 ]
			  ]
			
            | (shape,shape_name) <- [ (choose (red) (white) <$> square,"square")
				    , (choose (blue) (white) <$> circle,"circle")
				    , (img,"img")
				    , (choose (green) (white) <$> triangle (-0.5,-0.5) (0.5,-0.5) (0,0.5),"triangle")
				    ]
            ]

	-- load an image; display it.
	sequence_ [ do
		(x,y,imgBrd) <- readBoard ("images/" ++ nm)
		let xy = max x y
		drawChalkBoard cb (unAlpha <$> move (-0.5,-0.5) (scale (1/fromIntegral xy) imgBrd))
		writeChalkBoard cb $ "test3-image-load-" ++ nm ++ ".png"
	   | nm <- [ "cb-text.gif"
		   , "cb-text.jpg"
		   , "cb-text.png"
		   ] 
	   ]

	sequence_ [ do let r = move (0.26,0.15)  (choose (withAlpha a red) (transparent white) <$> circle)
	                   g = move (-0.26,0.15) (choose (withAlpha a green) (transparent white) <$> circle)
	                   b = move (0,-0.3)      (choose (withAlpha a blue) (transparent white) <$> circle)
		       drawChalkBoard cb (scale 0.5 (unAlpha <$> (r `over` b `over` g `over` boardOf (transparent white))))
		       writeChalkBoard cb $ "test4-" ++ show a ++  ".png"
		 | a <- [0,0.5,0.7,0.9,1]
		 ]

	-- These should be a single color,
	-- and not bleed through each other

	sequence_ [ do let r = move (0.26,0.15) circle
	                   g = move (-0.26,0.15) circle
	                   b = move (0,-0.3)    circle
		       drawChalkBoard cb (scale 0.5 (unAlpha <$> 
							(choose (withAlpha a green) (transparent white) <$>
							    (r `over` b `over` g))))
		       writeChalkBoard cb $ "test5-" ++ show a ++  ".png"
		 | a <- [0,0.5,0.7,0.9,1]
		 ]

-- This should show a single shape of overlap between the two snowmen.


	sequence_ [ do let rs0 = [ move (i * 0.26,j * 0.26) circle
			        | i <- [-1,1], j <- [-1,1]
			        ]
		       let rs = [ scale i b | (i,b) <- zip [1,0.9..] rs0 ]
		       drawChalkBoard cb (scale 0.5 (unAlpha <$> 
							((choose (withAlpha a green) 
								(transparent white) <$>
							    ((rs !! 0) `over` (rs !! 1))) `over`
							 (choose (withAlpha a red) 
								(transparent white) <$>
							    ((rs !! 2) `over` (rs !! 3))))))
		       writeChalkBoard cb $ "test6-" ++ show a ++  ".png"
		 | a <- [0,0.5,0.7,0.9,1]
		 ]

	exitChalkBoard cb