Allow changing the thickness of dots

By achieving that we have introduced the DiagProp data type
which can be enhanced in the future.
This commit is contained in:
hasufell 2014-10-01 21:48:31 +02:00
parent 3c140832bc
commit 7f20f3ff5b
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 42 additions and 25 deletions

View File

@ -6,17 +6,24 @@ import Meshparser
import Util import Util
data DiagProp = MkProp {
-- |Get the thickness of the dot.
getThickness :: Double
}
-- |Create the Diagram from the VTable. -- |Create the Diagram from the VTable.
diagFromVTable :: VTable -> Diagram Cairo R2 diagFromVTable :: DiagProp -> VTable -> Diagram Cairo R2
diagFromVTable meshArr diagFromVTable prop meshArr
= position (zip (map mkPoint . filter (inRange 0 500) $ meshArr) = position (zip (map mkPoint . filter (inRange 0 500) $ meshArr)
(repeat dot)) # moveTo (p2(-250, -250)) (repeat dot)) # moveTo (p2(-250, -250))
`atop` square 500 # lwG 0.05 # bg white `atop` square 500 # lwG 0.05 # bg white
where dot = (circle 2 :: Diagram Cairo R2) # fc black where dot = (circle $ getThickness prop :: Diagram Cairo R2) # fc black
mkPoint (x,y) = p2 (x,y) mkPoint (x,y) = p2 (x,y)
-- |Create the Diagram from a String. -- |Create the Diagram from a String.
diagFromString :: String -> Diagram Cairo R2 diagFromString :: DiagProp -> String -> Diagram Cairo R2
diagFromString mesh = diagFromVTable . diagFromString prop mesh
= diagFromVTable prop .
meshToArr $ meshToArr $
mesh mesh

36
Gtk.hs
View File

@ -27,7 +27,8 @@ startGUI startFile = do
quitButton <- buttonNew quitButton <- buttonNew
box1 <- vBoxNew False 0 box1 <- vBoxNew False 0
box2 <- hButtonBoxNew box2 <- hButtonBoxNew
box3 <- hButtonBoxNew box3 <- hBoxNew False 0
hscale <- hScaleNewWithRange 0.0 10 0.5
drawButtonLabel <- labelNew $ Just "Draw" drawButtonLabel <- labelNew $ Just "Draw"
saveButtonLabel <- labelNew $ Just "Save" saveButtonLabel <- labelNew $ Just "Save"
quitButtonLabel <- labelNew $ Just "Quit" quitButtonLabel <- labelNew $ Just "Quit"
@ -43,22 +44,24 @@ startGUI startFile = do
boxPackStart box2 drawButton PackNatural 0 boxPackStart box2 drawButton PackNatural 0
boxPackStart box2 saveButton PackNatural 0 boxPackStart box2 saveButton PackNatural 0
boxPackStart box2 quitButton PackNatural 0 boxPackStart box2 quitButton PackNatural 0
boxPackStart box3 fileButton PackNatural 0 boxPackStart box3 fileButton PackGrow 5
boxPackStart box3 hscale PackGrow 5
-- adjust properties -- adjust properties
set window [windowDefaultWidth := 600, windowDefaultHeight := 700, set window [windowDefaultWidth := 600, windowDefaultHeight := 700,
windowTitle := "Computergrafik"] windowTitle := "Computergrafik"]
set box2 [buttonBoxLayoutStyle := ButtonboxCenter] set box2 [buttonBoxLayoutStyle := ButtonboxCenter]
set box3 [buttonBoxLayoutStyle := ButtonboxCenter]
_ <- windowSetTypeHint window WindowTypeHintDialog
containerSetBorderWidth box2 10 containerSetBorderWidth box2 10
_ <- windowSetTypeHint window WindowTypeHintDialog
_ <- fileChooserSetCurrentFolder fileButton homedir _ <- fileChooserSetCurrentFolder fileButton homedir
_ <- fileChooserSetFilename fileButton startFile _ <- fileChooserSetFilename fileButton startFile
adjustment <- rangeGetAdjustment hscale
_ <- adjustmentSetValue adjustment 2
-- callbacks -- callbacks
_ <- onDestroy window mainQuit _ <- onDestroy window mainQuit
_ <- onClicked drawButton $ onClickedDrawButton fileButton _ <- onClicked drawButton $ onClickedDrawButton fileButton
da da hscale
_ <- onClicked saveButton $ onClickedSaveButton fileButton _ <- onClicked saveButton $ onClickedSaveButton fileButton
_ <- onClicked quitButton mainQuit _ <- onClicked quitButton mainQuit
@ -74,22 +77,23 @@ startGUI startFile = do
_ <- window `on` keyPressEvent $ tryEvent $ do _ <- window `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier [Control] <- eventModifier
"d" <- eventKeyName "d" <- eventKeyName
liftIO $ onClickedDrawButton fileButton da liftIO $ onClickedDrawButton fileButton da hscale
-- draw widgets and start main loop -- draw widgets and start main loop
widgetShowAll window widgetShowAll window
mainGUI mainGUI
onClickedDrawButton :: WidgetClass widget onClickedDrawButton :: (WidgetClass widget, RangeClass scale)
=> FileChooserButton => FileChooserButton
-> widget -> widget
-> scale
-> IO () -> IO ()
onClickedDrawButton fcb da = do onClickedDrawButton fcb da scale' = do
filename <- fileChooserGetFilename fcb filename <- fileChooserGetFilename fcb
case filename of case filename of
Just x -> do Just x -> do
drawDiag' x da drawDiag' x da scale'
Nothing -> do Nothing -> do
showErrorDialog "No valid Mesh file!" showErrorDialog "No valid Mesh file!"
@ -116,17 +120,23 @@ showErrorDialog str = do
widgetDestroy errorDialog widgetDestroy errorDialog
drawDiag' :: WidgetClass widget => FilePath -> widget -> IO () drawDiag' :: (WidgetClass widget, RangeClass scale)
drawDiag' fp da = do => FilePath
-> widget
-> scale
-> IO ()
drawDiag' fp da scale' = do
mesh <- readFile fp mesh <- readFile fp
dw <- widgetGetDrawWindow da dw <- widgetGetDrawWindow da
adjustment <- rangeGetAdjustment scale'
scaleVal <- adjustmentGetValue adjustment
let (_, r) = renderDia Cairo let (_, r) = renderDia Cairo
(CairoOptions "" (Width 600) SVG False) (CairoOptions "" (Width 600) SVG False)
(diagFromString mesh) (diagFromString (MkProp scaleVal) mesh)
renderWithDrawable dw r renderWithDrawable dw r
saveDiag' :: FilePath -> IO () saveDiag' :: FilePath -> IO ()
saveDiag' fp = do saveDiag' fp = do
mesh <- readFile fp mesh <- readFile fp
renderCairo "out.svg" (Width 600) (diagFromString mesh) renderCairo "out.svg" (Width 600) (diagFromString (MkProp 2) mesh)