;; w32api.scm
;; Some ad hoc imports for the WIN32 API.
;; Last edited 10 May 2005 by goetter for pscheme 1.2
;;

(define *userdll* 
  (cond-expand 
   (windows-nt "user32.dll")
   (windows-ce "coredll.dll")))
(define *gdidll* 
  (cond-expand 
   (windows-nt "gdi32.dll")
   (windows-ce "coredll.dll")))

(define MessageBox (w32:foreign-procedure *userdll* "MessageBoxW" 
   '(w32api dword handle lpcwstr lpcwstr dword)))

(define GetWindowTextLength (w32:foreign-procedure *userdll* "GetWindowTextLengthW" 
   '(w32api dword handle)))

(define GetWindowText (w32:foreign-procedure *userdll* "GetWindowTextW" 
   '(w32api dword handle lpwstr dword)))

(define EnumWindows (w32:foreign-procedure *userdll* "EnumWindows" 
   '(w32api bool (callback bool handle lparam-callback) lparam-callback)))

(define ShowWindow (w32:foreign-procedure *userdll* "ShowWindow" 
   '(w32api bool handle dword)))
(define SW_HIDE             0)
(define SW_SHOWNORMAL       1)
(define SW_SHOWNOACTIVATE   4)
(define SW_SHOW             5)
(define SW_MINIMIZE         6)
(define SW_SHOWNA           8)

;; N.b. CreateWindow is pre-loaded as w32:create-window
(define CW_USEDEFAULT       #x80000000)
(define HWND_DESKTOP        0)
(define WS_VISIBLE          #x10000000)
(define WS_DISABLED         #x08000000)
(define WS_GROUP            #x00020000)
(define WS_TABSTOP          #x00010000)
(define WS_CLIPSIBLINGS     #x04000000)
(define WS_CLIPCHILDREN     #x02000000)
(define WS_BORDER           #x00800000)
(define WS_DLGFRAME         #x00400000)
(define WS_VSCROLL          #x00200000)
(define WS_HSCROLL          #x00100000)
(define WS_SYSMENU          #x00080000)
(define WS_CAPTION          (bit-or WS_BORDER WS_DLGFRAME))
(define WS_POPUP            #x80000000)

(define WS_OVERLAPPED (cond-expand (windows-ce (bit-or WS_BORDER WS_CAPTION)) 
				   (windows-nt 0)))
(define WS_CHILD            #x40000000)

(define WS_EX_NOACTIVATE        #x08000000)
(define WS_EX_DLGMODALFRAME     #x00000001)
(define WS_EX_TOPMOST           #x00000008)
(define WS_EX_WINDOWEDGE        #x00000100)
(define WS_EX_CLIENTEDGE        #x00000200)
(define WS_EX_CONTEXTHELP	#x00000400)
(define WS_EX_STATICEDGE        #x00020000)
(define WS_EX_OVERLAPPEDWINDOW  (bit-or WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE))
(define WS_EX_CAPTIONOKBTN      #x80000000)
(define WS_EX_NODRAG            #x40000000)
(define WS_EX_ABOVESTARTUP	#x20000000)
(define WS_EX_INK		#x10000000)
(define WS_EX_NOANIMATION	#x04000000)


(define DestroyWindow (w32:foreign-procedure *userdll* "DestroyWindow" 
   '(w32api bool handle)))


(define DefWindowProc (w32:foreign-procedure *userdll* "DefWindowProcW" 
   '(w32api dword handle dword dword dword)))

(define GetDesktopWindow 
  (cond-expand
   (windows-ce (lambda () HWND_DESKTOP))
   (windows-nt (w32:foreign-procedure *userdll* "GetDesktopWindow" '(w32api handle)) )))


; winuser.h declares GetMessage as BOOL; 
; however, it has to be DWORD for the message loop to detect the death of the window
; when called on a non-NULL hwnd.
; (Note that on CE 2.0 the GetMessage will hang when called on a dead window.)
; The usual BOOL seems to work for a global loop to WM_QUIT treatment.

(define GetMessage (w32:foreign-procedure *userdll* "GetMessageW" 
   '(w32api bool lpvoid handle dword dword)))

(define GetMessage2 (w32:foreign-procedure *userdll* "GetMessageW" 
   '(w32api dword lpvoid handle dword dword)))

(define TranslateMessage (w32:foreign-procedure *userdll* "TranslateMessage" 
   '(w32api bool lpvoid)))

(define DispatchMessage (w32:foreign-procedure *userdll* "DispatchMessageW" 
   '(w32api dword lpvoid)))

(define IsWindow (w32:foreign-procedure *userdll* "IsWindow" 
   '(w32api bool handle)))

(define PostQuitMessage (w32:foreign-procedure *userdll* "PostQuitMessage" 
   '(w32api void dword)))

(define GetClientRect (w32:foreign-procedure *userdll* "GetClientRect" 
   '(w32api bool handle lpvoid)))

(define GetWindowRect (w32:foreign-procedure *userdll* "GetWindowRect" 
   '(w32api bool handle lpvoid)))

(define InvalidateRect (w32:foreign-procedure *userdll* "InvalidateRect"
   '(w32api bool handle lpvoid bool)))

(define UpdateWindow (w32:foreign-procedure *userdll* "UpdateWindow" 
   '(w32api bool handle)))

;; N.b. RegisterClass is pre-loaded as w32:register-class
(define UnregisterClass (w32:foreign-procedure *userdll* "UnregisterClassW" 
   '(w32api bool lpcwstr handle)))
(define CS_VREDRAW          #x0001)
(define CS_HREDRAW          #x0002)
(define CS_DBLCLKS          #x0008)
(define CS_PARENTDC         #x0080)
(define CS_NOCLOSE          #x0200)
(define CS_GLOBALCLASS      #x4000)

(define GetStockObject (w32:foreign-procedure *gdidll* "GetStockObject"
   '(w32api handle dword)))

(define SelectObject (w32:foreign-procedure *gdidll* "SelectObject"
   '(w32api handle handle handle)))
(define WHITE_BRUSH 0)
(define LTGRAY_BRUSH 1)
(define DKGRAY_BRUSH 3)
(define BLACK_BRUSH  4)
(define NULL_BRUSH   5)
(define HOLLOW_BRUSH NULL_BRUSH)
(define WHITE_PEN 6)
(define BLACK_PEN 7)

(define BeginPaint (w32:foreign-procedure *userdll* "BeginPaint"
   '(w32api handle handle lpvoid)))

(define EndPaint (w32:foreign-procedure *userdll* "EndPaint"
   '(w32api bool handle lpvoid)))

(define FillRect (w32:foreign-procedure *userdll* "FillRect"
   '(w32api bool handle lpvoid handle)))

(define Polyline (w32:foreign-procedure *gdidll* "Polyline"
   '(w32api bool handle lpvoid dword)))

;; $BUGBUG - FFI presently lacks ability to convert a negative numeric argument
;; These should be 'int', not 'dword'
(define SetPixel (w32:foreign-procedure *gdidll* "SetPixel"
   '(w32api dword handle dword dword dword)))

(define Rectangle (w32:foreign-procedure *gdidll* "Rectangle"
   '(w32api bool handle dword dword dword dword)))

(define Ellipse (w32:foreign-procedure *gdidll* "Ellipse"
   '(w32api bool handle dword dword dword dword)))

(define CreatePen (w32:foreign-procedure *gdidll* "CreatePen"
   '(w32api handle dword dword dword)))

(define PS_SOLID 0)

(define CreateSolidBrush (w32:foreign-procedure *gdidll* "CreateSolidBrush"
   '(w32api handle dword)))

; drawtext prototype is in wingdi.h, but the code resides in user32.dll
(define DrawText (w32:foreign-procedure *userdll* "DrawTextW"
   '(w32api bool handle lpcwstr dword lpvoid dword)))
(define DT_TOP       #x00000000)
(define DT_LEFT      #x00000000)
(define DT_CENTER    #x00000001)
(define DT_RIGHT     #x00000002)
(define DT_VCENTER   #x00000004)
(define DT_WORDBREAK #x00000010)
(define DT_SINGLELINE #x00000020)

(define SetWindowPos (w32:foreign-procedure *userdll* "SetWindowPos"
   '(w32api bool handle handle dword dword dword dword dword)))
(define HWND_TOP        0)
(define HWND_TOPMOST    (integer->foreign #xffffffff))
(define HWND_NOTOPMOST  (integer->foreign #xfffffffe))
(define HWND_BOTTOM     (integer->foreign 1))
(define SWP_NOSIZE         #x0001)
(define SWP_NOMOVE         #x0002)
(define SWP_NOZORDER	   #x0004)
(define SWP_NOREDRAW       #x0008)
(define SWP_NOACTIVATE     #x0010)
(define SWP_FRAMECHANGED   #x0020)
(define SWP_SHOWWINDOW	   #x0040)
(define SWP_HIDEWINDOW	   #x0080)
(define SWP_NOCOPYBITS     #x0100)
(define SWP_NOOWNERZORDER  #x0200)
(define SWP_NOSENDCHANGING #x0400)

(define GetDC (w32:foreign-procedure *userdll* "GetDC"
   '(w32api handle handle)))

(define ReleaseDC (w32:foreign-procedure *userdll* "ReleaseDC"
   '(w32api bool handle handle)))

(define LoadCursor (w32:foreign-procedure *userdll* "LoadCursorW"
   '(w32api handle handle lpcwstr)))
(define IDC_ARROW (integer->foreign 32512))

(define LoadIcon (w32:foreign-procedure *userdll* "LoadIconW"
   '(w32api handle handle lpcwstr)))
(define IDI_HAND (integer->foreign 32513))
(define IDI_WINLOGO (integer->foreign 32517))

(define SendMessage (w32:foreign-procedure *userdll* "SendMessageW"
   '(w32api dword handle dword handle handle)))

(define LoadImage (w32:foreign-procedure *userdll* "LoadImageW"
   '(w32api handle handle lpcwstr dword dword dword dword)))
(define LR_DEFAULTCOLOR 0)
(define IMAGE_ICON 1)

;; N.b. DialogBox is pre-loaded as w32:dialog-box
(define EndDialog (w32:foreign-procedure *userdll* "EndDialog"
   '(w32api dword handle dword)))

(define LoadString (w32:foreign-procedure *userdll* "LoadStringW"
   '(w32api dword handle dword lpwstr dword)))

(define SetDlgItemText (w32:foreign-procedure *userdll* "SetDlgItemTextW"
   '(w32api bool handle dword lpcwstr)))

;; The last parameter to SetTimer must be zero/#f/etc
(define SetTimer (w32:foreign-procedure *userdll* "SetTimer"
   '(w32api dword handle dword dword handle)))

(define KillTimer (w32:foreign-procedure *userdll* "KillTimer"
   '(w32api bool handle dword)))

(define CreateFontIndirect (w32:foreign-procedure *gdidll* "CreateFontIndirectW"
   '(w32api handle lpvoid)))
(define FW_BOLD 700)
(define FW_NORMAL 400)
(define ANSI_CHARSET 0)
(define OUT_DEFAULT_PRECIS 0)
(define CLIP_DEFAULT_PRECIS 0)
(define FF_MODERN (ash 3 4))
(define FF_SWISS (ash 2 4))
(define FIXED_PITCH 1)
(define DEFAULT_PITCH 0)

(define DeleteObject (w32:foreign-procedure *gdidll* "DeleteObject"
   '(w32api bool handle)))

(define SendDlgItemMessage (w32:foreign-procedure *userdll* "SendDlgItemMessageW"
   '(w32api dword handle dword dword handle handle)))

(define GetDeviceCaps (w32:foreign-procedure *gdidll* "GetDeviceCaps"
   '(w32api dword handle dword)))
(define LOGPIXELSY 90)

(define PeekMessage (w32:foreign-procedure *userdll* "PeekMessageW"
   '(w32api bool lpvoid handle dword dword dword)))
(define PM_NOREMOVE         #x0000)
(define PM_REMOVE           #x0001)
(define PM_NOYIELD          #x0002)

(define SetActiveWindow (w32:foreign-procedure *userdll* "SetActiveWindow"
   '(w32api handle handle)))

(define GetActiveWindow (w32:foreign-procedure *userdll* "GetActiveWindow"
   '(w32api handle)))

(define IsWindowEnabled (w32:foreign-procedure *userdll* "IsWindowEnabled"
   '(w32api bool handle)))

(define EnableWindow (w32:foreign-procedure *userdll* "EnableWindow"
   '(w32api bool handle bool)))

(define GetWindow (w32:foreign-procedure *userdll* "GetWindow"
   '(w32api handle handle dword)))
(define GW_OWNER 4)

(define MoveWindow
  (w32:foreign-procedure *userdll* "MoveWindow"
    '(w32api bool handle dword dword dword dword bool)))

(define SetForegroundWindow
  (w32:foreign-procedure *userdll* "SetForegroundWindow"
    '(w32api bool handle)))

(define SetFocus (w32:foreign-procedure *userdll* "SetFocus" '(w32api handle handle)))
  
(define SystemParametersInfo (w32:foreign-procedure *userdll* "SystemParametersInfoW"
  '(w32api bool dword dword lpvoid dword)))

(define SPI_GETWORKAREA 48)