diff --git a/AERN-RnToRm-Plot.cabal b/AERN-RnToRm-Plot.cabal
--- a/AERN-RnToRm-Plot.cabal
+++ b/AERN-RnToRm-Plot.cabal
@@ -1,12 +1,13 @@
Name: AERN-RnToRm-Plot
-Version: 0.1.2
+Version: 0.2
Cabal-Version: >= 1.2
Build-Type: Simple
License: BSD3
License-File: LICENCE
Author: Michal Konecny (Aston University)
-Copyright: (c) 2007-2008 Michal Konecny
-Maintainer: mik@konecny.aow.cz
+Copyright: (c) 2007-2009 Michal Konecny
+Maintainer: mikkonecny@gmail.com
+Homepage: http://www-users.aston.ac.uk/~konecnym/DISCERN
Stability: experimental
Category: Data, Math
Synopsis: GL plotting of polynomial function enclosures (PFEs)
@@ -17,14 +18,13 @@
.
Simple examples of usage can be found in module @Demo.hs@ in folder @tests@.
Extra-source-files:
- tests/Demo.hs tests/FnView.glade src/FnView.glade
-Data-files:
+ demos/Demo.hs demos/FnView.glade src/FnView.glade
ChangeLog README.glade
Library
hs-source-dirs: src
Build-Depends:
- base >= 3, base < 4, containers, binary >= 0.4, directory, filepath, time, stm,
+ base >= 3, base < 4, containers, binary >= 0.4, directory, filepath, time, stm, mtl,
AERN-Real >= 0.9.9, AERN-RnToRm >= 0.4.9,
OpenGL >= 2.2.1.1, GLUT >= 2.1.1.1,
gtk >= 0.10.0, gtkglext >= 0.10.0, glib >= 0.10.0, glade >= 0.10.0
diff --git a/ChangeLog b/ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,5 @@
+0.2: 29 July 2009
+ * enabled mouse zooming and panning in the GL canvas
0.1.2: 23 February 2009
* rewrote the formerly complex and sometimes incorrect
code that assigns inspected values to dimension labels
diff --git a/demos/Demo.hs b/demos/Demo.hs
new file mode 100644
--- /dev/null
+++ b/demos/Demo.hs
@@ -0,0 +1,124 @@
+module Main where
+
+import qualified Data.Number.ER.Real as AERN
+import qualified Data.Number.ER.RnToRm as AERNFunc
+import qualified Data.Number.ER.RnToRm.Plot.FnView as FNV
+
+import Control.Concurrent as Concurrent
+import Control.Concurrent.STM as STM
+
+import qualified Graphics.UI.Gtk as Gtk
+import Graphics.UI.Gtk (AttrOp((:=)))
+import qualified Graphics.UI.Gtk.Glade as Glade
+import qualified Graphics.UI.Gtk.OpenGL as GtkGL
+import qualified Graphics.UI.GLUT as GLUT
+
+type B = AERN.BM
+--type B = AERN.BMPFR
+type RA = AERN.RA B
+type IRA = AERN.IRA B
+type FA = AERNFunc.FAPWP B
+type Box a = AERNFunc.Box a
+type VarID = AERNFunc.VarID
+
+main =
+ do
+ AERN.initialiseBaseArithmetic (0 :: RA)
+ initGtkGL
+ fadataTV <- newTVarIO faData
+ fndataTV <- newTVarIO FNV.defaultFnData
+ fnviewWindow <- FNV.new (fadataTV, fndataTV) Nothing
+ forkIO $ signalData fndataTV
+ Gtk.mainGUI
+
+faData =
+ FNV.defaultFaData
+ {
+ FNV.dataFAs = [f1,f2]
+ }
+
+f1 = AERNFunc.tuple [f11,f12,f13]
+f2 = AERNFunc.tuple [f21,f22,f23]
+
+ix1 = 6
+ix2 = 12
+ix3 = 18
+
+g = AERNFunc.scale 10 x
+f11 = AERN.cos ix1 $ g -- cos(10x)
+f12 = AERN.cos ix2 $ g -- cos(10x)
+f13 = AERN.cos ix3 $ g -- cos(10x)
+
+f21 = AERNFunc.integrateUnary 3 f11 dom 0 [-1] -- integ(cos(10x)) - 1
+f22 = AERNFunc.integrateUnary 3 f12 dom 0 [-1] -- integ(cos(10x)) - 1
+f23 = AERNFunc.integrateUnary 3 f13 dom 0 [-1] -- integ(cos(10x)) - 1
+
+
+x :: FA
+x =
+ AERNFunc.bisectUnbisectDepth 5 $
+ AERNFunc.setMaxDegree 3 $
+ AERNFunc.proj xdom 0
+
+xdom = AERNFunc.fromAscList [(0, dom)]
+
+const01 :: FA
+const01 =
+ AERNFunc.const xdom [0 AERN.\/ 1]
+
+dom = domL AERN.\/ domR
+(domL, domR) = (-1, 1)
+(valLO, valHI) = (-2,2)
+
+fnData =
+ setExtents domL domR valLO valHI $
+ FNV.defaultFnData
+ {
+ FNV.dataFAsUpdated = True,
+ FNV.dataDomName = "x",
+ FNV.dataFnNames = ["f1","f2"],
+ FNV.dataResultNames = [["f11", "f12", "f13"],["f21", "f22", "f23"]],
+ FNV.dataDefaultEvalPoint = 0
+ }
+
+setExtents left right bot top fnData =
+ fnData
+ {
+ FNV.dataDomL = td left,
+ FNV.dataDomR = td right,
+ FNV.dataValLO = td bot,
+ FNV.dataValHI = td top,
+ FNV.dataDefaultPlotParams =
+ FNV.defaultPlotParams
+ {
+ FNV.pltprmCoordSystem =
+ FNV.CoordSystemLinear $
+ FNV.Rectangle
+ (tr $ top + 0.1)
+ (tr $ bot - 0.1)
+ (tr $ left - 0.1)
+ (tr $ right + 0.1)
+ }
+ }
+ where
+ tr = toRational . td
+ td = fst . AERN.doubleBounds
+
+initGtkGL =
+ do
+ Gtk.initGUI
+ -- enable multithreaded GUI:
+ Gtk.timeoutAddFull
+ (Concurrent.yield >> Concurrent.yield >> Concurrent.yield >> return True)
+ Gtk.priorityDefaultIdle 20
+ -- see http://haskell.org/gtk2hs/archives/2005/07/24/writing-multi-threaded-guis/
+ GtkGL.initGL
+ GLUT.initialize "AERN Function View" [] -- needed for text in GL canvas
+
+signalData fndataTV =
+ do
+ threadDelay 200000 -- 0.2s
+ atomically $
+ do
+ writeTVar fndataTV fnData
+
diff --git a/demos/FnView.glade b/demos/FnView.glade
new file mode 100644
--- /dev/null
+++ b/demos/FnView.glade
@@ -0,0 +1,466 @@
+
+
+
+
+
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 0
+ GTK_SHADOW_ETCHED_OUT
+
+
+ 500
+ 500
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 12
+
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ plot
+
+
+ label_item
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 0
+ GTK_SHADOW_ETCHED_OUT
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 12
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ log + squeeze
+linear
+
+
+
+
+ True
+
+
+
+
+
+ 1
+
+
+
+
+ True
+
+
+
+
+
+ 2
+
+
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ coord system
+ True
+
+
+ label_item
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 0
+ GTK_SHADOW_ETCHED_OUT
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 12
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 4
+ 1
+
+
+
+
+
+ True
+ True
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ set to defaults
+ 0
+
+
+ GTK_FILL
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 0
+ zoom=
+
+
+ False
+
+
+
+
+ True
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 5
+ True
+
+
+ False
+ False
+ 1
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ %
+
+
+ False
+ 2
+
+
+
+
+ 1
+ 2
+ GTK_FILL
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 2
+ 3
+
+
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 0
+ centre x=
+
+
+ GTK_FILL
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 0
+ centre y=
+
+
+ 1
+ 2
+ GTK_FILL
+
+
+
+
+ True
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 5
+
+
+ 1
+ 2
+ GTK_FILL
+
+
+
+
+ True
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 5
+
+
+ 1
+ 2
+ 1
+ 2
+ GTK_FILL
+
+
+
+
+ 2
+ 3
+ GTK_FILL
+
+
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ zoom/pan
+ True
+
+
+ label_item
+
+
+
+
+ 1
+
+
+
+
+ 1
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ True
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ default
+ 0
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ ==
+
+
+ 1
+
+
+
+
+ True
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ 2
+
+
+
+
+ False
+ 2
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ GTK_RESIZE_IMMEDIATE
+ 4
+ 3
+ 1
+ 5
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ False
+ 2
+ 1
+
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 0
+ GTK_SHADOW_ETCHED_OUT
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ 12
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+
+
+ True
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ jpg
+ 0
+
+
+
+
+ True
+ True
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ txt
+ 0
+
+
+ 1
+
+
+
+
+ True
+
+
+
+
+
+ 2
+
+
+
+
+
+
+
+
+ True
+ GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
+ export functions
+ True
+
+
+ label_item
+
+
+
+
+ False
+ GTK_PACK_END
+ 3
+
+
+
+
+ 1
+
+
+
+
+
+
diff --git a/src/Data/Number/ER/RnToRm/Plot/FnView.hs b/src/Data/Number/ER/RnToRm/Plot/FnView.hs
--- a/src/Data/Number/ER/RnToRm/Plot/FnView.hs
+++ b/src/Data/Number/ER/RnToRm/Plot/FnView.hs
@@ -4,7 +4,7 @@
#define GLADE_DIR "./"
#endif
{-|
- Module : Data.Number.ER.RnToRm.Plot.FAView
+ Module : Data.Number.ER.RnToRm.Plot.FnView
Description : plot function enclosures on GL canvas
Copyright : (c) 2007-2008 Michal Konecny
License : BSD3
@@ -34,24 +34,26 @@
import Data.Number.ER.RnToRm.Plot.Params
import qualified Data.Number.ER.Real.Approx as RA
import qualified Data.Number.ER.RnToRm.Approx as FA
-import qualified Data.Number.ER.Real.DomainBox as DBox
+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox
import Data.Number.ER.RnToRm.Plot.GLDrawable
import Data.Number.ER.BasicTypes
import Data.Number.ER.Misc
import qualified Graphics.UI.Gtk as Gtk
+import qualified Graphics.UI.Gtk.Gdk.EventM as GdkEv
import Graphics.UI.Gtk (AttrOp((:=)))
import qualified Graphics.UI.Gtk.Glade as Glade
import qualified Graphics.UI.Gtk.OpenGL as GtkGL
-import qualified Graphics.UI.GLUT as GLUT
import qualified System.Glib.Signals as Signals
+--import qualified Graphics.UI.GLUT as GLUT
+--import qualified Graphics.Rendering.FTGL as FTGL
import qualified Graphics.Rendering.OpenGL as GL
import Graphics.Rendering.OpenGL (HasSetter(($=)))
import Control.Concurrent as Concurrent
import Control.Concurrent.STM as STM
-import Data.Number.ER.MiscSTM
+import Data.Number.ER.Misc.STM
import Data.IORef
import Data.Maybe
@@ -59,6 +61,10 @@
import qualified System.FilePath as FilePath
import System.Directory
+import Control.Monad.Reader.Class
+import Control.Monad.Trans
+import Foreign.Storable
+
{-|
Two transactional variables with values of the following two types
will be used by the client(s) to communicate to the viewer what it
@@ -111,6 +117,10 @@
dataDefaultPlotParams = defaultPlotParams
}
+getFnExtents fndata =
+ (dataValHI fndata, dataValLO fndata,
+ dataDomL fndata, dataDomR fndata)
+
readBothTVars ::
(TVar a, TVar a1) ->
STM (a, a1)
@@ -181,6 +191,7 @@
dimTable <- Glade.xmlGetWidget xml Gtk.castToTable "dimTable1"
domVarLabel <- Glade.xmlGetWidget xml Gtk.castToLabel "domVarLabel1"
zoomEntry <- Glade.xmlGetWidget xml Gtk.castToEntry "zoomEntry1"
+ defaultZoomPanButton <- Glade.xmlGetWidget xml Gtk.castToButton "defaultZoomPanButton1"
centreXEntry <- Glade.xmlGetWidget xml Gtk.castToEntry "centreXEntry1"
centreYEntry <- Glade.xmlGetWidget xml Gtk.castToEntry "centreYEntry1"
exportJPGButton <- Glade.xmlGetWidget xml Gtk.castToButton "exportJPGButton1"
@@ -195,6 +206,7 @@
dimTable = dimTable,
domVarLabel = domVarLabel,
zoomEntry = zoomEntry,
+ defaultZoomPanButton = defaultZoomPanButton,
centreXEntry = centreXEntry,
centreYEntry = centreYEntry,
exportJPGButton = exportJPGButton,
@@ -213,6 +225,7 @@
dimTable :: Gtk.Table,
domVarLabel :: Gtk.Label,
zoomEntry :: Gtk.Entry,
+ defaultZoomPanButton :: Gtk.Button,
centreXEntry :: Gtk.Entry,
centreYEntry :: Gtk.Entry,
exportJPGButton :: Gtk.Button,
@@ -235,7 +248,9 @@
{
favstActiveDims :: [[Bool]],
favstTrackingDefaultEvalPt :: Bool,
- favstPlotParams :: PlotParams
+ favstPlotParams :: PlotParams,
+ favstZoomPercent :: Double,
+ favstPanCentre :: (Double, Double)
}
initState ::
@@ -246,9 +261,75 @@
{
favstActiveDims = map (map $ const True) $ dataResultNames fndata,
favstTrackingDefaultEvalPt = True,
- favstPlotParams = dataDefaultPlotParams fndata
+ favstPlotParams = dataDefaultPlotParams fndata,
+ favstZoomPercent = defaultZoom,
+ favstPanCentre = getDefaultCentre fndata
}
+defaultZoom :: Double
+defaultZoom = 110
+
+getDefaultCentre fndata =
+ (cX,cY)
+ where
+ cX = (fnL + fnR)/2
+ cY = (fnLO + fnHI)/2
+ (fnLO, fnHI, fnL, fnR) = getFnExtents fndata
+
+updateZoomPanCentreCoordSystem zoomPercent panCentre coordSystem state =
+ state
+ {
+ favstPlotParams =
+ (favstPlotParams state)
+ { pltprmCoordSystem = coordSystem },
+ favstZoomPercent = zoomPercent,
+ favstPanCentre = panCentre
+ }
+
+updatePanCentreCoordSystem = updateZoomPanCentreCoordSystem defaultZoom
+
+updateZoomPercentAndFnExtents zoomPercent fnExtents state =
+ state
+ {
+ favstPlotParams =
+ (favstPlotParams state)
+ { pltprmCoordSystem = newCoordSystem },
+ favstZoomPercent = zoomPercent
+ }
+ where
+ newCoordSystem =
+ case pltprmCoordSystem (favstPlotParams state) of
+ CoordSystemLogSqueeze ->
+ CoordSystemLogSqueeze
+ CoordSystemLinear _ ->
+ linearCoordsWithZoomAndCentre zoomPercent centre fnExtents
+ centre = favstPanCentre state
+
+updateCentreByRatio (ratX, ratY) state =
+ case pltprmCoordSystem (favstPlotParams state) of
+ CoordSystemLogSqueeze -> state
+ CoordSystemLinear (Rectangle hi lo l r) ->
+ state
+ {
+ favstPlotParams =
+ (favstPlotParams state)
+ { pltprmCoordSystem = coordSystem },
+ favstPanCentre = (cX - shiftX, cY - shiftY)
+ }
+ where
+ (cX,cY) = favstPanCentre state
+ shiftX = ratX * fnDomWidth
+ shiftY = ratY * fnRangeHeight
+ fnDomWidth = fromRational $ r - l
+ fnRangeHeight = fromRational $ lo - hi
+ coordSystem =
+ CoordSystemLinear
+ (Rectangle
+ (hi - shiftYrat) (lo - shiftYrat)
+ (l - shiftXrat) (r - shiftXrat))
+ shiftXrat = toRational shiftX
+ shiftYrat = toRational shiftY
+
updateDimActive ::
TVar ERFnViewState ->
Int ->
@@ -271,6 +352,32 @@
activeFnDims =
listUpdate dimNo isActive (activeDims !! fnNo)
+updateZoomWidgets widgets state =
+ case coordSystem of
+ CoordSystemLogSqueeze ->
+ do
+ Gtk.comboBoxSetActive (coorSystemCombo widgets) 0
+ Gtk.editableSetEditable (zoomEntry widgets) False
+ Gtk.editableSetEditable (centreXEntry widgets) False
+ Gtk.editableSetEditable (centreYEntry widgets) False
+ Gtk.entrySetText (zoomEntry widgets) ""
+ Gtk.entrySetText (centreXEntry widgets) ""
+ Gtk.entrySetText (centreYEntry widgets) ""
+ (CoordSystemLinear (Rectangle hi lo l r)) ->
+ do
+ Gtk.comboBoxSetActive (coorSystemCombo widgets) 1
+ Gtk.editableSetEditable (zoomEntry widgets) True
+ Gtk.editableSetEditable (centreXEntry widgets) True
+ Gtk.editableSetEditable (centreYEntry widgets) True
+ Gtk.entrySetText (zoomEntry widgets) $ show $ zoomPercent
+ Gtk.entrySetText (centreXEntry widgets) $ show $ cX
+ Gtk.entrySetText (centreYEntry widgets) $ show $ cY
+ where
+ zoomPercent = favstZoomPercent state
+ (cX,cY) = favstPanCentre state
+ coordSystem = pltprmCoordSystem $ favstPlotParams state
+
+
setHandlers ::
(FA.ERFnApprox box varid domra ranra fa,
ERFnGLDrawable box varid domra ranra fa) =>
@@ -285,11 +392,20 @@
setHandlerDefaultEvalPointButton
setHandlerEvalPointEntry
setHandlerCoordSystem
+ setHandlerZoomAndPanEntries
+ setHandlerPanByMouse
+ setHandlerZoomByMouse
+ state <- atomically $ readTVar stateTV
+ updateZoomWidgets widgets state
+-- putStrLn $ "setHandlers: " ++ (show $ pltprmCoordSystem $ favstPlotParams state)
return ()
- where
+ where
setHandlerCoordSystem =
do
- Gtk.on (coorSystemCombo widgets) Gtk.changed $
+ Gtk.on (coorSystemCombo widgets) Gtk.changed resetZoomPanFromCoordSystem
+ Gtk.onClicked (defaultZoomPanButton widgets) resetZoomPanFromCoordSystem
+ where
+ resetZoomPanFromCoordSystem =
do
maybeCSysIx <- Gtk.comboBoxGetActive (coorSystemCombo widgets)
case maybeCSysIx of
@@ -301,56 +417,148 @@
ix ->
#endif
do
- coordSystem <-
+ state <-
atomically $
do
fndata <- readTVar fndataTV
let coordSystem = case ix of
0 -> CoordSystemLogSqueeze
1 ->
- CoordSystemLinear $ Rectangle
- ((toRational $ dataValHI fndata) + 0.2)
- ((toRational $ dataValLO fndata) - 0.2)
- ((toRational $ dataDomL fndata) - 0.1)
- ((toRational $ dataDomR fndata) + 0.1)
- modifyTVar stateTV $ update coordSystem
- return coordSystem
- changeCoordSystem coordSystem
- where
- update coordSystem state =
- state
- {
- favstPlotParams =
- (favstPlotParams state)
- { pltprmCoordSystem = coordSystem }
- }
- changeCoordSystem coordSystem =
- do
- resetZoom coordSystem
- (fndatas, state) <- atomically $ readAll3TVars fndataTVs stateTV
- repaintCanvas (canvas widgets) fndatas state
- return ()
+ linearCoordsWithZoom defaultZoom (getFnExtents fndata)
+ state <- modifyTVar stateTV $
+ updatePanCentreCoordSystem (getDefaultCentre fndata) coordSystem
+ return state
+ Gtk.widgetQueueDraw (canvas widgets)
+ updateZoomWidgets widgets state
- resetZoom CoordSystemLogSqueeze =
+ setHandlerZoomAndPanEntries =
do
- Gtk.editableSetEditable (zoomEntry widgets) False
- Gtk.editableSetEditable (centreXEntry widgets) False
- Gtk.editableSetEditable (centreYEntry widgets) False
- Gtk.entrySetText (zoomEntry widgets) ""
- Gtk.entrySetText (centreXEntry widgets) ""
- Gtk.entrySetText (centreYEntry widgets) ""
- resetZoom (CoordSystemLinear (Rectangle hi lo l r)) =
+ Gtk.onEntryActivate (zoomEntry widgets) (zoomHandler ())
+ Gtk.onFocusOut (zoomEntry widgets) (\ e -> zoomHandler False)
+ Gtk.onEntryActivate (centreXEntry widgets) (zoomHandler ())
+ Gtk.onFocusOut (centreXEntry widgets) (\ e -> zoomHandler False)
+ Gtk.onEntryActivate (centreYEntry widgets) (zoomHandler ())
+ Gtk.onFocusOut (centreYEntry widgets) (\ e -> zoomHandler False)
+ where
+ zoomHandler returnValue =
+ do
+ zoomS <- Gtk.entryGetText (zoomEntry widgets)
+ centreXS <- Gtk.entryGetText (centreXEntry widgets)
+ centreYS <- Gtk.entryGetText (centreYEntry widgets)
+ case (reads zoomS, reads centreXS, reads centreYS) of
+ ([(zoomPercent,"")], [(centreX,"")], [(centreY,"")]) ->
+ atomically $
+ do
+ fndata <- readTVar fndataTV
+ modifyTVar stateTV $
+ updateZoomPanCentreCoordSystem zoomPercent (centreX, centreY) $
+ linearCoordsWithZoomAndCentre zoomPercent (centreX, centreY) $
+ getFnExtents fndata
+ return ()
+ _ -> return ()
+-- putStrLn $ "zoomHandler"
+ Gtk.widgetQueueDraw (canvas widgets)
+ return returnValue
+
+ setHandlerPanByMouse =
do
--- Gtk.editableSetEditable (zoomEntry widgets) True
--- Gtk.editableSetEditable (centreXEntry widgets) True
--- Gtk.editableSetEditable (centreYEntry widgets) True
- Gtk.editableSetEditable (zoomEntry widgets) False
- Gtk.editableSetEditable (centreXEntry widgets) False
- Gtk.editableSetEditable (centreYEntry widgets) False
- Gtk.entrySetText (zoomEntry widgets) "100"
- Gtk.entrySetText (centreXEntry widgets) $ show $ (l + r)/2
- Gtk.entrySetText (centreYEntry widgets) $ show $ (hi + lo)/2
-
+ -- a variable to keep track of position before each drag movement:
+ panOriginTV <- atomically $ newTVar Nothing
+ -- setup the canvas to receive various mouse events:
+ Gtk.widgetAddEvents (canvas widgets)
+ [Gtk.ButtonPressMask, Gtk.ButtonReleaseMask, Gtk.PointerMotionMask]
+ -- what to do when the left mouse button is pressed:
+ Gtk.on (canvas widgets) Gtk.buttonPressEvent $
+ do
+ button <- GdkEv.eventButton
+ coords <- GdkEv.eventCoordinates
+ case button of
+ GdkEv.LeftButton ->
+ liftIO $
+ do
+ -- remember the position and indicate that dragging is underway:
+ atomically $ writeTVar panOriginTV (Just coords)
+ return ()
+ _ -> return ()
+ return False
+ -- what to do when the left mouse button is released:
+ Gtk.on (canvas widgets) Gtk.buttonReleaseEvent $
+ do
+ button <- GdkEv.eventButton
+ case button of
+ GdkEv.LeftButton ->
+ liftIO $
+ do
+ -- indicate no dragging is underway:
+ atomically $ writeTVar panOriginTV Nothing
+ return ()
+ _ -> return ()
+ return False
+ -- what to do when mouse moves:
+ Gtk.on (canvas widgets) Gtk.motionNotifyEvent $
+ do
+ coords@(x,y) <- GdkEv.eventCoordinates
+ liftIO $
+ do
+ -- update the dragging information variable:
+ maybePanOrigin <- atomically $
+ do
+ maybePanOrigin <- readTVar panOriginTV
+ case maybePanOrigin of
+ Nothing ->
+ return maybePanOrigin
+ Just _ ->
+ do
+ writeTVar panOriginTV (Just coords)
+ return maybePanOrigin
+ -- check whether dragging or not:
+ case maybePanOrigin of
+ Nothing -> return ()
+ Just panOrigin@(oX,oY) -> -- yes, dragging occurred
+ do
+ -- find out the size of the canvas:
+ (canvasX, canvasY) <- Gtk.widgetGetSize (canvas widgets)
+ -- recalculate the centre and coordinate bounds
+ -- based on the drag amount relative to the size fo the canvas:
+ state <- atomically $ modifyTVar stateTV $
+ updateCentreByRatio
+ ((x - oX) / (int2dbl canvasX),
+ (y - oY) / (int2dbl canvasY))
+ -- make sure the text in the zoom and pan entries are updated:
+ updateZoomWidgets widgets state
+ -- schedule the canvas for redraw:
+ Gtk.widgetQueueDraw (canvas widgets)
+ where
+ int2dbl :: Int -> Double
+ int2dbl = fromInteger . toInteger
+ return False
+ return ()
+
+ setHandlerZoomByMouse =
+ do -- IO
+ Gtk.widgetAddEvents (canvas widgets) [Gtk.ScrollMask]
+ Gtk.on (canvas widgets) Gtk.scrollEvent $
+ do -- ReaderTV
+ scrollDirection <- GdkEv.eventScrollDirection
+ liftIO $
+ do -- IO
+ state <- atomically $
+ do -- STM
+ state <- readTVar stateTV
+ let zoomPercent = favstZoomPercent state
+ let newZoomPercent = case scrollDirection of
+ GdkEv.ScrollUp -> 1.25 * zoomPercent
+ GdkEv.ScrollDown -> 0.8 * zoomPercent
+ _ -> zoomPercent
+ fndata <- readTVar fndataTV
+ state <- modifyTVar stateTV $
+ updateZoomPercentAndFnExtents newZoomPercent $ getFnExtents fndata
+ return state
+ updateZoomWidgets widgets state
+ Gtk.widgetQueueDraw (canvas widgets)
+ return False
+ return () -- TODO
+
setHandlerPrintTXTButton =
Gtk.onClicked (printTXTButton widgets) $
do
@@ -402,6 +610,41 @@
-- update the values for the new point:
updateValueDisplayTV widgets dynWidgetsRef fndataTVs stateTV
+linearCoordsWithZoom ::
+ Double {-^ zoom level in percent -} ->
+ (Double, Double, Double, Double)
+ {-^ upper, lower, left, right bounds of the function graph -} ->
+ CoordSystem
+linearCoordsWithZoom zoomPercent fnExtents@(fnHI, fnLO, fnL, fnR) =
+ linearCoordsWithZoomAndCentre zoomPercent (cX,cY) fnExtents
+ where
+ cX = (fnL + fnR)/2
+ cY = (fnLO + fnHI)/2
+
+linearCoordsWithZoomAndCentre ::
+ Double {-^ zoom level in percent -} ->
+ (Double, Double) {-^ x,y coordinates of the centre -} ->
+ (Double, Double, Double, Double)
+ {-^ upper, lower, left, right bounds of the function graph -} ->
+ CoordSystem
+linearCoordsWithZoomAndCentre zoomPercent (cX,cY) (fnHI, fnLO, fnL, fnR) =
+ CoordSystemLinear $ Rectangle
+ ((toRational hi))
+ ((toRational lo))
+ ((toRational l))
+ ((toRational r))
+ where
+ hi = cY + heighHalf
+ lo = cY - heighHalf
+ l = cX - widthHalf
+ r = cX + widthHalf
+ heighHalf = zoomRatio * fnHeightHalf
+ widthHalf = zoomRatio * fnWidthHalf
+ zoomRatio = 100 / zoomPercent
+ fnWidthHalf = (fnR - fnL) / 2
+ fnHeightHalf = (fnHI - fnLO) / 2
+
+
{-|
Reconfigure the GUI to show variable names appropriate
for the given fndata.
@@ -481,7 +724,7 @@
isActive <- Gtk.toggleButtonGetActive showCheckButton
state <- atomically $ updateDimActive stateTV fnNo dimNo isActive
fndatas <- atomically $ readBothTVars fndataTVs
- repaintCanvas (canvas widgets) fndatas state
+ Gtk.widgetQueueDraw (canvas widgets)
return ()
return dimLabel
where
@@ -499,7 +742,8 @@
updateView widgets dynWidgetsRef state (fadata, fndata) =
do
updateValueDisplay widgets dynWidgetsRef state (fadata, fndata)
- repaintCanvas (canvas widgets) (fadata, fndata) state
+ updateZoomWidgets widgets state
+ Gtk.widgetQueueDraw (canvas widgets)
return ()
{-|
@@ -665,10 +909,12 @@
do
GL.clearColor $= (GL.Color4 0.05 0.0 0.2 0.0)
GL.matrixMode $= GL.Projection
- GL.loadIdentity
GL.ortho 0.0 1.0 0.0 1.0 (-1.0) 1.0
GL.depthFunc $= Just GL.Less
GL.drawBuffer $= GL.BackBuffers
+ -- open font for labels:
+-- font <- FTGL.createOutlineFont "VeraMono.ttf"
+ let font = () -- a dummy
-- set the canvas repaint handler:
Gtk.onExpose canvas $ \ event ->
do
@@ -678,7 +924,7 @@
fndata <- readTVar fndataTV
state <- readTVar stateTV
return ((fadata, fndata), state)
- repaintCanvas canvas fndatas state
+ repaintCanvas canvas font fndatas state
-- plug the GL canvas in the GUI:
Gtk.set (canvasAlignment widgets)
[ Gtk.containerChild := canvas ]
@@ -687,17 +933,19 @@
repaintCanvas ::
(FA.ERFnApprox box varid domra ranra fa, ERFnGLDrawable box varid domra ranra fa) =>
GtkGL.GLDrawingArea ->
+-- FTGL.Font ->
+ () ->
((FaData fa),
FnData) ->
(ERFnViewState) ->
IO Bool
-repaintCanvas canvas (fadata, fndata) state =
+repaintCanvas canvas font (fadata, fndata) state =
do
GtkGL.withGLDrawingArea canvas $ \glwindow ->
do
GL.clear [GL.DepthBuffer, GL.ColorBuffer]
drawFG1 $ zip (dataFAs fadata) (favstActiveDims state)
- drawCoords
+ drawCoords glwindow
GtkGL.glDrawableSwapBuffers glwindow
return True
where
@@ -715,29 +963,29 @@
GL.color $ GL.Color3 0.8 0.4 (0.4 :: GL.GLfloat)
glDraw (plotParams { pltprmPlotDimensions = activeDims }) fa
drawFG1 rest
- drawCoords =
+ drawCoords glwindow =
do
GL.color $ GL.Color3 1 0.2 (0.4 :: GL.GLfloat)
- drawPointLabel 0 0 "0"
+ drawPointLabel glwindow 0 0 "0"
case pltprmCoordSystem plotParams of
CoordSystemLogSqueeze ->
do
- mapM drawXmarks $ [0.1, 0.5, 1, 10, 100]
- mapM drawYmarks $ [0.1, 0.5, 1, 2, 5, 10, 100, 1000, 1000000, 1000000000000]
+ mapM (drawXmarks glwindow) $ [0.1, 0.5, 1, 10, 100]
+ mapM (drawYmarks glwindow) $ [0.1, 0.5, 1, 2, 5, 10, 100, 1000, 1000000, 1000000000000]
CoordSystemLinear _ ->
do
- mapM drawXmarks $ [0.25, 0.5, 0.75, 1] -- TODO: use the rectangle
- mapM drawYmarks $ [0.25, 0.5, 0.75, 1]
+ mapM (drawXmarks glwindow) $ [0.25, 0.5, 0.75, 1] -- TODO: use the rectangle
+ mapM (drawYmarks glwindow) $ [0.25, 0.5, 0.75, 1]
where
- drawXmarks xm =
+ drawXmarks glwindow xm =
do
- drawPointLabel xm 0 (show xm)
- drawPointLabel (-xm) 0 (show $ - xm)
- drawYmarks ym =
+ drawPointLabel glwindow xm 0 (show xm)
+ drawPointLabel glwindow (-xm) 0 (show $ - xm)
+ drawYmarks glwindow ym =
do
- drawPointLabel 0 ym (show ym)
- drawPointLabel 0 (-ym) (show $ - ym)
- drawPointLabel xModel yModel label =
+ drawPointLabel glwindow 0 ym (show ym)
+ drawPointLabel glwindow 0 (-ym) (show $ - ym)
+ drawPointLabel glwindow xModel yModel label =
do
GL.renderPrimitive GL.Lines $
do
@@ -749,11 +997,36 @@
GL.vertex $ GL.Vertex3 x y (z + d)
drawLabel (x + 2 * d,y - 2 * d,z) label
where
- d = 0.01 :: GL.GLfloat
+ d = 0.01 :: GL.GLdouble
(x,y) = translateToCoordSystem coordSystem [xModel, yModel]
z = 0
drawLabel (x,y,z) label =
do
- GL.rasterPos $ GL.Vertex3 x y z
- GLUT.renderString GLUT.Fixed9By15 label
+ return ()
+-- FTGL.setFontFaceSize font 6 12
+-- GL.matrixMode $= GL.Projection
+-- GL.preservingMatrix $
+-- do
+-- GL.translate $ GL.Vector3 0.2 0.8 z
+-- GL.scale 0.01 0.01 z
+-- m <- GL.newMatrix GL.ColumnMajor [0.1, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 0.1, 0, 0, 0, 0, 1]
+-- GL.multMatrix (m :: GL.GLmatrix Double)
+-- GL.renderPrimitive GL.Lines $
+-- do
+-- GL.vertex $ GL.Vertex3 0 0 z
+-- GL.vertex $ GL.Vertex3 0.5 0.5 z
+-- m <- GL.newMatrix GL.ColumnMajor [1,0,0,0,1,0,0,0,1]
+-- let _ = m :: (GL.GLmatrix Double)
+-- GL.withMatrix m $ \_ _ ->
+-- do
+---- GL.rasterPos $ GL.Vertex2 50 (50 :: GL.GLdouble)
+---- FTGL.renderFont font label FTGL.Front
+-- GL.renderPrimitive GL.Lines $
+-- do
+-- GL.vertex $ GL.Vertex3 0 0 z
+-- GL.vertex $ GL.Vertex3 10 10 z
+-- GtkGL.glDrawableSwapBuffers glwindow
+---- box <- FTGL.getFontBBox font label
+---- putStrLn $ show box
+---- GLUT.renderString GLUT.Fixed9By15 label
diff --git a/src/Data/Number/ER/RnToRm/Plot/GLDrawable.hs b/src/Data/Number/ER/RnToRm/Plot/GLDrawable.hs
--- a/src/Data/Number/ER/RnToRm/Plot/GLDrawable.hs
+++ b/src/Data/Number/ER/RnToRm/Plot/GLDrawable.hs
@@ -32,8 +32,8 @@
import Data.Number.ER.RnToRm.Approx.PieceWise
import qualified Data.Number.ER.RnToRm.BisectionTree as BISTR
-import qualified Data.Number.ER.Real.DomainBox as DBox
-import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBoxMappable, DomainIntBox)
+import qualified Data.Number.ER.BasicTypes.DomainBox as DBox
+import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBoxMappable, DomainIntBox)
import Data.Number.ER.RnToRm.Plot.Params
import Data.Number.ER.Misc
@@ -72,9 +72,13 @@
map (\pt -> FA.eval pt f) $
map (DBox.unary) partition
partition =
- [domLO] ++ (map iL [1..(segCnt -1)]) ++ [domHI]
+ case RA.isAnticonsistent visibleDom of
+ True -> []
+ False ->
+ [domLO] ++ (map iL [1..(segCnt -1)]) ++ [domHI]
where
- (domLO, domHI) = RA.bounds dom
+ (domLO, domHI) = RA.bounds visibleDom
+ visibleDom = dom RA./\ visibleExtents
dom =
case DBox.elems $ FA.dom f of
[dom] -> dom
@@ -107,10 +111,10 @@
(interpCoordsDoubleLower, interpCoordsDoubleUpper) =
unzip $ map convertCoords interpCoords
convertCoords (d,v)
- | RA.isEmpty d =
- ((0,0),(0,0))
- | RA.isEmpty v =
- ((dD,0),(dD,0))
+-- | not $ RA.isConsistent d =
+-- ((0,0),(0,0))
+-- | not $ RA.isConsistent v =
+-- ((dD,0),(dD,0))
| otherwise =
((dD,vD1),(dD,vD2))
where
@@ -122,10 +126,14 @@
where
(dNorm, vNorm) =
translateToCoordSystem coordSystem [d, v]
+ visibleExtents =
+ (RA.double2ra vdomLO) RA.\/ (RA.double2ra vdomHI)
+ where
+ (_,_,vdomLO, vdomHI) = getVisibleDomExtents coordSystem
getSegmentCount segPerUnit coordSystem dom
- | RA.isEmpty dom = 0
+ | RA.isAnticonsistent dom = 0
| otherwise =
-- unsafePrint ("GLDrawable: getSegmentCount: dom = " ++ show dom ++ " domWidthScreen = " ++ show domWidthScreen) $
ceiling (segPerUnitRA * domWidthScreen)
diff --git a/src/Data/Number/ER/RnToRm/Plot/Params.hs b/src/Data/Number/ER/RnToRm/Plot/Params.hs
--- a/src/Data/Number/ER/RnToRm/Plot/Params.hs
+++ b/src/Data/Number/ER/RnToRm/Plot/Params.hs
@@ -18,7 +18,8 @@
defaultPlotParams,
CoordSystem(..),
Rectangle(..),
- translateToCoordSystem
+ translateToCoordSystem,
+ getVisibleDomExtents
)
where
@@ -93,7 +94,7 @@
{-|
Translate a point given by a number of coordinates to
a 2D point assuming that only result points in the rectangle
- (0,0) --- (1,1) are visible, the origin being at the top left.
+ (0,0) --- (10,10) are visible, the origin being at the top left.
-}
translateToCoordSystem ::
(Floating ra, Ord ra) =>
@@ -103,19 +104,30 @@
translateToCoordSystem csys pt =
case (csys, pt) of
(CoordSystemLogSqueeze, [x,y]) ->
- (logSqueeze 0.5 x, logSqueeze 0.5 y)
+ ((logSqueeze 0.5 x) * scale, (logSqueeze 0.5 y) * scale)
(CoordSystemLinear (Rectangle t b l r), [x,y]) ->
- (linTransViaRat l r x,
- linTransViaRat b t y)
-
-linTransViaRat r0 r1 x =
- linTransform (fromRational r0) (fromRational r1) x
-
-linTransform x0 x1 x =
- (x - x0) / (x1 - x0)
-
-logSqueeze v1 =
- (\x -> (x + 1) /2) . (normalise v1) . logScale
+ ((linTransViaRat l r x) * scale,
+ (linTransViaRat b t y) * scale)
+ where
+ scale = 1
+ linTransViaRat r0 r1 x =
+ linTransform (fromRational r0) (fromRational r1) x
+
+ linTransform x0 x1 x =
+ (x - x0) / (x1 - x0)
+
+ logSqueeze v1 =
+ (\x -> (x + 1) /2) . (normalise v1) . logScale
+
+getVisibleDomExtents :: CoordSystem -> (Double,Double,Double,Double)
+getVisibleDomExtents csys =
+ case csys of
+ CoordSystemLogSqueeze ->
+ (infinity, -infinity, - infinity, infinity)
+ CoordSystemLinear (Rectangle t b l r) ->
+ (fromRational t, fromRational b, fromRational l, fromRational r)
+ where
+ infinity = 1/0
{-|
Convert a number from range [-oo,+oo] to
diff --git a/tests/Demo.hs b/tests/Demo.hs
deleted file mode 100644
--- a/tests/Demo.hs
+++ /dev/null
@@ -1,124 +0,0 @@
-module Main where
-
-import qualified Data.Number.ER.Real as AERN
-import qualified Data.Number.ER.RnToRm as AERNFunc
-import qualified Data.Number.ER.RnToRm.Plot.FnView as FNV
-
-import Control.Concurrent as Concurrent
-import Control.Concurrent.STM as STM
-
-import qualified Graphics.UI.Gtk as Gtk
-import Graphics.UI.Gtk (AttrOp((:=)))
-import qualified Graphics.UI.Gtk.Glade as Glade
-import qualified Graphics.UI.Gtk.OpenGL as GtkGL
-import qualified Graphics.UI.GLUT as GLUT
-
-type B = AERN.BM
---type B = AERN.BMPFR
-type RA = AERN.RA B
-type IRA = AERN.IRA B
-type FA = AERNFunc.FAPWP B
-type Box a = AERNFunc.Box a
-type VarID = AERNFunc.VarID
-
-main =
- do
- AERN.initialiseBaseArithmetic (0 :: RA)
- initGtkGL
- fadataTV <- newTVarIO faData
- fndataTV <- newTVarIO FNV.defaultFnData
- fnviewWindow <- FNV.new (fadataTV, fndataTV) Nothing
- forkIO $ signalData fndataTV
- Gtk.mainGUI
-
-faData =
- FNV.defaultFaData
- {
- FNV.dataFAs = [f1,f2]
- }
-
-f1 = AERNFunc.tuple [f11,f12,f13]
-f2 = AERNFunc.tuple [f21,f22,f23]
-
-ix1 = 6
-ix2 = 12
-ix3 = 18
-
-g = AERNFunc.scale 10 x
-f11 = AERN.cos ix1 $ g -- cos(10x)
-f12 = AERN.cos ix2 $ g -- cos(10x)
-f13 = AERN.cos ix3 $ g -- cos(10x)
-
-f21 = AERNFunc.integrateUnary 3 f11 dom 0 [-1] -- integ(cos(10x)) - 1
-f22 = AERNFunc.integrateUnary 3 f12 dom 0 [-1] -- integ(cos(10x)) - 1
-f23 = AERNFunc.integrateUnary 3 f13 dom 0 [-1] -- integ(cos(10x)) - 1
-
-
-x :: FA
-x =
- AERNFunc.bisectUnbisectDepth 5 $
- AERNFunc.setMaxDegree 3 $
- AERNFunc.proj xdom 0
-
-xdom = AERNFunc.fromAscList [(0, dom)]
-
-const01 :: FA
-const01 =
- AERNFunc.const xdom [0 AERN.\/ 1]
-
-dom = domL AERN.\/ domR
-(domL, domR) = (-1, 1)
-(valLO, valHI) = (-2,2)
-
-fnData =
- setExtents domL domR valLO valHI $
- FNV.defaultFnData
- {
- FNV.dataFAsUpdated = True,
- FNV.dataDomName = "x",
- FNV.dataFnNames = ["f1","f2"],
- FNV.dataResultNames = [["f11", "f12", "f13"],["f21", "f22", "f23"]],
- FNV.dataDefaultEvalPoint = 0
- }
-
-setExtents left right bot top fnData =
- fnData
- {
- FNV.dataDomL = td left,
- FNV.dataDomR = td right,
- FNV.dataValLO = td bot,
- FNV.dataValHI = td top,
- FNV.dataDefaultPlotParams =
- FNV.defaultPlotParams
- {
- FNV.pltprmCoordSystem =
- FNV.CoordSystemLinear $
- FNV.Rectangle
- (tr $ top + 0.1)
- (tr $ bot - 0.1)
- (tr $ left - 0.1)
- (tr $ right + 0.1)
- }
- }
- where
- tr = toRational . td
- td = fst . AERN.doubleBounds
-
-initGtkGL =
- do
- Gtk.initGUI
- -- enable multithreaded GUI:
- Gtk.timeoutAddFull
- (Concurrent.yield >> Concurrent.yield >> Concurrent.yield >> return True)
- Gtk.priorityDefaultIdle 20
- -- see http://haskell.org/gtk2hs/archives/2005/07/24/writing-multi-threaded-guis/
- GtkGL.initGL
- GLUT.initialize "AERN Function View" [] -- needed for text in GL canvas
-
-signalData fndataTV =
- do
- threadDelay 200000 -- 0.2s
- atomically $
- do
- writeTVar fndataTV fnData
-
diff --git a/tests/FnView.glade b/tests/FnView.glade
deleted file mode 100644
--- a/tests/FnView.glade
+++ /dev/null
@@ -1,466 +0,0 @@
-
-
-
-
-
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 0
- GTK_SHADOW_ETCHED_OUT
-
-
- 500
- 500
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 12
-
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- plot
-
-
- label_item
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 0
- GTK_SHADOW_ETCHED_OUT
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 12
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- log + squeeze
-linear
-
-
-
-
- True
-
-
-
-
-
- 1
-
-
-
-
- True
-
-
-
-
-
- 2
-
-
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- coord system
- True
-
-
- label_item
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 0
- GTK_SHADOW_ETCHED_OUT
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 12
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 4
- 1
-
-
-
-
-
- True
- True
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- set to defaults
- 0
-
-
- GTK_FILL
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 0
- zoom=
-
-
- False
-
-
-
-
- True
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 5
- True
-
-
- False
- False
- 1
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- %
-
-
- False
- 2
-
-
-
-
- 1
- 2
- GTK_FILL
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 2
- 3
-
-
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 0
- centre x=
-
-
- GTK_FILL
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 0
- centre y=
-
-
- 1
- 2
- GTK_FILL
-
-
-
-
- True
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 5
-
-
- 1
- 2
- GTK_FILL
-
-
-
-
- True
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 5
-
-
- 1
- 2
- 1
- 2
- GTK_FILL
-
-
-
-
- 2
- 3
- GTK_FILL
-
-
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- zoom/pan
- True
-
-
- label_item
-
-
-
-
- 1
-
-
-
-
- 1
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- True
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- default
- 0
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- ==
-
-
- 1
-
-
-
-
- True
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- 2
-
-
-
-
- False
- 2
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- GTK_RESIZE_IMMEDIATE
- 4
- 3
- 1
- 5
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- False
- 2
- 1
-
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 0
- GTK_SHADOW_ETCHED_OUT
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- 12
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
-
-
- True
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- jpg
- 0
-
-
-
-
- True
- True
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- txt
- 0
-
-
- 1
-
-
-
-
- True
-
-
-
-
-
- 2
-
-
-
-
-
-
-
-
- True
- GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK
- export functions
- True
-
-
- label_item
-
-
-
-
- False
- GTK_PACK_END
- 3
-
-
-
-
- 1
-
-
-
-
-
-