Add rudimentary shares system

9 files changed, 60 insertions, 5 deletions

diff --git a/.gitignore b/.gitignore
index 61da44c..4e64ef0 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,3 @@
 *.abc
 *.o
-
-*.prj
-
-test/test
+*.tcl
diff --git a/config/Gtk.linux.prt b/config/Gtk.linux.prt
index 1b70e04..aae3997 100644
--- a/config/Gtk.linux.prt
+++ b/config/Gtk.linux.prt
@@ -45,6 +45,7 @@ Global
 		KeepByteCodeSymbols:	True
 		PrelinkByteCode:	True
 	Paths
+		Path:	{Application}*lib*Dynamics
 		Path:	{Application}*lib*Platform
 		Path:	{Application}*lib*Gtk
 	Precompile:	
diff --git a/config/GtkSheet.linux.prt b/config/GtkSheet.linux.prt
index dc645de..3eca7e5 100644
--- a/config/GtkSheet.linux.prt
+++ b/config/GtkSheet.linux.prt
@@ -45,6 +45,7 @@ Global
 		KeepByteCodeSymbols:	True
 		PrelinkByteCode:	True
 	Paths
+		Path:	{Application}*lib*Dynamics
 		Path:	{Application}*lib*Platform
 		Path:	{Application}*lib*Gtk
 	Precompile:	
diff --git a/src/Gtk.dcl b/src/Gtk.dcl
index a77e2b1..964d2a4 100644
--- a/src/Gtk.dcl
+++ b/src/Gtk.dcl
@@ -1,5 +1,6 @@
 definition module Gtk
 
+import Gtk.Shares
 import Gtk.Signal
 import Gtk.State
 import Gtk.Tune
diff --git a/src/Gtk.icl b/src/Gtk.icl
index 88cb82b..77e08d3 100644
--- a/src/Gtk.icl
+++ b/src/Gtk.icl
@@ -1,5 +1,6 @@
 implementation module Gtk
 
+import Gtk.Shares
 import Gtk.Signal
 import Gtk.State
 import Gtk.Tune
diff --git a/src/Gtk/Shares.dcl b/src/Gtk/Shares.dcl
new file mode 100644
index 0000000..e05407c
--- /dev/null
+++ b/src/Gtk/Shares.dcl
@@ -0,0 +1,15 @@
+definition module Gtk.Shares
+
+from Gtk.State import :: GtkM
+
+:: ShareId :== String
+
+:: Shared a
+
+class shared a | TC a
+
+share :: !ShareId a -> Shared a | shared a
+
+getShared :: !(Shared a) -> GtkM a | shared a
+setShared :: !(Shared a) !a -> GtkM a | shared a
+updateShared :: !(a -> a) !(Shared a) -> GtkM a | shared a
diff --git a/src/Gtk/Shares.icl b/src/Gtk/Shares.icl
new file mode 100644
index 0000000..13a8727
--- /dev/null
+++ b/src/Gtk/Shares.icl
@@ -0,0 +1,36 @@
+implementation module Gtk.Shares
+
+import StdEnv
+import StdMaybe
+import StdDebug
+
+import Control.Monad
+import Data.Functor
+import qualified Data.Map
+
+import Gtk
+
+:: Shared a :== (String,a)
+
+share :: !ShareId a -> Shared a | shared a
+share id default = (id,default)
+
+getShared :: !(Shared a) -> GtkM a | shared a
+getShared (id,default) = retrieve <$> getState
+where
+	retrieve {shares} = case 'Data.Map'.get id shares of
+		Nothing        -> default
+		Just (v :: a^) -> v
+		Just d         -> trace_n warning default
+		with
+			warning = "getShared type mismatch: expected "+++
+				toString (typeCodeOfDynamic (dynamic default))+++"; got "+++
+				toString (typeCodeOfDynamic d)
+
+setShared :: !(Shared a) !a -> GtkM a | shared a
+setShared (id,_) v =
+	modState (\st -> {st & shares='Data.Map'.put id (dynamic v) st.shares}) >>|
+	pure v
+
+updateShared :: !(a -> a) !(Shared a) -> GtkM a | shared a
+updateShared f shared = getShared shared >>= setShared shared o f
diff --git a/src/Gtk/State.dcl b/src/Gtk/State.dcl
index 5c8d039..389ce71 100644
--- a/src/Gtk/State.dcl
+++ b/src/Gtk/State.dcl
@@ -7,6 +7,7 @@ from Control.Monad import class Monad
 from Data.Functor import class Functor
 from Data.Map import :: Map
 
+from Gtk.Shares import :: ShareId
 from Gtk.Signal import :: SignalHandlerInternal
 
 :: GtkState =
@@ -14,6 +15,7 @@ from Gtk.Signal import :: SignalHandlerInternal
 	, return          :: !Bool
 	, signal_handlers :: !Map Int SignalHandlerInternal
 	, signal_counter  :: !Int
+	, shares          :: !Map ShareId Dynamic
 	}
 
 :: GtkM a =: GtkM (GtkState -> (a, GtkState))
diff --git a/src/Gtk/State.icl b/src/Gtk/State.icl
index 405b8b4..0d1726e 100644
--- a/src/Gtk/State.icl
+++ b/src/Gtk/State.icl
@@ -9,8 +9,8 @@ from Data.Map import :: Map
 import Data.Maybe
 import Data.Tuple
 
+import Gtk
 import Gtk.Internal
-import Gtk.Signal
 
 newGtkState :: GtkState
 newGtkState =
@@ -18,6 +18,7 @@ newGtkState =
 	, return          = False
 	, signal_handlers = 'Data.Map'.newMap
 	, signal_counter  = 0
+	, shares          = 'Data.Map'.newMap
 	}
 
 instance Functor GtkM where fmap f (GtkM m) = GtkM (first f o m)