{-# LANGUAGE ForeignFunctionInterface #-} -- ChalkBoard Back End Example 1 -- August 2009 -- Kevin Matlage module Main where import Graphics.ChalkBoard import Graphics.ChalkBoard.CBIR import Graphics.ChalkBoard.OpenGL.CBBE import Control.Concurrent.MVar import Control.Concurrent import Foreign.Ptr (Ptr) import Foreign.C.Types (CUChar) import Graphics.ChalkBoard.Core -- TODO: remove, and fix with O main = do startChalkBoard [] main2 -- Will need to fork off a thread to pass more instructions to the mvar if we want animation -- Do we want an mvar for the board as well so that we can switch which board we are displaying? main2 :: ChalkBoard -> IO () main2 cb = do let ex = example1 let animation speed 100 _ = drawRawChalkBoard cb [Exit] animation speed count [] = drawRawChalkBoard cb [Exit] animation speed count (inst:insts) = do drawRawChalkBoard cb inst threadDelay speed animation speed (succ count) insts animation 0{-1000000-} 2 (fst ex) -- Hardcode example of some CBIR instructions -- The first instruction is *always* setting the the viewing board (??) example1:: ([[Inst BufferId]], BufferId) example1 = ( [[ Allocate 0 (sz,sz) RGBADepth (BackgroundRGBADepth (RGBA 1 1 1 1)) , Allocate 1 (sz,sz) RGBADepth (BackgroundRGBADepth (RGBA 0 0 1 0.6)) , Allocate 2 (sz,sz) RGBADepth (BackgroundRGBADepth (RGBA 0 1 1 0.6)) , Allocate 3 (sz,sz) RGBADepth (BackgroundRGBADepth (RGBA 0 1 0 0.6)) , Allocate 4 (sz,sz) RGBADepth (BackgroundRGBADepth (RGBA 1 0 1 0.6)) ]] ++ [ [ SplatTriangle ((i + j) `mod` 4 + 1) 0 (PointMap (1,1) (0.5,0.5)) (PointMap (1,1) (0.5 + scale * sin (fromIntegral j/10),0.5 + scale * cos (fromIntegral j/10))) (PointMap (1,1) (0.5 + scale * sin (fromIntegral j/8),0.5 + scale * cos (fromIntegral j/8))) | j <- [0..5000] ] | i <- [0..] ] , 0 ) where scale = 0.2 sz = 200 example2:: ([[Inst BufferId]], BufferId) example2 = ( [ Allocate 0 (500,500) RGBADepth (BackgroundG8Bit 0.8) , AllocateImage 2 "back.jpg" , Allocate 3 (1,1) RGBADepth (BackgroundG8Bit 0.8) , AllocateImage 6 "jhwk_RF_250px.gif" , SplatPolygon 3 0 [(PointMap (0,0) (0,0)), (PointMap (1,0) (1,0)), (PointMap (1,1) (1,1)), (PointMap (0,1) (0,1))] ] : [ [ SplatPolygon 2 0 [(PointMap (t0,t0) (0,0)), (PointMap (t1,t0) (1,0)), (PointMap (t1,t1) (1,1)), (PointMap (t0,t1) (0,1))] , SplatPolygon 6 0 [(PointMap (0,0) (0+x,0.5 - y)), (PointMap (0,1) (0 + x,1 - y)), (PointMap (1,1) (0.5 + x,1 - y)), (PointMap (1,0) (0.5 + x,0.5 - y))] ] | (x,y,z) <- zip3 (let t = take (50 * 5) [0,0.002..] in cycle (t ++ reverse t)) (let t = take (40 * 5) [0,0.0025..] in cycle (t ++ reverse t)) (let t = take (40 * 20) [0,0.00025..] in cycle (t ++ reverse t)) , let t0 = z , let t1 = 1 - z ] , 0 ) example3 :: ([[Inst BufferId]], BufferId) example3 = ( [[ AllocateImage 1 "back.jpg" , Allocate 2 (300,300) RGBADepth (BackgroundRGBADepth (RGBA 1 1 1 1)) , SplatPolygon 1 2 [(PointMap (0,0) (0,0)), (PointMap (1,0) (1,0)), (PointMap (1,1) (1,1)), (PointMap (0,1) (0,1))] , SplatColor (RGBA 0 0 0 1) 2 True [(0.15,0.15), (0.145,0.145), (0.145,0.855), (0.15,0.85)] , SplatColor (RGBA 0 0 0 1) 2 True [(0.15,0.85), (0.145,0.855), (0.855,0.855), (0.85,0.85)] , SplatColor (RGBA 0 0 0 1) 2 True [(0.85,0.85), (0.855,0.855), (0.855,0.85), (0.8535,0.8465), (0.1535,0.1465), (0.15,0.145), (0.145,0.145), (0.15,0.15)] , SaveImage 2 "TestImage1.bmp" , Allocate 3 (300,300) RGBADepth (BackgroundRGBADepth (RGBA 0.9 0 0 1)) , Allocate 0 (300,300) RGBADepth (BackgroundRGBADepth (RGBA 0 0 0 0.5)) ]] ++ [[ SplatColor (RGBA 0 0 0.9 1) 3 True [(x0,t0), (x1,t0), (x1,t1), (x0,t1)] | t0 <- [0,0.1..0.9], let t1 = t0+0.1, x0 <- if ((round (t1*10))`mod`2==0) then [0,0.2..0.8] else [0.1,0.3..0.9], let x1 = x0+0.1 ]] ++ [[ --, SplatPolygon 1 3 [(PointMap (0.25,0.25) (0.25,0.75)), (PointMap (0.25,0.75) (0.75,0.75)), (PointMap (0.75,0.75) (0.25,0.75))] -- to flip it SplatPolygon 1 3 [(PointMap (0.15,0.15) (0.85,0.85)), (PointMap (0.15,0.85) (0.85,0.15)), (PointMap (0.85,0.85) (0.15,0.15))] , SplatColor (RGBA 0 0 0 1) 3 True [(0.85,0.85), (0.855,0.855), (0.855,0.145), (0.85,0.15)] , SplatColor (RGBA 0 0 0 1) 3 True [(0.85,0.15), (0.855,0.145), (0.145,0.145), (0.15,0.15)] , SplatColor (RGBA 0 0 0 1) 3 True [(0.15,0.15), (0.145,0.145), (0.145,0.15), (0.1465,0.1535), (0.8465,0.8535), (0.85,0.855), (0.855,0.855), (0.85,0.85)] , SaveImage 3 "TestImage2.bmp" , CopyBuffer WithDestAlpha 3 0 , SaveImage 0 "TestImage3.bmp" , SplatBuffer 0 0 , SaveImage 0 "TestImage0.bmp" ]] , 0 ) --foreign import ccall "&" myptr :: Ptr CUChar