From: Duncan C. <dun...@wo...> - 2007-10-30 00:35:59
|
Mon Oct 29 10:32:43 PDT 2007 hth...@zo... * Tutorial Port Event and Button Boxes (Chapter 6.2) Corrected a previous patch error in index.xhtml where .xhtml had been changed into .html. Corrected the chapter on font and color selection, which came after Alex Tarkovsky's patch, for un- necessary newlines after <pre> Corrected a few other missing or incorrect links in previous files addfile ./docs/tutorial/Tutorial_Port/Example_Code/GtkChap6-2.hs hunk ./docs/tutorial/Tutorial_Port/Example_Code/GtkChap6-2.hs 1 +import Graphics.UI.Gtk +import System.Random (randomRIO) + +main :: IO () +main= do + initGUI + window <- windowNew + set window [windowTitle := "Slot Machine", + containerBorderWidth := 10, + windowDefaultWidth := 350, [_$_] + windowDefaultHeight := 400] [_$_] + hb1 <- hBoxNew False 0 + containerAdd window hb1 + vb1 <- vBoxNew False 0 + boxPackStart hb1 vb1 PackGrow 0 + vbb <- vButtonBoxNew + boxPackStart hb1 vbb PackGrow 0 + resetb <- buttonNewWithLabel "Reset" + containerAdd vbb resetb + quitb <- buttonNewWithLabel "Quit" + containerAdd vbb quitb + playb <- buttonNewWithMnemonic "_Play" + containerAdd vbb playb + set vbb [buttonBoxLayoutStyle := ButtonboxStart, [_$_] + (buttonBoxChildSecondary playb) := True ] + + let picfiles = ["./jacunda.gif", "./pacu.gif", "./tucunaream.gif"] + evimls <- sequence (map (initEvent vb1) picfiles) + tips <- tooltipsNew + sequence_ $ map ((myTooltip tips) . fst) evimls + + onClicked playb (play evimls picfiles) + [_$_] + onClicked resetb $ sequence_ (zipWith reSet evimls picfiles) + + onClicked quitb (widgetDestroy window) + widgetShowAll window + onDestroy window mainQuit + mainGUI + +initEvent :: VBox -> FilePath -> IO (EventBox, Image) +initEvent vb picfile = do + eb <- eventBoxNew + boxPackStart vb eb PackGrow 0 + slot <- imageNewFromFile picfile + set eb[containerChild := slot, containerBorderWidth := 10 ] + widgetModifyBg eb StateNormal (Color 0 35000 0) + widgetModifyBg eb StateInsensitive (Color 50000 50000 50000) + onButtonPress eb [_$_] + (\x -> if (eventButton x) == LeftButton [_$_] + then do widgetSetSensitivity eb False [_$_] + return (eventSent x) + else return (eventSent x)) + return (eb, slot) + +reSet :: (EventBox, Image) -> FilePath -> IO () +reSet (eb, im) pf = do widgetSetSensitivity eb True [_$_] + imageSetFromFile im pf + [_$_] +play :: [(EventBox, Image)] -> [FilePath] -> IO () +play eilist fplist = [_$_] + do let n = length fplist + rands <- sequence $ replicate n (randomRIO (0::Int,(n-1))) + sequence_ (zipWith display eilist rands) where + display (eb, im) rn = do + state <- widgetGetState eb + if state == StateInsensitive [_$_] + then return () + else imageSetFromFile im (fplist !! rn) [_$_] + +myTooltip :: Tooltips -> EventBox -> IO () +myTooltip ttp eb = tooltipsSetTip ttp eb "Click Left Mouse Button to Freeze" "" addfile ./docs/tutorial/Tutorial_Port/Example_Code/jacunda.gif binary ./docs/tutorial/Tutorial_Port/Example_Code/jacunda.gif addfile ./docs/tutorial/Tutorial_Port/Example_Code/pacu.gif binary ./docs/tutorial/Tutorial_Port/Example_Code/pacu.gif addfile ./docs/tutorial/Tutorial_Port/Images/GtkChap6-2a.png binary ./docs/tutorial/Tutorial_Port/Images/GtkChap6-2a.png addfile ./docs/tutorial/Tutorial_Port/Images/GtkChap6-2b.png binary ./docs/tutorial/Tutorial_Port/Images/GtkChap6-2b.png hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 21 - <!-- a href="chap5-4.xhtml" -->Next [_$_] - <!--</a>--></span> + <a href="chap5-4.xhtml">Next [_$_] + </a></span> hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 24 - <h1>5.3 Font and Color Selection</h1> + <h2>5.3 Font and Color Selection</h2> hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 30 - <pre class="codebox"> -fontSelectionNew :: IO FontSelection + <pre class="codebox">fontSelectionNew :: IO FontSelection hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 41 - <pre class="codebox"> -onFontSet:: FontButtonClass self => self -> IO () -> IO (ConnectId self) + <pre class="codebox">onFontSet:: FontButtonClass self => self -> IO () -> IO (ConnectId self) hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 45 - <pre class="codebox"> -fontButtonGetFontName :: FontButtonClass self => self -> IO String + <pre class="codebox">fontButtonGetFontName :: FontButtonClass self => self -> IO String hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 60 - <pre class="codebox"> -fontDescriptionFromString :: String -> IO FontDescription + <pre class="codebox">fontDescriptionFromString :: String -> IO FontDescription hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 64 - <pre class="codebox"> -widgetModifyFont:: WidgetClass self => self -> Maybe FontDescription -> IO () + <pre class="codebox">widgetModifyFont:: WidgetClass self => self -> Maybe FontDescription -> IO () hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 68 - <pre class="codebox"> -colorSelectionNew :: IO Color Selection + <pre class="codebox">colorSelectionNew :: IO Color Selection hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 73 - <pre class="codebox"> -onColorSet :: ColorButtonClass self => self -> IO () -> IO (ConnectId self) + <pre class="codebox">onColorSet :: ColorButtonClass self => self -> IO () -> IO (ConnectId self) hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 76 - <pre class="codebox"> -colorButtonGetColor :: ColorButtonClass self => self -> IO Color + <pre class="codebox">colorButtonGetColor :: ColorButtonClass self => self -> IO Color hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 98 - <pre class="codebox"> -widgetModifyFg :: WidgetClass self => self -> StateType -> Color -> IO () + <pre class="codebox">widgetModifyFg :: WidgetClass self => self -> StateType -> Color -> IO () hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 103 - <pre class="codebox"> -widgetGetState :: WidgetClass w => w -> IO StateType + <pre class="codebox">widgetGetState :: WidgetClass w => w -> IO StateType hunk ./docs/tutorial/Tutorial_Port/chap5-3.xhtml 176 - <!--<a href="chap3-1.xhtml">-->Next [_$_] - <!--</a>--> - <br /></span> + <a href="chap3-1.xhtml">Next + </a> + <br />5.4 Notebook</span> hunk ./docs/tutorial/Tutorial_Port/chap5-4.xhtml 233 - <br />To be continued</span> + <br />6.1 Scrolled Windows</span> hunk ./docs/tutorial/Tutorial_Port/chap6-1.xhtml 251 - <br />6.2</span> + <br />6.2 Event Boxes and Button Boxes</span> addfile ./docs/tutorial/Tutorial_Port/chap6-2.xhtml hunk ./docs/tutorial/Tutorial_Port/chap6-2.xhtml 1 +<?xml version="1.0" encoding="utf-8"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> + <head> + <meta http-equiv="Content-Type" + content="text/html; charset=utf-8" /> + <title>Gtk2Hs Tutorial: Event Boxes and Button Boxes</title> + <link href="default.css" type="text/css" rel="stylesheet" /> + </head> + <body> + <div id="header"> + <h1>Gtk2Hs Tutorial</h1> + <span class="nav-previous"> + <a href="chap6-1.xhtml">Previous</a> + </span> + <span class="nav-home"> + <a href="index.xhtml">Home</a> + </span> + <span class="nav-next"> + <a href="chap6-2.xhtml">Next</a> + </span> + </div> + <h2>6.2 Event Boxes and Button Boxes</h2> + <p>An event in Gtk2Hs is something that is sent to a widget, by + the main loop, usually as a result of an action performed by + the user. The widget then responds by emitting a signal, and + this is the 'signal' to the program to 'do something'. To the + Gtk2Hs application programmer, however, an event is just a + Haskell data type with named fields. Many of those are + described in the Graphics.UI.Gtk.Gdk.Events section in the API + documentation. Look, for example, at the widget signal:</p> + <pre class="codebox">onButtonPress :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w) +</pre> + <p>This is not to be confused with the signal emitted when a [_$_] + <code>Button</code> type widget has been pressed; the button + here is a mouse button and the signal is emitted when a mouse + button has been pressed when the mouse is over that widget. The + handler is a function which takes an event, which has to have + the [_$_] + <code>Button</code> constructor, and has a IO boolean value. The + API lists the following fields for [_$_] + <code>Button</code> :</p> + <pre class="codebox">eventSent :: Bool +eventClick :: Click +eventTime :: TimeStamp +eventModifier :: [Modifier] +eventButton :: MouseButton +eventXRoot, eventYRoot :: Double +</pre> + <p>The first is used for the return. It occurs in all [_$_] + <code>Event</code> constructors like [_$_] + <code>Motion, Expose, Key, Crossing, Focus, Configure, Scroll, + WindowState and Proximity.</code> From [_$_] + <code>Events</code> you can extract all kinds of information + about what the user is doing. A simple example is this code + snippet:</p> + <pre class="codebox">onButtonPress eb [_$_] + (\x -> if (eventButton x) == LeftButton [_$_] + then do widgetSetSensitivity eb False [_$_] + return (eventSent x) + else return (eventSent x)) +</pre> + <p>Here parameter [_$_] + <code>eb</code> is the widget covered by the mouse, and the + anonymous function is of the type as described above. Something + is done (see the example below) if the left mouse button has + been pressed and then [_$_] + <code>eventSent</code> returns the appropriate boolean. If + another mouse button has been pressed, nothing happens, and + only the boolean is returned.</p> + <p>Now, some widgets don't have associated windows, so they + just draw on their parents. Because of this, they cannot + receive events and if they are incorrectly sized, they don't + clip so you can get messy overwriting (but we won't discuss + this further). An [_$_] + <code>EventBox</code> provides an X window for its child widget. + It is a subclass of [_$_] + <code>Bin</code> which also has its own window and which is a + subclass of [_$_] + <code>ContainerClass</code> .</p> + <p>To create a new EventBox widget, use:</p> + <pre class="codebox">eventBoxNew :: IO EventBox +</pre> + <p>To add a child we can just use the well known:</p> + <pre class="codebox">containerAdd :: (ContainerClass self, WidgetClass widget) => self -> widget -> IO () +</pre> + <p>The window may be visible or invisible, and the event box + may be above or below its child in the widget tree. This is + determined by:</p> + <pre class="codebox">eventBoxVisibleWindow :: Attr EventBox Bool -- default True +eventBoxAboveChild :: Attr EventBox Bool -- default False +</pre> + <p>If you just want to trap events, then set the window to be + invisible. If the [_$_] + <code>eventBox</code> is above its child, all events will go to + it first. If it is below, windows in child widgets of the child + will be reached first.</p> + <p>A Button Box is just a box which can be used to pack buttons + in a standard way. There are two kinds, horizontal and vertical + ones, and you construct them with:</p> + <pre class="codebox">hbuttonBoxNew :: IO HButtonBox +vButtonBoxNew :: IO VButtonBox +</pre> + <p>The functionality is in the [_$_] + <code>ButtonBoxClass.</code> </p> + <pre class="codebox">buttonBoxSetLayout :: ButtonBoxClass self => self -> ButtonBoxStyle -> IO () +</pre> + <p>The style is one of the following: [_$_] + <code>ButtonBoxDefaultStyle, ButtonBoxSpread, ButtonBoxEdge, + ButtonBoxStart, ButtonBoxEnd</code> . You don't pack buttons as + in ordinary horizontal and vertical boxes, but you use the [_$_] + <code>containerAdd</code> function instead.</p> + <p>The second feature of button boxes is that you can define + one or more of your buttons to be in a secondary group. These + will then be treated differently when the button box is + resized. For example, a help button can be kept visually apart + from the others. The function is:</p> + <pre class="codebox">buttonBoxSetChildSecondary :: (ButtonBoxClass self, WidgetClass child) +=> self -> child -> Bool -> IO () +</pre> + <p>This illustrates the use of event boxes and button + boxes:</p> + <p> + <img src="Images/GtkChap6-2a.png" alt="Slot Machine" + id="imgGtkChap6-2a" /> + </p> + <p>The buttons are packed into a vertical button box, with the + play button as a secondary child. This is also a mnemonic + button, with Alt-P as the accellerator key. The images are + placed into event boxes with visible windows, and their + background color is set to a shade of green with:</p> + <pre class="codebox">widgetModifyBg eb StateNormal (Color 0 35000 0)</pre> + <p>As mentioned in Chapter 5.3 the [_$_] + <code>StateType</code> can be [_$_] + <code>StateNormal, StateActive, StatePrelight, StateSelected or + StateInsensitive</code> .</p> + <p>Note that the images above are not all the same size. This + does not matter, but some care has to be taken to make the main + window large enough. Otherwise borders will disappear when the + pictures are switched.</p> + <p>When the user clicks the left mouse button when the mouse is + over an event box, it will be set to insensitive with:</p> + <pre class="codebox">widgetSetSensitivity :: WidgetClass self => self -> Bool -> IO () +</pre> + <p>This changes the [_$_] + <code>StateType</code> to [_$_] + <code>StateInsensitive</code> and the widget will no longer + respond to any user events. Furthermore, its appearance changes. + In the example we've also set the background color to a shade + of grey.</p> + <p> + <img src="Images/GtkChap6-2b.png" + alt="Slot Machine Insensitive" id="imgGtkChap6-2b" /> + </p> + <p>We've used tooltips to tell the user the images can be + frozen. As mentioned in Chapter 4.4 they don't always work in + GHCi but they do in the compiled version. To flip the images + randomly, we've used function RandomRIO, as in the previous + chapter. You may wonder why a tuple of [_$_] + <code>EventBox</code> and [_$_] + <code>Image</code> has been used, instead of just getting the [_$_] + <code>Image</code> from the [_$_] + <code>containerChild</code> attribute of the event boxes. This + is because it is a write only attribute, it can be [_$_] + <code>set</code> but not retrieved with [_$_] + <code>get</code> .</p> + <p>Finally, if the images are not available in your source code + directory, or if you want to expand the slot machine with more + slots, there is an ample supply of Brazilian fish at + <a href="http://www.pesca.com.br/mundodapesca/peixe/index.htm"> + Peixes</a>. They have been classified into salt water (água + salgado) and fresh water (água doce) fish for your + convenience.</p> + <pre class="codebox"> +import Graphics.UI.Gtk +import System.Random (randomRIO) + +main :: IO () +main= do + initGUI + window <- windowNew + set window [windowTitle := "Slot Machine", + containerBorderWidth := 10, + windowDefaultWidth := 350, [_$_] + windowDefaultHeight := 400] [_$_] + hb1 <- hBoxNew False 0 + containerAdd window hb1 + vb1 <- vBoxNew False 0 + boxPackStart hb1 vb1 PackGrow 0 + vbb <- vButtonBoxNew + boxPackStart hb1 vbb PackGrow 0 + resetb <- buttonNewWithLabel "Reset" + containerAdd vbb resetb + quitb <- buttonNewWithLabel "Quit" + containerAdd vbb quitb + playb <- buttonNewWithMnemonic "_Play" + containerAdd vbb playb + set vbb [buttonBoxLayoutStyle := ButtonboxStart, [_$_] + (buttonBoxChildSecondary playb) := True ] + + let picfiles = ["./jacunda.gif", "./pacu.gif", "./tucunaream.gif"] + evimls <- sequence (map (initEvent vb1) picfiles) + tips <- tooltipsNew + sequence_ $ map ((myTooltip tips) . fst) evimls + + onClicked playb (play evimls picfiles) + + onClicked resetb $ sequence_ (zipWith reSet evimls picfiles) + + onClicked quitb (widgetDestroy window) + widgetShowAll window + onDestroy window mainQuit + mainGUI + +initEvent :: VBox -> FilePath -> IO (EventBox, Image) +initEvent vb picfile = do + eb <- eventBoxNew + boxPackStart vb eb PackGrow 0 + slot <- imageNewFromFile picfile + set eb[containerChild := slot, containerBorderWidth := 10 ] + widgetModifyBg eb StateNormal (Color 0 35000 0) + widgetModifyBg eb StateInsensitive (Color 50000 50000 50000) + onButtonPress eb [_$_] + (\x -> if (eventButton x) == LeftButton [_$_] + then do widgetSetSensitivity eb False [_$_] + return (eventSent x) + else return (eventSent x)) + return (eb, slot) + +reSet :: (EventBox, Image) -> FilePath -> IO () +reSet (eb, im) pf = do widgetSetSensitivity eb True [_$_] + imageSetFromFile im pf [_$_] + +play :: [(EventBox, Image)] -> [FilePath] -> IO () +play eilist fplist = [_$_] + do let n = length fplist + rands <- sequence $ replicate n (randomRIO (0::Int,(n-1))) + sequence_ (zipWith display eilist rands) where + display (eb, im) rn = do + state <- widgetGetState eb + if state == StateInsensitive [_$_] + then return () + else imageSetFromFile im (fplist !! rn) [_$_] + +myTooltip :: Tooltips -> EventBox -> IO () +myTooltip ttp eb = tooltipsSetTip ttp eb "Click Left Mouse Button to Freeze" "" +</pre> + <div id="footer"> + <span class="nav-previous"> + <a href="chap6-1.xhtml">Previous</a> + <br />6.1 Scrolled Windows</span> + <span class="nav-home"> + <a href="index.xhtml">Home</a> + </span> + <span class="nav-next"> + <a href="chap6-3.xhtml">Next</a> + <br />6.3</span> + </div> + </body> +</html> hunk ./docs/tutorial/Tutorial_Port/index.xhtml 94 + </li> + <li> + <a href="chap6-2.xhtml">6.2 Event Boxes and Button Boxes</a> |