;; Build with
;;   mzc ++ldf user32.lib msgbox.ss
;; so that MessageBox() is linked in.

(module msgbox mzscheme
  (require compiler/cffi)
  
  ;; c-declare is really file-specific, and
  ;;  not module-specific
  (c-declare "#include <windows.h>")

  ;; A direct hook to the MessageBox() function.
  ;; We never have a parent window, but NULL is ok,
  ;;  and we can pretend that a window is a string
  ;;  for the purposes of providing a NULL:
  (define unsafe-message-box
    (c-lambda ((pointer "void") ; always use #f
	       nonnull-char-string ; title
	       nonnull-char-string ; message
	       int)   ; style
	      int
	      "MessageBox"))

  ;; Functions that really just access constants:
  (define get-mb-okcancel
    (c-lambda () int "___result = MB_OKCANCEL;"))
  (define get-mb-yesno
    (c-lambda () int "___result = MB_YESNO;"))

  ;; Nice function for clients to use:
  (define (message-box title message style)
    (unsafe-message-box
     #f
     title
     message
     (case style
       [(ok-cancel) (get-mb-okcancel)]
       [(yes-no) (get-mb-yesno)]
       [else (raise-type-error 'message-box "'ok-cancel or 'yes-no" style)])))

  (provide message-box))
