(uffi:load-foreign-library "sdl.dll" :module "sdl.dll" :supporting-libraries '("c"))

(uffi:def-foreign-type Uint8 :unsigned-char)

(uffi:def-foreign-type Sint8 :char)

(uffi:def-foreign-type Uint16 :unsigned-short)

(uffi:def-foreign-type Sint16 :short)

(uffi:def-foreign-type Uint32 :unsigned-int)

(uffi:def-foreign-type Sint32 :int)

(progn
  (uffi:def-struct SDL_Color
                   (r Uint8)
                   (g Uint8)
                   (b Uint8)
                   (unused Uint8))
  (defmacro SDL_Color-r (s)
    `(uffi:get-slot-value ,s 'SDL_Color 'r))
  (defmacro SDL_Color-g (s)
    `(uffi:get-slot-value ,s 'SDL_Color 'g))
  (defmacro SDL_Color-b (s)
    `(uffi:get-slot-value ,s 'SDL_Color 'b))
  (defmacro SDL_Color-unused (s)
    `(uffi:get-slot-value ,s 'SDL_Color 'unused))
  (defun make-SDL_Color (&key r g b unused)
    (let ((s (uffi:allocate-foreign-object 'SDL_Color)))
      (setf (SDL_Color-r s) r)
      (setf (SDL_Color-g s) g)
      (setf (SDL_Color-b s) b)
      (setf (SDL_Color-unused s) unused)
      s)))

(progn
  (uffi:def-struct SDL_Palette
                   (ncolors :int)
                   (colors (* SDL_Color)))
  (defmacro SDL_Palette-ncolors (s)
    `(uffi:get-slot-value ,s 'SDL_Palette 'ncolors))
  (defmacro SDL_Palette-colors (s)
    `(uffi:get-slot-value ,s 'SDL_Palette 'colors))
  (defun make-SDL_Palette (&key ncolors colors)
    (let ((s (uffi:allocate-foreign-object 'SDL_Palette)))
      (setf (SDL_Palette-ncolors s) ncolors)
      (setf (SDL_Palette-colors s) colors)
      s)))


(progn
  (uffi:def-struct SDL_PixelFormat
                   (palette (* SDL_Palette))
                   (BitsPerPixel Uint8)
                   (BytesPerPixel Uint8)
                   (Rloss Uint8)
                   (Gloss Uint8)
                   (Bloss Uint8)
                   (Aloss Uint8)
                   (Rshift Uint8)
                   (Gshift Uint8)
                   (Bshift Uint8)
                   (Ashift Uint8)
                   (Rmask Uint32)
                   (Gmask Uint32)
                   (Bmask Uint32)
                   (Amask Uint32)
                   (colorkey Uint32)
                   (alpha Uint8))
  (defmacro SDL_PixelFormat-palette (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'palette))
  (defmacro SDL_PixelFormat-BitsPerPixel (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'BitsPerPixel))
  (defmacro SDL_PixelFormat-BytesPerPixel (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'BytesPerPixel))
  (defmacro SDL_PixelFormat-Rloss (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Rloss))
  (defmacro SDL_PixelFormat-Gloss (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Gloss))
  (defmacro SDL_PixelFormat-Bloss (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Bloss))
  (defmacro SDL_PixelFormat-Aloss (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Aloss))
  (defmacro SDL_PixelFormat-Rshift (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Rshift))
  (defmacro SDL_PixelFormat-Gshift (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Gshift))
  (defmacro SDL_PixelFormat-Bshift (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Bshift))
  (defmacro SDL_PixelFormat-Ashift (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Ashift))
  (defmacro SDL_PixelFormat-Rmask (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Rmask))
  (defmacro SDL_PixelFormat-Gmask (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Gmask))
  (defmacro SDL_PixelFormat-Bmask (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Bmask))
  (defmacro SDL_PixelFormat-Amask (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'Amask))
  (defmacro SDL_PixelFormat-colorkey (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'colorkey))
  (defmacro SDL_PixelFormat-alpha (s)
    `(uffi:get-slot-value ,s 'SDL_PixelFormat 'alpha))
  (defun make-SDL_PixelFormat (&key palette BitsPerPixel BytesPerPixel Rloss Gloss Bloss Aloss Rshift Gshift Bshift Ashift Rmask Gmask Bmask Amask colorkey alpha)
    (let ((s (uffi:allocate-foreign-object 'SDL_PixelFormat)))
      (setf (SDL_PixelFormat-palette s) palette)
      (setf (SDL_PixelFormat-BitsPerPixel s) BitsPerPixel)
      (setf (SDL_PixelFormat-BytesPerPixel s) BytesPerPixel)
      (setf (SDL_PixelFormat-Rloss s) Rloss)
      (setf (SDL_PixelFormat-Gloss s) Gloss)
      (setf (SDL_PixelFormat-Bloss s) Bloss)
      (setf (SDL_PixelFormat-Aloss s) Aloss)
      (setf (SDL_PixelFormat-Rshift s) Rshift)
      (setf (SDL_PixelFormat-Gshift s) Gshift)
      (setf (SDL_PixelFormat-Bshift s) Bshift)
      (setf (SDL_PixelFormat-Ashift s) Ashift)
      (setf (SDL_PixelFormat-Rmask s) Rmask)
      (setf (SDL_PixelFormat-Gmask s) Gmask)
      (setf (SDL_PixelFormat-Bmask s) Bmask)
      (setf (SDL_PixelFormat-Amask s) Amask)
      (setf (SDL_PixelFormat-colorkey s) colorkey)
      (setf (SDL_PixelFormat-alpha s) alpha)
      s)))

(progn
  (uffi:def-struct SDL_Rect
                   (x Sint16)
                   (y Sint16)
                   (w Sint16)
                   (h Uint16))
  (defmacro SDL_Rect-x (s)
    `(uffi:get-slot-value ,s 'SDL_Rect 'x))
  (defmacro SDL_Rect-y (s)
    `(uffi:get-slot-value ,s 'SDL_Rect 'y))
  (defmacro SDL_Rect-w (s)
    `(uffi:get-slot-value ,s 'SDL_Rect 'w))
  (defmacro SDL_Rect-h (s)
    `(uffi:get-slot-value ,s 'SDL_Rect 'h))
  (defun make-SDL_Rect (&key x y w h)
    (let ((s (uffi:allocate-foreign-object 'SDL_Rect)))
      (setf (SDL_Rect-x s) x)
      (setf (SDL_Rect-y s) y)
      (setf (SDL_Rect-w s) w)
      (setf (SDL_Rect-h s) h)
      s)))

(progn
  (uffi:def-struct SDL_Surface
                   (flags Uint32)
                   (format (* SDL_PixelFormat))
                   (w :int)
                   (h :int)
                   (pitch Uint16)
                   (pixels :pointer-void)
                   (offset :int)
                   (hwdata :pointer-void)
                   (clip_rect SDL_Rect)
                   (unused1 Uint32)
                   (locked Uint32)
                   (map :pointer-void)
                   (format_version :unsigned-int)
                   (refcount :int))
  (defmacro SDL_Surface-flags (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'flags))
  (defmacro SDL_Surface-format (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'format))
  (defmacro SDL_Surface-w (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'w))
  (defmacro SDL_Surface-h (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'h))
  (defmacro SDL_Surface-pitch (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'pitch))
  (defmacro SDL_Surface-pixels (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'pixels))
  (defmacro SDL_Surface-offset (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'offset))
  (defmacro SDL_Surface-hwdata (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'hwdata))
  (defmacro SDL_Surface-clip_rect (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'clip_rect))
  (defmacro SDL_Surface-unused1 (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'unused1))
  (defmacro SDL_Surface-locked (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'locked))
  (defmacro SDL_Surface-map (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'map))
  (defmacro SDL_Surface-format_version (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'format_version))
  (defmacro SDL_Surface-refcount (s)
    `(uffi:get-slot-value ,s 'SDL_Surface 'refcount))
  (defun make-SDL_Surface (&key flags format w h pitch pixels offset hwdata clip_rect unused1 locked map format_version refcount)
    (let ((s (uffi:allocate-foreign-object 'SDL_Surface)))
      (setf (SDL_Surface-flags s) flags)
      (setf (SDL_Surface-format s) format)
      (setf (SDL_Surface-w s) w)
      (setf (SDL_Surface-h s) h)
      (setf (SDL_Surface-pitch s) pitch)
      (setf (SDL_Surface-pixels s) pixels)
      (setf (SDL_Surface-offset s) offset)
      (setf (SDL_Surface-hwdata s) hwdata)
      (setf (SDL_Surface-clip_rect s) clip_rect)
      (setf (SDL_Surface-unused1 s) unused1)
      (setf (SDL_Surface-locked s) locked)
      (setf (SDL_Surface-map s) map)
      (setf (SDL_Surface-format_version s) format_version)
      (setf (SDL_Surface-refcount s) refcount)
      s)))

(defconstant SDL_INIT_TIMER #x00000001)
(defconstant SDL_INIT_AUDIO #x00000010)
(defconstant SDL_INIT_VIDEO #x00000020)
(defconstant SDL_INIT_CDROM #x00000100)
(defconstant SDL_INIT_JOYSTICK #x00000200)
(defconstant SDL_INIT_NOPARACHUTE #x00100000)
(defconstant SDL_INIT_EVENTTHREAD #x01000000)
(defconstant SDL_INIT_EVERYTHING #x0000FFFF)

(uffi:def-function ("SDL_Init" SDL_Init)
                   ( (flags Uint32))
                   :returning  :int 
                   :module "sdl.dll")

(defconstant SDL_SWSURFACE #x00000000)
(defconstant SDL_HWSURFACE #x00000001)
(defconstant SDL_ASYNCBLIT #x00000004)
(defconstant SDL_ANYFORMAT #x10000000)
(defconstant SDL_HWPALETTE #x20000000)
(defconstant SDL_DOUBLEBUF #x40000000)
(defconstant SDL_FULLSCREEN #x80000000)
(defconstant SDL_OPENGL #x00000002)
(defconstant SDL_OPENGLBLIT #x0000000A)
(defconstant SDL_RESIZABLE #x00000010)
(defconstant SDL_NOFRAME #x00000020)
(defconstant SDL_HWACCEL #x00000100)
(defconstant SDL_SRCCOLORKEY #x00001000)
(defconstant SDL_RLEACCELOK #x00002000)
(defconstant SDL_RLEACCEL #x00004000)
(defconstant SDL_SRCALPHA #x00010000)
(defconstant SDL_PREALLOC #x01000000)

(uffi:def-function ("SDL_SetVideoMode" SDL_SetVideoMode)
                   ( (width :int) (height :int) (bpp :int) (flags Uint32))
                   :returning  (* SDL_Surface)
                   :module "sdl.dll")

(uffi:def-function ("SDL_WM_SetCaption" SDL_WM_SetCaption)
                   ( (title :cstring) (icon :cstring))
                   :returning :void
                   :module "sdl.dll")

(uffi:def-function ("SDL_UpdateRect" SDL_UpdateRect)
                   ( (screen (* SDL_Surface)) (x Sint32) (y Sint32) (w Uint32) (h Uint32))
                   :returning :void
                   :module "sdl.dll")

(uffi:def-function ("SDL_Quit" SDL_Quit)
                   ()
                   :returning :void
                   :module "sdl.dll")

(uffi:def-function ("SDL_MapRGB" SDL_MapRGB)
                   ( (format (* SDL_PixelFormat)) (r Uint8) (g Uint8) (b Uint8))
                   :returning Uint32
                   :module "sdl.dll")

(uffi:def-function ("SDL_FillRect" SDL_FillRect)
                   ( (dst (* SDL_Surface)) (dstrect (* SDL_Rect)) (color Uint32))
                   :returning :int
                   :module "sdl.dll")


;; needed for delivery
#+lispworks(FLI::DEFINE-PRECOMPILED-FOREIGN-OBJECT-ACCESSOR-FUNCTIONS (((:POINTER COMMON-LISP-USER::SDL_PIXELFORMAT) :NO-ALLOC-P :ERROR :SIZE COMMON-LISP:NIL)))

;; start test
(defun start ()
  (let ((caption "Lisp SDL Test Application")
        (width 320)
        (height 200))
    (SDL_Init SDL_INIT_VIDEO)
    (SDL_WM_SetCaption caption caption)
    (let ((screen (SDL_SetVideoMode width height 0 (logior SDL_SWSURFACE SDL_RESIZABLE))))
      (format t "width: ~a~%height: ~a~%bits per pixel: ~a~%" 
              (SDL_Surface-w screen)
              (SDL_Surface-h screen)
              (SDL_PixelFormat-BitsPerPixel (SDL_Surface-format screen)))
      (dotimes (i 50)
        (let ((color (SDL_MapRGB (SDL_Surface-format screen) 
                                 (random 256) (random 256) (random 256)))
              (x0 (random width))
              (y0 (random height))
              (x1 (random width))
              (y1 (random height)))
          (let ((r (make-SDL_Rect :x x0 :y y0 :w (- x1 x0) :h (- y1 y0))))
            (SDL_FillRect screen r color)
            (SDL_UpdateRect screen 
                            (SDL_Rect-x r) (SDL_Rect-y r)
                            (SDL_Rect-w r) (SDL_Rect-h r))
            (uffi:free-foreign-object r)))
        (sleep 0.1)))
    (SDL_Quit)))