HGL 3.2.0.4 → 3.2.0.5
raw patch · 3 files changed
+225/−223 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- Graphics/HGL/X11/Display.hs +55/−55
- Graphics/HGL/X11/Types.hs +102/−100
- HGL.cabal +68/−68
Graphics/HGL/X11/Display.hs view
@@ -1,55 +1,55 @@--- #hide-module Graphics.HGL.X11.Display- ( getDisplayName- , openDisplay- , closeDisplay- , getDisplay- ) where--import Graphics.HGL.Internals.Utilities (modMVar)--import qualified Graphics.X11.Xlib as X--import Control.Concurrent.MVar (MVar, newMVar, readMVar, takeMVar, putMVar)-import Control.Monad (when)-import Data.Maybe (isJust)-import System.Environment (getEnv)-import System.IO.Error (try)-import System.IO.Unsafe (unsafePerformIO)--getDisplayName :: IO String-getDisplayName = do- disp <- try (getEnv "DISPLAY")- return (either (const ":0.0") id disp)--displayRef :: MVar (Maybe X.Display)-displayRef = unsafePerformIO (newMVar Nothing)--openDisplay :: String -> IO () -> IO X.Display-openDisplay host cleanup = do- mb_display <- readMVar displayRef- when (isJust mb_display) cleanup- openDisplay'- where- openDisplay' = do - display <- X.openDisplay host `catch` \ err -> - ioError (userError ("Unable to open X display " ++ host))- modMVar displayRef (const $ Just display)- return display--closeDisplay :: IO ()-closeDisplay = do- mb_display <- takeMVar displayRef- case mb_display of- Nothing -> do- putMVar displayRef Nothing- Just display -> do- X.closeDisplay display- putMVar displayRef Nothing--getDisplay :: IO X.Display-getDisplay = do- mb_display <- readMVar displayRef- case mb_display of- Nothing -> ioError $ userError "Display not opened yet"- Just display -> return display+-- #hide +module Graphics.HGL.X11.Display + ( getDisplayName + , openDisplay + , closeDisplay + , getDisplay + ) where + +import Graphics.HGL.Internals.Utilities (modMVar) + +import qualified Graphics.X11.Xlib as X + +import Control.Concurrent.MVar (MVar, newMVar, readMVar, takeMVar, putMVar) +import Control.Monad (when) +import Data.Maybe (isJust) +import System.Environment (getEnv) +import System.IO.Error (tryIOError,catchIOError) +import System.IO.Unsafe (unsafePerformIO) + +getDisplayName :: IO String +getDisplayName = do + disp <- tryIOError (getEnv "DISPLAY") + return (either (const ":0.0") id disp) + +displayRef :: MVar (Maybe X.Display) +displayRef = unsafePerformIO (newMVar Nothing) + +openDisplay :: String -> IO () -> IO X.Display +openDisplay host cleanup = do + mb_display <- readMVar displayRef + when (isJust mb_display) cleanup + openDisplay' + where + openDisplay' = do + display <- X.openDisplay host `catchIOError` \ err -> + ioError (userError ("Unable to open X display " ++ host)) + modMVar displayRef (const $ Just display) + return display + +closeDisplay :: IO () +closeDisplay = do + mb_display <- takeMVar displayRef + case mb_display of + Nothing -> do + putMVar displayRef Nothing + Just display -> do + X.closeDisplay display + putMVar displayRef Nothing + +getDisplay :: IO X.Display +getDisplay = do + mb_display <- readMVar displayRef + case mb_display of + Nothing -> ioError $ userError "Display not opened yet" + Just display -> return display
Graphics/HGL/X11/Types.hs view
@@ -1,100 +1,102 @@--------------------------------------------------------------------------------- |--- Module : Graphics.HGL.X11.Types--- Copyright : (c) Alastair Reid, 1999-2003--- License : BSD-style (see the file libraries/base/LICENSE)------ Maintainer : libraries@haskell.org--- Stability : internal--- Portability : non-portable (requires concurrency)------ Basic types for a simple graphics library.------------------------------------------------------------------------------------- #hide-module Graphics.HGL.X11.Types- ( DC(..)- , DC_Bits(..)- , Font(Font), Brush(Brush), Pen(Pen), defaultPen- , Key(MkKey)- , fromPoint, toPoint- , fromSize, toSize- , lookupColor- ) where--import Graphics.HGL.Internals.Types--import qualified Graphics.X11.Xlib as X--import Control.Concurrent.MVar (MVar)-import Data.Bits-import Data.Word (Word8)--------------------------------------------------------------------- Units-------------------------------------------------------------------fromPoint :: Point -> X.Point-toPoint :: X.Point -> Point-fromSize :: Size -> (X.Dimension, X.Dimension)-toSize :: (X.Dimension, X.Dimension) -> Size--fromPoint (x,y) = X.Point (fromIntegral x) (fromIntegral y)-toPoint (X.Point x y) = (fromIntegral x, fromIntegral y)-fromSize (x,y) = (fromIntegral x, fromIntegral y)-toSize (x,y) = (fromIntegral x, fromIntegral y)--------------------------------------------------------------------- Device Context (simulates Win32 Device Contexts)-------------------------------------------------------------------data DC = MkDC- { disp :: X.Display- , drawable :: X.Drawable- , textGC :: X.GC- , paintGC :: X.GC- , brushGC :: X.GC- , ref_rect :: MVar (X.Point,(X.Dimension, X.Dimension))- , ref_bits :: MVar DC_Bits- }--data DC_Bits = DC_Bits- { textColor :: RGB- , bkColor :: RGB- , bkMode :: BkMode- , textAlignment :: Alignment- , brush :: Brush- , pen :: Pen- , font :: Font- }--newtype Key = MkKey X.KeySym deriving Show--newtype Font = Font X.FontStruct-newtype Brush = Brush RGB--data Pen = Pen Style Int X.Pixel--defaultPen :: X.Pixel -> Pen-defaultPen col = Pen Solid 0 col--lookupColor :: X.Display -> RGB -> IO X.Pixel-lookupColor display col = (do- (X.Color p _ _ _ _) <-- X.allocColor display color_map (X.Color 0 r g b xcolor_flags)- return p)- `catch` \ err -> - print err >> return 0--- ioError (userError ("Error: " ++ show err--- ++ "\nUnable to allocate colo[u]r " ++ show (r,g,b) --- ++ " - I'll bet you're running Netscape."))- where- screen = X.defaultScreenOfDisplay display- color_map = X.defaultColormapOfScreen screen-- RGB r' g' b' = col- (r,g,b) = ((fromIntegral r') * 256, (fromIntegral g') * 256, (fromIntegral b')*256)--xcolor_flags :: Word8-xcolor_flags = X.doRed .|. X.doGreen .|. X.doBlue+----------------------------------------------------------------------------- +-- | +-- Module : Graphics.HGL.X11.Types +-- Copyright : (c) Alastair Reid, 1999-2003 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : internal +-- Portability : non-portable (requires concurrency) +-- +-- Basic types for a simple graphics library. +-- +----------------------------------------------------------------------------- + +-- #hide +module Graphics.HGL.X11.Types + ( DC(..) + , DC_Bits(..) + , Font(Font), Brush(Brush), Pen(Pen), defaultPen + , Key(MkKey) + , fromPoint, toPoint + , fromSize, toSize + , lookupColor + ) where + +import Graphics.HGL.Internals.Types + +import qualified Graphics.X11.Xlib as X + + +import System.IO.Error (catchIOError) +import Control.Concurrent.MVar (MVar) +import Data.Bits +import Data.Word (Word8) + +---------------------------------------------------------------- +-- Units +---------------------------------------------------------------- + +fromPoint :: Point -> X.Point +toPoint :: X.Point -> Point +fromSize :: Size -> (X.Dimension, X.Dimension) +toSize :: (X.Dimension, X.Dimension) -> Size + +fromPoint (x,y) = X.Point (fromIntegral x) (fromIntegral y) +toPoint (X.Point x y) = (fromIntegral x, fromIntegral y) +fromSize (x,y) = (fromIntegral x, fromIntegral y) +toSize (x,y) = (fromIntegral x, fromIntegral y) + +---------------------------------------------------------------- +-- Device Context (simulates Win32 Device Contexts) +---------------------------------------------------------------- + +data DC = MkDC + { disp :: X.Display + , drawable :: X.Drawable + , textGC :: X.GC + , paintGC :: X.GC + , brushGC :: X.GC + , ref_rect :: MVar (X.Point,(X.Dimension, X.Dimension)) + , ref_bits :: MVar DC_Bits + } + +data DC_Bits = DC_Bits + { textColor :: RGB + , bkColor :: RGB + , bkMode :: BkMode + , textAlignment :: Alignment + , brush :: Brush + , pen :: Pen + , font :: Font + } + +newtype Key = MkKey X.KeySym deriving Show + +newtype Font = Font X.FontStruct +newtype Brush = Brush RGB + +data Pen = Pen Style Int X.Pixel + +defaultPen :: X.Pixel -> Pen +defaultPen col = Pen Solid 0 col + +lookupColor :: X.Display -> RGB -> IO X.Pixel +lookupColor display col = (do + (X.Color p _ _ _ _) <- + X.allocColor display color_map (X.Color 0 r g b xcolor_flags) + return p) + `catchIOError` \ err -> + print err >> return 0 +-- ioError (userError ("Error: " ++ show err +-- ++ "\nUnable to allocate colo[u]r " ++ show (r,g,b) +-- ++ " - I'll bet you're running Netscape.")) + where + screen = X.defaultScreenOfDisplay display + color_map = X.defaultColormapOfScreen screen + + RGB r' g' b' = col + (r,g,b) = ((fromIntegral r') * 256, (fromIntegral g') * 256, (fromIntegral b')*256) + +xcolor_flags :: Word8 +xcolor_flags = X.doRed .|. X.doGreen .|. X.doBlue
HGL.cabal view
@@ -1,68 +1,68 @@-name: HGL-version: 3.2.0.4-license: BSD3-license-file: LICENSE-author: Alastair Reid-maintainer: Christoph Lueth <christoph.lueth@dfki.de>, Alan Hawkins <hawk.alan@gmail.com>-category: Graphics-synopsis: A simple graphics library based on X11 or Win32-description:- A simple graphics library, designed to give the programmer access- to most interesting parts of the Win32 Graphics Device Interface- and X11 library without exposing the programmer to the pain and- anguish usually associated with using these interfaces.- .- The library also includes a module Graphics.SOE providing the- interface used in "The Haskell School of Expression", by Paul- Hudak, cf <http://www.haskell.org/soe/>.-build-type: Simple-cabal-version: >= 1.2.1--flag split-base--library- if flag(split-base)- build-depends: base >= 3 && < 10, array- else- build-depends: base < 2- exposed-modules:- Graphics.HGL.Core,- Graphics.HGL.Draw,- Graphics.HGL.Units,- Graphics.HGL.Key,- Graphics.HGL.Run,- Graphics.HGL.Draw.Brush,- Graphics.HGL.Draw.Font,- Graphics.HGL.Draw.Monad,- Graphics.HGL.Draw.Pen,- Graphics.HGL.Draw.Picture,- Graphics.HGL.Draw.Region,- Graphics.HGL.Draw.Text,- Graphics.HGL.Utils,- Graphics.HGL.Window,- Graphics.HGL,- Graphics.SOE- other-modules:- Graphics.HGL.Internals.Event,- Graphics.HGL.Internals.Events,- Graphics.HGL.Internals.Draw,- Graphics.HGL.Internals.Types,- Graphics.HGL.Internals.Flag,- Graphics.HGL.Internals.Utilities- if os(windows)- build-depends: Win32- cpp-options: -DX_DISPLAY_MISSING- other-modules:- Graphics.HGL.Win32.Bitmap,- Graphics.HGL.Win32.Draw,- Graphics.HGL.Win32.Types,- Graphics.HGL.Win32.WND- else- build-depends: X11- other-modules:- Graphics.HGL.X11.Display,- Graphics.HGL.X11.DC,- Graphics.HGL.X11.Timer,- Graphics.HGL.X11.Types,- Graphics.HGL.X11.Window- extensions: CPP+name: HGL +version: 3.2.0.5 +license: BSD3 +license-file: LICENSE +author: Alastair Reid +maintainer: Christoph Lueth <christoph.lueth@dfki.de>, Alan Hawkins <hawk.alan@gmail.com> +category: Graphics +synopsis: A simple graphics library based on X11 or Win32 +description: + A simple graphics library, designed to give the programmer access + to most interesting parts of the Win32 Graphics Device Interface + and X11 library without exposing the programmer to the pain and + anguish usually associated with using these interfaces. + . + The library also includes a module Graphics.SOE providing the + interface used in "The Haskell School of Expression", by Paul + Hudak, cf <http://www.haskell.org/soe/>. +build-type: Simple +cabal-version: >= 1.2.1 + +flag split-base + +library + if flag(split-base) + build-depends: base >= 4.4.0.0 && < 5, array + else + build-depends: base < 2 + exposed-modules: + Graphics.HGL.Core, + Graphics.HGL.Draw, + Graphics.HGL.Units, + Graphics.HGL.Key, + Graphics.HGL.Run, + Graphics.HGL.Draw.Brush, + Graphics.HGL.Draw.Font, + Graphics.HGL.Draw.Monad, + Graphics.HGL.Draw.Pen, + Graphics.HGL.Draw.Picture, + Graphics.HGL.Draw.Region, + Graphics.HGL.Draw.Text, + Graphics.HGL.Utils, + Graphics.HGL.Window, + Graphics.HGL, + Graphics.SOE + other-modules: + Graphics.HGL.Internals.Event, + Graphics.HGL.Internals.Events, + Graphics.HGL.Internals.Draw, + Graphics.HGL.Internals.Types, + Graphics.HGL.Internals.Flag, + Graphics.HGL.Internals.Utilities + if os(windows) + build-depends: Win32 + cpp-options: -DX_DISPLAY_MISSING + other-modules: + Graphics.HGL.Win32.Bitmap, + Graphics.HGL.Win32.Draw, + Graphics.HGL.Win32.Types, + Graphics.HGL.Win32.WND + else + build-depends: X11 + other-modules: + Graphics.HGL.X11.Display, + Graphics.HGL.X11.DC, + Graphics.HGL.X11.Timer, + Graphics.HGL.X11.Types, + Graphics.HGL.X11.Window + extensions: CPP