{-# LINE 1 "Graphics\\Win32\\Dialogue.hsc" #-}



{-# LINE 2 "Graphics\\Win32\\Dialogue.hsc" #-}

{-# LANGUAGE Safe #-}



{-# LINE 6 "Graphics\\Win32\\Dialogue.hsc" #-}

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

-- |

-- Module      :  Graphics.Win32.Dialogue

-- Copyright   :  (c) Alastair Reid, 1997-2003

-- License     :  BSD-style (see the file libraries/base/LICENSE)

--

-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>

-- Stability   :  provisional

-- Portability :  portable

--

-- A collection of FFI declarations for interfacing with Win32.

--

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



module Graphics.Win32.Dialogue where



import Graphics.Win32.GDI.Types

import Graphics.Win32.Control

import Graphics.Win32.Message

import Graphics.Win32.Window

import System.Win32.Types



import Foreign

import Foreign.C



#include "windows_cconv.h"







type DTemplate = LPCTSTR



type DTemplateMem = Ptr Stub_DTM

newtype Stub_DTM = Stub_DTM DTemplateMem



newtype DIA_TEMPLATE = DIA_TEMPLATE (Ptr DIA_TEMPLATE)



type DialogStyle = WindowStyle



mkDialogTemplate :: String -> IO DTemplate

mkDialogTemplate = newTString



type ResourceID = Int



mkResource :: ResourceID -> IO (Ptr a)

mkResource res = return (castUINTPtrToPtr (fromIntegral res))



mkDialogTemplateFromResource :: Int -> IO DTemplate

mkDialogTemplateFromResource = mkResource



type DialogProc = HWND -> WindowMessage -> WPARAM -> LPARAM -> IO Int



marshall_dialogProc_ :: DialogProc -> IO (FunPtr DialogProc)

marshall_dialogProc_ cl = mkDialogClosure cl



-- ToDo: this was declared as a stdcall not a ccall - let's

-- hope and pray that it makes no difference - ADR

foreign import ccall "wrapper"

  mkDialogClosure :: DialogProc -> IO (FunPtr DialogProc)



dialogBox :: HINSTANCE -> DTemplate -> Maybe HWND -> DialogProc -> IO Int

dialogBox inst template mb_parent dia_fn =

  dialogBoxParam inst template mb_parent dia_fn 0



dialogBoxParam :: HINSTANCE -> DTemplate -> Maybe HWND -> DialogProc -> LPARAM -> IO Int

dialogBoxParam inst template mb_parent dia_fn init_val = do

  c_dia_fn <- mkDialogClosure dia_fn

  failIf (== -1) "DialogBoxParam" $

    c_DialogBoxParam inst template (maybePtr mb_parent) c_dia_fn init_val

foreign import WINDOWS_CCONV "windows.h DialogBoxParamW"

  c_DialogBoxParam :: HINSTANCE -> DTemplate -> HWND -> FunPtr DialogProc -> LPARAM -> IO Int



dialogBoxIndirect :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> IO Int

dialogBoxIndirect inst template mb_parent dia_fn =

  dialogBoxIndirectParam inst template mb_parent dia_fn 0



dialogBoxIndirectParam :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> LPARAM -> IO Int

dialogBoxIndirectParam inst template mb_parent dia_fn init_val = do

  c_dia_fn <- mkDialogClosure dia_fn

  failIf (== -1) "DialogBoxIndirectParam" $

    c_DialogBoxIndirectParam inst template (maybePtr mb_parent) c_dia_fn init_val

foreign import WINDOWS_CCONV "windows.h DialogBoxIndirectParamW"

  c_DialogBoxIndirectParam :: HINSTANCE -> DTemplateMem -> HWND -> FunPtr DialogProc -> LPARAM -> IO Int





data DialogTemplate

 = DialogTemplate

      Int Int Int Int  -- x, y, cx, cy

      WindowStyle

      DWORD

      (Either ResourceID String)  -- menu

      (Either ResourceID String)  -- class

      (Either ResourceID String)  -- caption

      (Either ResourceID String)  -- fontname

      Int                         -- font height

      [DialogControl]



data DialogControl

 = DialogControl

      Int Int Int Int -- x,y, cx, cy

      (Either ResourceID String) -- text

      (Either ResourceID String) -- classname

      WindowStyle

      DWORD

      Int                        -- dia_id



mkDialogFromTemplate :: DialogTemplate -> IO DTemplateMem

mkDialogFromTemplate (DialogTemplate x y cx cy

                                     wstyle extstyle

                                     mb_menu mb_class caption

                                     font font_height

                                     controls) = do

  prim_hmenu    <- marshall_res mb_menu

  prim_class    <- marshall_res mb_class

  prim_caption  <- marshall_res caption

  prim_font     <- marshall_res font

  dtemp <- mkDiaTemplate 0 x y cx cy wstyle extstyle

                         prim_hmenu prim_class

                         prim_caption prim_font

                         font_height

  mapM_ (addControl dtemp) controls

  getFinalDialog dtemp



pushButtonControl :: Int -> Int -> Int -> Int

                  -> DWORD -> DWORD -> Int

                  -> String

                  -> DialogControl

pushButtonControl x y cx cy style estyle dia_id lab =

  DialogControl x y cx cy (Left 0x0080) (Right lab)

                (style + bS_DEFPUSHBUTTON) estyle dia_id



labelControl :: Int -> Int -> Int -> Int

             -> DWORD -> DWORD -> Int

             -> String

             -> DialogControl

labelControl x y cx cy style estyle dia_id lab =

  DialogControl x y cx cy (Left 0x0082) (Right lab)

                (style + sS_LEFT) estyle dia_id



listBoxControl :: Int -> Int -> Int -> Int

               -> DWORD -> DWORD -> Int

               -> String

               -> DialogControl

listBoxControl x y cx cy style estyle dia_id lab =

  DialogControl x y cx cy (Left 0x0083) (Right lab)

                (style) estyle dia_id



comboBoxControl :: Int -> Int -> Int -> Int

               -> DWORD -> DWORD -> Int

               -> String

               -> DialogControl

comboBoxControl x y cx cy style estyle dia_id lab =

  DialogControl x y cx cy (Left 0x0085) (Right lab)

                (style) estyle dia_id



editControl :: Int -> Int -> Int -> Int

               -> DWORD -> DWORD -> Int

               -> String

               -> DialogControl

editControl x y cx cy style estyle dia_id lab =

  DialogControl x y cx cy (Left 0x0081) (Right lab)

                (style + eS_LEFT) estyle dia_id



scrollBarControl :: Int -> Int -> Int -> Int

               -> DWORD -> DWORD -> Int

               -> String

               -> DialogControl

scrollBarControl x y cx cy style estyle dia_id lab =

  DialogControl x y cx cy (Left 0x0084) (Right lab)

                (style) estyle dia_id



foreign import ccall unsafe "diatemp.h getFinalDialog"

  getFinalDialog :: Ptr DIA_TEMPLATE -> IO DTemplateMem



foreign import ccall unsafe "diatemp.h mkDiaTemplate"

  mkDiaTemplate :: Int -> Int -> Int -> Int -> Int -> WindowStyle -> DWORD ->

        LPCWSTR -> LPCWSTR -> LPCWSTR -> LPCWSTR -> Int -> IO (Ptr DIA_TEMPLATE)



addControl :: Ptr DIA_TEMPLATE -> DialogControl -> IO ()

addControl dtemp (DialogControl x y cx cy mb_text mb_class

                                style exstyle

                                dia_id) = do

   prim_text  <- marshall_res mb_text

   prim_class <- marshall_res mb_class

   _ <- addDiaControl dtemp prim_text dia_id prim_class style

                 x y cx cy exstyle

   return ()



foreign import ccall unsafe "diatemp.h addDiaControl"

  addDiaControl :: Ptr DIA_TEMPLATE -> LPCWSTR -> Int -> LPCWSTR -> DWORD ->

        Int -> Int -> Int -> Int -> DWORD -> IO (Ptr DIA_TEMPLATE)



{-# CFILES cbits/diatemp.c #-}



marshall_res :: Either ResourceID String -> IO LPCWSTR

marshall_res (Left r)  = mkResource r

marshall_res (Right s) = newCWString s



-- modeless dialogs



createDialog :: HINSTANCE -> DTemplate -> Maybe HWND -> DialogProc -> IO HWND

createDialog inst template mb_parent dia_fn =

  createDialogParam inst template mb_parent dia_fn 0



createDialogParam :: HINSTANCE -> DTemplate -> Maybe HWND -> DialogProc -> LPARAM -> IO HWND

createDialogParam inst template mb_parent dia_fn init_val = do

  c_dia_fn <- mkDialogClosure dia_fn

  failIfNull "CreateDialogParam" $

    c_CreateDialogParam inst template (maybePtr mb_parent) c_dia_fn init_val

foreign import WINDOWS_CCONV "windows.h CreateDialogParamW"

  c_CreateDialogParam :: HINSTANCE -> DTemplate -> HWND -> FunPtr DialogProc -> LPARAM -> IO HWND



createDialogIndirect :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> IO HWND

createDialogIndirect inst template mb_parent dia_fn =

  createDialogIndirectParam inst template mb_parent dia_fn 0



createDialogIndirectParam :: HINSTANCE -> DTemplateMem -> Maybe HWND -> DialogProc -> LPARAM -> IO HWND

createDialogIndirectParam inst template mb_parent dia_fn init_val = do

  c_dia_fn <- mkDialogClosure dia_fn

  failIfNull "CreateDialogIndirectParam" $

    c_CreateDialogIndirectParam inst template (maybePtr mb_parent) c_dia_fn init_val

foreign import WINDOWS_CCONV "windows.h CreateDialogIndirectParamW"

  c_CreateDialogIndirectParam :: HINSTANCE -> DTemplateMem -> HWND -> FunPtr DialogProc -> LPARAM -> IO HWND



foreign import WINDOWS_CCONV "windows.h DefDlgProcW"

  defDlgProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT



endDialog :: HWND -> Int -> IO ()

endDialog dlg res =

  failIfFalse_ "EndDialog" $ c_EndDialog dlg res

foreign import WINDOWS_CCONV "windows.h EndDialog"

  c_EndDialog :: HWND -> Int -> IO BOOL



foreign import WINDOWS_CCONV unsafe "windows.h GetDialogBaseUnits"

  getDialogBaseUnits :: IO LONG



getDlgCtrlID :: HWND -> IO Int

getDlgCtrlID ctl =

  failIfZero "GetDlgCtrlID" $ c_GetDlgCtrlID ctl

foreign import WINDOWS_CCONV unsafe "windows.h GetDlgCtrlID"

  c_GetDlgCtrlID :: HWND -> IO Int



getDlgItem :: HWND -> Int -> IO HWND

getDlgItem dlg item =

  failIfNull "GetDlgItem" $ c_GetDlgItem dlg item

foreign import WINDOWS_CCONV unsafe "windows.h GetDlgItem"

  c_GetDlgItem :: HWND -> Int -> IO HWND



getDlgItemInt :: HWND -> Int -> Bool -> IO Int

getDlgItemInt dlg item signed =

  alloca $ \ p_trans -> do

  res <- c_GetDlgItemInt dlg item p_trans signed

  failIfFalse_ "GetDlgItemInt" $ peek p_trans

  return (fromIntegral res)

foreign import WINDOWS_CCONV "windows.h GetDlgItemInt"

  c_GetDlgItemInt :: HWND -> Int -> Ptr Bool -> Bool -> IO UINT



getDlgItemText :: HWND -> Int -> Int -> IO String

getDlgItemText dlg item size =

  allocaArray size $ \ p_buf -> do

  _ <- failIfZero "GetDlgItemInt" $ c_GetDlgItemText dlg item p_buf size

  peekTString p_buf

foreign import WINDOWS_CCONV "windows.h GetDlgItemTextW"

  c_GetDlgItemText :: HWND -> Int -> LPTSTR -> Int -> IO Int



getNextDlgGroupItem :: HWND -> HWND -> BOOL -> IO HWND

getNextDlgGroupItem dlg ctl previous =

  failIfNull "GetNextDlgGroupItem" $ c_GetNextDlgGroupItem dlg ctl previous

foreign import WINDOWS_CCONV unsafe "windows.h GetNextDlgGroupItem"

  c_GetNextDlgGroupItem :: HWND -> HWND -> BOOL -> IO HWND



getNextDlgTabItem :: HWND -> HWND -> BOOL -> IO HWND

getNextDlgTabItem dlg ctl previous =

  failIfNull "GetNextDlgTabItem" $ c_GetNextDlgTabItem dlg ctl previous

foreign import WINDOWS_CCONV unsafe "windows.h GetNextDlgTabItem"

  c_GetNextDlgTabItem :: HWND -> HWND -> BOOL -> IO HWND



foreign import WINDOWS_CCONV "windows.h IsDialogMessageW"

  isDialogMessage :: HWND -> LPMSG -> IO BOOL



mapDialogRect :: HWND -> LPRECT -> IO ()

mapDialogRect dlg p_rect =

  failIfFalse_ "MapDialogRect" $ c_MapDialogRect dlg p_rect

foreign import WINDOWS_CCONV unsafe "windows.h MapDialogRect"

  c_MapDialogRect :: HWND -> LPRECT -> IO Bool



-- No MessageBox* funs in here just yet.



foreign import WINDOWS_CCONV "windows.h SendDlgItemMessageW"

  sendDlgItemMessage :: HWND -> Int -> WindowMessage -> WPARAM -> LPARAM -> IO LONG



setDlgItemInt :: HWND -> Int -> UINT -> BOOL -> IO ()

setDlgItemInt dlg item value signed =

  failIfFalse_ "SetDlgItemInt" $ c_SetDlgItemInt dlg item value signed

foreign import WINDOWS_CCONV "windows.h SetDlgItemInt"

  c_SetDlgItemInt :: HWND -> Int -> UINT -> BOOL -> IO Bool



setDlgItemText :: HWND -> Int -> String -> IO ()

setDlgItemText dlg item str =

  withTString str $ \ c_str ->

  failIfFalse_ "SetDlgItemText" $ c_SetDlgItemText dlg item c_str

foreign import WINDOWS_CCONV "windows.h SetDlgItemTextW"

  c_SetDlgItemText :: HWND -> Int -> LPCTSTR -> IO Bool



dS_3DLOOK             :: WindowStyle

dS_3DLOOK             =  4

dS_ABSALIGN           :: WindowStyle

dS_ABSALIGN           =  1

dS_CENTER             :: WindowStyle

dS_CENTER             =  2048

dS_CENTERMOUSE        :: WindowStyle

dS_CENTERMOUSE        =  4096

dS_CONTEXTHELP        :: WindowStyle

dS_CONTEXTHELP        =  8192

dS_CONTROL            :: WindowStyle

dS_CONTROL            =  1024

dS_FIXEDSYS           :: WindowStyle

dS_FIXEDSYS           =  8

dS_LOCALEDIT          :: WindowStyle

dS_LOCALEDIT          =  32

dS_MODALFRAME         :: WindowStyle

dS_MODALFRAME         =  128

dS_NOFAILCREATE       :: WindowStyle

dS_NOFAILCREATE       =  16

dS_NOIDLEMSG          :: WindowStyle

dS_NOIDLEMSG          =  256

dS_SETFONT            :: WindowStyle

dS_SETFONT            =  64

dS_SETFOREGROUND      :: WindowStyle

dS_SETFOREGROUND      =  512

dS_SYSMODAL           :: WindowStyle

dS_SYSMODAL           =  2



{-# LINE 325 "Graphics\\Win32\\Dialogue.hsc" #-}



dM_GETDEFID           :: WindowMessage

dM_GETDEFID           =  1024

dM_REPOSITION         :: WindowMessage

dM_REPOSITION         =  1026

dM_SETDEFID           :: WindowMessage

dM_SETDEFID           =  1025

wM_CTLCOLORDLG        :: WindowMessage

wM_CTLCOLORDLG        =  310

wM_CTLCOLORMSGBOX     :: WindowMessage

wM_CTLCOLORMSGBOX     =  306



{-# LINE 333 "Graphics\\Win32\\Dialogue.hsc" #-}



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

-- End

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