packages feed

gtk2hs-rpn (empty) → 0.0.1

raw patch · 9 files changed

+1131/−0 lines, 9 filesdep +basedep +cairodep +gtksetup-changed

Dependencies added: base, cairo, gtk, mtl

Files

+ .hg_archival.txt view
@@ -0,0 +1,2 @@+repo: 73f9f23123106e581edbcf74b725d9a23e2eb1f4+node: 7eab16509ef9e1c66dac522e1cfb48701d3ee1e8
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++import Distribution.Simple++main = defaultMain
+ gtk2hs-rpn.cabal view
@@ -0,0 +1,29 @@+cabal-Version: >= 1.2+name: gtk2hs-rpn+version: 0.0.1+synopsis:+  Adds a module to gtk2hs allowing layouts to+  be defined using reverse polish notation.+description:+  Adds a module 'Graphics.UI.Gtk.Layout.Rpn' to+  gtk2hs. This module defines a type 'RPN' for+  operators, and is an instance of Monoid class.+  You can combine those operators to define a+  layout, as well as buttons and other widgets.+build-type: Simple+license: LGPL+maintainer: Maurício CA <mauricio.antunes@gmail.com>+category: GUI+Library+  build-depends: base, gtk >= 0.10, cairo, mtl+  hs-source-dirs: src+  extensions:+    NoMonomorphismRestriction+  exposed-modules:+    Graphics.UI.Gtk.Layout.Rpn+Executable example+  main-is: example.hs+  build-depends: base, gtk >= 0.10, cairo+  hs-source-dirs: src+  extensions:+    NoMonomorphismRestriction
+ src/CanBeCasted.hs view
@@ -0,0 +1,508 @@+module CanBeCasted where {+import Graphics.UI.Gtk ;+import Graphics.UI.Gtk.Types ;++ class ( GObjectClass g ) => CanBeCasted g where {+     glibCast :: ( GObjectClass o ) => o -> Maybe g ;+     glibCast a = if isA a t then Just ( c a ) else Nothing+         where { ( t , c ) = castData } ;+     castData :: ( GObjectClass g1 ) => ( GType , g1 -> g )+ } ;++ instance CanBeCasted AboutDialog where {+     castData = ( gTypeAboutDialog , castToAboutDialog )+ } ;+ instance CanBeCasted AccelLabel where {+     castData = ( gTypeAccelLabel , castToAccelLabel )+ } ;+ instance CanBeCasted Action where {+     castData = ( gTypeAction , castToAction )+ } ;+ instance CanBeCasted ActionGroup where {+     castData = ( gTypeActionGroup , castToActionGroup )+ } ;+-- instance CanBeCasted Adapter where {+--     castData = ( gTypeAdapter , castToAdapter )+-- } ;+ instance CanBeCasted Adjustment where {+     castData = ( gTypeAdjustment , castToAdjustment )+ } ;+ instance CanBeCasted Alignment where {+     castData = ( gTypeAlignment , castToAlignment )+ } ;+ instance CanBeCasted Arrow where {+     castData = ( gTypeArrow , castToArrow )+ } ;+ instance CanBeCasted AspectFrame where {+     castData = ( gTypeAspectFrame , castToAspectFrame )+ } ;+-- instance CanBeCasted BaseSink where {+--     castData = ( gTypeBaseSink , castToBaseSink )+-- } ;+-- instance CanBeCasted BaseSrc where {+--     castData = ( gTypeBaseSrc , castToBaseSrc )+-- } ;+-- instance CanBeCasted BaseTransform where {+--     castData = ( gTypeBaseTransform , castToBaseTransform )+-- } ;+ instance CanBeCasted Bin where {+     castData = ( gTypeBin , castToBin )+ } ;+ instance CanBeCasted Box where {+     castData = ( gTypeBox , castToBox )+ } ;+-- instance CanBeCasted Buffer where {+--     castData = ( gTypeBuffer , castToBuffer )+-- } ;+-- instance CanBeCasted Bus where {+--     castData = ( gTypeBus , castToBus )+-- } ;+ instance CanBeCasted Button where {+     castData = ( gTypeButton , castToButton )+ } ;+ instance CanBeCasted ButtonBox where {+     castData = ( gTypeButtonBox , castToButtonBox )+ } ;+ instance CanBeCasted Calendar where {+     castData = ( gTypeCalendar , castToCalendar )+ } ;+ instance CanBeCasted CellRenderer where {+     castData = ( gTypeCellRenderer , castToCellRenderer )+ } ;+ instance CanBeCasted CellRendererCombo where {+     castData = ( gTypeCellRendererCombo , castToCellRendererCombo )+ } ;+ instance CanBeCasted CellRendererPixbuf where {+     castData = ( gTypeCellRendererPixbuf , castToCellRendererPixbuf )+ } ;+ instance CanBeCasted CellRendererProgress where {+     castData = ( gTypeCellRendererProgress , castToCellRendererProgress )+ } ;+ instance CanBeCasted CellRendererText where {+     castData = ( gTypeCellRendererText , castToCellRendererText )+ } ;+ instance CanBeCasted CellRendererToggle where {+     castData = ( gTypeCellRendererToggle , castToCellRendererToggle )+ } ;+ instance CanBeCasted CellView where {+     castData = ( gTypeCellView , castToCellView )+ } ;+ instance CanBeCasted CheckButton where {+     castData = ( gTypeCheckButton , castToCheckButton )+ } ;+ instance CanBeCasted CheckMenuItem where {+     castData = ( gTypeCheckMenuItem , castToCheckMenuItem )+ } ;+ instance CanBeCasted Clipboard where {+     castData = ( gTypeClipboard , castToClipboard )+ } ;+-- instance CanBeCasted Clock where {+--     castData = ( gTypeClock , castToClock )+-- } ;+ instance CanBeCasted ColorButton where {+     castData = ( gTypeColorButton , castToColorButton )+ } ;+ instance CanBeCasted ColorSelection where {+     castData = ( gTypeColorSelection , castToColorSelection )+ } ;+ instance CanBeCasted ColorSelectionDialog where {+     castData = ( gTypeColorSelectionDialog , castToColorSelectionDialog )+ } ;+ instance CanBeCasted Combo where {+     castData = ( gTypeCombo , castToCombo )+ } ;+ instance CanBeCasted ComboBox where {+     castData = ( gTypeComboBox , castToComboBox )+ } ;+ instance CanBeCasted ComboBoxEntry where {+     castData = ( gTypeComboBoxEntry , castToComboBoxEntry )+ } ;+ instance CanBeCasted Container where {+     castData = ( gTypeContainer , castToContainer )+ } ;+ instance CanBeCasted Dialog where {+     castData = ( gTypeDialog , castToDialog )+ } ;+ instance CanBeCasted DragContext where {+     castData = ( gTypeDragContext , castToDragContext )+ } ;+ instance CanBeCasted DrawWindow where {+     castData = ( gTypeDrawWindow , castToDrawWindow )+ } ;+ instance CanBeCasted Drawable where {+     castData = ( gTypeDrawable , castToDrawable )+ } ;+ instance CanBeCasted DrawingArea where {+     castData = ( gTypeDrawingArea , castToDrawingArea )+ } ;+-- instance CanBeCasted Drive where {+--     castData = ( gTypeDrive , castToDrive )+-- } ;+ instance CanBeCasted Editable where {+     castData = ( gTypeEditable , castToEditable )+ } ;+-- instance CanBeCasted Element where {+--     castData = ( gTypeElement , castToElement )+-- } ;+-- instance CanBeCasted ElementFactory where {+--     castData = ( gTypeElementFactory , castToElementFactory )+-- } ;+ instance CanBeCasted Entry where {+     castData = ( gTypeEntry , castToEntry )+ } ;+ instance CanBeCasted EntryCompletion where {+     castData = ( gTypeEntryCompletion , castToEntryCompletion )+ } ;+ instance CanBeCasted EventBox where {+     castData = ( gTypeEventBox , castToEventBox )+ } ;+ instance CanBeCasted Expander where {+     castData = ( gTypeExpander , castToExpander )+ } ;+ instance CanBeCasted FileChooser where {+     castData = ( gTypeFileChooser , castToFileChooser )+ } ;+ instance CanBeCasted FileChooserButton where {+     castData = ( gTypeFileChooserButton , castToFileChooserButton )+ } ;+ instance CanBeCasted FileChooserDialog where {+     castData = ( gTypeFileChooserDialog , castToFileChooserDialog )+ } ;+ instance CanBeCasted FileChooserWidget where {+     castData = ( gTypeFileChooserWidget , castToFileChooserWidget )+ } ;+ instance CanBeCasted FileFilter where {+     castData = ( gTypeFileFilter , castToFileFilter )+ } ;+ instance CanBeCasted FileSelection where {+     castData = ( gTypeFileSelection , castToFileSelection )+ } ;+ instance CanBeCasted Fixed where {+     castData = ( gTypeFixed , castToFixed )+ } ;+ instance CanBeCasted FontButton where {+     castData = ( gTypeFontButton , castToFontButton )+ } ;+ instance CanBeCasted FontSelection where {+     castData = ( gTypeFontSelection , castToFontSelection )+ } ;+ instance CanBeCasted FontSelectionDialog where {+     castData = ( gTypeFontSelectionDialog , castToFontSelectionDialog )+ } ;+ instance CanBeCasted Frame where {+     castData = ( gTypeFrame , castToFrame )+ } ;+ instance CanBeCasted GC where {+     castData = ( gTypeGC , castToGC )+ } ;+-- instance CanBeCasted GLConfig where {+--     castData = ( gTypeGLConfig , castToGLConfig )+-- } ;+-- instance CanBeCasted GLContext where {+--     castData = ( gTypeGLContext , castToGLContext )+-- } ;+-- instance CanBeCasted GLDrawable where {+--     castData = ( gTypeGLDrawable , castToGLDrawable )+-- } ;+-- instance CanBeCasted GLPixmap where {+--     castData = ( gTypeGLPixmap , castToGLPixmap )+-- } ;+-- instance CanBeCasted GLWindow where {+--     castData = ( gTypeGLWindow , castToGLWindow )+-- } ;+-- instance CanBeCasted GhostPad where {+--     castData = ( gTypeGhostPad , castToGhostPad )+-- } ;+ instance CanBeCasted HBox where {+     castData = ( gTypeHBox , castToHBox )+ } ;+ instance CanBeCasted HButtonBox where {+     castData = ( gTypeHButtonBox , castToHButtonBox )+ } ;+ instance CanBeCasted HPaned where {+     castData = ( gTypeHPaned , castToHPaned )+ } ;+ instance CanBeCasted HScale where {+     castData = ( gTypeHScale , castToHScale )+ } ;+ instance CanBeCasted HScrollbar where {+     castData = ( gTypeHScrollbar , castToHScrollbar )+ } ;+ instance CanBeCasted HSeparator where {+     castData = ( gTypeHSeparator , castToHSeparator )+ } ;+ instance CanBeCasted HandleBox where {+     castData = ( gTypeHandleBox , castToHandleBox )+ } ;+ instance CanBeCasted IconFactory where {+     castData = ( gTypeIconFactory , castToIconFactory )+ } ;+ instance CanBeCasted IconView where {+     castData = ( gTypeIconView , castToIconView )+ } ;+ instance CanBeCasted Image where {+     castData = ( gTypeImage , castToImage )+ } ;+ instance CanBeCasted ImageMenuItem where {+     castData = ( gTypeImageMenuItem , castToImageMenuItem )+ } ;+-- instance CanBeCasted ImplementsInterface where {+--     castData = ( gTypeImplementsInterface , castToImplementsInterface )+-- } ;+-- instance CanBeCasted Index where {+--     castData = ( gTypeIndex , castToIndex )+-- } ;+-- instance CanBeCasted IndexFactory where {+--     castData = ( gTypeIndexFactory , castToIndexFactory )+-- } ;+ instance CanBeCasted Label where {+     castData = ( gTypeLabel , castToLabel )+ } ;+ instance CanBeCasted Layout where {+     castData = ( gTypeLayout , castToLayout )+ } ;+ instance CanBeCasted Menu where {+     castData = ( gTypeMenu , castToMenu )+ } ;+ instance CanBeCasted MenuBar where {+     castData = ( gTypeMenuBar , castToMenuBar )+ } ;+ instance CanBeCasted MenuItem where {+     castData = ( gTypeMenuItem , castToMenuItem )+ } ;+ instance CanBeCasted MenuShell where {+     castData = ( gTypeMenuShell , castToMenuShell )+ } ;+ instance CanBeCasted MenuToolButton where {+     castData = ( gTypeMenuToolButton , castToMenuToolButton )+ } ;+-- instance CanBeCasted Message where {+--     castData = ( gTypeMessage , castToMessage )+-- } ;+ instance CanBeCasted MessageDialog where {+     castData = ( gTypeMessageDialog , castToMessageDialog )+ } ;+-- instance CanBeCasted MiniObject where {+--     castData = ( gTypeMiniObject , castToMiniObject )+-- } ;+ instance CanBeCasted Misc where {+     castData = ( gTypeMisc , castToMisc )+ } ;+ instance CanBeCasted Notebook where {+     castData = ( gTypeNotebook , castToNotebook )+ } ;+ instance CanBeCasted Object where {+     castData = ( gTypeObject , castToObject )+ } ;+ instance CanBeCasted OptionMenu where {+     castData = ( gTypeOptionMenu , castToOptionMenu )+ } ;+-- instance CanBeCasted Pad where {+--     castData = ( gTypePad , castToPad )+-- } ;+-- instance CanBeCasted PadTemplate where {+--     castData = ( gTypePadTemplate , castToPadTemplate )+-- } ;+ instance CanBeCasted Paned where {+     castData = ( gTypePaned , castToPaned )+ } ;+-- instance CanBeCasted Pipeline where {+--     castData = ( gTypePipeline , castToPipeline )+-- } ;+ instance CanBeCasted Pixbuf where {+     castData = ( gTypePixbuf , castToPixbuf )+ } ;+ instance CanBeCasted Plug where {+     castData = ( gTypePlug , castToPlug )+ } ;+-- instance CanBeCasted Plugin where {+--     castData = ( gTypePlugin , castToPlugin )+-- } ;+-- instance CanBeCasted PluginFeature where {+--     castData = ( gTypePluginFeature , castToPluginFeature )+-- } ;+ instance CanBeCasted ProgressBar where {+     castData = ( gTypeProgressBar , castToProgressBar )+ } ;+-- instance CanBeCasted PushSrc where {+--     castData = ( gTypePushSrc , castToPushSrc )+-- } ;+-- instance CanBeCasted Query where {+--     castData = ( gTypeQuery , castToQuery )+-- } ;+ instance CanBeCasted RadioAction where {+     castData = ( gTypeRadioAction , castToRadioAction )+ } ;+ instance CanBeCasted RadioButton where {+     castData = ( gTypeRadioButton , castToRadioButton )+ } ;+ instance CanBeCasted RadioMenuItem where {+     castData = ( gTypeRadioMenuItem , castToRadioMenuItem )+ } ;+ instance CanBeCasted RadioToolButton where {+     castData = ( gTypeRadioToolButton , castToRadioToolButton )+ } ;+ instance CanBeCasted Range where {+     castData = ( gTypeRange , castToRange )+ } ;+-- instance CanBeCasted Registry where {+--     castData = ( gTypeRegistry , castToRegistry )+-- } ;+ instance CanBeCasted Scale where {+     castData = ( gTypeScale , castToScale )+ } ;+ instance CanBeCasted Screen where {+     castData = ( gTypeScreen , castToScreen )+ } ;+ instance CanBeCasted Scrollbar where {+     castData = ( gTypeScrollbar , castToScrollbar )+ } ;+ instance CanBeCasted ScrolledWindow where {+     castData = ( gTypeScrolledWindow , castToScrolledWindow )+ } ;+ instance CanBeCasted Separator where {+     castData = ( gTypeSeparator , castToSeparator )+ } ;+ instance CanBeCasted SeparatorMenuItem where {+     castData = ( gTypeSeparatorMenuItem , castToSeparatorMenuItem )+ } ;+ instance CanBeCasted SeparatorToolItem where {+     castData = ( gTypeSeparatorToolItem , castToSeparatorToolItem )+ } ;+ instance CanBeCasted SizeGroup where {+     castData = ( gTypeSizeGroup , castToSizeGroup )+ } ;+ instance CanBeCasted Socket where {+     castData = ( gTypeSocket , castToSocket )+ } ;+-- instance CanBeCasted SourceBuffer where {+--     castData = ( gTypeSourceBuffer , castToSourceBuffer )+-- } ;+-- instance CanBeCasted SourceLanguage where {+--     castData = ( gTypeSourceLanguage , castToSourceLanguage )+-- } ;+-- instance CanBeCasted SourceLanguageManager where {+--     castData = ( gTypeSourceLanguageManager , castToSourceLanguageManager )+-- } ;+-- instance CanBeCasted SourceMark where {+--     castData = ( gTypeSourceMark , castToSourceMark )+-- } ;+-- instance CanBeCasted SourceStyleScheme where {+--     castData = ( gTypeSourceStyleScheme , castToSourceStyleScheme )+-- } ;+-- instance CanBeCasted SourceView where {+--     castData = ( gTypeSourceView , castToSourceView )+-- } ;+ instance CanBeCasted SpinButton where {+     castData = ( gTypeSpinButton , castToSpinButton )+ } ;+ instance CanBeCasted StatusIcon where {+     castData = ( gTypeStatusIcon , castToStatusIcon )+ } ;+ instance CanBeCasted Statusbar where {+     castData = ( gTypeStatusbar , castToStatusbar )+ } ;+ instance CanBeCasted Style where {+     castData = ( gTypeStyle , castToStyle )+ } ;+-- instance CanBeCasted SystemClock where {+--     castData = ( gTypeSystemClock , castToSystemClock )+-- } ;+ instance CanBeCasted Table where {+     castData = ( gTypeTable , castToTable )+ } ;+ instance CanBeCasted TearoffMenuItem where {+     castData = ( gTypeTearoffMenuItem , castToTearoffMenuItem )+ } ;+ instance CanBeCasted TextBuffer where {+     castData = ( gTypeTextBuffer , castToTextBuffer )+ } ;+ instance CanBeCasted TextMark where {+     castData = ( gTypeTextMark , castToTextMark )+ } ;+ instance CanBeCasted TextTag where {+     castData = ( gTypeTextTag , castToTextTag )+ } ;+ instance CanBeCasted TextTagTable where {+     castData = ( gTypeTextTagTable , castToTextTagTable )+ } ;+ instance CanBeCasted TextView where {+     castData = ( gTypeTextView , castToTextView )+ } ;+ instance CanBeCasted ToggleAction where {+     castData = ( gTypeToggleAction , castToToggleAction )+ } ;+ instance CanBeCasted ToggleButton where {+     castData = ( gTypeToggleButton , castToToggleButton )+ } ;+ instance CanBeCasted ToggleToolButton where {+     castData = ( gTypeToggleToolButton , castToToggleToolButton )+ } ;+ instance CanBeCasted ToolButton where {+     castData = ( gTypeToolButton , castToToolButton )+ } ;+ instance CanBeCasted ToolItem where {+     castData = ( gTypeToolItem , castToToolItem )+ } ;+ instance CanBeCasted Toolbar where {+     castData = ( gTypeToolbar , castToToolbar )+ } ;+ instance CanBeCasted Tooltips where {+     castData = ( gTypeTooltips , castToTooltips )+ } ;+ instance CanBeCasted TreeModel where {+     castData = ( gTypeTreeModel , castToTreeModel )+ } ;+ instance CanBeCasted TreeModelSort where {+     castData = ( gTypeTreeModelSort , castToTreeModelSort )+ } ;+ instance CanBeCasted TreeSelection where {+     castData = ( gTypeTreeSelection , castToTreeSelection )+ } ;+ instance CanBeCasted TreeSortable where {+     castData = ( gTypeTreeSortable , castToTreeSortable )+ } ;+ instance CanBeCasted TreeView where {+     castData = ( gTypeTreeView , castToTreeView )+ } ;+ instance CanBeCasted TreeViewColumn where {+     castData = ( gTypeTreeViewColumn , castToTreeViewColumn )+ } ;+ instance CanBeCasted UIManager where {+     castData = ( gTypeUIManager , castToUIManager )+ } ;+ instance CanBeCasted VBox where {+     castData = ( gTypeVBox , castToVBox )+ } ;+ instance CanBeCasted VButtonBox where {+     castData = ( gTypeVButtonBox , castToVButtonBox )+ } ;+ instance CanBeCasted VPaned where {+     castData = ( gTypeVPaned , castToVPaned )+ } ;+ instance CanBeCasted VScale where {+     castData = ( gTypeVScale , castToVScale )+ } ;+ instance CanBeCasted VScrollbar where {+     castData = ( gTypeVScrollbar , castToVScrollbar )+ } ;+ instance CanBeCasted VSeparator where {+     castData = ( gTypeVSeparator , castToVSeparator )+ } ;+ instance CanBeCasted Viewport where {+     castData = ( gTypeViewport , castToViewport )+ } ;+-- instance CanBeCasted Volume where {+--     castData = ( gTypeVolume , castToVolume )+-- } ;+ instance CanBeCasted Widget where {+     castData = ( gTypeWidget , castToWidget )+ } ;+ instance CanBeCasted Window where {+     castData = ( gTypeWindow , castToWindow )+ } ;+ instance CanBeCasted WindowGroup where {+     castData = ( gTypeWindowGroup , castToWindowGroup )+ }++}
+ src/Graphics/UI/Gtk/Layout/Rpn.hs view
@@ -0,0 +1,374 @@+module Graphics.UI.Gtk.Layout.Rpn where { import Graphics.UI.Gtk hiding+( get ) ; import qualified Data.Word ; import Data.Monoid ; import+Control.Monad.State ;+import Graphics.UI.Gtk.Types ;+import Graphics.Rendering.Cairo ;+import Graphics.UI.Gtk.Gdk.EventM ;+import Data.IORef ;+import Data.Maybe ;+import Data.List ;+import CanBeCasted ;++ doNothing :: (Monad m) => m () ;+ doNothing = return () ;++ maybeDoNothing :: (Monad m) => Maybe a -> ( a -> m b ) -> m () ;+ maybeDoNothing a f = maybe doNothing f' a+     where { f' a = f a >> doNothing } ;++ type ActionType a = StateT [ Widget ] IO a ;++ pushWidget :: ( WidgetClass w ) => w -> ActionType () ;+ pushWidget w = modify ( toWidget w : ) ;++ touchWidget :: ( CanBeCasted a ) => ( a -> IO b ) -> ActionType () ;+ touchWidget f = do {+     w <- ( liftM $ take 1 ) get ;+     case mapMaybe glibCast w of {+         [ w' ] -> liftIO $ f w' >> doNothing ;+         _ -> doNothing+     }+ } ;++ reachWidget :: ( CanBeCasted a ) => Int -> ActionType ( Maybe a ) ;+ reachWidget n = do {+     s <- get ;+     return $ if length s > n+         then glibCast ( s !! n )+         else Nothing+ } ;++ pullWidget :: ( CanBeCasted a , CanBeCasted b ) =>+ ( a -> b -> IO c ) -> ActionType () ;+ pullWidget f = do {+     w0 <- reachWidget 0 ;+     w1 <- reachWidget 1 ;+     case ( w0 , w1 ) of {+         ( Just w0' , Just w1' ) -> do {+             liftIO $ f w0' w1' ;+             ( s : ss ) <- get ;+             put $ s : drop 1 ss+         } ;+         _ -> doNothing+     }+ } ;++ pullWidget3 :: ( CanBeCasted a , CanBeCasted b , CanBeCasted c ,+ CanBeCasted d ) => ( a -> b -> c -> d -> IO e ) -> ActionType () ;+ pullWidget3 f = do {+     w0 <- reachWidget 0 ;+     w1 <- reachWidget 1 ;+     w2 <- reachWidget 2 ;+     w3 <- reachWidget 3 ;+     case ( w0 , w1 , w2 , w3 ) of {+         ( Just w0 , Just w1 , Just w2 , Just w3 ) -> do {+             liftIO $ f w0 w1 w2 w3 ;+             ( s : ss ) <- get ;+             put $ s : drop 3 ss+         } ;+         _ -> doNothing+     }+ } ;++ newtype RPN = RPN ( ActionType () ) ;++ instance Monoid RPN where { mempty = RPN doNothing ; mappend ( RPN+ rpn1 ) ( RPN rpn2 ) = RPN $ rpn1 >> rpn2 } ;++ widgetsFromRpn :: RPN -> IO [ Widget ] ;+ widgetsFromRpn ( RPN rpn ) = ( liftM $ reverse )  ( execStateT rpn [] ) ;++ io2rpn :: ( WidgetClass w ) => IO w -> RPN ;+ io2rpn = RPN . ( >>= pushWidget ) . liftIO ;++ cWID = RPN . pushWidget ;+ cACL = io2rpn . accelLabelNew ;+ cALN = ((( io2rpn .).).). alignmentNew ;+ cARW = ( io2rpn .). arrowNew ;+ cAFR = (( io2rpn .).). aspectFrameNew ;+ cBTN = io2rpn buttonNew ;+ cBTNSTK = io2rpn . buttonNewFromStock ;+ cBTNL = io2rpn . buttonNewWithLabel ;+ cBTNMNM = io2rpn . buttonNewWithMnemonic ;+ cCLD = io2rpn calendarNew ;+ cCVW = io2rpn cellViewNew ;+ cCVWPIX = io2rpn . cellViewNewWithPixbuf ;+ cCVWMRK = io2rpn . cellViewNewWithMarkup ;+ cCVWTXT = io2rpn . cellViewNewWithText ;+ cBTNCHK = io2rpn checkButtonNew ;+ cBTNCHKL = io2rpn . checkButtonNewWithLabel ;+ cBTNCHKMNM = io2rpn . checkButtonNewWithMnemonic ;+ cMENCHKIT = io2rpn checkMenuItemNew ;+ cMENCHKITL = io2rpn . checkMenuItemNewWithLabel ;+ cMENCHKITMNM = io2rpn . checkMenuItemNewWithMnemonic ;+ cBTNCLR = io2rpn colorButtonNew ;+ cBTNCLRCL = io2rpn . colorButtonNewWithColor ;+ cCLRSEL = io2rpn colorSelectionNew ;+ cCMBENY = io2rpn comboBoxEntryNew ;+ cCMBENYTXT = io2rpn comboBoxEntryNewText ;+ cCMBENYMDL = io2rpn . comboBoxEntryNewWithModel ;+ cCMB = io2rpn comboBoxNew ;+ cCMBTXT = io2rpn comboBoxNewText ;+ cCMBMDL = io2rpn . comboBoxNewWithModel ;+ cDRW = io2rpn drawingAreaNew ;+ cENY = io2rpn entryNew ;+ cEVN = io2rpn eventBoxNew ;+ cEXN = io2rpn . expanderNew ;+ cEXNMNM = io2rpn . expanderNewWithMnemonic ;+ cBTNFLE = ( io2rpn .). fileChooserButtonNew ;+ cFLESEL = io2rpn . fileChooserWidgetNew ;+ cFXD = io2rpn fixedNew ;+ cBTNFON = io2rpn fontButtonNew ;+ cBTNFONFN = io2rpn . fontButtonNewWithFont ;+ cFONSEL = io2rpn fontSelectionNew ;+ cFRM = io2rpn frameNew ;+ cHBX = ( io2rpn .). hBoxNew ;+ cHBXBTN = io2rpn hButtonBoxNew ;+ cHPD = io2rpn hPanedNew ;+ cHSC = io2rpn . hScaleNew ;+ cHSCRNG = (( io2rpn .).). hScaleNewWithRange ;+ cHSB = io2rpn . hScrollbarNew ;+ cHSBDF = io2rpn hScrollbarNewDefaults ;+ cHSP = io2rpn hSeparatorNew ;+ cHNB = io2rpn handleBoxNew ;+ cIVW = io2rpn iconViewNew ;+ cIVWMDL = io2rpn . iconViewNewWithModel ;+ cMENIMGIT = io2rpn imageMenuItemNew ;+ cMENIMGITSTK = io2rpn . imageMenuItemNewFromStock ;+ cMENIMGITL = io2rpn . imageMenuItemNewWithLabel ;+ cMENIMGITMNM = io2rpn . imageMenuItemNewWithMnemonic ;+ cIMG = io2rpn imageNew ;+ cIMGFLE = io2rpn . imageNewFromFile ;+ cIMGICN = ( io2rpn .). imageNewFromIconName ;+ cIMGPIX = io2rpn . imageNewFromPixbuf ;+ cIMGSTK = ( io2rpn .). imageNewFromStock ;+ cLBL = io2rpn . labelNew ;+ cLBLMNM = io2rpn . labelNewWithMnemonic ;+ cLAY = ( io2rpn .). layoutNew ;+ cMENBAR = io2rpn menuBarNew ;+ cMENIT = io2rpn menuItemNew ;+ cMENITL = io2rpn . menuItemNewWithLabel ;+ cMENITMNM = io2rpn . menuItemNewWithMnemonic ;+ cMEN = io2rpn menuNew ;+ cMENTBN = ( io2rpn .). menuToolButtonNew ;+ cMENTBNSTK = io2rpn . menuToolButtonNewFromStock ;+ cNBK = io2rpn notebookNew ;+ cPRB = io2rpn progressBarNew ;+ cBTNRDI = io2rpn radioButtonNew ;+ cBTNRDIWID = io2rpn . radioButtonNewFromWidget ;+ cBTNRDIL = io2rpn . radioButtonNewWithLabel ;+ cBTNRDILWID = ( io2rpn .). radioButtonNewWithLabelFromWidget ;+ cBTNRDIMNM = io2rpn . radioButtonNewWithMnemonic ;+ cBTNRDIMNMWID = ( io2rpn .). radioButtonNewWithMnemonicFromWidget ;+ cMENRDIIT = io2rpn radioMenuItemNew ;+ cMENRDIITWID = io2rpn . radioMenuItemNewFromWidget ;+ cMENRDIITL = io2rpn . radioMenuItemNewWithLabel ;+ cMENRDIITLWID = ( io2rpn .). radioMenuItemNewWithLabelFromWidget ;+ cMENRDIMNM = io2rpn . radioMenuItemNewWithMnemonic ;+ cMENRDIMNMWID = ( io2rpn .). radioMenuItemNewWithMnemonicFromWidget ;+ cTBNRDI = io2rpn radioToolButtonNew ;+ cTBNRDISTK = io2rpn . radioToolButtonNewFromStock ;+ cTBNRDIWID = io2rpn . radioToolButtonNewFromWidget ;+ cTBNRDISTKWID = ( io2rpn .). radioToolButtonNewWithStockFromWidget ;+ cSRL = ( io2rpn .). scrolledWindowNew ;+ cMENITSP = io2rpn separatorMenuItemNew ;+ cTLBITSP = io2rpn separatorToolItemNew ;+ cSKT = io2rpn socketNew ;+ cBTNSPI = (( io2rpn .).). spinButtonNew ;+ cBTNSPIRNG = (( io2rpn .).). spinButtonNewWithRange ;+ cSTU = io2rpn statusbarNew ;+ cTBL = (( io2rpn .).). tableNew ;+ cMENITTF = io2rpn tearoffMenuItemNew ;+ cXVW = io2rpn textViewNew ;+ cTVWBF = io2rpn . textViewNewWithBuffer ;+ cBTNTGL = io2rpn toggleButtonNew ;+ cBTNTGLL = io2rpn . toggleButtonNewWithLabel ;+ cBTNTGLMNM = io2rpn . toggleButtonNewWithMnemonic ;+ cTLBITTLG = io2rpn toggleToolButtonNew ;+ cTLBITTLGSTK = io2rpn . toggleToolButtonNewFromStock ;+ cTLBITBTN = ( io2rpn .). toolButtonNew ;+ cTLBITBTNSTK = io2rpn . toolButtonNewFromStock ;+ cTLBIT = io2rpn toolItemNew ;+ cTLB = io2rpn toolbarNew ;+ cRVW = io2rpn treeViewNew ;+ cRVWMDL = io2rpn . treeViewNewWithModel ;+ cVBX = ( io2rpn .). vBoxNew ;+ cVBXBTN = io2rpn vButtonBoxNew ;+ cVPD = io2rpn vPanedNew ;+ cVSC = io2rpn . vScaleNew ;+ cVSCRNG = (( io2rpn .).). vScaleNewWithRange ;+ cVSB = io2rpn . vScrollbarNew ;+ cVSBDF = io2rpn vScrollbarNewDefaults ;+ cVSP = io2rpn vSeparatorNew ;+ cVWP = ( io2rpn .). viewportNew ;+ cWND = io2rpn windowNew ;+ cWNDPU = io2rpn windowNewPopup ;++ tSET :: ( CanBeCasted w ) => [ AttrOp w ] -> RPN ;+ tSET a = RPN $ touchWidget $ ( $ a ) . set ;++ tON :: ( CanBeCasted w ) => Signal w c -> c -> RPN ;+ tON s c = RPN $ touchWidget $ ($ c) . ($ s) . on ;++ tAF :: ( CanBeCasted w ) => Signal w c -> c -> RPN ;+ tAF s c = RPN $ touchWidget $ ($ c) . ($ s) . after ;++ tSKT :: NativeWindowId -> RPN ;+ tSKT n = RPN $ touchWidget $ ($ n) . sai+     where { sai :: Socket -> NativeWindowId -> IO () ;+     sai = socketAddId } ;++ pCA = RPN $+     let { ca :: Container -> Widget -> IO () ; ca = containerAdd }+         in pullWidget ca ;++ pBSI = RPN $+     let { bsi :: Button -> Widget -> IO () ; bsi = buttonSetImage }+         in pullWidget bsi ;++ pBPS p i = RPN $+     let { bps :: Box -> Widget -> IO () ; bps b w = boxPackStart b w p i }+         in pullWidget bps ;++ pBPE p i = RPN $+     let { bpe :: Box -> Widget -> IO () ; bpe b w = boxPackEnd b w p i }+         in pullWidget bpe ;++ pBPSD = RPN $+     let { bpsd :: Box -> Widget -> IO () ; bpsd = boxPackStartDefaults }+         in pullWidget bpsd ;++ pBPED = RPN $+     let { bped :: Box -> Widget -> IO () ; bped = boxPackEndDefaults }+         in pullWidget bped ;++ pFP p = RPN $+     let { fp :: Fixed -> Widget -> IO () ; fp f w = fixedPut f w p }+         in pullWidget fp ;++ pPA1 = RPN $+     let { pa1 :: Paned -> Widget -> IO () ; pa1 = panedAdd1 }+         in pullWidget pa1 ;++ pPA2 = RPN $+     let { pa2 :: Paned -> Widget -> IO () ; pa2 = panedAdd2 }+         in pullWidget pa2 ;++ pPP1 r s = RPN $+     let { pp1 :: Paned -> Widget -> IO () ; pp1 p w = panedPack1 p w r s }+         in pullWidget pp1 ;++ pPP2 r s = RPN $+     let { pp2 :: Paned -> Widget -> IO () ; pp2 p w = panedPack2 p w r s }+         in pullWidget pp2 ;++ pLP x y = RPN $+     let { lp :: Layout -> Widget -> IO () ; lp l w = layoutPut l w x y }+         in pullWidget lp ;++ pNAP s = RPN $+     let { nap :: Notebook -> Widget -> IO Int ;+     nap l w = notebookAppendPage l w s }+         in pullWidget nap ;++ pNAPM = RPN $+     let { napm :: Notebook -> Widget -> Widget -> Widget -> IO Int ;+     napm = notebookAppendPageMenu }+         in pullWidget3 napm ;++ pNPP s = RPN $+     let { npp :: Notebook -> Widget -> IO Int ;+     npp l w = notebookPrependPage l w s }+         in pullWidget npp ;++ pNPPM = RPN $+     let { nppm :: Notebook -> Widget -> Widget -> Widget -> IO Int ;+     nppm = notebookPrependPageMenu }+         in pullWidget3 nppm ;++ pTA l r t b xo yo xp yp = RPN $+     let { ta :: Table -> Widget -> IO () ; ta tab wid =+     tableAttach tab wid l r t b xo yo xp yp }+         in pullWidget ta ;++ pTAD l r t b = RPN $+     let { tad :: Table -> Widget -> IO () ;+     tad ta wi = tableAttachDefaults ta wi l r t b }+         in pullWidget tad ;++ pTVACAA a = RPN $+     let { tvacaa :: TextView -> Widget -> IO () ; tvacaa t w =+     textViewAddChildAtAnchor t w a }+         in pullWidget tvacaa ;++ pTVACIW t x y = RPN $+     let { tvaciw :: TextView -> Widget -> IO () ; tvaciw te wi =+     textViewAddChildInWindow te wi t x y }+         in pullWidget tvaciw ;++ pTI i = RPN $+     let { ti :: Toolbar -> ToolItem -> IO () ; ti tc tic =+     toolbarInsert tc tic i }+         in pullWidget ti ;++ rCBK :: ( Widget -> IO () ) -> RPN ;+ rCBK f = RPN $ touchWidget cb+  where {+      cb w = after w realize $ f w+  } ;++ rTME :: ( Widget -> IO () ) -> Int -> RPN ;+ rTME f dt = rCBK i+  where {+      i w = do {+           id <- timeoutAdd ( f w >> return True ) dt ;+           on w unrealize $ timeoutRemove id+      } >> return ()+  } ;++ rSHPE :: ( ( Double , Double ) -> Render () ) -> RPN ;+ rSHPE c = mconcat [ cDRW , tON e s ]+  where {+      e :: Signal Widget ( EventM EExpose Bool ) ;+      e = exposeEvent ;+      s = do {+           w <- eventWindow ;+           liftIO $ do {+               ( ww , wh ) <- liftIO $ drawableGetSize w ;+               let { ch = c ( fromIntegral ww , fromIntegral wh ) } ;+               liftIO $ renderWithDrawable w ch ;+           } ;+           return True+      }+  } ;++ rANIM :: Int -> IO a -> ( a -> ( Double , Double ) -> Render () ) -> RPN ;+ rANIM dt readData toRender = mconcat [ cDRW , tON e ef , tON m mf ]+  where {+      e :: Signal Widget ( EventM EExpose Bool ) ;+      e = exposeEvent ;+      ef = do {+          dw <- eventWindow ;+          liftIO $ do {+              (sx,sy) <- drawableGetSize dw ;+              let { (sx',sy') = (fromIntegral sx , fromIntegral sy) } ;+              d <- readData ;+              let { render = toRender d (sx',sy') } ;+              renderWithDrawable dw render ;+          } ;+          return True+      } ;+      m :: Signal Widget ( EventM EAny Bool ) ;+      m = mapEvent ;+      mf = do {+          dw <- eventWindow ;+          liftIO $ do {+              (sx,sy) <- drawableGetSize dw ;+              let { area = Rectangle 0 0 sx sy } ;+              let { f = drawWindowInvalidateRect dw area False } ;+              timeoutAdd ( f >> return True ) dt+          } ;+          return True+      }+  } ;+}
+ src/example.hs view
@@ -0,0 +1,60 @@+module Main where+import Graphics.UI.Gtk+import Graphics.UI.Gtk.Gdk.EventM+import Graphics.Rendering.Cairo+import Graphics.UI.Gtk.Layout.Rpn+import Data.Monoid++title :: String -> [AttrOp Window]+title s = [windowTitle := s]+pressed :: Signal Widget (EventM EButton Bool)+pressed = buttonPressEvent++main = do+    initGUI++    -- Create a new operator ('line') that takes a label+    -- ('cLBL') and a button ('cBTNL') and pack then ('pBPED')+    -- in a horizontal box ('cHBX').++    let line s = mconcat [+         cLBL (Just $ s ++ ":"),+         cBTNL s,+         cHBX True 0,+         pBPED,+         pBPED]++    -- Create a new operator ('column') that packs many 'line'+    -- in a vertical box ('cVBX').++    let column = mconcat $ [+         line "One Button",+         line "Another Button",+         line "Yet Another Button",+         line "Last Button",+         cVBX True 0] ++ replicate 4 pBPED++    -- Take two copies of 'column' and add ('pNAP') then+    -- to a notebook ('cNBK'). Then create a stock button+    -- ('cBTNSTK') and attach a action to an event ('tON'). Then+    -- join the notebook and that button in a vertical box.+    -- Insert everything in a main window ('cWND, pCA'), and+    -- finally make everything into widgets ('widgetsFromRpn').++    [mainWindow] <- widgetsFromRpn $ mconcat $ [+         column,+         column,+         cNBK,+         pNAP "First Page",+         pNAP "Second Page",+         cBTNSTK stockQuit,+         tON pressed (liftIO mainQuit >> return True),+         cVBX False 0,+         pBPE PackNatural 0,+         pBPED,+         cWND,+         pCA,+         tSET (title "Layout.RPN Example")]++    widgetShowAll mainWindow+    mainGUI
+ src/rpnCompilar.hs view
@@ -0,0 +1,8 @@+module Main where {+import Graphics.UI.Gtk ;+import Graphics.Rendering.Cairo ;+import Graphics.UI.Gtk.Layout.Rpn ;++ main = return ()++}
+ src/rpnTeste.hs view
@@ -0,0 +1,37 @@+module Main where {+import Data.Monoid ;+import Graphics.UI.Gtk ; import Graphics.UI.Gtk.Layout.Rpn ;+import Graphics.Rendering.Cairo ;++ main = do {++     initGUI ;++     janelaPrincipal <- windowNew ; onDestroy janelaPrincipal mainQuit ;++     [ w ] <- widgetsFromRpn $ mconcat [++         cBTNSTK stockAbout ,+         cBTNSTK stockQuit ,+         cHBXBTN ,+         pCA ,+         pCA ,+         cLBL $ Just "<b> Oi! </b>" ,+         tSET $ ([labelUseMarkup := True] :: [AttrOp Label]) ,+         cDRW ,+         cVPD ,+         pPA2 ,+         pPA1 ,+         cVBX False 0 ,+         pBPE PackGrow 0 ,+         pBPE PackNatural 0++     ] ;++     containerAdd janelaPrincipal w ;++     widgetShowAll janelaPrincipal ;    mainGUI++ }++}
+ src/rpnTeste2.hs view
@@ -0,0 +1,108 @@+module Main where {+import Graphics.UI.Gtk ;+import Graphics.UI.Gtk.Layout.Rpn ;+import Graphics.Rendering.Cairo ;+import Data.Monoid ;+import Data.IORef ;++desenharQuadrados = do {+    dw <- eventWindow ;+    (w,h) <- drawableGetSize ;++dQ :: IORef (Double,Double) -> Int -> RPN ;+dQ ior n = mconcat [+    cDRW ,+    tON widgetExposeEvent desenharQuadrados ,+    cFRM ,+    tSET label ,+    pCA+ ] where {+    widgetExposeEvent :: Signal Widget (EventM ECrossing Bool) ;+    widgetExposeEvent = exposeEvent ;+    label :: [AttrOp Frame] ;+    label = [frameLabel := ( show n ++ " cm" )] ;+    desenharQuadrados = do {+        dw <- eventWindow ;+        (w,h) <- drawableGetSize ;+        let (w',h') = (fromIntegral w, fromIntegral h) ;+        (eX,eY) <- readIORef ior ;+        xs <- [0,n'*eX..w'] ;+        ys <- [0,n'*eY..h'] ;+        renderWithDrawable dw $ do {+++main = do {++ initGUI ;++     janelaPrincipal <- windowNew ;++     proporções <- newIORef ( 10 , 10 ) ;++     let {+         atualizarX = \v -> modifyIORef proporções $ \( _ , y ) -> ( 200 / v , y ) ;+         atualizarY = \v -> modifyIORef proporções $ \( x , _ ) -> ( x , 200 / v ) ;+         desenharQuadrados n = do {+             ( px , py ) <- readIORef proporções ;+             return $ Just $ \( w , h ) -> do {+                 let { dx = n * px ; dy = n * py } ;+                 sequence $ ( flip map ) [ 0 , dx .. w ] $+                  \v -> moveTo v 0 >> lineTo v h ;+                 sequence $ ( flip map ) [ 0 , dy .. h ] $+                  \v -> moveTo 0 v >> lineTo w v ;+                 stroke+             } ;+         } ;+         janelinha n = mconcat [+             rpnCairoLiveShape ( desenharQuadrados n ) 2000 ,+             rpnFrame $ Just $ "<b> Quadrados de " ++ show n ++ " <i> cm </i></b>"+         ] ;+     } ;++     [conteúdo] <- widgetFromRpn $ mconcat [++         rpnCairoShape $ const $ rectangle 10 10 200 200 >> stroke ,+         rpnMinimumSize 220 220 ,++         rpnSetOrientation OrientationVertical ,+         rpnScale 2 10 20 1 ( Just PosRight ) atualizarY ,++         rpnSetOrientation OrientationHorizontal ,+         rpnBox [ PackGrow , PackNatural ] ,++         rpnSetOrientation OrientationHorizontal ,+         rpnScale 2 10 20 1 ( Just PosBottom ) atualizarX ,++         rpnSetOrientation OrientationVertical ,+         rpnBox [ PackNatural , PackNatural ] ,++         rpnSetAlign ( 0.5 , 0.5 ) ,+         rpnAlign 0 0 ,++         rpnSetOrientation OrientationHorizontal ,+         rpnStockButton stockQuit mainQuit ,+         rpnButtonBox ButtonboxCenter [False] ,++         rpnSetOrientation OrientationVertical ,+         rpnBox [ PackGrow , PackNatural ] ,++         janelinha 1 ,+         janelinha 2 ,+         janelinha 3 ,+         rpnBox $ take 3 $ replicate 3 PackGrow ,++         rpnSetOrientation OrientationHorizontal ,+         rpnBox [ PackNatural , PackGrow ]++     ] ;++     containerAdd janelaPrincipal conteúdo ;++     widgetShowAll janelaPrincipal ;++     mainGUI++ }+++}