HGL 3.2.0.5 → 3.2.2
raw patch · 4 files changed
+230/−226 lines, 4 files
Files
- Graphics/HGL/Internals/Draw.hs +5/−1
- Graphics/HGL/X11/Display.hs +55/−55
- Graphics/HGL/X11/Types.hs +102/−102
- HGL.cabal +68/−68
Graphics/HGL/Internals/Draw.hs view
@@ -31,7 +31,7 @@ import Graphics.HGL.Win32.Types(DC) #endif import qualified Graphics.HGL.Internals.Utilities as Utils (bracket, bracket_)-import Control.Monad (liftM)+import Control.Monad (liftM, ap) ---------------------------------------------------------------- -- Graphics@@ -42,6 +42,10 @@ -- | Monad for sequential construction of images. newtype Draw a = MkDraw (DC -> IO a)++instance Applicative Draw where+ pure = return+ (<*>) = ap unDraw :: Draw a -> (DC -> IO a) unDraw (MkDraw m) = m
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 (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 +-- #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,102 +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 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 +-----------------------------------------------------------------------------+-- |+-- 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.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 +name: HGL+version: 3.2.2+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