├── .gitignore ├── ChangeLog.md ├── LICENSE ├── Makefile ├── README.md ├── Setup.hs ├── examples ├── Control │ ├── Conditionals1.hs │ ├── Conditionals2.hs │ ├── EmbeddedIteration.hs │ ├── Iteration.hs │ └── LogicalOperators.hs ├── Data │ ├── CharsAndStrings.hs │ ├── DatatypeConversion.hs │ ├── FreeSans.ttf │ ├── IntegersAndFloats.hs │ ├── TrueAndFalse.hs │ └── Variables.hs ├── Form │ ├── Bezier.hs │ ├── PieChart.hs │ ├── PlatonicShapes.hs │ ├── PointsAndLines.hs │ ├── RegularPolygon.hs │ ├── ShapePrimitives.hs │ ├── Sphere.hs │ ├── Star.hs │ └── TriangleStrip.hs ├── Input │ ├── Clock.hs │ ├── Constrain.hs │ ├── Easing.hs │ ├── Keyboard.hs │ ├── KeyboardFunctions.hs │ ├── Milliseconds.hs │ ├── Mouse1D.hs │ ├── Mouse2D.hs │ ├── MouseFunctions.hs │ ├── MousePress.hs │ ├── MouseSignals.hs │ └── StoringInput.hs ├── Math │ ├── AdditiveWave.hs │ ├── Arctangent.hs │ ├── Distance1D.hs │ ├── Distance2D.hs │ ├── DoubleRandom.hs │ ├── Graphing2D.hs │ ├── IncrementDecrement.hs │ ├── Interpolate.hs │ ├── Map.hs │ ├── Noise1D.hs │ ├── Noise2D.hs │ ├── Noise3D.hs │ ├── NoiseWave.hs │ ├── PolarToCortesian.hs │ ├── Random.hs │ ├── RandomGaussian.hs │ ├── Sine.hs │ ├── SineCosine.hs │ └── SineWave.hs ├── Structure │ ├── Coordinates.hs │ ├── CreateGraphics.hs │ ├── Functions.hs │ ├── Loop.hs │ ├── NoLoop.hs │ ├── Recursion.hs │ ├── Redraw.hs │ ├── SetupAndDraw.hs │ ├── StatementsAndComments.hs │ └── WidthAndHeight.hs └── Transform │ ├── Arm.hs │ ├── Rotate.hs │ ├── Scale.hs │ └── Translate.hs ├── goodies.md ├── processing-for-haskell.cabal ├── src └── Graphics │ ├── Proc.hs │ ├── Proc │ ├── Core.hs │ ├── Core │ │ ├── GLBridge.hs │ │ ├── PioRef.hs │ │ ├── Run.hs │ │ ├── State.hs │ │ ├── State │ │ │ ├── Elements.hs │ │ │ ├── Elements │ │ │ │ ├── Draw.hs │ │ │ │ ├── Font.hs │ │ │ │ ├── Frame.hs │ │ │ │ ├── Input.hs │ │ │ │ ├── Rnd.hs │ │ │ │ └── Time.hs │ │ │ └── Pio.hs │ │ ├── Vector.hs │ │ └── Vector │ │ │ └── Primitive2D.hs │ ├── Lib.hs │ ├── Lib │ │ ├── Color.hs │ │ ├── Data.hs │ │ ├── Data │ │ │ └── Conversion.hs │ │ ├── Environment.hs │ │ ├── Image.hs │ │ ├── Input.hs │ │ ├── Input │ │ │ ├── Keyboard.hs │ │ │ ├── Mouse.hs │ │ │ └── Time.hs │ │ ├── Math.hs │ │ ├── Math │ │ │ ├── Calculation.hs │ │ │ ├── Random.hs │ │ │ └── Trigonometry.hs │ │ ├── Misc.hs │ │ ├── Output.hs │ │ ├── Output │ │ │ └── TextArea.hs │ │ ├── Shape.hs │ │ ├── Shape │ │ │ ├── Attribute.hs │ │ │ ├── Curve.hs │ │ │ └── Primitive2D.hs │ │ ├── Transform.hs │ │ ├── Typography.hs │ │ └── Typography │ │ │ ├── Attributes.hs │ │ │ ├── Display.hs │ │ │ └── Metrics.hs │ ├── Lib3.hs │ └── Lib3 │ │ ├── Camera.hs │ │ ├── Lights.hs │ │ ├── Shape │ │ ├── Primitive2D.hs │ │ └── Primitive3D.hs │ │ └── Transform.hs │ └── Proc3.hs ├── stack.yaml └── tutorial ├── FirstSteps.md ├── QuickStartForProcessingers.md ├── Random.md ├── Shapes.md ├── Transformations.md ├── UserInput.md ├── VectorSpace.md └── code ├── BrownMotion.hs ├── Hero.hs ├── KeyFollow.hs ├── MouseFollow.hs ├── NoiseLine.hs ├── NoiseTexture.hs ├── Painter.hs ├── Planet.hs ├── PlanetClick.hs ├── RandomCircles.hs ├── Shapes.hs └── Static.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-newstyle 3 | .stack-work 4 | todo 5 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for processing-for-haskell 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | 7 | ## 0.2.0.0 8 | 9 | * camera functions 10 | 11 | * 3D drawing primitives 12 | 13 | * Changes types for points from tuples to strict custom types 14 | 15 | * Changes main numeric type from float to double to avoid many conversions 16 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Anton Kholomiov 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Anton Kholomiov nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | build: 2 | stack build 3 | 4 | run: 5 | stack exec -- runhaskell examples/Form/PlatonicShapes.hs 6 | 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Processing for Haskell 2 | 3 | Computer Graphics for kids and artists! 4 | It's an imperative EDSL for computer graphics. It's very easy to use. 5 | The library implements Processing language in Haskell. 6 | 7 | Well, But actually it... 8 | 9 | ... implements a **subset** of Processing Language in Haskell. So ... 10 | 11 | 12 | ### How to install 13 | 14 | You can install it from hackage. 15 | 16 | ~~~ 17 | > cabal install processing-for-haskell 18 | ~~~ 19 | 20 | ### Guide 21 | 22 | If you are familiar with processing you can read: 23 | 24 | * [Quick start guide for Processigers](https://github.com/anton-k/processing-for-haskell/blob/master/tutorial/QuickStartForProcessingers.md) 25 | 26 | Also you can read more detailed tutorial. The code examples for tutorial can be found [here](https://github.com/anton-k/processing-for-haskell/tree/master/tutorial/code): 27 | 28 | * [First steps](https://github.com/anton-k/processing-for-haskell/blob/master/tutorial/FirstSteps.md) 29 | 30 | * [Simple shapes](https://github.com/anton-k/processing-for-haskell/blob/master/tutorial/Shapes.md) 31 | 32 | * [Transformations](https://github.com/anton-k/processing-for-haskell/blob/master/tutorial/Transformations.md) 33 | 34 | * [User input](https://github.com/anton-k/processing-for-haskell/blob/master/tutorial/UserInput.md) 35 | 36 | * [Randomness](https://github.com/anton-k/processing-for-haskell/blob/master/tutorial/Random.md) 37 | 38 | * [Vectors](https://github.com/anton-k/processing-for-haskell/blob/master/tutorial/VectorSpace.md) 39 | 40 | There are many examples to try out at the [examples](https://github.com/anton-k/processing-for-haskell/tree/master/examples) directory. 41 | 42 | ### Missing features 43 | 44 | * Image processing functions 45 | 46 | * 3D drawing 47 | 48 | * Textures 49 | 50 | * Text and font rendering 51 | 52 | * Functions for rendering of complex 2D shapes (polygons with holes) 53 | 54 | * Should check for perlin-noise implementation. 55 | 56 | ### The project needs your help 57 | 58 | The Processing being a small language implements some tons of 59 | magic with OpenGL under the hood. There are really great implementations 60 | of graphics primitives. I can not finish this thing all alone. 61 | So if you are really interested in seeing the package finished. 62 | If you want all features of Processing be implemented please **do** contribute! 63 | 64 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /examples/Control/Conditionals1.hs: -------------------------------------------------------------------------------- 1 | -- Conditionals 1. 2 | -- 3 | -- Conditions are like questions. They allow a program to decide to take one 4 | -- action if the answer to a question is "true" or to do 5 | -- another action if the answer to the question is "false." 6 | -- 7 | -- The questions asked within a program are always logical or 8 | -- relational statements. For example, if the variable 'i' is equal 9 | -- to zero then draw a line. 10 | 11 | import Graphics.Proc 12 | 13 | main = runProc $ def { procSetup = setup, procDraw = draw } 14 | 15 | width = 640 16 | height = 360 17 | 18 | setup = do 19 | size (P2 width height) 20 | 21 | draw () = do 22 | background (grey 0) 23 | 24 | forM_ [10, 20 .. width] $ \i -> do 25 | if (int i `mod` 20 == 0) 26 | then do 27 | stroke (grey 255) 28 | line (P2 i 80) (P2 i (height / 2)) 29 | else do 30 | stroke (grey 153) 31 | line (P2 i 20) (P2 i 180) 32 | 33 | 34 | ---------------------------------- 35 | -- Side note 36 | -- 37 | -- We could easily transform imperative if-statment to pure one. 38 | -- We can create a procedure that takes in color and the length 39 | -- of the line and pass values that are based on condition. 40 | -- 41 | 42 | draw2 () = do 43 | background (grey 0) 44 | 45 | forM_ [10, 20 .. width] $ \i -> do 46 | drawLine i $ 47 | if (int i `mod` 20 == 0) 48 | then (grey 255, 80, height / 2) 49 | else (grey 153, 20, 180) 50 | where 51 | drawLine i (col, y1, y2) = do 52 | stroke col 53 | line (P2 i y1) (P2 i y2) 54 | 55 | -------------------------------------------------------------------------------- /examples/Control/Conditionals2.hs: -------------------------------------------------------------------------------- 1 | -- Conditionals 2. 2 | -- 3 | -- We extend the language of conditionals from the previous example by adding 4 | -- the keyword "else". This allows conditionals to ask two or more sequential 5 | -- questions, each with a different action. 6 | 7 | import Graphics.Proc 8 | 9 | main = runProc $ def { procSetup = setup, procDraw = draw } 10 | 11 | width = 640 12 | height = 360 13 | 14 | setup = do 15 | size (P2 width height) 16 | 17 | draw () = do 18 | background (grey 0) 19 | forM_ [2, 4 .. width - 2] $ \i -> do 20 | -- If 'i' divides by 20 with no remainder 21 | if ((int i `mod` 20) == 0) 22 | then do 23 | stroke (grey 255) 24 | line (P2 i 80) (P2 i (height/2)) 25 | else do 26 | -- If 'i' divides by 10 with no remainder 27 | if ((int i `mod` 10) == 0) 28 | then do 29 | stroke (grey 153) 30 | line (P2 i 20) (P2 i 180) 31 | -- If neither of the above two conditions are met 32 | -- then draw this line 33 | else do 34 | stroke (grey 102) 35 | line (P2 i (height/2)) (P2 i (height-20)) 36 | 37 | -------------------------------------------------------- 38 | -- Side note 39 | -- 40 | -- In Haskell we don't have if-statments with multiple branches. 41 | -- It's always a ternary operator. But we can achieve the same 42 | -- result with nesting `if-then-else`s. 43 | -------------------------------------------------------------------------------- /examples/Control/EmbeddedIteration.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/embeddediteration.html 2 | 3 | -- Embedding Iteration. 4 | -- 5 | -- Embedding "for" structures allows repetition in two dimensions. * 6 | 7 | import Graphics.Proc 8 | 9 | main = runProc $ def { procSetup = setup, procDraw = draw } 10 | 11 | width = 640 12 | height = 360 13 | 14 | setup = do 15 | size (P2 width height) 16 | 17 | gridSize = 40 18 | center = 0.5 *^ (P2 width height) -- special operator to scale vector by float 19 | 20 | draw () = do 21 | background (grey 0) 22 | forM_ [gridSize, 2*gridSize .. width - gridSize] $ \x -> do 23 | forM_ [gridSize, 2*gridSize .. height - gridSize] $ \y -> do 24 | noStroke 25 | fill (grey 255) 26 | rect (P2 (x - 1) (y - 1)) (P2 3 3) 27 | stroke (greya 255 100) 28 | line (P2 x y) center 29 | -------------------------------------------------------------------------------- /examples/Control/Iteration.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/iteration.html 2 | 3 | -- Iteration. 4 | -- 5 | -- Iteration with a "for" structure to construct repetitive forms. 6 | 7 | import Graphics.Proc 8 | 9 | main = runProc $ def { procSetup = setup, procDraw = draw } 10 | 11 | width = 640 12 | height = 360 13 | 14 | num = 14 15 | 16 | setup = do 17 | size (P2 width height) 18 | stroke (greya 255 160) 19 | 20 | draw () = do 21 | background (grey 102) 22 | noStroke 23 | 24 | -- White bars 25 | fill (grey 255) 26 | forM_ (ys (floor $ float num / 3) 60) $ \y -> do 27 | rect (P2 50 y) (P2 475 10) 28 | 29 | -- Grey bars 30 | fill (grey 51) 31 | forM_ (ys num 40) $ \y -> do 32 | rect (P2 405 y) (P2 30 10) 33 | 34 | forM_ (ys num 50) $ \y -> do 35 | rect (P2 425 y) (P2 30 10) 36 | 37 | -- Thin lines 38 | fill (grey 0) 39 | forM_ (ys (num - 1) 45) $ \y -> do 40 | rect (P2 120 y) (P2 40 1) 41 | 42 | ys n start = take (n + 1) $ fmap (+ start) [0, 20 ..] 43 | 44 | ----------------------------------------- 45 | -- Side note 46 | -- 47 | -- In Haskell we don't have the for-loop construct. 48 | -- But it can be emulated with function `forM_` (see docs for Control.Monad). 49 | -- 50 | -- forM_ :: Monad m => [a] -> (a -> m ()) -> m () 51 | -- 52 | -- It takes a list of values and applies a procedure to all of them. 53 | -- It's not so general as the for-loop, but there are it own advantages. 54 | -- Notice how we can construct the values for looping programmatically. 55 | -- 56 | -------------------------------------------------------------------------------- /examples/Control/LogicalOperators.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/logicaloperators.html 2 | 3 | -- Logical Operators. 4 | -- 5 | -- The logical operators for AND (&&) and OR (||) are used to combine simple relational statements 6 | -- into more complex expressions. The NOT (not) operator is used to negate a boolean statement. 7 | import Graphics.Proc 8 | 9 | main = runProc $ def { procSetup = setup, procDraw = draw } 10 | 11 | width = 640 12 | height = 360 13 | 14 | setup = do 15 | size (P2 width height) 16 | testRef <- newPioRef True 17 | return testRef 18 | 19 | draw testRef = do 20 | background (grey 126) 21 | 22 | forM_ [5, 10 .. height] $ \i -> do 23 | -- Logical AND 24 | stroke (grey 0) 25 | when (i > 35 && i < 100) $ do 26 | line (P2 (width/4) i) (P2 (width/2) i) 27 | writePioRef testRef False 28 | 29 | -- Logical OR 30 | stroke (grey 76) 31 | when (i <= 35 || i >= 100) $ do 32 | line (P2 (width/2) i) (P2 width i) 33 | writePioRef testRef True 34 | 35 | test <- readPioRef testRef 36 | 37 | -- Testing if a boolean value is "true" 38 | -- The expression "if(test)" is equivalent to "if (test == true)" 39 | when (test) $ do 40 | stroke (grey 0) 41 | point (P2 (width/3) i) 42 | 43 | -- Testing if a boolean value is "false" 44 | -- The expression "if(!test)" is equivalent to "if(test == false)" 45 | when (not test) $ do 46 | stroke (grey 255) 47 | point (P2 (width/4) i) 48 | 49 | --------------------------------------------------- 50 | -- Side note 51 | -- 52 | -- This example originally was intended to show the logical operators, 53 | -- but in Haskell setting it provides a good example for using mutable variables in Haskell. 54 | -- 55 | -- Being a purely functional language Haskell gives a way to mutable magic. 56 | -- but it's done in more strict way. In Haskell we can create references that hold values 57 | -- and then we can read and write values to the references. 58 | -- 59 | -- The state of the program is the reference testRef that holds the boolean value. 60 | -- We create references with function newPioRef: 61 | -- 62 | -- > newPioRef :: a -> Pio (PioRef a) 63 | -- 64 | -- We pass an initial value. 65 | -- Then we can read values with the function 66 | -- 67 | -- > readPioRef :: PioRef a -> Pio a 68 | -- 69 | -- Also we can write the values to the reference: 70 | -- 71 | -- > writePioRef :: PioRef a -> a -> Pio () 72 | -- 73 | -- There is a useful function for update of the value inside the reference: 74 | -- 75 | -- > modifyPioRef :: PioRef a -> (a -> a) -> Pio () 76 | -- 77 | -- The names for the functions follow the standard established in the similar module `Data.IORef`. 78 | -- 79 | -- Also example shows how we can create imperative if-statements without `else`-alternative. 80 | -- The function `when` does the trick: 81 | -- 82 | -- > when :: Monad m => Bool -> m () -> m () 83 | -- 84 | -- Here the m-type is automatically substituted with our main monad Pio. 85 | -- We use do-notation to join many effectfull statements in the single expression. 86 | -- 87 | -- > when (test) $ do 88 | -- > stmt1 89 | -- > stmt2 90 | 91 | 92 | -------------------------------------------------------------------------------- /examples/Data/CharsAndStrings.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/charactersstrings.html 2 | 3 | -- Characters Strings. 4 | 5 | -- NOT IMPLEMENTED 6 | 7 | -- The character datatype, abbreviated as char, stores letters and 8 | -- symbols in the Unicode format, a coding system developed to support 9 | -- a variety of world languages. Characters are distinguished from 10 | -- other symbols by putting them between single quotes ('P'). 11 | 12 | -- A string is a sequence of characters. A string is noted by surrounding 13 | -- a group of letters with float quotes ("Processing"). Chars and strings 14 | -- are most often used with the keyboard methods, to display text to the screen, 15 | -- and to load images or files. 16 | 17 | -- The String datatype must be capitalized because it is a complex datatype. 18 | -- A String is actually a class with its own methods, some of which are featured below. 19 | import Graphics.Proc 20 | 21 | import Prelude hiding (words) 22 | 23 | main = runProc $ def { procSetup = setup, procDraw = draw, procKeyReleased = keyPressed } 24 | 25 | width = 640 26 | height = 360 27 | 28 | letter = "a" 29 | wordsInit = "Begin..." 30 | 31 | setup = do 32 | size (width, height) 33 | font <- loadFont "FreeSans.ttf" 34 | textFont font 36 35 | return wordsInit 36 | 37 | draw words = do 38 | background (grey 0) 39 | 40 | textSize 14 41 | text "Click on the program, then type to add to the String" (50, 50) 42 | 43 | text ("Current key: " ++ letter) (50, 70) 44 | text ("The String is " ++ show(length words) ++ " characters long") (50, 90) 45 | 46 | textSize 28 47 | text words (50, 120) -- , 540, 300); 48 | 49 | -- keyTyped leads to SegFault. Need to investigate 50 | keyPressed words = do 51 | k <- key 52 | return $ case k of 53 | Char ch -> words ++ [ch] 54 | _ -> words 55 | -------------------------------------------------------------------------------- /examples/Data/DatatypeConversion.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/datatypeconversion.html 2 | 3 | -- Datatype Conversion. 4 | -- 5 | -- It is sometimes beneficial to convert a value from one type of 6 | -- data to another. Each of the conversion functions converts its 7 | -- parameter to an equivalent representation within its datatype. 8 | -- The conversion functions include int(), float(), char(), byte(), and others. 9 | 10 | import Graphics.Proc 11 | 12 | main = runProc $ def { procSetup = setup, procDraw = draw } 13 | 14 | width = 640 15 | height = 360 16 | 17 | c = 'A'; 18 | f = float (fromEnum c) -- Sets f = 65.0 19 | i = int (f * 1.4) -- Sets i to 91 20 | -- b = byte(c / 2); -- Sets b to 32 21 | 22 | setup = do 23 | size (width, height) 24 | noStroke 25 | font <- loadFont "FreeSans.ttf" 26 | textFont font 24 27 | 28 | msg varName value dy = text ("The value of variable " ++ varName ++ " is " ++ show(value)) (50, 100 + dy) 29 | 30 | draw () = do 31 | msg "c" c 0 32 | msg "f" f 50 33 | msg "i" i 100 34 | -- msg "b" b 150 35 | -------------------------------------------------------------------------------- /examples/Data/FreeSans.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/anton-k/processing-for-haskell/861ccd417220eb24fc36a68074a771e417e991df/examples/Data/FreeSans.ttf -------------------------------------------------------------------------------- /examples/Data/IntegersAndFloats.hs: -------------------------------------------------------------------------------- 1 | -- Integers Floats. 2 | -- 3 | -- Integers and floats are two different kinds of numerical data. 4 | -- An integer (more commonly called an int) is a number without a decimal point. 5 | -- A float is a floating-point number, which means it is a number that has a decimal place. 6 | -- Floats are used when more precision is needed. 7 | 8 | import Graphics.Proc 9 | 10 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 11 | 12 | width = 640 13 | height = 360 14 | 15 | -- Creates a pair of values an integer and float. 16 | setup :: Pio (Int, Float) 17 | setup = do 18 | -- Sets the screen to be 640 pixels wide and 360 pixels high 19 | size (P2 width height) 20 | stroke (grey 255) 21 | return (0, 0.0) 22 | 23 | draw (a, b) = do 24 | background (grey 0) 25 | line (P2 (float a) 0) (P2 (float a) (height/2)) 26 | line (P2 b (height/2)) (P2 b height) 27 | 28 | update (a, b) = return (a1, b1) 29 | where 30 | a1 = if (a > int width) then 0 else a + 1 31 | b1 = if (b > width) then 0 else b + 0.2 32 | 33 | -------------------------------------------------------- 34 | -- Side note 35 | -- 36 | -- Notice the need for explicit conversion with functions `float` and `int`. 37 | -- Processing can automatically convert ints to floats but in Haskell we 38 | -- should convert the values manually 39 | -------------------------------------------------------------------------------- /examples/Data/TrueAndFalse.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/truefalse.html 2 | 3 | -- True/False. 4 | -- 5 | -- A Boolean variable has only two possible values: true or false. 6 | -- It is common to use Booleans with control statements to determine 7 | -- the flow of a program. In this example, when the boolean value "x" is true, 8 | -- vertical black lines are drawn and when the boolean value "x" is false, 9 | -- horizontal gray lines are drawn. 10 | 11 | import Graphics.Proc 12 | 13 | main = runProc $ def { procSetup = setup, procDraw = draw } 14 | 15 | width = 640 16 | height = 360 17 | 18 | d = 20 19 | middle = width / 2 20 | 21 | setup = do 22 | size (P2 width height) 23 | background (grey 0) 24 | stroke (grey 255) 25 | 26 | draw () = do 27 | forM_ [d, 2 * d .. width] $ \i -> do 28 | -- creates a boolean val 29 | let b = i < middle 30 | if (b) 31 | then 32 | -- Vertical line 33 | line (P2 i d) (P2 i (height-d)) 34 | else 35 | -- Horizontal line 36 | line (P2 middle (i - middle + d)) (P2 (width-d) (i - middle + d)) 37 | -------------------------------------------------------------------------------- /examples/Data/Variables.hs: -------------------------------------------------------------------------------- 1 | -- the original example: https://processing.org/examples/variables.html 2 | 3 | -- Variables. 4 | -- 5 | -- Variables are used for storing values. In this example, change the values of variables to affect the composition. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw } 9 | 10 | width = 640 11 | height = 360 12 | 13 | setup = do 14 | -- Sets the screen to be 640 pixels wide and 360 pixels high 15 | size (P2 width height) 16 | 17 | draw () = do 18 | background (grey 0) 19 | stroke (grey 153) 20 | 21 | strokeWeight 4 22 | -- not implemented yet 23 | -- strokeCap(SQUARE); 24 | 25 | let a = 50 26 | b = 120 27 | c = 180 28 | 29 | line (P2 a b) (P2 (a+c) b) 30 | line (P2 a (b+10)) (P2 (a+c) (b+10)) 31 | line (P2 a (b+20)) (P2 (a+c) (b+20)) 32 | line (P2 a (b+30)) (P2 (a+c) (b+30)) 33 | 34 | let a1 = a + c 35 | b1 = height-b 36 | 37 | line (P2 a1 b1) (P2 (a1+c) b1) 38 | line (P2 a1 (b1+10)) (P2 (a1+c) (b1+10)) 39 | line (P2 a1 (b1+20)) (P2 (a1+c) (b1+20)) 40 | line (P2 a1 (b1+30)) (P2 (a1+c) (b1+30)) 41 | 42 | let a2 = a1 + c 43 | b2 = height-b1 44 | 45 | line (P2 a2 b2) (P2 (a2+c) b2) 46 | line (P2 a2 (b2+10)) (P2 (a2+c) (b2+10)) 47 | line (P2 a2 (b2+20)) (P2 (a2+c) (b2+20)) 48 | line (P2 a2 (b2+30)) (P2 (a2+c) (b2+30)) 49 | 50 | -------------------------------------------------------------- 51 | -- Sidenote 52 | -- 53 | -- In the original example we update the mutable variables `a` and `b`. 54 | -- But in Haskell there are no mutable variables. Local variables a pure constants 55 | -- and we can not change them after assignment. That's why we have to give new 56 | -- names to variables a1, b1 and a2, b2. 57 | 58 | 59 | 60 | ----------------------------------------------------------------------- 61 | -- More than one way to define variables 62 | ----------------------------------------------------------------------- 63 | -- 64 | -- We could write this example in another style. We could define the local variables 65 | -- with `where` keyword: 66 | -- 67 | 68 | draw2 () = do 69 | background (grey 0) 70 | stroke (grey 153) 71 | 72 | strokeWeight 4 73 | -- not implemented yet 74 | -- strokeCap(SQUARE); 75 | 76 | line (P2 a b) (P2 (a+c) b) 77 | line (P2 a (b+10)) (P2 (a+c) (b+10)) 78 | line (P2 a (b+20)) (P2 (a+c) (b+20)) 79 | line (P2 a (b+30)) (P2 (a+c) (b+30)) 80 | 81 | line (P2 a1 b1) (P2 (a1+c) b1) 82 | line (P2 a1 (b1+10)) (P2 (a1+c) (b1+10)) 83 | line (P2 a1 (b1+20)) (P2 (a1+c) (b1+20)) 84 | line (P2 a1 (b1+30)) (P2 (a1+c) (b1+30)) 85 | 86 | line (P2 a2 b2) (P2 (a2+c) b2) 87 | line (P2 a2 (b2+10)) (P2 (a2+c) (b2+10)) 88 | line (P2 a2 (b2+20)) (P2 (a2+c) (b2+20)) 89 | line (P2 a2 (b2+30)) (P2 (a2+c) (b2+30)) 90 | where 91 | a = 50 92 | b = 120 93 | c = 180 94 | 95 | a1 = a + c 96 | b1 = height-b 97 | 98 | a2 = a1 + c 99 | b2 = height-b1 100 | 101 | -- Also we could just write out the constants at the top level. 102 | -------------------------------------------------------------------------------- /examples/Form/Bezier.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/bezier.html 2 | -- 3 | 4 | -- Bezier. 5 | -- 6 | -- The first two parameters for the bezier() function specify the 7 | -- first point in the curve and the last two parameters specify 8 | -- the last point. The middle parameters set the control points that 9 | -- define the shape of the curve. 10 | import Graphics.Proc 11 | 12 | main = runProc $ def { procSetup = setup, procDraw = draw } 13 | 14 | width = 640 15 | height = 360 16 | 17 | setup = do 18 | size (P2 width height) 19 | stroke (grey 255) 20 | noFill 21 | 22 | draw () = do 23 | background (grey 0) 24 | mx <- mouseX 25 | forM_ [0, 20 .. 200] $ \i -> do 26 | bezier (P2 (mx - i/2) (40 + i)) (P2 410 20) (P2 440 300) (P2 (240 - (i/16)) (300 + (i/8))) 27 | -------------------------------------------------------------------------------- /examples/Form/PieChart.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- 3 | -- https://processing.org/examples/piechart.html 4 | 5 | -- Pie Chart 6 | -- 7 | -- Uses the arc() function to generate a pie chart from the data stored in an array. 8 | 9 | -- to implement arc todo 10 | 11 | {- 12 | int[] angles = { 30, 10, 45, 35, 60, 38, 75, 67 }; 13 | 14 | void setup() { 15 | size(640, 360); 16 | noStroke(); 17 | noLoop(); // Run once and stop 18 | } 19 | 20 | void draw() { 21 | background(100); 22 | pieChart(300, angles); 23 | } 24 | 25 | void pieChart(float diameter, int[] data) { 26 | float lastAngle = 0; 27 | for (int i = 0; i < data.length; i++) { 28 | float gray = map(i, 0, data.length, 0, 255); 29 | fill(gray); 30 | arc(width/2, height/2, diameter, diameter, lastAngle, lastAngle+radians(angles[i])); 31 | lastAngle += radians(angles[i]); 32 | } 33 | } 34 | -} 35 | -------------------------------------------------------------------------------- /examples/Form/PlatonicShapes.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc3 2 | 3 | main = runProc $ def 4 | { procSetup = setup 5 | , procDraw = draw 6 | , procUpdate = update 7 | } 8 | 9 | setup = do 10 | size (P2 800 630) 11 | pure 0 12 | 13 | update t = pure (t + 0.1) 14 | 15 | -- | We can also try for shape 16 | -- 17 | -- * tetrahedron 18 | -- * cube / box 19 | -- * octahedron 20 | -- * dodecahedron 21 | -- * icosahedron 22 | draw = drawBy 2 23 | ( reverse $ 24 | zip3 [icosahedron, octahedron, tetrahedron, dodecahedron, cube] 25 | [black, yellow, blue, green, purple] 26 | [10, 22, 45, 70, 120] 27 | ) 28 | 29 | drawBy speed params t = do 30 | background white 31 | let fov = pi / 15 32 | cameraZ = 500 / tan (fov / 2) 33 | camera (P3 0 0 0) (P3 0 0 (negate cameraZ)) (P3 0 1 0) 34 | perspective fov 1 (cameraZ / 10) (cameraZ * 400) 35 | translate (P3 150 150 (negate 300)) 36 | scale 1.2 37 | strokeWeight 2 38 | zipWithM_ go (cycle [rotateX, rotateY, rotateZ, rotateX . negate, rotateY . negate, rotateZ . negate]) params 39 | where 40 | go tfm (shape, col, rad) = 41 | local $ do 42 | strokeWeight (7 * rad / 100) 43 | strokeFill col 44 | tfm $ 0.3 * speed * t / rad 45 | shape rad 46 | 47 | 48 | -------------------------------------------------------------------------------- /examples/Form/PointsAndLines.hs: -------------------------------------------------------------------------------- 1 | -- the original example: 2 | -- 3 | -- https://processing.org/examples/pointslines.html 4 | 5 | -- Points and Lines. 6 | -- 7 | -- Points and lines can be used to draw basic geometry. 8 | -- Change the value of the variable 'd' to scale the form. 9 | --0 The four variables set the positions based on the value of 'd'. 10 | import Graphics.Proc 11 | 12 | main = runProc $ def { procSetup = setup, procDraw = draw } 13 | 14 | width = 640 15 | height = 360 16 | 17 | d = 70 18 | p1 = d 19 | p2 = p1+d 20 | p3 = p2+d 21 | p4 = p3+d 22 | 23 | setup = do 24 | size (P2 width height) 25 | noSmooth 26 | 27 | draw () = do 28 | background (grey 0) 29 | translate (P2 140 0) 30 | 31 | -- Draw gray box 32 | stroke (grey 153) 33 | line (P2 p3 p3) (P2 p2 p3) 34 | line (P2 p2 p3) (P2 p2 p2) 35 | line (P2 p2 p2) (P2 p3 p2) 36 | line (P2 p3 p2) (P2 p3 p3) 37 | 38 | -- Draw white points 39 | stroke (grey 255) 40 | point (P2 p1 p1) 41 | point (P2 p1 p3) 42 | point (P2 p2 p4) 43 | point (P2 p3 p1) 44 | point (P2 p4 p2) 45 | point (P2 p4 p4) 46 | -------------------------------------------------------------------------------- /examples/Form/RegularPolygon.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/regularpolygon.html 2 | 3 | -- Regular Polygon 4 | -- 5 | -- What is your favorite? Pentagon? Hexagon? Heptagon? No? What about the icosagon? 6 | -- The polygon() function created for this example is capable of drawing any regular polygon. 7 | -- Try placing different numbers into the polygon() function calls within draw() to explore. 8 | 9 | import Graphics.Proc 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw } 12 | 13 | width = 640 14 | height = 360 15 | 16 | setup = do 17 | smooth 18 | size (P2 width height) 19 | 20 | draw() = do 21 | background (grey 102) 22 | fill (grey 250) 23 | 24 | drawPoly (P2 (width*0.2) (height*0.5)) (1 / 400) 82 3 -- Triangle 25 | drawPoly (P2 (width*0.5) (height*0.5)) (1 / 100) 80 20 -- Icosahedron 26 | drawPoly (P2 (width*0.8) (height*0.5)) (-(1/ 200)) 70 7 -- Heptagon 27 | 28 | -- the function `local` is equivalent of pair of pushMatrix and popMatrix. 29 | -- We specify the scope of local transformation with indentation. 30 | drawPoly center speed radius npoints = local $ do 31 | translate center 32 | n <- frameCount 33 | rotate (float n * speed); 34 | poly 0 radius npoints 35 | 36 | poly center radius npoints = 37 | polygon $ fmap (onCircle radius center) [0, 1/npoints .. 1] 38 | 39 | ------------------------------------------- 40 | -- Sidenote 41 | -- 42 | -- In processing one often uses the trick with putting the matrix on stack 43 | -- and the puting it out of the stack to emulate the local transformations. 44 | -- Code may look like this: 45 | -- 46 | -- > pushMatrix(); 47 | -- > stmt1; 48 | -- > stmt2; 49 | -- > ... 50 | -- > stmtN; 51 | -- > popMatrix(); 52 | -- 53 | -- In Haskell there is much better way to express the same idea. we can just write: 54 | -- 55 | -- > local $ do 56 | -- > stmt1 57 | -- > stmt2 58 | -- > ... 59 | -- > stmtN 60 | -- 61 | -- Compiler knows which statments to enclose in local transformation by indentation. 62 | -- The function local takes a block of code and executes it its own matrix frame of space transformation. 63 | -- 64 | -- Another thing to note is misc function `onCircle`. It maps an interval [0, 1] to the circle. 65 | -- 66 | -- > onCircle :: Radius -> Center -> float -> P2 67 | -- 68 | -- So the first two arguments specify the shape of a circle and the last argument is a point on the circle. 69 | -- It's very convinient way to put points n the given circle. 70 | -- 71 | -- The function polygon constructs a polygon out of list of points. The polygon is olway convex. 72 | -- So let's take a closer look at this rather dence haskell statment: 73 | -- 74 | -- > polygon $ fmap (onCircle radius center) [0, 1/npoints .. 1] 75 | -- 76 | -- first we create a list of `npoints` number of floats that occupy the interval [0, 1]. 77 | -- Then we map interval to circle: 78 | -- 79 | -- > fmap (onCircle radius center) [0, 1/npoints .. 1] 80 | -- 81 | -- and with final function in the chain `polygon` we create a polygon. 82 | -- Unfortunately generic shape constructors right now are not implemented. 83 | -- So there is no beginShape and endShape functions. 84 | -------------------------------------------------------------------------------- /examples/Form/ShapePrimitives.hs: -------------------------------------------------------------------------------- 1 | -- the original example: 2 | -- 3 | -- https://processing.org/examples/shapeprimitives.html 4 | 5 | -- Shape Primitives. 6 | -- 7 | -- The basic shape primitive functions are triangle(), rect(), quad(), ellipse(), and arc(). 8 | -- Squares are made with rect() and circles are made with ellipse(). 9 | -- Each of these functions requires a number of parameters to determine the shape's position and size. 10 | 11 | import Graphics.Proc 12 | 13 | main = runProc $ def { procSetup = setup, procDraw = draw } 14 | 15 | width = 640 16 | height = 360 17 | 18 | setup = do 19 | size (P2 width height) 20 | noStroke 21 | 22 | draw () = do 23 | background (grey 0) 24 | 25 | fill (grey 204) 26 | triangle (P2 18 18) (P2 18 360) (P2 81 360) 27 | 28 | fill (grey 102) 29 | rect (P2 81 81) (P2 63 63) 30 | 31 | fill (grey 204); 32 | quad (P2 189 18) (P2 216 18) (P2 216 360) (P2 144 360) 33 | 34 | fill (grey 255) 35 | ellipse (P2 252 144) (P2 72 72) 36 | 37 | fill (grey 204) 38 | triangle (P2 288 18) (P2 351 360) (P2 288 360) 39 | 40 | fill (grey 255) 41 | -- todo 42 | -- arc (479, 300, 280, 280, PI, TWO_PI); 43 | -------------------------------------------------------------------------------- /examples/Form/Sphere.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def { procSetup = setup, procDraw = draw } 4 | 5 | setup = size (P2 200 200) 6 | 7 | draw _ = do 8 | background (grey 200) 9 | stroke black 10 | translate (P3 50 50 0) 11 | rotateX . (* 0.05) =<< mouseY 12 | rotateY . (* 0.05) =<< mouseX 13 | sphereDetail . (\x -> SphereRes x x) . int . (* 0.25) =<< mouseX 14 | sphere 40 15 | 16 | -------------------------------------------------------------------------------- /examples/Form/Star.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/star.html 2 | 3 | -- Star 4 | -- 5 | -- The star() function created for this example is capable of drawing 6 | -- a wide range of different forms. Try placing different numbers into 7 | -- the star() function calls within draw() to explore. 8 | 9 | import Graphics.Proc 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw } 12 | 13 | width = 640 14 | height = 360 15 | 16 | setup = do 17 | smooth 18 | size (P2 width height) 19 | 20 | draw() = do 21 | background (grey 102) 22 | fill (grey 250) 23 | 24 | drawPoly (P2 (width*0.2) (height*0.5)) (1 / 200) 70 3 -- Triangle 25 | drawPoly (P2 (width*0.5) (height*0.5)) (1 / 400) 100 40 -- Icosahedron 26 | drawPoly (P2 (width*0.8) (height*0.5)) (-(1/ 100)) 70 5 -- Heptagon 27 | 28 | -- the function `local` is equivalent of pair of pushMatrix and popMatrix. 29 | -- We specify the scope of local transformation with indentation. 30 | drawPoly center speed radius npoints = local $ do 31 | translate center 32 | n <- frameCount 33 | rotate (float n * speed); 34 | poly (P2 0 0) radius npoints 35 | 36 | poly center radius npoints = 37 | polygon $ fmap (onCircle radius center) [0, 1/npoints .. 1] 38 | 39 | star center radius npoints = undefined 40 | -- not convex polygons are not implemented yet (todo) 41 | -------------------------------------------------------------------------------- /examples/Form/TriangleStrip.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/trianglestrip.html 2 | 3 | -- Triangle Strip by Ira Greenberg. 4 | -- 5 | -- Generate a closed ring using the vertex() function and beginShape(TRIANGLE_STRIP) mode. 6 | -- The outsideRadius and insideRadius variables control ring's radii respectively. 7 | -- 8 | -- right now it can not be implemented in Haskell 9 | -- 10 | -- there is no begin/endShape function 11 | 12 | {- 13 | 14 | int x; 15 | int y; 16 | float outsideRadius = 150; 17 | float insideRadius = 100; 18 | 19 | void setup() { 20 | size(640, 360); 21 | background(204); 22 | x = width/2; 23 | y = height/2; 24 | } 25 | 26 | void draw() { 27 | background(204); 28 | 29 | int numPoints = int(map(mouseX, 0, width, 6, 60)); 30 | float angle = 0; 31 | float angleStep = 180.0/numPoints; 32 | 33 | beginShape(TRIANGLE_STRIP); 34 | for (int i = 0; i <= numPoints; i++) { 35 | float px = x + cos(radians(angle)) * outsideRadius; 36 | float py = y + sin(radians(angle)) * outsideRadius; 37 | angle += angleStep; 38 | vertex(px, py); 39 | px = x + cos(radians(angle)) * insideRadius; 40 | py = y + sin(radians(angle)) * insideRadius; 41 | vertex(px, py); 42 | angle += angleStep; 43 | } 44 | endShape(); 45 | } 46 | 47 | -} 48 | -------------------------------------------------------------------------------- /examples/Input/Clock.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/clock.html 2 | 3 | -- Clock. 4 | -- 5 | -- The current time can be read with the second(), minute(), and hour() 6 | -- functions. In this example, sin() and cos() values are used to set the 7 | -- position of the hands. 8 | 9 | import Graphics.Proc hiding (scale) 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw } 12 | 13 | width = 640 14 | height = 360 15 | 16 | setup = do 17 | size (P2 width height) 18 | noStroke 19 | 20 | radius = min width height / 2 21 | secondsRadius = radius * 0.72 22 | minutesRadius = radius * 0.60 23 | hoursRadius = radius * 0.50 24 | clockDiameter = radius * 1.8 25 | 26 | center = 0.5 *^ (P2 width height) 27 | 28 | draw () = do 29 | background (grey 0) 30 | drawClockBackground 31 | drawHands 32 | drawTicks 33 | 34 | drawClockBackground = do 35 | fill (grey 80) 36 | noStroke 37 | ellipse center (P2 clockDiameter clockDiameter) 38 | 39 | drawTicks = do 40 | fill (grey 255) 41 | mapM_ (circle 2) $ fmap (onCircle secondsRadius center) [0, 1/60 .. 1] 42 | 43 | drawHands = do 44 | drawHour 45 | drawSecond 46 | drawMinute 47 | 48 | drawHour = drawHand hoursRadius hour 12 5 49 | drawMinute = drawHand minutesRadius minute 60 3 50 | drawSecond = drawHand secondsRadius second 60 1 51 | 52 | drawHand rad getter maxVal weight = do 53 | p <- getVec 54 | stroke (grey 255) 55 | strokeWeight weight 56 | line center p 57 | where 58 | getVec = do 59 | value <- getter 60 | return $ onCircle rad center $ (remap (0, maxVal) (0, 1) (float value)) - 0.25 61 | -------------------------------------------------------------------------------- /examples/Input/Constrain.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/constrain.html 2 | 3 | -- Easing. 4 | -- 5 | -- Move the mouse across the screen and the symbol will follow. 6 | -- Between drawing each frame of the animation, the program 7 | -- calculates the difference between the position of the symbol 8 | -- and the cursor. If the distance is larger than 1 pixel, the symbol 9 | -- moves part of the distance (0.05) from its current position toward the cursor. 10 | 11 | import Graphics.Proc 12 | 13 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 14 | 15 | width = 640 16 | height = 360 17 | 18 | sizes = (P2 width height) 19 | center = 0.5 *^ sizes 20 | easing = 0.06 21 | edge = 100 22 | radius = 24 23 | inner = edge + radius 24 | 25 | setup = do 26 | size sizes 27 | ellipseMode Radius 28 | rectMode Corners 29 | noStroke 30 | return center 31 | 32 | draw pos = do 33 | background (grey 51) 34 | fill (grey 76) 35 | rect (P2 edge edge) (P2 (width-edge) (height-edge)) 36 | fill (grey 255) 37 | ellipse pos (P2 radius radius) 38 | 39 | update pos = do 40 | m <- mouse 41 | return (constrain2 (vin, sizes - vin) (pos + easing *^ (m - pos))) 42 | where 43 | vin = (P2 inner inner) 44 | -------------------------------------------------------------------------------- /examples/Input/Easing.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/easing.html 2 | 3 | -- Easing. 4 | -- 5 | -- Move the mouse across the screen and the symbol will follow. 6 | -- Between drawing each frame of the animation, the program 7 | -- calculates the difference between the position of the symbol 8 | -- and the cursor. If the distance is larger than 1 pixel, the symbol 9 | -- moves part of the distance (0.05) from its current position toward the cursor. 10 | 11 | import Graphics.Proc 12 | 13 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 14 | 15 | width = 640 16 | height = 360 17 | 18 | center = 0.5 *^ (P2 width height) 19 | easing = 0.05 20 | 21 | setup = do 22 | size (P2 width height) 23 | noStroke 24 | return center 25 | 26 | draw pos = do 27 | background (grey 51) 28 | fill (grey 255) 29 | ellipse pos 66 30 | 31 | update pos = do 32 | m <- mouse 33 | return (pos + easing *^ (m - pos)) 34 | -------------------------------------------------------------------------------- /examples/Input/Keyboard.hs: -------------------------------------------------------------------------------- 1 | -- Keyboard. 2 | -- 3 | -- Click on the image to give it focus and press the letter 4 | -- keys to create forms in time and space. Each key has a 5 | -- unique identifying number. These numbers can be used to position shapes in space. 6 | import Data.Char 7 | 8 | import Graphics.Proc hiding (scale) 9 | 10 | main = runProc $ def { procSetup = setup, procKeyPressed = keyPressed } 11 | 12 | width = 640 13 | height = 360 14 | 15 | setup = do 16 | size (P2 width height) 17 | noStroke 18 | background (grey 0) 19 | 20 | rectWidth = width/4 21 | 22 | keyPressed () = do 23 | k <- key 24 | case k of 25 | Char ch | isLetter ch-> do 26 | m <- millis 27 | let x = remap (0, 25) (0, width - rectWidth) (float $ (fromEnum ch - fromEnum 'a') `mod` 26) 28 | fill (grey $ float $ m `mod` 255) 29 | rect (P2 x 0) (P2 rectWidth height) 30 | 31 | _ -> background (grey 0) 32 | -------------------------------------------------------------------------------- /examples/Input/KeyboardFunctions.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/keyboardfunctions.html 2 | -- 3 | -- Keyboard Functions. Modified from code by Martin. Original 'Color Typewriter' concept by John Maeda. 4 | -- 5 | -- Click on the window to give it focus and press the letter keys to type colors. 6 | -- The keyboard function keyPressed() is called whenever a key is pressed. keyReleased() 7 | -- is another keyboard function that is called when a key is released. 8 | import Data.Char 9 | import qualified Data.Map as M 10 | 11 | import Graphics.Proc hiding (scale) 12 | 13 | main = runProc $ def { procSetup = setup, procKeyPressed = keyPressed } 14 | 15 | type St = ((Int, Int), M.Map Char Col) 16 | 17 | width = 640 18 | height = 360 19 | 20 | setup = do 21 | size (P2 width height) 22 | noStroke 23 | background (grey 101) 24 | -- todo 25 | -- colorMode(HSB, numChars) 26 | colorMap <- initColorMap 27 | return ((0, 0), colorMap) 28 | 29 | initColorMap = fmap M.fromList $ forM ['a' .. 'z'] $ \ch -> fmap (\col -> (ch, col)) randomCol 30 | 31 | nx = 20 32 | ny = 15 33 | 34 | dx = width / float nx 35 | dy = height / float ny 36 | 37 | keyPressed :: St -> Pio St 38 | keyPressed (p, colorMap) = do 39 | fill =<< fmap (getCol colorMap) key 40 | drawRect p 41 | return (nextCell p, colorMap) 42 | 43 | getCol colorMap k = case k of 44 | Char ch -> maybe black id $ M.lookup (toLower ch) colorMap 45 | _ -> black 46 | 47 | drawRect (x, y) = rect (P2 (float x * dx) (float y * dy)) (P2 dx dy) 48 | 49 | nextCell (x, y) = (x1, y1) 50 | where 51 | x1 = (x + 1) `mod` nx 52 | y1 = if abs (x1 - x) /= 1 then (y + 1) `mod` ny else y 53 | 54 | -------------------------------------- 55 | -- Side note 56 | -- 57 | -- This example demonstrates how not only Haskell can borrow from Processing, 58 | -- but how Processing can use advanced features of Haskell 59 | -- 60 | -- We use associative map from letters to colors. No need to encode all collections with arrays. 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /examples/Input/Milliseconds.hs: -------------------------------------------------------------------------------- 1 | -- Milliseconds. 2 | -- 3 | -- A millisecond is 1/1000 of a second. Processing keeps track 4 | -- of the number of milliseconds a program has run. By modifying 5 | -- this number with the modulo(%) operator, different patterns 6 | -- in time are created. 7 | 8 | import Graphics.Proc hiding (scale) 9 | 10 | main = runProc $ def { procSetup = setup, procDraw = draw } 11 | 12 | width = 640 13 | height = 360 14 | 15 | scale = width/20 16 | 17 | setup = do 18 | size (P2 width height) 19 | noStroke 20 | 21 | draw () = do 22 | m <- millis 23 | forM_ [0 .. scale] $ \i -> do 24 | fill (grey $ remap (0, (i + 1) * scale * 10) (0, 255) (float $ m `mod` (int $ (i + 1) * scale * 10))) 25 | rect (P2 (i * scale) 0) (P2 scale height) 26 | -------------------------------------------------------------------------------- /examples/Input/Mouse1D.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/mouse1d.html 2 | 3 | -- Mouse 1D. 4 | -- 5 | -- Move the mouse left and right to shift the balance. The "mouseX" variable 6 | -- is used to control both the size and color of the rectangles. 7 | import Graphics.Proc 8 | 9 | main = runProc $ def { procSetup = setup, procDraw = draw } 10 | 11 | width = 640 12 | height = 360 13 | 14 | setup = do 15 | size (P2 width height) 16 | noStroke 17 | -- todo implement 18 | -- colorMode(RGB, height, height, height); 19 | rectMode Center 20 | 21 | grey' = grey . remap (0, height) (0, 255) 22 | 23 | draw () = do 24 | background (grey 0) 25 | mx <- mouseX 26 | let r1 = remap (0, width) (0, height) mx 27 | r2 = height - r1 28 | 29 | fill (grey' r1) 30 | rect (P2 (width/2 + r1/2) (height/2)) (P2 r1 r1) 31 | 32 | fill (grey' r2) 33 | rect (P2 (width/2 - r2/2) (height/2)) (P2 r2 r2) 34 | -------------------------------------------------------------------------------- /examples/Input/Mouse2D.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/mouse2d.html 2 | 3 | -- Mouse 2D. 4 | -- 5 | -- Moving the mouse changes the position and size of each box. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw } 9 | 10 | width = 640 11 | height = 360 12 | 13 | setup = do 14 | size (P2 width height) 15 | noStroke 16 | -- todo implement 17 | rectMode Center 18 | 19 | draw () = do 20 | background (grey 51) 21 | m@(P2 mx my) <- mouse 22 | 23 | fill (greya 255 204) 24 | rect (P2 mx (height/2)) (0.5 *^ (P2 my my) + 10) 25 | 26 | let inverseX = width - mx 27 | inverseY = height - my 28 | 29 | fill (greya 255 204) 30 | rect (P2 inverseX (height/2)) (0.5 *^ (P2 inverseY inverseY) + 10) 31 | -------------------------------------------------------------------------------- /examples/Input/MouseFunctions.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/mousefunctions.html 2 | 3 | -- Mouse Functions. 4 | -- 5 | -- Click on the box and drag it across the screen. 6 | import Data.Maybe 7 | import Graphics.Proc hiding (scale) 8 | 9 | main = runProc $ def 10 | { procSetup = setup, procDraw = draw, procUpdate = update 11 | , procMousePressed = mousePressed, procMouseReleased = mouseReleased } 12 | 13 | width = 640 14 | height = 360 15 | 16 | boxSize = 75 17 | center = 0.5 *^ (P2 width height) 18 | 19 | setup = do 20 | size (P2 width height) 21 | rectMode Radius 22 | noStroke 23 | return (center, mlockPoint) 24 | where mlockPoint = Nothing 25 | 26 | getCol lockPoint 27 | | isLocked = grey 255 28 | | otherwise = grey 153 29 | where isLocked = isJust lockPoint 30 | 31 | draw (pos, lockPoint) = do 32 | background (grey 0) 33 | stroke (grey 255) 34 | fill (getCol lockPoint) 35 | rect pos (P2 boxSize boxSize) 36 | 37 | update st@(pos, mlockPoint) = case mlockPoint of 38 | Just lockPoint -> do 39 | m <- mouse 40 | let pos1 = m + lockPoint 41 | return (pos1, mlockPoint) 42 | Nothing -> return st 43 | 44 | mousePressed = whenWhithin $ \m (pos, _) -> (pos, Just (pos - m)) 45 | mouseReleased = whenWhithin $ \_ (pos, _) -> (pos, Nothing) 46 | 47 | whenWhithin f (pos, value) = do 48 | m <- mouse 49 | return $ if (withinRect m pos) 50 | then f m (pos, value) 51 | else (pos, value) 52 | 53 | withinRect (P2 mx my) (P2 px py) = 54 | mx >= (px - boxSize) && mx < (px + boxSize) && 55 | my >= (py - boxSize) && my < (py + boxSize) 56 | -------------------------------------------------------------------------------- /examples/Input/MousePress.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/mousepress.html 2 | 3 | -- Mouse Press. 4 | -- 5 | -- Move the mouse to position the shape. Press the mouse button to invert the color. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw, procMousePressed = mousePressed, procMouseReleased = mouseReleased } 9 | 10 | width = 640 11 | height = 360 12 | 13 | setup = do 14 | size (P2 width height) 15 | noSmooth 16 | fill (grey 126) 17 | background (grey 102) 18 | return 0 19 | 20 | draw col = do 21 | stroke (grey col) 22 | (P2 mX mY) <- mouse 23 | line (P2 (mX-66) mY) (P2 (mX+66) mY) 24 | line (P2 mX (mY-66)) (P2 mX (mY+66)) 25 | 26 | mousePressed _ = return 255 27 | mouseReleased _ = return 0 28 | -------------------------------------------------------------------------------- /examples/Input/MouseSignals.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/mousesignals.html 2 | 3 | -- Mouse Signals. 4 | -- 5 | -- Move and click the mouse to generate signals. The top row is the signal 6 | -- from "mouseX", the middle row is the signal from "mouseY", and the 7 | -- bottom row is the signal from "mousePressed". 8 | import qualified Data.Sequence as S 9 | import Data.Foldable 10 | 11 | import Graphics.Proc 12 | 13 | main = runProc $ def { 14 | procSetup = setup, procDraw = draw, procUpdate = update, 15 | procMousePressed = mousePressed, procMouseReleased = mouseReleased } 16 | 17 | width = 640 18 | height = 360 19 | 20 | initQueue x = S.fromList $ take (int width) $ repeat x 21 | 22 | setup = do 23 | size (P2 width height) 24 | noSmooth 25 | return (initQueue 0, initQueue 0, initQueue 1, False) 26 | 27 | draw (xs, ys, ps, _) = do 28 | background (grey 102) 29 | fill (grey 255) 30 | noStroke 31 | rect (P2 0 (height/3 - 2)) (P2 width (height/3 + 2)) 32 | 33 | stroke (grey 255) 34 | pointSeq $ fmap (/ 3) xs 35 | 36 | stroke (grey 0) 37 | pointSeq $ fmap (\y -> height/3+y/3) ys 38 | 39 | stroke (grey 255) 40 | lineSeq $ fmap (\p -> 2*height/3 + p/3 + 7) ps 41 | 42 | pointSeq xs = pointPath $ toPoints xs 43 | lineSeq xs = linePath $ toPoints xs 44 | toPoints xs = zipWith P2 [1 .. width] (toList xs) 45 | 46 | update (xs, ys, ps, isPress) = do 47 | (P2 mx my) <- mouse 48 | return (put mx xs, put my ys, put (if isPress then 0 else 255) ps, isPress) 49 | 50 | put value xs = S.drop 1 xs S.|> value 51 | 52 | mousePressed (xs, ys, ps, _) = return (xs, ys, ps, True) 53 | mouseReleased (xs, ys, ps, _) = return (xs, ys, ps, False) 54 | -------------------------------------------------------------------------------- /examples/Input/StoringInput.hs: -------------------------------------------------------------------------------- 1 | -- Storing Input. 2 | -- 3 | -- Move the mouse across the screen to change the position of the circles. 4 | -- The positions of the mouse are recorded into an array and played back 5 | -- every frame. Between each frame, the newest value are added to the end 6 | -- of each array and the oldest value is deleted. 7 | import qualified Data.Sequence as S 8 | import Data.Foldable 9 | 10 | import Graphics.Proc 11 | 12 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 13 | 14 | width = 640 15 | height = 360 16 | 17 | center = 0.5 *^ (P2 width height) 18 | num = 60 19 | 20 | initQueue x = S.fromList $ take (int num) $ repeat x 21 | 22 | setup = do 23 | size (P2 width height) 24 | noStroke 25 | fill (greya 255 153) 26 | return (initQueue center) 27 | 28 | draw ps = do 29 | background (grey 51) 30 | forM_ (zip [0 .. num] (toList ps)) $ \(i, p) -> do 31 | fill (greya 255 (255 - 3 * num)) 32 | ellipse p (P2 i i) 33 | 34 | update ps = do 35 | m <- mouse 36 | return (put m ps) 37 | 38 | put value xs = S.drop 1 xs S.|> value 39 | -------------------------------------------------------------------------------- /examples/Math/AdditiveWave.hs: -------------------------------------------------------------------------------- 1 | -- originaal code: https://processing.org/examples/additivewave.html 2 | 3 | -- Additive Wave by Daniel Shiffman. 4 | -- 5 | -- Create a more complex wave by adding two waves together. 6 | import Data.List 7 | 8 | import Graphics.Proc 9 | 10 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 11 | 12 | width = 640 13 | height = 360 14 | 15 | xspacing = 8 -- How far apart should each horizontal location be spaced 16 | w = width + 16 -- Width of entire wave 17 | maxwaves = 4 -- total # of waves to add together 18 | npoints = int $ w / xspacing 19 | 20 | theta = 0.0 21 | 22 | -- amplitudes -- Height of wave 23 | -- dxs -- Value for incrementing X, to be calculated as a function of period and xspacing 24 | 25 | setup = do 26 | size (P2 width height) 27 | frameRate 30 28 | -- colorMode(RGB, 255, 255, 255, 100) 29 | (amplitudes, periods) <- fmap unzip $ forM [0 .. maxwaves] $ \i -> do 30 | amplitude <- random2 (10, 30) 31 | period <- random2 (100, 300) 32 | return (amplitude, period) 33 | let dxs = fmap (\period -> (2 * pi / period) * xspacing) periods 34 | return (theta, amplitudes, dxs) 35 | where theta = 0 36 | 37 | draw (theta, amplitudes, dxs) = do 38 | background (grey 0) 39 | renderWave (calcWave theta amplitudes dxs) 40 | 41 | -- Increment theta (try different values for 'angular velocity' here 42 | update (theta, amplitudes, dxs) = 43 | return (theta + 0.012, amplitudes, dxs) 44 | 45 | calcWave theta amplitudes dxs = 46 | fmap sum $ transpose $ zipWith3 (wave1 theta) amplitudes dxs [0 .. maxwaves] 47 | 48 | wave1 theta amplitude dx n = take npoints $ fmap (\x -> dx + amplitude * func (x + theta)) [0, dx .. ] 49 | where 50 | func 51 | | n `mod` 2 == 0 = sin 52 | | otherwise = cos 53 | 54 | 55 | renderWave ys = do 56 | -- A simple way to draw the wave with an ellipse at each location 57 | noStroke 58 | fill (greya 255 78) 59 | ellipseMode Center 60 | forM_ (zip [0 .. npoints] ys) $ \(x, y) -> do 61 | ellipse (P2 (float x * xspacing) (height/2+y)) 16 62 | -------------------------------------------------------------------------------- /examples/Math/Arctangent.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/arctangent.html 2 | 3 | -- Arctangent. 4 | -- 5 | -- Move the mouse to change the direction of the eyes. The atan2() function computes the angle from each eye to the cursor. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 9 | 10 | data Eye = Eye 11 | { eyePos :: !P2 12 | , eyeSize :: !Float 13 | , eyeAngle :: !Float 14 | } 15 | 16 | width = 640 17 | height = 360 18 | 19 | setup = do 20 | size (P2 width height) 21 | noStroke 22 | return [e1, e2, e3] 23 | where 24 | e1 = Eye (P2 250 16) 120 0 25 | e2 = Eye (P2 164 185) 80 0 26 | e3 = Eye (P2 420 230) 220 0 27 | 28 | draw eyes = do 29 | background (grey 102) 30 | mapM_ drawEye eyes 31 | 32 | update eyes = do 33 | m <- mouse 34 | return $ fmap (updateEye m) eyes 35 | 36 | drawEye x = local $ do 37 | translate (eyePos x) 38 | fill (grey 255) 39 | ellipse 0 sz 40 | rotate (eyeAngle x) 41 | fill (rgb 153 204 0) 42 | ellipse (P2 (eyeSize x / 4) 0) (0.5 *^ sz) 43 | where 44 | sz = P2 (eyeSize x) (eyeSize x) 45 | 46 | updateEye m eye = eye { eyeAngle = remap (0, 2 * pi) (0, 1) (atan2 y x) } 47 | where 48 | (P2 x y) = m - eyePos eye 49 | -------------------------------------------------------------------------------- /examples/Math/Distance1D.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/distance1d.html 2 | 3 | -- Distance 1D. 4 | -- 5 | -- Move the mouse left and right to control the speed and direction of the moving shapes. 6 | 7 | import Graphics.Proc 8 | 9 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 10 | 11 | width = 640 12 | height = 360 13 | 14 | thin = 8 15 | thick = 36 16 | 17 | setup = do 18 | size (P2 width height) 19 | noStroke 20 | return (xpos1, xpos2, xpos3, xpos4) 21 | where 22 | xpos1 = width/2 23 | xpos2 = width/2 24 | xpos3 = width/2 25 | xpos4 = width/2 26 | 27 | draw (xpos1, xpos2, xpos3, xpos4) = do 28 | background (grey 0) 29 | 30 | fill (grey 102) 31 | rect (P2 xpos2 0) (P2 thick (height/2)) 32 | fill (grey 204) 33 | rect (P2 xpos1 0) (P2 thin (height/2)) 34 | fill (grey 102) 35 | rect (P2 xpos4 (height/2)) (P2 thick (height/2)) 36 | fill (grey 204) 37 | rect (P2 xpos3 (height/2)) (P2 thin (height/2)) 38 | 39 | 40 | update (xpos1, xpos2, xpos3, xpos4) = do 41 | mX <- mouseX 42 | let mx = mX * 0.4 - width / 5 43 | xpos1' = withinBounds (xpos1 + coeff * mx/16) 44 | xpos2' = withinBounds (xpos2 + coeff * mx/64) 45 | xpos3' = withinBounds (xpos3 - coeff * mx/16) 46 | xpos4' = withinBounds (xpos4 - coeff * mx/64) 47 | return (xpos1', xpos2', xpos3', xpos4') 48 | where 49 | withinBounds value = 50 | if (value < -thin) 51 | then width 52 | else 53 | if (value > width) 54 | then -thin 55 | else value 56 | coeff = 0.6 57 | -------------------------------------------------------------------------------- /examples/Math/Distance2D.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/distance2d.html 2 | 3 | -- Distance 2D. 4 | -- 5 | -- Move the mouse across the image to obscure and reveal the matrix. 6 | -- Measures the distance from the mouse to each square and sets the 7 | -- size proportionally. 8 | 9 | import Graphics.Proc 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw } 12 | 13 | width = 640 14 | height = 360 15 | 16 | thin = 8 17 | thick = 36 18 | 19 | setup = do 20 | size (P2 width height) 21 | noStroke 22 | fill (grey 255) 23 | 24 | maxDistance = distance (P2 0 0) (P2 width height) 25 | 26 | draw () = do 27 | background (grey 0) 28 | m <- mouse 29 | forM_ [0, 20 .. width] $ \i -> do 30 | forM_ [0, 20 .. height] $ \j -> do 31 | let s = distance m (P2 i j) / maxDistance * 66 32 | ellipse (P2 i j) (P2 s s) 33 | 34 | ---------------------------------------- 35 | -- Side note 36 | -- 37 | -- We use the function `distance` that is re-exported with vector-space package. 38 | 39 | -------------------------------------------------------------------------------- /examples/Math/DoubleRandom.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/doublerandom.html 2 | 3 | -- Double Random by Ira Greenberg. 4 | -- 5 | -- Using two random() calls and the point() function to create an irregular sawtooth line. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw } 9 | 10 | width = 640 11 | height = 360 12 | 13 | totalPts = 300 14 | steps = totalPts + 1 15 | dx = width / steps 16 | 17 | setup = do 18 | size (P2 width height) 19 | stroke (grey 255) 20 | frameRate 1 21 | randRef <- newPioRef 0 22 | return randRef 23 | 24 | draw randRef = do 25 | background (grey 0) 26 | writePioRef randRef 0 27 | forM_ [0 .. steps ] $ \i -> do 28 | rand <- readPioRef randRef 29 | r1 <- random2 (-rand, rand) 30 | point (P2 (dx * i) (height / 2 + r1)) 31 | r2 <- random2 (-5, 5) 32 | modifyPioRef randRef (+ r2) 33 | -------------------------------------------------------------------------------- /examples/Math/Graphing2D.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/graphing2dequation.html 2 | 3 | -- Graphing 2D Equations by Daniel Shiffman. 4 | -- 5 | -- Graphics the following equation: sin(n*cos(r) + 5*theta) where n is a function of horizontal mouse location. 6 | 7 | -- requires Imagr drawing capabilities which are not implemented. 8 | 9 | void setup() { 10 | size(640, 360); 11 | } 12 | 13 | void draw() { 14 | loadPixels(); 15 | float n = (mouseX * 10.0) / width; 16 | float w = 16.0; // 2D space width 17 | float h = 16.0; // 2D space height 18 | float dx = w / width; // Increment x this amount per pixel 19 | float dy = h / height; // Increment y this amount per pixel 20 | float x = -w/2; // Start x at -1 * width / 2 21 | for (int i = 0; i < width; i++) { 22 | float y = -h/2; // Start y at -1 * height / 2 23 | for (int j = 0; j < height; j++) { 24 | float r = sqrt((x*x) + (y*y)); // Convert cartesian to polar 25 | float theta = atan2(y,x); // Convert cartesian to polar 26 | // Compute 2D polar coordinate function 27 | float val = sin(n*cos(r) + 5 * theta); // Results in a value between -1 and 1 28 | //float val = cos(r); // Another simple function 29 | //float val = sin(theta); // Another simple function 30 | // Map resulting vale to grayscale value 31 | pixels[i+j*width] = color((val + 1.0) * 255.0/2.0); // Scale to between 0 and 255 32 | y += dy; // Increment y 33 | } 34 | x += dx; // Increment x 35 | } 36 | updatePixels(); 37 | } 38 | 39 | -------------------------------------------------------------------------------- /examples/Math/IncrementDecrement.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/incrementdecrement.html 2 | 3 | -- Increment Decrement. 4 | -- 5 | -- Writing "a++" is equivalent to "a = a + 1". Writing "a--" is equivalent to "a = a - 1". 6 | -- but in Haskell there is no such operator we can just update values. 7 | import Graphics.Proc 8 | 9 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 10 | 11 | width = 640 12 | height = 360 13 | 14 | setup = do 15 | size (P2 width height) 16 | -- not implemented 17 | -- colorMode(RGB, width) 18 | frameRate 30 19 | return (a, b, direction) 20 | where 21 | a = 0 22 | b = width 23 | direction = True 24 | 25 | stroke' n = stroke (grey $ 255 * n / width) 26 | 27 | draw (a, b, direction) = do 28 | if direction 29 | then stroke' a 30 | else stroke' (width - a) 31 | line (P2 a 0) (P2 a (height / 2)) 32 | 33 | if direction 34 | then stroke' (width - b) 35 | else stroke' b 36 | line (P2 b (height/2+1)) (P2 b height) 37 | 38 | update (a, b, direction) = return (a1, b1, direction1) 39 | where 40 | a1 = if (a > width) then 0 else a + 1 41 | b1 = if (b < 0) then width else b - 1 42 | direction1 = if (a > width) then not direction else direction 43 | -------------------------------------------------------------------------------- /examples/Math/Interpolate.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/interpolate.html 2 | 3 | -- Linear Interpolation. 4 | -- 5 | -- Move the mouse across the screen and the symbol will follow. 6 | -- Between drawing each frame of the animation, the ellipse moves 7 | -- part of the distance (0.05) from its current position toward 8 | -- the cursor using the lerp() function * This is the same as 9 | -- the Easing under input only with lerp() instead. 10 | import Graphics.Proc 11 | 12 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 13 | 14 | width = 640 15 | height = 360 16 | center = 0.5 *^ (P2 width height) 17 | 18 | setup = do 19 | size (P2 width height) 20 | noStroke 21 | return center 22 | 23 | draw pos = do 24 | background (grey 51) 25 | fill (grey 255) 26 | ellipse pos 66 27 | 28 | update pos = do 29 | m <- mouse 30 | return (lerp pos m 0.05) 31 | 32 | ----------------------------------------- 33 | -- Side note 34 | -- 35 | -- In Haskell `lerp` is defined not only for floats but also for vectors. 36 | -------------------------------------------------------------------------------- /examples/Math/Map.hs: -------------------------------------------------------------------------------- 1 | -- Map. 2 | -- 3 | -- Use the map() function to take any number and scale it to a new 4 | -- number that is more useful for the project that you are working on. 5 | -- For example, use the numbers from the mouse position to control 6 | -- the size or color of a shape. In this example, the mouse’s x-coordinate 7 | -- (numbers between 0 and 360) are scaled to new numbers to define the 8 | -- color and size of a circle. 9 | import Graphics.Proc 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw } 12 | 13 | width = 640 14 | height = 360 15 | 16 | center = 0.5 *^ (P2 width height) 17 | 18 | setup = do 19 | size (P2 width height) 20 | noStroke 21 | 22 | draw () = do 23 | background (grey 0) 24 | mx <- mouseX 25 | -- Scale the mouseX value from 0 to 640 to a range between 0 and 175 26 | let c = remap (0, width) (0, 175) mx 27 | -- Scale the mouseX value from 0 to 640 to a range between 40 and 300 28 | d = remap (0, width) (20, 150) mx 29 | fill (rgb 255 c 0) 30 | circle d center 31 | 32 | ------------------------------------------------ 33 | -- Side note 34 | 35 | -- Haskell already has the function map, so the Processing's function is called `remap`. 36 | -------------------------------------------------------------------------------- /examples/Math/Noise1D.hs: -------------------------------------------------------------------------------- 1 | -- Noise1D. 2 | -- 3 | -- Using 1D Perlin Noise to assign location. 4 | 5 | -- todo check out the Perlin noise implementation. I'm not sure that init params are right 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 9 | 10 | width = 640 11 | height = 360 12 | 13 | xincrement = 0.01 14 | 15 | setup = do 16 | size (P2 width height) 17 | noStroke 18 | background (grey 0) 19 | return xoff 20 | where xoff = 0.0 21 | 22 | draw xoff = do 23 | fill (greya 0 10) 24 | rect 0 (P2 width height) 25 | n <- fmap (* width) $ noise1 xoff 26 | fill (grey 200) 27 | ellipse (P2 n (height/2)) 64 28 | 29 | update xoff = return (xoff + xincrement) 30 | -------------------------------------------------------------------------------- /examples/Math/Noise2D.hs: -------------------------------------------------------------------------------- 1 | -- Image functions are not implemented yet 2 | 3 | -- original code: https://processing.org/examples/noise2d.html 4 | 5 | -- Noise2D by Daniel Shiffman. 6 | -- 7 | -- Using 2D noise to create simple texture. 8 | 9 | 10 | float increment = 0.02; 11 | 12 | void setup() { 13 | size(640, 360); 14 | } 15 | 16 | void draw() { 17 | 18 | loadPixels(); 19 | 20 | float xoff = 0.0; // Start xoff at 0 21 | float detail = map(mouseX, 0, width, 0.1, 0.6); 22 | noiseDetail(8, detail); 23 | 24 | // For every x,y coordinate in a 2D space, calculate a noise value and produce a brightness value 25 | for (int x = 0; x < width; x++) { 26 | xoff += increment; // Increment xoff 27 | float yoff = 0.0; // For every xoff, start yoff at 0 28 | for (int y = 0; y < height; y++) { 29 | yoff += increment; // Increment yoff 30 | 31 | // Calculate noise and scale by 255 32 | float bright = noise(xoff, yoff) * 255; 33 | 34 | // Try using this line instead 35 | //float bright = random(0,255); 36 | 37 | // Set each pixel onscreen to a grayscale value 38 | pixels[x+y*width] = color(bright); 39 | } 40 | } 41 | 42 | updatePixels(); 43 | } 44 | 45 | 46 | 47 | -------------------------------------------------------------------------------- /examples/Math/Noise3D.hs: -------------------------------------------------------------------------------- 1 | -- Image functions are not implemented yet 2 | 3 | -- original code: https://processing.org/examples/noise3d.html 4 | 5 | -- Noise3D. 6 | -- 7 | -- Using 3D noise to create simple animated texture. Here, the third dimension ('z') is treated as time. 8 | 9 | 10 | float increment = 0.01; 11 | // The noise function's 3rd argument, a global variable that increments once per cycle 12 | float zoff = 0.0; 13 | // We will increment zoff differently than xoff and yoff 14 | float zincrement = 0.02; 15 | 16 | void setup() { 17 | size(640, 360); 18 | frameRate(30); 19 | } 20 | 21 | void draw() { 22 | 23 | // Optional: adjust noise detail here 24 | // noiseDetail(8,0.65f); 25 | 26 | loadPixels(); 27 | 28 | float xoff = 0.0; // Start xoff at 0 29 | 30 | // For every x,y coordinate in a 2D space, calculate a noise value and produce a brightness value 31 | for (int x = 0; x < width; x++) { 32 | xoff += increment; // Increment xoff 33 | float yoff = 0.0; // For every xoff, start yoff at 0 34 | for (int y = 0; y < height; y++) { 35 | yoff += increment; // Increment yoff 36 | 37 | // Calculate noise and scale by 255 38 | float bright = noise(xoff,yoff,zoff)*255; 39 | 40 | // Try using this line instead 41 | //float bright = random(0,255); 42 | 43 | // Set each pixel onscreen to a grayscale value 44 | pixels[x+y*width] = color(bright,bright,bright); 45 | } 46 | } 47 | updatePixels(); 48 | 49 | zoff += zincrement; // Increment zoff 50 | 51 | 52 | } 53 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /examples/Math/NoiseWave.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/noisewave.html 2 | 3 | -- Noise Wave by Daniel Shiffman. 4 | -- 5 | -- Using Perlin Noise to generate a wave-like pattern. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 9 | 10 | width = 640 11 | height = 360 12 | 13 | setup = do 14 | size (P2 width height) 15 | return 0 16 | 17 | draw yoff = do 18 | background (grey 51) 19 | stroke (grey 255) 20 | 21 | ps <- forM (zip [0, 10 .. width] [0, 0.05 ..]) $ \(x, xoff) -> do 22 | y <- fmap (remap (0, 1) (200, 300)) $ noise2 (P2 xoff yoff) 23 | return (P2 x y) 24 | 25 | linePath ps 26 | 27 | update yoff = return (yoff + 0.01) 28 | 29 | 30 | -------------------------------- 31 | -- Side note 32 | -- 33 | -- Original code uses polygones to draw shapes but in Hskell 34 | -- drawing of polygons is not available right now. 35 | 36 | {- 37 | float yoff = 0.0; // 2nd dimension of perlin noise 38 | 39 | 40 | void draw() { 41 | background(51); 42 | 43 | fill(255); 44 | // We are going to draw a polygon out of the wave points 45 | beginShape(); 46 | 47 | float xoff = 0; // Option #1: 2D Noise 48 | // float xoff = yoff; // Option #2: 1D Noise 49 | 50 | // Iterate over horizontal pixels 51 | for (float x = 0; x <= width; x += 10) { 52 | // Calculate a y value according to noise, map to 53 | float y = map(noise(xoff, yoff), 0, 1, 200,300); // Option #1: 2D Noise 54 | // float y = map(noise(xoff), 0, 1, 200,300); // Option #2: 1D Noise 55 | 56 | // Set the vertex 57 | vertex(x, y); 58 | // Increment x dimension for noise 59 | xoff += 0.05; 60 | } 61 | // increment y dimension for noise 62 | yoff += 0.01; 63 | vertex(width, height); 64 | vertex(0, height); 65 | endShape(CLOSE); 66 | } 67 | -} 68 | -------------------------------------------------------------------------------- /examples/Math/PolarToCortesian.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/polartocartesian.html 2 | 3 | -- PolarToCartesian by Daniel Shiffman. 4 | -- 5 | -- Convert a polar coordinate (r,theta) to cartesian (x,y): x = rcos(theta) y = rsin(theta) 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 9 | 10 | width = 640 11 | height = 360 12 | center = 0.5 *^ (P2 width height) 13 | 14 | radius = height * 0.45 15 | thetaAcc = 0.0001 16 | 17 | setup = do 18 | size (P2 width height) 19 | return (0, 0) 20 | 21 | draw (theta, thetaVel) = do 22 | background (grey 0) 23 | translate center 24 | ellipseMode Center 25 | noStroke 26 | fill (grey 200) 27 | ellipse p 32 28 | where 29 | p = polarToCartesian (P2 radius theta) 30 | 31 | update (theta, thetaVel) = return (theta1, thetaVel1) 32 | where 33 | theta1 = theta + thetaVel1 34 | thetaVel1 = thetaVel + thetaAcc 35 | 36 | polarToCartesian :: P2 -> P2 37 | polarToCartesian (P2 r theta) = r *^ P2 (cos theta) (sin theta) 38 | -------------------------------------------------------------------------------- /examples/Math/Random.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/random.html 2 | 3 | -- Random. 4 | -- 5 | -- Random numbers create the basis of this image. Each time the program is loaded the result is different. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw } 9 | 10 | width = 640 11 | height = 360 12 | 13 | setup = do 14 | size (P2 width height) 15 | strokeWeight 20 16 | frameRate 2 17 | 18 | draw () = do 19 | forM_ [0 .. width] $ \i -> do 20 | r <- random 255 21 | stroke (grey r) 22 | line (P2 i 0) (P2 i height) 23 | -------------------------------------------------------------------------------- /examples/Math/RandomGaussian.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/randomgaussian.html 2 | 3 | -- Random Gaussian. 4 | -- 5 | -- This sketch draws ellipses with x and y locations tied to a gaussian distribution of random numbers. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw } 9 | 10 | width = 640 11 | height = 360 12 | 13 | totalPts = 300 14 | steps = totalPts + 1 15 | dx = width / steps 16 | 17 | setup = do 18 | size (P2 width height) 19 | background (grey 0) 20 | 21 | draw () = do 22 | drawCircle =<< getRnd 23 | 24 | drawCircle x = do 25 | noStroke 26 | fill (greya 255 10) 27 | ellipse (P2 x (height/2)) (P2 32 32) 28 | 29 | getRnd = do 30 | value <- randomGaussian 31 | return (( value * sd ) + mean) 32 | 33 | sd = 60 -- Define a standard deviation 34 | mean = width/2 -- Define a mean value (middle of the screen along the x-axis) 35 | -------------------------------------------------------------------------------- /examples/Math/Sine.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/sine.html 2 | 3 | -- Sine. 4 | -- 5 | -- Smoothly scaling size with the sin() function. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 9 | 10 | width = 640 11 | height = 360 12 | 13 | diameter = height - 10 14 | 15 | setup = do 16 | size (P2 width height) 17 | noStroke 18 | fill (rgb 255 204 0) 19 | return angle 20 | where angle = 0 21 | 22 | draw angle = do 23 | background (grey 0) 24 | circle d1 (P2 0 (height/2)) 25 | circle d2 (P2 (width/2) (height/2)) 26 | circle d3 (P2 width (height/2)) 27 | where 28 | d1 = 0.5 * (10 + (sin(angle) * diameter/2) + diameter/2) 29 | d2 = 0.5 * (10 + (sin(angle + pi/2) * diameter/2) + diameter/2) 30 | d3 = 0.5 * (10 + (sin(angle + pi) * diameter/2) + diameter/2) 31 | 32 | update angle = return (angle + 0.03) 33 | -------------------------------------------------------------------------------- /examples/Math/SineCosine.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/sinecosine.html 2 | 3 | -- Sine Cosine. 4 | -- 5 | -- Linear movement with sin() and cos(). Numbers between 0 and PI*2 (TWO_PI which angles roughly 6.28) 6 | -- are put into these functions and numbers between -1 and 1 are returned. These values 7 | -- are then scaled to produce larger movements. 8 | import Graphics.Proc 9 | 10 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 11 | 12 | width = 640 13 | height = 360 14 | 15 | center = 0.5 *^ (P2 width height) 16 | 17 | setup = do 18 | size (P2 width height) 19 | noStroke 20 | rectMode Center 21 | return (P2 0 0) 22 | 23 | scalar = 70 24 | 25 | draw (P2 angle1 angle2) = do 26 | background (grey 0) 27 | fill (grey 255) 28 | rect (P2 (width*0.5) (height*0.5)) (P2 140 140) 29 | 30 | fill (rgb 0 102 153) 31 | ellipse (P2 x1 (height*0.5 - 120)) (P2 scalar scalar) 32 | ellipse (P2 x2 (height*0.5 + 120)) (P2 scalar scalar) 33 | 34 | fill (rgb 255 204 0) 35 | ellipse (P2 (width*0.5 - 120) y1) (P2 scalar scalar) 36 | ellipse (P2 (width*0.5 + 120) y2) (P2 scalar scalar) 37 | where 38 | ang1 = radians angle1 39 | ang2 = radians angle2 40 | 41 | er x = P2 (cos x) (sin x) 42 | (P2 x1 y1) = center + scalar *^ (er ang1) 43 | (P2 x2 y2) = center + scalar *^ (er ang2) 44 | 45 | update :: P2 -> Pio P2 46 | update angles = return $ angles + (P2 2 3) 47 | -------------------------------------------------------------------------------- /examples/Math/SineWave.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/sinewave.html 2 | -- 3 | -- Sine Wave by Daniel Shiffman. 4 | -- 5 | -- Render a simple sine wave. 6 | 7 | import Graphics.Proc 8 | 9 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 10 | 11 | width = 640 12 | height = 360 13 | 14 | xspacing = 16; -- How far apart should each horizontal location be spaced 15 | w = width + 16 -- Width of entire wave 16 | amplitude = 75.0 -- Height of wave 17 | period = 500.0 -- How many pixels before the wave repeats 18 | dx = (2 * pi / period) * xspacing -- Value for incrementing X, a function of period and xspacing 19 | npoints = int $ w / xspacing 20 | 21 | setup = do 22 | size (P2 width height) 23 | return theta 24 | where theta = 0.0 -- Start angle at 0 25 | 26 | draw theta = do 27 | background (grey 0) 28 | renderWave (calcWave theta) 29 | 30 | update theta = return (theta + 0.03) 31 | 32 | calcWave theta = take npoints $ fmap (\x -> amplitude * sin (x + theta)) [0, dx ..] 33 | 34 | renderWave ys = do 35 | noStroke 36 | fill (grey 255) 37 | forM_ (zip [0 .. npoints] ys) $ \(x, y) -> do 38 | ellipse (P2 (float x * xspacing) (height/2 + y)) 16 39 | -------------------------------------------------------------------------------- /examples/Structure/Coordinates.hs: -------------------------------------------------------------------------------- 1 | -- the original example: 2 | -- 3 | -- https://processing.org/examples/coordinates.html 4 | import Graphics.Proc 5 | 6 | main = runProc $ def { procSetup = setup, procDraw = draw } 7 | 8 | width = 640 9 | height = 360 10 | 11 | setup = do 12 | -- Sets the screen to be 640 pixels wide and 360 pixels high 13 | size (P2 width height) 14 | 15 | draw () = do 16 | -- Set the background to black and turn off the fill color 17 | background (grey 0) 18 | noFill 19 | 20 | -- The parameter of the point function specifies coordinates. 21 | -- It's a pair of floats (x and y coordinate). 22 | stroke (grey 255) 23 | point (P2 (width * 0.5) (height * 0.5)) 24 | point (P2 (width * 0.5) (height * 0.25)) 25 | 26 | -- Coordinates are used for drawing all shapes, not just points. 27 | -- Parameters for different functions are used for different purposes. 28 | -- For example, the first parameter to line() specifies 29 | -- the coordinates of the first endpoint and the second prameter 30 | -- specifies the second endpoint 31 | stroke (rgb 0 153 255) 32 | line (P2 0 (height * 0.33)) (P2 width (height * 0.33)) 33 | 34 | 35 | -- By default, the first two parameters to rect() are the 36 | -- coordinates of the upper-left corner and the second pair 37 | -- is the width and height 38 | stroke (rgb 255 153 0) 39 | rect (P2 (width*0.25) (height*0.1)) (P2 (width * 0.5) (height * 0.8)) 40 | 41 | 42 | --------------------------------------------- 43 | -- Sidenotes 44 | -- 45 | -- notice the usage of width and height constants. 46 | -- They have the different meaning from the values width and height 47 | -- in processing. 48 | -- 49 | -- Haskell names for processing width and height are winWidth and winHeight. 50 | -- But it's not so convenient to use as in Processing due to implicit sideeffect. 51 | -- Haskell makes that side effect explicit. So we should write 52 | -- 53 | -- > do 54 | -- > w <- winWidth 55 | -- > h <- winHeight 56 | -- 57 | -- But we can work it around with a simple trick. We just define constants width and height 58 | -- and then use them to set the sizes of the window: 59 | -- 60 | -- > setup = do 61 | -- > size (width, height) 62 | -- 63 | -- Then we can use them just like in processing. Because they are pure constant values. 64 | 65 | 66 | -------------------------------------------------------------------------------- /examples/Structure/CreateGraphics.hs: -------------------------------------------------------------------------------- 1 | -- original code 2 | -- 3 | -- https://processing.org/examples/creategraphics.html 4 | -- 5 | -- The PShape is not implemented yet 6 | 7 | {- 8 | PGraphics pg; 9 | 10 | void setup() { 11 | size(640, 360); 12 | pg = createGraphics(400, 200); 13 | } 14 | 15 | void draw() { 16 | fill(0, 12); 17 | rect(0, 0, width, height); 18 | fill(255); 19 | noStroke(); 20 | ellipse(mouseX, mouseY, 60, 60); 21 | 22 | pg.beginDraw(); 23 | pg.background(51); 24 | pg.noFill(); 25 | pg.stroke(255); 26 | pg.ellipse(mouseX-120, mouseY-60, 60, 60); 27 | pg.endDraw(); 28 | 29 | // Draw the offscreen buffer to the screen with image() 30 | image(pg, 120, 60); 31 | } 32 | 33 | -} -------------------------------------------------------------------------------- /examples/Structure/Functions.hs: -------------------------------------------------------------------------------- 1 | -- original code 2 | -- 3 | -- https://processing.org/examples/functions.html 4 | 5 | -- Functions. 6 | 7 | -- The drawTarget() function makes it easy to draw many distinct targets. 8 | -- Each call to drawTarget() specifies the position, 9 | -- size, and number of rings for each target. 10 | import Graphics.Proc 11 | 12 | main = runProc $ def { procSetup = setup, procDraw = draw } 13 | 14 | width = 640 15 | height = 360 16 | 17 | setup = do 18 | size (P2 width height) 19 | noStroke 20 | 21 | draw () = do 22 | background (grey 51) 23 | drawTarget (width*0.25) (height*0.4) 200 4 24 | drawTarget (width*0.5) (height*0.5) 300 10 25 | drawTarget (width*0.75) (height*0.3) 120 6 26 | 27 | drawTarget xloc yloc size num = do 28 | forM_ [0, 1 .. num] $ \i -> do 29 | fill (grey (i*grayvalues)) 30 | ellipse (P2 xloc yloc) (P2 (size - i*steps) (size - i*steps)) 31 | where 32 | grayvalues = 255/num 33 | steps = size/num 34 | -------------------------------------------------------------------------------- /examples/Structure/Loop.hs: -------------------------------------------------------------------------------- 1 | -- original code 2 | -- 3 | -- https://processing.org/examples/loop.html 4 | -- 5 | -- Loop. 6 | -- 7 | -- The loop() function causes draw() to execute continuously. If noLoop is 8 | -- called in setup() the draw() is only executed once. In this example 9 | -- click the mouse to execute loop(), which will cause the draw() 10 | -- the execute continuously. 11 | 12 | import Graphics.Proc 13 | 14 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update, procMousePressed = mousePressed } 15 | 16 | width = 640 17 | height = 360 18 | 19 | -- The statements in the setup() function 20 | -- execute once when the program begins 21 | setup = do 22 | size (P2 width height) 23 | stroke (grey 255) 24 | noLoop 25 | return (height / 2) 26 | 27 | -- The statements in draw() are executed until the 28 | -- program is stopped. Each statement is executed in 29 | -- sequence and after the last line is read, the first 30 | -- line is executed again. 31 | draw y = do 32 | background (grey 0) -- Clear the screen with a black background 33 | line (P2 0 y) (P2 width y) 34 | 35 | update y 36 | | y < 0 = return height 37 | | otherwise = return (y - 1) 38 | 39 | mousePressed y = do 40 | loop 41 | return y 42 | 43 | ------------------------------------------------ 44 | -- Notice that in haskell we use two separate functions to 45 | -- draw the state and to update it. 46 | -------------------------------------------------------------------------------- /examples/Structure/NoLoop.hs: -------------------------------------------------------------------------------- 1 | -- original code 2 | -- 3 | -- https://processing.org/examples/noloop.html 4 | 5 | -- No Loop. 6 | -- 7 | -- The noLoop() function causes draw() to only execute once. 8 | -- Without calling noLoop(), the code inside draw() is run continually. 9 | import Graphics.Proc 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 12 | 13 | width = 640 14 | height = 360 15 | 16 | -- The statements in the setup() function 17 | -- execute once when the program begins 18 | setup = do 19 | size (P2 width height) 20 | stroke (grey 255) 21 | noLoop 22 | return (height / 2) 23 | 24 | -- The statements in draw() are executed until the 25 | -- program is stopped. Each statement is executed in 26 | -- sequence and after the last line is read, the first 27 | -- line is executed again. 28 | draw y = do 29 | background (grey 0) -- Clear the screen with a black background 30 | line (P2 0 y) (P2 width y) 31 | 32 | update y 33 | | y < 0 = return height 34 | | otherwise = return (y - 1) 35 | 36 | ------------------------------------------------ 37 | -- Notice that in haskell we use two separate functions to 38 | -- draw the state and to update it. 39 | -------------------------------------------------------------------------------- /examples/Structure/Recursion.hs: -------------------------------------------------------------------------------- 1 | -- original code 2 | -- 3 | -- https://processing.org/examples/recursion.html 4 | 5 | -- Recursion. 6 | -- 7 | -- A demonstration of recursion, which means functions call themselves. 8 | -- Notice how the drawCircle() function calls itself at the end of its block. 9 | -- It continues to do this until the variable "level" is equal to 1. 10 | 11 | import Graphics.Proc 12 | 13 | main = runProc $ def { procSetup = setup, procDraw = draw } 14 | 15 | width = 640 16 | height = 360 17 | 18 | setup = do 19 | size (P2 width height) 20 | noStroke 21 | 22 | draw () = do 23 | background (grey 255) 24 | drawCircle (width/2) 280 6 25 | 26 | drawCircle x radius level = do 27 | let tt = 126 * level/4.0 28 | fill (grey tt) 29 | ellipse (P2 x (height/2)) (P2 (radius*2) (radius*2)) 30 | if (level > 1) 31 | then do 32 | let newLevel = level - 1 33 | drawCircle (x - radius/2) (radius/2) newLevel 34 | drawCircle (x + radius/2) (radius/2) newLevel 35 | else do 36 | return () 37 | -------------------------------------------------------------------------------- /examples/Structure/Redraw.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/redraw.html 2 | 3 | -- Redraw. 4 | -- 5 | -- The redraw() function makes draw() execute once. In this example, draw() 6 | -- is executed once every time the mouse is clicked. 7 | 8 | import Graphics.Proc 9 | 10 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update, procMousePressed = mousePressed } 11 | 12 | width = 640 13 | height = 360 14 | 15 | -- The statements in the setup() function 16 | -- execute once when the program begins 17 | setup = do 18 | size (P2 width height) 19 | stroke (grey 255) 20 | noLoop 21 | return (height / 2) 22 | 23 | -- The statements in draw() are executed until the 24 | -- program is stopped. Each statement is executed in 25 | -- sequence and after the last line is read, the first 26 | -- line is executed again. 27 | draw y = do 28 | background (grey 0) -- Clear the screen with a black background 29 | line (P2 0 y) (P2 width y) 30 | 31 | update y 32 | | y < 0 = return height 33 | | otherwise = return (y - 4) 34 | 35 | mousePressed y = do 36 | redraw 37 | return y 38 | 39 | ------------------------------------------------ 40 | -- Notice that in haskell we use two separate functions to 41 | -- draw the state and to update it. 42 | -------------------------------------------------------------------------------- /examples/Structure/SetupAndDraw.hs: -------------------------------------------------------------------------------- 1 | -- original code: 2 | -- 3 | -- https://processing.org/examples/setupdraw.html 4 | -- 5 | -- The code inside the draw() function runs continuously from top to bottom until the program is stopped. 6 | import Graphics.Proc 7 | 8 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 9 | 10 | width = 640 11 | height = 360 12 | 13 | -- The statements in the setup() function 14 | -- execute once when the program begins 15 | setup = do 16 | size (P2 width height) 17 | stroke (grey 255) 18 | frameRate 30 19 | return 100 20 | 21 | -- The statements in draw() are executed until the 22 | -- program is stopped. Each statement is executed in 23 | -- sequence and after the last line is read, the first 24 | -- line is executed again. 25 | draw y = do 26 | background (grey 0) -- Clear the screen with a black background 27 | line (P2 0 y) (P2 width y) 28 | 29 | update y 30 | | y < 0 = return height 31 | | otherwise = return (y - 1) 32 | 33 | ------------------------------------------------ 34 | -- Notice that in haskell we use two separate functions to 35 | -- draw the state and to update it. 36 | -------------------------------------------------------------------------------- /examples/Structure/StatementsAndComments.hs: -------------------------------------------------------------------------------- 1 | -- the original example: 2 | -- 3 | -- https://processing.org/examples/statementscomments.html 4 | -- 5 | -- Note that in processing if we want to produce static picture 6 | -- we can write statments at the top-level. But in haskell we have to use callbacks. 7 | -- We initialize window in the setup function and draw the picture at the draw function. 8 | -- If we want it to be static we can just draw the same picture over and over again. 9 | import Graphics.Proc 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw } 12 | 13 | -- The size function is a statement that tells the computer 14 | -- how large to make the window. 15 | -- Each function statement has zero or more parameters. 16 | -- Parameters are data passed into the function 17 | -- and are used as values for telling the computer what to do. 18 | -- 19 | -- the state type is unit or (). 20 | setup = do 21 | size (P2 640 360) 22 | 23 | -- The background function is a statement that tells the computer 24 | -- which color (or gray value) to make the background of the display window 25 | -- 26 | -- we make grey colors with function grey and rgb colors with rgb. 27 | draw () = do 28 | background (rgb 204 153 0) 29 | -------------------------------------------------------------------------------- /examples/Structure/WidthAndHeight.hs: -------------------------------------------------------------------------------- 1 | -- the original example: 2 | -- 3 | -- https://processing.org/examples/widthheight.html 4 | import Graphics.Proc 5 | 6 | main = runProc $ def { procSetup = setup, procDraw = draw } 7 | 8 | width = 640 9 | height = 360 10 | 11 | setup = do 12 | size (P2 width height) 13 | 14 | draw () = do 15 | background (grey 127) 16 | noStroke 17 | 18 | -- The forM_ is not a special construct of the language. 19 | -- It's a library function reexported with the module `Control.Monad`. 20 | -- the forM_ is the same as mapM_ but the order of arguments is reversed. 21 | forM_ [0, 20 .. height] $ \i -> do 22 | fill (rgb 129 206 15) 23 | rect (P2 0 i) (P2 width 10) 24 | fill (grey 255) 25 | rect (P2 i 0) (P2 10 height) 26 | 27 | --------------------------------------------- 28 | -- Sidenotes 29 | -- 30 | -- notice the usage of width and height constants. 31 | -- They have the different meaning from the values width and height 32 | -- in processing. 33 | -- 34 | -- Haskell names for processing width and height are winWidth and winHeight. 35 | -- But it's not so convenient to use as in Processing due to implicit sideeffect. 36 | -- Haskell makes that side effect explicit. So we should write 37 | -- 38 | -- > do 39 | -- > w <- winWidth 40 | -- > h <- winHeight 41 | -- 42 | -- But we can work it around with a simple trick. We just define constants width and height 43 | -- and then use them to set the sizes of the window: 44 | -- 45 | -- > setup = do 46 | -- > size (width, height) 47 | -- 48 | -- Then we can use them just like in processing. Because they are pure constant values. 49 | -------------------------------------------------------------------------------- /examples/Transform/Arm.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/arm.html 2 | 3 | -- Arm. 4 | -- 5 | -- The angle of each segment is controlled with the mouseX and mouseY position. 6 | -- The transformations applied to the first segment are also applied to the 7 | -- second segment because they are inside the same pushMatrix() and popMatrix() group. 8 | -- 9 | 10 | import Graphics.Proc 11 | 12 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 13 | 14 | width = 640 15 | height = 360 16 | 17 | base = P2 (width * 0.3) (height * 0.5) 18 | segLength = 100 19 | 20 | setup = do 21 | size (P2 width height) 22 | strokeWeight 30 23 | stroke (greya 255 160) 24 | return (0, 0) 25 | 26 | draw (angle1, angle2) = do 27 | background (grey 0) 28 | local $ do 29 | segment base angle1 30 | segment (P2 segLength 0) angle2 31 | 32 | update _ = do 33 | -- relMouse produces mouse pointer coordinates normalized with sizes of the window 34 | (P2 mx my) <- relMouse 35 | let angle1 = -0.5 * (mx - 0.5) 36 | angle2 = 0.5 * (my - 0.5) 37 | return (angle1, angle2) 38 | 39 | segment p a = do 40 | translate p 41 | rotate a 42 | line (P2 0 0) (P2 segLength 0) 43 | 44 | --------------------------------------------------- 45 | -- Side note 46 | -- 47 | -- The rotate in processing varies in the interval [0, 2*pi] 48 | -- But in the haskell lib the angle of rotation is measured in TAUs 49 | -- It's a ratio of full rotation. So the interval is [0, 1]. 50 | -------------------------------------------------------------------------------- /examples/Transform/Rotate.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/rotate.html 2 | 3 | -- Rotate. 4 | -- 5 | -- Rotating a square around the Z axis. To get the results you expect, 6 | -- send the rotate function angle parameters that are values 7 | -- between 0 and PI*2 (TWO_PI which is roughly 6.28). If you prefer 8 | -- to think about angles as degrees (0-360), you can use the radians() 9 | -- method to convert your values. For example: scale(radians(90)) is 10 | -- identical to the statement scale(PI/2). 11 | 12 | 13 | import Graphics.Proc 14 | 15 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 16 | 17 | width = 640 18 | height = 360 19 | 20 | dim = 80.0 21 | 22 | setup = do 23 | size (P2 width height) 24 | noStroke 25 | fill (grey 255) 26 | rectMode Center 27 | return (0, 0) 28 | 29 | draw (angle, _) = do 30 | background (grey 51) 31 | 32 | let c = cos angle 33 | translate (P2 (width/2) (height/2)) 34 | rotate c 35 | rect (P2 0 0) (P2 180 180) 36 | where 37 | s = cos angle * 2 38 | 39 | update (angle, jitter) = do 40 | s <- second 41 | jitter1 <- if (s `mod` 2 == 0) 42 | then random2 (-0.05, 0.05) 43 | else return jitter 44 | return (angle + jitter1, jitter1) 45 | 46 | -------------------------------------------------------------------------------- /examples/Transform/Scale.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/scale.html 2 | 3 | -- Scale by Denis Grutze. 4 | -- 5 | -- Paramenters for the scale() function are values specified as decimal 6 | -- percentages. For example, the method call scale(2.0) will increase 7 | -- the dimension of the shape by 200 percent. Objects always scale from the origin. 8 | 9 | import Graphics.Proc 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 12 | 13 | width = 640 14 | height = 360 15 | 16 | dim = 80.0 17 | 18 | setup = do 19 | size (P2 width height) 20 | noStroke 21 | rectMode Center 22 | frameRate 30 23 | return 0 24 | 25 | draw a = do 26 | background (grey 102) 27 | 28 | translate (P2 (width/2) (height/2)) 29 | scale (P2 s s) 30 | fill (grey 51); 31 | rect (P2 0 0) (P2 50 50) 32 | 33 | translate (P2 75 0) 34 | fill (grey 255) 35 | scale (P2 s s) 36 | rect (P2 0 0) (P2 50 50) 37 | where 38 | s = cos a * 2 39 | 40 | update a = return (a + 0.04) 41 | -------------------------------------------------------------------------------- /examples/Transform/Translate.hs: -------------------------------------------------------------------------------- 1 | -- original code: https://processing.org/examples/translate.html 2 | 3 | -- Translate. 4 | -- 5 | -- The translate() function allows objects to be moved to any 6 | -- location within the window. The first parameter sets the 7 | -- x-axis offset and the second parameter sets the y-axis offset. 8 | 9 | import Graphics.Proc 10 | 11 | main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 12 | 13 | width = 640 14 | height = 360 15 | 16 | dim = 80.0 17 | 18 | setup = do 19 | size (P2 width height) 20 | noStroke 21 | return 0 22 | 23 | draw x = do 24 | background (grey 102) 25 | 26 | translate (P2 x (height/2 - dim/2)) 27 | fill (grey 255) 28 | rect (P2 (-dim/2) (-dim/2)) (P2 dim dim) 29 | 30 | -- Transforms accumulate. Notice how this rect moves 31 | -- twice as fast as the other, but it has the same 32 | -- parameter for the x-axis value 33 | translate (P2 x dim) 34 | fill (grey 0) 35 | rect (P2 (-dim/2) (-dim/2)) (P2 dim dim) 36 | 37 | update x = return (if (x > width + dim) then (-dim) else x + 1) 38 | -------------------------------------------------------------------------------- /goodies.md: -------------------------------------------------------------------------------- 1 | instruction to instal ftgl: 2 | 3 | https://noamlewis.wordpress.com/2012/12/16/cabal-install-ftgl-on-windows-and-getting-exes-that-use-it-to-work/ 4 | 5 | How to install FTGL. I'm not using it right now but who knows 6 | 7 | ### For Linux 8 | 9 | We need to install the dev libraries for ftgl. It should be libftgl-dev or similar. 10 | 11 | ~~~ 12 | > sudo apt-get install libftgl-dev 13 | ~~~ 14 | 15 | ### For Windows 16 | 17 | For Windows it's somewhat more complicated. We need to download 18 | the DLLs for FreeType and FTGL, copy them to system32 or system64 directory 19 | and write out the coresponding include and lib dirs in the cabal install command. 20 | Here is how to do it: 21 | 22 | * Get 32-bit windows binaries for FreeType and FTGL. I downloaded them 23 | from: http://www.opencascade.org/getocc/download/3rdparty/, but you might 24 | as well compile them from the official sources. 25 | 26 | * Copy the FTGL.dll and FreeType.dll to: 27 | 28 | * 64-bit version of Windows: copy to c:\windows\syswow64 29 | 30 | * 32-bit version of Windows: copy to c:\windows\system32 31 | 32 | * Install the [Visual C++ 2010 redistributable, 32-bit version](https://www.microsoft.com/en-us/download/details.aspx?id=5555&tduid=(78d8e7036ed52f69c7cec950d42fe15d)(256380)(2459594)(TnL5HPStwNw-tlEstIGjsicPt6X8U_TS0Q)()) 33 | 34 | * Assuming you’ve unpackged the FTGL binaries in some directory “\ftgl-2.1.3-vc10-32”, 35 | run the following: 36 | 37 | ~~~ 38 | cabal install ftgl --extra-include-dirs=\ftgl-2.1.3-vc10-32\include --extra-lib-dirs=\ftgl-2.1.3-vc10-32\lib --reinstall --force-reinstalls 39 | ~~~ 40 | 41 | * cabal build / install the processing-for-haskell library. 42 | 43 | The original guide on installing FTGL can be found [here](https://noamlewis.wordpress.com/2012/12/16/cabal-install-ftgl-on-windows-and-getting-exes-that-use-it-to-work/). 44 | -------------------------------------------------------------------------------- /processing-for-haskell.cabal: -------------------------------------------------------------------------------- 1 | -- Initial processing-for-haskell.cabal generated by cabal init. For 2 | -- further documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | -- The name of the package. 5 | name: processing-for-haskell 6 | 7 | -- The package version. See the Haskell package versioning policy (PVP) 8 | -- for standards guiding when and how versions should be incremented. 9 | -- https://wiki.haskell.org/Package_versioning_policy 10 | -- PVP summary: +-+------- breaking API changes 11 | -- | | +----- non-breaking API additions 12 | -- | | | +--- code changes with no API change 13 | version: 0.1.0.1 14 | 15 | -- A short (one-line) description of the package. 16 | synopsis: Computer graphics for kids and artists with Processing implemented in Haskell. 17 | 18 | -- A longer description of the package. 19 | description: The library implements the Processing language (see ). It's an imperative EDSL for graphics and animation. 20 | It's very easy and fun to use. There are many books on processing and community is fairly active. 21 | We can find the quick start guide and lots of examples in the project repository 22 | on github (see the directory @examples@). 23 | There is a tutorial at the project homepage at github: . 24 | 25 | -- The license under which the package is released. 26 | license: BSD3 27 | 28 | -- The file containing the license text. 29 | license-file: LICENSE 30 | 31 | -- The package author(s). 32 | author: Anton Kholomiov 33 | 34 | -- An email address to which users can send suggestions, bug reports, and 35 | -- patches. 36 | maintainer: anton.kholomiov@gmail.com 37 | 38 | -- A copyright notice. 39 | -- copyright: 40 | 41 | category: Graphics 42 | 43 | build-type: Simple 44 | 45 | -- Extra files to be distributed with the package, such as examples or a 46 | -- README. 47 | extra-source-files: ChangeLog.md 48 | 49 | -- Constraint on the version of Cabal needed to build this package. 50 | cabal-version: >=1.10 51 | 52 | Stability: Experimental 53 | 54 | Tested-With: GHC==8.0.1 55 | 56 | Homepage: https://github.com/anton-k/processing-for-haskell 57 | Bug-Reports: https://github.com/anton-k/processing-for-haskell/issues 58 | 59 | Source-repository head 60 | Type: git 61 | Location: https://github.com/anton-k/processing-for-haskell 62 | 63 | 64 | library 65 | -- Modules exported by the library. 66 | exposed-modules: 67 | Graphics.Proc 68 | Graphics.Proc3 69 | 70 | -- Modules included in this library but not exported. 71 | other-modules: 72 | Graphics.Proc.Core 73 | 74 | Graphics.Proc.Core.PioRef 75 | Graphics.Proc.Core.Run 76 | Graphics.Proc.Core.GLBridge 77 | Graphics.Proc.Core.Vector 78 | Graphics.Proc.Core.Vector.Primitive2D 79 | 80 | Graphics.Proc.Core.State 81 | Graphics.Proc.Core.State.Pio 82 | Graphics.Proc.Core.State.Elements 83 | Graphics.Proc.Core.State.Elements.Input 84 | Graphics.Proc.Core.State.Elements.Rnd 85 | Graphics.Proc.Core.State.Elements.Draw 86 | Graphics.Proc.Core.State.Elements.Font 87 | Graphics.Proc.Core.State.Elements.Frame 88 | Graphics.Proc.Core.State.Elements.Time 89 | 90 | Graphics.Proc.Lib 91 | 92 | Graphics.Proc.Lib.Environment 93 | 94 | Graphics.Proc.Lib.Data 95 | Graphics.Proc.Lib.Data.Conversion 96 | 97 | Graphics.Proc.Lib.Shape 98 | Graphics.Proc.Lib.Shape.Primitive2D 99 | Graphics.Proc.Lib.Shape.Curve 100 | Graphics.Proc.Lib.Shape.Attribute 101 | 102 | Graphics.Proc.Lib.Input 103 | Graphics.Proc.Lib.Input.Mouse 104 | Graphics.Proc.Lib.Input.Keyboard 105 | Graphics.Proc.Lib.Input.Time 106 | 107 | Graphics.Proc.Lib.Output 108 | Graphics.Proc.Lib.Output.TextArea 109 | 110 | Graphics.Proc.Lib.Transform 111 | 112 | Graphics.Proc.Lib.Color 113 | 114 | Graphics.Proc.Lib.Image 115 | 116 | Graphics.Proc.Lib.Typography 117 | Graphics.Proc.Lib.Typography.Display 118 | Graphics.Proc.Lib.Typography.Attributes 119 | Graphics.Proc.Lib.Typography.Metrics 120 | 121 | Graphics.Proc.Lib.Math 122 | Graphics.Proc.Lib.Math.Calculation 123 | Graphics.Proc.Lib.Math.Trigonometry 124 | Graphics.Proc.Lib.Math.Random 125 | 126 | Graphics.Proc.Lib.Misc 127 | 128 | Graphics.Proc.Lib3 129 | Graphics.Proc.Lib3.Shape.Primitive2D 130 | Graphics.Proc.Lib3.Shape.Primitive3D 131 | Graphics.Proc.Lib3.Camera 132 | Graphics.Proc.Lib3.Lights 133 | Graphics.Proc.Lib3.Transform 134 | 135 | -- LANGUAGE extensions used by modules in this package. 136 | other-extensions: DeriveFunctor, GeneralizedNewtypeDeriving 137 | 138 | -- Other library packages from which modules are imported. 139 | build-depends: 140 | base >=4.7 && <7, 141 | data-default, mtl, random, time, hsnoise, 142 | OpenGL, GLUT, 143 | -- FTGL, 144 | utf8-string, 145 | vector-space, NumInstances 146 | 147 | -- Directories containing source files. 148 | hs-source-dirs: src 149 | 150 | -- Base language which the package is written in. 151 | default-language: Haskell2010 152 | default-extensions: 153 | BangPatterns 154 | FlexibleInstances 155 | FlexibleContexts 156 | RankNTypes 157 | RecordWildCards 158 | TypeFamilies 159 | TypeSynonymInstances 160 | 161 | 162 | -------------------------------------------------------------------------------- /src/Graphics/Proc.hs: -------------------------------------------------------------------------------- 1 | -- | Imperative EDSL for graphics and animation. The libary implements a Processing in Haskell. 2 | -- Two dimensional version of the library. 3 | -- 4 | -- An example: 5 | -- 6 | -- > import Graphics.Proc 7 | -- > 8 | -- > main = runProc $ def { procSetup = setup, procDraw = draw, procUpdate = update } 9 | -- > 10 | -- > setup = do 11 | -- > size (P2 300 300) 12 | -- > return 0 13 | -- > 14 | -- > draw x = do 15 | -- > background (grey 255) 16 | -- > fill (rgb 0 255 0) 17 | -- > circle 20 (P2 (150 + 50 * sin x) 150) 18 | -- > 19 | -- > update x = return (x + 0.1) 20 | -- > 21 | -- We can find the quickstart guide and lots of examples in the project repository on github (see the directory @examples@). 22 | module Graphics.Proc( 23 | -- * Structure 24 | Proc(..), runProc, 25 | 26 | -- * Types 27 | Pio, Draw, Update, TimeInterval, Col(..), P2(..), 28 | 29 | -- * Environment 30 | winSize, winWidth, winHeight, 31 | size, 32 | smooth, noSmooth, frameCount, frameRate, 33 | loop, noLoop, redraw, 34 | 35 | -- * Data 36 | -- | We can use ordinary Haskell datatypes primitive and composite ones. 37 | 38 | -- ** Conversion 39 | int, float, 40 | 41 | -- ** String Functions 42 | -- | We can use standard Haskell string functions. 43 | 44 | -- ** Array Functions 45 | -- | We can use Haskell arrays. 46 | 47 | -- * Control 48 | -- | We can use plain old Bool datatype. 49 | 50 | 51 | -- * Shape 52 | 53 | -- ** 2D Primitives 54 | 55 | triangle, rect, quad, ellipse, circle, line, linePath, point, pointPath, polygon, 56 | 57 | -- ** Curves 58 | bezier, 59 | 60 | -- ** Attributes 61 | EllipseMode, RectMode, DrawMode(..), ellipseMode, rectMode, 62 | strokeWeight, 63 | 64 | -- ** Vertex 65 | 66 | -- ** Loading & Displaying 67 | 68 | -- * Input 69 | 70 | -- ** Mouse 71 | mouse, mouseX, mouseY, 72 | relMouse, relMouseX, relMouseY, 73 | MouseButton(..), 74 | mouseButton, 75 | 76 | -- ** Keyboard 77 | Key(..), SpecialKey(..), key, Modifiers(..), modifiers, 78 | 79 | -- ** Files 80 | 81 | -- ** Time & Date 82 | year, month, day, hour, minute, second, millis, utcHour, 83 | 84 | -- * Output 85 | 86 | -- ** Text Area 87 | println, 88 | 89 | -- ** Image 90 | 91 | -- ** Files 92 | 93 | -- * Transform 94 | translate, 95 | rotate, 96 | scale, 97 | resetMatrix, local, 98 | applyMatrix, 99 | shearX, shearY, 100 | 101 | -- ** Coordinates 102 | 103 | -- ** Material Properties 104 | 105 | -- * Color 106 | fill, noFill, stroke, noStroke, strokeFill, 107 | rgb, rgba, grey, greya, setAlpha, 108 | hsv, hsva, 109 | background, clear, 110 | 111 | white, black, navy, blue, aqua, teal, olive, green, 112 | lime, yellow, orange, red, maroon, fushsia, purple, 113 | gray, silver, 114 | 115 | -- Image 116 | 117 | -- Loading & Displaying 118 | 119 | -- Textures 120 | 121 | -- Pixels 122 | 123 | -- Rendering 124 | 125 | -- Shaders 126 | 127 | -- Typography 128 | 129 | -- Loading & Displaying 130 | -- Font, loadFont, text, textFont, 131 | 132 | -- Attributes 133 | -- textSize, 134 | 135 | -- Metrics 136 | 137 | -- ** Calculation 138 | remap, FloatInterval, 139 | constrain, constrain2, 140 | 141 | -- ** Trigonometry 142 | radians, degrees, e, erad, 143 | 144 | -- ** Random 145 | randomSeed, random, random2, randomP2, randomCol, randomCola, 146 | randomGaussian, 147 | 148 | -- *** Perlin noise 149 | -- | Returns the Perlin noise value at specified coordinates. Perlin noise is a random sequence generator producing a more natural, harmonic succession of numbers than that of the standard random() function. It was developed by Ken Perlin in the 1980s and has been used in graphical applications to generate procedural textures, shapes, terrains, and other seemingly organic forms. 150 | -- 151 | -- processing docs: 152 | NoiseDetail(..), noiseDetail, noiseOctaves, noiseSeed, noise1, noise2, noise3, 153 | 154 | -- * Misc 155 | onCircle, onLine, uon, 156 | 157 | -- * Pio mutable values 158 | PioRef, newPioRef, readPioRef, writePioRef, modifyPioRef, 159 | 160 | -- | Useful standard functions 161 | module Data.VectorSpace, 162 | module Data.AffineSpace, 163 | module Data.Cross, 164 | module Data.NumInstances, 165 | module Data.Default, 166 | module Data.Monoid, 167 | module Control.Monad, 168 | module Control.Monad.IO.Class, 169 | module Control.Applicative 170 | ) where 171 | 172 | import Data.Default 173 | import Data.Monoid 174 | import Control.Monad 175 | import Control.Monad.IO.Class 176 | import Control.Applicative 177 | 178 | import Data.VectorSpace hiding (Sum(..)) 179 | import Data.NumInstances 180 | import Data.AffineSpace 181 | import Data.Cross 182 | 183 | import Graphics.Proc.Core 184 | import Graphics.Proc.Lib 185 | 186 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core( 2 | 3 | module Graphics.Proc.Core.State, 4 | module Graphics.Proc.Core.PioRef, 5 | module Graphics.Proc.Core.Run, 6 | module Graphics.Proc.Core.Vector, 7 | module Graphics.Proc.Core.GLBridge, 8 | 9 | -- | Common reexports 10 | module Data.Default, 11 | module Control.Monad, 12 | module Control.Applicative, 13 | module Control.Monad.IO.Class 14 | 15 | ) where 16 | 17 | 18 | import Data.Default 19 | import Control.Monad 20 | import Control.Applicative 21 | import Control.Monad.IO.Class 22 | 23 | import Graphics.Proc.Core.State 24 | import Graphics.Proc.Core.PioRef 25 | import Graphics.Proc.Core.Run 26 | import Graphics.Proc.Core.Vector 27 | import Graphics.Proc.Core.GLBridge 28 | 29 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/GLBridge.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.GLBridge( 2 | MouseButton(..), Modifiers(..), Key(..), KeyState(..), Position(..), SpecialKey(..), 3 | -- Font, 4 | Col(..), glCol, 5 | d2f, f2d, v3, 6 | toVertex, toVector, 7 | glSize, setupWindow, getWindowSize 8 | ) where 9 | 10 | import Graphics.Rendering.OpenGL hiding (scale, translate, rotate, rect, height, width) 11 | import qualified Graphics.Rendering.OpenGL as G 12 | import Graphics.UI.GLUT hiding (scale, translate, rotate, rect, rgba, Font) 13 | -- import Graphics.Rendering.FTGL 14 | import Graphics.Proc.Core.Vector 15 | import Data.Default 16 | import Control.Monad.IO.Class 17 | import GHC.Float 18 | 19 | -- | Color datatype. It contains values for three components of the color and transparency. 20 | -- All values range in the interval from 0 to 1. 21 | data Col = Col Float Float Float Float 22 | deriving (Show) 23 | 24 | instance Default Col where 25 | def = black 26 | where black = Col 0 0 0 1 27 | 28 | glCol :: Col -> Color4 Float 29 | glCol (Col r g b a) = Color4 r g b a 30 | 31 | ----------------------------------------- 32 | -- init window 33 | 34 | setupWindow :: IO () 35 | setupWindow = do 36 | getArgsAndInitialize 37 | initialDisplayMode $= [DoubleBuffered] 38 | createWindow "" 39 | multisample $= Enabled 40 | blend $= Enabled 41 | blendFunc $= (SrcAlpha, OneMinusSrcAlpha) 42 | glSize (P2 100 100) 43 | clearColor $= Color4 1 1 1 1 44 | G.clear [ColorBuffer, DepthBuffer] 45 | 46 | glSize :: P2 -> IO () 47 | glSize p@(P2 w h) = do 48 | windowSize $= fromPoint p 49 | projection2 0 w h 0 50 | where 51 | fromPoint (P2 x y) = Size (f x) (f y) 52 | f = toEnum . floor 53 | 54 | projection2 xl xu yl yu = do 55 | matrixMode $= Projection 56 | loadIdentity 57 | ortho (f2d xl) (f2d xu) (f2d yl) (f2d yu) zl zu 58 | matrixMode $= Modelview 0 59 | where 60 | zl = -5 61 | zu = 5 62 | 63 | -------------------------------------------- 64 | 65 | getWindowSize :: IO (Int, Int) 66 | getWindowSize = do 67 | Size w h <- G.get windowSize 68 | return (fromEnum w, fromEnum h) 69 | 70 | -------------------------------------------- 71 | -- converters 72 | 73 | f2d = float2Double 74 | d2f = double2Float 75 | 76 | v3 :: IsPoint p => p -> IO () 77 | v3 = vertex . toVertex . toP3 78 | 79 | toVector :: P3 -> Vector3 Double 80 | toVector (P3 x y z) = Vector3 (f2d x) (f2d y) (f2d z) 81 | 82 | toVertex :: P3 -> Vertex3 Double 83 | toVertex (P3 x y z) = Vertex3 (f2d x) (f2d y) (f2d z) 84 | 85 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/PioRef.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.PioRef( 2 | PioRef, newPioRef, readPioRef, writePioRef, modifyPioRef 3 | ) where 4 | 5 | import Data.IORef 6 | 7 | import Control.Monad.IO.Class 8 | 9 | import Graphics.Proc.Core.State 10 | 11 | -- | Datatyp for mutable variables. We can create a reference 12 | -- and then manipulate the value with functions @readPioRef@ and @writePioRef@. 13 | -- The API is the same as in the case of @IORef@s. It's standard way to work with mutables in haskell. 14 | newtype PioRef a = PioRef { unPioRef :: IORef a } 15 | deriving (Eq) 16 | 17 | -- | Creates a reference for a mutable value. The argument is an initial value assigned to the variable. 18 | newPioRef :: a -> Pio (PioRef a) 19 | newPioRef a = liftIO $ fmap PioRef $ newIORef a 20 | 21 | -- | Reads the value from the reference. 22 | readPioRef :: PioRef a -> Pio a 23 | readPioRef (PioRef ref) = liftIO $ readIORef ref 24 | 25 | -- | Writes the value to reference. 26 | writePioRef :: PioRef a -> a -> Pio () 27 | writePioRef (PioRef ref) value = liftIO $ writeIORef ref value 28 | 29 | -- | Modifies a value iside the reference with a function. 30 | modifyPioRef :: PioRef a -> (a -> a) -> Pio () 31 | modifyPioRef (PioRef ref) f = liftIO $ modifyIORef ref f 32 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/Run.hs: -------------------------------------------------------------------------------- 1 | {-# Language FlexibleContexts #-} 2 | module Graphics.Proc.Core.Run( 3 | Proc(..), runProc, Draw, Update, TimeInterval 4 | ) where 5 | 6 | import Control.Monad.IO.Class 7 | 8 | import Data.Default 9 | import Data.IORef 10 | 11 | import qualified Graphics.Rendering.OpenGL as G 12 | import qualified Graphics.UI.GLUT as G 13 | import Graphics.UI.GLUT (($=)) 14 | 15 | import Graphics.Proc.Core.State 16 | import Graphics.Proc.Core.GLBridge 17 | 18 | 19 | -- | A alias for value update inside processing IO-monad. 20 | type Update s = s -> Pio s 21 | 22 | -- | An alias for processing procedures. 23 | type Draw = Pio () 24 | 25 | -- | It holds all processing standard callbacks. 26 | -- With it we can set the setup, draw, and update functions. 27 | -- Here we can specify how to react on user-input. 28 | -- 29 | -- All functions update the program state. They take it in as an argument and produce as result. 30 | -- In Haskell we can not manipulate global variables with such ease as Processing provides. 31 | -- So we have to find out another way to update the state. The natural way for Haskell is to keep 32 | -- the things as explicit as possible. That leads to the following decisions: 33 | -- 34 | -- * @setup@ returns the initial state. 35 | -- 36 | -- * @draw@ takes the state as an argument and draws it. 37 | -- 38 | -- * @update@ should take in the current state and return back the next state. 39 | -- 40 | -- * All input processing functions also manipulate the state explicitly by passing arguments. 41 | -- 42 | -- Notice that the processing function draw is split on two functions: draw and update. 43 | -- The draw is only for drawing the program state and update is for state update. 44 | -- 45 | -- There is a useful function procUpdateTime that provides a time interval that has passed since 46 | -- the previous update of the state. It can be useful for physics engines. 47 | data Proc s = Proc 48 | { procSetup :: Pio s 49 | , procUpdate :: Update s 50 | , procUpdateTime :: TimeInterval -> Update s 51 | , procDraw :: s -> Draw 52 | 53 | -- mouse callbacks 54 | , procMousePressed :: Update s 55 | , procMouseReleased :: Update s 56 | , procMouseClicked :: Update s 57 | , procMouseDragged :: Update s 58 | , procMouseMoved :: Update s 59 | 60 | -- keyboard callbacks 61 | , procKeyPressed :: Update s 62 | , procKeyReleased :: Update s 63 | , procKeyTyped :: Update s 64 | } 65 | 66 | instance Default (Proc s) where 67 | def = Proc 68 | { procSetup = return $ error "No setup is defined. Please define the procSetup value." 69 | , procUpdate = return 70 | , procUpdateTime = const return 71 | , procDraw = const (return ()) 72 | -- mouse 73 | , procMousePressed = return 74 | , procMouseReleased = return 75 | , procMouseClicked = return 76 | , procMouseDragged = return 77 | , procMouseMoved = return 78 | -- keyboard 79 | , procKeyPressed = return 80 | , procKeyReleased = return 81 | , procKeyTyped = return 82 | } 83 | 84 | data St s = St 85 | { stUser :: s 86 | , stGlobal :: GlobalState } 87 | 88 | initSt :: Proc s -> IO (St s) 89 | initSt p = do 90 | (user, global) <- runPio (procSetup p) =<< defGlobalState 91 | return $ St user global 92 | 93 | updateSt :: IORef (St s) -> Update s -> IO () 94 | updateSt ref f = do 95 | st <- G.get ref 96 | (user, global) <- runPio (f (stUser st)) (stGlobal st) 97 | ref $= St user global 98 | 99 | passSt :: IORef (St s) -> Pio () -> IO () 100 | passSt ref p = updateSt ref $ \s -> p >> return s 101 | 102 | -- | The main function for rendering processing actions. 103 | -- It sets the scene and starts the rendering of animation. 104 | runProc :: Proc s -> IO () 105 | runProc p = do 106 | setupWindow 107 | ref <- newIORef =<< initSt p 108 | 109 | nextFrame ref 110 | G.displayCallback $= display ref 111 | G.keyboardMouseCallback $= Just (keyMouse ref) 112 | G.motionCallback $= Just (mouseMotion ref) 113 | G.passiveMotionCallback $= Just (passiveMouseMotion ref) 114 | 115 | G.mainLoop 116 | where 117 | display ref = updateSt ref $ \s -> do 118 | liftIO $ G.loadIdentity 119 | procDraw p s 120 | liftIO $ G.swapBuffers 121 | updateFrameCount 122 | return s 123 | 124 | idle ref = do 125 | loopInfo <- getLoopInfo ref 126 | case loopInfo of 127 | Loop -> updateLoopState ref 128 | NoLoop -> return () 129 | Redraw -> updateLoopState ref >> passSt ref (putLoopMode NoLoop) 130 | nextFrame ref 131 | 132 | updateLoopState ref = updateSt ref $ \s -> do 133 | s1 <- procUpdate p s 134 | dt <- getDuration 135 | s2 <- procUpdateTime p dt s1 136 | liftIO $ G.postRedisplay Nothing 137 | return s2 138 | 139 | nextFrame ref = do 140 | timeOut <- getTimeoutInterval ref 141 | G.addTimerCallback timeOut (idle ref) 142 | 143 | keyMouse ref key keyState modifiers pos = updateSt ref $ \s -> do 144 | putPosition pos 145 | case keyState of 146 | Down -> do 147 | case key of 148 | MouseButton mb -> do 149 | putMouseButton (Just mb) 150 | procMousePressed p s 151 | keyPress -> do 152 | putKeyPress keyPress 153 | procKeyPressed p s 154 | Up -> 155 | case key of 156 | Char ch -> procKeyReleased p s 157 | SpecialKey sk -> return s 158 | MouseButton mb -> do 159 | putMouseButton Nothing 160 | procMouseReleased p s 161 | 162 | mouseMotion ref pos = passSt ref $ putPosition pos 163 | passiveMouseMotion ref pos = passSt ref $ putPosition pos 164 | 165 | getTimeoutInterval ref = readRef getter ref 166 | where getter = fmap (round . (1000 * ) . recip) getFrameRate 167 | 168 | getLoopInfo ref = readRef getLoopMode ref 169 | 170 | readRef getter ref = do 171 | st <- fmap stGlobal $ G.get ref 172 | fmap fst $ runPio getter st 173 | 174 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.State( 2 | Pio(..), runPio, 3 | GlobalState(..), defGlobalState, 4 | 5 | -- * Input 6 | MouseButton(..), Modifiers(..), Key(..), KeyState(..), 7 | putKeyPress, putMouseButton, putPosition, 8 | getMousePosition, getMouseButton, getLastPressedKey, getPressedModifiers, 9 | 10 | -- * Random 11 | NoiseDetail(..), Seed, 12 | getRandomGen, getNoiseGen, getNoiseDetail, 13 | putRandomGen, putNoiseGen, putNoiseDetail, 14 | putOctaves, 15 | 16 | -- * Draw 17 | DrawState(..), 18 | EllipseMode, RectMode, DrawMode(..), 19 | StrokeCap(..), StrokeJoin(..), 20 | 21 | getStroke, getFill, getEllipseMode, getRectMode, 22 | putEllipseMode, putStroke, putFill, putRectMode, 23 | 24 | -- * Font 25 | 26 | -- * Frame 27 | LoopMode(..), 28 | updateFrameCount, frameCount, 29 | getFrameRate, putFrameRate, 30 | getLoopMode, putLoopMode, 31 | 32 | -- * Time 33 | initTimeState, TimeInterval, getDuration, getStartTime, 34 | 35 | -- 3D primitives 36 | SphereRes(..), RawSphereRes(..), toRawSphereRes, 37 | module X, 38 | ) where 39 | 40 | import Data.Time.Clock 41 | import Control.Monad.IO.Class as X 42 | import Control.Monad.State.Strict as X 43 | 44 | import Graphics.Proc.Core.State.Pio 45 | import Graphics.Proc.Core.GLBridge 46 | import Graphics.Proc.Core.Vector 47 | import qualified Graphics.Proc.Core.State.Elements as E 48 | import Graphics.Proc.Core.State.Elements hiding (updateFrameCount, getDuration, frameCount) 49 | 50 | ---------------------------------------- 51 | -- input 52 | 53 | putKeyPress :: Key -> Pio () 54 | putKeyPress key = onInput $ modify $ \x -> x { lastPressedKey = key } 55 | 56 | putMouseButton :: Maybe MouseButton -> Pio () 57 | putMouseButton mb = onInput $ modify $ \x -> x { pressedButton = mb } 58 | 59 | putPosition :: Position -> Pio () 60 | putPosition pos = onInput $ modify $ \x -> x { mousePosition = fromPosition pos } 61 | where fromPosition (Position x y) = (fromEnum x, fromEnum y) 62 | 63 | getMousePosition :: Pio P2 64 | getMousePosition = onInput $ fmap ((\(x, y) -> P2 (fromIntegral x) (fromIntegral y)) . mousePosition) get 65 | 66 | getLastPressedKey :: Pio Key 67 | getLastPressedKey = onInput $ fmap lastPressedKey get 68 | 69 | getPressedModifiers :: Pio Modifiers 70 | getPressedModifiers = onInput $ fmap pressedModifiers get 71 | 72 | getMouseButton :: Pio (Maybe MouseButton) 73 | getMouseButton = onInput $ fmap pressedButton get 74 | 75 | ---------------------------------------- 76 | -- random 77 | 78 | getRandomGen = onRnd $ fmap rndRandomGen get 79 | getNoiseGen = onRnd $ fmap rndNoiseGen get 80 | getNoiseDetail = onRnd $ fmap rndNoiseDetail get 81 | 82 | putRandomGen v = onRnd $ modify $ \x -> x { rndRandomGen = v } 83 | putNoiseGen v = onRnd $ modify $ \x -> x { rndNoiseGen = v } 84 | putNoiseDetail v = onRnd $ modify $ \x -> x { rndNoiseDetail = v } 85 | 86 | putOctaves v = onRnd $ modify $ \x -> x { rndNoiseDetail = go (rndNoiseDetail x) v } 87 | where go nd v = nd { noiseDetailsOctaves = v } 88 | 89 | ---------------------------------------- 90 | -- draw 91 | 92 | getStroke :: Pio (Maybe Col) 93 | getStroke = fmap drawStroke $ onDraw get 94 | 95 | getFill :: Pio (Maybe Col) 96 | getFill = fmap drawFill $ onDraw get 97 | 98 | getEllipseMode :: Pio EllipseMode 99 | getEllipseMode = fmap drawEllipseMode $ onDraw get 100 | 101 | getRectMode :: Pio RectMode 102 | getRectMode = fmap drawRectMode $ onDraw get 103 | 104 | putEllipseMode :: EllipseMode -> Pio () 105 | putEllipseMode value = onDraw $ modify $ \x -> x { drawEllipseMode = value } 106 | 107 | putRectMode :: RectMode -> Pio () 108 | putRectMode value = onDraw $ modify $ \x -> x { drawRectMode = value } 109 | 110 | putStroke :: Maybe Col -> Pio () 111 | putStroke value = onDraw $ modify $ \x -> x { drawStroke = value } 112 | 113 | putFill :: Maybe Col -> Pio () 114 | putFill value = onDraw $ modify $ \x -> x { drawFill = value } 115 | 116 | ---------------------------------------- 117 | -- font 118 | 119 | ---------------------------------------- 120 | -- frame 121 | 122 | updateFrameCount :: Pio () 123 | updateFrameCount = onFrame E.updateFrameCount 124 | 125 | -- | The system variable frameCount contains the number of frames that have been displayed since the program started. Inside setup() the value is 0, after the first iteration of draw it is 1, etc. 126 | -- 127 | -- processing docs: 128 | frameCount :: Pio Int 129 | frameCount = onFrame $ fmap E.frameCount get 130 | 131 | getFrameRate :: Pio Float 132 | getFrameRate = onFrame $ fmap E.frameRate get 133 | 134 | putFrameRate :: Float -> Pio () 135 | putFrameRate value = onFrame $ modify $ \x -> x { frameRate = value } 136 | 137 | getLoopMode :: Pio LoopMode 138 | getLoopMode = onFrame $ fmap frameLoop get 139 | 140 | putLoopMode :: LoopMode -> Pio () 141 | putLoopMode value = onFrame $ modify $ \x -> x { frameLoop = value } 142 | 143 | ---------------------------------------- 144 | -- time 145 | 146 | getDuration :: Pio TimeInterval 147 | getDuration = onTimeIO E.getDuration 148 | 149 | getStartTime :: Pio UTCTime 150 | getStartTime = onTime $ fmap timeStart get 151 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State/Elements.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.State.Elements( 2 | module X 3 | ) where 4 | 5 | import Graphics.Proc.Core.State.Elements.Input as X 6 | import Graphics.Proc.Core.State.Elements.Rnd as X 7 | import Graphics.Proc.Core.State.Elements.Draw as X 8 | import Graphics.Proc.Core.State.Elements.Font as X 9 | import Graphics.Proc.Core.State.Elements.Frame as X 10 | import Graphics.Proc.Core.State.Elements.Time as X 11 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State/Elements/Draw.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.State.Elements.Draw( 2 | DrawState(..), 3 | EllipseMode, RectMode, DrawMode(..), 4 | StrokeCap(..), StrokeJoin(..) 5 | ) where 6 | 7 | import Control.Monad.State.Strict 8 | import Data.Default 9 | import Graphics.Proc.Core.GLBridge 10 | 11 | data DrawState = DrawState 12 | { drawEllipseMode :: EllipseMode 13 | , drawRectMode :: RectMode 14 | , drawStrokeCap :: StrokeCap 15 | , drawStrokeJoin :: StrokeJoin 16 | , drawStrokeWeight :: Float 17 | , drawFill :: Maybe Col 18 | , drawStroke :: Maybe Col 19 | } 20 | 21 | instance Default DrawState where 22 | def = DrawState 23 | { drawEllipseMode = Center 24 | , drawRectMode = Corner 25 | , drawStrokeCap = Round 26 | , drawStrokeJoin = JoinMiter 27 | , drawStrokeWeight = 1 28 | , drawFill = Just $ Col 0 0 0 1 29 | , drawStroke = Just $ Col 0 0 0 1 30 | } 31 | 32 | -- | Modes for drawing of ellipse. See @ellipseMode@. 33 | type EllipseMode = DrawMode 34 | 35 | -- | Modes for drawing of rectangle. See @rectMode@. 36 | type RectMode = DrawMode 37 | 38 | -- | Modes for drawing of rectangle or ellipse. 39 | data DrawMode = Radius | Center | Corner | Corners 40 | deriving (Show, Eq, Enum, Bounded) 41 | 42 | instance Default DrawMode where 43 | def = Center 44 | 45 | data StrokeCap = Round | Square | Project 46 | deriving (Show, Eq, Enum, Bounded) 47 | 48 | instance Default StrokeCap where 49 | def = Round 50 | 51 | data StrokeJoin = JoinMiter | JoinBevel | JoinRound 52 | deriving (Show, Eq, Enum, Bounded) 53 | 54 | instance Default StrokeJoin where 55 | def = JoinMiter 56 | 57 | ---------------------------------------------------------- 58 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State/Elements/Font.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.State.Elements.Font( 2 | FontState(..) 3 | ) where 4 | 5 | import Data.Default 6 | 7 | data FontState = FontState 8 | { fontCurrent :: Maybe Font 9 | , fontInitSize :: Int 10 | , fontSize :: Int 11 | } 12 | 13 | type Font = String 14 | 15 | instance Default FontState where 16 | def = FontState Nothing 12 12 17 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State/Elements/Frame.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.State.Elements.Frame( 2 | FrameState(..), LoopMode(..), 3 | updateFrameCount 4 | ) where 5 | 6 | import Control.Monad.State.Strict 7 | import Data.Default 8 | 9 | data FrameState = FrameState 10 | { frameCount :: Int 11 | , frameRate :: Float 12 | , frameLoop :: LoopMode 13 | } 14 | 15 | instance Default FrameState where 16 | def = FrameState 0 60 Loop 17 | 18 | data LoopMode = Loop | NoLoop | Redraw 19 | deriving (Show, Eq, Enum, Bounded) 20 | 21 | instance Default LoopMode where 22 | def = Loop 23 | 24 | updateFrameCount :: State FrameState () 25 | updateFrameCount = modify $ \x -> x { frameCount = succ (frameCount x) } 26 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State/Elements/Input.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.State.Elements.Input( 2 | InputState(..), MouseButton(..), Modifiers(..), Key(..), KeyState(..) 3 | ) where 4 | 5 | import Data.Default 6 | import Control.Monad.State.Strict 7 | 8 | import Graphics.Proc.Core.GLBridge 9 | 10 | data InputState = InputState 11 | { lastPressedKey :: Key 12 | , pressedModifiers :: Modifiers 13 | , mousePosition :: (Int, Int) 14 | , pressedButton :: Maybe MouseButton 15 | } 16 | 17 | instance Default Modifiers where 18 | def = Modifiers Up Up Up 19 | 20 | instance Default InputState where 21 | def = InputState 22 | { lastPressedKey = Char ' ' 23 | , pressedModifiers = def 24 | , mousePosition = (0, 0) 25 | , pressedButton = Nothing 26 | } 27 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State/Elements/Rnd.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.State.Elements.Rnd( 2 | RndState(..), 3 | NoiseDetail(..), Seed 4 | ) where 5 | 6 | import Data.Default 7 | import System.Random 8 | 9 | data RndState = RndState 10 | { rndRandomGen :: Maybe StdGen 11 | , rndNoiseGen :: Maybe Int 12 | , rndNoiseDetail :: NoiseDetail 13 | } 14 | 15 | instance Default RndState where 16 | def = RndState def def def 17 | 18 | type Seed = Maybe Int 19 | 20 | -- | Parameters for perlin noise. See docs for function @noiseDetail@. 21 | data NoiseDetail = NoiseDetail 22 | { noiseDetailsOctaves :: Int 23 | , noiseDetailsFalloff :: Float 24 | } 25 | 26 | instance Default NoiseDetail where 27 | def = NoiseDetail 4 0.5 28 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State/Elements/Time.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.State.Elements.Time( 2 | TimeState(..), initTimeState, TimeInterval, getDuration 3 | ) where 4 | 5 | import Data.Time.Clock 6 | import Control.Monad.State.Strict 7 | 8 | -- | Time duration in seconds. 9 | type TimeInterval = Float 10 | 11 | data TimeState = TimeState 12 | { timeLast :: UTCTime 13 | , timeStart :: UTCTime } 14 | 15 | initTimeState = fmap (\x -> TimeState x x) getCurrentTime 16 | 17 | ------------------------------------------ 18 | 19 | getDuration :: StateT TimeState IO TimeInterval 20 | getDuration = StateT $ \s -> do 21 | let prevTime = timeLast s 22 | now <- getCurrentTime 23 | let dt = fromRational $ toRational $ diffUTCTime now prevTime 24 | return (dt, s { timeLast = now }) 25 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/State/Pio.hs: -------------------------------------------------------------------------------- 1 | {-# Language DeriveFunctor, GeneralizedNewtypeDeriving #-} 2 | -- | The Processing IO-monad. 3 | module Graphics.Proc.Core.State.Pio( 4 | Pio(..), runPio, 5 | GlobalState(..), defGlobalState, SphereRes(..), RawSphereRes(..), toRawSphereRes, 6 | 7 | onInput, onRnd, onDraw, onFont, onFrame, onTime, onTimeIO, 8 | module X 9 | ) where 10 | 11 | import Data.Default 12 | import Data.IORef 13 | import Control.Monad.IO.Class as X 14 | import Control.Monad.State.Strict as X 15 | import GHC.Int 16 | 17 | import Graphics.Proc.Core.State.Elements 18 | 19 | -- | Processing IO-monad. It has the same meaning as the Haskell IO-monad but 20 | -- it's augmented with Processing library functions. 21 | -- 22 | -- We can use @liftIO@ to execute ordinary Haskell IO-actions. 23 | -- The Pio has instance for class @MonadIO@. 24 | -- 25 | -- > text <- liftIO $ readFile filename 26 | newtype Pio a = Pio { unPio :: StateT GlobalState IO a } 27 | deriving (Functor, Applicative, Monad, MonadIO, MonadState GlobalState) 28 | 29 | runPio :: Pio a -> GlobalState -> IO (a, GlobalState) 30 | runPio (Pio x) st = runStateT x st 31 | 32 | readPio :: (InputState -> a) -> Pio a 33 | readPio selector = readStatePio (selector . globalInputState) 34 | 35 | readStatePio :: (GlobalState -> a) -> Pio a 36 | readStatePio selector = Pio $ do 37 | st <- get 38 | return $ selector st 39 | 40 | modifyStatePio :: (GlobalState -> GlobalState) -> Pio () 41 | modifyStatePio update = Pio $ do 42 | st <- get 43 | put $ update st 44 | 45 | data GlobalState = GlobalState 46 | { globalInputState :: !InputState 47 | , globalRndState :: !RndState 48 | , globalDrawState :: !DrawState 49 | , globalFontState :: !FontState 50 | , globalTimeState :: !TimeState 51 | , globalFrameState :: !FrameState 52 | , globalSphereDetail :: !RawSphereRes 53 | } 54 | 55 | data RawSphereRes = RawSphereRes 56 | { rawSphereRes'longitude :: !Int32 57 | , rawSphereRes'latitude :: !Int32 58 | } 59 | 60 | -- | Sphere resolution 61 | data SphereRes = SphereRes 62 | { sphereRes'longitude :: !Int 63 | , sphereRes'latitude :: !Int 64 | } 65 | 66 | toRawSphereRes :: SphereRes -> RawSphereRes 67 | toRawSphereRes (SphereRes a b) = RawSphereRes (fromIntegral a) (fromIntegral b) 68 | 69 | instance Default SphereRes where 70 | def = SphereRes 30 30 71 | 72 | instance Default RawSphereRes where 73 | def = toRawSphereRes def 74 | -- | Hack to construct resolution from single number 75 | 76 | instance Num SphereRes where 77 | fromInteger n = SphereRes (fromInteger n) (fromInteger n) 78 | (+) = undefined 79 | (*) = undefined 80 | (-) = undefined 81 | negate = undefined 82 | abs = undefined 83 | signum = undefined 84 | 85 | defGlobalState :: IO GlobalState 86 | defGlobalState = fmap (\timeSt -> GlobalState def def def def timeSt def def) initTimeState 87 | 88 | onInput :: State InputState a -> Pio a 89 | onInput = onState globalInputState (\x a -> x { globalInputState = a }) 90 | 91 | onRnd :: State RndState a -> Pio a 92 | onRnd = onState globalRndState (\x a -> x { globalRndState = a }) 93 | 94 | onDraw :: State DrawState a -> Pio a 95 | onDraw = onState globalDrawState (\x a -> x { globalDrawState = a }) 96 | 97 | onFont :: State FontState a -> Pio a 98 | onFont = onState globalFontState (\x a -> x { globalFontState = a }) 99 | 100 | onFrame :: State FrameState a -> Pio a 101 | onFrame = onState globalFrameState (\x a -> x { globalFrameState = a }) 102 | 103 | onTime :: State TimeState a -> Pio a 104 | onTime = onState globalTimeState (\x a -> x { globalTimeState = a }) 105 | 106 | onTimeIO :: StateT TimeState IO a -> Pio a 107 | onTimeIO = onStateIO globalTimeState (\x a -> x { globalTimeState = a }) 108 | 109 | -------------------------------------------------- 110 | 111 | onState :: (GlobalState -> a) -> (GlobalState -> a -> GlobalState) -> State a b -> Pio b 112 | onState getter setter act = Pio $ do 113 | st <- get 114 | let (b, a) = runState act (getter st) 115 | put $ setter st a 116 | return b 117 | 118 | onStateIO :: (GlobalState -> a) -> (GlobalState -> a -> GlobalState) -> StateT a IO b -> Pio b 119 | onStateIO getter setter act = Pio $ do 120 | st <- get 121 | (b, a) <- liftIO $ runStateT act (getter st) 122 | put $ setter st a 123 | return b 124 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/Vector.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.Vector( 2 | P2(..), P3(..), IsPoint(..), 3 | module X 4 | ) where 5 | 6 | import Data.VectorSpace as X 7 | import Data.NumInstances as X 8 | import Data.AffineSpace as X 9 | import Data.Cross as X 10 | 11 | -- | 2D vector. 12 | data P2 = P2 !Float !Float 13 | 14 | -- | 3D vector. 15 | data P3 = P3 !Float !Float !Float 16 | 17 | -------------------------------------------------------------------------------- 18 | 19 | class IsPoint a where 20 | toP3 :: a -> P3 21 | px :: a -> Float 22 | py :: a -> Float 23 | pz :: a -> Float 24 | 25 | instance IsPoint P3 where 26 | toP3 = id 27 | px (P3 x _ _) = x 28 | py (P3 _ y _) = y 29 | pz (P3 _ _ z) = z 30 | 31 | instance IsPoint P2 where 32 | toP3 (P2 x y) = P3 x y 0 33 | px (P2 x _) = x 34 | py (P2 _ y) = y 35 | pz (P2 _ _) = 0 36 | 37 | -------------------------------------------------------------------------------- 38 | -- Num 39 | 40 | instance Num P2 where 41 | fromInteger n = P2 (fromInteger n) (fromInteger n) 42 | (+) (P2 x1 y1) (P2 x2 y2) = P2 (x1 + x2) (y1 + y2) 43 | (*) (P2 x1 y1) (P2 x2 y2) = P2 (x1 * x2) (y1 * y2) 44 | (-) (P2 x1 y1) (P2 x2 y2) = P2 (x1 - x2) (y1 - y2) 45 | negate (P2 x y) = P2 (negate x) (negate y) 46 | abs (P2 x y) = P2 (abs x) (abs y) 47 | signum (P2 x y) = P2 (signum x) (signum y) 48 | 49 | instance Num P3 where 50 | fromInteger n = P3 (fromInteger n) (fromInteger n) (fromInteger n) 51 | (+) (P3 x1 y1 z1) (P3 x2 y2 z2) = P3 (x1 + x2) (y1 + y2) (z1 + z2) 52 | (*) (P3 x1 y1 z1) (P3 x2 y2 z2) = P3 (x1 * x2) (y1 * y2) (z1 * z2) 53 | (-) (P3 x1 y1 z1) (P3 x2 y2 z2) = P3 (x1 - x2) (y1 - y2) (z1 - z2) 54 | negate (P3 x y z) = P3 (negate x) (negate y) (negate z) 55 | abs (P3 x y z) = P3 (abs x) (abs y) (abs z) 56 | signum (P3 x y z) = P3 (signum x) (signum y) (signum z) 57 | 58 | instance Fractional P2 where 59 | fromRational x = P2 (fromRational x) (fromRational x) 60 | recip (P2 x y) = P2 (recip x) (recip y) 61 | 62 | instance Fractional P3 where 63 | fromRational x = P3 (fromRational x) (fromRational x) (fromRational x) 64 | recip (P3 x y z) = P3 (recip x) (recip y) (recip z) 65 | 66 | -------------------------------------------------------------------------------- 67 | -- Vector space 68 | 69 | instance AdditiveGroup P2 where 70 | zeroV = P2 0 0 71 | (^+^) a b = a + b 72 | (^-^) a b = a - b 73 | negateV = negate 74 | 75 | instance AdditiveGroup P3 where 76 | zeroV = P3 0 0 0 77 | (^+^) a b = a + b 78 | (^-^) a b = a - b 79 | negateV = negate 80 | 81 | instance VectorSpace P2 where 82 | type Scalar P2 = Float 83 | (*^) k (P2 x y) = P2 (k * x) (k * y) 84 | 85 | instance VectorSpace P3 where 86 | type Scalar P3 = Float 87 | (*^) k (P3 x y z) = P3 (k * x) (k * y) (k * z) 88 | 89 | instance AffineSpace P2 where 90 | type Diff P2 = P2 91 | (.-.) = (-) 92 | (.+^) = (+) 93 | 94 | instance AffineSpace P3 where 95 | type Diff P3 = P3 96 | (.-.) = (-) 97 | (.+^) = (+) 98 | 99 | instance HasNormal P2 where 100 | normalVec p = (recip len) *^ p 101 | where 102 | len = sqrt (p <.> p) 103 | 104 | instance HasNormal P3 where 105 | normalVec p = (recip len) *^ p 106 | where 107 | len = sqrt (p <.> p) 108 | 109 | instance HasCross2 P2 where 110 | cross2 (P2 x y) = P2 (negateV y) x 111 | 112 | instance HasCross3 P3 where 113 | cross3 (P3 ax ay az) (P3 bx by bz) 114 | = P3 (ay * bz - az * by) 115 | (az * bx - ax * bz) 116 | (ax * by - ay * bx) 117 | 118 | instance InnerSpace P2 where 119 | (<.>) (P2 x1 y1) (P2 x2 y2) = x1 * x2 + y1 * y2 120 | 121 | instance InnerSpace P3 where 122 | (<.>) (P3 x1 y1 z1) (P3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2 123 | 124 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Core/Vector/Primitive2D.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Core.Vector.Primitive2D( 2 | triangle, quad, 3 | line, linePath, 4 | point, pointPath, polygon, 5 | ) where 6 | 7 | import Graphics.Proc.Core 8 | import Graphics.Rendering.OpenGL hiding (get, rect) 9 | 10 | -- | A triangle is a plane created by connecting three points. 11 | -- 12 | -- processing docs: 13 | triangle :: IsPoint p => p -> p -> p -> Draw 14 | triangle p1 p2 p3 = drawProcP3 Triangles LineLoop [p1, p2, p3] 15 | 16 | -- | A quad is a quadrilateral, a four sided polygon. It is similar to a rectangle, 17 | -- but the angles between its edges are not constrained to ninety degrees. The first 18 | -- pair of parameters (x1,y1) sets the first vertex and the subsequent pairs should 19 | -- proceed clockwise or counter-clockwise around the defined shape. 20 | -- 21 | -- processing docs: 22 | quad :: IsPoint p => p -> p -> p -> p -> Draw 23 | quad p1 p2 p3 p4 = drawProcP3 Polygon LineLoop [p1, p2, p3, p4] 24 | 25 | -- | Draws a polygon. 26 | polygon :: IsPoint p => [p] -> Draw 27 | polygon ps = drawProcP3 Polygon LineLoop ps 28 | 29 | -- | Draws a point, a coordinate in space at the dimension of one pixel. 30 | -- 31 | -- processing docs: 32 | point :: IsPoint p => p -> Draw 33 | point p = do 34 | setStrokeColor 35 | drawP3 Points [p] 36 | 37 | -- | Draws a sequence of points. 38 | pointPath :: IsPoint p => [p] -> Draw 39 | pointPath ps = do 40 | setStrokeColor 41 | drawP3 Points ps 42 | 43 | setStrokeColor :: Pio () 44 | setStrokeColor = setCol . maybe black id =<< getStroke 45 | 46 | black = Col 0 0 0 1 47 | 48 | -- | Draws a line (a direct path between two points) to the screen. 49 | -- 50 | -- processing docs: 51 | line :: IsPoint p => p -> p -> Draw 52 | line p1 p2 = do 53 | setStrokeColor 54 | drawP3 Lines [p1, p2] 55 | 56 | -- | Draws a line-path (sequence of line segments). 57 | linePath :: IsPoint p => [p] -> Draw 58 | linePath ps = do 59 | setStrokeColor 60 | drawP3 LineStrip ps 61 | 62 | --------------------------------------------------- 63 | 64 | drawP3 :: IsPoint p => PrimitiveMode -> [p] -> Pio () 65 | drawP3 primType ps = do 66 | liftIO $ renderPrimitive primType $ mapM_ v3 ps 67 | 68 | drawProcP3 :: IsPoint p => PrimitiveMode -> PrimitiveMode -> [p] -> Pio () 69 | drawProcP3 onFill onStroke ps = do 70 | go onFill =<< getFill 71 | go onStroke =<< getStroke 72 | where 73 | go shapeType mcol = case mcol of 74 | Just col -> do 75 | setCol col 76 | drawP3 shapeType ps 77 | Nothing -> return () 78 | 79 | setCol :: Col -> Draw 80 | setCol col = liftIO $ currentColor $= glCol col 81 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib( 2 | module X 3 | ) where 4 | 5 | import Graphics.Proc.Lib.Environment as X 6 | import Graphics.Proc.Lib.Data as X 7 | import Graphics.Proc.Lib.Shape as X 8 | import Graphics.Proc.Lib.Input as X 9 | import Graphics.Proc.Lib.Output as X 10 | import Graphics.Proc.Lib.Transform as X 11 | import Graphics.Proc.Lib.Color as X 12 | import Graphics.Proc.Lib.Image as X 13 | import Graphics.Proc.Lib.Typography as X 14 | import Graphics.Proc.Lib.Math as X 15 | import Graphics.Proc.Lib.Misc as X 16 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Color.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Color( 2 | stroke, noStroke, 3 | fill, noFill, 4 | background, clear, 5 | strokeFill, 6 | 7 | rgb, grey, rgba, greya, setAlpha, 8 | hsv, hsva, 9 | 10 | white, black, navy, blue, aqua, teal, olive, green, 11 | lime, yellow, orange, red, maroon, fushsia, purple, 12 | gray, silver 13 | ) where 14 | 15 | import Control.Monad.State.Strict 16 | import Graphics.Rendering.OpenGL hiding(clear) 17 | import qualified Graphics.Rendering.OpenGL as G 18 | import qualified Data.Fixed as F 19 | 20 | import Graphics.Proc.Core 21 | 22 | -- | Sets the color used to draw lines and borders around shapes. 23 | -- 24 | -- processing docs: 25 | stroke :: Col -> Draw 26 | stroke = putStroke . Just 27 | 28 | -- | Disables drawing the stroke (outline). If both noStroke() and noFill() are called, nothing will be drawn to the screen 29 | -- 30 | -- processing docs: 31 | noStroke :: Draw 32 | noStroke = putStroke Nothing 33 | 34 | -- | Sets the color used to fill shapes. For example, if you run @fill (rgb 204 102 0)@, all subsequent shapes will be filled with orange. 35 | -- 36 | -- processing docs: 37 | fill :: Col -> Draw 38 | fill = putFill . Just 39 | 40 | -- | Disables filling geometry. If both noStroke() and noFill() are called, nothing will be drawn to the screen. 41 | -- 42 | -- processing docs: 43 | noFill :: Draw 44 | noFill = putFill Nothing 45 | 46 | -- | Sets stroke and fill to the same color. 47 | strokeFill :: Col -> Draw 48 | strokeFill col = do 49 | stroke col 50 | fill col 51 | 52 | ------------------------------------------------------ 53 | 54 | -- | The background() function sets the color used for the background of the Processing window. The default background is light gray. This function is typically used within draw() to clear the display window at the beginning of each frame, but it can be used inside setup() to set the background on the first frame of animation or if the backgound need only be set once. 55 | -- 56 | -- processing docs: 57 | background :: Col -> Draw 58 | background x = liftIO $ do 59 | clearColor $= glCol x 60 | G.clear [ColorBuffer] 61 | 62 | -- | Clears the pixels within a buffer. 63 | -- 64 | -- processing docs: 65 | 66 | clear :: Draw 67 | clear = liftIO $ do 68 | G.clear [ColorBuffer] 69 | 70 | ------------------------------------------------------ 71 | 72 | -- | Creates an RGB-color from three values. The values are from 0 to 255. 73 | rgb :: Float -> Float -> Float -> Col 74 | rgb r g b = rgba r g b 255 75 | 76 | -- | Creates a grey value out of single float value. The value is from 0 to 255. 77 | grey :: Float -> Col 78 | grey g = rgb g g g 79 | 80 | -- | Creates an RGB-color with transparency. 81 | rgba :: Float -> Float -> Float -> Float -> Col 82 | rgba r g b a = Col (r / 255) (g / 255) (b / 255) (a / 255) 83 | 84 | -- | Creates an grey-color with transparency. 85 | greya :: Float -> Float -> Col 86 | greya g a = rgba g g g a 87 | 88 | ------------------------------------------------------ 89 | -- HSV color model 90 | 91 | -- | 92 | -- * Hue (H) is 0 to 360 93 | -- * Saturation (S) is 0 to 1 94 | -- * Value (V) or brightness is 0 to 1 95 | hsv :: Float -> Float -> Float -> Col 96 | hsv h s v = rgb r g b 97 | where 98 | !c = v * s 99 | !x = c * (1 - abs (((h / 60) `F.mod'` 2) - 1)) 100 | !m = v - c 101 | 102 | (r', g', b') 103 | | hIn 0 60 = (c, x, 0) 104 | | hIn 60 120 = (x, c, 0) 105 | | hIn 120 180 = (0, c, x) 106 | | hIn 180 240 = (0, x, c) 107 | | hIn 240 300 = (x, 0, c) 108 | | otherwise = (c, 0, x) 109 | 110 | hIn a b = a <= h && h < b 111 | fromRel a = (a + m) * 255 112 | !r = fromRel r' 113 | !g = fromRel g' 114 | !b = fromRel b' 115 | 116 | hsva :: Float -> Float -> Float -> Float -> Col 117 | hsva h s v a = setAlpha a $ hsv h s v 118 | 119 | ------------------------------------------------------ 120 | 121 | setAlpha :: Float -> Col -> Col 122 | setAlpha x (Col r g b _) = Col r g b x 123 | 124 | -- | White color. 125 | white :: Col 126 | white = Col 1 1 1 1 127 | 128 | -- | Black color. 129 | black :: Col 130 | black = Col 0 0 0 1 131 | 132 | -- | Nave color. 133 | navy :: Col 134 | navy = rgb 0 31 63 135 | 136 | -- | Blue color. 137 | blue :: Col 138 | blue = rgb 0 116 217 139 | 140 | -- | Aqua color. 141 | aqua :: Col 142 | aqua = rgb 127 219 255 143 | 144 | -- | Teal color. 145 | teal :: Col 146 | teal = rgb 57 204 204 147 | 148 | -- | Olive color. 149 | olive :: Col 150 | olive = rgb 61 153 112 151 | 152 | -- | Green color. 153 | green :: Col 154 | green = rgb 46 204 64 155 | 156 | -- | Lime color. 157 | lime :: Col 158 | lime = rgb 1 255 112 159 | 160 | -- | Yellow color. 161 | yellow :: Col 162 | yellow = rgb 255 220 0 163 | 164 | -- | Orange color 165 | orange :: Col 166 | orange = rgb 255 33 27 167 | 168 | -- | Red color 169 | red :: Col 170 | red = rgb 255 65 54 171 | 172 | -- | Maroon color. 173 | maroon :: Col 174 | maroon = rgb 133 20 75 175 | 176 | -- | Fuchsia color. 177 | fushsia :: Col 178 | fushsia = rgb 240 18 190 179 | 180 | -- | Purple color 181 | purple :: Col 182 | purple = rgb 177 13 201 183 | 184 | -- | Gray color. 185 | gray :: Col 186 | gray = grey 170 187 | 188 | -- | Silver color. 189 | silver :: Col 190 | silver = grey 221 191 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Data.hs: -------------------------------------------------------------------------------- 1 | -- | We can use ordinary Haskell data types, like floats, booleans and strings. 2 | module Graphics.Proc.Lib.Data( 3 | module X 4 | ) where 5 | 6 | import Graphics.Proc.Lib.Data.Conversion as X 7 | 8 | 9 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Data/Conversion.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Data.Conversion( 2 | int, float 3 | ) where 4 | 5 | -- | Converts ints to doubles. 6 | float :: Int -> Float 7 | float = fromIntegral 8 | 9 | -- | Converts doubles to ints. 10 | int :: Float -> Int 11 | int = floor 12 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Environment.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Environment( 2 | winSize, winWidth, winHeight, 3 | size, 4 | smooth, noSmooth, 5 | frameCount, frameRate, 6 | redraw, loop, noLoop 7 | ) where 8 | 9 | import qualified Control.Monad.State.Strict as S 10 | import Graphics.Rendering.OpenGL 11 | 12 | import Graphics.Proc.Core 13 | 14 | -- | Return the pair of width and height as a 2D vector. 15 | winSize :: Pio P2 16 | winSize = liftA2 P2 winWidth winHeight 17 | 18 | -- | System variable that stores the width of the display window. 19 | -- This value is set by the first parameter of the @size()@ function. 20 | -- For example, the function call @size(320, 240)@ sets the width 21 | -- variable to the value 320. The value of width defaults to 100 22 | -- if @size()@ is not used in a program. 23 | -- 24 | -- processing docs: 25 | winWidth :: Pio Float 26 | winWidth = liftIO $ fmap (fromIntegral . fst) getWindowSize 27 | 28 | -- | System variable that stores the height of the display window. 29 | -- This value is set by the second parameter of the @winSize()@ function. 30 | -- For example, the function call @winSize(320, 240)@ sets the height 31 | -- variable to the value 240. The value of height defaults to 100 32 | -- if @winSize()@ is not used in a program. 33 | -- 34 | -- processing docs: 35 | winHeight :: Pio Float 36 | winHeight = liftIO $ fmap (fromIntegral . snd) getWindowSize 37 | 38 | -------------------------------------------- 39 | 40 | -- | Defines the dimension of the display window width and height 41 | -- in units of pixels. In a program that has the setup() function, 42 | -- the size() function must be the first line of code inside setup(). 43 | -- 44 | -- processing docs: 45 | size :: P2 -> Draw 46 | size = liftIO . glSize 47 | 48 | -------------------------------------------- 49 | 50 | -- | Draws all geometry with smooth (anti-aliased) edges. This behavior is 51 | -- the default, so @smooth()@ only needs to be used when a program needs to set 52 | -- the smoothing in a different way. The level parameter increases the level 53 | -- of smoothness. This is the level of over sampling applied to the graphics buffer. 54 | -- 55 | -- processing docs: 56 | smooth :: Draw 57 | smooth = liftIO $ pointSmooth $= Enabled 58 | 59 | -- | Draws all geometry and fonts with jagged (aliased) edges and images 60 | -- when hard edges between the pixels when enlarged rather than interpoloating pixels. 61 | -- Note that smooth() is active by default, so it is necessary to call noSmooth() 62 | -- to disable smoothing of geometry, fonts, and images. 63 | -- 64 | -- processing docs: 65 | noSmooth :: Pio () 66 | noSmooth = liftIO $ pointSmooth $= Disabled 67 | 68 | -- | Specifies the number of frames to be displayed every second. 69 | -- For example, the function call frameRate(30) will attempt to 70 | -- refresh 30 times a second. If the processor is not fast enough to 71 | -- maintain the specified rate, the frame rate will not be achieved. 72 | -- Setting the frame rate within setup() is recommended. 73 | -- The default rate is 60 frames per second. 74 | -- 75 | -- processing docs: 76 | frameRate :: Float -> Pio () 77 | frameRate = putFrameRate 78 | 79 | 80 | -- | Executes the code within draw() one time. This functions allows the program 81 | -- to update the display window only when necessary, for example when an event 82 | -- registered by mousePressed() or keyPressed() occurs. 83 | -- 84 | -- In structuring a program, it only makes sense to call redraw() within events 85 | -- such as mousePressed(). This is because redraw() does not run draw() immediately 86 | -- (it only sets a flag that indicates an update is needed). 87 | -- 88 | -- processing docs: 89 | redraw :: Draw 90 | redraw = putLoopMode Redraw 91 | 92 | -- | By default, Processing loops through draw() continuously, executing the code 93 | -- within it. However, the draw() loop may be stopped by calling noLoop(). 94 | -- In that case, the draw() loop can be resumed with loop(). 95 | -- 96 | -- processing docs: 97 | loop :: Draw 98 | loop = putLoopMode Loop 99 | 100 | -- | Stops Processing from continuously executing the code within draw(). 101 | -- If loop() is called, the code in draw() begins to run continuously again. 102 | -- If using noLoop() in setup(), it should be the last line inside the block. 103 | -- 104 | -- processing docs: 105 | noLoop :: Draw 106 | noLoop = putLoopMode NoLoop 107 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Image.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Image( 2 | ) where 3 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Input.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Input( 2 | module X 3 | ) where 4 | 5 | import Graphics.Proc.Lib.Input.Mouse as X 6 | import Graphics.Proc.Lib.Input.Keyboard as X 7 | import Graphics.Proc.Lib.Input.Time as X 8 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Input/Keyboard.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Input.Keyboard( 2 | key, modifiers 3 | ) where 4 | 5 | import Graphics.Proc.Core 6 | 7 | -- | Returns last pressed key. 8 | -- 9 | -- processing docs: 10 | key :: Pio Key 11 | key = getLastPressedKey 12 | 13 | -- | Returns last pressed key modifier. 14 | modifiers :: Pio Modifiers 15 | modifiers = getPressedModifiers 16 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Input/Mouse.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Input.Mouse( 2 | mouse, mouseX, mouseY, 3 | relMouse, relMouseX, relMouseY, 4 | mouseButton 5 | ) where 6 | 7 | import Graphics.Proc.Core 8 | import Graphics.Proc.Lib.Environment 9 | 10 | -- | Contains coordinates of the mouse as a vector. 11 | mouse :: Pio P2 12 | mouse = getMousePosition 13 | 14 | -- | The system variable mouseX always contains the current horizontal coordinate of the mouse. 15 | -- 16 | -- processing docs: 17 | mouseX :: Pio Float 18 | mouseX = fmap px mouse 19 | 20 | -- | The system variable mouseX always contains the current vertical coordinate of the mouse. 21 | -- 22 | -- processing docs: 23 | mouseY :: Pio Float 24 | mouseY = fmap py mouse 25 | 26 | relMouseX, relMouseY :: Pio Float 27 | 28 | -- | Contains relative @mouseX@ coordinates of the mouse (scaled to the interval [0, 1]). 29 | relMouseX = do 30 | mx <- mouseX 31 | w <- winWidth 32 | return $ mx / w 33 | 34 | -- | Contains relative @mouseY@ coordinates of the mouse (scaled to the interval [0, 1]). 35 | relMouseY = do 36 | my <- mouseY 37 | h <- winHeight 38 | return $ my / h 39 | 40 | -- | Contains relative coordinates of the mouse as a vector. 41 | relMouse :: Pio P2 42 | relMouse = liftA2 P2 relMouseX relMouseY 43 | 44 | mouseButton :: Pio (Maybe MouseButton) 45 | mouseButton = getMouseButton 46 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Input/Time.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Input.Time( 2 | year, month, day, utcHour, hour, minute, second, millis 3 | ) where 4 | 5 | import Control.Monad.State.Strict 6 | import Data.Time.Clock 7 | import Data.Time.LocalTime 8 | import Data.Time.Calendar 9 | 10 | import Graphics.Proc.Core 11 | 12 | import Data.Fixed 13 | 14 | date :: IO (Integer,Int,Int) -- :: (year,month,day) 15 | date = getCurrentTime >>= return . toGregorian . utctDay 16 | 17 | -- | The year() function returns the current year as an integer (2003, 2004, 2005, etc). 18 | -- 19 | -- processing docs: 20 | year :: Pio Int 21 | year = liftIO $ fmap (\(y, _, _) -> fromInteger y) date 22 | 23 | -- | The month() function returns the current month as a value from 1 - 12. 24 | -- 25 | -- processing docs: 26 | month :: Pio Int 27 | month = liftIO $ fmap (\(_, m, _) -> m) date 28 | 29 | -- | The day() function returns the current day as a value from 1 - 31. 30 | -- 31 | -- processing docs: 32 | day :: Pio Int 33 | day = liftIO $ fmap (\(_, _, d) -> d) date 34 | 35 | -- getTime = liftIO $ fmap (\(UTCTime _ time) -> time) getCurrentTime 36 | getTime = liftIO $ do 37 | fmap (localTimeOfDay . zonedTimeToLocalTime) getZonedTime 38 | 39 | getUtcTime = liftIO $ fmap utctDayTime getCurrentTime 40 | 41 | -- | Returens univeral hour. 42 | utcHour :: Pio Int 43 | utcHour = fmap toHour getUtcTime 44 | where 45 | toHour x = (floor x) `div` (60 * 60) 46 | 47 | -- | The hour() function returns the current hour as a value from 0 - 23. 48 | -- 49 | -- processing docs: 50 | hour :: Pio Int 51 | hour = fmap todHour getTime 52 | 53 | -- | The minute() function returns the current minute as a value from 0 - 59. 54 | -- 55 | -- processing docs: 56 | minute :: Pio Int 57 | minute = fmap todMin getTime 58 | 59 | -- | The second() function returns the current second as a value from 0 - 59. 60 | -- 61 | -- processing docs: 62 | second :: Pio Int 63 | second = liftIO $ fmap toSecond $ getCurrentTime >>= return . fromRational . toRational . utctDayTime 64 | where 65 | toSecond x = (floor x) `mod` 60 66 | 67 | -- | Returns the number of milliseconds (thousandths of a second) since starting the program. This information is often used for timing events and animation sequences. 68 | -- 69 | -- processing docs: 70 | millis :: Pio Int 71 | millis = do 72 | start <- getStartTime 73 | now <- liftIO $ getCurrentTime 74 | return $ floor $ (* 1000) $ diffUTCTime now start 75 | 76 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Math.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Math( 2 | module X 3 | ) where 4 | 5 | import Graphics.Proc.Lib.Math.Random as X 6 | import Graphics.Proc.Lib.Math.Calculation as X 7 | import Graphics.Proc.Lib.Math.Trigonometry as X 8 | 9 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Math/Calculation.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Math.Calculation( 2 | remap, FloatInterval, constrain, constrain2 3 | ) where 4 | 5 | import Graphics.Proc.Core 6 | 7 | -- | Interval for Float value @(minValue, maxValue)@. 8 | type FloatInterval = (Float, Float) 9 | 10 | -- | Re-maps a number from one range to another. Originally called map in the Processing, but in Haskell this name is already taken. 11 | -- 12 | -- processing docs: 13 | remap :: FloatInterval -> FloatInterval -> Float -> Float 14 | remap (a, b) (a1, b1) x = a1 + (b1 - a1) * (x - a) / (b - a) 15 | 16 | -- | The @constrian@ that is defined on vectors. 17 | constrain2 :: (P2, P2) -> P2 -> P2 18 | constrain2 ((P2 xmin ymin), (P2 xmax ymax)) (P2 x y) = P2 (constrain (xmin, xmax) x) (constrain (ymin, ymax) y) 19 | 20 | -- | Constrains a value to not exceed a maximum and minimum value. 21 | -- 22 | -- processing docs: 23 | constrain :: (Float, Float) -> Float -> Float 24 | constrain (xmin, xmax) x = min xmax (max xmin x) 25 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Math/Trigonometry.hs: -------------------------------------------------------------------------------- 1 | -- | We can use all functions defined in Haskell 2 | module Graphics.Proc.Lib.Math.Trigonometry( 3 | radians, degrees, e, erad 4 | ) where 5 | 6 | import Graphics.Proc.Core 7 | import Graphics.Proc.Lib.Math.Calculation 8 | 9 | -- | Converts degrees to radians. 10 | radians :: Float -> Float 11 | radians = remap (0, 360) (0, 2 * pi) 12 | 13 | -- | Converts rdians to degrees. 14 | degrees :: Float -> Float 15 | degrees = remap (0, 2 * pi) (0, 360) 16 | 17 | -- | Converts angle in taus to unit vector rotated by given angle. 18 | e :: Float -> P2 19 | e x = P2 (cos (2 * pi * x)) (sin (2 * pi * x)) 20 | 21 | -- | The function e in radians. 22 | erad :: Float -> P2 23 | erad x = P2 (cos x) (sin x) 24 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Misc.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Misc( 2 | onCircle, onLine, uon 3 | ) where 4 | 5 | import Graphics.Proc.Core 6 | 7 | -- | Maps values from interval (0, 1) to the points on the circle. 8 | -- 9 | -- > onCircle radius center value 10 | onCircle :: Float -> P2 -> Float -> P2 11 | onCircle rad center x = center + rad *^ P2 (cos (2 * pi * x)) (sin (2 * pi * x)) 12 | 13 | -- | Maps values from interval (0, 1) to the points on the line segment. 14 | -- 15 | -- > onLine point1 point2 value 16 | onLine :: P2 -> P2 -> Float -> P2 17 | onLine p1 p2 x = p1 + x *^ (p2 - p1) 18 | 19 | -- | Rescales the unipolar scale (0, 1) to the given range. 20 | uon :: (Float, Float) -> Float -> Float 21 | uon (a, b) x = a + (b - a) * x 22 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Output.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Output( 2 | module Graphics.Proc.Lib.Output.TextArea 3 | ) where 4 | 5 | import Graphics.Proc.Lib.Output.TextArea 6 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Output/TextArea.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Output.TextArea( 2 | println 3 | ) where 4 | 5 | import Graphics.Proc.Core 6 | 7 | -- | Prints values on the console. 8 | println :: Show a => a -> Pio () 9 | println = liftIO . print 10 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Shape.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Shape( 2 | module X 3 | ) where 4 | 5 | import Graphics.Proc.Lib.Shape.Primitive2D as X 6 | import Graphics.Proc.Lib.Shape.Curve as X 7 | import Graphics.Proc.Lib.Shape.Attribute as X 8 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Shape/Attribute.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Shape.Attribute( 2 | EllipseMode(..), ellipseMode, rectMode, 3 | strokeWeight 4 | ) where 5 | 6 | import Control.Monad.State.Strict 7 | import Graphics.Rendering.OpenGL 8 | 9 | import Graphics.Proc.Core 10 | 11 | -- | Modifies the location from which ellipses are drawn by changing the way in which parameters given to ellipse() are intepreted. 12 | -- 13 | -- The default mode is @ellipseMode Center@, which interprets the first two parameters of ellipse() as the shape's center point, while the third and fourth parameters are its width and height. 14 | -- 15 | -- @ellipseMode Radius@ also uses the first two parameters of ellipse() as the shape's center point, but uses the third and fourth parameters to specify half of the shapes's width and height. 16 | -- 17 | -- @ellipseMode Corner@ interprets the first two parameters of ellipse() as the upper-left corner of the shape, while the third and fourth parameters are its width and height. 18 | -- 19 | -- @ellipseMode Corners@ interprets the first two parameters of ellipse() as the location of one corner of the ellipse's bounding box, and the third and fourth parameters as the location of the opposite corner. 20 | ellipseMode :: EllipseMode -> Draw 21 | ellipseMode = putEllipseMode 22 | 23 | -- | Modifies the location from which rectangles are drawn by changing the way in which parameters given to rect() are intepreted. 24 | -- 25 | -- The default mode is @rectMode Corner@, which interprets the first two parameters of rect() as the upper-left corner of the shape, while the third and fourth parameters are its width and height. 26 | -- 27 | -- @rectMode Corners@ interprets the first two parameters of rect() as the location of one corner, and the third and fourth parameters as the location of the opposite corner. 28 | -- 29 | -- @rectMode Center@ interprets the first two parameters of rect() as the shape's center point, while the third and fourth parameters are its width and height. 30 | -- 31 | -- @rectMode Radius@ also uses the first two parameters of rect() as the shape's center point, but uses the third and fourth parameters to specify half of the shapes's width and height. 32 | -- 33 | -- processing docs: 34 | rectMode :: RectMode -> Draw 35 | rectMode = putRectMode 36 | 37 | -- | Sets the width of the stroke used for lines, points, and the border around shapes. All widths are set in units of pixels. 38 | -- 39 | -- processing docs: 40 | strokeWeight :: Float -> Draw 41 | strokeWeight x = liftIO $ lineWidth $= x 42 | 43 | 44 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Shape/Curve.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Shape.Curve( 2 | bezier 3 | ) where 4 | 5 | import Graphics.Proc.Core 6 | import Graphics.Proc.Lib.Shape.Primitive2D 7 | 8 | bezierPointsNum = 35 9 | 10 | -- | Draws a Bezier curve on the screen. These curves are defined by a series 11 | -- of anchor and control points. The first two parameters specify the first 12 | -- anchor point and the last two parameters specify the other anchor point. 13 | -- The middle parameters specify the control points which define the shape of the curve. 14 | -- Bezier curves were developed by French engineer Pierre Bezier. 15 | -- 16 | -- processing docs: 17 | bezier :: P2 -> P2 -> P2 -> P2 -> Draw 18 | bezier p1 p2 p3 p4 = linePath (map phi ts) 19 | where 20 | ts = [0, 1 / bezierPointsNum .. 1] 21 | phi t = ((1 - t) ** 3) *^ p1 + (3 * t * ((1 - t) ** 2)) *^ p2 + (3 * (t ** 2) * (1 - t)) *^ p3 + (t ** 3) *^ p4 22 | -- TODO: implement with OpenGL built-in functions 23 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Shape/Primitive2D.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Shape.Primitive2D( 2 | triangle, rect, quad, ellipse, 3 | circle, line, linePath, 4 | point, pointPath, polygon, 5 | ) where 6 | 7 | import Graphics.Proc.Core 8 | import Graphics.Rendering.OpenGL hiding (get, rect) 9 | import qualified Graphics.Proc.Core.Vector.Primitive2D as Core 10 | 11 | -- | A triangle is a plane created by connecting three points. 12 | -- 13 | -- processing docs: 14 | triangle :: P2 -> P2 -> P2 -> Draw 15 | triangle = Core.triangle 16 | 17 | -- | Draws a rectangle to the screen. A rectangle is a four-sided shape 18 | -- with every angle at ninety degrees. By default, the first two parameters 19 | -- set the location of the upper-left corner, the third sets the width, 20 | -- and the fourth sets the height. The way these parameters are interpreted, 21 | -- however, may be changed with the rectMode() function. 22 | -- 23 | -- processing docs: 24 | rect :: P2 -> P2 -> Draw 25 | rect a b = uncurry cornerRect =<< fmap (\mode -> modeRectPoints mode a b) getRectMode 26 | 27 | cornerRect :: P2 -> P2 -> Draw 28 | cornerRect (P2 x y) (P2 w h) = drawProcP3 Polygon LineLoop [P2 x y, P2 x (y + h), P2 (x + w) (y + h), P2 (x + w) y] 29 | 30 | modeRectPoints mode (P2 a b) (P2 c d) = case mode of 31 | Corner -> (P2 a b, P2 c d) 32 | Corners -> (P2 a b, P2 (c - a) (d - b)) 33 | Radius -> 34 | let rx = c 35 | ry = d 36 | cx = a 37 | cy = b 38 | in (P2 (cx - rx) (cy - ry), P2 (2 * rx) (2 * ry)) 39 | Center -> 40 | let dx = c 41 | dy = d 42 | rx = dx / 2 43 | ry = dy / 2 44 | cx = a 45 | cy = b 46 | in (P2 (cx - rx) (cy - ry), P2 dx dy) 47 | 48 | -- | A quad is a quadrilateral, a four sided polygon. It is similar to a rectangle, 49 | -- but the angles between its edges are not constrained to ninety degrees. The first 50 | -- pair of parameters (x1,y1) sets the first vertex and the subsequent pairs should 51 | -- proceed clockwise or counter-clockwise around the defined shape. 52 | -- 53 | -- processing docs: 54 | quad :: P2 -> P2 -> P2 -> P2 -> Draw 55 | quad = Core.quad 56 | 57 | -- | Draws a polygon. 58 | polygon :: [P2] -> Draw 59 | polygon = Core.polygon 60 | 61 | -- | Draws a point, a coordinate in space at the dimension of one pixel. 62 | -- 63 | -- processing docs: 64 | point :: P2 -> Draw 65 | point = Core.point 66 | 67 | -- | Draws a sequence of points. 68 | pointPath :: [P2] -> Draw 69 | pointPath = Core.pointPath 70 | 71 | setStrokeColor :: Pio () 72 | setStrokeColor = setCol . maybe black id =<< getStroke 73 | 74 | black = Col 0 0 0 1 75 | 76 | -- | Draws a line (a direct path between two points) to the screen. 77 | -- 78 | -- processing docs: 79 | line :: P2 -> P2 -> Draw 80 | line = Core.line 81 | 82 | -- | Draws a line-path (sequence of line segments). 83 | linePath :: [P2] -> Draw 84 | linePath = Core.linePath 85 | 86 | -- | Draws an ellipse (oval) to the screen. An ellipse with equal 87 | -- width and height is a circle. By default, the first two parameters 88 | -- set the location, and the third and fourth parameters set the shape's 89 | -- width and height. The origin may be changed with the @ellipseMode()@ function. 90 | -- 91 | -- processing docs: 92 | ellipse :: P2 -> P2 -> Draw 93 | ellipse center rad = do 94 | mode <- getEllipseMode 95 | drawProcP3 Polygon LineLoop (modeEllipsePoints mode 150 rad center) 96 | 97 | -- | Draws a circle with a given radius and center. 98 | -- 99 | -- > circle radius center 100 | circle :: Float -> P2 -> Draw 101 | circle rad center = drawProcP3 Polygon LineLoop (modeEllipsePoints Radius 150 (P2 rad rad) center) 102 | 103 | modeEllipsePoints :: DrawMode -> Float -> P2 -> P2 -> [P2] 104 | modeEllipsePoints mode number (P2 a b) (P2 c d) = (uncurry $ ellipsePoints number) $ case mode of 105 | Center -> 106 | let width = a 107 | height = b 108 | cx = c 109 | cy = d 110 | in (P2 (width / 2) (height / 2), P2 cx cy) 111 | Radius -> 112 | let radx = a 113 | rady = b 114 | cx = c 115 | cy = d 116 | in (P2 radx rady, P2 cx cy) 117 | Corner -> 118 | let width = a 119 | height = b 120 | px = c 121 | py = d 122 | rx = width / 2 123 | ry = width / 2 124 | in (P2 rx ry, P2 (px + rx) (py + ry)) 125 | Corners -> 126 | let p1x = a 127 | p1y = b 128 | p2x = c 129 | p2y = d 130 | in (P2 (abs (p1x - p2x) / 2) (abs (p1y - p2y) / 2), P2 ((p1x + p2x) / 2) ((p1y + p2y) / 2)) 131 | 132 | ellipsePoints number (P2 radx rady) (P2 cx cy) = 133 | [ let alpha = twoPi * i /number 134 | in P2 (cx + radx * (cos (alpha))) (cy + rady * (sin (alpha))) 135 | | i <- [1,2..number]] 136 | where 137 | twoPi = 2*pi 138 | 139 | --------------------------------------------------- 140 | 141 | drawP3 :: IsPoint p => PrimitiveMode -> [p] -> Pio () 142 | drawP3 primType ps = do 143 | liftIO $ renderPrimitive primType $ mapM_ v3 ps 144 | 145 | drawProcP3 :: IsPoint p => PrimitiveMode -> PrimitiveMode -> [p] -> Pio () 146 | drawProcP3 onFill onStroke ps = do 147 | go onFill =<< getFill 148 | go onStroke =<< getStroke 149 | where 150 | go shapeType mcol = case mcol of 151 | Just col -> do 152 | setCol col 153 | drawP3 shapeType ps 154 | Nothing -> return () 155 | 156 | setCol :: Col -> Draw 157 | setCol col = liftIO $ currentColor $= glCol col 158 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Transform.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Transform( 2 | translate, 3 | rotate, 4 | scale, 5 | resetMatrix, 6 | local, 7 | applyMatrix, 8 | shearX, shearY 9 | ) where 10 | 11 | import Control.Monad.State.Strict 12 | 13 | import Graphics.Rendering.OpenGL hiding (scale, translate, rotate) 14 | import qualified Graphics.Rendering.OpenGL as G 15 | 16 | import Graphics.Proc.Core 17 | 18 | -- | Specifies an amount to displace objects within the display window. The x parameter specifies left/right translation, the y parameter specifies up/down translation 19 | -- 20 | -- processing docs: 21 | translate :: P2 -> Draw 22 | translate p = liftIO $ G.translate $ toVector (toP3 p) 23 | 24 | -- | Rotates the amount specified by the angle parameter. Angles must be specified in taus (values from 0 to 1) 25 | -- 26 | -- processing docs: 27 | rotate :: Float -> Draw 28 | rotate x = liftIO $ G.rotate (x * 360) (Vector3 0 0 (1 :: GLfloat)) 29 | 30 | -- | Increases or decreases the size of a shape by expanding and contracting vertices. Objects always scale from their relative origin to the coordinate system. Scale values are specified as decimal percentages. For example, the function call scale(2.0) increases the dimension of a shape by 200%. 31 | -- 32 | -- processing docs: 33 | scale :: P2 -> Draw 34 | scale (P2 x y) = liftIO $ G.scale x y 1 35 | 36 | -- | Replaces the current matrix with the identity matrix. The equivalent function in OpenGL is glLoadIdentity(). 37 | -- 38 | -- processing docs: 39 | resetMatrix :: Draw 40 | resetMatrix = liftIO $ loadIdentity 41 | 42 | -- | Applies local transformation. Substitutes the pair of pushMatrix and popMatrix. 43 | -- It can be used like this: 44 | -- 45 | -- > local $ do 46 | -- > rotate angle 47 | -- > translate p1 48 | -- > drawShape params 49 | -- 50 | -- see and 51 | local :: Draw -> Draw 52 | local (Pio a) = Pio $ StateT $ \s -> do 53 | preservingMatrix $ do 54 | runStateT a s 55 | 56 | -- | Multiplies the current matrix by the one specified through the parameters. 57 | -- This is very slow because it will try to calculate the inverse of the transform, so avoid it whenever possible. The equivalent function in OpenGL is glMultMatrix(). 58 | -- 59 | -- processing docs: 60 | applyMatrix :: [Float] -> Draw 61 | applyMatrix as@[a11, a12, a21, a22] = 62 | applyMatrix 63 | [ a11, a12, 0, 0 64 | , a21, a22, 0, 0 65 | , 0, 0, 1, 0 66 | , 0, 0, 0, 1] 67 | applyMatrix as@[a11, a12, a13, a21, a22, a23, a31, a32, a33] = 68 | applyMatrix 69 | [ a11, a12, a13, 0 70 | , a21, a22, a23, 0 71 | , a31, a32, a33, 0 72 | , 0, 0, 0, 1] 73 | applyMatrix as@[a11, a12, a13, a14, a21, a22, a23, a24, a31, a32, a33, a34, a41, a42, a43, a44] = liftIO $ do 74 | m <- newMatrix RowMajor (fmap f2d as) 75 | multMatrix (m :: GLmatrix GLdouble) 76 | applyMatrix _ = error "Wrong matrix size. The list should contain 4, 9 or 16 elements" 77 | 78 | -- | Shears a shape around the x-axis the amount specified by the angle parameter. A 79 | -- 80 | -- processing docs: 81 | shearX :: Float -> Draw 82 | shearX x = applyMatrix [1, x, 0, 1] 83 | 84 | -- | Shears a shape around the y-axis the amount specified by the angle parameter. A 85 | -- 86 | -- processing docs: 87 | shearY :: Float -> Draw 88 | shearY x = applyMatrix [1, 0, x, 1] 89 | 90 | printMatrix :: Draw 91 | printMatrix = undefined 92 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Typography.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Typography( 2 | module X 3 | ) where 4 | 5 | import Graphics.Proc.Lib.Typography.Display as X 6 | import Graphics.Proc.Lib.Typography.Attributes as X 7 | import Graphics.Proc.Lib.Typography.Metrics as X 8 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Typography/Attributes.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Typography.Attributes( 2 | -- textSize 3 | ) where 4 | 5 | {- 6 | import Graphics.Rendering.FTGL 7 | import Graphics.Proc.Core 8 | 9 | import Graphics.Proc.Lib.Typography.Display 10 | 11 | textSize :: Int -> Pio () 12 | textSize size = onFont $ \font -> setFontSize font size 13 | 14 | 15 | -- consider using these types for alignment 16 | data TextAlignX = AlignLeft | AlignRight | AlignCenterX 17 | data TextAlignY = AlignTop | AlignBottom | AlignCenterY | AlignBaseline 18 | 19 | textAlignX :: TextAlignX -> Draw 20 | textAlignX tx = undefined 21 | 22 | textAlign :: TextAlignX -> TextAlignY -> Draw 23 | textAlign tx ty = undefined 24 | -} 25 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Typography/Display.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Typography.Display( 2 | {- 3 | loadFont, text, textFont, 4 | getCurrentFont, onFont, setFontSize 5 | -} 6 | ) where 7 | 8 | {- 9 | import Graphics.Rendering.FTGL 10 | import Codec.Binary.UTF8.String 11 | 12 | import Graphics.Proc.Core 13 | import Graphics.Proc.Lib.Transform 14 | 15 | loadFont :: String -> Pio Font 16 | loadFont fontName = liftIO $ do 17 | font <- createTextureFont fontName 18 | fsetFontCharMap font (marshalCharMap EncodingUnicode) 19 | return font 20 | 21 | text :: String -> P2 -> Pio () 22 | text str p = do 23 | onFont $ \fontSpec -> 24 | local $ do 25 | translate p 26 | local $ do 27 | scale (fontSizeFactor fontSpec *^ (1, -1)) 28 | liftIO $ renderFont (fontCurrent fontSpec) (encodeString str) Side 29 | 30 | fontSizeFactor fontSpec = fromIntegral (fontSize fontSpec) / fromIntegral (fontInitSize fontSpec) 31 | 32 | textFont :: Font -> Int -> Pio () 33 | textFont font size = do 34 | modifyStatePio $ \st -> st { globalFont = Just (FontSpec font size size) } 35 | onFont $ \fontSpec -> liftIO $ do 36 | _ <- setFontFaceSize (fontCurrent fontSpec) size size 37 | return () 38 | 39 | ----------------------------------------------- 40 | -- Raw Fonts 41 | 42 | getCurrentFont :: Pio (Maybe FontSpec) 43 | getCurrentFont = readStatePio globalFont 44 | 45 | onFont :: (FontSpec -> Pio ()) -> Pio () 46 | onFont act = do 47 | mfont <- getCurrentFont 48 | case mfont of 49 | Just font -> act font 50 | Nothing -> liftIO $ print "Font is not set" 51 | 52 | setFontSize :: FontSpec -> Int -> Pio () 53 | setFontSize fontSpec size = modifyStatePio $ \st -> 54 | let font = globalFont st 55 | font' = fmap (\x -> x { fontSize = size }) font 56 | in st { globalFont = font' } 57 | -} 58 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib/Typography/Metrics.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib.Typography.Metrics( 2 | ) where 3 | 4 | import Graphics.Proc.Core 5 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib3.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib3( 2 | module X 3 | ) where 4 | 5 | import Graphics.Proc.Lib.Environment as X 6 | import Graphics.Proc.Lib.Data as X 7 | import Graphics.Proc.Lib.Input as X 8 | import Graphics.Proc.Lib.Output as X 9 | import Graphics.Proc.Lib.Color as X 10 | import Graphics.Proc.Lib.Image as X 11 | import Graphics.Proc.Lib.Typography as X 12 | import Graphics.Proc.Lib.Math as X 13 | import Graphics.Proc.Lib.Misc as X 14 | import Graphics.Proc.Lib3.Camera as X 15 | import Graphics.Proc.Lib3.Transform as X 16 | import Graphics.Proc.Lib3.Lights as X 17 | import Graphics.Proc.Lib.Shape.Attribute as X(strokeWeight) 18 | import Graphics.Proc.Lib3.Shape.Primitive2D as X 19 | import Graphics.Proc.Lib3.Shape.Primitive3D as X 20 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib3/Camera.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib3.Camera( 2 | camera, 3 | camera2, 4 | ortho, 5 | frustrum, 6 | perspective, 7 | ) where 8 | 9 | import Control.Monad.State.Strict 10 | 11 | import qualified Graphics.Rendering.OpenGL as G 12 | import Graphics.Proc.Core 13 | 14 | -- | Define a viewing transformation 15 | -- 16 | -- > camera eye center up 17 | -- 18 | -- @camera@ creates a viewing matrix derived from an eye point, 19 | -- a reference point indicating the center of the scene, and an UP vector. 20 | camera :: P3 -> P3 -> P3 -> Pio () 21 | camera eye center up = 22 | liftIO $ G.lookAt (toVertex eye) (toVertex center) (toVector up) 23 | 24 | {- 25 | -- | Camera on spheric coordinates. 26 | -- 27 | -- > cameraSphere distance (P2 rotateX rotateY rotateZ) 28 | -- 29 | -- The eye is placed on the sphere with parameters: (distance, rotateX, rotateY). 30 | -- It looks at the center of the sphere. rotateZ - is rotation in the plane that is orthogonal to sphere. 31 | -- Rotations are measured in @tau@ (the fraction of the full circle) 32 | cameraSphere :: Float -> P3 -> Pio () 33 | cameraSphere distance (P3 rotateX rotateY rotateZ) = 34 | where 35 | center = P3 0 0 0 36 | eye = P3 eyeX eyeY eyeZ 37 | 38 | eyeX = distance * cos rotX * sin rotY 39 | eyeY = distance * sin rotX * sin rotY 40 | eyeZ = distance * cos rotY 41 | 42 | rotX = 2 * pi * rotateX 43 | rotY = 2 * pi * rotateY 44 | -} 45 | 46 | -- | 2D camera view. It defines the center point, distance (affects scaling) and rotation 47 | -- 48 | -- > camera2 center distance angle 49 | camera2 :: P2 -> Float -> Float -> Pio () 50 | camera2 (P2 cx cy) dist angle = camera (P3 cx cy dist) (P3 cx cy 0) (P3 (cos angle) (sin angle) 0) 51 | 52 | ortho :: Float -> Float -> Float -> Float -> Float -> Float -> Pio () 53 | ortho left right bottom top near far = 54 | liftIO $ G.ortho (f2d left) (f2d right) (f2d bottom) (f2d top) (f2d near) (f2d far) 55 | 56 | frustrum :: Float -> Float -> Float -> Float -> Float -> Float -> Pio () 57 | frustrum left right bottom top near far = 58 | liftIO $ G.ortho (f2d left) (f2d right) (f2d bottom) (f2d top) (f2d near) (f2d far) 59 | 60 | perspective :: Float -> Float -> Float -> Float -> Pio () 61 | perspective fovy aspect zNear zFar = 62 | liftIO $ G.perspective (f2d fovy) (f2d aspect) (f2d zNear) (f2d zFar) 63 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib3/Lights.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib3.Lights( 2 | ) where 3 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib3/Shape/Primitive2D.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib3.Shape.Primitive2D( 2 | triangle, quad, 3 | line, linePath, 4 | point, pointPath, polygon, 5 | ) where 6 | 7 | import Graphics.Proc.Core 8 | import Graphics.Rendering.OpenGL hiding (get, rect) 9 | import qualified Graphics.Proc.Core.Vector.Primitive2D as Core 10 | 11 | -- | A triangle is a plane created by connecting three points. 12 | -- 13 | -- processing docs: 14 | triangle :: P3 -> P3 -> P3 -> Draw 15 | triangle = Core.triangle 16 | 17 | -- | Draws a rectangle to the screen. A rectangle is a four-sided shape 18 | -- with every angle at ninety degrees. By default, the first two parameters 19 | -- set the location of the upper-left corner, the third sets the width, 20 | -- and the fourth sets the height. The way these parameters are interpreted, 21 | -- however, may be changed with the rectMode() function. 22 | -- 23 | 24 | -- | A quad is a quadrilateral, a four sided polygon. It is similar to a rectangle, 25 | -- but the angles between its edges are not constrained to ninety degrees. The first 26 | -- pair of parameters (x1,y1) sets the first vertex and the subsequent pairs should 27 | -- proceed clockwise or counter-clockwise around the defined shape. 28 | -- 29 | -- processing docs: 30 | quad :: P3 -> P3 -> P3 -> P3 -> Draw 31 | quad = Core.quad 32 | 33 | -- | Draws a polygon. 34 | polygon :: [P3] -> Draw 35 | polygon = Core.polygon 36 | 37 | -- | Draws a point, a coordinate in space at the dimension of one pixel. 38 | -- 39 | -- processing docs: 40 | point :: P3 -> Draw 41 | point = Core.point 42 | 43 | -- | Draws a sequence of points. 44 | pointPath :: [P3] -> Draw 45 | pointPath = Core.pointPath 46 | 47 | setStrokeColor :: Pio () 48 | setStrokeColor = setCol . maybe black id =<< getStroke 49 | 50 | black = Col 0 0 0 1 51 | 52 | -- | Draws a line (a direct path between two points) to the screen. 53 | -- 54 | -- processing docs: 55 | line :: P3 -> P3 -> Draw 56 | line = Core.line 57 | 58 | -- | Draws a line-path (sequence of line segments). 59 | linePath :: [P3] -> Draw 60 | linePath = Core.linePath 61 | 62 | --------------------------------------------------- 63 | 64 | setCol :: Col -> Draw 65 | setCol col = liftIO $ currentColor $= glCol col 66 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib3/Shape/Primitive3D.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib3.Shape.Primitive3D( 2 | SphereRes(..), 3 | sphereDetail, 4 | sphere, 5 | box, 6 | tetrahedron, 7 | cube, 8 | octahedron, 9 | dodecahedron, 10 | icosahedron, 11 | ) where 12 | 13 | import Graphics.Proc.Core 14 | import Graphics.Proc.Lib3.Shape.Primitive2D (linePath, line) 15 | import qualified Graphics.Rendering.OpenGL.GLU.Quadrics as G 16 | 17 | -- | Controls the detail used to render a sphere by adjusting the number of vertices of the sphere mesh. 18 | -- The default resolution is 30, which creates a fairly detailed sphere definition with vertices 19 | -- every 360/30 = 12 degrees. If you're going to render a great number of spheres per frame, 20 | -- it is advised to reduce the level of detail using this function. 21 | -- The setting stays active until sphereDetail() is called again with a new parameter 22 | -- and so should not be called prior to every sphere() statement, unless you wish to render 23 | -- spheres with different settings, e.g. using less detail for smaller spheres or ones 24 | -- further away from the camera. To control the detail of the horizontal and vertical resolution 25 | -- independently, use the version of the functions with two parameters. 26 | sphereDetail :: SphereRes -> Pio () 27 | sphereDetail sphereRes = modify' $ \st -> st { globalSphereDetail = toRawSphereRes sphereRes } 28 | 29 | sphere :: Float -> Draw 30 | sphere rad = do 31 | RawSphereRes slices stacks <- gets globalSphereDetail 32 | liftIO $ G.renderQuadric (G.QuadricStyle Nothing G.NoTextureCoordinates G.Outside G.FillStyle) (G.Sphere (f2d rad) slices stacks) 33 | 34 | -- | Draw a box (width, height, depth) with center at 0. 35 | box :: P3 -> Draw 36 | box (P3 h w d) = do 37 | sq d2 38 | sq (-d2) 39 | rib (-h2) (-w2) 40 | rib h2 (-w2) 41 | rib (-h2) w2 42 | rib h2 w2 43 | where 44 | sq z = linePath [P3 (-h2) (-w2) z, P3 (-h2) w2 z, P3 h2 w2 z, P3 h2 (-w2) z, P3 (-h2) (-w2) z] 45 | rib x y = line (P3 x y d2) (P3 x y (-d2)) 46 | 47 | h2 = 0.5 * h 48 | w2 = 0.5 * w 49 | d2 = 0.5 * d 50 | 51 | -- | Draw a tetrahedron with given radius of the sphere 52 | tetrahedron :: Float -> Pio () 53 | tetrahedron rad = do 54 | side v1 v2 v3 55 | side v1 v2 v4 56 | side v1 v4 v3 57 | side v4 v2 v3 58 | where 59 | side a b c = linePath [a, b, c, a] 60 | 61 | a1 = sqrt 2 / 3 62 | a2 = sqrt (2 / 3) 63 | a3 = negate (1/3) 64 | 65 | v1 = rad *^ P3 (sqrt 8 / 3) 0 a3 66 | v2 = rad *^ P3 (negate a1) a2 a3 67 | v3 = rad *^ P3 (negate a1) (negate a2) a3 68 | v4 = rad *^ P3 0 0 1 69 | 70 | cube :: Float -> Pio () 71 | cube rad = box (P3 x x x) 72 | where 73 | x = 2 * rad / sqrt 3 74 | 75 | octahedron :: Float -> Pio () 76 | octahedron rad = do 77 | side v1 v3 v5 78 | side v1 v3 v6 79 | side v1 v4 v5 80 | side v1 v4 v6 81 | side v2 v3 v5 82 | side v2 v3 v6 83 | side v2 v4 v5 84 | side v2 v4 v6 85 | where 86 | side a b c = linePath [a, b, c, a] 87 | 88 | rad' = negate rad 89 | 90 | v1 = P3 rad 0 0 91 | v2 = P3 rad' 0 0 92 | 93 | v3 = P3 0 rad 0 94 | v4 = P3 0 rad' 0 95 | 96 | v5 = P3 0 0 rad 97 | v6 = P3 0 0 rad' 98 | 99 | dodecahedron :: Float -> Pio () 100 | dodecahedron rad = do 101 | side v15 v13 v2 v11 v6 102 | side v13 v1 v17 v18 v2 103 | side v11 v6 v20 v8 v12 104 | side v11 v12 v4 v18 v2 105 | side v8 v12 v4 v14 v16 106 | side v4 v18 v17 v3 v14 107 | side v15 v13 v1 v9 v5 108 | side v15 v6 v20 v19 v5 109 | side v20 v19 v7 v16 v8 110 | side v15 v13 v1 v9 v5 111 | side v9 v10 v7 v19 v5 112 | side v9 v10 v3 v17 v1 113 | where 114 | side a1 a2 a3 a4 a5 = linePath [a1, a2, a3, a4, a5, a1] 115 | k = rad / sqrt 3 116 | 117 | phi = (1 + sqrt 5) / 2 118 | invPhi = recip phi 119 | p x y z = k *^ P3 x y z 120 | 121 | v1 = p 1 1 1 122 | v2 = p 1 (-1) 1 123 | v3 = p 1 1 (-1) 124 | v4 = p 1 (-1) (-1) 125 | 126 | v5 = p (-1) 1 1 127 | v6 = p (-1) (-1) 1 128 | v7 = p (-1) 1 (-1) 129 | v8 = p (-1) (-1) (-1) 130 | 131 | v9 = p 0 phi invPhi 132 | v10 = p 0 phi (negate invPhi) 133 | v11 = p 0 (negate phi) invPhi 134 | v12 = p 0 (negate phi) (negate invPhi) 135 | 136 | v13 = p invPhi 0 phi 137 | v14 = p invPhi 0 (negate phi) 138 | v15 = p (negate invPhi) 0 phi 139 | v16 = p (negate invPhi) 0 (negate phi) 140 | 141 | v17 = p phi invPhi 0 142 | v18 = p phi (negate invPhi) 0 143 | v19 = p (negate phi) invPhi 0 144 | v20 = p (negate phi) (negate invPhi) 0 145 | 146 | -- | Draw icosahedron with given radius 147 | icosahedron :: Float -> Pio () 148 | icosahedron rad = do 149 | side v1 v5 v7 150 | side v2 v5 v7 151 | side v1 v5 v9 152 | side v1 v9 v3 153 | side v1 v10 v3 154 | side v7 v10 v12 155 | side v8 v10 v12 156 | side v8 v10 v3 157 | side v8 v6 v3 158 | side v8 v6 v4 159 | side v11 v6 v4 160 | side v11 v2 v4 161 | side v11 v2 v5 162 | side v11 v9 v5 163 | side v11 v9 v6 164 | side v3 v9 v6 165 | side v4 v12 v8 166 | side v4 v12 v2 167 | side v1 v10 v7 168 | side v2 v7 v12 169 | where 170 | side a b c = linePath [a, b, c, a] 171 | phi = (1 + sqrt 5) / 2 172 | k = rad / sqrt (phi * phi + 1) 173 | p x y z = k *^ P3 x y z 174 | 175 | v1 = p 0 1 phi 176 | v2 = p 0 1 (negate phi) 177 | v3 = p 0 (-1) phi 178 | v4 = p 0 (-1) (negate phi) 179 | 180 | v5 = p 1 phi 0 181 | v6 = p 1 (negate phi) 0 182 | v7 = p (-1) phi 0 183 | v8 = p (-1) (negate phi) 0 184 | 185 | v9 = p phi 0 1 186 | v10 = p (negate phi) 0 1 187 | v11 = p phi 0 (-1) 188 | v12 = p (negate phi) 0 (-1) 189 | 190 | -------------------------------------------------------------------------------- /src/Graphics/Proc/Lib3/Transform.hs: -------------------------------------------------------------------------------- 1 | module Graphics.Proc.Lib3.Transform( 2 | translate, 3 | rotateX, rotateY, rotateZ, 4 | scale, 5 | resetMatrix, 6 | local, 7 | ) where 8 | 9 | import Control.Monad.State.Strict 10 | 11 | import Graphics.Rendering.OpenGL hiding (scale, translate, rotate) 12 | import qualified Graphics.Rendering.OpenGL as G 13 | 14 | import Graphics.Proc.Core 15 | 16 | -- | Specifies an amount to displace objects within the display window. The x parameter specifies left/right translation, the y parameter specifies up/down translation 17 | -- 18 | -- processing docs: 19 | translate :: P3 -> Draw 20 | translate p = liftIO $ G.translate $ toVector p 21 | 22 | -- | Rotates around given 3D vector. 23 | rotateBy :: Vector3 GLfloat -> Float -> Draw 24 | rotateBy v x = liftIO $ G.rotate (x * 360) v 25 | 26 | -- | Rotates around X-axis. 27 | rotateX :: Float -> Draw 28 | rotateX = rotateBy $ Vector3 (1 :: GLfloat) 0 0 29 | 30 | -- | Rotates around Y-axis. 31 | rotateY :: Float -> Draw 32 | rotateY = rotateBy $ Vector3 0 (1 :: GLfloat) 0 33 | 34 | -- | Rotates around Z-axis. 35 | rotateZ :: Float -> Draw 36 | rotateZ = rotateBy $ Vector3 0 0 (1 :: GLfloat) 37 | 38 | -- | Increases or decreases the size of a shape by expanding and contracting vertices. Objects always scale from their relative origin to the coordinate system. Scale values are specified as decimal percentages. For example, the function call scale(2.0) increases the dimension of a shape by 200%. 39 | -- 40 | -- processing docs: 41 | scale :: P3 -> Draw 42 | scale (P3 x y z) = liftIO $ G.scale x y z 43 | 44 | -- | Replaces the current matrix with the identity matrix. The equivalent function in OpenGL is glLoadIdentity(). 45 | -- 46 | -- processing docs: 47 | resetMatrix :: Draw 48 | resetMatrix = liftIO $ loadIdentity 49 | 50 | -- | Applies local transformation. Substitutes the pair of pushMatrix and popMatrix. 51 | -- It can be used like this: 52 | -- 53 | -- > local $ do 54 | -- > rotate angle 55 | -- > translate p1 56 | -- > drawShape params 57 | -- 58 | -- see and 59 | local :: Draw -> Draw 60 | local (Pio a) = Pio $ StateT $ \s -> do 61 | preservingMatrix $ do 62 | runStateT a s 63 | 64 | -------------------------------------------------------------------------------- /src/Graphics/Proc3.hs: -------------------------------------------------------------------------------- 1 | -- | Imperative EDSL for graphics and animation. The libary implements a Processing in Haskell. 2 | -- Three dimensional version of the library. 3 | -- 4 | -- We can find the quickstart guide and lots of examples in the project repository on github (see the directory @examples@). 5 | module Graphics.Proc3( 6 | -- * Structure 7 | Proc(..), runProc, 8 | 9 | -- * Types 10 | Pio, Draw, Update, TimeInterval, Col(..), P2(..), P3(..), IsPoint(..), 11 | 12 | -- * Environment 13 | winSize, winWidth, winHeight, 14 | size, 15 | smooth, noSmooth, frameCount, frameRate, 16 | loop, noLoop, redraw, 17 | 18 | -- * Data 19 | -- | We can use ordinary Haskell datatypes primitive and composite ones. 20 | 21 | -- ** Conversion 22 | int, float, 23 | 24 | -- ** String Functions 25 | -- | We can use standard Haskell string functions. 26 | 27 | -- ** Array Functions 28 | -- | We can use Haskell arrays. 29 | 30 | -- * Control 31 | -- | We can use plain old Bool datatype. 32 | 33 | 34 | -- * Shape 35 | 36 | -- ** 2D Primitives 37 | 38 | triangle, quad, line, linePath, point, pointPath, polygon, 39 | 40 | -- ** 3D Primitives 41 | SphereRes(..), sphereDetail, sphere, box, tetrahedron, cube, octahedron, dodecahedron, icosahedron, 42 | 43 | -- ** Attributes 44 | DrawMode(..), strokeWeight, 45 | 46 | -- ** Loading & Displaying 47 | 48 | -- * Input 49 | 50 | -- ** Mouse 51 | mouse, mouseX, mouseY, 52 | relMouse, relMouseX, relMouseY, 53 | MouseButton(..), 54 | mouseButton, 55 | 56 | -- ** Keyboard 57 | Key(..), SpecialKey(..), key, Modifiers(..), modifiers, 58 | 59 | -- ** Time & Date 60 | year, month, day, hour, minute, second, millis, utcHour, 61 | 62 | -- * Output 63 | 64 | -- ** Text Area 65 | println, 66 | 67 | -- * Transform 68 | translate, 69 | rotateX, rotateY, rotateZ, 70 | scale, 71 | resetMatrix, local, 72 | 73 | -- * Camera 74 | camera, camera2, ortho, frustrum, perspective, 75 | 76 | -- * Color 77 | fill, noFill, stroke, noStroke, strokeFill, 78 | rgb, rgba, grey, greya, setAlpha, 79 | hsv, hsva, 80 | background, clear, 81 | 82 | white, black, navy, blue, aqua, teal, olive, green, 83 | lime, yellow, orange, red, maroon, fushsia, purple, 84 | gray, silver, 85 | 86 | -- ** Calculation 87 | remap, FloatInterval, 88 | constrain, constrain2, 89 | 90 | -- ** Trigonometry 91 | radians, degrees, e, erad, 92 | 93 | -- ** Random 94 | randomSeed, random, random2, randomP2, randomCol, randomCola, 95 | randomGaussian, 96 | 97 | -- *** Perlin noise 98 | -- | Returns the Perlin noise value at specified coordinates. Perlin noise is a random sequence generator producing a more natural, harmonic succession of numbers than that of the standard random() function. It was developed by Ken Perlin in the 1980s and has been used in graphical applications to generate procedural textures, shapes, terrains, and other seemingly organic forms. 99 | -- 100 | -- processing docs: 101 | NoiseDetail(..), noiseDetail, noiseOctaves, noiseSeed, noise1, noise2, noise3, 102 | 103 | -- * Misc 104 | onCircle, onLine, uon, 105 | 106 | -- * Pio mutable values 107 | PioRef, newPioRef, readPioRef, writePioRef, modifyPioRef, 108 | 109 | -- | Useful standard functions 110 | module Data.VectorSpace, 111 | module Data.AffineSpace, 112 | module Data.Cross, 113 | module Data.NumInstances, 114 | module Data.Default, 115 | module Data.Monoid, 116 | module Control.Monad, 117 | module Control.Monad.IO.Class, 118 | module Control.Applicative 119 | ) where 120 | 121 | import Data.Default 122 | import Data.Monoid 123 | import Control.Monad 124 | import Control.Monad.IO.Class 125 | import Control.Applicative 126 | 127 | import Data.VectorSpace hiding (Sum(..)) 128 | import Data.NumInstances 129 | import Data.AffineSpace 130 | import Data.Cross 131 | 132 | import Graphics.Proc.Core 133 | import Graphics.Proc.Lib3 134 | 135 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: 2 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/21.yaml 3 | 4 | packages: 5 | - . 6 | 7 | extra-deps: 8 | - hsnoise-0.0.2 9 | 10 | -------------------------------------------------------------------------------- /tutorial/FirstSteps.md: -------------------------------------------------------------------------------- 1 | 2 | The first steps. The structure of animation 3 | ========================================= 4 | 5 | The animation is some evolving state that we can render on the screen. 6 | We have initial state, the function that can draw the state and the function that updates the state. 7 | So there are three main functions: 8 | 9 | * `setup` -- it produces initial state and sets up the scene. Here we can define the window size, frame rate etc. 10 | 11 | * `draw` -- it turns the state to picture. It renders or model on the screen. 12 | 13 | * `update` -- it calculates the next state out of current one. 14 | 15 | The functions have following signatures: 16 | 17 | ~~~Haskell 18 | setup :: Pio st 19 | 20 | draw :: st -> Pio () 21 | 22 | update :: st -> Pio st 23 | ~~~ 24 | 25 | The `Pio` is IO-monad augmented with processing functions. We can also lift plain old IO-actions 26 | to `Pio` with the function `liftIO`. 27 | 28 | Let's draw a simple static picture. We are going to draw a circle in the center of the window. 29 | We are going to define our three main functions and render the animation. 30 | 31 | ~~~Haskell 32 | import Graphics.Proc 33 | 34 | width = 400 35 | height = 400 36 | center = (width / 2, height / 2) 37 | 38 | setup = do 39 | size (width, height) 40 | return () 41 | 42 | draw () = do 43 | background (grey 0) 44 | fill (grey 255) 45 | circle 17 center 46 | 47 | update x = return x 48 | 49 | main = runProc $ def 50 | { procSetup = setup 51 | , procDraw = draw 52 | , procUpdate = update } 53 | ~~~ 54 | 55 | In setup we set the sizes of the window and return the initial state. 56 | Our picture is static so the state is not going to change that is why we return 57 | a value of the unit type. It has only one value. 58 | 59 | The function `draw` clears the picture with black color (`grey 0`), sets the 60 | current color to white (`fill (grey 255)`) and draws a circle in the center of the screen. 61 | 62 | The function `update` doesn't change anything it just passes the state around. 63 | 64 | We are ready to render our static animation. To do that we set the three callbacks 65 | and pass them to the function `runProc`. 66 | 67 | ~~~Haskell 68 | runProc :: Proc -> IO () 69 | ~~~ 70 | 71 | The data type `Proc` contains all callback functions. There are many callbacks but right now 72 | we can set only three of them. We use the default value `def` and redefine the fields we need: 73 | 74 | ~~~Haskell 75 | main = runProc $ def 76 | { procSetup = setup 77 | , procDraw = draw 78 | , procUpdate = update } 79 | ~~~ 80 | 81 | Save the code to file and execute runhaskell on it: 82 | 83 | ~~~ 84 | > runhaskell Static.hs 85 | ~~~ 86 | 87 | We have a nice picture of the lonely star. Let's create a planet that spins around our Sun! 88 | The planet has parameters: 89 | 90 | ~~~Haskell 91 | data Planet = Planet 92 | { planetColor :: Col 93 | , planetRadius :: Float 94 | , planetAngle :: Float 95 | , planetSpeed :: Float 96 | , planetDistanceToSun :: Float } 97 | ~~~ 98 | 99 | A planet can have color, radius (or size), current angle on the orbit, speed of rotation 100 | and distance to the Sun. Let's define the function to draw the planet: 101 | 102 | ~~~Haskell 103 | drawPlanet p = local $ do 104 | translate center 105 | rotate (planetAngle p) 106 | noStroke 107 | fill (planetColor p) 108 | circle (planetRadius p) (0, planetDistanceToSun p) 109 | ~~~ 110 | 111 | We draw the planet at transformed coordinates. First we translate the coordinates 112 | so that the point (0, 0) corresponds to the center of the screen. Then we rotate 113 | the space by the planet's angle. We are going to update the angle of rotation so that 114 | the planet could move around the Sun. Let's implement this function: 115 | 116 | ~~~Haskell 117 | updatePlanet p = p { planetAngle = angle + speed } 118 | where 119 | angle = planetAngle p 120 | speed = planetSpeed p 121 | ~~~ 122 | 123 | We can define the initial state: 124 | 125 | ~~~Haskell 126 | initPlanets = [Planet green 10 0 0.0013 85, Planet red 8 0 0.001 155] 127 | ~~~ 128 | 129 | Here is the complete code sample. Notice how easy it is to add new planets. 130 | We can just put them into init list and system will take of them: 131 | 132 | ~~~Haskell 133 | import Graphics.Proc 134 | 135 | width = 400 136 | height = 400 137 | center = (width / 2, height / 2) 138 | 139 | setup = do 140 | size (width, height) 141 | return initPlanets 142 | 143 | draw xs = do 144 | background (grey 0) 145 | drawSun 146 | mapM_ drawPlanet xs 147 | 148 | update xs = return $ fmap updatePlanet xs 149 | 150 | ------------------------------------- 151 | -- sun 152 | 153 | drawSun = do 154 | fill (grey 255) 155 | circle 17 center 156 | 157 | ------------------------------------- 158 | -- planets 159 | 160 | data Planet = Planet 161 | { planetColor :: Col 162 | , planetRadius :: Float 163 | , planetAngle :: Float 164 | , planetSpeed :: Float 165 | , planetDistanceToSun :: Float } 166 | 167 | drawPlanet p = local $ do 168 | translate center 169 | rotate (planetAngle p) 170 | noStroke 171 | fill (planetColor p) 172 | circle (planetRadius p) (0, planetDistanceToSun p) 173 | 174 | updatePlanet p = p { planetAngle = angle + speed } 175 | where 176 | angle = planetAngle p 177 | speed = planetSpeed p 178 | 179 | initPlanets = [Planet green 10 0 0.0013 85, Planet red 8 0 0.001 155] 180 | 181 | ------------------------------------- 182 | 183 | main = runProc $ def 184 | { procSetup = setup 185 | , procDraw = draw 186 | , procUpdate = update } 187 | ~~~ 188 | 189 | We use standard Haskell functions to update all planets in the list. 190 | The `mapM_` to draw planets and accumulate the effects and `fmap` 191 | to transform all elements in the list. 192 | 193 | Exercise: try to add satellites. 194 | 195 | 196 | -------------------------------------------------------------------------------- /tutorial/Random.md: -------------------------------------------------------------------------------- 1 | Randomness 2 | ================================ 3 | 4 | Let's create some random stuff! We have several functions to simulate randomness. 5 | The simplest functions are `random` and it's bro `random2`. They create random values 6 | from the given interval: 7 | 8 | ~~~Haskell 9 | random :: Float -> Pio Float 10 | random maxValue = random (0, maxValue) 11 | 12 | random2 :: (Float, Float) -> Pio Float 13 | random2 (minValue, maxValue) = ... 14 | ~~~ 15 | 16 | Let's create a chaotic movement. This type of random behavior is called brownian motion: 17 | 18 | ~~~Haskell 19 | import Graphics.Proc 20 | 21 | main = runProc $ def 22 | { procSetup = setup 23 | , procDraw = draw 24 | , procUpdate = update } 25 | 26 | width = 400 27 | height = 400 28 | center = (0.5 * width, 0.5 * height) 29 | 30 | setup = do 31 | size (width, height) 32 | background (grey 0) 33 | stroke (grey 255) 34 | strokeWeight 2 35 | frameRate 30 36 | return (center, center) 37 | 38 | draw (p1, p2) = do 39 | line p1 p2 40 | 41 | len = 5 42 | 43 | update (_, p) = do 44 | x <- random2 (-len, len) 45 | y <- random2 (-len, len) 46 | return (p, p + (x, y)) 47 | ~~~ 48 | 49 | We have functions to create ranfom points on the screen and colors: `randomP2`, `randomCol`, `ranodimCola` (color with transparency or alpha). 50 | Let's draw colored circles at random on the screen: 51 | 52 | ~~~Haskell 53 | import Graphics.Proc 54 | 55 | main = runProc $ def 56 | { procSetup = setup 57 | , procDraw = draw } 58 | 59 | width = 400 60 | height = 400 61 | center = (0.5 * width, 0.5 * height) 62 | 63 | setup = do 64 | size (width, height) 65 | background (grey 255) 66 | frameRate 7 67 | 68 | draw () = do 69 | drawRandomCircle 70 | 71 | drawRandomCircle = do 72 | noStroke 73 | fill =<< randomCola 74 | rad <- random2 (10, 40) 75 | circle rad =<< randomP2 76 | ~~~ 77 | 78 | 79 | Gaussian noise 80 | ------------------------------------------ 81 | 82 | With gaussian noise we can create values that most frequently fall to a certain value 83 | but often miss it by some degree. With this change we can spread all our circles around the center: 84 | 85 | 86 | ~~~Haskell 87 | drawRandomGaussCircle = do 88 | noStroke 89 | fill =<< randomCola 90 | rad <- random2 (10, 20) 91 | x <- randomGaussian 92 | y <- randomGaussian 93 | circle rad (50 * (x, y) + center) 94 | ~~~ 95 | 96 | The function `randomGaussian` generates values that are spread around zero. Amount of spread equals to 1. 97 | We can add th value to change the center point and multiply the value to change the amount of spread. 98 | 99 | Perlin noise 100 | ------------------------------------------- 101 | 102 | (right now it looks like haskell implementation of Perlin noise is not accurate) 103 | 104 | Sometimes the random is way too `random` and `randomGaussian` is too focused. 105 | We can use the `noise` function to create "organic" chaotic structures. 106 | It implements the Perlin noise. 107 | 108 | The `noise` is a function that maps values to random numbers. We can control the amount 109 | of spread by proximity of values of the argument. If values are close to each other then 110 | amount of noise is also small. It means that `noise` is a continuous function. 111 | 112 | We have 1D, 2D and 3D noise functions: 113 | 114 | ~~~Haskell 115 | noise1 :: Float -> Pio Float 116 | noise2 :: P2 -> Pio Float 117 | noise2 :: P3 -> Pio Float 118 | ~~~ 119 | 120 | Let's divide the screen in two halves with natural looking line: 121 | 122 | ~~~Haskell 123 | import Graphics.Proc 124 | 125 | main = runProc $ def 126 | { procSetup = setup 127 | , procDraw = draw } 128 | 129 | width = 400 130 | height = 400 131 | 132 | setup = do 133 | size (width, height) 134 | forM [0 .. width] $ \x -> do 135 | y <- noise1 (x / 100) 136 | return (x, (30 * y - 15) + 0.5 * height) 137 | 138 | draw ps = do 139 | linePath ps 140 | ~~~ 141 | 142 | Let's create a texture: 143 | 144 | ~~~Haskell 145 | import Graphics.Proc 146 | 147 | main = runProc $ def 148 | { procSetup = setup 149 | , procDraw = draw } 150 | 151 | width = 400 152 | height = 400 153 | 154 | setup = do 155 | size (width, height) 156 | noStroke 157 | forM [(x, y) | x <- [0, 5 .. width], y <- [0, 7 .. height]] $ \(x, y) -> do 158 | z <- noise2 (x / 100, y / 100) 159 | return ((x, y), 255 * z) 160 | 161 | draw ps = do 162 | forM_ ps $ \(p, col) -> do 163 | fill (grey col) 164 | circle 5 p 165 | ~~~ 166 | 167 | Predictable noise 168 | ---------------------------- 169 | 170 | We can set the seed for random generators: 171 | 172 | ~~~Haskell 173 | noiseSeed, randomSeed :: Float -> Pio () 174 | ~~~ 175 | 176 | With fixed seed we can create reproducible noise behaviors. 177 | The `randomSeed` controls the random and gaussian noises at the same time. 178 | -------------------------------------------------------------------------------- /tutorial/Shapes.md: -------------------------------------------------------------------------------- 1 | Drawing shapes and curves 2 | ==================================== 3 | 4 | There are some other forms beside the circle available to us. 5 | Let's draw them on the screen: 6 | 7 | ~~~Haskell 8 | import Graphics.Proc 9 | 10 | main = runProc $ def 11 | { procSetup = setup 12 | , procDraw = draw } 13 | 14 | setup = do 15 | size (400, 400) 16 | 17 | draw () = do 18 | noStroke 19 | fill (rgb 255 145 23) 20 | ellipse (50, 50) (40, 70) 21 | 22 | noStroke 23 | fill (grey 74) 24 | rect (150, 50) (60, 90) 25 | 26 | strokeWeight 6 27 | stroke (rgb 24 146 75) 28 | line (50, 200) (350, 200) 29 | 30 | noStroke 31 | fill (greya 34 140) 32 | rect (100, 300) (75, 75) 33 | 34 | noStroke 35 | fill (rgba 230 53 38 100) 36 | triangle (50, 350) (100, 250) (150, 350) 37 | 38 | strokeWeight 2 39 | stroke purple 40 | bezier (250, 250) (350, 200) (400, 350) (367, 80) 41 | 42 | fill green 43 | stroke navy 44 | quad (220, 300) (270, 350) (320, 300) (260, 260) 45 | 46 | stroke black 47 | point (350, 230) 48 | 49 | linePath [(10, 10), (10, 390), (390, 390)] 50 | ~~~ 51 | 52 | Coordinates of the shapes are given with vectors which contain (x, y)-coordinates. 53 | You can see various shapes and ways to set the colors. 54 | We set the colors with two functions: 55 | 56 | ~~~Haskell 57 | fill, stroke :: Col -> Pio () 58 | ~~~ 59 | 60 | The `fill` sets the color of the body of the shape and `stroke` sets the color of the rim. 61 | We can supress the drawing of the body or the rim with commands: 62 | 63 | ~~~Haskell 64 | noFill, noStroke :: Pio () 65 | ~~~ 66 | 67 | Notice the various ways to specify the colors. Arguments range in the interval `(0, 255)`: 68 | 69 | * `rgb` -- creates colors out of red, green and blue. 70 | 71 | * `grey` -- creates grey colors out of singl component. 72 | 73 | * `rgba` -- creates RGB-color with fourth parameter for transparency or **a**lpha. 74 | 75 | * `greya` -- creates grey colors with transparency as a second argument. 76 | 77 | There are predefined colors: `red`, `green`, `blue`, `orange`, `olive` etc. 78 | 79 | The function: `setAlpha` can change the trasparency of the given color. 80 | -------------------------------------------------------------------------------- /tutorial/Transformations.md: -------------------------------------------------------------------------------- 1 | Transformations 2 | ======================================== 3 | 4 | In computer graphics we often draw not in absolute coordinates of the screen 5 | but in some local coordinates of the object that we want to place on the scene. 6 | This can be very convenient. We can ceate a separate procedure that 7 | draws an object in it's own coordinate system and then we can 8 | place it anywhere on the screen. 9 | 10 | Let's create a hero: 11 | 12 | ~~~Haskell 13 | drawHero = do 14 | drawHead 15 | drawBody 16 | drawLegs 17 | drawArms 18 | 19 | drawHead = do 20 | fill (grey 165) 21 | circle 10 (0, -20) 22 | 23 | drawBody = do 24 | fill (grey 68) 25 | rect (-10, -10) (20, 40) 26 | 27 | drawLegs = do 28 | fill (grey 125) 29 | rect (-7, 30) (3, 27) 30 | rect (4, 30) (3, 27) 31 | 32 | drawArms = do 33 | fill (grey 125) 34 | strokeWeight 2 35 | linePath [(-10, -10), (-20, 7), (-15, 15)] 36 | linePath [(10, -10), (20, -27), (15, -35)] 37 | ~~~ 38 | 39 | ### Translate 40 | 41 | If we draw our hero on the screen he is going to stick to the upper left corner. 42 | But we can place him in the center if we translate the coordinates: 43 | 44 | ~~~Haskell 45 | width = 400 46 | height = 400 47 | 48 | center = (0.5 * width, 0.5 * height) 49 | 50 | draw () = do 51 | background (grey 230) 52 | translate center 53 | drawHero 54 | ~~~ 55 | 56 | So you can see that the command `translate` affects all shapes that are drawn after it. 57 | After it the point `(0, 0)` coressponds to the `center`. 58 | 59 | ### Scaling 60 | 61 | The next thing we can do is to change the size of our hero. We can make him bigger: 62 | 63 | ~~~Haskell 64 | draw () = do 65 | background (grey 230) 66 | translate center 67 | scale (2, 2) 68 | drawHero 69 | ~~~ 70 | 71 | ### Rotation 72 | 73 | We can make him fly: 74 | 75 | ~~~Haskell 76 | draw () = do 77 | background (grey 230) 78 | translate center 79 | scale (2, 2) 80 | rotate 0.2 81 | drawHero 82 | ~~~ 83 | 84 | We apply a rotation now all our coordinates are transformed. 85 | Note that angle of rotation is set with taus. The tau is relative 86 | measure of rotation. 1 means full circle 0.5 is half of the circle and so on. 87 | 88 | 89 | ### Local transformations 90 | 91 | What if we want to draw another hero that watches as the first flies. 92 | Here is the first attempt: 93 | 94 | ~~~Haskell 95 | draw () = do 96 | background (grey 230) 97 | 98 | translate center 99 | scale (2, 2) 100 | rotate 0.2 101 | drawHero 102 | 103 | translate (100, 320) 104 | scale (0.5, 0.5) 105 | drawHero 106 | ~~~ 107 | 108 | But we can not see the second hero. The root of the problem is that transformations 109 | accumulate. We'd like to through away the transformations for the first hero after it's drawn 110 | on the screen. We'd like to start afresh for the second hero. 111 | 112 | To solve this problem there is a function `local`. It introduces the scope of transformation: 113 | 114 | ~~~Haskell 115 | draw () = do 116 | background (grey 230) 117 | local $ do 118 | translate center 119 | scale (2, 2) 120 | rotate 0.2 121 | drawHero 122 | local $ do 123 | translate (100, 320) 124 | scale (0.5, 0.5) 125 | drawHero 126 | ~~~ 127 | 128 | Let's look at it's signature: 129 | 130 | ~~~Haskell 131 | local :: Pio () -> Pio () 132 | ~~~ 133 | 134 | It takes in a procedure and executes it in the local scope of transformations. 135 | Then it falls back to the previous space. 136 | 137 | Exercise: draw a crowd of heroes. 138 | 139 | -------------------------------------------------------------------------------- /tutorial/VectorSpace.md: -------------------------------------------------------------------------------- 1 | Vector space 2 | ================================ 3 | 4 | In processing almost all drawing functions take plain numbers as arguments. 5 | But in Haskell lib they take in vectors or pairs of numbers. Why do we need this? 6 | 7 | The representation of points is much more convenient with vectors. 8 | The vectors come with the library vector-space and it provides many 9 | useful functions. 10 | 11 | We can treat the vectors like numbers. We can add, multiply, negate them, create them 12 | out of numbers. The number `12` can become a vector `(12, 12)` with the help of Haskell overloading. 13 | We can scale vectors with numbers. So instead of writing: 14 | 15 | ~~~haskell 16 | width = 400 17 | height = 400 18 | 19 | center = (0.5 * width, 0.5 * height) 20 | ~~~ 21 | 22 | We can rewrite it: 23 | 24 | ~~~haskell 25 | sizes = (400, 400) 26 | center = 0.5 *^ sizes 27 | ~~~ 28 | 29 | There are another usefull functions: 30 | 31 | * `distance` calculates the distance between two vectors. 32 | 33 | * `magnitude` calculates the size of the vector 34 | 35 | * `lerp` interpolates between two vectors 36 | 37 | * `normalized` calculates a normalized vector for the given one. 38 | 39 | You can read the whole list of functions in the package [`vector-space`](https://hackage.haskell.org/package/vector-space-0.10.2) on Hackage. 40 | -------------------------------------------------------------------------------- /tutorial/code/BrownMotion.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def 4 | { procSetup = setup 5 | , procDraw = draw 6 | , procUpdate = update } 7 | 8 | width = 400 9 | height = 400 10 | center = (0.5 * width, 0.5 * height) 11 | 12 | setup = do 13 | size (width, height) 14 | background (grey 0) 15 | stroke (grey 255) 16 | strokeWeight 2 17 | frameRate 30 18 | return (center, center) 19 | 20 | draw (p1, p2) = do 21 | line p1 p2 22 | 23 | len = 5 24 | 25 | update (_, p) = do 26 | x <- random2 (-len, len) 27 | y <- random2 (-len, len) 28 | return (p, p + (x, y)) 29 | -------------------------------------------------------------------------------- /tutorial/code/Hero.hs: -------------------------------------------------------------------------------- 1 | 2 | import Graphics.Proc 3 | 4 | main = runProc $ def 5 | { procSetup = setup 6 | , procDraw = draw } 7 | 8 | width = 400 9 | height = 400 10 | 11 | center = (0.5 * width, 0.5 * height) 12 | 13 | setup = do 14 | noStroke 15 | size (width, height) 16 | 17 | draw () = do 18 | background (grey 230) 19 | local $ do 20 | translate center 21 | scale (2, 2) 22 | rotate 0.2 23 | drawHero 24 | local $ do 25 | translate (100, 320) 26 | scale (0.5, 0.5) 27 | drawHero 28 | 29 | drawHero = do 30 | drawHead 31 | drawBody 32 | drawLegs 33 | drawArms 34 | 35 | drawHead = do 36 | fill (grey 165) 37 | circle 10 (0, -20) 38 | 39 | drawBody = do 40 | fill (grey 68) 41 | rect (-10, -10) (20, 40) 42 | 43 | drawLegs = do 44 | fill (grey 125) 45 | rect (-7, 30) (3, 27) 46 | rect (4, 30) (3, 27) 47 | 48 | drawArms = do 49 | fill (grey 125) 50 | strokeWeight 2 51 | linePath [(-10, -10), (-20, 7), (-15, 15)] 52 | linePath [(10, -10), (20, -27), (15, -35)] -------------------------------------------------------------------------------- /tutorial/code/KeyFollow.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def 4 | { procSetup = setup 5 | , procDraw = draw 6 | , procKeyPressed = keyPressed } 7 | 8 | width = 400 9 | height = 400 10 | center = (0.5 * width, 0.5 * height) 11 | 12 | setup = do 13 | size (width, height) 14 | return center 15 | 16 | draw p = do 17 | background (grey 12) 18 | fill (grey 255) 19 | circle 15 p 20 | 21 | dt = 5 22 | 23 | keyPressed (x, y) = do 24 | k <- key 25 | return $ case k of 26 | Char 'w' -> (x, y - dt) 27 | Char 'a' -> (x - dt, y) 28 | Char 's' -> (x, y + dt) 29 | Char 'd' -> (x + dt, y) 30 | 31 | SpecialKey KeyUp -> (x, y - dt) 32 | SpecialKey KeyLeft -> (x - dt, y) 33 | SpecialKey KeyDown -> (x, y + dt) 34 | SpecialKey KeyRight -> (x + dt, y) 35 | _ -> (x, y) 36 | -------------------------------------------------------------------------------- /tutorial/code/MouseFollow.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def 4 | { procSetup = setup 5 | , procDraw = draw } 6 | 7 | width = 400 8 | height = 400 9 | 10 | setup = do 11 | size (width, height) 12 | 13 | draw () = do 14 | background (grey 12) 15 | m <- mouse 16 | circle 15 m -------------------------------------------------------------------------------- /tutorial/code/NoiseLine.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def 4 | { procSetup = setup 5 | , procDraw = draw } 6 | 7 | width = 400 8 | height = 400 9 | 10 | setup = do 11 | size (width, height) 12 | forM [0 .. width] $ \x -> do 13 | y <- noise1 (x / 100) 14 | return (x, (30 * y - 15) + 0.5 * height) 15 | 16 | draw ps = do 17 | linePath ps 18 | 19 | -------------------------------------------------------------------------------- /tutorial/code/NoiseTexture.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def 4 | { procSetup = setup 5 | , procDraw = draw } 6 | 7 | width = 400 8 | height = 400 9 | 10 | setup = do 11 | size (width, height) 12 | noStroke 13 | forM [(x, y) | x <- [0, 5 .. width], y <- [0, 7 .. height]] $ \(x, y) -> do 14 | z <- noise2 (x / 100, y / 100) 15 | return ((x, y), 255 * z) 16 | 17 | draw ps = do 18 | forM_ ps $ \(p, col) -> do 19 | fill (grey col) 20 | circle 5 p 21 | -------------------------------------------------------------------------------- /tutorial/code/Painter.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def { procSetup = setup, procDraw = draw, procMousePressed = mousePressed } 4 | 5 | width = 400 6 | height = 400 7 | 8 | setup = do 9 | size (width, height) 10 | strokeWeight 2 11 | stroke (grey 255) 12 | return [] 13 | 14 | draw ps = do 15 | background (grey 0) 16 | case ps of 17 | [] -> return () 18 | _ -> do 19 | m <- mouse 20 | linePath (m : ps) 21 | 22 | mousePressed ps = do 23 | mb <- mouseButton 24 | case mb of 25 | Just LeftButton -> do 26 | m <- mouse 27 | return (m : ps) 28 | Just RightButton -> do 29 | if null ps 30 | then return [] 31 | else return (tail ps) 32 | _ -> return ps 33 | -------------------------------------------------------------------------------- /tutorial/code/Planet.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | width = 400 4 | height = 400 5 | center = (width / 2, height / 2) 6 | 7 | setup = do 8 | size (width, height) 9 | return initPlanets 10 | 11 | draw xs = do 12 | background (grey 0) 13 | drawSun 14 | mapM_ drawPlanet xs 15 | 16 | update xs = return $ fmap updatePlanet xs 17 | 18 | ------------------------------------- 19 | -- sun 20 | 21 | drawSun = do 22 | fill (grey 255) 23 | circle 17 center 24 | 25 | ------------------------------------- 26 | -- planets 27 | 28 | data Planet = Planet 29 | { planetColor :: Col 30 | , planetRadius :: Float 31 | , planetAngle :: Float 32 | , planetSpeed :: Float 33 | , planetDistanceToSun :: Float } 34 | 35 | drawPlanet p = local $ do 36 | translate center 37 | rotate (planetAngle p) 38 | noStroke 39 | fill (planetColor p) 40 | circle (planetRadius p) (0, planetDistanceToSun p) 41 | 42 | updatePlanet p = p { planetAngle = angle + speed } 43 | where 44 | angle = planetAngle p 45 | speed = planetSpeed p 46 | 47 | initPlanets = [Planet green 10 0 0.0013 85, Planet red 8 0 0.001 155] 48 | 49 | ------------------------------------- 50 | 51 | main = runProc $ def 52 | { procSetup = setup 53 | , procDraw = draw 54 | , procUpdate = update } -------------------------------------------------------------------------------- /tutorial/code/PlanetClick.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | width = 400 4 | height = 400 5 | center = (width / 2, height / 2) 6 | 7 | setup = do 8 | size (width, height) 9 | return (1, initPlanets) 10 | 11 | draw (_, xs) = do 12 | background (grey 0) 13 | drawSun 14 | mapM_ drawPlanet xs 15 | 16 | update (orient, xs) = return $ (orient, fmap (updatePlanet orient) xs) 17 | 18 | ------------------------------------- 19 | -- sun 20 | 21 | drawSun = do 22 | fill (grey 255) 23 | circle 17 center 24 | 25 | ------------------------------------- 26 | -- planets 27 | 28 | data Planet = Planet 29 | { planetColor :: Col 30 | , planetRadius :: Float 31 | , planetAngle :: Float 32 | , planetSpeed :: Float 33 | , planetDistanceToSun :: Float } 34 | 35 | drawPlanet p = local $ do 36 | translate center 37 | rotate (planetAngle p) 38 | noStroke 39 | fill (planetColor p) 40 | circle (planetRadius p) (0, planetDistanceToSun p) 41 | 42 | updatePlanet orient p = p { planetAngle = angle + orient * speed } 43 | where 44 | angle = planetAngle p 45 | speed = planetSpeed p 46 | 47 | initPlanets = [Planet green 10 0 0.0013 85, Planet red 8 0 0.001 155] 48 | 49 | ------------------------------------- 50 | 51 | mousePressed (orient, ps) = return (negate orient, ps) 52 | 53 | ------------------------------------- 54 | 55 | main = runProc $ def 56 | { procSetup = setup 57 | , procDraw = draw 58 | , procUpdate = update 59 | , procMousePressed = mousePressed } -------------------------------------------------------------------------------- /tutorial/code/RandomCircles.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def 4 | { procSetup = setup 5 | , procDraw = draw } 6 | 7 | width = 400 8 | height = 400 9 | center = (0.5 * width, 0.5 * height) 10 | 11 | setup = do 12 | size (width, height) 13 | background (grey 255) 14 | frameRate 7 15 | 16 | draw () = do 17 | drawRandomGaussCircle 18 | 19 | drawRandomCircle :: Pio () 20 | drawRandomCircle = do 21 | noStroke 22 | fill =<< randomCola 23 | rad <- random2 (10, 40) 24 | circle rad =<< randomP2 25 | 26 | drawRandomGaussCircle = do 27 | noStroke 28 | fill =<< randomCola 29 | rad <- random2 (10, 20) 30 | x <- randomGaussian 31 | y <- randomGaussian 32 | circle rad (50 * (x, y) + center) 33 | 34 | -------------------------------------------------------------------------------- /tutorial/code/Shapes.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | main = runProc $ def 4 | { procSetup = setup 5 | , procDraw = draw } 6 | 7 | setup = do 8 | size (400, 400) 9 | 10 | draw () = do 11 | background white 12 | noStroke 13 | fill (rgb 255 145 23) 14 | ellipse (50, 50) (40, 70) 15 | 16 | noStroke 17 | fill (grey 74) 18 | rect (150, 50) (60, 90) 19 | 20 | strokeWeight 6 21 | stroke (rgb 24 146 75) 22 | line (50, 200) (350, 200) 23 | 24 | noStroke 25 | fill (greya 34 140) 26 | rect (100, 300) (75, 75) 27 | 28 | noStroke 29 | fill (rgba 230 53 38 100) 30 | triangle (50, 350) (100, 250) (150, 350) 31 | 32 | strokeWeight 2 33 | stroke purple 34 | bezier (250, 250) (350, 200) (400, 350) (367, 80) 35 | 36 | fill green 37 | stroke navy 38 | quad (220, 300) (270, 350) (320, 300) (260, 260) 39 | 40 | stroke black 41 | point (350, 230) 42 | 43 | linePath [(10, 10), (10, 390), (390, 390)] 44 | camera2 (40, 40) 1000 1.2 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /tutorial/code/Static.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Proc 2 | 3 | width = 400 4 | height = 400 5 | center = (width / 2, height / 2) 6 | 7 | setup = do 8 | size (width, height) 9 | return () 10 | 11 | draw () = do 12 | background (grey 0) 13 | fill (grey 255) 14 | circle 17 center 15 | 16 | update x = return x 17 | 18 | main = runProc $ def 19 | { procSetup = setup 20 | , procDraw = draw 21 | , procUpdate = update } --------------------------------------------------------------------------------