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))
`atop` hrule (xuD - xlD) # centerX # moveTo (p2(0, yOffset))
`atop` vrule (yuD - ylD) # centerY # moveTo (p2(xOffset, 0))
`atop` rect (xuD - xlD + 50)
(yuD - ylD + 50) # lwG 0.00 # bg white
`atop` emptyRect (xuD - xlD + 50) (yuD - ylD + 50)
where dot = (circle $
t prop :: Diagram Cairo R2) # fc black
mkPoint (x,y) = p2 (x,y)
@ -57,3 +56,8 @@ diagFromString prop mesh
= diagFromVTable prop .
meshToArr $
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

85
Gtk.hs
View File

@ -34,6 +34,10 @@ makeGUI startFile = do
"filechooserButton"
da <- xmlGetWidget xml castToDrawingArea "drawingarea"
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
if startFile == ""
@ -47,8 +51,9 @@ makeGUI startFile = do
-- callbacks
_ <- onDestroy window mainQuit
_ <- onClicked drawButton $ onClickedDrawButton fileButton
da hscale
da hscale (xlDE, xlUE) (ylDE, ylUE)
_ <- onClicked saveButton $ onClickedSaveButton fileButton
hscale (xlDE, xlUE) (ylDE, ylUE)
_ <- onClicked quitButton mainQuit
-- hotkeys
@ -60,10 +65,12 @@ makeGUI startFile = do
[Control] <- eventModifier
"s" <- eventKeyName
liftIO $ onClickedSaveButton fileButton
hscale (xlDE, xlUE) (ylDE, ylUE)
_ <- window `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"d" <- eventKeyName
liftIO $ onClickedDrawButton fileButton da hscale
(xlDE, xlUE) (ylDE, ylUE)
-- draw widgets and start main loop
widgetShowAll window
@ -75,26 +82,32 @@ onClickedDrawButton :: (WidgetClass widget, RangeClass scale)
=> FileChooserButton
-> widget
-> scale
-> (Entry, Entry)
-> (Entry, Entry)
-> IO ()
onClickedDrawButton fcb da scale' = do
onClickedDrawButton fcb da scale' dXE dYE = do
filename <- fileChooserGetFilename fcb
case filename of
Just x -> do
cId <- onExpose da (\_ -> drawDiag' x da scale')
cId <- onExpose da (\_ -> drawDiag' x da scale' dXE dYE)
_ <- on fcb fileActivated (signalDisconnect cId)
ret <- drawDiag' x da scale'
ret <- drawDiag' x da scale' dXE dYE
unless ret $ showErrorDialog "No valid Mesh file!"
Nothing -> showErrorDialog "No valid Mesh file!"
-- |Callback when the "Save" Button is clicked.
onClickedSaveButton :: FileChooserButton
onClickedSaveButton :: RangeClass scale
=> FileChooserButton
-> scale
-> (Entry, Entry)
-> (Entry, Entry)
-> IO ()
onClickedSaveButton fcb = do
onClickedSaveButton fcb scale' dXE dYE = do
filename <- fileChooserGetFilename fcb
case filename of
Just x -> do
ret <- saveDiag' x
ret <- saveDiag' x scale' dXE dYE
unless ret $ showErrorDialog "No valid Mesh file!"
Nothing -> showErrorDialog "No valid Mesh file!"
@ -117,28 +130,74 @@ drawDiag' :: (WidgetClass widget, RangeClass scale)
=> FilePath
-> widget
-> scale
-> (Entry, Entry)
-> (Entry, Entry)
-> IO Bool
drawDiag' fp da scale' =
drawDiag' fp da scale' dXE dYE =
if cmpExt "obj" fp
then do
mesh <- readFile fp
dw <- widgetGetDrawWindow da
adjustment <- rangeGetAdjustment scale'
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)
(diagFromString (def{t = scaleVal}) mesh)
(diagFromString (def{t = scaleVal,
dX = xD,
dY = yD})
mesh)
renderWithDrawable dw r
return True
else return False
-- |Saves a Diagram which is built from a given file as an SVG.
saveDiag' :: FilePath -> IO Bool
saveDiag' fp =
saveDiag' :: RangeClass scale
=> FilePath
-> scale
-> (Entry, Entry)
-> (Entry, Entry)
-> IO Bool
saveDiag' fp scale' dXE dYE =
if cmpExt "obj" fp
then do
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
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">
<property name="visible">True</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>
<widget class="GtkDrawingArea" id="drawingarea">
<property name="width_request">600</property>
@ -21,7 +33,7 @@
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
<property name="position">1</property>
</packing>
</child>
<child>
@ -71,7 +83,7 @@
<packing>
<property name="expand">False</property>
<property name="fill">False</property>
<property name="position">1</property>
<property name="position">2</property>
</packing>
</child>
<child>
@ -79,10 +91,204 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<widget class="GtkFileChooserButton" id="filechooserButton">
<widget class="GtkHBox" id="hbox3">
<property name="visible">True</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>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<widget class="GtkHBox" id="hbox4">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<widget class="GtkVBox" id="vbox4">
<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>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</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>
@ -105,10 +311,17 @@
</packing>
</child>
</widget>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">2</property>
</packing>
</child>
</widget>
<packing>
<property name="expand">False</property>
<property name="fill">False</property>
<property name="position">2</property>
<property name="position">3</property>
</packing>
</child>
</widget>