Allow specifying the diagram dimensions in the GUI

This commit is contained in:
hasufell 2014-10-05 18:41:41 +02:00
parent 6c677d55b8
commit 522ad2b452
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
3 changed files with 303 additions and 27 deletions

View File

@ -34,8 +34,7 @@ diagFromVTable prop vt
(repeat dot)) # moveTo (p2(xOffset, yOffset)) (repeat dot)) # moveTo (p2(xOffset, yOffset))
`atop` hrule (xuD - xlD) # centerX # moveTo (p2(0, yOffset)) `atop` hrule (xuD - xlD) # centerX # moveTo (p2(0, yOffset))
`atop` vrule (yuD - ylD) # centerY # moveTo (p2(xOffset, 0)) `atop` vrule (yuD - ylD) # centerY # moveTo (p2(xOffset, 0))
`atop` rect (xuD - xlD + 50) `atop` emptyRect (xuD - xlD + 50) (yuD - ylD + 50)
(yuD - ylD + 50) # lwG 0.00 # bg white
where dot = (circle $ where dot = (circle $
t prop :: Diagram Cairo R2) # fc black t prop :: Diagram Cairo R2) # fc black
mkPoint (x,y) = p2 (x,y) mkPoint (x,y) = p2 (x,y)
@ -57,3 +56,8 @@ diagFromString prop mesh
= diagFromVTable prop . = diagFromVTable prop .
meshToArr $ meshToArr $
mesh mesh
-- |Create a white rectangle with the given width and height.
emptyRect :: Double -> Double -> Diagram Cairo R2
emptyRect x y = rect x y # lwG 0.00 # bg white

89
Gtk.hs
View File

@ -34,6 +34,10 @@ makeGUI startFile = do
"filechooserButton" "filechooserButton"
da <- xmlGetWidget xml castToDrawingArea "drawingarea" da <- xmlGetWidget xml castToDrawingArea "drawingarea"
hscale <- xmlGetWidget xml castToHScale "hscale" hscale <- xmlGetWidget xml castToHScale "hscale"
xlDE <- xmlGetWidget xml castToEntry "xlD"
xlUE <- xmlGetWidget xml castToEntry "xlU"
ylDE <- xmlGetWidget xml castToEntry "ylD"
ylUE <- xmlGetWidget xml castToEntry "ylU"
-- adjust properties -- adjust properties
if startFile == "" if startFile == ""
@ -47,8 +51,9 @@ makeGUI startFile = do
-- callbacks -- callbacks
_ <- onDestroy window mainQuit _ <- onDestroy window mainQuit
_ <- onClicked drawButton $ onClickedDrawButton fileButton _ <- onClicked drawButton $ onClickedDrawButton fileButton
da hscale da hscale (xlDE, xlUE) (ylDE, ylUE)
_ <- onClicked saveButton $ onClickedSaveButton fileButton _ <- onClicked saveButton $ onClickedSaveButton fileButton
hscale (xlDE, xlUE) (ylDE, ylUE)
_ <- onClicked quitButton mainQuit _ <- onClicked quitButton mainQuit
-- hotkeys -- hotkeys
@ -60,10 +65,12 @@ makeGUI startFile = do
[Control] <- eventModifier [Control] <- eventModifier
"s" <- eventKeyName "s" <- eventKeyName
liftIO $ onClickedSaveButton fileButton liftIO $ onClickedSaveButton fileButton
hscale (xlDE, xlUE) (ylDE, ylUE)
_ <- window `on` keyPressEvent $ tryEvent $ do _ <- window `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier [Control] <- eventModifier
"d" <- eventKeyName "d" <- eventKeyName
liftIO $ onClickedDrawButton fileButton da hscale liftIO $ onClickedDrawButton fileButton da hscale
(xlDE, xlUE) (ylDE, ylUE)
-- draw widgets and start main loop -- draw widgets and start main loop
widgetShowAll window widgetShowAll window
@ -75,26 +82,32 @@ onClickedDrawButton :: (WidgetClass widget, RangeClass scale)
=> FileChooserButton => FileChooserButton
-> widget -> widget
-> scale -> scale
-> (Entry, Entry)
-> (Entry, Entry)
-> IO () -> IO ()
onClickedDrawButton fcb da scale' = do onClickedDrawButton fcb da scale' dXE dYE = do
filename <- fileChooserGetFilename fcb filename <- fileChooserGetFilename fcb
case filename of case filename of
Just x -> do Just x -> do
cId <- onExpose da (\_ -> drawDiag' x da scale') cId <- onExpose da (\_ -> drawDiag' x da scale' dXE dYE)
_ <- on fcb fileActivated (signalDisconnect cId) _ <- on fcb fileActivated (signalDisconnect cId)
ret <- drawDiag' x da scale' ret <- drawDiag' x da scale' dXE dYE
unless ret $ showErrorDialog "No valid Mesh file!" unless ret $ showErrorDialog "No valid Mesh file!"
Nothing -> showErrorDialog "No valid Mesh file!" Nothing -> showErrorDialog "No valid Mesh file!"
-- |Callback when the "Save" Button is clicked. -- |Callback when the "Save" Button is clicked.
onClickedSaveButton :: FileChooserButton onClickedSaveButton :: RangeClass scale
=> FileChooserButton
-> scale
-> (Entry, Entry)
-> (Entry, Entry)
-> IO () -> IO ()
onClickedSaveButton fcb = do onClickedSaveButton fcb scale' dXE dYE = do
filename <- fileChooserGetFilename fcb filename <- fileChooserGetFilename fcb
case filename of case filename of
Just x -> do Just x -> do
ret <- saveDiag' x ret <- saveDiag' x scale' dXE dYE
unless ret $ showErrorDialog "No valid Mesh file!" unless ret $ showErrorDialog "No valid Mesh file!"
Nothing -> showErrorDialog "No valid Mesh file!" Nothing -> showErrorDialog "No valid Mesh file!"
@ -117,28 +130,74 @@ drawDiag' :: (WidgetClass widget, RangeClass scale)
=> FilePath => FilePath
-> widget -> widget
-> scale -> scale
-> (Entry, Entry)
-> (Entry, Entry)
-> IO Bool -> IO Bool
drawDiag' fp da scale' = drawDiag' fp da scale' dXE dYE =
if cmpExt "obj" fp if cmpExt "obj" fp
then do then do
mesh <- readFile fp mesh <- readFile fp
dw <- widgetGetDrawWindow da dw <- widgetGetDrawWindow da
adjustment <- rangeGetAdjustment scale' adjustment <- rangeGetAdjustment scale'
scaleVal <- adjustmentGetValue adjustment scaleVal <- adjustmentGetValue adjustment
let (_, r) = renderDia Cairo xlD <- entryGetText $ fst dXE
xlU <- entryGetText $ snd dXE
ylD <- entryGetText $ fst dYE
ylU <- entryGetText $ snd dYE
-- clear drawing area
clearDiag da
let xD = (read xlD, read xlU) :: (Double, Double)
yD = (read ylD, read ylU) :: (Double, Double)
(_, r) = renderDia Cairo
(CairoOptions "" (Width 600) SVG False) (CairoOptions "" (Width 600) SVG False)
(diagFromString (def{t = scaleVal}) mesh) (diagFromString (def{t = scaleVal,
dX = xD,
dY = yD})
mesh)
renderWithDrawable dw r renderWithDrawable dw r
return True return True
else return False else return False
-- |Saves a Diagram which is built from a given file as an SVG. -- |Saves a Diagram which is built from a given file as an SVG.
saveDiag' :: FilePath -> IO Bool saveDiag' :: RangeClass scale
saveDiag' fp = => FilePath
-> scale
-> (Entry, Entry)
-> (Entry, Entry)
-> IO Bool
saveDiag' fp scale' dXE dYE =
if cmpExt "obj" fp if cmpExt "obj" fp
then do then do
mesh <- readFile fp mesh <- readFile fp
renderCairo "out.svg" (Width 600) (diagFromString def mesh) adjustment <- rangeGetAdjustment scale'
scaleVal <- adjustmentGetValue adjustment
xlD <- entryGetText $ fst dXE
xlU <- entryGetText $ snd dXE
ylD <- entryGetText $ fst dYE
ylU <- entryGetText $ snd dYE
let xD = (read xlD, read xlU) :: (Double, Double)
yD = (read ylD, read ylU) :: (Double, Double)
renderCairo "out.svg" (Width 600)
(diagFromString (def{t = scaleVal,
dX = xD,
dY = yD})
mesh)
return True return True
else return False else return False
-- |Clears the drawing area by painting a white rectangle.
clearDiag :: WidgetClass widget
=> widget
-> IO ()
clearDiag da = do
dw <- widgetGetDrawWindow da
let (_, r) = renderDia Cairo
(CairoOptions "" (Width 600) SVG False)
(emptyRect 600 600)
renderWithDrawable dw r

View File

@ -11,6 +11,18 @@
<widget class="GtkVBox" id="vbox1"> <widget class="GtkVBox" id="vbox1">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<child>
<widget class="GtkFileChooserButton" id="filechooserButton">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="create_folders">False</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child> <child>
<widget class="GtkDrawingArea" id="drawingarea"> <widget class="GtkDrawingArea" id="drawingarea">
<property name="width_request">600</property> <property name="width_request">600</property>
@ -21,7 +33,7 @@
<packing> <packing>
<property name="expand">True</property> <property name="expand">True</property>
<property name="fill">True</property> <property name="fill">True</property>
<property name="position">0</property> <property name="position">1</property>
</packing> </packing>
</child> </child>
<child> <child>
@ -71,7 +83,7 @@
<packing> <packing>
<property name="expand">False</property> <property name="expand">False</property>
<property name="fill">False</property> <property name="fill">False</property>
<property name="position">1</property> <property name="position">2</property>
</packing> </packing>
</child> </child>
<child> <child>
@ -79,10 +91,93 @@
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<child> <child>
<widget class="GtkFileChooserButton" id="filechooserButton"> <widget class="GtkHBox" id="hbox3">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<property name="create_folders">False</property> <child>
<widget class="GtkVBox" id="vbox2">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<widget class="GtkLabel" id="label1">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="label" translatable="yes">X min</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<widget class="GtkEntry" id="xlD">
<property name="width_request">5</property>
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="invisible_char">●</property>
<property name="text" translatable="yes">0</property>
<property name="invisible_char_set">True</property>
<property name="primary_icon_activatable">False</property>
<property name="secondary_icon_activatable">False</property>
<property name="primary_icon_sensitive">True</property>
<property name="secondary_icon_sensitive">True</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<widget class="GtkVBox" id="vbox3">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<widget class="GtkLabel" id="label2">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="label" translatable="yes">X max</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<widget class="GtkEntry" id="xlU">
<property name="width_request">5</property>
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="invisible_char">●</property>
<property name="text" translatable="yes">500</property>
<property name="invisible_char_set">True</property>
<property name="primary_icon_activatable">False</property>
<property name="secondary_icon_activatable">False</property>
<property name="primary_icon_sensitive">True</property>
<property name="secondary_icon_sensitive">True</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
</widget> </widget>
<packing> <packing>
<property name="expand">True</property> <property name="expand">True</property>
@ -91,12 +186,93 @@
</packing> </packing>
</child> </child>
<child> <child>
<widget class="GtkHScale" id="hscale"> <widget class="GtkHBox" id="hbox4">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">True</property> <property name="can_focus">False</property>
<property name="adjustment">1 0.10000000000000001 10 0.5 0.5 0</property> <child>
<property name="round_digits">1</property> <widget class="GtkVBox" id="vbox4">
<property name="value_pos">left</property> <property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<widget class="GtkLabel" id="label3">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="label" translatable="yes">Y min</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<widget class="GtkEntry" id="ylD">
<property name="width_request">5</property>
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="invisible_char">●</property>
<property name="text" translatable="yes">0</property>
<property name="invisible_char_set">True</property>
<property name="primary_icon_activatable">False</property>
<property name="secondary_icon_activatable">False</property>
<property name="primary_icon_sensitive">True</property>
<property name="secondary_icon_sensitive">True</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<widget class="GtkVBox" id="vbox5">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<widget class="GtkLabel" id="label4">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="label" translatable="yes">Y max</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<widget class="GtkEntry" id="ylU">
<property name="width_request">5</property>
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="invisible_char">●</property>
<property name="text" translatable="yes">500</property>
<property name="invisible_char_set">True</property>
<property name="primary_icon_activatable">False</property>
<property name="secondary_icon_activatable">False</property>
<property name="primary_icon_sensitive">True</property>
<property name="secondary_icon_sensitive">True</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
</widget> </widget>
<packing> <packing>
<property name="expand">True</property> <property name="expand">True</property>
@ -104,11 +280,48 @@
<property name="position">1</property> <property name="position">1</property>
</packing> </packing>
</child> </child>
<child>
<widget class="GtkVBox" id="vbox6">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<widget class="GtkLabel" id="label5">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="label" translatable="yes">point thickness</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<widget class="GtkHScale" id="hscale">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="adjustment">1 0.10000000000000001 10 0.5 0.5 0</property>
<property name="round_digits">1</property>
<property name="value_pos">left</property>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">2</property>
</packing>
</child>
</widget> </widget>
<packing> <packing>
<property name="expand">False</property> <property name="expand">False</property>
<property name="fill">False</property> <property name="fill">False</property>
<property name="position">2</property> <property name="position">3</property>
</packing> </packing>
</child> </child>
</widget> </widget>