-- This file is part of Goatee. -- -- Copyright 2014 Bryan Gardiner -- -- Goatee is free software: you can redistribute it and/or modify -- it under the terms of the GNU Affero General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- Goatee is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU Affero General Public License for more details. -- -- You should have received a copy of the GNU Affero General Public License -- along with Goatee. If not, see . -- | A widget that renders an interactive Go board. module Game.Goatee.Ui.Gtk.Goban ( Goban, create, destroy, myWidget, ) where import Control.Applicative ((<$>)) import Control.Monad (liftM, unless, when) import qualified Data.Foldable as F import Data.IORef (IORef, newIORef, readIORef, writeIORef) import qualified Data.Map as Map import Data.Map (Map) import Data.Maybe (fromJust, isJust) import Data.Tree (drawTree, unfoldTree) import Game.Goatee.Common import Game.Goatee.Sgf.Board hiding (isValidMove) import Game.Goatee.Sgf.Monad ( childAddedEvent, modifyMark, navigationEvent, propertiesModifiedEvent, ) import Game.Goatee.Sgf.Property import Game.Goatee.Sgf.Tree import Game.Goatee.Sgf.Types import Game.Goatee.Ui.Gtk.Common import Graphics.Rendering.Cairo ( Antialias (AntialiasDefault, AntialiasNone), Render, arc, closePath, deviceToUser, deviceToUserDistance, fillPreserve, liftIO, lineTo, moveTo, paint, paintWithAlpha, popGroupToSource, pushGroup, rotate, scale, setAntialias, setLineWidth, setSourceRGB, stroke, translate, ) import Graphics.UI.Gtk ( DrawingArea, EventMask (ButtonPressMask, LeaveNotifyMask, PointerMotionMask), Modifier (Shift), Widget, buttonPressEvent, drawingAreaNew, eventCoordinates, eventKeyName, eventModifier, exposeEvent, keyPressEvent, leaveNotifyEvent, motionNotifyEvent, on, renderWithDrawable, toWidget, widgetAddEvents, widgetGetDrawWindow, widgetGetSize, widgetGrabFocus, widgetQueueDraw, widgetSetCanFocus, ) {-# ANN module "HLint: ignore Use camelCase" #-} -- | If false, then the up and down keys will move toward and away -- from the game tree root, and left and right will move between -- siblings. If true, these are reversed. useHorizontalKeyNavigation :: Bool useHorizontalKeyNavigation = True -- Key handler code below requires that these keys don't use modifiers. keyNavActions :: UiCtrl a => Map String (a -> IO Bool) keyNavActions = Map.fromList $ if useHorizontalKeyNavigation then [("Up", goLeft), ("Down", goRight), ("Left", goUp), ("Right", flip goDown 0)] else [("Up", goUp), ("Down", flip goDown 0), ("Left", goLeft), ("Right", goRight)] boardBgColor :: Rgb boardBgColor = rgb255 229 178 58 blackStoneColor :: Rgb blackStoneColor = rgb 0 0 0 blackStoneBorderColor :: Rgb blackStoneBorderColor = rgb 1 1 1 whiteStoneColor :: Rgb whiteStoneColor = rgb 1 1 1 whiteStoneBorderColor :: Rgb whiteStoneBorderColor = rgb 0 0 0 stoneColor :: Color -> Rgb stoneColor color = case color of Black -> blackStoneColor White -> whiteStoneColor stoneBorderColor :: Color -> Rgb stoneBorderColor color = case color of Black -> blackStoneBorderColor White -> whiteStoneBorderColor -- | Percentage of coordinate size, in @[0, 1]@. stoneBorderThickness :: Double stoneBorderThickness = 0.03 -- | The radius of small circles that are overlaid on points to indicate that -- move variations exist. Percentage of coordinate size, in @[0, 1]@. stoneVariationRadius :: Double stoneVariationRadius = 0.15 -- | The width of the border of a variation circle. Percentage of coordinate -- size, in @[0, 1]@. stoneVariationBorderThickness :: Double stoneVariationBorderThickness = 0.02 -- | The opacity, in @[0, 1]@, of a stone that should be drawn dimmed because of -- 'DD'. dimmedPointOpacity :: Double dimmedPointOpacity = 0.3 -- | Returns the color that should be used to draw a 'Mark' on either an empty -- point, or one with a stone of the given color. coordAnnotationStrokeColor :: Maybe Color -> Rgb coordAnnotationStrokeColor = maybe blackStoneColor stoneBorderColor -- | For line and arrow annotations, the width of the line. 1 is the width of a -- stone. boardAnnotationLineWidth :: Double boardAnnotationLineWidth = 0.08 -- | For arrow annotations, the distance to pull back along the length of a line -- before extending at right angles to form the arrowhead. boardAnnotationArrowPullback :: Double boardAnnotationArrowPullback = 0.2 -- | For arrow annotations, the distance to extend away from the baseline in -- either direction to form the arrowhead. boardAnnotationArrowWidth :: Double boardAnnotationArrowWidth = 0.1 -- | A GTK widget that renders a Go board. -- -- @ui@ should be an instance of 'UiCtrl'. data Goban ui = Goban { myUi :: ui , myRegistrations :: ViewRegistrations , myWidget :: Widget , myDrawingArea :: DrawingArea , myModesChangedHandler :: IORef (Maybe Registration) } instance UiCtrl ui => UiView (Goban ui) ui where viewName = const "Goban" viewCtrl = myUi viewRegistrations = myRegistrations -- | Holds data relating to the state of the mouse hovering over the board. data HoverState = HoverState { hoverCoord :: Maybe Coord -- ^ The board coordinate corresponding to the -- current mouse position. Nothing if the mouse -- is not over the board. , hoverIsValidMove :: Bool -- ^ True iff the hovered point is legal to play -- on for the current player. } deriving (Show) -- | Augments a 'CoordState' with data that is only used for rendering purposes. data RenderedCoord = RenderedCoord { renderedCoordState :: CoordState , renderedCoordCurrent :: Bool , renderedCoordVariation :: Maybe Color -- ^ If a variation move exists at this point, then this will be the color -- of the move. } deriving (Show) -- | Creates a 'Goban' for rendering Go boards of the given size. create :: UiCtrl ui => ui -> IO (Goban ui) create ui = do hoverStateRef <- newIORef HoverState { hoverCoord = Nothing , hoverIsValidMove = False } drawingArea <- drawingAreaNew widgetSetCanFocus drawingArea True widgetAddEvents drawingArea [LeaveNotifyMask, ButtonPressMask, PointerMotionMask] on drawingArea exposeEvent $ liftIO $ do drawBoard ui hoverStateRef drawingArea return True on drawingArea motionNotifyEvent $ do mouseCoord <- fmap Just eventCoordinates liftIO $ handleMouseMove ui hoverStateRef drawingArea mouseCoord return True on drawingArea leaveNotifyEvent $ do liftIO $ handleMouseMove ui hoverStateRef drawingArea Nothing return True on drawingArea buttonPressEvent $ do liftIO $ widgetGrabFocus drawingArea mouseXy <- eventCoordinates liftIO $ doToolAtPoint ui drawingArea mouseXy return True on drawingArea keyPressEvent $ do key <- eventKeyName mods <- eventModifier let km = (key, mods) let maybeAction = Map.lookup key keyNavActions cond (return False) [(null mods && isJust maybeAction, liftIO $ fromJust maybeAction ui >> return True), -- Write a list of the current node's properties to the console. (km == ("t", []), liftIO $ do cursor <- readCursor ui print $ nodeProperties $ cursorNode cursor return True), -- Draw a tree rooted at the current node to the console. (km == ("T", [Shift]), liftIO $ do cursor <- readCursor ui putStrLn $ drawTree $ flip unfoldTree (cursorNode cursor) $ \node -> (show $ nodeProperties node, nodeChildren node) return True)] registrations <- viewNewRegistrations modesChangedHandler <- newIORef Nothing let me = Goban { myUi = ui , myRegistrations = registrations , myWidget = toWidget drawingArea , myDrawingArea = drawingArea , myModesChangedHandler = modesChangedHandler } initialize me return me initialize :: UiCtrl ui => Goban ui -> IO () initialize me = do let ui = myUi me onChange = afterGo $ update me viewRegister me childAddedEvent $ const $ const onChange viewRegister me navigationEvent $ const onChange viewRegister me propertiesModifiedEvent $ const $ const onChange writeIORef (myModesChangedHandler me) =<< liftM Just (registerModesChangedHandler ui "Goban" $ \_ _ -> update me) -- TODO Need to update the hover state's validity on cursor and tool (mode?) -- changes. update me destroy :: UiCtrl ui => Goban ui -> IO () destroy me = do let ui = myUi me viewUnregisterAll me F.mapM_ (unregisterModesChangedHandler ui) =<< readIORef (myModesChangedHandler me) update :: UiCtrl ui => Goban ui -> IO () update = widgetQueueDraw . myDrawingArea -- | Called when the mouse is moved. Updates the 'HoverState' according to the -- new mouse location, and redraws the board if necessary. handleMouseMove :: UiCtrl a => a -> IORef HoverState -> DrawingArea -> Maybe (Double, Double) -> IO () handleMouseMove ui hoverStateRef drawingArea maybeClickCoord = do maybeXy <- case maybeClickCoord of Nothing -> return Nothing Just (mouseX, mouseY) -> do board <- fmap cursorBoard (readCursor ui) gtkToBoardCoordinates board drawingArea mouseX mouseY updateHoverPosition ui hoverStateRef maybeXy >>= flip when (widgetQueueDraw drawingArea) -- | Applies the current tool at the given GTK coordinate, if such an action is -- valid. doToolAtPoint :: UiCtrl ui => ui -> DrawingArea -> (Double, Double) -> IO () doToolAtPoint ui drawingArea (mouseX, mouseY) = do cursor <- readCursor ui let board = cursorBoard cursor maybeXy <- gtkToBoardCoordinates board drawingArea mouseX mouseY whenMaybe maybeXy $ \xy -> do tool <- fmap uiTool (readModes ui) case tool of ToolMarkCircle -> toggleMark ui xy MarkCircle ToolMarkSelected -> toggleMark ui xy MarkSelected ToolMarkSquare -> toggleMark ui xy MarkSquare ToolMarkTriangle -> toggleMark ui xy MarkTriangle ToolMarkX -> toggleMark ui xy MarkX ToolPlay -> do valid <- isValidMove ui xy when valid $ playAt ui xy _ -> return () -- TODO Support other tools. where toggleMark ui xy mark = runUiGo ui $ modifyMark (toggleMark' mark) xy toggleMark' mark maybeExistingMark = case maybeExistingMark of Just existingMark | existingMark == mark -> Nothing _ -> Just mark -- | Updates the hover state for the mouse having moved to the given board -- coordinate. Returns true if the board coordinate has changed. updateHoverPosition :: UiCtrl ui => ui -> IORef HoverState -> Maybe Coord -> IO Bool updateHoverPosition ui hoverStateRef maybeXy = do hoverState <- readIORef hoverStateRef if maybeXy == hoverCoord hoverState then return False else do valid <- case maybeXy of Nothing -> return False Just xy -> isValidMove ui xy writeIORef hoverStateRef HoverState { hoverCoord = maybeXy , hoverIsValidMove = valid } return True applyBoardCoordinates :: BoardState -> DrawingArea -> IO (Render ()) applyBoardCoordinates board drawingArea = do (canvasWidth, canvasHeight) <- return . mapTuple fromIntegral =<< widgetGetSize drawingArea let maxStoneWidth = canvasWidth / fromIntegral (boardWidth board) maxStoneHeight = canvasHeight / fromIntegral (boardHeight board) maxStoneLength = min maxStoneWidth maxStoneHeight return $ do -- Set user coordinates so that the top-left stone occupies the rectangle -- from (0,0) to (1,1). when (canvasWidth > canvasHeight) $ translate ((canvasWidth - canvasHeight) / 2) 0 when (canvasHeight > canvasWidth) $ translate 0 ((canvasHeight - canvasWidth) / 2) scale maxStoneLength maxStoneLength -- | Takes a GTK coordinate and, using a Cairo rendering context, returns the -- corresponding board coordinate, or @Nothing@ if the GTK coordinate is not -- over the board. gtkToBoardCoordinates :: BoardState -> DrawingArea -> Double -> Double -> IO (Maybe (Int, Int)) gtkToBoardCoordinates board drawingArea x y = do drawWindow <- widgetGetDrawWindow drawingArea changeCoords <- applyBoardCoordinates board drawingArea result@(bx, by) <- fmap (mapTuple floor) $ renderWithDrawable drawWindow $ changeCoords >> deviceToUser x y return $ if bx < 0 || bx >= boardWidth board || by < 0 || by >= boardHeight board then Nothing else Just result -- | Fully redraws the board based on the current controller and UI state. drawBoard :: UiCtrl ui => ui -> IORef HoverState -> DrawingArea -> IO () drawBoard ui hoverStateRef drawingArea = do cursor <- readCursor ui modes <- readModes ui hoverState <- readIORef hoverStateRef let board = cursorBoard cursor tool = uiTool modes variationMode = rootInfoVariationMode $ gameInfoRootInfo $ boardGameInfo $ cursorBoard cursor variations :: [(Coord, Color)] variations = if variationModeBoardMarkup variationMode then cursorVariations (variationModeSource variationMode) cursor else [] -- Positions of stones that have been played at the current node. current :: [Coord] current = if uiHighlightCurrentMovesMode modes then concatMap (\prop -> case prop of B (Just xy) -> [xy] W (Just xy) -> [xy] _ -> []) $ cursorProperties cursor else [] -- The state of the board's points, with all data for rendering. renderedCoords :: [[RenderedCoord]] renderedCoords = -- Add current moves. (flip .) foldr (\(x, y) grid -> listUpdate (flip listUpdate x $ \renderedCoord -> renderedCoord { renderedCoordCurrent = True }) y grid) current $ -- Add variations. foldr (\((x, y), color) grid -> listUpdate (flip listUpdate x $ \renderedCoord -> renderedCoord { renderedCoordVariation = Just color }) y grid) (map (map $ \state -> RenderedCoord state False Nothing) $ mapBoardCoords maybeAddHover board) variations maybeAddHover :: Int -> Int -> CoordState -> CoordState maybeAddHover y x state = case hoverCoord hoverState of Just (hx, hy) | x == hx && y == hy -> modifyCoordForHover tool board hoverState state _ -> state drawWindow <- widgetGetDrawWindow drawingArea changeCoords <- applyBoardCoordinates board drawingArea renderWithDrawable drawWindow $ do changeCoords -- Fill the background a nice woody shade. setRgb boardBgColor paint -- Draw the grid and all points. gridLineWidth <- fst <$> deviceToUserDistance 1 0 let drawCoord' = drawCoord board gridLineWidth (gridLineWidth * 2) -- First draw points that are visible and not dimmed. forIndexM_ renderedCoords $ \y row -> forIndexM_ row $ \x renderedCoord -> do let coord = renderedCoordState renderedCoord when (coordVisible coord && not (coordDimmed coord)) $ drawCoord' x y renderedCoord -- Then draw visible but dimmed points. This is performed under a single -- Cairo group for performance reasons. (Having a group for each dimmed -- point is *really* slow with a board full of dimmed points.) pushGroup forIndexM_ renderedCoords $ \y row -> forIndexM_ row $ \x renderedCoord -> do let coord = renderedCoordState renderedCoord when (coordVisible coord && coordDimmed coord) $ drawCoord' x y renderedCoord popGroupToSource paintWithAlpha dimmedPointOpacity -- Draw non-CoordState-based annotations. unless (null (boardLines board) && null (boardArrows board)) $ do setSourceRGB 0 0 0 setLineWidth boardAnnotationLineWidth mapM_ (uncurry drawLine) $ boardLines board mapM_ (uncurry drawArrow) $ boardArrows board return () -- | Draws a single point on the board. drawCoord :: BoardState -- ^ The board being drawn. -> Double -- ^ The pixel width of the grid in the board's interior. -> Double -- ^ The pixel width of the grid on the board's border. -> Int -- ^ The x-index of the point to be drawn. -> Int -- ^ The y-index of the point to be drawn. -> RenderedCoord -- ^ The point to be drawn. -> Render () drawCoord board gridWidth gridBorderWidth x y renderedCoord = do let x' = fromIntegral x y' = fromIntegral y coord = renderedCoordState renderedCoord current = renderedCoordCurrent renderedCoord variation = renderedCoordVariation renderedCoord -- Translate the grid so that we can draw the stone from (0,0) to (1,1). translate x' y' -- Draw the grid, stone (if present), and mark (if present). drawGrid board gridWidth gridBorderWidth x y F.mapM_ drawStone $ coordStone coord maybe (return ()) (drawMark $ coordStone coord) $ coordMark coord case (current, variation) of -- With @VariationMode ShowChildVariations True@, this is the case of an -- immediately recaptured ko. With @ShowCurrentVariations@ and a valid SGF -- this case shouldn't happen. (True, Just variation') -> do drawCurrent True drawVariation variation' True (True, _) -> drawCurrent False (_, Just variation') -> drawVariation variation' False _ -> return () -- Restore the coordinate system for the next stone. translate (-x') (-y') -- | Given a current tool, board, and hover, modifies a 'CoordState' to reflect -- that the user is hovering over the point. The effect depends on the tool. -- The effect is to suggest what would happen if the point were clicked. modifyCoordForHover :: Tool -> BoardState -> HoverState -> CoordState -> CoordState modifyCoordForHover tool board hover coord = case tool of ToolPlay -> if hoverIsValidMove hover then coord { coordStone = Just (boardPlayerTurn board) } else coord ToolJump -> coord -- TODO Hover for ToolJump. ToolScore -> coord -- TODO Hover for ToolScore. ToolBlack -> coord { coordStone = Just (toolToColor tool) } ToolWhite -> coord { coordStone = Just (toolToColor tool) } ToolErase -> coord { coordStone = Nothing } ToolArrow -> coord -- TODO Hover for ToolArrow. ToolMarkCircle -> toggleMark MarkCircle coord ToolLabel -> coord -- TODO Hover for ToolLabel. ToolLine -> coord -- TODO Hover for ToolLine. ToolMarkX -> toggleMark MarkX coord ToolMarkSelected -> toggleMark MarkSelected coord ToolMarkSquare -> toggleMark MarkSquare coord ToolMarkTriangle -> toggleMark MarkTriangle coord ToolVisible -> coord { coordVisible = not $ coordVisible coord } ToolDim -> coord { coordDimmed = not $ coordDimmed coord } -- | Toggles a specific mark on a 'CoordState'. If the @CoordState@ already has -- that mark, then it is removed. If the @CoordState@ has no mark or has -- another mark, then the given mark is added to the @CoordState@, overwriting -- an existing mark if there is one. toggleMark :: Mark -> CoordState -> CoordState toggleMark mark coord = let justMark = Just mark in if coordMark coord == justMark then coord { coordMark = Nothing } else coord { coordMark = justMark } -- | Draws the gridlines for a single point on the board. drawGrid :: BoardState -> Double -> Double -> Int -> Int -> Render () drawGrid board gridWidth gridBorderWidth x y = do -- Draw the grid. let atLeft = x == 0 atTop = y == 0 atRight = x == boardWidth board - 1 atBottom = y == boardHeight board - 1 gridX0 = if atLeft then 0.5 else 0 gridY0 = if atTop then 0.5 else 0 gridX1 = if atRight then 0.5 else 1 gridY1 = if atBottom then 0.5 else 1 -- Temporarily disable antialiasing. We want grid lines to be sharp. setAntialias AntialiasNone setSourceRGB 0 0 0 setLineWidth $ if atTop || atBottom then gridBorderWidth else gridWidth moveTo gridX0 0.5 lineTo gridX1 0.5 stroke setLineWidth $ if atLeft || atRight then gridBorderWidth else gridWidth moveTo 0.5 gridY0 lineTo 0.5 gridY1 stroke setAntialias AntialiasDefault -- | Draws a stone from @(0, 0)@ to @(1, 1)@ in user coordinates. drawStone :: Color -> Render () drawStone color = do arc 0.5 0.5 (0.5 - stoneBorderThickness / 2) 0 pi_2 setRgb $ stoneColor color fillPreserve setLineWidth stoneBorderThickness setRgb $ stoneBorderColor color stroke -- | Draws the given mark on the current point. The color should be that of the -- stone on the point, if there is one; it determines the color of the mark. drawMark :: Maybe Color -> Mark -> Render () drawMark stone mark = do case mark of MarkCircle -> arc 0.5 0.5 0.25 0 pi_2 MarkTriangle -> do moveTo trianglePoint1X trianglePoint1Y lineTo trianglePoint2X trianglePoint2Y lineTo trianglePoint3X trianglePoint3Y closePath MarkSquare -> do moveTo 0.25 0.25 lineTo 0.25 0.75 lineTo 0.75 0.75 lineTo 0.75 0.25 closePath MarkX -> do moveTo 0.25 0.25 lineTo 0.75 0.75 moveTo 0.25 0.75 lineTo 0.75 0.25 MarkSelected -> do moveTo 0.2 0.5 lineTo 0.5 0.8 lineTo 0.8 0.5 lineTo 0.5 0.2 closePath setRgb $ coordAnnotationStrokeColor stone setLineWidth 0.1 stroke -- The coordinates for inscribing a triangle within a unit circle centered about -- @(0.5, 0.5)@, with radius @triangleRadius@. triangleRadius, trianglePoint1X, trianglePoint1Y, trianglePoint2X, trianglePoint2Y :: Double trianglePoint3X, trianglePoint3Y :: Double triangleRadius = 0.3 trianglePoint1X = 0.5 trianglePoint1Y = 0.5 - triangleRadius trianglePoint2X = 0.5 - triangleRadius * cos (pi / 6) trianglePoint2Y = 0.5 + triangleRadius * 0.5 {-sin (pi / 6)-} trianglePoint3X = 0.5 + triangleRadius * cos (pi / 6) trianglePoint3Y = 0.5 + triangleRadius * 0.5 {-sin (pi / 6)-} -- | Draws a line between the given board points. Expects the context to be -- already set up to draw. drawLine :: Coord -> Coord -> Render () drawLine (fromIntegral -> x0, fromIntegral -> y0) (fromIntegral -> x1, fromIntegral -> y1) = do moveTo (x0 + 0.5) (y0 + 0.5) lineTo (x1 + 0.5) (y1 + 0.5) stroke -- | Draws an arrow from the first point to the second point. Expects the -- context to be already set up to draw. drawArrow :: Coord -> Coord -> Render () drawArrow (fromIntegral -> x0, fromIntegral -> y0) (fromIntegral -> x1, fromIntegral -> y1) = do let angle = atan ((y1 - y0) / (x1 - x0)) + if x0 <= x1 then 0 else pi len = sqrt ((y1 - y0)**2 + (x1 - x0)**2) - boardAnnotationLineWidth tx = x0 + 0.5 ty = y0 + 0.5 -- Set up user space so that we can draw the line from (0,0) to -- (0,lineLength). translate tx ty rotate angle moveTo 0 0 lineTo len 0 stroke moveTo len 0 lineTo (len - boardAnnotationArrowPullback) boardAnnotationArrowWidth lineTo (len - boardAnnotationArrowPullback) (-boardAnnotationArrowWidth) closePath stroke rotate (-angle) translate (-tx) (-ty) -- | Draws a dot via 'drawSmallDot' to indicate that a variation is available -- where the given player plays a stone here. The dot is of the given color. -- If the boolean is true, then a semicircle is drawn that will not overlap with -- a similar semicircle drawn by 'drawCurrent'. drawVariation :: Color -> Bool -> Render () drawVariation stone half = let angle0 = if half then pi_1_75 else 0 angle1 = if half then pi_0_75 else pi_2 in drawSmallDot (stoneColor stone) (stoneBorderColor stone) angle0 angle1 -- | Draws a dot via 'drawSmallDot' to indicate that the current coordinate was -- played on in the current node. If the boolean is true, then a semicircle is -- drawn that will not overlap with a similar semicircle drawn by -- 'drawVariation'. drawCurrent :: Bool -> Render () drawCurrent half = let angle0 = if half then pi_0_75 else 0 angle1 = if half then pi_1_75 else pi_2 in drawSmallDot (0,0,1) (0,0,0) angle0 angle1 -- | Draws a small filled arc centered on the current coordinate being drawn. drawSmallDot :: Rgb -> Rgb -> Double -> Double -> Render () drawSmallDot fill border angle0 angle1 = do arc 0.5 0.5 stoneVariationRadius angle0 angle1 setRgb fill fillPreserve setLineWidth stoneVariationBorderThickness setRgb border stroke type Rgb = (Double, Double, Double) rgb :: Double -> Double -> Double -> Rgb rgb = (,,) rgb255 :: Double -> Double -> Double -> Rgb rgb255 r g b = (r / 255, g / 255, b / 255) setRgb :: Rgb -> Render () setRgb (r, g, b) = setSourceRGB r g b pi_0_75, pi_1_75, pi_2 :: Floating a => a pi_0_75 = pi * 0.75 pi_1_75 = pi * 1.75 pi_2 = pi * 2