mosaico-lib-0.1.1.0: src/Graphics/Mosaico/Ventana.hs
{-|
Module : Graphics.Mosaico.Ventana
Description : Ventanas interactivas con distribuciones de rectángulos
Copyright : ⓒ Manuel Gómez, 2015
License : BSD3
Maintainer : targen@gmail.com
Stability : experimental
Portability : portable
Representación orientada a objetos de una ventana interactiva donde se puede
mostrar un 'Diagrama' con una parte enfocada, y obtener eventos de teclas
pulsadas en la ventana.
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnicodeSyntax #-}
module Graphics.Mosaico.Ventana
( Ventana
, cerrar
, crearVentana
, leerTecla
, mostrar
)
where
import Control.Applicative (pure)
import Control.Concurrent (forkIO)
import Control.Concurrent.STM.TMChan (newTMChanIO, closeTMChan, readTMChan, writeTMChan)
import Control.Concurrent.STM.TVar (newTVarIO, readTVarIO, writeTVar)
import Control.Monad (void)
import Control.Monad.STM (atomically)
import Control.Monad.Unicode ((=≪))
import Control.Monad.IO.Class (liftIO)
import Data.Bool (Bool(True))
import Data.Colour.Names (blue, green, red, yellow)
import Data.Colour.SRGB (Colour, sRGB24)
import Data.Function (($), flip)
import Data.Function.Unicode ((∘))
import Data.Functor ((<$>))
import Data.List (reverse)
import Data.Maybe (Maybe(Nothing, Just))
import Data.Monoid (mappend, mempty)
import Data.String (String)
import Diagrams.Attributes (opacity)
import Diagrams.Backend.Cairo (Cairo)
import Diagrams.Backend.Gtk (renderToGtk, toGtkCoords)
import Diagrams.BoundingBox (boundingBox, boxExtents)
import Diagrams.Core.Types (Diagram)
import Diagrams.TwoD.Align (centerXY)
import Diagrams.TwoD.Attributes (fillColor, lineColor, lineWidth, ultraThick)
import Diagrams.TwoD.Combinators ((===), (|||))
import Diagrams.TwoD.Shapes (rect, unitSquare)
import Diagrams.TwoD.Size (SizeSpec2D(Dims), sized)
import Diagrams.TwoD.Transform (scaleX, scaleY)
import Diagrams.TwoD.Types (R2(R2))
import Diagrams.Util (( # ))
import Graphics.Mosaico.Imagen (Imagen(Imagen, altura, anchura), Color(Color, rojo, verde, azul))
import Graphics.Mosaico.Diagrama (Diagrama((:-:), (:|:), Hoja), Paso(Primero, Segundo), Rectángulo(Rectángulo, color, imagen))
import Graphics.UI.Gtk.Abstract.Container (containerChild)
import Graphics.UI.Gtk.Abstract.Widget (EventMask(KeyPressMask), Requisition(Requisition), exposeEvent, keyPressEvent, onDestroy, sizeRequest, widgetAddEvents, widgetDestroy, widgetQueueDraw, widgetShowAll)
import Graphics.UI.Gtk.Gdk.EventM (eventKeyName, eventWindow)
import Graphics.UI.Gtk.General.General (initGUI, mainGUI, mainQuit, postGUIAsync, postGUISync)
import Graphics.UI.Gtk.Misc.DrawingArea (drawingAreaNew)
import Graphics.UI.Gtk.Windows.Window (windowNew)
import Prelude (Double, Integer, fromInteger, fromIntegral)
import System.Glib.Attributes (AttrOp((:=)), set)
import System.Glib.Signals (on)
import System.Glib.UTFString (glibToString)
import System.IO (IO)
-- | Un valor del tipo 'Ventana' es un objeto que representa a una ventana
-- interactiva donde puede dibujarse un 'Diagrama'. Es posible, además,
-- obtener información de qué teclas son pulsadas sobre la ventana.
data Ventana
= Ventana
{ mostrar ∷ [Paso] → Diagrama → IO ()
-- ^ Dada una 'Ventana', un 'Diagrama', y una lista de 'Paso's,
-- representar gráficamente el 'Diagrama' dado sobre el lienzo de la
-- 'Ventana', haciendo resaltar visualmente el nodo del árbol alcanzado
-- si se realizan los movimientos correspondientes a la lista de
-- 'Paso's desde la raíz del árbol.
--
-- Los nodos se resaltan con un cuadro verde, y se colorean según el
-- tipo de nodo. En el caso de nodos intermedios, se colorea en azul
-- la región correspondiente al primer subárbol del nodo binario, y en
-- rojo la región correspondiente al segundo subárbol. En el caso de
-- nodos terminales (hojas), el rectángulo se colorea en amarillo.
, leerTecla ∷ IO (Maybe String)
-- ^ Dada una 'Ventana', esperar por un evento de teclado.
--
-- Cuando sobre la ventana se haya pulsado alguna tecla que no haya sido
-- reportada a través de este cómputo, se producirá como resultado
-- @'Just' tecla@, donde @tecla@ será el nombre de la tecla.
--
-- Si la ventana ya ha sido cerrada, se producirá como resultado
-- 'Nothing'.
--
-- El texto correspondiente a cada tecla es aproximadamente igual al
-- nombre del símbolo en la biblioteca GDK sin el prefijo @GDK_KEY_@.
-- La lista completa está disponible en
-- <https://git.gnome.org/browse/gtk+/plain/gdk/gdkkeysyms.h el código fuente de la biblioteca GDK>.
-- Sin embargo, la mejor manera de descubrir cuál simbolo corresponde
-- a cada tecla es crear una 'Ventana' y hacer que se imprima el texto
-- correspondiente a cada tecla pulsada sobre ella.
, cerrar ∷ IO ()
-- ^ Dada una 'Ventana', hacer que se cierre y que no pueda producir
-- más eventos de teclado.
}
-- | Construye un objeto del tipo 'Ventana' dadas sus dimensiones en número
-- de píxeles.
crearVentana
∷ Integer -- ^ Número de píxeles de anchura de la 'Ventana' a crear.
→ Integer -- ^ Número de píxeles de altura de la 'Ventana' a crear.
→ IO Ventana -- ^ La 'Ventana' nueva, ya visible, con el lienzo en blanco.
crearVentana anchura' altura'
= do
chan ← newTMChanIO
diagramaV ← newTVarIO mempty
void initGUI
window ← windowNew
drawingArea ← drawingAreaNew
set window [containerChild := drawingArea]
void
$ drawingArea `on` sizeRequest
$ pure (Requisition (fromInteger anchura') (fromInteger altura'))
void
$ window `on` keyPressEvent
$ do
key ← glibToString <$> eventKeyName
liftIO
∘ void
∘ atomically
$ writeTMChan chan key
pure True
void
$ drawingArea `on` exposeEvent
$ do
w ← eventWindow
liftIO
$ do
renderToGtk w
∘ toGtkCoords
∘ sized (Dims (fromIntegral anchura') (fromIntegral altura'))
=≪ readTVarIO diagramaV
pure True
void
$ onDestroy window
$ do
mainQuit
atomically $ closeTMChan chan
widgetAddEvents window [KeyPressMask]
widgetShowAll window
void $ forkIO mainGUI
let
ventana
= Ventana {..}
cerrar
= postGUISync
$ widgetDestroy window
leerTecla
= atomically
$ readTMChan chan
mostrar pasos diagrama
= postGUIAsync
$ do
atomically
∘ writeTVar diagramaV
$ renderDiagrama pasos diagrama
widgetQueueDraw drawingArea
pure ventana
renderDiagrama ∷ [Paso] → Diagrama → Diagram Cairo R2
renderDiagrama
= go ∘ pure
where
go pasos
= centerXY
∘ \ case
d1 :-: d2 → foco blue (go pasosPrimero d1) === foco red (go pasosSegundo d2)
d1 :|: d2 → foco blue (go pasosPrimero d1) ||| foco red (go pasosSegundo d2)
Hoja
Rectángulo { color = Color {..}, imagen = Imagen {..} }
→ foco yellow
$ unitSquare
# fillColor (sRGB24 rojo verde azul ∷ Colour Double)
# scaleX (fromInteger anchura)
# scaleY (fromInteger altura )
where
pasosPrimero
= case pasos of
Just (Primero:xs) → Just xs
_ → Nothing
pasosSegundo
= case pasos of
Just (Segundo:xs) → Just xs
_ → Nothing
foco color diagrama
= case pasos of
Just []
→ flip mappend (diagrama # centerXY)
∘ toRect
∘ boxExtents
$ boundingBox diagrama
_ → diagrama
where
toRect (R2 w h)
= rect w h
# fillColor (color ∷ Colour Double)
# lineColor (green ∷ Colour Double)
# lineWidth ultraThick
# opacity 0.25