anchor.diff:  (defcfun ("RegisterClassExA" %register-class-ex) :int16
     (wndclass-ex :pointer))
   
  +(defcfun ("GetClassInfoA" %get-class-info) bool
  +  (instance hinstance) (class-name :string) (wndclass :pointer))
   
   (defcfun ("UnregisterClassA" unregister-class) bool
     (class-name :string) (instance hinstance))
   
  +(defun class-exists-p (module-instance name)
  +  (with-foreign-object (class 'wndclass)
  +	(%get-class-info module-instance name class)))
  +
   (defun create-and-register-class (module-instance name)
  -  (with-foreign-object (class 'wndclass)
  -    (with-foreign-slots ((style wndproc cls-extra wnd-extra instance icon cursor
  -                                br-background menu-name class-name) class wndclass)
  -      (setf style (foreign-bitfield-value 'class-style-flags
  -                                          '(:cs-hredraw :cs-vredraw :cs-own-dc))
  -            wndproc (callback window-proc)
  -            cls-extra 0
  -            wnd-extra 0
  -            instance module-instance
  -            icon  (null-pointer)
  -            cursor (null-pointer)
  -            br-background (null-pointer)
  -            menu-name (null-pointer)
  -            class-name name))
  -    (when (zerop (%register-class class))
  -      (format t "Error registering class ~S: ~S~%" name (get-last-error)))))
  +  (unless (class-exists-p module-instance name)
  +	(with-foreign-object (class 'wndclass)
  +	  (with-foreign-slots ((style wndproc cls-extra wnd-extra instance icon cursor
  +								  br-background menu-name class-name) class wndclass)
  +		(setf style (foreign-bitfield-value 'class-style-flags
  +											'(:cs-hredraw :cs-vredraw :cs-own-dc))
  +			  wndproc (callback window-proc)
  +			  cls-extra 0
  +			  wnd-extra 0
  +			  instance module-instance
  +			  icon	(null-pointer)
  +			  cursor (null-pointer)
  +			  br-background (null-pointer)
  +			  menu-name (null-pointer)
  +			  class-name name))
  +	  (when (zerop (%register-class class))
  +		(format t "Error registering class ~S: ~S~%" name (get-last-error))))))
   
   (defcfun ("SetWindowTextA" set-window-text) bool
     (wnd hwnd) (title :string))
  
positive.code: 
  (defun current-video-mode ()
    (with-foreign-object (dmode 'devmode)
      (with-foreign-slots ((size bits-per-pixel pels-width pels-height display-frequency)
                           dmode devmode)
        (setf size (foreign-type-size 'devmode))
        (enum-display-settings (cffi:null-pointer) -1 dmode)
        (glop::make-video-mode :width pels-width
                                     :height pels-height
                                     :depth bits-per-pixel
                                     :rate display-frequency))))
  
  (defun list-video-modes ()
    (with-foreign-object (dmode 'devmode)
      (with-foreign-slots ((size bits-per-pixel pels-width pels-height display-frequency)
                           dmode devmode)
        (setf size (foreign-type-size 'devmode))
        (loop with mode-index = 0
           for res = (enum-display-settings (cffi:null-pointer) mode-index dmode)
           do (incf mode-index)
           until (zerop res)
           collect (glop::make-video-mode :width pels-width
                                          :height pels-height
                                          :depth bits-per-pixel
                                          :rate display-frequency)))))
  
  (defun set-video-mode (mode)
    (let ((width (glop::video-mode-width mode))
          (height (glop::video-mode-height mode))
          (depth (glop::video-mode-depth mode))
          (rate (glop::video-mode-rate mode)))
      (with-foreign-object (dmode 'devmode)
        (with-foreign-slots ((size bits-per-pixel pels-width pels-height display-frequency fields)
                             dmode devmode)
          (setf size (foreign-type-size 'devmode))
          (enum-display-settings (cffi:null-pointer) -1 dmode)
          (setf pels-width width
                pels-height height
                display-frequency rate
                bits-per-pixel depth
                fields (foreign-bitfield-value 'device-mode-fields '(:dm-pels-width
                                                                     :dm-pels-height
                                                                     :dm-bits-per-pixel
                                                                     :dm-display-frequency)))
          (change-display-settings dmode
                                   (foreign-enum-value 'display-settings-mode
                                                           :cds-fullscreen))))))
  
  (defun default-video-mode ()
    (change-display-settings (cffi:null-pointer) 0))
  
  (defun %set-fullscreen (wnd state)
    (if state
        (progn (set-window-long wnd :gwl-style
                        (foreign-bitfield-value 'wstyle
                                '(:ws-popup :ws-clip-siblings :ws-clip-children)))
               (set-window-long wnd :gwl-ex-style
                        (foreign-bitfield-value 'wex-style
                                '(:ws-ex-app-window :ws-ex-topmost))))
        (progn (set-window-long wnd :gwl-style
                        (foreign-bitfield-value 'wstyle
                                '(:ws-overlapped-window :ws-clip-siblings :ws-clip-children)))
               (set-window-long wnd :gwl-ex-style
                        (foreign-bitfield-value 'wex-style
                                '(:ws-ex-app-window :ws-ex-window-edge))))))
  
  (defcfun ("GetClientRect" %get-client-rect) bool
    (wnd hwnd) (rect-out :pointer))
  
  (defun get-client-rect (wnd)
    (with-foreign-object (rct 'rect)
      (%get-client-rect wnd rct)
      (with-foreign-slots ((left top right bottom) rct rect)
        (values left top
                (- right left)
                (- bottom top)))))
  
  (defcfun ("GetWindowRect" %get-window-rect) bool
    (wnd hwnd) (rect-out :pointer))
  
  (defun get-window-rect (wnd)
    (with-foreign-object (rct 'rect)
      (%get-window-rect wnd rct)
      (with-foreign-slots ((left top right bottom) rct rect)
        (values left top
                (- right left)
                (- bottom top)))))
  
  (defun get-client-area-offset (wnd)
    (multiple-value-bind (wx wy ww wh) (get-window-rect wnd)
      (multiple-value-bind (cx cy cw ch) (get-client-rect wnd)
        (declare (ignore ww wh cw ch))
        (values (- cx wx) (- cy wy)))))
  
  (defcfun ("MoveWindow" move-window) bool
    (wnd hwnd) (x :int) (y :int) (width :int) (height :int)
  
negative.code: 
  (defun next-event (win wnd &optional blocking)
    (let ((%window% win))
  	(with-foreign-object (msg 'msg)
  	  (if blocking
  		  (when (> (%get-message msg wnd 0 0) 0)
  			(%translate-message msg)
  			(%dispatch-message msg))
  		  (when (%peek-message msg wnd 0 0 :pm-remove)
  			(%translate-message msg)
  			(%dispatch-message msg))))
  	%event%))
  
  ;; XXX: we probably have problems with negative numbers here...
  (defun low-word (value)
  