>import Text.ParserCombinators.Parsec hiding (label)
>import Text.ParserCombinators.Parsec.Char
>import Text.ParserCombinators.Parsec.Token hiding (lexeme, symbol,natural,reserved)
>import qualified Text.ParserCombinators.Parsec.Token as P
>import Text.ParserCombinators.Parsec.Language (emptyDef)
>import Text.ParserCombinators.Parsec.Error
>import Graphics.HGL hiding (Point,char)
>import Graphics.HGL.Draw.Picture
>import Graphics.HGL.Draw.Text
>import Control.Monad
>import Data.Either
-------------
The Type
Our topmost type is a graph. It has a title, two axes, and many curves.
>data Graph = Graph {title :: String,xaxis::Axis,yaxis::Axis,curves::[Curve]} deriving Show
For now an axis is just labeled with a name. In the future, the axis will have a size.
>data Axis = Axis {axisLab:: String} deriving Show
A curve is a collection of points. Connected tells us if we should draw the connecting line.
>data Curve = Curve { pts::[Point], connected::Bool} deriving Show
>type Point = (Int,Int)
-------------
The Lexer
Parsec does lexing and parsing simultaneously, but we still need to define the lexer. Our lexer just needs to throw away empty space and eat reserved words.
>lexer :: TokenParser ()
>lexer = makeTokenParser
> (emptyDef
> { reservedNames = ["newgraph","newcurve","label","title","connected"]})
These are just shortcuts to this lexer. You can think of lexer like an object. makeTokenParser is like new lexer() and P.natural lexer is like the method lexer.natural.
>lexeme = P.lexeme lexer
>natural =P.natural lexer
>symbol = P.symbol lexer
>reserved = P.reserved lexer
>stringLit = P.stringLiteral lexer
This one is a little more interesting. We eat a string and convert it to a boolean value.
>boolLit = do
> t<-stringLit > case t of
> "true"->return True
> "false"->return False
> _ -> fail "Not boolean"
------------
The Parser
Our grammar in BNF
Looks just like our types! Cool. First we introduce two helper functions-
The first just eats a reserved word and continues.
>label :: String -> Parser a -> Parser a
>label s p = do {reserved s; p}
Second one tries a parse, and if it fails, returns a default value.
>def :: a -> Parser a -> Parser a
>def d par = do {par <|> return d}
We start our parsing with points. The Point parser just reads in two natural numbers and returns a point.
>point :: Parser Point
>point = do
> a<-natural > b<-natural > return (fromInteger a, fromInteger b)
The rest of the parsers are remarkably similar. They all first read in their label, and then their subparts. The function many1 is equivalent to our + notation above, it means read at least one of the items. Similarly The function many is equivalent to *. Finally the function def is our ? operator, it means try to read one, if it fails just return the default value.
>curve :: Parser Curve
>curve = label "newcurve" $ do
> connected <- def False $ label "connected" boolLit > pts<-many1 point > return $ Curve {pts= pts,connected=connected}
>axis :: String -> Parser Axis
>axis s = label s $ do
> lab <- def "" $ label "label" stringLit > return $ Axis lab
>graph :: Parser Graph
>graph = label "newgraph" $ do
> title <- def "" $ label "title" stringLit > xaxis <- axis "xaxis" > yaxis <- axis "yaxis" > curves <- many curve > return $ Graph{title = title,xaxis=xaxis,yaxis=yaxis,curves=curves}
It is pretty neat how the BNF description and the Parser line up so nicely. This isn't always the case, but we had a prtty simple grammar to parse.
--------------
The Graphics
In JGraph we would draw out to a postscript file, but I'm not sure how to do that yet, so for now we just use HGL.
The program opens a window, draws the graph with the labels of the axes, a title, plots points, and possibly connects them .
Start with some constants.
>size = 300
>midH = size `div` 2
>midV = size `div` 2
>bot = size
>right = size
This is just boilerplate, it creates a window and displays a graphic in the window.
>createW :: Graphic -> IO()
>createW p = withWindow_ "HGraph" (right,bot) $ \w -> do
> drawInWindow w p
> getKey w
Our Drawing functions will look just like the parsing functions. We traverse the Graph structure drawing each part.
First we draw a point.
>drawPoint :: Point -> Graphic
>drawPoint (x,y)= ellipse (x-1,y-1) (x+1,y+1)
Now we draw a curve. A curve is just a series of points. transPts moves the pts from the graph position to the screen position, and then the first line draws them on the screen.
The second line connects the points together. We do this by zipping the points to the points shifted by one. i.e. if our points were [(1,2),(7,3),(4,6)] the code finds [(1,2),(7,3)] and [(7,3),(4,6)] and then runs line (1,2) (7,3), line (7,3) (4,6). I like this trick.
>drawCurve :: Curve -> Graphic
>drawCurve cur = do
> overGraphics $ map drawPoint transPts
> if connected cur then overGraphics $ zipWith line (init transPts) (tail transPts)
> else emptyGraphic
> where transPts = map (\(x,y)->(midH + x,midV - y)) (pts cur)
You might have noticed that we are taking
advantage of the fact that Graphic is a Monad (Yay!) which means we can draw in an imperative style.
For instance do {line (0,0) (1,1);line (0,1) (1,0)} will draw a cross. This is all that is going on an our last function . This just draws a bunch of things on the screen.
>drawGraph :: Graph -> Graphic
>drawGraph graph = do
> setTextAlignment (Center,Top)
> text (midH, 0) $ title graph
> axes
> overGraphics $ map drawCurve (curves graph)
> where axes = do line (midH,0) (midH,bot)
> text (midH,midV-midV `div` 2) $ axisLab $ yaxis graph
> line (0,midV) (right,midV)
> text (midH+midH `div` 2,midV) $ axisLab $ xaxis graph
>
--------------
Main
>main :: IO()
>main = do
> test <-readFile "test" > case parse graph "JGraph" test of
> Left v-> ioError $ userError $ show v
> Right g -> runGraphics $ createW $ drawGraph g
Here is a sample graph.
newgraph title "My Graph" xaxis label "blah2" yaxis label "blah" newcurve connected "true" 0 0 4 28 100 100 title "hello"
No comments:
Post a Comment