diff --git a/demo/ColourCharts.hs b/demo/ColourCharts.hs new file mode 100644 --- /dev/null +++ b/demo/ColourCharts.hs @@ -0,0 +1,86 @@ +{-# OPTIONS -Wall #-} + +module ColourCharts where + +import ColourDefns + +import Wumpus.Core +import Wumpus.Basic.Graphic +import Wumpus.Basic.SafeFonts +import Wumpus.Basic.Utils.HList + +import Data.AffineSpace + +import Data.List +import Data.Maybe + +import System.Directory + +main :: IO () +main = do + createDirectoryIfMissing True "./out/" + test01 + +test01 :: IO () +test01 = do + writeEPS_latin1 "./out/SVGcolours.eps" svg + writeSVG_latin1 "./out/SVGcolours.svg" svg + writeEPS_latin1 "./out/X11colours.eps" $ uniformScale 0.75 x11_portrait + writeSVG_latin1 "./out/X11colours.svg" x11_landscape + +svg :: Picture Double +svg = mkPic all_svg_colours (ixDownLeftRight 4 60 (scalePt 160)) + +x11_landscape :: Picture Double +x11_landscape = mkPic all_x11_colours (ixDownLeftRight 6 60 (scalePt 140)) + +x11_portrait :: Picture Double +x11_portrait = mkPic all_x11_colours (ixDownLeftRight 5 72 (scalePt 140)) + + +-- Note - this is code from an old project that needs tidying up... + +mkPic :: [(String,DRGB)] -> [DPoint2] -> DPicture +mkPic cs pts = fromMaybe errK $ + drawGraphic $ concatH $ zipWith colourSample cs pts + where + errK = error "Empty Picture" + +scalePt :: Num u => u -> Point2 u -> Point2 u +scalePt w (P2 x y) = P2 (x*w) (y*12) + +colourSample :: (Fractional u, Floating u, Ord u) + => (String,DRGB) -> GraphicF u +colourSample (name,rgb) = block `cc` lbl + where + block = filledRectangle rgb 15 10 + lbl = text (courier 10) name . (.+^ hvec 18) + + + +--------------------------- + +-- | Generate points in a grid - move down a whole column, move +-- right one, move down the next column. +-- +-- Points are generated from count-1 to 0, but can be scaled +-- or have the offest shifted with the point transformer function. +-- +ixDownLeftRight :: (Num u) + => Int -> Int -> (Point2 u -> Point2 u) -> [Point2 u] +ixDownLeftRight row_count col_count fn = + [fn $ P2 x y | x <- countup (row_count - 1) + , y <- countdown (col_count - 1) ] + + +-- | Countdown from n to 0. +countdown :: Num u => Int -> [u] +countdown = unfoldr phi where + phi i | i < 0 = Nothing + phi i = Just (fromIntegral i,i-1) + +-- | Count up to n from 0. +countup :: Num u => Int -> [u] +countup n = unfoldr phi 0 where + phi i | i > n = Nothing + phi i = Just (fromIntegral i,i+1) diff --git a/demo/ColourDefns.hs b/demo/ColourDefns.hs new file mode 100644 --- /dev/null +++ b/demo/ColourDefns.hs @@ -0,0 +1,507 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : ColourDefns +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC with TypeFamilies and more +-- +-- All the SVG / X11 \"named colours\" listed in tables. +-- +-------------------------------------------------------------------------------- + +module ColourDefns + ( + -- * Tables of all colours + all_x11_colours + , all_svg_colours + + ) where + +import qualified Wumpus.Basic.SVGColours as SVG +import qualified Wumpus.Basic.X11Colours as X11 + +import Wumpus.Core.Colour ( DRGB ) + + +all_svg_colours :: [(String,DRGB)] +all_svg_colours = + [ ("aliceBlue", SVG.aliceBlue) + , ("antiqueWhite", SVG.antiqueWhite) + , ("aqua", SVG.aqua) + , ("aquamarine", SVG.aquamarine) + , ("azure", SVG.azure) + , ("beige", SVG.beige) + , ("bisque", SVG.bisque) + , ("black", SVG.black) + , ("blanchedAlmond", SVG.blanchedAlmond) + , ("blue", SVG.blue) + , ("blueViolet", SVG.blueViolet) + , ("brown", SVG.brown) + , ("burlywood", SVG.burlywood) + , ("cadetBlue", SVG.cadetBlue) + , ("chartreuse", SVG.chartreuse) + , ("chocolate", SVG.chocolate) + , ("coral", SVG.coral) + , ("cornflowerBlue", SVG.cornflowerBlue) + , ("cornsilk", SVG.cornsilk) + , ("crimson", SVG.crimson) + , ("cyan", SVG.cyan) + , ("darkBlue", SVG.darkBlue) + , ("darkCyan", SVG.darkCyan) + , ("darkGoldenrod", SVG.darkGoldenrod) + , ("darkGray", SVG.darkGray) + , ("darkGreen", SVG.darkGreen) + , ("darkGrey", SVG.darkGrey) + , ("darkKhaki", SVG.darkKhaki) + , ("darkMagenta", SVG.darkMagenta) + , ("darkOliveGreen", SVG.darkOliveGreen) + , ("darkOrange", SVG.darkOrange) + , ("darkOrchid", SVG.darkOrchid) + , ("darkRed", SVG.darkRed) + , ("darkSalmon", SVG.darkSalmon) + , ("darkSeaGreen", SVG.darkSeaGreen) + , ("darkSlateBlue", SVG.darkSlateBlue) + , ("darkSlateGray", SVG.darkSlateGray) + , ("darkSlateGrey", SVG.darkSlateGrey) + , ("darkTurquoise", SVG.darkTurquoise) + , ("darkViolet", SVG.darkViolet) + , ("deepPink", SVG.deepPink) + , ("deepSkyBlue", SVG.deepSkyBlue) + , ("dimGray", SVG.dimGray) + , ("dimGrey", SVG.dimGrey) + , ("dodgerBlue", SVG.dodgerBlue) + , ("firebrick", SVG.firebrick) + , ("floralWhite", SVG.floralWhite) + , ("forestGreen", SVG.forestGreen) + , ("fuchsia", SVG.fuchsia) + , ("gainsboro", SVG.gainsboro) + , ("ghostWhite", SVG.ghostWhite) + , ("gold", SVG.gold) + , ("goldenrod", SVG.goldenrod) + , ("gray", SVG.gray) + , ("grey", SVG.grey) + , ("green", SVG.green) + , ("greenYellow", SVG.greenYellow) + , ("honeydew", SVG.honeydew) + , ("hotPink", SVG.hotPink) + , ("indianRed", SVG.indianRed) + , ("indigo", SVG.indigo) + , ("ivory", SVG.ivory) + , ("khaki", SVG.khaki) + , ("lavender", SVG.lavender) + , ("lavenderBlush", SVG.lavenderBlush) + , ("lawnGreen", SVG.lawnGreen) + , ("lemonChiffon", SVG.lemonChiffon) + , ("lightBlue", SVG.lightBlue) + , ("lightCoral", SVG.lightCoral) + , ("lightCyan", SVG.lightCyan) + , ("lightGoldenrodYellow", SVG.lightGoldenrodYellow) + , ("lightGray", SVG.lightGray) + , ("lightGreen", SVG.lightGreen) + , ("lightGrey", SVG.lightGrey) + , ("lightPink", SVG.lightPink) + , ("lightSalmon", SVG.lightSalmon) + , ("lightSeaGreen", SVG.lightSeaGreen) + , ("lightSkyBlue", SVG.lightSkyBlue) + , ("lightSlateGray", SVG.lightSlateGray) + , ("lightSlateGrey", SVG.lightSlateGrey) + , ("lightSteelBlue", SVG.lightSteelBlue) + , ("lightYellow", SVG.lightYellow) + , ("lime", SVG.lime) + , ("limeGreen", SVG.limeGreen) + , ("linen", SVG.linen) + , ("magenta", SVG.magenta) + , ("maroon", SVG.maroon) + , ("mediumAquamarine", SVG.mediumAquamarine) + , ("mediumBlue", SVG.mediumBlue) + , ("mediumOrchid", SVG.mediumOrchid) + , ("mediumPurple", SVG.mediumPurple) + , ("mediumSeaGreen", SVG.mediumSeaGreen) + , ("mediumSlateBlue", SVG.mediumSlateBlue) + , ("mediumSpringGreen", SVG.mediumSpringGreen) + , ("mediumTurquoise", SVG.mediumTurquoise) + , ("mediumVioletRed", SVG.mediumVioletRed) + , ("midnightBlue", SVG.midnightBlue) + , ("mintcream", SVG.mintcream) + , ("mistyrose", SVG.mistyrose) + , ("moccasin", SVG.moccasin) + , ("navajoWhite", SVG.navajoWhite) + , ("navy", SVG.navy) + , ("oldlace", SVG.oldlace) + , ("olive", SVG.olive) + , ("oliveDrab", SVG.oliveDrab) + , ("orange", SVG.orange) + , ("orangeRed", SVG.orangeRed) + , ("orchid", SVG.orchid) + , ("paleGoldenrod", SVG.paleGoldenrod) + , ("paleGreen", SVG.paleGreen) + , ("paleTurquoise", SVG.paleTurquoise) + , ("paleVioletRed", SVG.paleVioletRed) + , ("papayawhip", SVG.papayawhip) + , ("peachpuff", SVG.peachpuff) + , ("peru", SVG.peru) + , ("pink", SVG.pink) + , ("plum", SVG.plum) + , ("powderBlue", SVG.powderBlue) + , ("purple", SVG.purple) + , ("red", SVG.red) + , ("rosyBrown", SVG.rosyBrown) + , ("royalBlue", SVG.royalBlue) + , ("saddleBrown", SVG.saddleBrown) + , ("salmon", SVG.salmon) + , ("sandyBrown", SVG.sandyBrown) + , ("seaGreen", SVG.seaGreen) + , ("seashell", SVG.seashell) + , ("sienna", SVG.sienna) + , ("silver", SVG.silver) + , ("skyBlue", SVG.skyBlue) + , ("slateBlue", SVG.slateBlue) + , ("slateGray", SVG.slateGray) + , ("slateGrey", SVG.slateGrey) + , ("snow", SVG.snow) + , ("springGreen", SVG.springGreen) + , ("steelBlue", SVG.steelBlue) + , ("tan", SVG.tan) + , ("teal", SVG.teal) + , ("thistle", SVG.thistle) + , ("tomato", SVG.tomato) + , ("turquoise", SVG.turquoise) + , ("violet", SVG.violet) + , ("wheat", SVG.wheat) + , ("white", SVG.white) + , ("whitesmoke", SVG.whitesmoke) + , ("yellow", SVG.yellow) + , ("yellowGreen", SVG.yellowGreen) + ] + + + +all_x11_colours :: [(String,DRGB)] +all_x11_colours = + [ ("antiqueWhite1", X11.antiqueWhite1) + , ("antiqueWhite2", X11.antiqueWhite2) + , ("antiqueWhite3", X11.antiqueWhite3) + , ("antiqueWhite4", X11.antiqueWhite4) + , ("aquamarine1", X11.aquamarine1) + , ("aquamarine2", X11.aquamarine2) + , ("aquamarine3", X11.aquamarine3) + , ("aquamarine4", X11.aquamarine4) + , ("azure1", X11.azure1) + , ("azure2", X11.azure2) + , ("azure3", X11.azure3) + , ("azure4", X11.azure4) + , ("bisque1", X11.bisque1) + , ("bisque2", X11.bisque2) + , ("bisque3", X11.bisque3) + , ("bisque4", X11.bisque4) + , ("blue1", X11.blue1) + , ("blue2", X11.blue2) + , ("blue3", X11.blue3) + , ("blue4", X11.blue4) + , ("brown1", X11.brown1) + , ("brown2", X11.brown2) + , ("brown3", X11.brown3) + , ("brown4", X11.brown4) + , ("burlywood1", X11.burlywood1) + , ("burlywood2", X11.burlywood2) + , ("burlywood3", X11.burlywood3) + , ("burlywood4", X11.burlywood4) + , ("cadetBlue1", X11.cadetBlue1) + , ("cadetBlue2", X11.cadetBlue2) + , ("cadetBlue3", X11.cadetBlue3) + , ("cadetBlue4", X11.cadetBlue4) + , ("chartreuse1", X11.chartreuse1) + , ("chartreuse2", X11.chartreuse2) + , ("chartreuse3", X11.chartreuse3) + , ("chartreuse4", X11.chartreuse4) + , ("chocolate1", X11.chocolate1) + , ("chocolate2", X11.chocolate2) + , ("chocolate3", X11.chocolate3) + , ("chocolate4", X11.chocolate4) + , ("coral1", X11.coral1) + , ("coral2", X11.coral2) + , ("coral3", X11.coral3) + , ("coral4", X11.coral4) + , ("cornsilk1", X11.cornsilk1) + , ("cornsilk2", X11.cornsilk2) + , ("cornsilk3", X11.cornsilk3) + , ("cornsilk4", X11.cornsilk4) + , ("cyan1", X11.cyan1) + , ("cyan2", X11.cyan2) + , ("cyan3", X11.cyan3) + , ("cyan4", X11.cyan4) + , ("darkGoldenrod1", X11.darkGoldenrod1) + , ("darkGoldenrod2", X11.darkGoldenrod2) + , ("darkGoldenrod3", X11.darkGoldenrod3) + , ("darkGoldenrod4", X11.darkGoldenrod4) + , ("darkOliveGreen1", X11.darkOliveGreen1) + , ("darkOliveGreen2", X11.darkOliveGreen2) + , ("darkOliveGreen3", X11.darkOliveGreen3) + , ("darkOliveGreen4", X11.darkOliveGreen4) + , ("darkOrange1", X11.darkOrange1) + , ("darkOrange2", X11.darkOrange2) + , ("darkOrange3", X11.darkOrange3) + , ("darkOrange4", X11.darkOrange4) + , ("darkOrchid1", X11.darkOrchid1) + , ("darkOrchid2", X11.darkOrchid2) + , ("darkOrchid3", X11.darkOrchid3) + , ("darkOrchid4", X11.darkOrchid4) + , ("darkSeaGreen1", X11.darkSeaGreen1) + , ("darkSeaGreen2", X11.darkSeaGreen2) + , ("darkSeaGreen3", X11.darkSeaGreen3) + , ("darkSeaGreen4", X11.darkSeaGreen4) + , ("darkSlateGray1", X11.darkSlateGray1) + , ("darkSlateGray2", X11.darkSlateGray2) + , ("darkSlateGray3", X11.darkSlateGray3) + , ("darkSlateGray4", X11.darkSlateGray4) + , ("deepPink1", X11.deepPink1) + , ("deepPink2", X11.deepPink2) + , ("deepPink3", X11.deepPink3) + , ("deepPink4", X11.deepPink4) + , ("deepSkyBlue1", X11.deepSkyBlue1) + , ("deepSkyBlue2", X11.deepSkyBlue2) + , ("deepSkyBlue3", X11.deepSkyBlue3) + , ("deepSkyBlue4", X11.deepSkyBlue4) + , ("dodgerBlue1", X11.dodgerBlue1) + , ("dodgerBlue2", X11.dodgerBlue2) + , ("dodgerBlue3", X11.dodgerBlue3) + , ("dodgerBlue4", X11.dodgerBlue4) + , ("firebrick1", X11.firebrick1) + , ("firebrick2", X11.firebrick2) + , ("firebrick3", X11.firebrick3) + , ("firebrick4", X11.firebrick4) + , ("gold1", X11.gold1) + , ("gold2", X11.gold2) + , ("gold3", X11.gold3) + , ("gold4", X11.gold4) + , ("goldenrod1", X11.goldenrod1) + , ("goldenrod2", X11.goldenrod2) + , ("goldenrod3", X11.goldenrod3) + , ("goldenrod4", X11.goldenrod4) + , ("green1", X11.green1) + , ("green2", X11.green2) + , ("green3", X11.green3) + , ("green4", X11.green4) + , ("honeydew1", X11.honeydew1) + , ("honeydew2", X11.honeydew2) + , ("honeydew3", X11.honeydew3) + , ("honeydew4", X11.honeydew4) + , ("hotPink1", X11.hotPink1) + , ("hotPink2", X11.hotPink2) + , ("hotPink3", X11.hotPink3) + , ("hotPink4", X11.hotPink4) + , ("indianRed1", X11.indianRed1) + , ("indianRed2", X11.indianRed2) + , ("indianRed3", X11.indianRed3) + , ("indianRed4", X11.indianRed4) + , ("ivory1", X11.ivory1) + , ("ivory2", X11.ivory2) + , ("ivory3", X11.ivory3) + , ("ivory4", X11.ivory4) + , ("khaki1", X11.khaki1) + , ("khaki2", X11.khaki2) + , ("khaki3", X11.khaki3) + , ("khaki4", X11.khaki4) + , ("lavenderBlush1", X11.lavenderBlush1) + , ("lavenderBlush2", X11.lavenderBlush2) + , ("lavenderBlush3", X11.lavenderBlush3) + , ("lavenderBlush4", X11.lavenderBlush4) + , ("lemonChiffon1", X11.lemonChiffon1) + , ("lemonChiffon2", X11.lemonChiffon2) + , ("lemonChiffon3", X11.lemonChiffon3) + , ("lemonChiffon4", X11.lemonChiffon4) + , ("lightBlue1", X11.lightBlue1) + , ("lightBlue2", X11.lightBlue2) + , ("lightBlue3", X11.lightBlue3) + , ("lightBlue4", X11.lightBlue4) + , ("lightCyan1", X11.lightCyan1) + , ("lightCyan2", X11.lightCyan2) + , ("lightCyan3", X11.lightCyan3) + , ("lightCyan4", X11.lightCyan4) + , ("lightGoldenrod1", X11.lightGoldenrod1) + , ("lightGoldenrod2", X11.lightGoldenrod2) + , ("lightGoldenrod3", X11.lightGoldenrod3) + , ("lightGoldenrod4", X11.lightGoldenrod4) + , ("lightPink1", X11.lightPink1) + , ("lightPink2", X11.lightPink2) + , ("lightPink3", X11.lightPink3) + , ("lightPink4", X11.lightPink4) + , ("lightSalmon1", X11.lightSalmon1) + , ("lightSalmon2", X11.lightSalmon2) + , ("lightSalmon3", X11.lightSalmon3) + , ("lightSalmon4", X11.lightSalmon4) + , ("lightSkyBlue1", X11.lightSkyBlue1) + , ("lightSkyBlue2", X11.lightSkyBlue2) + , ("lightSkyBlue3", X11.lightSkyBlue3) + , ("lightSkyBlue4", X11.lightSkyBlue4) + , ("lightSteelBlue1", X11.lightSteelBlue1) + , ("lightSteelBlue2", X11.lightSteelBlue2) + , ("lightSteelBlue3", X11.lightSteelBlue3) + , ("lightSteelBlue4", X11.lightSteelBlue4) + , ("lightYellow1", X11.lightYellow1) + , ("lightYellow2", X11.lightYellow2) + , ("lightYellow3", X11.lightYellow3) + , ("lightYellow4", X11.lightYellow4) + , ("magenta1", X11.magenta1) + , ("magenta2", X11.magenta2) + , ("magenta3", X11.magenta3) + , ("magenta4", X11.magenta4) + , ("maroon1", X11.maroon1) + , ("maroon2", X11.maroon2) + , ("maroon3", X11.maroon3) + , ("maroon4", X11.maroon4) + , ("mediumOrchid1", X11.mediumOrchid1) + , ("mediumOrchid2", X11.mediumOrchid2) + , ("mediumOrchid3", X11.mediumOrchid3) + , ("mediumOrchid4", X11.mediumOrchid4) + , ("mediumPurple1", X11.mediumPurple1) + , ("mediumPurple2", X11.mediumPurple2) + , ("mediumPurple3", X11.mediumPurple3) + , ("mediumPurple4", X11.mediumPurple4) + , ("mistyRose1", X11.mistyRose1) + , ("mistyRose2", X11.mistyRose2) + , ("mistyRose3", X11.mistyRose3) + , ("mistyRose4", X11.mistyRose4) + , ("navajoWhite1", X11.navajoWhite1) + , ("navajoWhite2", X11.navajoWhite2) + , ("navajoWhite3", X11.navajoWhite3) + , ("navajoWhite4", X11.navajoWhite4) + , ("oliveDrab1", X11.oliveDrab1) + , ("oliveDrab2", X11.oliveDrab2) + , ("oliveDrab3", X11.oliveDrab3) + , ("oliveDrab4", X11.oliveDrab4) + , ("orange1", X11.orange1) + , ("orange2", X11.orange2) + , ("orange3", X11.orange3) + , ("orange4", X11.orange4) + , ("orangeRed1", X11.orangeRed1) + , ("orangeRed2", X11.orangeRed2) + , ("orangeRed3", X11.orangeRed3) + , ("orangeRed4", X11.orangeRed4) + , ("orchid1", X11.orchid1) + , ("orchid2", X11.orchid2) + , ("orchid3", X11.orchid3) + , ("orchid4", X11.orchid4) + , ("paleGreen1", X11.paleGreen1) + , ("paleGreen2", X11.paleGreen2) + , ("paleGreen3", X11.paleGreen3) + , ("paleGreen4", X11.paleGreen4) + , ("paleTurquoise1", X11.paleTurquoise1) + , ("paleTurquoise2", X11.paleTurquoise2) + , ("paleTurquoise3", X11.paleTurquoise3) + , ("paleTurquoise4", X11.paleTurquoise4) + , ("paleVioletRed1", X11.paleVioletRed1) + , ("paleVioletRed2", X11.paleVioletRed2) + , ("paleVioletRed3", X11.paleVioletRed3) + , ("paleVioletRed4", X11.paleVioletRed4) + , ("peachPuff1", X11.peachPuff1) + , ("peachPuff2", X11.peachPuff2) + , ("peachPuff3", X11.peachPuff3) + , ("peachPuff4", X11.peachPuff4) + , ("pink1", X11.pink1) + , ("pink2", X11.pink2) + , ("pink3", X11.pink3) + , ("pink4", X11.pink4) + , ("plum1", X11.plum1) + , ("plum2", X11.plum2) + , ("plum3", X11.plum3) + , ("plum4", X11.plum4) + , ("purple1", X11.purple1) + , ("purple2", X11.purple2) + , ("purple3", X11.purple3) + , ("purple4", X11.purple4) + , ("red1", X11.red1) + , ("red2", X11.red2) + , ("red3", X11.red3) + , ("red4", X11.red4) + , ("rosyBrown1", X11.rosyBrown1) + , ("rosyBrown2", X11.rosyBrown2) + , ("rosyBrown3", X11.rosyBrown3) + , ("rosyBrown4", X11.rosyBrown4) + , ("royalBlue1", X11.royalBlue1) + , ("royalBlue2", X11.royalBlue2) + , ("royalBlue3", X11.royalBlue3) + , ("royalBlue4", X11.royalBlue4) + , ("salmon1", X11.salmon1) + , ("salmon2", X11.salmon2) + , ("salmon3", X11.salmon3) + , ("salmon4", X11.salmon4) + , ("seaGreen1", X11.seaGreen1) + , ("seaGreen2", X11.seaGreen2) + , ("seaGreen3", X11.seaGreen3) + , ("seaGreen4", X11.seaGreen4) + , ("seashell1", X11.seashell1) + , ("seashell2", X11.seashell2) + , ("seashell3", X11.seashell3) + , ("seashell4", X11.seashell4) + , ("sienna1", X11.sienna1) + , ("sienna2", X11.sienna2) + , ("sienna3", X11.sienna3) + , ("sienna4", X11.sienna4) + , ("skyBlue1", X11.skyBlue1) + , ("skyBlue2", X11.skyBlue2) + , ("skyBlue3", X11.skyBlue3) + , ("skyBlue4", X11.skyBlue4) + , ("slateBlue1", X11.slateBlue1) + , ("slateBlue2", X11.slateBlue2) + , ("slateBlue3", X11.slateBlue3) + , ("slateBlue4", X11.slateBlue4) + , ("slateGray1", X11.slateGray1) + , ("slateGray2", X11.slateGray2) + , ("slateGray3", X11.slateGray3) + , ("slateGray4", X11.slateGray4) + , ("snow1", X11.snow1) + , ("snow2", X11.snow2) + , ("snow3", X11.snow3) + , ("snow4", X11.snow4) + , ("springGreen1", X11.springGreen1) + , ("springGreen2", X11.springGreen2) + , ("springGreen3", X11.springGreen3) + , ("springGreen4", X11.springGreen4) + , ("steelBlue1", X11.steelBlue1) + , ("steelBlue2", X11.steelBlue2) + , ("steelBlue3", X11.steelBlue3) + , ("steelBlue4", X11.steelBlue4) + , ("tan1", X11.tan1) + , ("tan2", X11.tan2) + , ("tan3", X11.tan3) + , ("tan4", X11.tan4) + , ("thistle1", X11.thistle1) + , ("thistle2", X11.thistle2) + , ("thistle3", X11.thistle3) + , ("thistle4", X11.thistle4) + , ("tomato1", X11.tomato1) + , ("tomato2", X11.tomato2) + , ("tomato3", X11.tomato3) + , ("tomato4", X11.tomato4) + , ("turquoise1", X11.turquoise1) + , ("turquoise2", X11.turquoise2) + , ("turquoise3", X11.turquoise3) + , ("turquoise4", X11.turquoise4) + , ("violetRed1", X11.violetRed1) + , ("violetRed2", X11.violetRed2) + , ("violetRed3", X11.violetRed3) + , ("violetRed4", X11.violetRed4) + , ("wheat1", X11.wheat1) + , ("wheat2", X11.wheat2) + , ("wheat3", X11.wheat3) + , ("wheat4", X11.wheat4) + , ("yellow1", X11.yellow1) + , ("yellow2", X11.yellow2) + , ("yellow3", X11.yellow3) + , ("yellow4", X11.yellow4) + , ("gray0", X11.gray0) + , ("green0", X11.green0) + , ("grey0", X11.grey0) + , ("maroon0", X11.maroon0) + , ("purple0", X11.purple0) + ] + + + + diff --git a/demo/FontPic.hs b/demo/FontPic.hs --- a/demo/FontPic.hs +++ b/demo/FontPic.hs @@ -28,18 +28,21 @@ writeSVG_latin1 "./out/font_symbol.svg" symbol_pic -makeFontLabel :: DRGB -> FontAttr -> (DPoint2 -> DPrimitive) +makeFontLabel :: DRGB -> FontAttr -> DPoint2 -> DPrimitive makeFontLabel c fa = textlabel (c,fa) msg where msg = unwords [ font_name fa, (show $ font_size fa) ++ "pt"] -blueLabel :: FontAttr -> (DPoint2 -> DPrimitive) -blueLabel = makeFontLabel steelBlue +blueLabel :: (Int -> FontAttr) -> Int -> DPoint2 -> DPrimitive +blueLabel f i = makeFontLabel steelBlue (f i) -redLabel :: FontAttr -> (DPoint2 -> DPrimitive) -redLabel = makeFontLabel indianRed1 +redLabel :: (Int -> FontAttr) -> Int -> DPoint2 -> DPrimitive +redLabel f i = makeFontLabel indianRed1 (f i) +point_sizes :: [Int] +point_sizes = [10, 12, 18, 24, 36, 48] + -------------------------------------------------------------------------------- -- Times @@ -51,32 +54,19 @@ timesroman_pic :: Picture Double timesroman_pic = - frameMulti $ zipWith blueLabel xs (mkPoints 1.5) - where - xs = [ timesRoman10, timesRoman12, timesRoman18 - , timesRoman24, timesRoman36, timesRoman48 ] + frameMulti $ zipWith (blueLabel timesRoman) point_sizes (mkPoints 1.5) timesitalic_pic :: Picture Double timesitalic_pic = - frameMulti $ zipWith redLabel xs (mkPoints 1.5) - where - xs = [ timesItalic10, timesItalic12, timesItalic18 - , timesItalic24, timesItalic36, timesItalic48 ] - + frameMulti $ zipWith (redLabel timesItalic) point_sizes (mkPoints 1.5) timesbold_pic :: Picture Double timesbold_pic = - frameMulti $ zipWith blueLabel xs (mkPoints 1.5) - where - xs = [ timesBold10, timesBold12, timesBold18 - , timesBold24, timesBold36, timesBold48 ] + frameMulti $ zipWith (blueLabel timesBold) point_sizes (mkPoints 1.5) timesbolditalic_pic :: Picture Double timesbolditalic_pic = - frameMulti $ zipWith redLabel xs (mkPoints 1.5) - where - xs = [ timesBoldItalic10, timesBoldItalic12, timesBoldItalic18 - , timesBoldItalic24, timesBoldItalic36, timesBoldItalic48 ] + frameMulti $ zipWith (redLabel timesBoldItalic) point_sizes (mkPoints 1.5) -------------------------------------------------------------------------------- helvetica_pic :: Picture Double @@ -85,36 +75,19 @@ helvetica_pic1 :: Picture Double helvetica_pic1 = - frameMulti $ zipWith blueLabel xs (mkPoints 1.5) - where - xs = [ helvetica10, helvetica12, helvetica18 - , helvetica24, helvetica36, helvetica48 ] - + frameMulti $ zipWith (blueLabel helvetica) point_sizes (mkPoints 1.5) - helveticaoblique_pic :: Picture Double helveticaoblique_pic = - frameMulti $ zipWith redLabel xs (mkPoints 1.5) - where - xs = [ helveticaOblique10, helveticaOblique12, helveticaOblique18 - , helveticaOblique24, helveticaOblique36, helveticaOblique48 ] - + frameMulti $ zipWith (redLabel helveticaOblique) point_sizes (mkPoints 1.5) helveticabold_pic :: Picture Double helveticabold_pic = - frameMulti $ zipWith blueLabel xs (mkPoints 1.5) - where - xs = [ helveticaBold10, helveticaBold12, helveticaBold18 - , helveticaBold24, helveticaBold36, helveticaBold48 ] - + frameMulti $ zipWith (blueLabel helveticaBold) point_sizes (mkPoints 1.5) helveticaboldoblique_pic :: Picture Double helveticaboldoblique_pic = - frameMulti $ zipWith redLabel xs (mkPoints 1.5) - where - xs = [ helveticaBoldOblique10, helveticaBoldOblique12 - , helveticaBoldOblique18, helveticaBoldOblique24 - , helveticaBoldOblique36, helveticaBoldOblique48 ] + frameMulti $ zipWith (redLabel helveticaBoldOblique) point_sizes (mkPoints 1.5) -------------------------------------------------------------------------------- @@ -124,43 +97,26 @@ courier_pic1 :: Picture Double courier_pic1 = - frameMulti $ zipWith blueLabel xs (mkPoints 1.5) - where - xs = [ courier10, courier12, courier18 - , courier24, courier36, courier48 ] - + frameMulti $ zipWith (blueLabel courier) point_sizes (mkPoints 1.5) courieroblique_pic :: Picture Double courieroblique_pic = - frameMulti $ zipWith redLabel xs (mkPoints 1.5) - where - xs = [ courierOblique10, courierOblique12, courierOblique18 - , courierOblique24, courierOblique36, courierOblique48 ] - + frameMulti $ zipWith (redLabel courierOblique) point_sizes (mkPoints 1.5) courierbold_pic :: Picture Double courierbold_pic = - frameMulti $ zipWith blueLabel xs (mkPoints 1.5) - where - xs = [ courierBold10, courierBold12, courierBold18 - , courierBold24, courierBold36, courierBold48 ] - + frameMulti $ zipWith (blueLabel courierBold) point_sizes (mkPoints 1.5) courierboldoblique_pic :: Picture Double courierboldoblique_pic = - frameMulti $ zipWith redLabel xs (mkPoints 1.5) - where - xs = [ courierBoldOblique10, courierBoldOblique12, courierBoldOblique18 - , courierBoldOblique24, courierBoldOblique36, courierBoldOblique48 ] + frameMulti $ zipWith (redLabel courierBoldOblique) point_sizes (mkPoints 1.5) -------------------------------------------------------------------------------- symbol_pic :: Picture Double symbol_pic = - frameMulti $ zipWith blueLabel xs (mkPoints 1.5) - where - xs = [ symbol10, symbol12, symbol18, symbol24, symbol36, symbol48 ] + frameMulti $ zipWith (blueLabel symbol) point_sizes (mkPoints 1.5) -------------------------------------------------------------------------------- diff --git a/src/Wumpus/Basic/Graphic.hs b/src/Wumpus/Basic/Graphic.hs new file mode 100644 --- /dev/null +++ b/src/Wumpus/Basic/Graphic.hs @@ -0,0 +1,121 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Wumpus.Basic.Graphic +-- Copyright : (c) Stephen Tetley 2010 +-- License : BSD3 +-- +-- Maintainer : stephen.tetley@gmail.com +-- Stability : unstable +-- Portability : GHC +-- +-- Graphic type and opertations +-- +-- ** WARNING ** this module is highly experimental, and may +-- change significantly or even be dropped from future revisions. +-- +-- +-------------------------------------------------------------------------------- + +module Wumpus.Basic.Graphic + ( + -- * Type aliases + Graphic + , DGraphic + + , GraphicF + , DGraphicF + + -- * New Bird.. + , cc + + -- * Operations + , drawGraphic + , wrapG + + , text + , straightLine + , strokedRectangle + , filledRectangle + , circle + + ) where + + + +import Wumpus.Core -- package: wumpus-core +import Wumpus.Basic.Utils.HList + +import Data.AffineSpace -- package: vector-space + +-- | Note - this representation allows for zero, one or more +-- Primitives to be collected together. +-- +type Graphic u = H (Primitive u) + +type DGraphic = Graphic Double + +type GraphicF u = Point2 u -> Graphic u + +type DGraphicF = GraphicF Double + + +-------------------------------------------------------------------------------- +-- Wow a new bird combinator... + +infixr 9 `cc` + +cc :: (r1 -> a -> ans) -> (r1 -> r2 -> a) -> r1 -> r2 -> ans +cc f g = \x y -> f x (g x y) + + +-------------------------------------------------------------------------------- + +-- | Note - a Picture cannot be empty whereas a Graphic can. +-- Hence this function returns via Maybe. +-- +drawGraphic :: (Real u, Floating u) => Graphic u -> Maybe (Picture u) +drawGraphic f = post $ f [] + where + post [] = Nothing + post xs = Just $ frameMulti $ xs + + +-- | Lift a Primitive to a Graphic +-- +wrapG :: Primitive u -> Graphic u +wrapG = wrapH + + +-------------------------------------------------------------------------------- + +text :: (TextLabel t, Num u) => t -> String -> GraphicF u +text t ss = wrapG . textlabel t ss + +straightLine :: (Stroke t, Num u) => t -> Vec2 u -> GraphicF u +straightLine t v = \pt -> wrapG $ ostroke t $ path pt [lineTo $ pt .+^ v] + + +-- | Point is bottom-left. +-- +strokedRectangle :: (Stroke t, Num u) => t -> u -> u -> GraphicF u +strokedRectangle t w h = wrapG . cstroke t . rectangle w h + +-- | Point is bottom-left. +-- +filledRectangle :: (Fill t, Num u) => t -> u -> u -> GraphicF u +filledRectangle t w h = wrapG . fill t . rectangle w h + + +rectangle :: Num u => u -> u -> Point2 u -> Path u +rectangle w h bl = path bl [ lineTo br, lineTo tr, lineTo tl ] + where + br = bl .+^ hvec w + tr = br .+^ vvec h + tl = bl .+^ vvec h + + + +circle :: (Ellipse t, Fractional u) => t -> u -> GraphicF u +circle t radius = wrapG . ellipse t radius radius diff --git a/src/Wumpus/Basic/SafeFonts.hs b/src/Wumpus/Basic/SafeFonts.hs --- a/src/Wumpus/Basic/SafeFonts.hs +++ b/src/Wumpus/Basic/SafeFonts.hs @@ -8,114 +8,36 @@ -- -- Maintainer : Stephen Tetley -- Stability : highly unstable --- Portability : GHC with TypeFamilies and more +-- Portability : GHC -- --- Safe to use font / size combinations. +-- Safe to use fonts. -- --- Using fonts at other sizes than the ones enumerated in this --- module may case unusual rendering errors, consider drawing --- at a standard size then uniform-scaling for other sizes in --- PostScript. -- -------------------------------------------------------------------------------- module Wumpus.Basic.SafeFonts ( -- * Times Roman - timesRoman10 - , timesRoman12 - , timesRoman18 - , timesRoman24 - , timesRoman36 - , timesRoman48 - - , timesItalic10 - , timesItalic12 - , timesItalic18 - , timesItalic24 - , timesItalic36 - , timesItalic48 - - , timesBold10 - , timesBold12 - , timesBold18 - , timesBold24 - , timesBold36 - , timesBold48 - - , timesBoldItalic10 - , timesBoldItalic12 - , timesBoldItalic18 - , timesBoldItalic24 - , timesBoldItalic36 - , timesBoldItalic48 + timesRoman + , timesItalic + , timesBold + , timesBoldItalic -- * Helvetica - , helvetica10 - , helvetica12 - , helvetica18 - , helvetica24 - , helvetica36 - , helvetica48 - - , helveticaOblique10 - , helveticaOblique12 - , helveticaOblique18 - , helveticaOblique24 - , helveticaOblique36 - , helveticaOblique48 - - , helveticaBold10 - , helveticaBold12 - , helveticaBold18 - , helveticaBold24 - , helveticaBold36 - , helveticaBold48 - - , helveticaBoldOblique10 - , helveticaBoldOblique12 - , helveticaBoldOblique18 - , helveticaBoldOblique24 - , helveticaBoldOblique36 - , helveticaBoldOblique48 + , helvetica + , helveticaOblique + , helveticaBold + , helveticaBoldOblique -- * Courier - , courier10 - , courier12 - , courier18 - , courier24 - , courier36 - , courier48 - - , courierOblique10 - , courierOblique12 - , courierOblique18 - , courierOblique24 - , courierOblique36 - , courierOblique48 - - , courierBold10 - , courierBold12 - , courierBold18 - , courierBold24 - , courierBold36 - , courierBold48 - - , courierBoldOblique10 - , courierBoldOblique12 - , courierBoldOblique18 - , courierBoldOblique24 - , courierBoldOblique36 - , courierBoldOblique48 + , courier + , courierOblique + , courierBold + , courierBoldOblique -- * Symbol -- $symboldoc - , symbol10 - , symbol12 - , symbol18 - , symbol24 - , symbol36 - , symbol48 + , symbol ) where @@ -134,297 +56,75 @@ -------------------------------------------------------------------------------- -- Times-Roman -mkTimesRoman :: Int -> FontAttr -mkTimesRoman = FontAttr "Times-Roman" "Times New Roman" SVG_REGULAR - -timesRoman10 :: FontAttr -timesRoman10 = mkTimesRoman 10 - -timesRoman12 :: FontAttr -timesRoman12 = mkTimesRoman 12 - -timesRoman18 :: FontAttr -timesRoman18 = mkTimesRoman 18 - -timesRoman24 :: FontAttr -timesRoman24 = mkTimesRoman 24 - -timesRoman36 :: FontAttr -timesRoman36 = mkTimesRoman 36 - -timesRoman48 :: FontAttr -timesRoman48 = mkTimesRoman 48 +timesRoman :: Int -> FontAttr +timesRoman = FontAttr "Times-Roman" "Times New Roman" SVG_REGULAR -- Times Italic -mkTimesItalic :: Int -> FontAttr -mkTimesItalic = FontAttr "Times-Italic" "Times New Roman" SVG_ITALIC - -timesItalic10 :: FontAttr -timesItalic10 = mkTimesItalic 10 - -timesItalic12 :: FontAttr -timesItalic12 = mkTimesItalic 12 - -timesItalic18 :: FontAttr -timesItalic18 = mkTimesItalic 18 - -timesItalic24 :: FontAttr -timesItalic24 = mkTimesItalic 24 - -timesItalic36 :: FontAttr -timesItalic36 = mkTimesItalic 36 - -timesItalic48 :: FontAttr -timesItalic48 = mkTimesItalic 48 +timesItalic :: Int -> FontAttr +timesItalic = FontAttr "Times-Italic" "Times New Roman" SVG_ITALIC -- Times Bold -mkTimesBold :: Int -> FontAttr -mkTimesBold = FontAttr "Times-Bold" "Times New Roman" SVG_BOLD - -timesBold10 :: FontAttr -timesBold10 = mkTimesBold 10 - -timesBold12 :: FontAttr -timesBold12 = mkTimesBold 12 - -timesBold18 :: FontAttr -timesBold18 = mkTimesBold 18 - -timesBold24 :: FontAttr -timesBold24 = mkTimesBold 24 - -timesBold36 :: FontAttr -timesBold36 = mkTimesBold 36 - -timesBold48 :: FontAttr -timesBold48 = mkTimesBold 48 +timesBold :: Int -> FontAttr +timesBold = FontAttr "Times-Bold" "Times New Roman" SVG_BOLD -- Times Bold Italic -mkTimesBoldItalic :: Int -> FontAttr -mkTimesBoldItalic = +timesBoldItalic :: Int -> FontAttr +timesBoldItalic = FontAttr "Times-BoldItalic" "Times New Roman" SVG_BOLD_ITALIC -timesBoldItalic10 :: FontAttr -timesBoldItalic10 = mkTimesBoldItalic 10 -timesBoldItalic12 :: FontAttr -timesBoldItalic12 = mkTimesBoldItalic 12 - -timesBoldItalic18 :: FontAttr -timesBoldItalic18 = mkTimesBoldItalic 18 - -timesBoldItalic24 :: FontAttr -timesBoldItalic24 = mkTimesBoldItalic 24 - -timesBoldItalic36 :: FontAttr -timesBoldItalic36 = mkTimesBoldItalic 36 - -timesBoldItalic48 :: FontAttr -timesBoldItalic48 = mkTimesBoldItalic 48 - - -------------------------------------------------------------------------------- -- Helvetica -mkHelvetica :: Int -> FontAttr -mkHelvetica = FontAttr "Helvetica" "Helvetica" SVG_REGULAR +helvetica :: Int -> FontAttr +helvetica = FontAttr "Helvetica" "Helvetica" SVG_REGULAR -helvetica10 :: FontAttr -helvetica10 = mkHelvetica 10 - -helvetica12 :: FontAttr -helvetica12 = mkHelvetica 12 - -helvetica18 :: FontAttr -helvetica18 = mkHelvetica 18 - -helvetica24 :: FontAttr -helvetica24 = mkHelvetica 24 - -helvetica36 :: FontAttr -helvetica36 = mkHelvetica 36 - -helvetica48 :: FontAttr -helvetica48 = mkHelvetica 48 - -- Helvetica Oblique -mkHelveticaOblique :: Int -> FontAttr -mkHelveticaOblique = FontAttr "Helvetica-Oblique" "Helvetica" SVG_OBLIQUE - - -helveticaOblique10 :: FontAttr -helveticaOblique10 = mkHelveticaOblique 10 - -helveticaOblique12 :: FontAttr -helveticaOblique12 = mkHelveticaOblique 12 - -helveticaOblique18 :: FontAttr -helveticaOblique18 = mkHelveticaOblique 18 - -helveticaOblique24 :: FontAttr -helveticaOblique24 = mkHelveticaOblique 24 - -helveticaOblique36 :: FontAttr -helveticaOblique36 = mkHelveticaOblique 36 - -helveticaOblique48 :: FontAttr -helveticaOblique48 = mkHelveticaOblique 48 - +helveticaOblique :: Int -> FontAttr +helveticaOblique = FontAttr "Helvetica-Oblique" "Helvetica" SVG_OBLIQUE -- Helvetica Bold -mkHelveticaBold :: Int -> FontAttr -mkHelveticaBold = FontAttr "Helvetica-Bold" "Helvetica" SVG_BOLD +helveticaBold :: Int -> FontAttr +helveticaBold = FontAttr "Helvetica-Bold" "Helvetica" SVG_BOLD -helveticaBold10 :: FontAttr -helveticaBold10 = mkHelveticaBold 10 - -helveticaBold12 :: FontAttr -helveticaBold12 = mkHelveticaBold 12 - -helveticaBold18 :: FontAttr -helveticaBold18 = mkHelveticaBold 18 - -helveticaBold24 :: FontAttr -helveticaBold24 = mkHelveticaBold 24 - -helveticaBold36 :: FontAttr -helveticaBold36 = mkHelveticaBold 36 - -helveticaBold48 :: FontAttr -helveticaBold48 = mkHelveticaBold 48 - -- Helvetica Bold Oblique -mkHelveticaBoldOblique :: Int -> FontAttr -mkHelveticaBoldOblique = +helveticaBoldOblique :: Int -> FontAttr +helveticaBoldOblique = FontAttr "Helvetica-Bold-Oblique" "Helvetica" SVG_BOLD_OBLIQUE -helveticaBoldOblique10 :: FontAttr -helveticaBoldOblique10 = mkHelveticaBoldOblique 10 -helveticaBoldOblique12 :: FontAttr -helveticaBoldOblique12 = mkHelveticaBoldOblique 12 - -helveticaBoldOblique18 :: FontAttr -helveticaBoldOblique18 = mkHelveticaBoldOblique 18 - -helveticaBoldOblique24 :: FontAttr -helveticaBoldOblique24 = mkHelveticaBoldOblique 24 - -helveticaBoldOblique36 :: FontAttr -helveticaBoldOblique36 = mkHelveticaBoldOblique 36 - -helveticaBoldOblique48 :: FontAttr -helveticaBoldOblique48 = mkHelveticaBoldOblique 48 - - - - -------------------------------------------------------------------------------- -- Courier -mkCourier :: Int -> FontAttr -mkCourier = FontAttr "Courier" "Courier New" SVG_REGULAR - -courier10 :: FontAttr -courier10 = mkCourier 10 - -courier12 :: FontAttr -courier12 = mkCourier 12 - -courier18 :: FontAttr -courier18 = mkCourier 18 - -courier24 :: FontAttr -courier24 = mkCourier 24 - -courier36 :: FontAttr -courier36 = mkCourier 36 - -courier48 :: FontAttr -courier48 = mkCourier 48 +courier :: Int -> FontAttr +courier = FontAttr "Courier" "Courier New" SVG_REGULAR -- Courier Oblique -mkCourierOblique :: Int -> FontAttr -mkCourierOblique = FontAttr "Courier-Oblique" "Courier New" SVG_OBLIQUE - - -courierOblique10 :: FontAttr -courierOblique10 = mkCourierOblique 10 - -courierOblique12 :: FontAttr -courierOblique12 = mkCourierOblique 12 - -courierOblique18 :: FontAttr -courierOblique18 = mkCourierOblique 18 - -courierOblique24 :: FontAttr -courierOblique24 = mkCourierOblique 24 - -courierOblique36 :: FontAttr -courierOblique36 = mkCourierOblique 36 - -courierOblique48 :: FontAttr -courierOblique48 = mkCourierOblique 48 +courierOblique :: Int -> FontAttr +courierOblique = FontAttr "Courier-Oblique" "Courier New" SVG_OBLIQUE -- Courier Bold -mkCourierBold :: Int -> FontAttr -mkCourierBold = FontAttr "Courier-Bold" "Courier New" SVG_BOLD +courierBold :: Int -> FontAttr +courierBold = FontAttr "Courier-Bold" "Courier New" SVG_BOLD -courierBold10 :: FontAttr -courierBold10 = mkCourierBold 10 - -courierBold12 :: FontAttr -courierBold12 = mkCourierBold 12 - -courierBold18 :: FontAttr -courierBold18 = mkCourierBold 18 - -courierBold24 :: FontAttr -courierBold24 = mkCourierBold 24 - -courierBold36 :: FontAttr -courierBold36 = mkCourierBold 36 - -courierBold48 :: FontAttr -courierBold48 = mkCourierBold 48 - -- Courier Bold Oblique -mkCourierBoldOblique :: Int -> FontAttr -mkCourierBoldOblique = +courierBoldOblique :: Int -> FontAttr +courierBoldOblique = FontAttr "Courier-Bold-Oblique" "Courier New" SVG_BOLD_OBLIQUE - -courierBoldOblique10 :: FontAttr -courierBoldOblique10 = mkCourierBoldOblique 10 - -courierBoldOblique12 :: FontAttr -courierBoldOblique12 = mkCourierBoldOblique 12 - -courierBoldOblique18 :: FontAttr -courierBoldOblique18 = mkCourierBoldOblique 18 - -courierBoldOblique24 :: FontAttr -courierBoldOblique24 = mkCourierBoldOblique 24 - -courierBoldOblique36 :: FontAttr -courierBoldOblique36 = mkCourierBoldOblique 36 - -courierBoldOblique48 :: FontAttr -courierBoldOblique48 = mkCourierBoldOblique 48 - -------------------------------------------------------------------------------- -- Symbol @@ -432,27 +132,9 @@ -- Symbol does not appear to be well supported by SVG. -- It renders in Chrome but not in Firefox. -mkSymbol :: Int -> FontAttr -mkSymbol = FontAttr "Symbol" "Symbol" SVG_REGULAR - - -symbol10 :: FontAttr -symbol10 = mkSymbol 10 - -symbol12 :: FontAttr -symbol12 = mkSymbol 12 - -symbol18 :: FontAttr -symbol18 = mkSymbol 18 - -symbol24 :: FontAttr -symbol24 = mkSymbol 24 - -symbol36 :: FontAttr -symbol36 = mkSymbol 36 +symbol :: Int -> FontAttr +symbol = FontAttr "Symbol" "Symbol" SVG_REGULAR -symbol48 :: FontAttr -symbol48 = mkSymbol 48 diff --git a/src/Wumpus/Basic/Utils/HList.hs b/src/Wumpus/Basic/Utils/HList.hs --- a/src/Wumpus/Basic/Utils/HList.hs +++ b/src/Wumpus/Basic/Utils/HList.hs @@ -24,6 +24,7 @@ , consH , snocH , appendH + , unfoldrH , veloH , concatH @@ -53,6 +54,15 @@ appendH :: H a -> H a -> H a appendH f g = f . g + + + +unfoldrH :: (b -> Maybe (a,b)) -> b -> H a +unfoldrH phi = step + where step b = case phi b of + Nothing -> emptyH + Just (a,s) -> a `consH` step s + -- | velo consumes the list as per map, but builds it back -- as a Hughes list - so items can be dropped diff --git a/src/Wumpus/Basic/VersionNumber.hs b/src/Wumpus/Basic/VersionNumber.hs --- a/src/Wumpus/Basic/VersionNumber.hs +++ b/src/Wumpus/Basic/VersionNumber.hs @@ -22,4 +22,4 @@ wumpus_basic_version :: (Int,Int,Int) -wumpus_basic_version = (0,1,1) +wumpus_basic_version = (0,2,0) diff --git a/wumpus-basic.cabal b/wumpus-basic.cabal --- a/wumpus-basic.cabal +++ b/wumpus-basic.cabal @@ -1,5 +1,5 @@ name: wumpus-basic -version: 0.1.1 +version: 0.2.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley @@ -11,7 +11,18 @@ . Very preliminary release... . + Changelog: . + 0.1.1 to 0.2.0: + . + * Added the module @Wumpus.Basic.Graphic@. + . + * SafeFonts changed to be size neutral. PostScript\'s + @scalefont@ command (which wumpus-core uses in the generated + output) should be able to scale to any integer size. + . + * New demo @ColourCharts.hs@. + . build-type: Simple stability: highly unstable cabal-version: >= 1.2 @@ -19,8 +30,11 @@ extra-source-files: CHANGES, LICENSE, - demo/FontPic.hs - + demo/FontPic.hs, + demo/ColourCharts.hs, + demo/ColourDefns.hs + + library hs-source-dirs: src build-depends: base < 5, @@ -30,6 +44,7 @@ exposed-modules: + Wumpus.Basic.Graphic, Wumpus.Basic.Monads.TraceMonad, Wumpus.Basic.Monads.TurtleMonad, Wumpus.Basic.SafeFonts,