gacela_SDL.lisp

   1 ;;; Gacela, a GNU Common Lisp extension for fast games development
   2 ;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
   3 ;;;
   4 ;;; This program is free software: you can redistribute it and/or modify
   5 ;;; it under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation, either version 3 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;; GNU General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License
  15 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 (eval-when (compile load eval)
  19            (when (not (find-package 'gacela)) (make-package 'gacela :nicknames '(gg) :use '(lisp)))
  20            (in-package 'gacela :nicknames '(gg) :use '(lisp)))
  21
  22
  23 (defmacro mapcconst (type c-type name)
  24   (let ((c-header (concatenate 'string c-type " gacela_" name " (void)"))
  25         (c-body (concatenate 'string "return " name ";"))
  26         (c-name (concatenate 'string "gacela_" name))
  27         (lisp-name (intern (string-upcase name))))
  28     `(progn
  29        (defcfun ,c-header 0 ,c-body)
  30        (defentry ,lisp-name () (,type ,c-name))
  31        (eval-when (load) (defconstant ,lisp-name (,lisp-name))))))
  32
  33 (clines "#include <SDL/SDL.h>")
  34 (clines "#include <SDL/SDL_image.h>")
  35 (clines "#include <SDL/SDL_mixer.h>")
  36
  37 ;;; SDL constants as functions
  38 (mapcconst int "int" "SDL_INIT_TIMER")
  39 (mapcconst int "int" "SDL_INIT_AUDIO")
  40 (mapcconst int "int" "SDL_INIT_VIDEO")
  41 (mapcconst int "int" "SDL_INIT_CDROM")
  42 (mapcconst int "int" "SDL_INIT_JOYSTICK")
  43 (mapcconst int "int" "SDL_INIT_NOPARACHUTE")
  44 (mapcconst int "int" "SDL_INIT_EVENTTHREAD")
  45 (mapcconst int "int" "SDL_INIT_EVERYTHING")
  46
  47 (mapcconst int "int" "SDL_SWSURFACE")
  48 (mapcconst int "int" "SDL_HWSURFACE")
  49 (mapcconst int "int" "SDL_ASYNCBLIT")
  50
  51 (mapcconst int "int" "SDL_ANYFORMAT")
  52 (mapcconst int "int" "SDL_HWPALETTE")
  53 (mapcconst int "int" "SDL_DOUBLEBUF")
  54 (mapcconst int "int" "SDL_FULLSCREEN")
  55 (mapcconst int "int" "SDL_OPENGL")
  56 (mapcconst int "int" "SDL_OPENGLBLIT")
  57 (mapcconst int "int" "SDL_RESIZABLE")
  58 (mapcconst int "int" "SDL_NOFRAME")
  59
  60 (mapcconst int "int" "SDL_HWACCEL")
  61 (mapcconst int "int" "SDL_SRCCOLORKEY")
  62
  63 (mapcconst int "int" "SDL_GL_DOUBLEBUFFER")
  64
  65 (mapcconst int "int" "SDL_DEFAULT_REPEAT_DELAY")
  66 (mapcconst int "int" "SDL_DEFAULT_REPEAT_INTERVAL")
  67
  68 (mapcconst int "int" "SDL_LIL_ENDIAN")
  69 (mapcconst int "int" "SDL_BIG_ENDIAN")
  70
  71 (mapcconst int "int" "MIX_DEFAULT_FORMAT")
  72
  73 ;;; SDL Functions
  74 (defcfun "int gacela_SDL_Init (int flags)" 0
  75   "return SDL_Init (flags);")
  76
  77 (defcfun "void gacela_SDL_Quit (void)" 0
  78   "SDL_Quit ();")
  79
  80 (defcfun "int gacela_SDL_SetVideoMode (int width, int height, int bpp, int flags)" 0
  81   "close(2);"
  82   "return SDL_SetVideoMode (width, height, bpp, flags);")
  83
  84 (defcfun "void gacela_SDL_WM_SetCaption (char *title, char *icon)" 0
  85   "SDL_WM_SetCaption (title, icon);")
  86
  87 (defcfun "int gacela_SDL_Flip (int screen)" 0
  88   "return SDL_Flip (screen);")
  89
  90 (defcfun "void gacela_SDL_FreeSurface (int surface)" 0
  91   "SDL_FreeSurface (surface);")
  92
  93 (defcfun "void gacela_SDL_Delay (int ms)" 0
  94   "SDL_Delay (ms);")
  95
  96 (defcfun "int gacela_SDL_GetTicks (void)" 0
  97   "return SDL_GetTicks ();")
  98
  99 (defcfun "int gacela_SDL_DisplayFormat (int surface)" 0
 100   "return SDL_DisplayFormat (surface);")
 101
 102 (defcfun "int gacela_SDL_MapRGB (int format, int r, int g, int b)" 0
 103   "return SDL_MapRGB (format, r, g, b);")
 104
 105 (defcfun "int gacela_SDL_SetColorKey (int surface, int flag, int key)" 0
 106   "return SDL_SetColorKey (surface, flag, key);")
 107
 108 (defcfun "int gacela_SDL_LoadBMP (char *file)" 0
 109   "return SDL_LoadBMP (file);")
 110
 111 (defcfun "int gacela_IMG_Load (char *filename)" 0
 112   "return IMG_Load (filename);")
 113
 114 (defcfun "static object gacela_SDL_GetVideoInfo (void)" 0
 115   "const SDL_VideoInfo *info;"
 116   "object vi, label;"
 117   "info = SDL_GetVideoInfo ();"
 118   ('nil vi)
 119   ((cons (int info->blit_hw) vi) vi) (':blit_hw label) ((cons label vi) vi)
 120   ((cons (int info->hw_available) vi) vi) (':hw_available label) ((cons label vi) vi)
 121   "return vi;")
 122
 123 (defcfun "int gacela_SDL_GL_SetAttribute (int attr, int value)" 0
 124   "return SDL_GL_SetAttribute (attr, value);")
 125
 126 (defcfun "static object gacela_SDL_PollEvent (void)" 0
 127   "SDL_Event sdl_event;"
 128   "object event, label;"
 129   ('nil event)
 130   "if (SDL_PollEvent (&sdl_event)) {"
 131   "  switch (sdl_event.type) {"
 132   "    case SDL_KEYDOWN:"
 133   "    case SDL_KEYUP:"
 134   ((cons (int sdl_event.key.keysym.sym) event) event) (':key.keysym.sym label) ((cons label event) event)
 135   "      break;"
 136   "  }"
 137   ((cons (int sdl_event.type) event) event) (':type label) ((cons label event) event)
 138   "}"
 139   "return event;")
 140
 141 (defcfun "void gacela_SDL_GL_SwapBuffers (void)" 0
 142   "SDL_GL_SwapBuffers ();")
 143
 144 (defcfun "int gacela_SDL_EnableKeyRepeat (int delay, int interval)" 0
 145   "return SDL_EnableKeyRepeat (delay, interval);")
 146
 147 (defcfun "int gacela_SDL_ByteOrder (void)" 0
 148   "return SDL_BYTEORDER;")
 149
 150 (defcfun "int gacela_zoomSurface (int src, double zoomx, double zoomy, int smooth)" 0
 151   "return zoomSurface (src, zoomx, zoomy, smooth);")
 152
 153 (defcfun "int gacela_Mix_OpenAudio (int frequency, int format, int channels, int chunksize)" 0
 154   "return Mix_OpenAudio (frequency, format, channels, chunksize);")
 155
 156 (defcfun "int gacela_Mix_LoadMUS (char *file)" 0
 157   "return Mix_LoadMUS (file);")
 158
 159 (defcfun "int gacela_Mix_LoadWAV (char *file)" 0
 160   "return Mix_LoadWAV (file);")
 161
 162 (defcfun "int gacela_Mix_PlayChannel (int channel, int chunk, int loops)" 0
 163   "return Mix_PlayChannel (channel, chunk, loops);")
 164
 165 (defcfun "int gacela_Mix_PlayMusic (int music, int loops)" 0
 166   "return Mix_PlayMusic (music, loops);")
 167
 168 (defcfun "int gacela_Mix_PlayingMusic (void)" 0
 169   "return Mix_PlayingMusic ();")
 170
 171 (defcfun "int gacela_Mix_PausedMusic (void)" 0
 172   "return Mix_PausedMusic ();")
 173
 174 (defcfun "void gacela_Mix_PauseMusic (void)" 0
 175   "Mix_PauseMusic ();")
 176
 177 (defcfun "void gacela_Mix_ResumeMusic (void)" 0
 178   "Mix_ResumeMusic ();")
 179
 180 (defcfun "int gacela_Mix_HaltMusic (void)" 0
 181   "return Mix_HaltMusic ();")
 182
 183 (defcfun "void gacela_Mix_FreeMusic (int music)" 0
 184   "Mix_FreeMusic (music);")
 185
 186 (defcfun "void gacela_Mix_FreeChunk (int chunk)" 0
 187   "Mix_FreeChunk (chunk);")
 188
 189 (defcfun "void gacela_Mix_CloseAudio (void)" 0
 190   "Mix_CloseAudio ();")
 191
 192 (defentry SDL_Init (int) (int "gacela_SDL_Init"))
 193 (defentry SDL_Quit () (void "gacela_SDL_Quit"))
 194 (defentry SDL_SetVideoMode (int int int int) (int "gacela_SDL_SetVideoMode"))
 195 (defentry SDL_WM_SetCaption (string string) (void "gacela_SDL_WM_SetCaption"))
 196 (defentry SDL_Flip (int) (int "gacela_SDL_Flip"))
 197 (defentry SDL_FreeSurface (int) (void "gacela_SDL_FreeSurface"))
 198 (defentry SDL_Delay (int) (void "gacela_SDL_Delay"))
 199 (defentry SDL_GetTicks () (int "gacela_SDL_GetTicks"))
 200 (defentry SDL_DisplayFormat (int) (int "gacela_SDL_DisplayFormat"))
 201 ;(defentry SDL_SurfaceFormat (int) (int "gacela_SDL_SurfaceFormat"))
 202 (defentry SDL_MapRGB (int int int int) (int "gacela_SDL_MapRGB"))
 203 (defentry SDL_SetColorKey (int int int) (int "gacela_SDL_SetColorKey"))
 204 ;(defentry SDL_BlitSurface (int int int int) (void "gacela_SDL_BlitSurface"))
 205 ;(defentry SDL_Rect (int int int int) (int "gacela_SDL_Rect"))
 206 (defentry SDL_LoadBMP (string) (int "gacela_SDL_LoadBMP"))
 207 (defentry IMG_Load (string) (int "gacela_IMG_Load"))
 208 (defentry SDL_GetVideoInfo () (object "gacela_SDL_GetVideoInfo"))
 209 (defentry SDL_GL_SetAttribute (int int) (int "gacela_SDL_GL_SetAttribute"))
 210 (defentry SDL_PollEvent () (object "gacela_SDL_PollEvent"))
 211 ;(defentry TTF_Init () (int "gacela_TTF_Init"))
 212 ;(defentry TTF_OpenFont (string int) (int "gacela_TTF_OpenFont"))
 213 ;(defentry TTF_CloseFont (int) (void "gacela_TTF_CloseFont"))
 214 ;(defentry TTF_Quit () (void "gacela_TTF_Quit"))
 215 (defentry Mix_OpenAudio (int int int int) (int "gacela_Mix_OpenAudio"))
 216 (defentry Mix_LoadMUS (string) (int "gacela_Mix_LoadMUS"))
 217 (defentry Mix_LoadWAV (string) (int "gacela_Mix_LoadWAV"))
 218 (defentry Mix_PlayChannel (int int int) (int "gacela_Mix_PlayChannel"))
 219 (defentry Mix_PlayMusic (int int) (int "gacela_Mix_PlayMusic"))
 220 (defentry Mix_PlayingMusic () (int "gacela_Mix_PlayingMusic"))
 221 (defentry Mix_PausedMusic () (int "gacela_Mix_PausedMusic"))
 222 (defentry Mix_PauseMusic () (void "gacela_Mix_PauseMusic"))
 223 (defentry Mix_ResumeMusic () (void "gacela_Mix_ResumeMusic"))
 224 (defentry Mix_HaltMusic () (int "gacela_Mix_HaltMusic"))
 225 (defentry Mix_FreeMusic (int) (void "gacela_Mix_FreeMusic"))
 226 (defentry Mix_FreeChunk (int) (void "gacela_Mix_FreeChunk"))
 227 (defentry Mix_CloseAudio () (void "gacela_Mix_CloseAudio"))
 228 ;(defentry free (int) (void "gacela_free"))
 229 (defentry SDL_GL_SwapBuffers () (void "gacela_SDL_GL_SwapBuffers"))
 230 (defentry SDL_EnableKeyRepeat (int int) (int "gacela_SDL_EnableKeyRepeat"))
 231 (defentry SDL_ByteOrder () (int "gacela_SDL_ByteOrder"))
 232 (defentry zoomSurface (int double double int) (int "gacela_zoomSurface"))
 233
 234 ;;; C-Gacela Functions
 235 (defcfun "int gacela_surface_format (int surface)" 0
 236   "const SDL_Surface *s = surface;"
 237   "return s->format;")
 238
 239 (defcfun "int gacela_surface_w (int surface)" 0
 240   "const SDL_Surface *s = surface;"
 241   "return s->w;")
 242
 243 (defcfun "int gacela_surface_h (int surface)" 0
 244   "const SDL_Surface *s = surface;"
 245   "return s->h;")
 246
 247 (defcfun "int gacela_surface_pixels (int surface)" 0
 248   "const SDL_Surface *s = surface;"
 249   "return s->pixels;")
 250
 251 (defcfun "int gacela_surface_format_BytesPerPixel (int surface)" 0
 252   "const SDL_Surface *s = surface;"
 253   "return s->format->BytesPerPixel;")
 254
 255 ;(defentry apply-surface2 (int int int int int int int int int) (void "apply_surface"))
 256 ;(defentry render-text2 (int string int int int) (int "render_text"))
 257 ;(defentry box-collision (int int int int int int) (int "box_collision"))
 258 ;(defentry create-SDL_Surface (int int int int int int) (int "create_SDL_Surface"))
 259 ;(defentry copy-SDL_Surface (int) (int "copy_SDL_Surface"))
 260 (defentry surface-format (int) (int "gacela_surface_format"))
 261 (defentry surface-w (int) (int "gacela_surface_w"))
 262 (defentry surface-h (int) (int "gacela_surface_h"))
 263 (defentry surface-pixels (int) (int "gacela_surface_pixels"))
 264 (defentry surface-format-BytesPerPixel (int) (int "gacela_surface_format_BytesPerPixel"))