Menu
▾
▴
[Gtk2hs-commit] Add several soe demos
|
From: Duncan C. <dun...@wo...> - 2007-06-28 17:18:21
|
Thu Jun 28 10:15:53 PDT 2007 Duncan Coutts <du...@ha...>
* Add several soe demos
adddir ./demo/soe
hunk ./Makefile.am 1737
- demo/graphic demo/unicode
+ demo/graphic demo/unicode demo/soe
hunk ./Makefile.am 1742
-DEMOS += demo/glade demo/calc
+DEMOS += demo/glade demo/calc demo/noughty
hunk ./Makefile.am 1819
- demo/svg/Makefile demo/svg/Svg2Png.hs demo/svg/SvgViewer.hs
+ demo/svg/Makefile demo/svg/Svg2Png.hs demo/svg/SvgViewer.hs \
+ demo/soe/BouncingBall.hs demo/soe/Demo1.hs demo/soe/Demo2.hs \
+ demo/soe/Snowflake.hs demo/soe/Makefile
+
addfile ./demo/soe/BouncingBall.hs
hunk ./demo/soe/BouncingBall.hs 1
+{- Written by Antti-Juhani Kaijanaho.
+ You may treat this file as if it were in the public domain.
+-}
+module Main where
+
+import Graphics.SOE.Gtk
+
+main = runGraphics $
+ do w <- openWindowEx "Bouncing Ball" (Just (800,800)) (Just (200, 600)) drawBufferedGraphic (Just 30)
+ let loop x y xd yd
+ = do setGraphic w $ withColor Yellow $
+ ellipse (x-5,y-5) (x+5,y+5)
+ (xmax, ymax) <- getWindowSize w
+ let x' = x + xd + 5
+ y' = y + yd + 5
+ xd' | x' >= xmax || x' < 0 = -xd
+ | otherwise = xd
+ yd' | y' >= ymax || y' < 0 = -yd
+ | otherwise = yd
+ x'' = x + xd'
+ y'' = y + yd'
+ x''' | x'' + 5 > xmax = xmax `div` 2
+ | otherwise = x''
+ y''' | y'' + 5 > ymax = ymax `div` 2
+ | otherwise = y''
+ e <- maybeGetWindowEvent w
+ case e of Just Closed -> return ()
+ _ -> do getWindowTick w
+ loop x''' y''' xd' yd'
+ loop 300 100 5 5
+
addfile ./demo/soe/Demo1.hs
hunk ./demo/soe/Demo1.hs 1
+{- Written by Antti-Juhani Kaijanaho.
+ You may treat this file as if it were in the public domain.
+-}
+module Main where
+
+import Graphics.SOE.Gtk
+
+main = runGraphics $ do w <- openWindow "Testing" (200, 200)
+ drawInWindow w $ text (100,100) "Hello"
+ drawInWindow w $ line (50, 50) (75, 75)
+ drawInWindow w $ withColor White $ polyline [(10,10), (10,40), (20,20)]
+ drawInWindow w $ polygon [(60,60), (60,90), (80,90)]
+ drawInWindow w $ withColor Yellow $
+ ellipse (290, 190) (150, 150)
+ drawInWindow w $ arc (20,190) (90,130) (45) (390)
+ drawInWindow w $ withColor Blue $ line (20,190) (90,130)
+ drawInWindow w $ withColor Yellow $
+ shearEllipse (140, 10) (160, 90) (190, 50)
+ loopEvents w
+ closeWindow w
+
+loopEvents w = loop
+ where loop = do e <- getWindowEvent w
+ case e of Closed -> return ()
+ _ -> loop
addfile ./demo/soe/Demo2.hs
hunk ./demo/soe/Demo2.hs 1
+{- Written by Antti-Juhani Kaijanaho.
+ You may treat this file as if it were in the public domain.
+-}
+module Main where
+
+import Graphics.SOE.Gtk
+
+main = runGraphics $ do w <- openWindow "Testing" (200, 200)
+ drawInWindow w $ text (10,180) "Hello"
+ drawInWindow w $ withColor Blue $
+ polyline [(20,20), (20,150), (150,150), (150,20), (20,20)]
+ let region = createRectangle (20,20) (100,100)
+ `orRegion` createRectangle (50,50) (150,150)
+ `diffRegion` createRectangle (100,100) (150,150)
+ drawInWindow w $ withColor Blue $
+ polyline [(20,20), (20,100), (100,100), (100,20), (20,20)]
+ drawInWindow w $ withColor Blue $
+ polyline [(50,50), (50,150), (150,150), (150,50), (50,50)]
+ drawInWindow w $ withColor Green $ drawRegion region
+ loopEvents w
+ closeWindow w
+
+loopEvents w = loop
+ where loop = do e <- getWindowEvent w
+ case e of Closed -> return ()
+ _ -> loop
addfile ./demo/soe/Makefile
hunk ./demo/soe/Makefile 1
+
+PROGS = bouncingball snowflake demo1 demo2
+
+SOURCES = BouncingBall.hs Demo1.hs Demo2.hs Snowflake.hs
+PACKAGES = gtk soegtk
+
+all : $(PROGS)
+
+bouncingball : BouncingBall.hs
+ $(HC_RULE)
+
+snowflake : Snowflake.hs
+ $(HC_RULE)
+
+demo1 : Demo1.hs
+ $(HC_RULE)
+
+demo2 : Demo2.hs
+ $(HC_RULE)
+
+HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) $(HCEXTRAFLAGS)
+
+HCEXTRAFLAGS = $(if $(HCNEEDSPACKAGE), $(addprefix -package ,$(PACKAGES)))
+
+clean:
+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS)
+
+HC=ghc
addfile ./demo/soe/Snowflake.hs
hunk ./demo/soe/Snowflake.hs 1
+module Main where
+
+import Graphics.SOE.Gtk
+
+type Vector = (Double, Double)
+
+(<+>) :: Vector -> Vector -> Vector
+(a, b) <+> (c, d) = (a+c, b+d)
+
+(<->) :: Vector -> Vector -> Vector
+(a, b) <-> (c, d) = (a-c, b-d)
+
+(.*) :: Double -> Vector -> Vector
+k .* (a, b) = (k * a, k * b)
+
+(*.) :: Vector -> Double -> Vector
+(*.) = flip (.*)
+
+(<*>) :: Vector -> Vector -> Double
+(a, b) <*> (c, d) = a * c + b * d
+
+norm :: Vector -> Double
+norm v = sqrt (v <*> v)
+
+dist :: Vector -> Vector -> Double
+dist v1 v2 = norm (v1 <-> v2)
+
+xunit :: Vector
+xunit = (1, 0)
+
+yunit :: Vector
+yunit = (0,1)
+
+ortho :: Vector -> Vector
+ortho v@(a, b) = (m11*a + m12*b, m21*a+m22*b)
+ where m11 = cos ang
+ m12 = sin ang
+ m21 = -sin ang
+ m22 = cos ang
+ ang = pi/2
+
+
+type Line = (Vector, Vector)
+
+gen :: [Line] -> [Line]
+gen [] = []
+gen (l@(v1,v2):ls)
+ | dist v1 v2 < 3 = l : gen ls
+ | otherwise = let dir = v1 <-> v2
+ ort = ortho dir
+ p = v2 <+> ((1/3) .* dir)
+ q = v2 <+> ((2/3) .* dir)
+ r = v2 <+> (0.5 .* dir) <+> ((1/3) .* ort)
+ s = v2 <+> (0.5 .* dir) <+> ((-1/3) .* ort)
+ in --(v2,p) : (q,v1) : gen ((p,r) : (q,r) : (p,s) : (q,s) : ls)
+ gen ((v2,p) : (q,v1) : (p,r) : (q,r) : (p,s) : (q,s) : ls)
+ -- kauniimpi kuva (mutta teht[_\c3_][_\a4_]v[_\c3_][_\a4_]nannon vastainen) tulee
+ -- korvaamalla edellinen lauseke seuraavalla:
+ -- gen ((v2,p) : (q,v1) : (p,r) : (q,r) : (p,s) : (q,s) : ls)
+
+draw :: [Line] -> Graphic
+draw [] = emptyGraphic
+draw ((p1,p2):ls) = overGraphic (line (f p1) (f p2)) (draw ls)
+ where f (x,y) = (round (x), round (y))
+
+test = runGraphics $ do w <- openWindow "T 3.7-8" (200, 200)
+ loop w
+ closeWindow w
+ where loop w = do (xmax', ymax') <- getWindowSize w
+ let xmax = fromIntegral xmax'
+ ymax = fromIntegral ymax'
+ ls = gen [((1/8 * xmax, 1/2 * ymax),
+ (7/8 * xmax, 1/2 * ymax))]
+ setGraphic w (draw ls)
+ e <- getWindowEvent w
+ case e of Resize -> loop w
+ _ -> return ()
+
+main = test
|