lambda-canvas (empty) → 0.1

raw patch · 4 files changed

+123/−0 lines, 4 filesdep +GLUTdep +OpenGLdep +basesetup-changed

Dependencies added: GLUT, OpenGL, base, mtl, time

Files

• LICENSE +19/−0
• Setup.lhs +4/−0
• lambda-canvas.cabal +32/−0
• src/Graphics/LambdaCanvas.hs +68/−0

@@ -0,0 +1,19 @@+Copyright (c) 2012 Dimitry Solovyov++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,32 @@+name:                lambda-canvas+version:             0.1+synopsis:            Educational drawing canvas for FP explorers.+description:         This package is an experimental teaching tool that+                     provides the foundation for presenting functional+                     idioms with graphical metaphors. The OpenGL canvas+                     boilerplate is abstracted away to a simple interface,+                     which allows to focus on program logic instead of the+                     graphics API. It's also arguably fun.+license:             MIT+license-file:        LICENSE+author:              Dimitry Solovyov <dimituri@gmail.com>+maintainer:          Dimitry Solovyov <dimituri@gmail.com>+category:            Education, Graphics+build-type:          Simple+cabal-version:       >= 1.8++library+  hs-source-dirs:      src+  exposed-modules:     Graphics.LambdaCanvas++  build-depends: base   >= 4 && < 5+               , GLUT   == 2.3.0.*+               , mtl    == 2.1.*+               , OpenGL == 2.5.*+               , time   == 1.4.*++  ghc-options: -Wall -funbox-strict-fields++source-repository head+  type:     git+  location: git://github.com/dimituri/lambda-canvas.git

@@ -0,0 +1,68 @@+module Graphics.LambdaCanvas+(+-- * Drawing types+  Point+, Graphics.Rendering.OpenGL.PrimitiveMode(..)+-- * Drawing functions+, animate+, draw+, put+-- * Utility functions+, stepOf+) where++import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)+import Graphics.Rendering.OpenGL+import Graphics.UI.GLUT hiding (initialize)++type Point = (GLfloat, GLfloat)++vertex2 :: Point -> IO ()+vertex2 (x, y) = vertex $ Vertex2 x y++-- | Draw a primitive from a set of a vertices on screen.+put :: PrimitiveMode -> [Point] -> IO ()+put mode pts = renderPrimitive mode $ mapM_ vertex2 pts++initialize :: String -> IO ()+initialize title = do+    _ <- getArgsAndInitialize+    initialWindowSize $= Size 500 500+    initialDisplayMode $= [DoubleBuffered, WithAlphaComponent]+    _ <- createWindow title+    reshapeCallback $= Just reshape++-- | Create a canvas suitable for drawing a static picture.+-- The drawing block is invoked on each redisplay.+draw :: String -> IO () -> IO ()+draw title actions = do+    initialize title+    displayCallback $= do+      clear [ColorBuffer]+      actions+      swapBuffers+    mainLoop++-- | Create a canvas suitable for animation.+-- The drawing block is invoked on each redisplay+-- and is passed the current timestamp.+animate :: String -> (POSIXTime -> IO ()) -> IO ()+animate title actions = do+    initialize title+    displayCallback $= do+      clear [ColorBuffer]+      time <- getPOSIXTime+      actions time+      swapBuffers+    idleCallback $= Just (postRedisplay Nothing)+    mainLoop++reshape :: Size -> IO ()+reshape size = do+    viewport $= (Position 0 0, size)+    postRedisplay Nothing++-- | Given an amount of steps and a timestamp, calculate current step number.+-- Step numbers begin with 0.+stepOf :: Num a => Integer -> POSIXTime -> a+stepOf total = fromIntegral . (`mod` total) . truncate . (*1000)