diff --git a/Diagram.hs b/Diagram.hs index 4d32bda..60a6fd1 100644 --- a/Diagram.hs +++ b/Diagram.hs @@ -6,17 +6,24 @@ import Meshparser import Util +data DiagProp = MkProp { + -- |Get the thickness of the dot. + getThickness :: Double +} + + -- |Create the Diagram from the VTable. -diagFromVTable :: VTable -> Diagram Cairo R2 -diagFromVTable meshArr +diagFromVTable :: DiagProp -> VTable -> Diagram Cairo R2 +diagFromVTable prop meshArr = position (zip (map mkPoint . filter (inRange 0 500) $ meshArr) (repeat dot)) # moveTo (p2(-250, -250)) `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) -- |Create the Diagram from a String. -diagFromString :: String -> Diagram Cairo R2 -diagFromString mesh = diagFromVTable . - meshToArr $ - mesh +diagFromString :: DiagProp -> String -> Diagram Cairo R2 +diagFromString prop mesh + = diagFromVTable prop . + meshToArr $ + mesh diff --git a/Gtk.hs b/Gtk.hs index a92d8e6..0965614 100644 --- a/Gtk.hs +++ b/Gtk.hs @@ -21,13 +21,14 @@ startGUI startFile = do window <- windowNew da <- drawingAreaNew fileButton <- fileChooserButtonNew "Select mesh" - FileChooserActionOpen + FileChooserActionOpen drawButton <- buttonNew saveButton <- buttonNew quitButton <- buttonNew - box1 <- vBoxNew False 0 - box2 <- hButtonBoxNew - box3 <- hButtonBoxNew + box1 <- vBoxNew False 0 + box2 <- hButtonBoxNew + box3 <- hBoxNew False 0 + hscale <- hScaleNewWithRange 0.0 10 0.5 drawButtonLabel <- labelNew $ Just "Draw" saveButtonLabel <- labelNew $ Just "Save" quitButtonLabel <- labelNew $ Just "Quit" @@ -43,22 +44,24 @@ startGUI startFile = do boxPackStart box2 drawButton PackNatural 0 boxPackStart box2 saveButton PackNatural 0 boxPackStart box2 quitButton PackNatural 0 - boxPackStart box3 fileButton PackNatural 0 + boxPackStart box3 fileButton PackGrow 5 + boxPackStart box3 hscale PackGrow 5 -- adjust properties set window [windowDefaultWidth := 600, windowDefaultHeight := 700, windowTitle := "Computergrafik"] set box2 [buttonBoxLayoutStyle := ButtonboxCenter] - set box3 [buttonBoxLayoutStyle := ButtonboxCenter] - _ <- windowSetTypeHint window WindowTypeHintDialog containerSetBorderWidth box2 10 + _ <- windowSetTypeHint window WindowTypeHintDialog _ <- fileChooserSetCurrentFolder fileButton homedir _ <- fileChooserSetFilename fileButton startFile + adjustment <- rangeGetAdjustment hscale + _ <- adjustmentSetValue adjustment 2 -- callbacks _ <- onDestroy window mainQuit _ <- onClicked drawButton $ onClickedDrawButton fileButton - da + da hscale _ <- onClicked saveButton $ onClickedSaveButton fileButton _ <- onClicked quitButton mainQuit @@ -74,22 +77,23 @@ startGUI startFile = do _ <- window `on` keyPressEvent $ tryEvent $ do [Control] <- eventModifier "d" <- eventKeyName - liftIO $ onClickedDrawButton fileButton da + liftIO $ onClickedDrawButton fileButton da hscale -- draw widgets and start main loop widgetShowAll window mainGUI -onClickedDrawButton :: WidgetClass widget +onClickedDrawButton :: (WidgetClass widget, RangeClass scale) => FileChooserButton -> widget + -> scale -> IO () -onClickedDrawButton fcb da = do +onClickedDrawButton fcb da scale' = do filename <- fileChooserGetFilename fcb case filename of Just x -> do - drawDiag' x da + drawDiag' x da scale' Nothing -> do showErrorDialog "No valid Mesh file!" @@ -116,17 +120,23 @@ showErrorDialog str = do widgetDestroy errorDialog -drawDiag' :: WidgetClass widget => FilePath -> widget -> IO () -drawDiag' fp da = do - mesh <- readFile fp - dw <- widgetGetDrawWindow da +drawDiag' :: (WidgetClass widget, RangeClass scale) + => FilePath + -> widget + -> scale + -> IO () +drawDiag' fp da scale' = do + mesh <- readFile fp + dw <- widgetGetDrawWindow da + adjustment <- rangeGetAdjustment scale' + scaleVal <- adjustmentGetValue adjustment let (_, r) = renderDia Cairo (CairoOptions "" (Width 600) SVG False) - (diagFromString mesh) + (diagFromString (MkProp scaleVal) mesh) renderWithDrawable dw r saveDiag' :: FilePath -> IO () saveDiag' fp = do mesh <- readFile fp - renderCairo "out.svg" (Width 600) (diagFromString mesh) + renderCairo "out.svg" (Width 600) (diagFromString (MkProp 2) mesh)