Allow choosing convex hull algorithm

This is still a no-op.
This commit is contained in:
hasufell 2014-10-08 16:35:19 +02:00
parent 09ac8dd440
commit bb0b0a951b
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 12 additions and 7 deletions

8
Gtk.hs
View File

@ -191,6 +191,7 @@ drawDiag' fp mygui =
xuD' <- entryGetText (xu mygui) xuD' <- entryGetText (xu mygui)
ylD' <- entryGetText (yl mygui) ylD' <- entryGetText (yl mygui)
yuD' <- entryGetText (yu mygui) yuD' <- entryGetText (yu mygui)
alg' <- comboBoxGetActive (cB mygui)
-- clear drawing area -- clear drawing area
clearDiag mygui clearDiag mygui
@ -205,7 +206,8 @@ drawDiag' fp mygui =
(CairoOptions "" (Width 600) SVG False) (CairoOptions "" (Width 600) SVG False)
(diagS (def{t = scaleVal, (diagS (def{t = scaleVal,
dX = xD', dX = xD',
dY = yD'}) dY = yD',
alg = alg'})
mesh) mesh)
renderWithDrawable dw r renderWithDrawable dw r
return 0 return 0
@ -228,6 +230,7 @@ saveDiag' fp mygui =
xuD' <- entryGetText (xu mygui) xuD' <- entryGetText (xu mygui)
ylD' <- entryGetText (yl mygui) ylD' <- entryGetText (yl mygui)
yuD' <- entryGetText (yu mygui) yuD' <- entryGetText (yu mygui)
alg' <- comboBoxGetActive (cB mygui)
let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double, let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double,
Double) Double)
@ -238,7 +241,8 @@ saveDiag' fp mygui =
renderCairo "out.svg" (Width 600) renderCairo "out.svg" (Width 600)
(diagS (def{t = scaleVal, (diagS (def{t = scaleVal,
dX = xD', dX = xD',
dY = yD'}) dY = yD',
alg = alg'})
mesh) mesh)
return 0 return 0
_ -> return 1 _ -> return 1

View File

@ -702,7 +702,8 @@ Malte Flender &lt;malte.flender@fh-bielefeld.de&gt;</property>
<widget class="GtkComboBox" id="comboalgo"> <widget class="GtkComboBox" id="comboalgo">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<property name="items" translatable="yes">Show points</property> <property name="items" translatable="yes">Show points
Show convex hull</property>
</widget> </widget>
<packing> <packing>
<property name="expand">False</property> <property name="expand">False</property>