grapefruit-examples 0.0.0.0 → 0.1.0.0
raw patch · 7 files changed
+365/−69 lines, 7 filesdep +colourdep +containersdep +fractiondep ~basedep ~grapefruit-frpdep ~grapefruit-records
Dependencies added: colour, containers, fraction
Dependency ranges changed: base, grapefruit-frp, grapefruit-records, grapefruit-ui
Files
- LICENSE +1/−0
- grapefruit-examples.cabal +32/−19
- src/Examples/Grapefruit/Converter.hs +47/−0
- src/Examples/Grapefruit/ListView.hs +143/−0
- src/Examples/Grapefruit/SetView.hs +93/−0
- src/Examples/Grapefruit/Simple.hs +9/−12
- src/Examples/Grapefruit/Switching.hs +40/−38
LICENSE view
@@ -1,4 +1,5 @@ Copyright © 2007–2009 Brandenburgische Technische Universität Cottbus+Copyright © 2011 Wolfgang Jeltsch All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted
grapefruit-examples.cabal view
@@ -1,15 +1,15 @@ Name: grapefruit-examples-Version: 0.0.0.0-Cabal-Version: >= 1.2.3+Version: 0.1.0.0+Cabal-Version: >= 1.6 Build-Type: Simple License: BSD3 License-File: LICENSE-Copyright: © 2007–2009 Brandenburgische Technische Universität Cottbus+Copyright: © 2007–2009 Brandenburgische Technische Universität Cottbus; © 2011 Wolfgang Jeltsch Author: Wolfgang Jeltsch-Maintainer: jeltsch@informatik.tu-cottbus.de+Maintainer: wolfgang@cs.ioc.ee Stability: provisional-Homepage: http://haskell.org/haskellwiki/Grapefruit-Package-URL: http://hackage.haskell.org/packages/archive/grapefruit-examples/0.0.0.0/grapefruit-examples-0.0.0.0.tar.gz+Homepage: http://grapefruit-project.org/+Package-URL: http://hackage.haskell.org/packages/archive/grapefruit-examples/0.1.0.0/grapefruit-examples-0.1.0.0.tar.gz Synopsis: Examples using the Grapefruit library Description: Grapefruit is a library for Functional Reactive Programming (FRP) with a focus on user interfaces. FRP makes it possible to implement reactive and interactive systems@@ -24,27 +24,40 @@ import Graphics.UI.Grapefruit.Circuit import Graphics.UI.Grapefruit./UIBackend/ import Examples.Grapefruit./Example/- run /UIBackend/ mainCircuit+ run /UIBackend/ mainCircuit () @ . Replace @/Example/@ with the name of the example to run and @/UIBackend/@ with the- name of the UI backend you want to use. At the moment, the only examples are @Simple@- and @Switching@ and the only UI backend is @GTK@.+ name of the UI backend you want to use. At the moment, the only examples are+ @Simple@, @Switching@, @Converter@, @ListView@, and @SetView@, and the only UI+ backend is @GTK@. Category: FRP, Reactivity, GUI, User Interfaces-Tested-With: GHC == 6.8.3- GHC == 6.10.1+Tested-With: GHC == 7.0.4 +Source-Repository head+ type: darcs+ location: http://darcs.grapefruit-project.org/main++Source-Repository this+ type: darcs+ location: http://darcs.grapefruit-project.org/main+ tag: grapefruit-0.1.0.0+ Library- Build-Depends: base >= 3.0 && < 4.1,- grapefruit-frp >= 0.0 && < 0.1,- grapefruit-records >= 0.0 && < 0.1,- grapefruit-ui >= 0.0 && < 0.1+ Build-Depends: base >= 3.0 && < 4.4,+ colour >= 1.0 && < 2.4,+ containers >= 0.1 && < 0.5,+ fraction >= 0.0.1 && < 0.2,+ grapefruit-frp >= 0.1 && < 0.2,+ grapefruit-records >= 0.1 && < 0.2,+ grapefruit-ui >= 0.1 && < 0.2 Extensions: Arrows- CPP- -- ImpredicativeTypes+ ImpredicativeTypes Rank2Types TypeOperators- GHC-Options: -fglasgow-exts- Exposed-Modules: Examples.Grapefruit.Simple+ Exposed-Modules: Examples.Grapefruit.Converter+ Examples.Grapefruit.ListView+ Examples.Grapefruit.SetView+ Examples.Grapefruit.Simple Examples.Grapefruit.Switching HS-Source-Dirs: src
+ src/Examples/Grapefruit/Converter.hs view
@@ -0,0 +1,47 @@+module Examples.Grapefruit.Converter (++ mainCircuit,++) where++ -- Control+ import Control.Applicative as Applicative+ import Control.Arrow as Arrow++ -- Data+ import Data.Record as Record++ -- FRP.Grapefruit+ import FRP.Grapefruit.Signal.Discrete as DSignal++ -- Graphics.UI.Grapefruit+ import Graphics.UI.Grapefruit.Item as UIItem hiding (box)+ import Graphics.UI.Grapefruit.Circuit as UICircuit+ import Graphics.UI.Grapefruit.Backend.Basic as BasicUIBackend++ mainCircuit :: (BasicUIBackend uiBackend) => UICircuit Window uiBackend era () (DSignal era ())+ mainCircuit = proc _ -> do+ X :& Closure := closure `With` X `With` _ <- mainWindow -< X :& Title := mainWindowTitle+ `With` X `With` ()+ returnA -< closure where++ mainWindow = window `with` box Vertical `with` content++ mainWindowTitle = pure "Converter"++ content :: (BasicUIBackend uiBackend) => UICircuit Widget uiBackend era () ()+ content = proc _ -> do+ X :& Content := decimal <- just lineEditor -< X+ X <- just label -< X :& Text := decimalToBinary <$> decimal+ returnA -< ()++ decimalToBinary :: String -> String+ decimalToBinary decimal = case reads decimal of+ [(number,"")] -> reverse (numberToReverseBinary number)+ _ -> ""++ numberToReverseBinary :: Integer -> String+ numberToReverseBinary number | number == 0 = "0"+ | number == 1 = "1"+ | otherwise = numberToReverseBinary (number `mod` 2) +++ numberToReverseBinary (number `div` 2)
+ src/Examples/Grapefruit/ListView.hs view
@@ -0,0 +1,143 @@+{-|+ A Grapefruit example which demonstrates the use of incremental signals and container views.++ A list of kinds of fruit is displayed. Below this list, there are several buttons for+ manipulating the list. The changing list is represented by an incremental signal over sequences.+ Note that not every list manipulation is applicable at every time. If you select a+ non-applicable operation, you get a runtime error. This is caused by the generic checking for+ incremental signals which is provided by the 'iSignal' function.+-}+module Examples.Grapefruit.ListView (++ mainCircuit++) where++ -- Control+ import Control.Applicative as Applicative+ import Control.Arrow as Arrow++ -- Data+ import Data.Foldable as Foldable+ import Data.Sequence as Seq+ import Data.Fraction as Fraction+ import Data.Colour.RGBSpace as RGBSpace+ import Data.Record as Record++ -- FRP.Grapefruit+ import FRP.Grapefruit.Signal.Discrete as DSignal+ import FRP.Grapefruit.Signal.Incremental as ISignal+ import FRP.Grapefruit.Signal.Incremental.Sequence as SeqISignal++ -- Graphics.UI.Grapefruit+ import Graphics.UI.Grapefruit.Item as UIItem hiding (box)+ import Graphics.UI.Grapefruit.Circuit as UICircuit+ import Graphics.UI.Grapefruit.Backend.Basic as BasicUIBackend+ import Graphics.UI.Grapefruit.Backend.Container as ContainerUIBackend++ -- |The circuit describing the whole application.+ mainCircuit :: (ContainerUIBackend uiBackend) =>+ UICircuit Window uiBackend era () (DSignal era ())+ mainCircuit = proc _ -> do+ X :& Closure := closure+ `With` X+ `With` _ <- mainWindow -< X :& Title := pure "List view"+ `With` X+ `With` ()+ returnA -< closure where++ mainWindow = window `with` box Vertical `with` content++ content :: (ContainerUIBackend uiBackend) => UICircuit Widget uiBackend era () ()+ content = proc _ -> do+ rec let++ fruits = ISignal.construct (Seq.singleton Grapefruit)+ (fmap (Diff . Seq.singleton) atomicFruitDiffs)++ atomicFruitDiffs = DSignal.unions [insertions, deletions, shifts, updates]++ cols = ISignal.construct (Seq.fromList [nameCol,tastinessCol])+ (fmap (Diff . Seq.singleton) atomicColDiffs)++ nameCol = Column "name" nameDisplay textCell++ nameDisplay = \fruit -> TextCellDisplay (name fruit) (color fruit)++ tastinessCol = Column "tastiness" tastinessDisplay progressCell++ tastinessDisplay = \fruit -> ProgressCellDisplay (tastiness fruit) Nothing++ atomicColDiffs = colSwaps++ _ <- display -< (fruits,cols)+ insertions <- inserter -< ()+ deletions <- deleter -< ()+ shifts <- shifter -< ()+ updates <- updater -< ()+ colSwaps <- colSwapper -< ()++ returnA -< ()++ display :: (ContainerUIBackend uiBackend) =>+ UICircuit Widget+ uiBackend+ era+ (ISignal era (Seq Fruit),ISignal era (Seq (Column uiBackend Fruit)))+ ()+ display = proc (fruits,cols) -> do+ X :& Selection := selection <- just listView -< X :& Elements := fruits+ :& Columns := cols+ X <- just label -< X :& Text := fmap (show . toList)+ selection+ returnA -< ()++ inserter :: (BasicUIBackend uiBackend) =>+ UICircuit Widget uiBackend era () (DSignal era (AtomicDiff Fruit))+ inserter = proc _ -> do+ X :& Push := push <- just pushButton -< X :& Text := pure ("Insert an apple " +++ "at the beginning")+ returnA -< Insertion 0 (Seq.singleton Apple) <$ push++ deleter :: (BasicUIBackend uiBackend) =>+ UICircuit Widget uiBackend era () (DSignal era (AtomicDiff Fruit))+ deleter = proc _ -> do+ X :& Push := push <- just pushButton -< X :& Text := pure "Delete the second element"+ returnA -< Deletion 1 1 <$ push++ shifter :: (BasicUIBackend uiBackend) =>+ UICircuit Widget uiBackend era () (DSignal era (AtomicDiff Fruit))+ shifter = proc _ -> do+ X :& Push := push <- just pushButton -< X :& Text := pure "Swap the first two elements"+ returnA -< Shift 0 1 1 <$ push++ updater :: (BasicUIBackend uiBackend) =>+ UICircuit Widget uiBackend era () (DSignal era (AtomicDiff Fruit))+ updater = proc _ -> do+ X :& Push := push <- just pushButton -< X :& Text := pure ("Replace the third element " +++ "with a banana")+ returnA -< Update 2 (Seq.singleton Banana) <$ push++ colSwapper :: (BasicUIBackend uiBackend) =>+ UICircuit Widget uiBackend era ()+ (DSignal era (AtomicDiff (Column uiBackend Fruit)))+ colSwapper = proc _ -> do+ X :& Push := push <- just pushButton -< X :& Text := pure "Swap columns"+ returnA -< Shift 0 1 1 <$ push++ data Fruit = Grapefruit | Apple | Banana deriving (Show)++ name :: Fruit -> String+ name Grapefruit = "grapefruit"+ name Apple = "apple"+ name Banana = "banana"++ tastiness :: Fruit -> Fraction+ tastiness Grapefruit = Fraction.fromPercentage 100+ tastiness Apple = Fraction.fromPercentage 25+ tastiness Banana = Fraction.fromPercentage 50++ color :: Fruit -> RGB Fraction+ color Grapefruit = RGB (fromFactor 1) (fromFactor 0.8) (fromFactor 0)+ color Apple = RGB (fromFactor 1) (fromFactor 0) (fromFactor 0)+ color Banana = RGB (fromFactor 1) (fromFactor 1) (fromFactor 0)
+ src/Examples/Grapefruit/SetView.hs view
@@ -0,0 +1,93 @@+module Examples.Grapefruit.SetView (++ mainCircuit++) where++ -- Control+ import Control.Applicative as Applicative+ import Control.Arrow as Arrow++ -- Data+ import Data.Monoid as Monoid+ import Data.Sequence as Seq+ import Data.Set as Set+ import Data.Colour.RGBSpace as RGBSpace+ import Data.Record as Record++ -- FRP.Grapefruit+ import FRP.Grapefruit.Signal as Signal+ import FRP.Grapefruit.Signal.Discrete as DSignal+ import FRP.Grapefruit.Signal.Incremental as ISignal+ import FRP.Grapefruit.Signal.Incremental.Set as SetISignal++ -- Graphics.UI.Grapefruit+ import Graphics.UI.Grapefruit.Item as UIItem hiding (box)+ import Graphics.UI.Grapefruit.Circuit as UICircuit+ import Graphics.UI.Grapefruit.Backend.Basic as BasicUIBackend+ import Graphics.UI.Grapefruit.Backend.Container as ContainerUIBackend++ -- |The circuit describing the whole application.+ mainCircuit :: (ContainerUIBackend uiBackend) =>+ UICircuit Window uiBackend era () (DSignal era ())+ mainCircuit = proc _ -> do+ X :& Closure := closure+ `With` X+ `With` _ <- mainWindow -< X :& Title := pure "Set view"+ `With` X+ `With` ()+ returnA -< closure where++ mainWindow = window `with` box Vertical `with` content++ content :: (ContainerUIBackend uiBackend) => UICircuit Widget uiBackend era () ()+ content = proc _ -> do+ rec let++ names = ISignal.construct Set.empty (DSignal.union insertions deletions)++ insertions = elementInsertion <$> insertionNames++ deletions = elementDeletion <$> deletionNames++ cols = ISignal.const (Seq.fromList [firstNameCol,familyNameCol])++ firstNameCol = Column "first name" firstNameDisplay textCell++ firstNameDisplay = \(Name firstName _) -> TextCellDisplay firstName backgroundColor++ familyNameCol = Column "family name" familyNameDisplay textCell++ familyNameDisplay = \(Name _ familyName) -> TextCellDisplay familyName+ backgroundColor++ backgroundColor = RGB mempty mempty mempty++ _ <- display -< (names,cols)+ insertionNames <- modifier "Insert" -< ()+ deletionNames <- modifier "Delete" -< ()++ returnA -< ()++ display :: (ContainerUIBackend uiBackend) =>+ UICircuit Widget+ uiBackend+ era+ (ISignal era (Set Name),ISignal era (Seq (Column uiBackend Name)))+ ()+ display = proc (names,cols) -> do+ X :& Selection := selection <- just setView -< X :& Elements := names+ :& Columns := cols+ X <- just label -< X :& Text := fmap (show . Set.toList)+ selection+ returnA -< ()++ modifier :: (BasicUIBackend uiBackend) =>+ String -> UICircuit Widget uiBackend era () (DSignal era Name)+ modifier actionText = proc _ -> do+ X :& Content := firstName <- just lineEditor -< X+ X :& Content := familyName <- just lineEditor -< X+ X :& Push := push <- just pushButton -< X :& Text := pure actionText+ returnA -< Name <$ push <#> firstName <#> familyName++ data Name = Name String String deriving (Eq, Ord, Show)
src/Examples/Grapefruit/Simple.hs view
@@ -13,25 +13,22 @@ -- Control import Control.Applicative as Applicative-#if __GLASGOW_HASKELL__ >= 610 import Control.Arrow as Arrow-#else- import Control.Arrow as Arrow hiding (pure)-#endif + -- Data+ import Data.Record as Record+ -- FRP.Grapefruit import FRP.Grapefruit.Signal.Discrete as DSignal import FRP.Grapefruit.Signal.Segmented as SSignal- import FRP.Grapefruit.Record as Record -- Graphics.UI.Grapefruit- import Graphics.UI.Grapefruit.Comp as UIComp- import Graphics.UI.Grapefruit.Item as UIItem- import Graphics.UI.Grapefruit.Circuit as UICircuit- import Graphics.UI.Grapefruit.Backend.Std as StdUIBackend+ import Graphics.UI.Grapefruit.Item as UIItem+ import Graphics.UI.Grapefruit.Circuit as UICircuit+ import Graphics.UI.Grapefruit.Backend.Basic as BasicUIBackend -- |The circuit describing the whole application.- mainCircuit :: (StdUIBackend uiBackend) => UICircuit Window uiBackend era () (DSignal era ())+ mainCircuit :: (BasicUIBackend uiBackend) => UICircuit Window uiBackend era () (DSignal era ()) mainCircuit = proc () -> do rec let @@ -39,7 +36,7 @@ text = SSignal.scan "*" (const . ('*' :)) push - X :& Closure ::= closure `With` X :& Push ::= push+ X :& Closure := closure `With` X :& Push := push <- window `with` just pushButton- -< X :& Title ::= title `With` X :& Text ::= text+ -< X :& Title := title `With` X :& Text := text returnA -< closure
src/Examples/Grapefruit/Switching.hs view
@@ -29,78 +29,80 @@ ) where -- Control- import Control.Applicative as Applicative- import Control.Arrow (arr, returnA)+ import Control.Applicative as Applicative+ import Control.Arrow as Arrow (arr, returnA) + -- Data+ import Data.Record as Record+ -- FRP.Grapefruit import FRP.Grapefruit.Signal as Signal import FRP.Grapefruit.Signal.Discrete as DSignal import FRP.Grapefruit.Signal.Segmented as SSignal- import FRP.Grapefruit.Record as Record -- Graphics.UI.Grapefruit- import Graphics.UI.Grapefruit.Comp as UIComp- import Graphics.UI.Grapefruit.Item as UIItem- import Graphics.UI.Grapefruit.Circuit as UICircuit- import Graphics.UI.Grapefruit.Backend.Std as StdUIBackend+ import Graphics.UI.Grapefruit.Comp as UIComp+ import Graphics.UI.Grapefruit.Item as UIItem+ import Graphics.UI.Grapefruit.Circuit as UICircuit+ import Graphics.UI.Grapefruit.Backend.Basic as BasicUIBackend -- |The circuit describing the whole application.- mainCircuit :: (StdUIBackend uiBackend) => UICircuit Window uiBackend era () (DSignal era ())+ mainCircuit :: (BasicUIBackend uiBackend) => UICircuit Window uiBackend era () (DSignal era ()) mainCircuit = proc _ -> do- X :& Closure ::= closure- `With` _ <- window `with` windowContent -< X :& Title ::= pure "Switching"- `With` ()+ X :& Closure := closure+ `With` _ <- window `with` windowContent -< X :& Title := pure "Switching"+ `With` () returnA -< closure - windowContent :: (StdUIBackend uiBackend) => UIItem Widget uiBackend era () ()+ windowContent :: (BasicUIBackend uiBackend) => UIItem Widget uiBackend era () () windowContent = arr (const (X `With` ()))- |>> StdUIBackend.box Horizontal `with` boxContent >>|+ |>> BasicUIBackend.box Horizontal `with` boxContent >>| arr (\(X `With` _) -> ()) data Port = Port1 | Port2 - boxContent :: (StdUIBackend uiBackend) => UICircuit Widget uiBackend era () ()+ boxContent :: (BasicUIBackend uiBackend) => UICircuit Widget uiBackend era () () boxContent = proc _ -> do- X :& Push ::= inc1 <- just pushButton -< X :& Text ::= pure "Inc 1"- X :& Push ::= inc2 <- just pushButton -< X :& Text ::= pure "Inc 2"- X :& Push ::= switchTo1 <- just pushButton -< X :& Text ::= pure "Switch to 1"- X :& Push ::= switchTo2 <- just pushButton -< X :& Text ::= pure "Switch to 2"+ X :& Push := inc1 <- just pushButton -< X :& Text := pure "Inc 1"+ X :& Push := inc2 <- just pushButton -< X :& Text := pure "Inc 2"+ X :& Push := switchTo1 <- just pushButton -< X :& Text := pure "Switch to 1"+ X :& Push := switchTo2 <- just pushButton -< X :& Text := pure "Switch to 2" let port = SSignal.fromInitAndUpdate Port1 (union (Port1 <$ switchTo1) (Port2 <$ switchTo2)) localCounter = unOSF $- switch ((\port -> withCounting port) <$> port) `sfApp` inc1- `sfApp` inc2+ polySwitch ((\port -> withCounting port) <$> port) `sfApp` inc1+ `sfApp` inc2 globalCounter = unOSF $- switch ((\port -> withoutCounting port) <$> port) `sfApp` count inc1- `sfApp` count inc2+ polySwitch ((\port -> withoutCounting port) <$> port) `sfApp` count inc1+ `sfApp` count inc2 - X <- just label -< X :& Text ::= localCounter- X <- just label -< X :& Text ::= globalCounter+ X <- just label -< X :& Text := localCounter+ X <- just label -< X :& Text := globalCounter returnA -< () - withCounting :: Port -> SignalFun era (DSignal `Of` () :->+ withCounting :: Port -> PolySignalFun (DSignal `Of` () :-> DSignal `Of` () :-> SSignal `Of` String)- withCounting Port1 = SSF $ \inc1 ->- SSF $ \_ ->- OSF $ count inc1- withCounting Port2 = SSF $ \_ ->- SSF $ \inc2 ->- OSF $ count inc2+ withCounting Port1 = PolySignalFun (SSF $ \inc1 ->+ SSF $ \_ ->+ OSF $ count inc1)+ withCounting Port2 = PolySignalFun (SSF $ \_ ->+ SSF $ \inc2 ->+ OSF $ count inc2) - withoutCounting :: Port -> SignalFun era (SSignal `Of` String :->+ withoutCounting :: Port -> PolySignalFun (SSignal `Of` String :-> SSignal `Of` String :-> SSignal `Of` String)- withoutCounting Port1 = SSF $ \value1 ->- SSF $ \_ ->- OSF $ value1- withoutCounting Port2 = SSF $ \_ ->- SSF $ \value2 ->- OSF $ value2+ withoutCounting Port1 = PolySignalFun (SSF $ \value1 ->+ SSF $ \_ ->+ OSF $ value1)+ withoutCounting Port2 = PolySignalFun (SSF $ \_ ->+ SSF $ \value2 ->+ OSF $ value2) count :: DSignal era dummy -> SSignal era String count dSignal = show <$> SSignal.scan 0 (\num _ -> succ num) dSignal