wumpus-drawing-0.2.0: demo/SingleLine.hs

{-# OPTIONS -Wall #-}


module SingleLine where

import FontLoaderUtils

import Wumpus.Drawing.Colour.SVGColours
import Wumpus.Drawing.Text.LRText
import Wumpus.Drawing.Text.SafeFonts

import Wumpus.Basic.Kernel                      -- package: wumpus-basic
import Wumpus.Basic.System.FontLoader.Afm
import Wumpus.Basic.System.FontLoader.GhostScript

import Wumpus.Core                              -- package: wumpus-core

import System.Directory


main :: IO ()
main = do 
    (mb_gs, mb_afm) <- processCmdLine default_font_loader_help
    createDirectoryIfMissing True "./out/"
    maybe gs_failk  makeGSPicture  $ mb_gs
    maybe afm_failk makeAfmPicture $ mb_afm
  where
    gs_failk  = putStrLn "No GhostScript font path supplied..."
    afm_failk = putStrLn "No AFM v4.1 font path supplied..."


makeGSPicture :: FilePath -> IO ()
makeGSPicture font_dir = do
    putStrLn "Using GhostScript metrics..."
    (gs_metrics, msgs) <- loadGSMetrics font_dir ["Helvetica"]
    mapM_ putStrLn msgs
    let pic1 = runCtxPictureU (makeCtx gs_metrics) drawing01
    writeEPS "./out/single_line01.eps" pic1
    writeSVG "./out/single_line01.svg" pic1

makeAfmPicture :: FilePath -> IO ()
makeAfmPicture font_dir = do
    putStrLn "Using AFM 4.1 metrics..."
    (afm_metrics, msgs) <- loadAfmMetrics font_dir ["Helvetica"]
    mapM_ putStrLn msgs
    let pic2 = runCtxPictureU (makeCtx afm_metrics) drawing01
    writeEPS "./out/single_line02.eps" pic2
    writeSVG "./out/single_line02.svg" pic2



makeCtx :: GlyphMetrics -> DrawingContext
makeCtx = fontFace helvetica . metricsContext 12



drawing01 :: DCtxPicture
drawing01 = drawTracing $ localize (fillColour red) $ mf 


mf :: (Real u, Floating u, FromPtSize u) => TraceDrawing u ()
mf = do
    draw $ testDraw NN `at` (P2   0 200)
    draw $ testDraw SS `at` (P2  75 200)
    draw $ testDraw EE `at` (P2 150 200)
    draw $ testDraw WW `at` (P2 225 200)
    draw $ testDraw NE `at` (P2   0 100)
    draw $ testDraw SE `at` (P2  75 100)
    draw $ testDraw SW `at` (P2 150 100)
    draw $ testDraw NW `at` (P2 225 100)
    draw $ testDraw CENTER    `at` (P2   0 0)
    

testDraw :: (Real u, Floating u, FromPtSize u) => RectPosition -> LocGraphic u
testDraw rpos = filledDisk 2 `oplus` (ignoreAns ans)
  where
    ans = singleLine "Qwerty" `startPos` rpos