module GraphicsDraw
	( DrawFun, drawGraphic, drawBufferedGraphic, drawBufferedGraphicBC
	, drawBufferedGraphic
	, saveGraphic
	, withBitmap
	, setDefaults
	, createCompatibleBitmap, withCompatibleBitmap, withCompatibleDC, withDC
	, createBitmapFile
	) where

import GraphicsTypes
import qualified GraphicsUtilities as Utils
import qualified Win32

type DrawFun = Win32.HWND -> Win32.HDC -> IO ()

drawGraphic            ::                    Draw () -> DrawFun
drawBufferedGraphic    ::                    Draw () -> DrawFun
drawBufferedGraphicBC  :: Win32.COLORREF  -> Draw () -> DrawFun
saveGraphic            :: String -> Point -> Draw () -> IO ()

createBitmapFile       :: Win32.HDC -> String -> Bitmap -> IO ()
createCompatibleDC     :: Win32.HDC -> IO Win32.HDC
deleteDC               :: Win32.HDC -> IO ()
createCompatibleBitmap :: Win32.HDC -> Win32.Int32 -> Win32.Int32 -> IO Bitmap
withCompatibleDC       :: Win32.HDC -> (Win32.HDC -> IO a) -> IO a
withBitmap             :: Win32.HDC -> Bitmap -> IO a -> IO a
withDC                 :: Maybe Win32.HWND -> (Win32.HDC -> IO a) -> IO a
withCompatibleBitmap   :: Win32.HDC -> Win32.Int32 -> Win32.Int32 -> (Bitmap -> IO a) -> IO a

----------------------------------------------------------------

drawGraphic p = \ hwnd hdc -> do
  (w,h) <- windowSize hwnd
  Win32.bitBlt hdc 0 0 w h hdc 0 0 backgroundColor
  setDefaults hdc
  unDraw p hdc

drawBufferedGraphic = drawBufferedGraphicBC backgroundColor

drawBufferedGraphicBC bgColor p = \ hwnd hdc -> do
  (w,h) <- windowSize hwnd
  withBuffer (Just hwnd) w h bgColor $ \ buffer _ -> do
    setDefaults buffer
    unDraw p buffer
    Win32.bitBlt hdc 0 0 w h buffer 0 0 Win32.sRCCOPY

saveGraphic fileName size p = 
  withBuffer Nothing w h backgroundColor $ \ buffer bmp -> do
    setDefaults buffer
    unDraw p buffer
    createBitmapFile buffer fileName bmp
 where
  (w,h) = fromPoint size

backgroundColor = Win32.bLACKNESS

setDefaults :: Win32.HDC -> IO ()
setDefaults hdc = do
  setDefaultPen   hdc
  setDefaultBrush hdc
  setDefaultText  hdc
  return ()

setDefaultPen :: Win32.HDC -> IO ()
setDefaultPen = \ hdc -> do
  whitePen <- Win32.getStockPen Win32.wHITE_PEN
  Win32.selectPen hdc whitePen
  return ()

setDefaultBrush :: Win32.HDC -> IO ()
setDefaultBrush = \ hdc -> do
  whiteBrush <- Win32.getStockBrush Win32.wHITE_BRUSH
  Win32.selectBrush hdc whiteBrush
  return ()

setDefaultText :: Win32.HDC -> IO ()
setDefaultText = \ hdc -> do
  Win32.setTextColor hdc white
-- We omit this because it should be redundant (since mode is transparent)
-- And because it causes some examples to crash.
-- Maybe you're not allowed to set a color if the mode is transparent?
--  Win32.setBkColor   hdc black
  Win32.setBkMode    hdc Win32.tRANSPARENT
  return ()

white :: Win32.COLORREF
white = Win32.rgb 255 255 255

black :: Win32.COLORREF
black = Win32.rgb 0 0 0

----------------------------------------------------------------
-- Note that we create a bitmap which is compatible with the hdc
-- onto which we are going to zap the Graphic.  It might seem that
-- it would be enough for it to be compatible with the buffer -
-- but, sadly, this isn't the case.  The problem is that the buffer
-- is initially 0 pixels wide, 0 pixels high and 1 bit deep
-- (ie it looks monochrome); it only becomes n-bits deep when you
-- select in a bitmap which is n-bits deep.
--
-- If it wasn't for that, we'd have swapped these two lines:
--
--   withCompatibleBitmap w h   $ \ bitmap ->
--   withCompatibleDC           $ \ hdc    ->
--
withBuffer :: Maybe Win32.HWND -> Win32.Int32 -> Win32.Int32 -> Win32.COLORREF -> (Win32.HDC -> Bitmap -> IO a) -> IO a

withBuffer mbhwnd w h bgColor p = 
  withDC mbhwnd                $ \ hdc    -> 
  withCompatibleBitmap hdc w h $ \ bitmap ->
  withCompatibleDC hdc         $ \ buffer ->
  withBitmap buffer bitmap     $ do
    Win32.bitBlt buffer 0 0 w h buffer 0 0 bgColor
    p buffer bitmap

----------------------------------------------------------------

-- Get the width and height of a window's client area, in pixels.
windowSize :: Win32.HWND -> IO (Win32.LONG,Win32.LONG)
windowSize hwnd =
 Win32.getClientRect hwnd >>= \ (l',t',r',b') ->
 return (r' - l', b' - t')

-- Note that this DC is only "1 bit" in size - you have to call
-- "createCompatibleBitmap" before it is big enough to hold the bitmap
-- you want.
createCompatibleDC hdc = Win32.createCompatibleDC (Just hdc)

deleteDC = Win32.deleteDC

createCompatibleBitmap hdc w h = do
  bmp <- Win32.createCompatibleBitmap hdc w h
  return (MkBitmap bmp)

withBitmap hdc bmp = Utils.bracket_ (selectBitmap hdc bmp) (selectBitmap hdc)

withDC mhwnd = Utils.bracket (Win32.getDC mhwnd) (Win32.releaseDC mhwnd)

-- Note that this DC is only "1 bit" in size - you have to call
-- "createCompatibleBitmap" before it is big enough to hold the bitmap
-- you want.
withCompatibleDC hdc = Utils.bracket (createCompatibleDC hdc) deleteDC

withCompatibleBitmap hdc w h =
  Utils.bracket (createCompatibleBitmap hdc w h) deleteBitmap

deleteBitmap (MkBitmap bmp) = Win32.deleteBitmap bmp

selectBitmap hdc (MkBitmap bmp) = do
  bmp' <- Win32.selectBitmap hdc bmp
  return (MkBitmap bmp)

createBitmapFile hdc fileName (MkBitmap bmp) = 
  Win32.createBMPFile fileName bmp hdc

----------------------------------------------------------------
-- End
----------------------------------------------------------------