[Tutorial-Port Spanish Chapters 5, 6 and 7 hthiel.char@zonnet.nl**20080101165758 (also corrected a previous typo) ] hunk ./docs/tutorial/Tutorial_Port/es-chap4-7.xhtml 1 - + addfile ./docs/tutorial/Tutorial_Port/es-chap5-1.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap5-1.xhtml 1 - + + + + + + Tutorial de Gtk2Hs: Calendario + + + +

Calendario

+

El widget Calendar es una buena manera de mostrar y recuperar + la información cronológica. Es un widget muy sencillo de crear y su + funcionamiento es muy simple. Debes usar:

+
calendarNew: IO Calendar
+
+

Por defecto se muestra el mes actual. Para recuperar la información de + un calendario emplea:

+
calendarGetDate :: CalendarClass self => self -> IO (Int, Int, Int)
+
+

donde la terna contendría la información (año, mes, día). (Enero es el 0). + Los atributos relacionados son:

+
calendarYear :: CalendarClass self => Attr self Int
+calendarMonth :: CalendarClass self => Attr self Int
+calendarDay :: CalendarClass self => Attr self Int
+
+

El widget Calendar tiene algunas opciones que te permiten cambiar la apariencia y el modo de operación + del widget. Para ello debes usar la función + calendarSetDisplayOptions. Para recuperar los valores usa: + calendarGetDisplayOptions.

+
calendarSetDisplayOptions :: CalendarClass self => self -> [CalendarDisplayOptions] -> IO ()
+calendarGetDisplayOptions :: CalendarClass self => self -> IO [CalendarDisplayOptions]
+
+

+ CalendarDisplayOptions tiene los siguientes constructores:

+ +

También puede obtenerse y cambiarse el valor de las opciones usando atributos + Booleanos mediante las funciones genéricas get y set.

+

Nota: No hay atributo para CalendarWeekStartMonday y el uso de la función + calendarSetDisplay origina un mensaje en tiempo de ejecución indicando que + el primer día de la semana se toma por defecto y se ignora GTK_CALENDAR_WEEK_START_MONDAY.

+

Por último, destacar que se pueden marcar algunos días del mes. Un día marcado + se resalta en el calendario mostrado. Las siguientes funciones (sin atributos) sirven para manipular + los días marcados:

+
calendarMarkDay :: CalendarClass self => self -> Int -> IO Bool
+calendarUnmarkDay :: CalendarClass self => self -> Int -> IO Bool
+calendarClearMarks :: CalendarClass self => self -> IO ()
+
+

El valor Booleano no se usa (siempre True). Las marcas se mantienen + en los cambios de mes y de año.

+

El widget Calendar puede generar señales que indican los cambios y la fecha + seleccionada. Los nombres de esas señales son:

+ +

Nota: lo siguiente está mencionado en la documentación de la API, pero + aparece implementado como onDaySelected. Mira el comentario en el código del ejemplo.

+ +

El siguiente ejemplo muestra el uso del widget Calendar:

+

+ GtkChap5-1.png +

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main= do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Calendar",
+                 windowDefaultWidth:= 200,
+                 windowDefaultHeight:= 100]
+     mainbox <- vBoxNew True 0
+     containerAdd window mainbox
+
+     hbox1 <- hBoxNew True 0
+     boxPackStart mainbox hbox1 PackGrow 0
+
+     cal <-calendarNew
+     boxPackStart hbox1 cal PackGrow 0   
+
+     vbox1 <- vBoxNew True 0
+     frame1 <- frameNew
+     set frame1 [frameLabel := "Display Options",
+                 containerBorderWidth := 10,
+                 frameLabelYAlign := 0.5, 
+                 frameLabelXAlign := 0.5,
+                 containerChild := vbox1 ]
+     boxPackStart hbox1 frame1 PackGrow 0
+     headingopt <- addDisplayOpt vbox1 "Show Heading"
+     daynameopt <- addDisplayOpt vbox1 "Show Day Names"
+     monchngopt <- addDisplayOpt vbox1 "No Month Change"
+     weeknumopt <- addDisplayOpt vbox1 "Show Week Numbers"
+
+     set headingopt [toggleButtonActive := True]
+     set daynameopt [toggleButtonActive := True]
+
+     reslabel <- labelNew Nothing
+     showMess cal reslabel "Nothing Done Yet"
+     frame2 <- frameNew
+     set frame2 [frameLabel := "Last Action:",
+                 containerBorderWidth := 10, 
+                 containerChild := reslabel]
+     boxPackStart mainbox frame2 PackGrow 0     
+
+     mySetOnToggled headingopt cal calendarShowHeading
+     mySetOnToggled daynameopt cal calendarShowDayNames
+     mySetOnToggled monchngopt cal calendarNoMonthChange
+     mySetOnToggled weeknumopt cal calendarShowWeekNumbers
+
+     onDaySelected cal (showMess cal reslabel "Day Selected")
+     onDaySelectedDoubleClick cal 
+            (showMess cal reslabel "Double Click Day Selected")
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+
+
+addDisplayOpt :: VBox -> String -> IO CheckButton
+addDisplayOpt box lbl = do
+         cb <- checkButtonNewWithLabel lbl
+         boxPackStart box cb PackGrow 5
+         return cb
+
+mySetOnToggled :: CheckButton -> Calendar -> 
+               Attr Calendar Bool -> 
+               IO (ConnectId CheckButton)
+mySetOnToggled cb cl att = onToggled cb $ do
+         cbstate <- get cb toggleButtonActive
+         set cl [att := cbstate]
+
+showMess :: Calendar -> Label -> String -> IO ()
+showMess cal lbl str = do  
+         (year, month, day) <- calendarGetDate cal
+         labelSetText lbl $ str ++ "\n" ++ "Date = " ++
+                      (show year) ++ "//" ++ 
+                      (myshow (month +1))  -- month is 0 to 11
+                       ++ "//" ++ (myshow day) 
+                            where myshow n | n <= 9 = '0':(show n)
+                                           | otherwise = show n
+
+{- Comentado para hacer una comprobación específica de la plataforma:
+Estas señales parecen implementadas como onDaySelected.
+La plataforma es: Gtk2Hs 0.9.12 en Fedora Core 6
+
+     onMonthChanged cal (showMess cal reslabel "Month Changed")
+     onNextMonth cal (showMess cal reslabel "Next Month Selected")
+     onNextYear cal (showMess cal reslabel "Next Year Selected")
+     onPrevMonth cal (showMess cal reslabel "Previous Month
+Selected")
+     onPrevYear cal (showMess cal reslabel "Previous Year
+Selected")
+-}
+
+ + + addfile ./docs/tutorial/Tutorial_Port/es-chap5-2.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap5-2.xhtml 1 - + + + + + Tutorial de Gtk2Hs: Selección de fichero + + + +

5.2 Selección de fichero

+

Los ficheros y los directorios (carpetas) son esenciales en cualquier + programa de ordenador y Gtk contiene diversos componentes para facilitar + su manejo. La selección de ficheros y directorios en Gtk2Hs se + implementa a través del interfaz FileChooser. Basicamente hay cuatro + modos, como se indica en el tipo FileChooserAction. Sus constructores son:

+ +

El interfaz + FileChooser tiene atributos, métodos y señales, pero no es propiamente un widget. Hay tres + widgets que usan el interfaz de modo diferente, + FileChooserWidget , + FileChooserButton y + FileChooserDialog . El widget a usar está restingido por la + FileChooserActionType permitida. Como verás en los ejemplos siguientes, + el widget para guardar un fichero o para seleccionar un directorio puede contener + también un botón que permita al usuario crear un directorio. Además, el constructor + FileActionCreateFolder probablemente nuncá será usado en ninguno de tus programas.

+

Es importante indicar que, a pesar de que los widgets no guardan ni abren ficheros por + sí mismos, le creación de los directorios (por el usuario) se implementa a través de widgets.

+

Nuestro primer ejemplo usará FileChooserWidget , que puede emplearse en el modo + Abrir y Salvar.

+
fileChooserWidgetNew :: FileChooserAction -> IO FileChooserWidget
+
+

Aquí usamos FileChooserActionOpen, y cuando el usuario elige definitivamente un fichero, ya sea + haciendo doble clic en él o pulsando la tecla Enter, la señal onFileActived se emite. Usamos:

+
fileChooserGetFilename :: FileChooserClass self => self -> IO (Maybe FilePath)
+
+

Desde la ubicación del fichero, el programa puede abrir el fichero, o posiblemente hacer otra cosa. + El formato del filepath puede depender de la plataforma y está determinado por la variable de entorno + G_FILENAME_ENCODING. Hay también funciones en FileChooser para formatos URI (Uniform Resource Identifier), + pero no las vamos a ver aquí.

+

Puedes permitir al usuario seleccionar múltiples ficheros con:

+
fileChooserSetselectMultiple :: FileChooserClass self => self -> Bool -> IO ()
+
+

y, con el FileChooserWidget , puedes añadir fácilmente un botón check + para dejar al usuario determinarlo. La colocación de un widget de este tipo se hace de modo estándar + con:

+
fileChooserSetExtraWidget :: (FileChooserClass self, WidgetClass extraWidget)
+=> self -> extraWidget -> IO ()
+
+

Otra utilidad es el uso de filtros para mostrar sólo ficheros de un tipo, ya + sea especificando un tipo MIME, un pattern (plantilla) o un formato a medida. + Los filtros de ficheros se documentan en Graphics.UI.Gtk.Selectors.FileFilter.

+

El siguiente trozo de código, parte del ejemplo siguiente, muestra los filtros. + La última línea simplemente añade el filtro al widget selector de fichero y, como ocurre con el widget extra, + el posicionamiento visual se hace automáticamente.

+
   hsfilt <- fileFilterNew
+   fileFilterAddPattern hsfilt "*.hs"
+   fileFilterSetName hsfilt "Haskell Source"   
+   fileChooserAddFilter fch hsfilt
+
+

Puedes también añadir un widget "preview" (previsualización) con:

+
fileChooserSetPreviewWidget :: (FileChooserClass self, WidgetClass
+previewWidget) => self -> previewWidget -> IO ()
+
+

En el ejemplo se usa para previsualizar ficheros gráficos. El ejemplo usa un widget + Image (documentado en Graphics.UI.Gtk.Display.Image) como los usados antes en el + Capítulo 4.1. + Allí usamos imageNewFromFile para añadir gráficos a un botón; aquí construímos + un widget Image vacío.

+

Para actualizarlo cuando haya cambios, tenemos una señal onUpdatePreview, + que se emite cada vez que el usuario cambia la selección de fichero moviendo el ratón o con las teclas + de aceleración. Esta señal es más general que lo que su nombre sugiere, pero aquí se usa sólo para + previsualizar. El código es el siguiente:

+
   onUpdatePreview fch $ 
+        do file <- fileChooserGetPreviewFilename fch
+           case file of
+                Nothing -> putStrLn "No File Selected"
+                Just fpath -> imageSetFromFile img fpath
+
+

Hay funciones y atributos para controlar lo que se muestra, por ejemplo + lo que sucede cuando el fichero seleccionado no es un fichero gráfico, pero + no son estrictamente necesarios. En el resto del código los ficheros no gráficos + se ignoran o se muestra un icono estándar. Así es como aparecen:

+

+ File Selection examples +

+

Fíjate en que el usuario también puede añadir y borrar bookmarks, y + FileChooser tiene funciones para gestionar esto también. Sin + embargo, esta característica no se trata en el ejemplo FileChooserWidget , que + tiene el siguiente código fuente:

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main = do
+   initGUI
+   window <- windowNew
+   set window [windowTitle := "File Chooser Widget", 
+               windowDefaultWidth := 500,
+               windowDefaultHeight := 400 ]
+
+   fch <- fileChooserWidgetNew FileChooserActionOpen
+   containerAdd window fch 
+
+   selopt <- checkButtonNewWithLabel "Multiple File Selection"
+   fileChooserSetExtraWidget fch selopt
+
+   hsfilt <- fileFilterNew
+   fileFilterAddPattern hsfilt "*.hs"
+   fileFilterSetName hsfilt "Haskell Source"   
+   fileChooserAddFilter fch hsfilt
+
+   nofilt <- fileFilterNew
+   fileFilterAddPattern nofilt "*.*"
+   fileFilterSetName nofilt "All Files"
+   fileChooserAddFilter fch nofilt
+
+   img <- imageNew
+   fileChooserSetPreviewWidget fch img
+
+
+   onUpdatePreview fch $ 
+        do file <- fileChooserGetPreviewFilename fch
+           case file of
+                Nothing -> putStrLn "No File Selected"
+                Just fpath -> imageSetFromFile img fpath
+
+                           
+   onFileActivated fch $ 
+        do dir <- fileChooserGetCurrentFolder fch
+           case dir of 
+                Just dpath -> putStrLn 
+                               ("The current directory is: " ++
+dpath)
+                Nothing -> putStrLn "Nothing" 
+           mul <- fileChooserGetSelectMultiple fch 
+           if mul 
+              then do
+                fls <- fileChooserGetFilenames fch
+                putStrLn 
+                  ("You selected " ++ (show (length fls)) ++
+"files:")
+                sequence_ (map putStrLn fls)
+              else do
+                file <- fileChooserGetFilename fch
+                case file of
+                     Just fpath -> putStrLn ("You selected: " ++
+fpath)
+                     Nothing -> putStrLn "Nothing"
+
+   onToggled selopt $ do state <- toggleButtonGetActive selopt
+                         fileChooserSetSelectMultiple fch state
+
+   widgetShowAll window
+   onDestroy window mainQuit
+   mainGUI
+
+

Nota: Con Gtk2Hs 0.9-12 y GHC 6.1 en Fedora Core 6, la selección múltiple + de ficheros funciona visualmente (las teclas Ctrl y Shift funcionan como el usuario + supone), pero la lista de direcciones de fichero sólo contiene la dirección + del último fichero seleccionado.

+

El segundo modo de usar el interface FileChooser es a través de FileChooserButton .

+
fileChooserButtonNew :: String FileChooserAction -> String ->
+IO FileChooserButton
+
+

El parámetro tipo String es el nombre de la ventana de diálogo que salta + cuando el usuario selecciona la opción 'other...' después de pulsar el botón. En el ejemplo hemos + construido un botón de selección de fichero con FileChooserActionSelectFolder. Tras seleccionar el directorio + "Test", se vería así.

+

+ File Selection examples +

+

Así es como se vería la ventana de diálogo:

+

+ File Selection examples +

+

Como puedes ver, hay un botón "Create Folder" (Crea Carpeta) en la parte superior derecha de la ventana + de diálogo. La puedes usar para crear un directorio. Esto es lo que sucede si tratamos de crear una carpeta + existente:

+

+ File Selection examples +

+

Crear o sobrescribir un directorio existente no tiene sentido y puede ser peligroso. Así + que Gtk2Hs automáticamente lo percibe y lo notifica al usuario. Cuando el usuario selecciona un + directorio existente, la señal onCurrentFolderChanged se emite y el programa puede + tomar la acción apropiada. Al crear un directorio se selecciona automáticamente, así que, en ese caso, + la señal onCurrentFolderChanged también puede ser usada. Aquí está el código del ejemplo:

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main = do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "File Chooser Button",
+windowDefaultWidth := 250, windowDefaultHeight := 75 ]
+     fchd <- fileChooserButtonNew "Select Folder"
+FileChooserActionSelectFolder
+     containerAdd window fchd
+
+     onCurrentFolderChanged fchd $
+          do dir <- fileChooserGetCurrentFolder fchd   
+             case dir of
+                  Nothing -> putStrLn "Nothing"
+                  Just dpath -> putStrLn ("You selected:\n" ++
+dpath)
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+
+

La tercera manera de usar el interfaz FileChooser es a través de + FileChooserDialog . Puede ser construido en modo abrir o salvar, y normalmente se aplica desde + un menú o una barra de herramientas.

+

+ FileChooserDialog implementa tanto + FileChooser como + Dialog . Recuerda del Capítulo 4.5 que un "diálogo" es un widget compuesto con botones, normalmente + implementados con dialogRun, que produce respuestas del tipo + ResponseId . Un + FileChooserDialog se construye con:

+
fileChooserDialogNew ::
+Maybe String                 -- título del diálogo o "por defecto"
+-> Maybe Window              -- Ventana "padre" del diálogo o nada
+-> FileChooserAction         -- modo abrir o salvar
+-> [(String, ResponseId)]    -- lista de botones y sus códigos de respuesta
+-> IO FileChooserDialog
+
+

Todo lo que tienes que hacer es indicar los nombres de los botones y sus respuestas en el cuarto + argumento, y serán automáticamente implementados.

+

El ejemplo usa + FileChooserActionSave y la ventana de diálogo tiene tres botones. Así es como queda:

+

+ File Selection examples +

+

Como puedes ver aquí hay un botón en la parte superior derecha para crear una carpeta. Como en el ejemplo + anterior, intentar crear una carpeta ya existente genera un mensaje de error. + Sobreescribir un fichero, sin embargo, tiene sentido y es admitido por defecto. + Puedes ahcer que el usuario confirme la sobreescritura de ficheros con:

+
fileChooserSetDoOverwriteconfirmation :: FileChooserClass self
+=> self -> Bool -> IO ()
+
+

Como ya mencioné, no se realizan escrituras o sobrescrituras de ficheros con el + widget FileChooserDialog; El programa simplemente obtiene el path del fichero.

+

Este es el código del tercer ejemplo:

+
import  Graphics.UI.Gtk 
+ 
+main :: IO ()
+main = do
+     initGUI
+     fchdal <- fileChooserDialogNew (Just "Save As...Dialog")
+Nothing
+                                     FileChooserActionSave
+                                     [("Cancel", ResponseCancel),
+                                      ("Save", ResponseAccept),
+                                      ("Backup", ResponseUser 100)]
+ 
+     fileChooserSetDoOverwriteConfirmation fchdal True
+     widgetShow fchdal
+     response <- dialogRun fchdal
+     case response of
+          ResponseCancel -> putStrLn "You cancelled..."
+          ResponseAccept -> do nwf <- fileChooserGetFilename
+fchdal
+                               case nwf of
+                                    Nothing -> putStrLn
+"Nothing"
+                                    Just path -> putStrLn ("New
+file path is:\n" ++ path)
+          ResponseUser 100 -> putStrLn "You pressed the backup
+button"
+          ResponseDeleteEvent -> putStrLn "You closed the dialog
+window..."
+
+     widgetDestroy fchdal
+     onDestroy fchdal mainQuit
+     mainGUI
+
+

Nota: Al probarlo con Gtk2Hs 0.9-12 y GHC 6.1 en Fedora Core 6, + pulsar la tecla "Enter" para guardar el fichero no tiene ningún efecto. Cuando + se elige un fichero existente, pulsar la tecla "Save" no tiene efecto la primera vez, + pero si se pulsa de nuevo provoca la aparición de la ventana de confirmación. Mi + opinión es que esto tiene algo que ver con la señal onConfirmOverwrite y + su segundo argumento de tipo IO FileChooserConfirmation. No entiendo bien su uso, + y quizá el error provenga de mi código.

+ addfile ./docs/tutorial/Tutorial_Port/es-chap5-3.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap5-3.xhtml 1 - + + + + + + Tutorial de Gtk2Hs: Seleción de Fuente (tipo de letra) + + + +

5.3 Seleción de Fuente (tipo de letra)

+

La selección del color y del tipo de letra son muy parecidas + a la selección de ficheros. Hay tres maneras de implantarlas, como widgets, + como diálogos y como botones. Los valores seleccionados por el usuario se + obtienen a partir de atributos y funciones, como ya va resultando habitual. + Primero discutiremos la selección de tipo de letra (font). Puedes usar:

+
fontSelectionNew :: IO FontSelection
+fontSelectionDialogNew :: String -> IO FontSelectionDialog
+fontButtonNew :: IO FontButton
+
+

El parámetro + String es el título de la ventana de diálogo. Hay un puñado de + atributos y funciones para gestionar la presentación de estos widgets, todos bastante + sencillos. Con un diálogo debes usar los tipos ResponseId adecuados; con + el FontButton debes usar:

+
onFontSet:: FontButtonClass self => self -> IO () -> IO (ConnectId self)
+
+

Después puedes usar la siguiente función para conseguir el nombre de la fuente seleccionada + por el usuario:

+
fontButtonGetFontName :: FontButtonClass self => self -> IO String
+
+

El nombre de la fuente debe ser algo así como "Courier Italic 10" o + "URW Gothic L Semi-Bold Oblique 16", dependiendo de lo que esté disponible en + tu sistema. Como puedes ver en la imagen, el usuario puede seleccionar una familia, + un estilo y un tamaño.

+

+ Font Select Window +

+

La documentación sobre fonts está en Graphics.UI.Gtk.Pango.Font. Se soportan diversas + características avanzadas, pero el usuario normal sólo necesita saber como conseguir una + FontDescription (descripción de fuente) a partir de un nombre de fuente.

+
fontDescriptionFromString :: String -> IO FontDescription
+
+

Una vez que tienes la FontDescription (descripción de una fuente), puedes + usar:

+
widgetModifyFont:: WidgetClass self => self -> Maybe FontDescription -> IO ()
+
+

La selección de color es parecida a la selección de fuentes. Tienes tres posibilidades: +

+
colorSelectionNew :: IO Color Selection
+colorSelectionDialogNew: :: String -> IO ColorSelectionDialog
+colorButtonNew :: IO Color Button
+
+

Con un ColorButton usa:

+
onColorSet :: ColorButtonClass self => self -> IO () -> IO (ConnectId self)
+
+

y después:

+
colorButtonGetColor :: ColorButtonClass self => self -> IO Color
+
+

También hay una función (y un atributo) para conseguir el valor Alpha (opacidad), + si esta característica ha sido activada.

+

La ventana de selección de color que aparece por defecto tiene esta forma:

+

+ Color Selection Window +

+

Color es un tipo de datos de tres Ints , en un rango de 0 A 65535, que + especifican los valores de los componentes rojo, verde y azul. Aquí hay funciones que + permiten establecer los colores del foreground, background, texto y base de un widget, y + estas funciones usan un parámetro de tipo StateType. Estos son sus valores: + StateNormal, StateActive, StatePreLight, StateSelected + y StateInsensitive y dependen de si el widget está activo, el puntero del ratón está + sobre un widget, se selecciona un widget y cosas así. Hay muchos parámetros que gobiernan la + presentación de los widgets, por ejemplo, para cambiar el color de una etiqueta de texto + simplemente debes usar StateNormal y el Color que haya sido + seleccionado por el usuario.

+
widgetModifyFg :: WidgetClass self => self -> StateType -> Color -> IO ()
+
+

Si tienes dudas sobre cual es el StateType que tiene el widget, puedes usar la siguiente + función:

+
widgetGetState :: WidgetClass w => w -> IO StateType
+
+

Aquí hay un ejemplo de selección de fuente y color.

+

+ FontButton and ColorButton Example +

+

La ventana automáticamente cambia de tamaño para que quepa la fuente mayor.

+

+ Window +

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main = do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Font and Color Selection",
+containerBorderWidth := 10 ]
+     vb <- vBoxNew False 0
+     containerAdd window vb
+
+     qtlab <- labelNew (Just "How poor are they that have not
+patience!\nWhat wound did ever heal but by degrees?\nThou know'st
+we work by wit, and not by witchcraft;\nAnd wit depends on dilatory
+time.")
+     boxPackStart vb qtlab PackGrow 0
+
+     srclab <- labelNew (Just "From Othello (II, iii, 376-379)")
+     srcfont <- fontDescriptionFromString "Courier Italic 10"
+     widgetModifyFont srclab (Just srcfont)
+     miscSetAlignment srclab 1.0 0.5
+     boxPackStart vb srclab PackNatural 10
+
+     sep <- hSeparatorNew
+     boxPackStart vb sep PackGrow 10
+     
+     fntb <- fontButtonNew
+     boxPackStart vb fntb PackGrow 0
+
+     colb <- colorButtonNew
+     boxPackStart vb colb PackGrow 0
+
+     onFontSet fntb $ do name <- fontButtonGetFontName fntb
+                         fdesc <- fontDescriptionFromString name
+                         widgetModifyFont qtlab (Just fdesc)
+                         putStrLn name
+
+     onColorSet colb $ do colour <- colorButtonGetColor colb
+                          widgetModifyFg qtlab StateNormal colour
+                          putStrLn (show  colour)
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+
+instance Show Color where
+         show (Color r g b) = "Red: " ++ (show r) ++ 
+                              " Green: " ++ (show g) ++ 
+                              " Blue: " ++ (show b)
+
+ + addfile ./docs/tutorial/Tutorial_Port/es-chap5-4.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap5-4.xhtml 1 - + + + + + + Tutorial de Gtk2Hs: Bloc de notas + + + +

5.4 Bloc de notas

+

El widget + Notebook (bloc de notas) es una colección de "páginas" que + se superponen. Cada página es diferente, y sólo una es visible en cada + momento. Las páginas contienen otros widgets que el programador suministra.

+

Para crear un nuevo widget Notebook:

+
NotebookNew :: IO Notebook
+
+

Una vez que el bloc de notas ha sido creado, dispones de funciones y atributos + para ajustarlo a tus necesidades o gustos. Los siguientes atributos determinan la + posición de las pestañas (tabs), y si son visibles o no.

+
notebookTabPos :: NotebookClass self => Attr self PositionType
+notebookShowTabs :: NotebookClass self => Attr self Bool
+
+

PositionType (tipo de posición) tiene los siguientes cosntructores : + PosLeft , + PosRight , + PosTop (por defecto) y + PosBottom.

+

A continuación echaremos un vistazo a la manera de añadir páginas + al notebook. Hay tres modos, append (añadir detrás), prepend (añadir delante) e insert (insertar).

+
noteBookAppendPage :: (NotebookClass self, WidgetClass child)
+=> self
+-> child         -- El widget que tiene los contenidos de la página
+-> String        -- la etiqueta de texto
+-> IO Int        -- el índice (número de página) de la nueva página (empieza en 0)
+
+

La función + notebookPrependPage tiene la misma signatura. + Y, por supuesto, devuelve 0 como valor del índice. La función + notebookInsertPage toma el índice (lugar donde quieres insertar + la página) como un parámetro adicional. Se pueden eliminar páginas + con + notebookRemovePage.

+

Un + Notebook es un widget contenedor y puedes usar otros contenedores como + hijos, incluyendo cajas horizontales y verticales. Esto te permite crear páginas + bastante complejas, y establecer su distribución con las funciones de empaquetado + habituales.

+

Las funciones listadas para añadir, pre-añadir e insertar páginas, sólo sirven + con etiquetas de texto. Las tres tienen versiones que permiten que aparezca un menú + emergente (popup), y en los cuales puedes usar cualquier widget como etiqueta.

+
notebookAppendPageMenu ::
+(NotebookClass self, WidgetClass child, WidgetClass tabLabel, WidgetClass menuLabel)
+=> self
+-> child           -- el widget contenido en la página
+-> tabLabel        -- el widget para usar como etiqueta de la página
+-> menuLabel       -- el widget para usar como etiqueta del menú emergente
+-> IO Int          -- el índice (número de página) de la nueva página (empieza en 0)
+
+

+ notebookPrependPageMenu y + notebookInsertPageMenu colocarán la página en primer lugar o en + la posición indicada por el índice respectivamente.

+

Algunos atributos interesantes son: (consulta la docuemntación de la API (en inglés) + para verlos todos):

+
notebookScrollable :: NotebookClass self => Attr self Bool
+notebookCurrentPage :: NotebookClass self => Attr self Int
+notebookEnablePopup :: NotebookClass self => Attr self Bool
+
+

Si hay muchas páginas puedes usar + notebookScrollable . Usa + notebookCurrentPage o la función + notebookSetCurrentPage para abrir el notebook en una página diferente + que la primera (valor por defecto). El atributo + notebookEnablePopup determina si la pulsación del botón derecho + del ratón en una pestaña mostrará un menú emergente de todas las páginas disponibles, + siempre que las funciones de menú hayan sido definidas.

+

Un widget + Notebook tiene su propia función de manejo de la señal:

+
onSwitchPage :: NotebookClass nb => nb -> (Int -> IO ()) -> IO (ConnectId nb)
+
+

La función, que tú debes suministrar, emplea un índice de página devuelto por + onSwitchPage y debe realizar alguna salida.

+

Los ejemplos muestran un catálogo StockItem de conjuntos de iconos + de maneras diversas.

+

+ Notebook Example 1 +

+

Vimos los Stock items en el capítulo 4.5. Recuerda + que un StockItem se conoce a partir de GTK+ (y Gtk2Hs). + La siguiente función produce una lista de todos los identificadores de Stock Items.

+
stockListIds :: IO [StockId]
+
+

Un + StockId es una + String y en Gtk2Hs tiene la forma: + stockCopy , + stockDialogError etc. En GTK+ la forma correspondiente + es: gtk-copy, gtk-dialog-error y así sucesivamente. El ejemplo + define una función tabName para convertir los identificadores GTK+ en + la lista de StockId a nombres para las solapas del notebook. La función + myNewPage usa + imageNewFromStock para poner el icono en un widget + Image, que será después añadido a la página. Devuelve + el índice de la página, pero no lo usa. Para conseguir una lista de todas las + páginas puedes usar sequence en vez de + sequence_

+

Fíjate en que el tamaño del icono, en píxeles debe ser limitado. El + valor por defecto es 4, el valor usado aquí, 6, también está permitido + pero un tamaño de 8 produce un error de ejecución con GHCi.

+
import Graphics.UI.Gtk
+import Data.Char (toUpper)
+
+main :: IO ()
+main= do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Notebook Example 1", windowDefaultWidth := 300,
+                 windowDefaultHeight := 200 ]
+     
+     ntbk <- notebookNew
+     containerAdd window ntbk
+     set ntbk [notebookScrollable := True, notebookTabPos := PosBottom]
+
+     stls <- stockListIds
+     sequence_ (map (myNewPage ntbk) stls)
+
+     onSwitchPage ntbk (putStrLn . ((++)"Page: ") . show)
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+
+tabName :: StockId -> String
+tabName st = (drop 3) (conv st) where
+                  conv (x:[]) = x:[]
+                  conv (x:y:ys) | x == '-' = (toUpper y):(conv ys)
+                                | otherwise = x: (conv (y:ys))
+
+myNewPage :: Notebook -> StockId -> IO Int
+myNewPage noteb stk = 
+          do img <- imageNewFromStock stk 6
+             pagenum <- notebookAppendPage noteb img (tabName stk)
+             return pagenum          
+
+

Otra manera de mostrar el catálogo es poner los iconos en las solapas + del notebook.

+

+ Notebook Example 2 +

+

Para hacer esto necesitamos el estilo de menú para añadir páginas, y también + hemos definido un menú de solapas que consta de la primera letra de la cadena + nombre. El resultado es un menú emergente de 98 letras, con desplazamiento. + Esto puede ser inhabilitado de un modo sencillo + a través del atributo notebookEnablePopup. El contenido de cada + página es el identificador de icono de Gtk2Hs (mira + Graphics.UI.Gtk.General.StockItems).

+
import Graphics.UI.Gtk
+import Data.Char (toUpper)
+
+main :: IO ()
+main= do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Notebook Example 2", windowDefaultWidth := 300,
+                 windowDefaultHeight := 200 ]
+     
+     ntbk <- notebookNew
+     containerAdd window ntbk
+     set ntbk [notebookScrollable := True, notebookEnablePopup := True,
+                    notebookTabPos := PosRight ]
+
+     stls <- stockListIds
+     sequence_ (map (myNewPage ntbk) stls)
+
+     onSwitchPage ntbk (putStrLn . ((++)"Page: ") . show)
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+
+tabName :: StockId -> String
+tabName st = (drop 3) (conv st) where
+                  conv (x:[]) = x:[]
+                  conv (x:y:ys) | x == '-' = (toUpper y):(conv ys)
+                                | otherwise = x: (conv (y:ys))
+
+myNewPage :: Notebook -> StockId -> IO Int
+myNewPage noteb stk = 
+          do img <- imageNewFromStock stk 4
+             let nmstr = tabName stk
+             men <- labelNew (Just ((take 1) nmstr))
+             cont <- labelNew (Just ("stock" ++ nmstr))
+             pagenum <- notebookAppendPageMenu noteb cont img men
+             return pagenum          
+
+ + + addfile ./docs/tutorial/Tutorial_Port/es-chap6-1.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap6-1.xhtml 1 - + + + + + + Tutorial de Gtk2Hs: Ventanas con desplazamiento (scroll) + + + +

6.1 Ventanas con desplazamiento (scroll)

+

Las ventanas con desplazamiento se usan para crear un área desplazable con otro + widget dentro de él. Puedes insertar cualquier tipo de widget en una ventana desplazable, + y será accesible, sin tener en cuenta su tamaño, mediante el uso de las barras de desplazamiento + (scroll bars)

+

La siguiente función se usa para crear una nueva ventana desplazable.

+
scrolledWindowNew :: Maybe Adjustment -> Maybe Adjustment -> IO ScrolledWindow
+
+

El primer argumento es el ajuste de la dirección horizontal, y el segundo el de la dirección vertical. + Casi siempre se establecen a + Nothing (nada) .

+
scrolledWindowSetPolicy :: ScrolledWindowClass self =>
+self -> PolicyType -> PolicyType -> IO ()
+
+

Este establece la política a usar con respecto a las barras de desplazamiento verticales y + horizontales. El constructor PolicyAlways muestra siempre la barra de desplazamiento, + PolicyNever no la muestra nunca y + PolicyAutomatic la muestra sólo si el tamaño de la página es mayor que la ventana. + Por defecto usa + PolicyAlways.

+

A continuación puedes colocar tu objeto en la ventana con desplazamiento usando + containerAdd si el objeto tiene una ventana asociada con él. Si no lo tiene, + necesitarás un Viewport , aunque puedes añadir una automáticamente con:

+
scrolledWindowAddWithViewport :: (ScrolledWindowClass self, WidgetClass child)
+=> self -> child -> IO ()
+
+

Si te olvidas del viewport, GHCi produce un mensaje de + error si usas containerAdd y no has debido hacerlo.

+

En el ejemplo empaquetamos una tabla con 100 botones toggle en + una ventana con desplazamiento. Implementa un programa de + 'Yet Another Haskell Tutorial' (y otro tutorial de Haskell) de Hal Daumé III. + Este tutorial está disponible en forma gratuita en el web de Haskell. + En la página 43 hay un programita que permite adivinar un numero entre 1 y 100, seleccionado + al azar por la máquina, indicando si nuestra selección es menor, mayor o igual. + El número se genera con la función randomRIO del módulo System.Random.

+

Nuestro ejemplo lo implementa con un interfaz gráfico.

+

Scrolled Window

+ +

En la ventana principal usamos una caja vertical para empaquetar + una etiqueta (para información del usuario), un separador horizontal, una + ventana con desplazamiento, un separador horizontal y una caja + horizontal que contiene dos botones de stock. + La ventana con desplazamiento se empaqueta con PackGrow, + lo que le permite adaptarse a los cambios de tamaño de la ventana principal. + Los botones nuevo (new) y salir (quit) se empaquetan en los extremos + opuestos de la caja horizontal.

+

Los 100 botones se crean con:

+
     buttonlist <- sequence (map numButton [1..100])
+
+

donde la función + numButton se define como:

+
numButton :: Int -> IO Button
+numButton n = do
+        button <- buttonNewWithLabel (show n)
+        return button
+
+

Así, cada botón automáticamente obtiene el número apropiado + como etiqueta.

+

Dentro de la ventana con desplazamiento creamos una tabla + de 10 por 10 para los 100 botones. Para posicionar los botones + usamos la función cross , que se basa en List monad. + Esta función, un modo sencillo de obtener un producto cartesiano + de dos o más listas, también está explicado en el tutorial ya citado.

+
cross :: [Int] -> [Int] -> [(Int,Int)]
+cross row col = do 
+        x <- row
+        y <- col
+        return (x,y)
+
+

La función + attachButton parte de una tabla, un botón y una + tupla de coordenadas para colocar un botón en la tabla. (Repasa el + capítulo 3.3 para más información sobre empaquetado de tablas.)

+
attachButton :: Table -> Button -> (Int,Int) -> IO () 
+attachButton ta bu (x,y) = tableAttachDefaults ta bu y (y+1) x (x+1)
+
+

Ahora, el siguiente segmento de código empaqueta todos los botones en + la tabla con buttonlist según se ha descrito.

+
     let places = cross [0..9] [0..9]
+     sequence_ (zipWith (attachButton table) buttonlist places)
+
+

Cada vez que el usuario pulsa el botón play se genera un + número aleatorio, que habrá que ir comparando con la elección + del usuario. Pero el manejador de señales de Gtk2Hs onClicked + emplea un botón y una función sin parámetros y tiene un valor de tipo + IO () . Necesitamos algo así como una variable global, + y esta es aportada por el módulo Data.IORef. Ahora podemos usar los siguientes + snippets, en diferentes funciones, para inicializar, escribir y leer el + número aleatorio.

+
snippet 1   --  randstore <- newIORef 50  
+snippet 2   --  writeIORef rst rand  
+snippet 3   --  rand <- readIORef rst
+
+

El primero obtiene una variable de tipo IORef Int y la + inicializa al valor 50. La segunda se implementa con la función aleatoria + randomButton :

+
randomButton :: ButtonClass b => Label -> IORef Int -> b -> IO (ConnectId b)
+randomButton inf rst b = 
+    onClicked b $ do rand <- randomRIO (1::Int, 100)
+                     writeIORef rst rand  
+                     set inf [labelLabel := "Ready"]
+                     widgetModifyFg inf StateNormal (Color 0 0 65535)
+
+

y después usa el siguiente snippet, donde info + es la etiqueta que permite acceder a la información de usuario. + (Mira el capítulo 5.3 para los colores y como cambiarlos.)

+

De un modo parecido a la escritura del número aleatorio, la + función actionButton implementa la lectura de + randstore. Entonces compara el número obtenido + de la etiqueta del botón que ha sido pulsado, y muestra la + información en la etiqueta info.

+

Finalmente debemos monitorizar los 100 botones para saber cual ha + sido pulsado, si ha habido alguno.

+
     sequence_ (map (actionButton info randstore) buttonlist)
+
+

Lo anterior es análogo a las combinaciones de sequence _ y + map que hemos usado, pero en este caso exactamente + uno de los 100 manejadores de señal será activado, en el momento en + que el usuario pulse un botón concreto.

+

A continuación tienes el código completo del ejemplo.

+
import Graphics.UI.Gtk
+import Data.IORef 
+import System.Random (randomRIO)
+
+main:: IO ()
+main= do
+     initGUI
+     window <- windowNew
+     set window [ windowTitle := "Guess a Number", 
+                  windowDefaultWidth := 300, windowDefaultHeight := 250]
+     mb <- vBoxNew False 0
+     containerAdd window mb
+
+     info <- labelNew (Just "Press \"New\" for a random number")
+     boxPackStart mb info PackNatural 7
+     sep1 <- hSeparatorNew
+     boxPackStart mb sep1 PackNatural 7
+     
+     scrwin <- scrolledWindowNew Nothing Nothing
+     boxPackStart mb scrwin PackGrow 0
+
+     table <- tableNew 10 10 True
+     scrolledWindowAddWithViewport scrwin table
+
+     buttonlist <- sequence (map numButton [1..100])
+     let places = cross [0..9] [0..9]
+     sequence_ (zipWith (attachButton table) buttonlist places)
+
+     sep2 <- hSeparatorNew
+     boxPackStart mb sep2 PackNatural 7
+     hb <- hBoxNew False 0
+     boxPackStart mb hb PackNatural 0
+     play <- buttonNewFromStock stockNew
+     quit <- buttonNewFromStock stockQuit
+     boxPackStart hb play PackNatural 0
+     boxPackEnd hb quit PackNatural 0
+     
+     randstore <- newIORef 50
+     randomButton info randstore play
+
+     sequence_ (map (actionButton info randstore) buttonlist)  
+
+     widgetShowAll window
+     onClicked quit (widgetDestroy window)
+     onDestroy window mainQuit
+     mainGUI
+
+numButton :: Int -> IO Button
+numButton n = do
+        button <- buttonNewWithLabel (show n)
+        return button
+
+cross :: [Int] -> [Int] -> [(Int,Int)]
+cross row col = do 
+        x <- row
+        y <- col
+        return (x,y)
+
+attachButton :: Table -> Button -> (Int,Int) -> IO ()
+attachButton ta bu (x,y) = 
+              tableAttachDefaults ta bu y (y+1) x (x+1)
+
+actionButton :: ButtonClass b => Label -> IORef Int -> b -> IO (ConnectId b)
+actionButton inf rst b = 
+  onClicked b $ do label <- get b buttonLabel
+                   let num = (read label):: Int
+                   rand <- readIORef rst
+                   case compare num rand of
+                     GT -> do set inf [labelLabel :=  "Too High"]
+                              widgetModifyFg inf StateNormal (Color 65535 0 0)
+                     LT -> do set inf [labelLabel := "Too Low"]
+                              widgetModifyFg inf StateNormal (Color 65535 0 0)
+                     EQ -> do set inf [labelLabel := "Correct"]
+                              widgetModifyFg inf StateNormal (Color 0 35000 0)
+
+randomButton :: ButtonClass b => Label -> IORef Int -> b -> IO (ConnectId b)
+randomButton inf rst b = 
+    onClicked b $ do rand <- randomRIO (1::Int, 100)
+                     writeIORef rst rand  
+                     set inf [labelLabel := "Ready"]
+                     widgetModifyFg inf StateNormal (Color 0 0 65535)
+
+ + + addfile ./docs/tutorial/Tutorial_Port/es-chap6-2.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap6-2.xhtml 1 - + + + + + + Tutorial de Gtk2Hs: Cajas de botones y cajas de eventos + + + +

6.2 Cajas de botones y cajas de eventos

+

Un evento en Gtk2Hs es algo que se envía a un widget, por + el bucle principal, normalmente como resultado de una acción + realizada por el usuario. El widget entonces responde emitiendo + una señal, y esta es la señal para el programa de hacer algo. + Para el programador de aplicaciones de Gtk2Hs, sin embargo, + un evento no es más que un tipo de datos de Haskell con campos + nombrados. La mayoría de estos están descritos en + la sección de la API correspondiente a Graphics.UI.Gtk.Gdk.Events. Mira, por ejemplo, + la señal del widget:

+
onButtonPress :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w)
+
+

Esto no debe ser confundido con la señal emitida cuando un + widget de tipo Button es presionado; el botón + aquí es un botón del ratón y la señal se emite cuando se ha pulsado + un botón del ratón cuando el ratón estaba sobre ese widget. El manejador es una función + que toma un evento, que tiene que tener el constructor + Button, y tiene un valor IO boolean. La + API lista los siguientes campos para + Button :

+
eventSent :: Bool
+eventClick :: Click
+eventTime :: TimeStamp
+eventModifier :: [Modifier]
+eventButton :: MouseButton
+eventXRoot, eventYRoot :: Double
+
+

El primero se usa para el retorno. Ocurre en todos los constructores + Event como Motion, Expose, Key, Crossing, Focus, Configure, Scroll, + WindowState and Proximity. (movimiento, exposición, llave, cruce, foco, configurar, + desplazamiento, estado de la ventana y proximidad). De los + Events puedes obtener todo tipo de información sobre lo que está haciendo el + usuario. Tienes un ejemplo sencillo en este trozo de código:

+
onButtonPress eb 
+                 (\x -> if (eventButton x) == LeftButton 
+                           then do widgetSetSensitivity eb False 
+                                   return (eventSent x)
+                           else return (eventSent x))
+
+

Aquí, el parámetro + eb es el widget sobre el que está el ratón, y la + función anónima es del tipo descrito arriba. Algo se hace + (mira el ejemplo inferior) si el botón izquierdo del ratón ha + sido pulsado y entonces, + eventSent devuelve el booleano apropiado. + si se pulsa cualquier otro botón del ratón, no pasa nada + y sólo se devuelve el booleano.

+

Ahora, algunos widwets no tienen ventanas asociadas, así + que están dibujados en sus ventanas padre. Por eso no pueden recibir eventos + y si su tamaño está puesto incorrectamente, no se superponen con lo + que puedes organizar un lío de sobreescritura (no seguiremos discutiendo este aspecto). Un + EventBox proporciona una ventana X window para su widget hijo. + Es una subclase de Bin que también tiene su propia ventana y que es una subclase de + ContainerClass .

+

Para crear un nuevo widget EventBox widget, usa:

+
eventBoxNew :: IO EventBox
+
+

Para añadir un hijo simplemente tenemos que usar el bien conocido:

+
containerAdd :: (ContainerClass self, WidgetClass widget) => self -> widget -> IO ()
+
+

La ventana puede ser visible o invisible, y la caja de eventos puede estar + por encima o por debajo de su hijo en el árbol del widget. + Esto se determina por:

+
eventBoxVisibleWindow :: Attr EventBox Bool    -- default True
+eventBoxAboveChild :: Attr EventBox Bool       -- default False
+
+

Si simplemente quieres capturar los eventos, entonces establece la + ventana como invisible. Si el + eventBox está sobre su hijo, todos los eventos irán en primer lugar allí primero. + Si está debajo, las ventanas en los widgets hijos del hijo serán + alcanzados primero.

+

Una caja Button es simplemente una caja que puede ser usada para empaquetar botones + de un modo estándar. Hay dos tipos, horizontales and verticales, y puedes + construirlos con:

+
hbuttonBoxNew :: IO HButtonBox
+vButtonBoxNew :: IO VButtonBox
+
+

La funcionalidad está en el + ButtonBoxClass.

+
buttonBoxSetLayout :: ButtonBoxClass self => self -> ButtonBoxStyle -> IO ()
+
+

El estilo es uno de los siguientes: + ButtonBoxDefaultStyle, ButtonBoxSpread, ButtonBoxEdge, + ButtonBoxStart, ButtonBoxEnd . No se empaquetan los buttons como + en las cajas normales verticales y horizontales, sino que debes usar la + función containerAdd.

+

La segunda característica de las cajas button boxes es que puedes definir + que uno o más de los botones estén en un grupo secundario. Estos serán + tratados de modo diferente cuando se modifique el tamaño de la caja button. + Por ejemplo, un botón de ayuda puede mantenerse visualmente separado de los otros. La función es:

+
buttonBoxSetChildSecondary :: (ButtonBoxClass self, WidgetClass child)
+=> self -> child -> Bool -> IO ()
+
+

Esto ilustra el uso de cajas de eventos y cajas de botón:

+

+ Slot Machine +

+

Los botones se empaquetan en una caja de botones verticales, con el botón play + como un hijo secundario. Además es un botón mnemónico, + con Alt-P como tecla aceleradora. Las imágenes se colocan en cajas de eventos con ventanas + visibles, y su color de fondo se establece en un color verde con:

+
widgetModifyBg eb StateNormal (Color 0 35000 0)
+

Como se mencionó en el capítulo 5.3 el + StateType puede ser + StateNormal, StateActive, StatePrelight, StateSelected or + StateInsensitive (normal, activo, preiluminado, seleccionado o insensible) .

+

Fíjate en que las imágenes de abajo no tienen todas el mismo tamaño. + No tiene especial importancia, pero debemos tener cuidado de asegurarnos de + que la ventana principal sea suficientemente grande. De otro modo los + bordes desaparecerán cuando se cambien las imágenes.

+

Cuando el usuario pulsa el botón izquierdo del ratón cuando el ratón + está sobre una caja de eventos, se puede colocar en el estado insensible con:

+
widgetSetSensitivity :: WidgetClass self => self -> Bool -> IO ()
+
+

Esto cambia el StateType a + StateInsensitive y el widget no responderá más a los + eventos del usuario. Ademas su apariencia cambia. + En el ejemplo hemos cambiado también el color de fondo a + un gris.

+

+ Slot Machine Insensitive +

+

Hemos usado tooltips para indicar al usuario que las imágenes pueden ser congeladas. + Como se mencionó en el Capítulo 4.4 no siempre funcionan con el intérprete pero si lo + hacen con el compilador. Para cambiar las imágenes aleatoriamente, usamos la función + RandomRIO, como en el capítulo anterior. Te puede sorprender el porque hemos usado una tupla de + EventBox y + Image, en vez de simplemente usar la + Image del atributo + containerChild de las cajas de evento. Esto se debe a que es + un atributo de sólo escritura, puede + set (establecerse) pero no recuperarse con + get .

+

Finalmente, si no puedes disponer de las imágenes en tu directorio de código fuente, + o si quieres extender la máquina con más posibilidades, tienes un gran surtido de peces + brasileños en + + peces. Están clasificados en peces de agua salada (água + salgado) y de agua dulce (água doce).

+
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/es-chap6-3.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap6-3.xhtml 1 - + + + + + + Tutorial de Gtk2Hs: El contenedor Layout (distribución) + + + +

6.3 El contenedor Layout (distribución)

+

Hasta ahora el empaquetado de widgets se ha realizado por secuenciado + en cajas verticales u horizontales, o en una tabla. Puedes, sin embargo, colocar + los widgets en la posición que desees usando un widget + Fixed (Fijo) o un + Layout (algo así como plano de distribución). No se + recomienda usar un contenedor Fixed, ya que no se adapta bien + a los cambios de tamaño de la ventana.

+

El contenedor Layout es parecido al contenedor Fijo, pero se diferencia en + que implementa un área de desplazamiento infinita (cuando infinito es menor que 2^32). + El sistema X window (sobre el que está basado Gtk+) tiene una limitación de anchura o + altura, y no pueden superar los 32767 pixels. El contenedor Layout puede esquivar + este problema haciendo cosas exóticas, lo que permite tener suaves deplazamientos + incluso cuando tienes muchos widgets hijos en el área de desplazamiento. De este modo + las desventajas del widget Fixed se esquivan.

+

Para crear un contenedor Layout usamos:

+
layoutNew :: Maybe Adjustment -> Maybe Adjustment -> IO Layout
+
+

Como puedes ver, puedes optar por especificar los objetos Adjustment + que el widget Layout usará para su desplazamiento.

+

Puedes añadir y mover widgets en el contenedor Layout container usando las + dos funciones siguientes:

+
layoutPut :: (LayoutClass self, WidgetClass childWidget)
+=> self -> childWidget -> Int -> Int -> IO ()
+layoutMove :: (LayoutClass self, WidgetClass childWidget)
+=> self -> childWidget -> Int -> Int -> IO ()   
+
+

El primer argumento es la posición x, el segundo la posición y. La posición + superior izquierda es (0,0), x crece de izquierda a derecha e y de arriba abajo. +

+

Se puede fijar el tamaño del contenedor + Layout usando la siguiente función:

+
layoutSetSize :: LayoutClass self => self  -> Int -> Int -> IO ()
+
+

El primer argumento es la anchura de toda el área desplazable, el segundo su altura.

+

En el ejemplo hemos puesto una lista de etiquetas, cada una con una letra + mayúscula del alfabeto, en un círculo. La etiquetas se posicionan perpendicularmente + al radio, usando la función :

+
labelSetAngle :: labelClass self => self -> Double -> IO ()
+
+

El ángulo se mide en grados, medidos en contra de las agujas del reloj.

+ Alphabet +

El widget layout se posiciona en una ventana desplazable con containerAdd + ya que en sí es desplazable, y además no necesita un viewport, como vimos en + el capítulo 6.1. Las etiquetas se posicionan usando coordenadas angulares, + que son transformadas en coordenadas cartesianas con las funciones de Prelude + sin (seno) y + cos (coseno). Estas toman el argumento en radianes + (entre 0 y (2 * pi)). En el ejemplo, la anchura y la altura están + parametrizadas, como lo está la lista a mostrar. + Además, en + main las esquinas del + Layout se marcan, por lo que es sencillo experimentar con su tamaño, + si quieres. Fíjate en que el marcador ha sido reemplazado por un '+' debido a + las quejas del validador.

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main = do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Alphabet" , windowDefaultWidth := 350,
+             windowDefaultHeight := 350 , containerBorderWidth := 10]
+     sw <- scrolledWindowNew Nothing Nothing
+     set sw [scrolledWindowPlacement := CornerBottomRight, 
+             scrolledWindowShadowType := ShadowEtchedIn,
+             scrolledWindowHscrollbarPolicy := PolicyAutomatic,
+             scrolledWindowVscrollbarPolicy := PolicyAutomatic ]
+     containerAdd window sw
+
+     layt <- layoutNew Nothing Nothing
+     layoutSetSize layt myLayoutWidth myLayoutHeight
+     widgetModifyBg layt StateNormal (Color 65535 65535 65535)
+     containerAdd sw layt     
+ 
+     upleft  <- labelNew (Just "+(0,0)")
+     layoutPut layt upleft 0 0
+     upright <- labelNew (Just ("+(" ++ (show (myLayoutWidth - 50)) ++",0)"))
+     layoutPut layt upright (myLayoutWidth -50)  0
+     dwnright <- labelNew (Just ("+(0," ++ (show (myLayoutHeight -20)) ++ ")"))
+     layoutPut layt dwnright 0 (myLayoutHeight -20)
+     dwnleft <- labelNew (Just ("+(" ++ (show(myLayoutWidth -70)) ++ "," ++
+                                  (show (myLayoutHeight -20)) ++ ")"))
+     layoutPut layt dwnleft (myLayoutWidth -70) (myLayoutHeight - 20)
+     
+     labels <- sequence $ map (labelNew . Just) txtls
+     sequence_ $ map (\x -> widgetModifyFg x StateNormal (Color 0 0 45000)) labels
+     
+     let wnums = zip labels [0..]
+     sequence_ $ map (myLayoutPut layt) wnums     
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+
+-- parameters
+myLayoutWidth :: Int
+myLayoutWidth = 800
+
+myLayoutHeight :: Int
+myLayoutHeight = 800
+
+txtls :: [String]
+txtls = map (\x -> x:[]) ['A'..'Z']
+-- end parameters
+
+step :: Double
+step = (2 * pi)/(fromIntegral (length txtls))
+
+ox :: Int
+ox =  myLayoutWidth `div` 2
+
+oy :: Int
+oy = myLayoutHeight `div` 2
+
+radius :: Double
+radius = 0.25 * (fromIntegral ox)
+
+angle :: Int -> Double
+angle num = 1.5 * pi + (fromIntegral num) * step
+
+num2x :: Int -> Int
+num2x n = ox + relx where 
+              relx = round $ radius * (cos (angle n))
+
+num2y :: Int -> Int
+num2y n = oy + rely where
+              rely = round $ radius * (sin (angle n))
+
+myLayoutPut :: Layout -> (Label, Int) -> IO ()
+myLayoutPut lt (lb, n) = do 
+         layoutPut lt lb (num2x n) (num2y n) 
+         labelSetAngle lb (letterAngle n)
+
+letterAngle :: Int -> Double
+letterAngle n = (270 - degree) where
+                    degree = (angle n) * (180.0 /pi)
+
+ + + + addfile ./docs/tutorial/Tutorial_Port/es-chap6-4.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap6-4.xhtml 1 - + + + + + + Tutorial de Gtk2Hs: Ventanas panelables y marcos de ratio fijo + + + +

6.4 Ventanas panelables y marcos de ratio fijo

+

El widged de ventana panelable (paned window) resulta muy útil cuando + quieres dividir un área en dos partes, y que el usuario pueda determinar el + tamaño relativo de ambas. Se dibuja una línea entre ambas partes, con una flecha + doble que el usuario puede arrastrar para cambiar el tamaño de ambas porciones + (lo que se agranda una se empequeñece la otra). La división puede ser horizontal + HPaned, o vertical, + VPaned.

+

Para crear una ventana panelable puedes usar:

+
hPanedNew :: IO HPanel
+vPanedNew :: IO VPaned 
+
+

La posición del divisor se establece con:

+
panedSetPosition :: PanedClass self => self -> Int -> IO ()
+
+

Tras crear la ventana panelable, necesitas añadir widgets hijos a las + dos mitades.

+
panedAdd1 :: (PanedClass self, WidgetClass child) => self -> child -> IO ()
+panedAdd2 :: (PanedClass self, WidgetClass child) => self -> child -> IO ()
+
+

El primero se situa en la parte superior (derecha) , el segundo lo hace en la parte inferior (izquierda) + de la ventana panelable. Si no quieres que algún hijo no se expanda o reduzca con el widget + panelable debes usar + panedPack1 y + panedPack2.

+

Un marco de ratio fijo (Aspect Frame) es un marco para el que puedes definir una relación + constante entre la altura y la anchura. Este no cambiará al cambiar el tamaño del marco. + Para crear uno puedes usar:

+
aspectFrameNew :: Float -> Float -> Maybe Float -> IO AspectFrame
+
+

El primer parámetro establece el alineamiento horizontal del hijo dentro del marco (entre 0.0 y 1.0). + El segundo hace lo mismo con el alineamiento vertical. Opcionalmente, puedes establecer la + proporción deseada con el tercer parámetro. Como un widget + AspectFrame es un widget de tipo Frame , puedes añadirle una + etiqueta.

+

En el ejemplo siguiente hemos creado un panel vertical de ratio fijo con un marco de + ratio fijo en la mitad superior.

+ Paned Window +

Hemos creado un widget DrawingArea (área de dibujo) en el + AspectFrame. Un widget + DrawingArea es un widget vacío, que puede usarse para dibujar en él, aunque + aquí sólo le hemos puesto un color de fondo para demostrar el uso del + AspectFrame. En la mitad inferior del widget + VPaned hemos creado un widget + TextView . Este es un visor y editor de texto multilínea con muchas + y poderosas características. Aquí, sin embargo, simplemente hemos tomado el + buffer de texto asociado y hemos contado los caracteres cada vez + que el usuario edita algún texto.

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main = do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Paned Window", containerBorderWidth := 10,
+                 windowDefaultWidth := 400, windowDefaultHeight := 400 ]
+
+     pw <- vPanedNew
+     panedSetPosition pw 250
+     containerAdd window pw
+     af <- aspectFrameNew 0.5 0.5 (Just 3.0)
+     frameSetLabel af "Aspect Ratio: 3.0"
+     frameSetLabelAlign af 1.0 0.0
+     panedAdd1 pw af
+
+     da <- drawingAreaNew
+     containerAdd af da
+     widgetModifyBg da StateNormal (Color 65535 0 0)
+   
+     tv <- textViewNew
+     panedAdd2 pw tv
+     buf <- textViewGetBuffer tv
+
+     onBufferChanged buf $ do cn <- textBufferGetCharCount buf
+                              putStrLn (show cn)   
+
+     widgetShowAll window 
+     onDestroy window mainQuit
+     mainGUI
+
+ + + addfile ./docs/tutorial/Tutorial_Port/es-chap7-1.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap7-1.xhtml 1 - + + + + + + Tutorial de Gtk2Hs: Menús y Toolbars (barras de herramientas) + + + +

7.1 Menús y Toolbars (barras de herramientas)

+

Hay APIs específicos para menús y toolbars, pero normalmente trabajarás + conjuntamente con ambos usando el + UIManager para definir acciones que posteriormente situarás en + menús y barras de herramientas. Cada acción se puede asociar con varios + 'proxy widgets'. De este modo puedes gestionar la activación de la acción en vez + de establecer una respuesta independiente a la acción de menú y al elemento del + toolbar. Además puedes habilitar o deshabilitar ambos items + con la acción.

+
actionNew ::
+   String              --  nombre : nombre único para la acción
+-> String              --  etiqueta : lo que será mostrado en los elementos del menú y en los botones
+-> Maybe String        --  tooltip : un tooltip para la acción
+-> Maybe String        --  stockId : el stock item que se mostrará
+-> IO Action
+
+

Como puedes ver, una acción puede ser cualquier cosa. Cuando + el usuario activa una acción, ya sea pulsando en el widget asociado + o a través de una tecla de aceleración (lo vemos más adelante), se emite una + señal. Se especifica lo que debe suceder con:

+
onActionActivate :: ActionClass self => self -> IO () -> IO (ConnectId self)
+
+

Una + Action tiene métodos y atributos. Por ejemplo, puedes + ocultar una acción o hacerla insensible con:

+
actionSetVisible :: ActionClass self => self -> Bool -> IO ()
+actionSetSensitive :: ActionClass self => self -> Bool -> IO ()
+
+

Sin embargo, las acciones de agrupan juntas, y una acción sólo puede ser + visible (o sensible) si su grupo es visible (o sensible). + Los grupos de acciones se crean con:

+
actionGroupNew :: String -> IO ActionGroup
+
+

El argumento es el nombre del + ActionGroup y se usa cuando se asocian los key + bindings con las acciones. Para añadir acciones a un grupo, cuando no se usan teclas de + aceleración ni stocks items, usamos:

+
actionGroupAddAction ActionClass action => ActionGroup -> action -> IO ()
+
+

Si se usa una tecla de aceleración, o un stock item:

+
actionGroupAddActionWithAccel :: 
+   ActionClass action => ActionGroup -> action -> Maybe String -> IO ()
+
+

Si usas un stock item, el argumento + Maybe String debe ser + Nothing. Si no usas stock item, pero no especificas un acelerador, usa + Just "". En cualquier otro caso la cadena debe estar en un + formato que pueda ser analizado (lo veremos más adelante). Puedes establecer la visibilidad + y sensibilidad de un + ActionGroup con:

+
actionGroupSetVisible :: ActionGroup -> Bool -> IO ()
+actionGroupSetSensitive :: ActionGroup -> Bool -> IO ()
+
+

Como se ha dicho, una acción en un grupo sólo será visible + (sensible) si lo es ella y el grupo al que pertenece.

+

Ahora puedes usar las acciones si las fijas (binding) a + uno o más widgets proxy, por ejemplo en un menú y en un toolbar. + Por supuesto que puedes asociarla a un único elemento, pero la idea tras + el diseño de acciones es la reusabilidad. Puedes hacer esto mediante + un String en formato XML.

+

Los elementos XML disponibles son los siguientes: ui, menubar, menu, menuitem, + toolbar, toolitem y popup. Los elementos menuitem y toolitem requieren un + atributo de acción, y este se establece en el nombre único que recibió + la acción cuando fue creada. Los elementos menubar y toolbar también + pueden tener acciones asociadas con ellos, pero son opcionales. + Todos los elementos pueden tener nombres, y esos son también opcionales. + Necesitamos los nombres para distinguir los widgets del mismo tipo y con la + misma dirección, por ejemplo dos barras de herramientas justo por debajo + de root (raíz) (dentro de los elementos ui (interfaz de usuario)).

+

Además dispones de elementos separadores, colocadores y aceleradores. + Los separadores son líneas en las barras de herramientas y en las barras de menús. + Los colocadores se utilizan para agrupar elementos y sub árboles y los + aceleradores definen las teclas de aceleración. La referencia de GTK+ advierte + que no deben confundirse los aceleradores con los mnemónicos. Los mnemónicos se + activan a través de una letra en la etiqueta, mientras que los aceleradores se activan a + través de una combinación de teclas que tú especificas.

+

Nota: Desafortunadamente los aceleradores + para los menús y toolbars no me han funcionado como se anuncia. Quizá esto sea debido a + GTK+, Gtk2Hs, la plataforma, o quizá debido a que no he entendido algo. + En cualquier caso intentalo a ver si tienes más suerte.

+

La sección Graphics.UI.Gtk.ActionMenuToolbar.UIManager en la documentación de la API + contiene un DTD (Document Type Definition - Definición de tipo de documento) + para la cadena XML, así como alguna información adicional sobre su formato.

+

Aquí tienes un ejemplo de la cadena XML, que hemos usado en el ejemplo inferior. + Las barras al principio y final de cada línea se necesitan para que GHCi y GHC sepan + que la línea continúa y que debe entender las " como parte de la cadena y no como + delimitadores de la misma. + La indentación no tiene un especial significado aquí.

+
 uiDecl = "<ui>\
+\           <menubar>\
+\            <menu action=\"FMA\">\
+\              <menuitem action=\"NEWA\" />\
+\              <menuitem action=\"OPNA\" />\
+\              <menuitem action=\"SAVA\" />\
+\              <menuitem action=\"SVAA\" />\
+\              <separator />\
+\              <menuitem action=\"EXIA\" />\
+\            </menu>\
+\           <menu action=\"EMA\">\
+\              <menuitem action=\"CUTA\" />\
+\              <menuitem action=\"COPA\" />\
+\              <menuitem action=\"PSTA\" />\
+\           </menu>\
+\            <separator />\
+\            <menu action=\"HMA\">\
+\              <menuitem action=\"HLPA\" />\
+\            </menu>\
+\           </menubar>\
+\           <toolbar>\
+\            <toolitem action=\"NEWA\" />\
+\            <toolitem action=\"OPNA\" />\
+\            <toolitem action=\"SAVA\" />\
+\            <toolitem action=\"EXIA\" />\
+\            <separator />\
+\            <toolitem action=\"CUTA\" />\
+\            <toolitem action=\"COPA\" />\
+\            <toolitem action=\"PSTA\" />\
+\            <separator />\
+\            <toolitem action=\"HLPA\" />\
+\           </toolbar>\
+\          </ui>"
+
+

Todos los atributos de la acción son cadenas que hemos definido antes, + cuando hemos creado las acciones (puedes verlo en el listado completo del programa al + final del texto).

+

Ahora la definición debe ser procesada por un gestor de ui. + Para crear uno:

+
uiManagerNew :: IO UIManager
+
+

Para añadir la cadena XML:

+
uiManagerAddUiFromString :: UIManager -> String -> IO MergeId
+
+

Después, los grupos de acción, que ya han sido creados, deben ser insertados:

+
uiManagerInsertActionGroup :: UIManager -> ActionGroup -> Int -> IO ()
+
+

Si sólo tienes un grupo de acción, la posición será 0, + en cualquier otro caso tienes que especificar el índice en la lista que ya tienes. +

+

Ahora ya puedes conseguir todos los widgets que necesites de tu + UIManager y la dirección (path) (incluyendo nombres si + fuera necesario) en tu definición XML.

+
uiManagerGetWidget :: UIManager -> String -> IO (Maybe Widget)
+
+

De la definición anterior, por ejemplo, poedemos conseguir una barra de manú y una + barra de herramientas con:

+
maybeMenubar <- uiManagerGetWidget ui "/ui/menubar"
+     let menubar = case maybeMenubar of
+                        (Just x) -> x
+                        Nothing -> error "Cannot get menubar from string." 
+     boxPackStart box menubar PackNatural 0
+
+     maybeToolbar <- uiManagerGetWidget ui "/ui/toolbar"
+     let toolbar = case maybeToolbar of
+                        (Just x) -> x
+                        Nothing -> error "Cannot get toolbar from string." 
+     boxPackStart box toolbar PackNatural 0
+
+

El empaquetado ha sido incluído en el snippet anterior, para + demostrar que esto debes hacerlo tú. Este es el ejemplo con el código:

+

+ Menus and Toolbars +

+

Hemos colocado una acción como insensible, para mostrar como se hace. +También hemos añadido un acelerador a la acción de salir (exit), que emplea el +stockitem stockQuit pero ahora muestra el acelerador Ctrl + E. Según el +manual de referencia de GTK+, las teclas de aceleración se definen: +<Control>a, <Shift><Alt>F1, <Release>z, etcétera. Como ya he indicado, +las teclas de aceleración se muestran, pero en mi configuración no funcionan. fíjate que en +este ejemplo hemos usado mapM_ en vez de la combinación sequence_ y map +de los capítulos precedentes.

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main = do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Menus and Toolbars",
+                 windowDefaultWidth := 450, windowDefaultHeight := 200]
+
+     box <- vBoxNew False 0
+     containerAdd window box
+
+     fma <- actionNew "FMA" "File" Nothing Nothing
+     ema <- actionNew "EMA" "Edit" Nothing Nothing
+     hma <- actionNew "HMA" "Help" Nothing Nothing
+
+     newa <- actionNew "NEWA" "New"     (Just "Just a Stub") (Just stockNew)
+     opna <- actionNew "OPNA" "Open"    (Just "Just a Stub") (Just stockOpen)
+     sava <- actionNew "SAVA" "Save"    (Just "Just a Stub") (Just stockSave)
+     svaa <- actionNew "SVAA" "Save As" (Just "Just a Stub") (Just stockSaveAs)
+     exia <- actionNew "EXIA" "Exit"    (Just "Just a Stub") (Just stockQuit)
+ 
+     cuta <- actionNew "CUTA" "Cut"   (Just "Just a Stub") (Just stockCut)    
+     copa <- actionNew "COPA" "Copy"  (Just "Just a Stub") (Just stockCopy)
+     psta <- actionNew "PSTA" "Paste" (Just "Just a Stub") (Just stockPaste)
+
+     hlpa <- actionNew "HLPA" "Help"  (Just "Just a Stub") (Just stockHelp)
+
+     agr <- actionGroupNew "AGR"
+     mapM_ (actionGroupAddAction agr) [fma, ema, hma]
+     mapM_ (\ act -> actionGroupAddActionWithAccel agr act Nothing) 
+       [newa,opna,sava,svaa,cuta,copa,psta,hlpa]
+
+     actionGroupAddActionWithAccel agr exia (Just "<Control>e")
+
+     ui <- uiManagerNew
+     uiManagerAddUiFromString ui uiDecl
+     uiManagerInsertActionGroup ui agr 0
+
+     maybeMenubar <- uiManagerGetWidget ui "/ui/menubar"
+     let menubar = case maybeMenubar of
+                        (Just x) -> x
+                        Nothing -> error "Cannot get menubar from string." 
+     boxPackStart box menubar PackNatural 0
+
+     maybeToolbar <- uiManagerGetWidget ui "/ui/toolbar"
+     let toolbar = case maybeToolbar of
+                        (Just x) -> x
+                        Nothing -> error "Cannot get toolbar from string." 
+     boxPackStart box toolbar PackNatural 0
+
+     actionSetSensitive cuta False
+
+     onActionActivate exia (widgetDestroy window)
+     mapM_ prAct [fma,ema,hma,newa,opna,sava,svaa,cuta,copa,psta,hlpa]
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+     
+uiDecl=  "<ui>\
+\           <menubar>\
+\            <menu action=\"FMA\">\
+\              <menuitem action=\"NEWA\" />\
+\              <menuitem action=\"OPNA\" />\
+\              <menuitem action=\"SAVA\" />\
+\              <menuitem action=\"SVAA\" />\
+\              <separator />\
+\              <menuitem action=\"EXIA\" />\
+\            </menu>\
+\           <menu action=\"EMA\">\
+\              <menuitem action=\"CUTA\" />\
+\              <menuitem action=\"COPA\" />\
+\              <menuitem action=\"PSTA\" />\
+\           </menu>\
+\            <separator />\
+\            <menu action=\"HMA\">\
+\              <menuitem action=\"HLPA\" />\
+\            </menu>\
+\           </menubar>\
+\           <toolbar>\
+\            <toolitem action=\"NEWA\" />\
+\            <toolitem action=\"OPNA\" />\
+\            <toolitem action=\"SAVA\" />\
+\            <toolitem action=\"EXIA\" />\
+\            <separator />\
+\            <toolitem action=\"CUTA\" />\
+\            <toolitem action=\"COPA\" />\
+\            <toolitem action=\"PSTA\" />\
+\            <separator />\
+\            <toolitem action=\"HLPA\" />\
+\           </toolbar>\
+\          </ui>" </pre>"
+
+prAct :: ActionClass self => self -> IO (ConnectId self)
+prAct a = onActionActivate a $ do name <- actionGetName a
+                                  putStrLn ("Action Name: " ++ name)
+
+ + + addfile ./docs/tutorial/Tutorial_Port/es-chap7-2.xhtml hunk ./docs/tutorial/Tutorial_Port/es-chap7-2.xhtml 1 - + + + + + + + + + Tutorial de Gtk2Hs: Menús emergentes (Popup), acciones Radio y acciones Toggle + + + +

7.2 Menús emergentes (Popup), acciones Radio y acciones Toggle

+

Los Menús normalmente pertenecen a una ventana, pero pueden ser mostrados temporalmente + como resultado de la pulsación de un botón del ratón. Por ejemplo, puede mostrarse un menú + de contexto cuando el usuario pulsa el botón derecho de su ratón.

+

La disposición de un menú popup menu debe usar el nodo + popup. Por ejemplo:

+
uiDecl = "<ui> \
+\          <popup>\
+\            <menuitem action=\"EDA\" />\
+\            <menuitem action=\"PRA\" />\
+\            <menuitem action=\"RMA\" />\
+\            <separator />\
+\            <menuitem action=\"SAA\" />\
+\          </popup>\
+\        </ui>"   
+
+

La construcción de un menú popup lleva los mismos pasos que la + construcción de un menú o un toolbar.(pero... sigue leyendo). Una vez que has creado las acciones + y las has puesto en uno o más grupos, creas el gestor de UI, le + añades la cadena XML y le añades los grupos. Es el momento + de extraer el(los) widget(s). En nuestro ejemplo de popup hemos + creado 4 acciones con los nombres listados arriba. La ventana de popup + no se muestra en un volcado de pantalla por lo que hemos omitido la + imagen.

+

Como es un popup no hemos empaquetado el widget. Para mostralo, necesitamos + la función:

+
menuPopup :: MenuClass self => self -> Maybe (MouseButton,TimeStamp)
+
+

Todo esto está en la documentación de la API referente al módulo Graphics.UI.Gtk.MenuComboToolbar.Menu. + En el ejemplo, el menú aparece cuando pulsamos el botón derecho del ratón, + el segundo argumento puede ser + Nothing. La función es la misma que la que vimos en el + capítulo 6.2. Aquí, sin embargo, podemos usar la ventana en vez de + una caja de eventos.

+
onButtonPress window (\x -> if (eventButton x) == RightButton
+                                    then do menuPopup (castToMenu pop) Nothing
+                                            return (eventSent x)
+                                    else return (eventSent x))
+
+

El único truco es que el widget devuelto por el gestor de ui es de + tipo Widget y la función menuPopup necesita un argumento + de un tipo que sea una instancia de MenuClass. Así que tenemos que usar:

+
castToMenu :: GObjectClass obj => obj -> Menu
+
+

Esta función también está documentada en la sección Graphics.UI.Gtk.MenuComboToolbar.Menu. + El listado completo del ejemplo es:

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main= do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Click Right Popup",
+                 windowDefaultWidth := 250,
+                 windowDefaultHeight := 150 ]
+
+     eda <- actionNew "EDA" "Edit" Nothing Nothing
+     pra <- actionNew "PRA" "Process" Nothing Nothing
+     rma <- actionNew "RMA" "Remove" Nothing Nothing
+     saa <- actionNew "SAA" "Save" Nothing Nothing
+
+     agr <- actionGroupNew "AGR1" 
+     mapM_ (actionGroupAddAction agr) [eda,pra,rma,saa]
+
+     uiman <- uiManagerNew
+     uiManagerAddUiFromString uiman uiDecl
+     uiManagerInsertActionGroup uiman agr 0
+
+     maybePopup <- uiManagerGetWidget uiman "/ui/popup"
+     let pop = case maybePopup of 
+                    (Just x) -> x
+                    Nothing -> error "Cannot get popup from string"
+
+     onButtonPress window (\x -> if (eventButton x) == RightButton
+                                    then do menuPopup (castToMenu pop) Nothing
+                                            return (eventSent x)
+                                    else return (eventSent x))
+
+     mapM_ prAct [eda,pra,rma,saa]
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+
+uiDecl = "<ui> \
+\          <popup>\
+\            <menuitem action=\"EDA\" />\
+\            <menuitem action=\"PRA\" />\
+\            <menuitem action=\"RMA\" />\
+\            <separator />\
+\            <menuitem action=\"SAA\" />\
+\          </popup>\
+\        </ui>"   
+
+prAct :: ActionClass self => self -> IO (ConnectId self)
+prAct a = onActionActivate a $ do name <- actionGetName a
+                                  putStrLn ("Action Name: " ++ name)
+
+

Hay otro modo de usar las acciones, sin crearlas específicamente, a + partir del tipo de datos ActionEntry :

+
data ActionEntry = ActionEntry {
+actionEntryName :: String
+actionEntryLabel :: String
+actionEntryStockId :: (Maybe String)
+actionEntryAccelerator :: (Maybe String)
+actionEntryTooltip :: (Maybe String)
+actionEntryCallback :: (IO ())
+}
+
+

El uso de estos campos es como su nombre indica y como ha sido descrito más arriba + y en el capítulo 7.1. La función + actionEntryCallback debe ser aportada por el programador, y será ejecutada cuando + la acción a la que está asociada se active.

+

Añade una lista de entradas a un grupo de acción con:

+
actionGroupAddActions :: ActionGroup -> [ActionEntry] -> IO ()
+
+

Despés el grupo se inserta usando + uiManagerInsertActionGroup como antes.

+

Hay funciones similares para RadioAction y ToggleAction . + Las acciones Radio (Radio actions) permiten al usuario seleccionar entre varias posibilidades, + de las que sólo una puede estar activa. Debido a esto tiene sentido definirlas todas juntas. + La definición es:

+
data RadioActionEntry = RadioActionEntry {
+radioActionName :: String
+radioActionLabel :: String
+radioActionStockId :: (Maybe String)
+radioActionAccelerator :: (Maybe String)
+radioActionTooltip :: (Maybe String)
+radioActionValue :: Int
+}
+
+

Los primeros 5 campos de nuevo se usan como se podría esperar. El + radioActionValue (Valor de acción del radio) identifica cada una de las + posibles selecciones. La incorporación al grupo se realiza con:

+
actionGroupAddRadioActions :: 
+              ActionGroup -> [RadioActionEntry] -> Int -> (RadioAction -> IO ()) -> IO ()
+
+

El parámetro + Int es el valor de la acción para ser activada inicialmente, o -1 + si no va a ser ninguna.

+

+ Nota: En el siguiente ejemplo esto parece no tener efecto; la + última acción está siempre seleccionada inicialmente.

+

La función de tipo + (RadioAction -> IO ()) se ejecuta siempre que esa acción + se activa.

+

Las acciones Toggle tienen un valor + Bool y cada una puede establecerse o no. La + ToggleActionEntry se define como:

+
data ToggleActionEntry = ToggleActionEntry {
+toggleActionName :: String
+toggleActionLabel :: String
+toggleActionStockId :: (Maybe String)
+toggleActionAccelerator :: (Maybe String)
+toggleActionTooltip :: (Maybe String)
+toggleActionCallback :: (IO ())
+toggleActionIsActive :: Bool
+}
+
+

El ejemplo que tenemos a continuación demuestra el uso de acciones toggle + así como acciones radio.

+

+ Nota: La función + toggleActionCallback tiene el valor equivocado en + mi plataforma; el truco es, por supuesto, usar la función not.

+ RadioAction and ToggleAction +

Los botones radio pueden controlar un modo "resaltado", como en el editor de texto gedit, + del cual está copiado. El primer menú tiene un botón y dos submenús que + contienen los items restantes. Además, uno de los botones radio es un + elemento de un toolbar. Esta distribución está controlada completamente + por la primera definición XML.

+

Las acciones toggle son elementos de otro menú, y dos de estos están + también colocados en una barra de herramientas. Su distribución está + determinada por la segunda definición XML.

+

Lo interesante es que el + uiManager puede fusionar estas definiciones del ui, simplemente + añadiendolas, como se verá más adelante. Así que puedes definir tus menús en módulos separados + y combinarlos fácilmente más tarde en el módulo principal. De acuerdo a la documentación, + el gestor de ui (ui manager) es suficientemente inteligente en esto, y por supuesto + puedes usar nombres iguales en las definiciones XML que se diferencien en los caminos. + Pero recuerda que la + String que denota una acción, debe ser única para cada acción.

+

También es posible separar los menús y los toolbars, usando las funciones + MergeId y uiManagerRemoveUi. + De este modo puedes gestionar menús y toolbars dinámicamente.

+
import Graphics.UI.Gtk
+
+main :: IO ()
+main= do
+     initGUI
+     window <- windowNew
+     set window [windowTitle := "Radio and Toggle Actions",
+                 windowDefaultWidth := 400,
+                 windowDefaultHeight := 200 ]
+ 
+     mhma <- actionNew "MHMA" "Highlight\nMode" Nothing Nothing
+     msma <- actionNew "MSMA" "Source"          Nothing Nothing
+     mmma <- actionNew "MMMA" "Markup"          Nothing Nothing  
+
+     agr1 <- actionGroupNew "AGR1"
+     mapM_ (actionGroupAddAction agr1) [mhma,msma,mmma]
+     actionGroupAddRadioActions agr1 hlmods 0 myOnChange
+
+     vima <- actionNew "VIMA" "View" Nothing Nothing          
+
+     agr2 <- actionGroupNew "AGR2"
+     actionGroupAddAction agr2 vima
+     actionGroupAddToggleActions agr2 togls
+
+     uiman <- uiManagerNew
+     uiManagerAddUiFromString uiman uiDef1
+     uiManagerInsertActionGroup uiman agr1 0
+
+     uiManagerAddUiFromString uiman uiDef2
+     uiManagerInsertActionGroup uiman agr2 1
+
+     mayMenubar <- uiManagerGetWidget uiman "/ui/menubar"
+     let mb = case mayMenubar of 
+                    (Just x) -> x
+                    Nothing -> error "Cannot get menu bar."
+
+     mayToolbar <- uiManagerGetWidget uiman "/ui/toolbar"
+     let tb = case mayToolbar of 
+                    (Just x) -> x
+                    Nothing -> error "Cannot get tool bar."
+
+     box <- vBoxNew False 0
+     containerAdd window box
+     boxPackStart box mb PackNatural 0
+     boxPackStart box tb PackNatural 0
+
+     widgetShowAll window
+     onDestroy window mainQuit
+     mainGUI
+
+hlmods :: [RadioActionEntry]
+hlmods = [
+     RadioActionEntry "NOA" "None"    Nothing Nothing Nothing 0,   
+     RadioActionEntry "SHA" "Haskell" (Just stockHome)  Nothing Nothing 1, 
+     RadioActionEntry "SCA" "C"       Nothing Nothing Nothing 2,
+     RadioActionEntry "SJA" "Java"    Nothing Nothing Nothing 3,
+     RadioActionEntry "MHA" "HTML"    Nothing Nothing Nothing 4,
+     RadioActionEntry "MXA" "XML"     Nothing Nothing Nothing 5]
+
+myOnChange :: RadioAction -> IO ()
+myOnChange ra = do val <- radioActionGetCurrentValue ra
+                   putStrLn ("RadioAction " ++ (show val) ++ " now active.")
+
+uiDef1 = " <ui> \
+\           <menubar>\
+\              <menu action=\"MHMA\">\
+\                 <menuitem action=\"NOA\" />\
+\                 <separator />\
+\                 <menu action=\"MSMA\">\
+\                    <menuitem action= \"SHA\" /> \
+\                    <menuitem action= \"SCA\" /> \
+\                    <menuitem action= \"SJA\" /> \
+\                 </menu>\
+\                 <menu action=\"MMMA\">\
+\                    <menuitem action= \"MHA\" /> \
+\                    <menuitem action= \"MXA\" /> \
+\                 </menu>\
+\              </menu>\
+\           </menubar>\
+\            <toolbar>\
+\              <toolitem action=\"SHA\" />\
+\            </toolbar>\
+\           </ui> "            
+
+togls :: [ToggleActionEntry]
+togls = let mste = ToggleActionEntry "MST" "Messages" Nothing Nothing Nothing (myTog mste) False   
+            ttte = ToggleActionEntry "ATT" "Attributes" Nothing Nothing Nothing (myTog ttte)  False 
+            erte = ToggleActionEntry "ERT" "Errors" (Just stockInfo) Nothing Nothing (myTog erte)  True 
+        in [mste,ttte,erte]
+
+myTog :: ToggleActionEntry -> IO ()
+myTog te = putStrLn ("The state of " ++ (toggleActionName te) 
+                      ++ " (" ++ (toggleActionLabel te) ++ ") " 
+                      ++ " is now " ++ (show $ not (toggleActionIsActive te)))
+uiDef2 = "<ui>\
+\          <menubar>\
+\            <menu action=\"VIMA\">\
+\             <menuitem action=\"MST\" />\
+\             <menuitem action=\"ATT\" />\
+\             <menuitem action=\"ERT\" />\
+\            </menu>\
+\          </menubar>\
+\            <toolbar>\
+\              <toolitem action=\"MST\" />\
+\              <toolitem action=\"ERT\" />\
+\            </toolbar>\
+\         </ui>"
+
+ + + hunk ./docs/tutorial/Tutorial_Port/es-index.xhtml 45 - - - + hunk ./docs/tutorial/Tutorial_Port/es-index.xhtml 69 - - + hunk ./docs/tutorial/Tutorial_Port/es-index.xhtml 114 -

Copyright © 1998-2002 Tony Gale.

-

Copyright © 2007 Hans van Thiel and Alex Tarkovsky.

-

Copyright © 2007 Traducción española Laszlo Keuschnig

+

© 1998-2002 Tony Gale.

+

© 2007 Hans van Thiel and Alex Tarkovsky.

+

© 2007 Traducción española Laszlo Keuschnig