typed-spreadsheet 1.0.0 → 1.0.1
raw patch · 5 files changed
+287/−73 lines, 5 filesdep +diagrams-cairodep +diagrams-gtkdep +diagrams-libdep −gtk3new-component:exe:typed-spreadsheet-example-graphics
Dependencies added: diagrams-cairo, diagrams-gtk, diagrams-lib, gtk
Dependencies removed: gtk3
Files
- exec/Graphics.hs +28/−0
- exec/Main.hs +0/−14
- exec/Text.hs +14/−0
- src/Typed/Spreadsheet.hs +219/−46
- typed-spreadsheet.cabal +26/−13
+ exec/Graphics.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++import Diagrams.Backend.Cairo (Cairo)+import Diagrams.Prelude+import Typed.Spreadsheet++data AColor = Red | Orange | Yellow | Green | Blue | Purple+ deriving (Enum, Bounded, Show)++toColor :: AColor -> Colour Double+toColor Red = red+toColor Orange = orange+toColor Yellow = yellow+toColor Green = green+toColor Blue = blue+toColor Purple = purple++main :: IO ()+main = graphicalUI "Example program" logic+ where+ logic = combine <$> radioButton "Color" Red [Orange .. Purple]+ <*> spinButtonAt 100 "Radius" 1+ <*> spinButton "X Coordinate" 1+ <*> spinButton "Y Coordinate" 1++ combine :: AColor -> Double -> Double -> Double -> Diagram Cairo+ combine color r x y =+ circle r # fc (toColor color) # translate (r2 (x, -y))
− exec/Main.hs
@@ -1,14 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Control.Applicative-import Typed.Spreadsheet--main :: IO ()-main = textUI "Example program" logic- where- logic = combine <$> checkBox "a"- <*> spinButton "b" 1- <*> spinButton "c" 0.1- <*> entry "d"-- combine a b c d = display (a, b + c, d)
+ exec/Text.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Applicative+import Typed.Spreadsheet++main :: IO ()+main = textUI "Example program" logic+ where+ logic = combine <$> checkBox "a"+ <*> spinButton "b" 1+ <*> spinButton "c" 0.1+ <*> entry "d"++ combine a b c d = display (a, b + c, d)
src/Typed/Spreadsheet.hs view
@@ -43,6 +43,42 @@ -- > d <- entry "d" -- > return (display (a, b + c, d)) ) --+-- This library also supports graphical output, like in the following program:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > import Diagrams.Backend.Cairo (Cairo)+-- > import Diagrams.Prelude+-- > import Typed.Spreadsheet+-- > +-- > data AColor = Red | Orange | Yellow | Green | Blue | Purple+-- > deriving (Enum, Bounded, Show)+-- > +-- > toColor :: AColor -> Colour Double+-- > toColor Red = red+-- > toColor Orange = orange+-- > toColor Yellow = yellow+-- > toColor Green = green+-- > toColor Blue = blue+-- > toColor Purple = purple+-- > +-- > main :: IO ()+-- > main = graphicalUI "Example program" logic+-- > where+-- > logic = combine <$> radioButton "Color" Red [Orange .. Purple]+-- > <*> spinButtonAt 100 "Radius" 1+-- > <*> spinButton "X Coordinate" 1+-- > <*> spinButton "Y Coordinate" 1+-- > +-- > combine :: AColor -> Double -> Double -> Double -> Diagram Cairo+-- > combine color r x y =+-- > circle r # fc (toColor color) # translate (r2 (x, -y))+--+-- This produces a canvas that colors, resizes, and moves a circle in response+-- to user input:+--+-- <<http://i.imgur.com/ddYoG46.png Graphical user interface>>+-- -- The general workflow for this library is: -- -- * You build primitive `Updatable` values using `checkBox`, `spinButton`,@@ -72,6 +108,7 @@ -- * Types Updatable , textUI+ , graphicalUI -- * Controls , checkBox@@ -79,6 +116,11 @@ , entry , radioButton + -- * Controls with Defaults+ , checkBoxAt+ , spinButtonAt+ , entryAt+ -- * Utilities , display @@ -87,12 +129,16 @@ ) where import Control.Applicative+import Control.Concurrent (threadDelay) import Control.Concurrent.STM (STM) import Control.Foldl (Fold(..)) import Control.Monad.IO.Class (liftIO) import Data.Monoid import Data.String (IsString(..)) import Data.Text (Text)+import Diagrams.Backend.Cairo (Cairo)+import Diagrams.Backend.Gtk (renderToGtk)+import Diagrams.Prelude (Diagram, r2, translate, (#)) import Lens.Micro (_Left, _Right) import Graphics.UI.Gtk (AttrOp((:=))) @@ -179,10 +225,10 @@ -- | Use a `Control` to obtain updatable input `Updatable`s data Control = Control- { _checkBox :: Text -> Cell Bool- , _spinButton :: Text -> Double -> Cell Double- , _entry :: Text -> Cell Text- , _radioButton :: forall a . Show a => Text -> a -> [a] -> Cell a+ { _checkBoxAt :: Bool -> Text -> Cell Bool+ , _spinButtonAt :: Double -> Text -> Double -> Cell Double+ , _entryAt :: Text -> Text -> Cell Text+ , _radioButton :: forall a . Show a => Text -> a -> [a] -> Cell a } -- | Build a `Text`-based user interface@@ -192,7 +238,61 @@ -> Updatable Text -- ^ Program logic -> IO ()-textUI title (Updatable k) = do+textUI = ui textSetup processTextEvent+ where+ textSetup :: Gtk.HBox -> IO Gtk.TextBuffer+ textSetup hBox = do+ textView <- Gtk.textViewNew+ textBuffer <- Gtk.get textView Gtk.textViewBuffer+ Gtk.set textView+ [ Gtk.textViewEditable := False+ , Gtk.textViewCursorVisible := False+ ]++ hAdjust <- Gtk.textViewGetHadjustment textView+ vAdjust <- Gtk.textViewGetVadjustment textView+ scrolledWindow <- Gtk.scrolledWindowNew (Just hAdjust) (Just vAdjust)+ Gtk.set scrolledWindow+ [ Gtk.containerChild := textView+ , Gtk.scrolledWindowShadowType := Gtk.ShadowIn+ ]+ Gtk.boxPackStart hBox scrolledWindow Gtk.PackGrow 0+ return textBuffer++ processTextEvent :: Gtk.TextBuffer -> Text -> IO ()+ processTextEvent textBuffer txt =+ Gtk.set textBuffer [ Gtk.textBufferText := txt ]++-- | Build a `Diagram`-based user interface+graphicalUI+ :: Text+ -- ^ Window title+ -> Updatable (Diagram Cairo)+ -- ^ Program logic+ -> IO ()+graphicalUI = ui setupGraphical processGraphicalEvent+ where+ setupGraphical :: Gtk.HBox -> IO Gtk.DrawingArea+ setupGraphical hBox = do+ drawingArea <- Gtk.drawingAreaNew+ Gtk.boxPackStart hBox drawingArea Gtk.PackGrow 0+ return drawingArea++ processGraphicalEvent :: Gtk.DrawingArea -> Diagram Cairo -> IO ()+ processGraphicalEvent drawingArea diagram = do+ drawWindow <- Gtk.widgetGetDrawWindow drawingArea+ (w, h) <- Gtk.widgetGetSize drawingArea+ let w' = fromIntegral w / 2+ let h' = fromIntegral h / 2+ renderToGtk drawWindow (diagram # translate (r2 (w', h')))++-- | Shared logic for `textUI` and `graphicalUI`+ui :: (Gtk.HBox -> IO a)+ -> (a -> b -> IO ())+ -> Text+ -> Updatable b+ -> IO ()+ui setup process title (Updatable k) = do _ <- Gtk.initGUI window <- Gtk.windowNew@@ -200,26 +300,11 @@ [ Gtk.containerBorderWidth := 5 ] - textView <- Gtk.textViewNew- textBuffer <- Gtk.get textView Gtk.textViewBuffer- Gtk.set textView- [ Gtk.textViewEditable := False- , Gtk.textViewCursorVisible := False- ]-- hAdjust <- Gtk.textViewGetHadjustment textView- vAdjust <- Gtk.textViewGetVadjustment textView- scrolledWindow <- Gtk.scrolledWindowNew (Just hAdjust) (Just vAdjust)- Gtk.set scrolledWindow- [ Gtk.containerChild := textView- , Gtk.scrolledWindowShadowType := Gtk.ShadowIn- ]- vBox <- Gtk.vBoxNew False 5 hBox <- Gtk.hBoxNew False 5- Gtk.boxPackStart hBox vBox Gtk.PackNatural 0- Gtk.boxPackStart hBox scrolledWindow Gtk.PackGrow 0+ Gtk.boxPackStart hBox vBox Gtk.PackNatural 0+ a <- setup hBox Gtk.set window [ Gtk.windowTitle := title@@ -228,14 +313,14 @@ , Gtk.windowDefaultHeight := 400 ] - let __spinButton :: Text -> Double -> Cell Double- __spinButton label stepX = Cell (do+ let __spinButtonAt :: Double -> Text -> Double -> Cell Double+ __spinButtonAt s0 label stepX = Cell (do tmvar <- STM.newEmptyTMVarIO let minX = fromIntegral (minBound :: Int) let maxX = fromIntegral (maxBound :: Int) spinButton_ <- Gtk.spinButtonNewWithRange minX maxX stepX Gtk.set spinButton_- [ Gtk.spinButtonValue := 0+ [ Gtk.spinButtonValue := s0 ] _ <- Gtk.onValueSpinned spinButton_ (do n <- Gtk.get spinButton_ Gtk.spinButtonValue@@ -249,12 +334,13 @@ Gtk.boxPackStart vBox frame Gtk.PackNatural 0 Gtk.widgetShowAll vBox- return (STM.takeTMVar tmvar, Fold.lastDef 0) )+ return (STM.takeTMVar tmvar, Fold.lastDef s0) ) - let __checkBox :: Text -> Cell Bool- __checkBox label = Cell (do+ let __checkBoxAt :: Bool -> Text -> Cell Bool+ __checkBoxAt s0 label = Cell (do checkButton <- Gtk.checkButtonNewWithLabel label + Gtk.set checkButton [ Gtk.toggleButtonActive := s0 ] tmvar <- STM.newEmptyTMVarIO _ <- Gtk.on checkButton Gtk.toggled (do pressed <- Gtk.get checkButton Gtk.toggleButtonActive@@ -262,10 +348,10 @@ Gtk.boxPackStart vBox checkButton Gtk.PackNatural 0 Gtk.widgetShowAll vBox- return (STM.takeTMVar tmvar, Fold.lastDef False) )+ return (STM.takeTMVar tmvar, Fold.lastDef s0) ) - let __entry :: Text -> Cell Text- __entry label = Cell (do+ let __entryAt :: Text -> Text -> Cell Text+ __entryAt s0 label = Cell (do entry_ <- Gtk.entryNew frame <- Gtk.frameNew@@ -273,6 +359,7 @@ [ Gtk.containerChild := entry_ , Gtk.frameLabel := label ]+ Gtk.set entry_ [ Gtk.entryText := s0 ] tmvar <- STM.newEmptyTMVarIO _ <- Gtk.on entry_ Gtk.editableChanged (do@@ -281,7 +368,7 @@ Gtk.boxPackStart vBox frame Gtk.PackNatural 0 Gtk.widgetShowAll frame- return (STM.takeTMVar tmvar, Fold.lastDef Text.empty) )+ return (STM.takeTMVar tmvar, Fold.lastDef s0) ) let __radioButton :: Show a => Text -> a -> [a] -> Cell a __radioButton label x xs = Cell (do@@ -293,8 +380,8 @@ button <- f (show a) Gtk.boxPackStart vBoxRadio button Gtk.PackNatural 0 _ <- Gtk.on button Gtk.toggled (do- mode <- Gtk.get button Gtk.toggleButtonMode- if mode+ active <- Gtk.get button Gtk.toggleButtonActive+ if active then STM.atomically (STM.putTMVar tmvar a) else return () ) return button@@ -312,21 +399,21 @@ return (STM.takeTMVar tmvar, Fold.lastDef x) ) let control = Control- { _checkBox = __checkBox- , _spinButton = __spinButton- , _entry = __entry- , _radioButton = __radioButton+ { _checkBoxAt = __checkBoxAt+ , _spinButtonAt = __spinButtonAt+ , _entryAt = __entryAt+ , _radioButton = __radioButton } doneTMVar <- STM.newEmptyTMVarIO - let run :: Cell Text -> IO ()- run (Cell m) = do+ let run (Cell m) = do (stm, Fold step begin done) <- Gtk.postGUISync m+ -- I don't know why this delay is necessary for diagrams output+ threadDelay 200000 let loop x = do- let txt = done x- Gtk.postGUISync- (Gtk.set textBuffer [ Gtk.textBufferText := txt ])+ let b = done x+ Gtk.postGUISync (process a b) let doneTransaction = do STM.takeTMVar doneTMVar return Nothing@@ -350,7 +437,7 @@ :: Text -- ^ Label -> Updatable Bool-checkBox label = Updatable (\control -> _checkBox control label)+checkBox = checkBoxAt False -- | A `Double` spin button spinButton@@ -359,14 +446,14 @@ -> Double -- ^ Step size -> Updatable Double-spinButton label x = Updatable (\control -> _spinButton control label x)+spinButton = spinButtonAt 0 -- | A `Text` entry entry :: Text -- ^ Label -> Updatable Text-entry label = Updatable (\control -> _entry control label)+entry = entryAt Text.empty -- | A control that selects from one or more mutually exclusive choices radioButton@@ -381,6 +468,37 @@ radioButton label a0 as = Updatable (\control -> _radioButton control label a0 as) +-- | Same as `checkBox` except that you can specify the initial state+checkBoxAt+ :: Bool+ -- ^ Initial state + -> Text+ -- ^ Label+ -> Updatable Bool+checkBoxAt s0 label =+ Updatable (\control -> _checkBoxAt control s0 label)++-- | Same as `spinButton` except that you can specify the initial state+spinButtonAt+ :: Double+ -- ^ Initial state+ -> Text+ -- ^ Label+ -> Double+ -- ^ Step size+ -> Updatable Double+spinButtonAt s0 label x =+ Updatable (\control -> _spinButtonAt control s0 label x)++-- | Same as `entry` except that you can specify the initial state+entryAt+ :: Text+ -- ^ Initial state+ -> Text+ -- ^ Label+ -> Updatable Text+entryAt s0 label = Updatable (\control -> _entryAt control s0 label)+ -- | Convert a `Show`able value to `Text` display :: Show a => a -> Text display = Text.pack . show@@ -441,3 +559,58 @@ -- Example input and output: -- -- <<http://i.imgur.com/k22An4Y.png Mad libs program>>+--+-- Sinusoid plot:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > import Diagrams.Backend.Cairo (Cairo)+-- > import Diagrams.Prelude+-- > import Typed.Spreadsheet+-- > +-- > main :: IO ()+-- > main = graphicalUI "Example program" logic+-- > where+-- > logic = combine <$> spinButtonAt 50 "Amplitude (Pixels)" 0.1+-- > <*> spinButtonAt 0.1 "Frequency (Pixels⁻¹)" 0.001+-- > <*> spinButtonAt 90 "Phase (Degrees)" 1+-- > +-- > combine :: Double -> Double -> Double -> Diagram Cairo+-- > combine amplitude frequency phase = strokeP (fromVertices points) <> axes+-- > where+-- > axes = arrowBetween (p2 (0, 0)) (p2 ( 100, 0))+-- > <> arrowBetween (p2 (0, 0)) (p2 (-100, 0))+-- > <> arrowBetween (p2 (0, 0)) (p2 ( 0, 100))+-- > <> arrowBetween (p2 (0, 0)) (p2 ( 0, -100))+-- > +-- > f x = - amplitude * cos (frequency * x + phase * pi / 180)+-- > +-- > points = map (\x -> p2 (x, f x)) [-100, -99 .. 100]+--+-- Example input and output:+--+-- <<http://i.imgur.com/ueF0w7U.png Sinusoid plot>>+--+-- Factor diagram:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > import Diagrams.Backend.Cairo (Cairo)+-- > import Diagrams.Prelude+-- > import Diagrams.TwoD.Factorization (factorDiagram')+-- > import Typed.Spreadsheet+-- > +-- > main :: IO ()+-- > main = graphicalUI "Factor diagram" logic+-- > where+-- > logic = combine <$> spinButtonAt 3 "Factor #1" 1+-- > <*> spinButtonAt 3 "Factor #2" 1+-- > <*> spinButtonAt 3 "Factor #3" 1+-- > +-- > combine :: Double -> Double -> Double -> Diagram Cairo+-- > combine x y z =+-- > factorDiagram' [truncate x, truncate y, truncate z] # scale 10+--+-- Example input and output:+--+-- <<http://i.imgur.com/eMvMtKk.png Factor diagram>>
typed-spreadsheet.cabal view
@@ -1,5 +1,5 @@ Name: typed-spreadsheet-Version: 1.0.0+Version: 1.0.1 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -31,22 +31,35 @@ Library Hs-Source-Dirs: src Build-Depends:- base >= 4 && < 5 ,- async >= 2.0 && < 2.1 ,- foldl >= 1.1 && < 1.2 ,- gtk3 >= 0.14.0 && < 0.15,- microlens < 0.4 ,- stm < 2.5 ,- text < 1.3 ,- transformers >= 0.2.0.0 && < 0.5+ base >= 4 && < 5 ,+ async >= 2.0 && < 2.1 ,+ diagrams-cairo >= 1.3 && < 1.4 ,+ diagrams-gtk >= 1.3 && < 1.4 ,+ diagrams-lib >= 1.3 && < 1.4 ,+ foldl >= 1.1 && < 1.2 ,+ gtk >= 0.13 && < 0.14,+ microlens < 0.4 ,+ stm < 2.5 ,+ text < 1.3 ,+ transformers >= 0.2.0.0 && < 0.5 Exposed-Modules: Typed.Spreadsheet GHC-Options: -O2 -Wall Executable typed-spreadsheet-example Hs-Source-Dirs: exec- Main-Is: Main.hs+ Main-Is: Text.hs Build-Depends:- base >= 4 && < 5 ,- typed-spreadsheet ,- text < 1.3+ base >= 4 && < 5 ,+ text < 1.3,+ typed-spreadsheet+ GHC-Options: -O2 -Wall -threaded++Executable typed-spreadsheet-example-graphics+ Hs-Source-Dirs: exec+ Main-Is: Graphics.hs+ Build-Depends:+ base >= 4 && < 5 ,+ diagrams-cairo >= 1.3 && < 1.4,+ diagrams-lib >= 1.3 && < 1.4,+ typed-spreadsheet GHC-Options: -O2 -Wall -threaded