wumpus-basic-0.6.0: demo/DotPic.hs

{-# OPTIONS -Wall #-}

module DotPic where


import Wumpus.Basic.Colour.SVGColours
import Wumpus.Basic.Dots.Base
import Wumpus.Basic.Graphic
import Wumpus.Basic.Graphic.DrawingAttr
import Wumpus.Basic.PictureLanguage
import Wumpus.Basic.Utils.HList

import Wumpus.Core                      -- package: wumpus-core

import System.Directory

main :: IO ()
main = do 
    createDirectoryIfMissing True "./out/"
    demo01

pt2 :: Point2 Double
pt2 = P2 100 10


demo01 :: IO ()
demo01 = do 
    writeEPS_latin1 "./out/dots01.eps" pic
    writeSVG_latin1 "./out/dots01.svg" pic
  where 
    pic :: Picture Double
    pic = extendBoundary 10 10 $
          uniformScale 2       $ 
            vsepA VLeft 10 p1 [p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14
                              ,p15,p16,p17]
    
    p1  = makeDotPic dotHLine       points
    p2  = makeDotPic dotVLine       points
    p3  = makeDotPic dotX           points
    p4  = makeDotPic dotPlus        points   
    p5  = makeDotPic dotCross       points
    p6  = makeDotPic dotDiamond     points
    p7  = makeDotPic dotDisk        points
    p8  = makeDotPic dotSquare      points
    p9  = makeDotPic dotCircle      points
    p10 = makeDotPic dotPentagon    points
    p11 = makeDotPic dotStar        points
    p12 = makeDotPic dotAsterisk    points
    p13 = makeDotPic dotOPlus       points
    p14 = makeDotPic dotOCross      points
    p15 = makeDotPic dotFOCross     points
    p16 = makeDotPic dotFDiamond    points
    p17 = makeDotPic (dotText "AA") points
 
std_attr :: DrawingAttr
std_attr = standardAttr 12

points :: [Point2 Double]
points = [P2 0 0, P2 32 10, P2 64 0, P2 96 10]

makeDotPic :: (Real u, Floating u, FromPtSize u) 
           => (DrawingAttr -> GraphicF u) -> [Point2 u] -> Picture u
makeDotPic fn xs = drawGraphicU $ veloH (fn std_attr) xs . dashline
  where
    dashline = wrapG $ ostroke cadet_blue attr $ vertexPath xs
    attr     = default_stroke_attr { dash_pattern = evenDashes 1 }


errK :: a
errK = error "no picture"



-- Should these produce a DashPattern or a StrokeAttr?

evenDashes :: Int -> DashPattern 
evenDashes n = Dash 0 [(n,n)]

dashOffset :: Int -> DashPattern -> DashPattern
dashOffset _ Solid       = Solid
dashOffset n (Dash _ xs) = Dash n xs