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 |
From: Duncan C. <dun...@wo...> - 2007-06-28 17:24:55
|
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 |