diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +Copyright © 2007–2009 Brandenburgische Technische Universität Cottbus +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted +provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this list of conditions + and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright notice, this list of + conditions and the following disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of the copyright holders nor the names of the contributors may be used to + endorse or promote products derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER +IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF +THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#!/usr/bin/env runghc + +> import Distribution.Simple +> main = defaultMain diff --git a/grapefruit-examples.cabal b/grapefruit-examples.cabal new file mode 100644 --- /dev/null +++ b/grapefruit-examples.cabal @@ -0,0 +1,50 @@ +Name: grapefruit-examples +Version: 0.0.0.0 +Cabal-Version: >= 1.2.3 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Copyright: © 2007–2009 Brandenburgische Technische Universität Cottbus +Author: Wolfgang Jeltsch +Maintainer: jeltsch@informatik.tu-cottbus.de +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 +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 + in a declarative style. To learn more about FRP, have a look at + . + . + This package contains a collection of examples using Grapefruit. + . + For running an example, you can start GHCi and enter the following: + . + @ + import Graphics.UI.Grapefruit.Circuit + import Graphics.UI.Grapefruit./UIBackend/ + import Examples.Grapefruit./Example/ + 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@. +Category: FRP, Reactivity, GUI, User Interfaces +Tested-With: GHC == 6.8.3 + GHC == 6.10.1 + +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 + Extensions: Arrows + CPP + -- ImpredicativeTypes + Rank2Types + TypeOperators + GHC-Options: -fglasgow-exts + Exposed-Modules: Examples.Grapefruit.Simple + Examples.Grapefruit.Switching + HS-Source-Dirs: src diff --git a/src/Examples/Grapefruit/Simple.hs b/src/Examples/Grapefruit/Simple.hs new file mode 100644 --- /dev/null +++ b/src/Examples/Grapefruit/Simple.hs @@ -0,0 +1,45 @@ +{-| + A Grapefruit example which demonstrates the use of feedback loops. + + A button with one star is shown. Each time, the user clicks on the button, one star is added to + the caption of the button. The interesting thing about this is that the button’s input + depends on the button’s output. So you need the 'ArrowLoop' instance of 'UICircuit'. +-} +module Examples.Grapefruit.Simple ( + + mainCircuit + +) where + + -- Control + import Control.Applicative as Applicative +#if __GLASGOW_HASKELL__ >= 610 + import Control.Arrow as Arrow +#else + import Control.Arrow as Arrow hiding (pure) +#endif + + -- 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 + + -- |The circuit describing the whole application. + mainCircuit :: (StdUIBackend uiBackend) => UICircuit Window uiBackend era () (DSignal era ()) + mainCircuit = proc () -> do + rec let + + title = pure "Simple" + + text = SSignal.scan "*" (const . ('*' :)) push + + X :& Closure ::= closure `With` X :& Push ::= push + <- window `with` just pushButton + -< X :& Title ::= title `With` X :& Text ::= text + returnA -< closure diff --git a/src/Examples/Grapefruit/Switching.hs b/src/Examples/Grapefruit/Switching.hs new file mode 100644 --- /dev/null +++ b/src/Examples/Grapefruit/Switching.hs @@ -0,0 +1,106 @@ +{-| + A Grapefruit example which demonstrates switching. + + The application creates two counters. These can be incremented with the buttons + “Inc 1” and “Inc 2”. On the very right of the window, you + always see the current value of one of those counters. Initially, this is counter 1 but you + can switch between both counters using the buttons “Switch to 1” and + “Switch to 2”. + + At the start of the application and at each press on one of the + “Switch to” buttons, a further counter is created. The value of the last of + these counters is shown left to the other counter value. The initially created counter can be + incremented by pushing the button “Inc 1” and each counter created by a press + on “Switch to /n/” can be incremented by pushing the button + “Inc /n/”. + + The implementation uses Grapefruit’s 'switch' function which provides switching between + signal functions. The arguments of the resulting signal functions are automatically aged, that + is, everything before the time they are used is cut off. The right counter value is created by + counting the presses of the “Inc” buttons, aging the resulting signals and + switching between the aged signals. The left counter value is produced by aging the + “Inc” button press signals, counting the occurences in the aged signals and + switching between the resulting counter signals. +-} +module Examples.Grapefruit.Switching ( + + mainCircuit + +) where + + -- Control + import Control.Applicative as Applicative + import Control.Arrow (arr, returnA) + + -- 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 + + -- |The circuit describing the whole application. + mainCircuit :: (StdUIBackend uiBackend) => UICircuit Window uiBackend era () (DSignal era ()) + mainCircuit = proc _ -> do + X :& Closure ::= closure + `With` _ <- window `with` windowContent -< X :& Title ::= pure "Switching" + `With` () + returnA -< closure + + windowContent :: (StdUIBackend uiBackend) => UIItem Widget uiBackend era () () + windowContent = arr (const (X `With` ())) + |>> StdUIBackend.box Horizontal `with` boxContent >>| + arr (\(X `With` _) -> ()) + + data Port = Port1 | Port2 + + boxContent :: (StdUIBackend 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" + let + + port = SSignal.fromInitAndUpdate Port1 (union (Port1 <$ switchTo1) + (Port2 <$ switchTo2)) + + localCounter = unOSF $ + switch ((\port -> withCounting port) <$> port) `sfApp` inc1 + `sfApp` inc2 + + globalCounter = unOSF $ + switch ((\port -> withoutCounting port) <$> port) `sfApp` count inc1 + `sfApp` count inc2 + + X <- just label -< X :& Text ::= localCounter + X <- just label -< X :& Text ::= globalCounter + returnA -< () + + withCounting :: Port -> SignalFun era (DSignal `Of` () :-> + DSignal `Of` () :-> + SSignal `Of` String) + withCounting Port1 = SSF $ \inc1 -> + SSF $ \_ -> + OSF $ count inc1 + withCounting Port2 = SSF $ \_ -> + SSF $ \inc2 -> + OSF $ count inc2 + + withoutCounting :: Port -> SignalFun era (SSignal `Of` String :-> + SSignal `Of` String :-> + SSignal `Of` String) + withoutCounting Port1 = SSF $ \value1 -> + SSF $ \_ -> + OSF $ value1 + withoutCounting Port2 = SSF $ \_ -> + SSF $ \value2 -> + OSF $ value2 + + count :: DSignal era dummy -> SSignal era String + count dSignal = show <$> SSignal.scan 0 (\num _ -> succ num) dSignal