hgl-example 0.0.1 → 0.0.2
raw patch · 6 files changed
+112/−241 lines, 6 filesdep +utility-htdep ~arraydep ~base
Dependencies added: utility-ht
Dependency ranges changed: array, base
Files
- Makefile +8/−0
- demo.readme +30/−0
- hgl-example.cabal +9/−3
- src/GraphicDemo.hs +0/−222
- src/Main.hs +29/−16
- src/Sierpinski.hs +36/−0
+ Makefile view
@@ -0,0 +1,8 @@+ghci:+ ghci +RTS -M64m -c30 -RTS -Wall -i:src src/Main.hs++demo:+ hgl-example rotating-spiral rotating-lissajous stars star-circle `seq -f 'locomotive-%g' 0 3`++record:+ recordmydesktop -x 1 -y 1 --width 500 --height 530 --no-sound
+ demo.readme view
@@ -0,0 +1,30 @@+Haskell animation demo++Some small animations using the HGL package+showing rotating spiral, stars and Lissajous curves+and finally some locomotives with strange wheels.++For installation run+$ cabal install hgl-example-0.0.1++You need to have my math utility package installed,+which is so experimental that I didn't upload it to Hackage, so far.++$ darcs get http://darcs.haskell.org/htam/+$ (cd htam; cabal install)+++The demo is started by++$ hgl-example rotating-spiral rotating-lissajous stars star-circle `seq -f 'locomotive-%g' 0 3`++See also the Makefile.++For more information on the Haskell programming language,+see http://www.haskell.org/ .++++Tags: Haskell, Functional Programming, Animation++Kategorie: Film und Animation
hgl-example.cabal view
@@ -1,5 +1,5 @@ Name: hgl-example-Version: 0.0.1+Version: 0.0.2 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -24,16 +24,22 @@ Cabal-Version: >=1.2 Build-Type: Simple +Extra-Source-Files:+ Makefile+ demo.readme+ Executable hgl-example Build-Depends: HTam >=0.0.2 && <0.1, HGL >=3.2 && <3.3,+ utility-ht >=0.0.1 && <0.1, random >=1.0 && <1.1,- array >=0.1 && <0.3,- base >= 3+ array >=0.1 && <0.6,+ base >= 3 && <5 GHC-Options: -Wall Hs-Source-Dirs: src Main-Is: Main.hs Other-Modules:+ Sierpinski GraphicDemo
src/GraphicDemo.hs view
@@ -1,18 +1,5 @@- module GraphicDemo where -{-- hugs GraphicDemo--}--{-- hugs-- :load Graphics.HGL.Utils-- :browse Graphics.HGL.Utils--}- import Graphics.HGL.Units (Time, Point, Size, ) import Graphics.HGL.Draw.Monad (Graphic, ) import Graphics.HGL.Utils@@ -22,13 +9,8 @@ import Graphics.HGL.Window import Graphics.HGL.Run -import System.Random (RandomGen, randomRs, mkStdGen, )-import Data.Array (listArray, bounds, (!), )- import Control.Exception (bracket, ) -import qualified Numerics.ZeroFinder.Newton as Newton- import Prelude hiding ((^), ) import qualified Prelude as P @@ -181,207 +163,3 @@ (map (stern (-phase)) (kreispunkte (250, 250) 150 7 phase (2*pi/7)))) [0,0.02..])--polygonMove :: Num a => (a,a) -> [(a,a)] -> [(a,a)]-polygonMove (dx,dy) = map (\(x,y) -> (x+dx,y+dy))--polygonTurn :: Floating a => a -> [(a,a)] -> [(a,a)]-polygonTurn angle =- polygonOrtho (cos angle, sin angle)--polygonOrtho :: Num a => (a,a) -> [(a,a)] -> [(a,a)]-polygonOrtho (rx,ry) =- map (\(x,y) -> (x*rx-y*ry,x*ry+y*rx))--norm :: Floating a => (a,a) -> a-norm (x,y) = sqrt (x^2+y^2)--normalize :: Floating a => (a,a) -> (a,a)-normalize (x,y) =- let n = norm (x,y)- in (x/n, y/n)--lok :: Num a => [(a,a)]-lok =- [( 0, 0), ( 0,130), ( 80,130), ( 80,70),- ( 20,70), ( 20,110), ( 60,110), ( 60,70),- (170,70), (165,120), (185,120), (180,70),- (190,70), (200, 0), ( 0, 0)]--lok' :: Num a => [(a,a)]-lok' =- [( 0, 0), ( 0,130), ( 80,130), ( 80,70),- ( 20,70), ( 20,110), ( 60,110), ( 60,70),- (170,70), (165,120), (185,120), (180,70),- (190,70), (200, 0),- (155, 0), (150, 10), (145, 0),- ( 55, 0), ( 50, 10), ( 45, 0),- ( 0, 0)]--flipY :: Num a => [(a,a)] -> [(a,a)]-flipY = map (\(dx,dy) -> (dx,-dy))--wagenAnim :: IO ()-wagenAnim =- testAnim 20- (map (\zeit ->- let (pos, dreh) = properFraction (zeit::Double)- angle = dreh * pi/2- laenge = 50- dx = round (laenge * sin angle)- dy = round (laenge * cos angle)- dx2 = round (laenge/sqrt 2 * sin (angle-pi/4))- dy2 = round (laenge/sqrt 2 * cos (angle-pi/4))- x = pos * round laenge- y = 300- quadrat (mx,my) =- polyline [(mx, my), (mx+dx, my-dy),- (mx+dx-dy, my-dx-dy), (mx-dy, my-dx),- (mx, my)]- wanne m =- polygon (polygonMove m (flipY lok))- in overGraphics [quadrat (x-100,y), quadrat (x,y),- wanne (x + dx2-150, y - dy2)])- [0,0.025..])--circle, circleFill, circleFill' :: Int -> Point -> Graphic-circle = circlePoly 20 0-circleFill' r (x,y) = arc (x-r,y-r) (x+r,y+r) 0 270-circleFill r (x,y) = ellipse (x-r,y-r) (x+r,y+r)--circlePoly :: Int -> Double -> Int -> Point -> Graphic-circlePoly n angle r (x,y) =- polyline (map roundPoint- (kreispunkte (fromIntegral x, fromIntegral y)- (fromIntegral r) (n+1) angle (2*pi/fromIntegral n)))--wheel :: Double -> Double -> (Double, Double) -> Graphic-wheel radius angle (xd,yd) =- let dx = round (radius * sin angle)- dy = round (radius * cos angle)- x = round xd- y = round yd- in overGraphics [circlePoly 20 angle (round radius) (x,y),- polyline [(x-dx,y+dy),(x+dx,y-dy)],- polyline [(x-dy,y-dx),(x+dy,y+dx)]]--holperAnim0 :: IO ()-holperAnim0 =- testAnim 5- (map (\zeit ->- let radius = 25- mount = 10- wheelDist = 100- angle = zeit * pi/2- mx = mount * sin angle- my = mount * cos angle- x = angle * radius- y = 300- wanne m = polygon (polygonMove m (flipY lok))- in overGraphics [wheel radius angle (x,y),- wheel radius angle (x-wheelDist,y),- wanne (round (x+mx - 150), round (y-my))])- [0,0.025..])--holperAnim1 :: IO ()-holperAnim1 =- testAnim 5- (map (\zeit ->- let radius = 25- mount = 15- angle = zeit * pi/2- mx = mount * sin angle- my = mount * cos angle- x = angle * radius- y = 300- xLW = x+mx-wheelDistX- angleLW = xLW / radius- wheelDist = 100- wheelDistX = sqrt(wheelDist^2 - my^2)- wanne m = polygon (map roundPoint (polygonMove m (flipY- (polygonOrtho (normalize (wheelDistX,my))- (polygonMove (-150,0) lok)))))- in overGraphics [wheel radius angle (x, y),- wheel radius angleLW (xLW,y),- wanne (x+mx, y-my)])- [0,0.025..])---{- Inverse cycloid function. -}-cycloidAngle :: Floating a => a -> a -> a -> a -> (a,a) -> [a]-cycloidAngle t0 radius mount d (x,y) =- let f t = let ct = cos t- st = sin t- xt = radius * t + mount * ct - x- yt = mount * st - y- in (xt^2+yt^2,- 2 * (xt * (radius - mount * st) + yt * mount * ct))- in Newton.inverse t0 f (d^2)--propCycloidAngle :: Floating a => a -> a -> (a,a) -> ((a,a), (a,a))-propCycloidAngle radius d (x,y) =- let sq = sqrt (d^2-y^2)- t0 = (x - sq) / radius- t1 = (x + sq) / radius- in ((t0, cycloidAngle (2*t0) radius 0 d (x,y) !! 10),- (t1, cycloidAngle (2*t1) radius 0 d (x,y) !! 10))---holperAnim :: IO ()-holperAnim =- testAnim 5- (map (\zeit ->- let radiusRW = 25- radiusLW = 35- mountRW = 15- mountLW = 20- yRW = 300- yLW = yRW-radiusLW+radiusRW- angleRW = zeit * pi/2- dxRW = mountRW * cos angleRW- dyRW = mountRW * sin angleRW- dxLW = mountLW * cos angleLW- dyLW = mountLW * sin angleLW-- wheelDist = 100- angleLW =- cycloidAngle- ((xRW-wheelDist)/radiusLW) radiusLW mountLW- wheelDist (xRW+dxRW,dyRW+yRW-yLW) !! 10- xLW = angleLW * radiusLW- xRW = angleRW * radiusRW- wanne m = polygon (map roundPoint (polygonMove m (flipY- (polygonOrtho- (normalize (xRW+dxRW-(xLW+dxLW),- -(yRW+dyRW)+(yLW+dyLW)))- (polygonMove (-150,0) lok)))))- in overGraphics [wheel radiusRW angleRW (xRW,yRW),- wheel radiusLW angleLW (xLW,yLW),- wanne (xRW+dxRW, yRW+dyRW)])- [0,0.025..])----{- |-probabilistic Sierpinski triangle--See Computer Graphics I lecture at the university of Halle.--}-sierpinskiPoints :: (Fractional a, RandomGen g) =>- g -> ((a,a), (a,a), (a,a)) -> [(a,a)]-sierpinskiPoints g (t0,t1,t2) =- let vertices = listArray (0,2::Int) [t0,t1,t2]- in scanl1 (\(xt,yt) (xk,yk) -> ((xt+xk)/2, (yt+yk)/2))- (map (vertices!) (randomRs (bounds vertices) g))--sierpinski :: IO ()-sierpinski =- let ps = ((0, 0), (1, 0), (0.5, sqrt 3 / 2))- size = 1000- toInt :: Double -> Int- toInt x = round (x * fromIntegral size)- setDot p = polyline [p, p]- graphics = map (\(x,y) -> setDot (toInt x, toInt y))- (sierpinskiPoints (mkStdGen 834750) ps)- in runWindow "Sierpinski" (size,size)- (\w -> mapM_ (directDraw w) graphics)
src/Main.hs view
@@ -1,6 +1,19 @@+{-+ hugs -P:src src/Main.hs+-}++{-+ hugs++ :load Graphics.HGL.Utils++ :browse Graphics.HGL.Utils+-} module Main where -import GraphicDemo as G+import qualified GraphicDemo as G+import qualified Sierpinski as S+import qualified Locomotive as L import System.Environment (getArgs, ) import System.Exit (exitWith, ExitCode(..), )@@ -9,21 +22,21 @@ demos :: [(String, IO ())] demos =- ("text", textAnim) :- ("triangle", dreieck) :- ("17angle", siebzehneck) :- ("spiral", spirale) :- ("double-spiral", doppelSpirale) :- ("rotating-spiral", spiraleAnim) :- ("lissajous", lissajous) :- ("rotating-lissajous", lissajousAnim) :- ("rotating-star", sternAnim) :- ("star-circle", sternenkreisAnim) :- ("locomotive-0", wagenAnim) :- ("locomotive-1", holperAnim0) :- ("locomotive-2", holperAnim1) :- ("locomotive-3", holperAnim) :- ("sierpinski", sierpinski) :+ ("text", G.textAnim) :+ ("triangle", G.dreieck) :+ ("17angle", G.siebzehneck) :+ ("spiral", G.spirale) :+ ("double-spiral", G.doppelSpirale) :+ ("rotating-spiral", G.spiraleAnim) :+ ("lissajous", G.lissajous) :+ ("rotating-lissajous", G.lissajousAnim) :+ ("rotating-star", G.sternAnim) :+ ("star-circle", G.sternenkreisAnim) :+ ("locomotive-0", L.squareWheelAnim) :+ ("locomotive-1", L.acentricAnim) :+ ("locomotive-2", L.asymmetricAnim) :+ ("locomotive-3", L.bigSmallAnim) :+ ("sierpinski", S.demo) : []
+ src/Sierpinski.hs view
@@ -0,0 +1,36 @@+{- |+probabilistic Sierpinski triangle++See Computer Graphics I lecture at the university of Halle.+-}+module Sierpinski (demo, ) where++import Graphics.HGL.Utils (runWindow, )+import Graphics.HGL.Draw.Picture (polyline, )+import Graphics.HGL.Window (directDraw, )++import System.Random (RandomGen, randomRs, mkStdGen, )+import Data.Array (listArray, bounds, (!), )++import Data.Tuple.HT (mapPair, )+++points :: (Fractional a, RandomGen g) =>+ g -> ((a,a), (a,a), (a,a)) -> [(a,a)]+points g (t0,t1,t2) =+ let vertices = listArray (0,2::Int) [t0,t1,t2]+ in scanl1 (\(xt,yt) (xk,yk) -> ((xt+xk)/2, (yt+yk)/2))+ (map (vertices!) (randomRs (bounds vertices) g))++demo :: IO ()+demo =+ let size = 1000+ toInt :: Double -> Int+ toInt x = round (x * fromIntegral size)+ setDot p = polyline [p, p]+ graphics =+ map (setDot . mapPair (toInt, toInt)) $+ points (mkStdGen 834750) $+ ((0, 0), (1, 0), (0.5, sqrt 3 / 2))+ in runWindow "Sierpinski" (size,size)+ (\w -> mapM_ (directDraw w) graphics)