packages feed

GtkTV 0.0.3 → 0.1.0

raw patch · 3 files changed

+75/−46 lines, 3 files

Files

GtkTV.cabal view
@@ -1,5 +1,5 @@ Name:                GtkTV-Version:             0.0.3+Version:             0.1.0 Cabal-Version:       >= 1.2 Synopsis:            Gtk-based GUIs for Tangible Values Category:            User Interfaces
examples/test.hs view
@@ -16,10 +16,12 @@ import Data.Pair   (pair)   -- or use iPair, oPair import Data.Title  (title)  -- or use iTitle, oTitle -import Interface.TV (tv,runTV)-import Interface.TV.Gtk (In,Out,R,toggleI,textO,sliderRI,sliderII)+-- import Interface.TV (tv,runTV,boolIn,stringOut,oLambda)+-- import Interface.TV.Gtk (In,Out,gtv,R,sliderRI,sliderII) +import Interface.TV.Gtk + {--------------------------------------------------------------------     Tests --------------------------------------------------------------------}@@ -28,7 +30,7 @@ i1 = title "size" $ sliderRI (0,10) 3  i2 :: In Bool-i2 = title "happy" $ toggleI False+i2 = title "happy" $ boolIn False  i3 :: In (R, Bool) i3 = pair i1 i2@@ -36,11 +38,17 @@ i4 :: In Int i4 = title "cookies" $ sliderII (0,10) 5 --- testI i = runOut "test" (lambda i textO) show+-- testI i = runOut "test" (lambda i stringOut) show  testI :: Show a => In a -> IO ()-testI i = runTV (tv (lambda i textO) show) +-- testI i = runTV (tv (lambda i (stringOut :: Out String)) show)++-- The explicit typing is unfortunate here.  Alternatively, use gtv or runGTV:++testI i = runGTV (tv (oLambda i stringOut) show)++ t1,t2,t3,t4,t5 :: IO () t1 = testI i1 t2 = testI i2@@ -52,7 +60,7 @@ -- t6 = runUI TextureIn "/home/conal/Pictures/phone pics/Image002.jpg" print  o6 :: Out (R -> Bool -> String)-o6 = lambda i1 $ lambda i2 $ textO+o6 = lambda i1 $ lambda i2 $ stringOut  t6 :: IO () -- t6 = runOut "currying" o6  (\ a b -> show (a,b))
src/Interface/TV/Gtk.hs view
@@ -14,9 +14,10 @@  module Interface.TV.Gtk   ( -- * TV type specializations-    In, Out, GTV, runGTV+    In, Out, GTV, gtv, runGTV     -- * UI primitives-  , R, sliderRI, sliderII, toggleI, toggleO, textI, textO, clockI, fileNameI+  , R, sliderRI, sliderII, clockI, fileNameI+  , module Interface.TV   ) where  import Control.Applicative (liftA2,(<$>))@@ -31,12 +32,15 @@ import Data.Lambda  import qualified Control.Compose as C-import Control.Compose (ToOI(..))+import Control.Compose (ToOI(..),Cofunctor(..)) -import Interface.TV.Input-import Interface.TV.Output-import Interface.TV.Tangible+import Interface.TV +-- import Interface.TV.Input+-- import Interface.TV.Output+-- import Interface.TV.Tangible+-- import Interface.TV.Common+ import Graphics.UI.Gtk -- as Gtk  @@ -48,7 +52,11 @@ type Out = Output MkI MkO type GTV = TV MkI MkO --- Type specialization+-- Type specialization of 'tv'+gtv :: Out a -> a -> GTV a+gtv = tv++-- Type specialization of 'runTV' runGTV :: GTV a -> IO () runGTV = runTV @@ -77,6 +85,49 @@ -- | Sink of information type OI a = a -> IO () ++instance Functor MkI where+  fmap f (MkI h) = MkI h'+    where+      h' refresh = do (wid,poll,clean) <- h refresh+                      return (wid, fmap f poll, clean)++instance Cofunctor MkO where+  cofmap f (MkO io) = MkO io'+   where+     io' = do (wid,sink,cleanup) <- io+              return (wid,sink . f,cleanup)++-- Note that Functor & Cofunctor are isomorphic to a standard form.+-- Consider redefining MkI' and MkO' accordingly.  See how other instances+-- work out.++instance CommonIns MkI where+  getString start = MkI $ \ refresh ->+    do entry <- entryNew+       entrySetText entry start+       onEntryActivate entry refresh+       return (toWidget entry, entryGetText entry, return ())+  getRead = getReadF  -- thanks to MkI Functor+  getBool start = MkI $ \ refresh ->+    do w <- checkButtonNew+       toggleButtonSetActive w start+       onToggled w refresh+       return (toWidget w, toggleButtonGetActive w, return ())++-- TODO: refactor textI, toggleI.  Or eliminate them, and just use+-- stringIn, boolIn in their place.++instance CommonOuts MkO where+  putString = MkO $+    do entry <- entryNew+       return (toWidget entry, entrySetText entry, return ())+  putShow = putShowC  -- thanks to MkO Cofunctor+  putBool = MkO $+    do w <- checkButtonNew+       return (toWidget w, toggleButtonSetActive w, return ())++ -- | Add post-processing result :: (b -> b') -> ((a -> b) -> (a -> b')) result = (.)@@ -171,8 +222,8 @@ primMkI :: MkI' a -> In a primMkI = iPrim . MkI -primMkO :: MkO' a -> Out a-primMkO = oPrim . MkO+-- primMkO :: MkO' a -> Out a+-- primMkO = oPrim . MkO  type R = Float @@ -205,19 +256,6 @@          -- TODO: experiment with return False vs True          return (toWidget w, getter, return ()) --toggleI :: Bool -> In Bool-toggleI start = primMkI $ \ refresh ->-  do w <- checkButtonNew-     toggleButtonSetActive w start-     onToggled w refresh-     return (toWidget w, toggleButtonGetActive w, return ())--toggleO :: Out Bool-toggleO = primMkO $-  do w <- checkButtonNew-     return (toWidget w, toggleButtonSetActive w, return ())- fileNameI :: FilePath -> In FilePath fileNameI start = primMkI $ \ refresh ->   do w <- fileChooserButtonNew "Select file" FileChooserActionOpen@@ -235,23 +273,6 @@ -- mkTexture _ _ _ = error "mkTexture: not BaseG"  -- onEntryActivate :: EntryClass ec => ec -> IO () -> IO (ConnectId ec)--textI :: String -> In String-textI start = primMkI $ \ refresh ->-  do entry <- entryNew-     entrySetText entry start-     onEntryActivate entry refresh-     return (toWidget entry, entryGetText entry, return ())---textO :: Out String-textO = primMkO $-  do entry <- entryNew-     return (toWidget entry, entrySetText entry, return ())---- textO = primMkO $---         do lab <- labelNew Nothing---            return (toWidget lab, labelSetText lab)  -- | A clock that reports time in seconds and updates at the given period -- (in seconds).