source: project/release/4/kitaaba/trunk/sdl.scm @ 25842

;;;; sdl.scm


(foreign-declare #<<EOF

#include <SDL/SDL.h>
#include <SDL/SDL_ttf.h>

#ifdef _WIN32
#include <windows.h>
#endif

SDL_Event event;

EOF
)


(define-enum event-type-code event-code-type
  NOEVENT
  ACTIVEEVENT
  KEYDOWN
  KEYUP
  MOUSEMOTION
  MOUSEBUTTONDOWN
  MOUSEBUTTONUP
  (QUIT 12)
  (VIDEORESIZE 16)
  VIDEOEXPOSE)

(define-enum modifier-key-code modifier-key-name
  (SHIFT #x0003)
  (CTRL #x00c0)
  (ALT #x0300))


(define screen #f)                      ; POINTER
(define font #f)                        ; POINTER


(define (open-font ttf size)
  (set! font
    ((foreign-lambda* c-pointer ((c-string name) (int size))
       "return(TTF_OpenFont(name, size));")
     ttf size))
  (set! char-width
    ((foreign-lambda* int ((c-pointer fnt))
       "int w, h;"
       "TTF_SizeText((TTF_Font *)fnt, \"_\", &w, &h);"
       "return(w);")
     font))
  (set! line-height size))              ;XXX configurable

;;XXX use indexed color mode
(define (open-screen w h)
  (set! screen
    ((foreign-lambda* c-pointer ((int w) (int h))
       "SDL_Init(SDL_INIT_EVERYTHING | SDL_INIT_NOPARACHUTE);"
       "TTF_Init();"
       "SDL_EnableKeyRepeat(SDL_DEFAULT_REPEAT_DELAY, SDL_DEFAULT_REPEAT_INTERVAL);"
       "SDL_EnableUNICODE(1);"
       "return(SDL_SetVideoMode(w, h, 8, SDL_RESIZABLE));")
     w h))
  (print "h: " (surface-height screen)))

(define (resize-screen w h)
  (set! screen
    ((foreign-lambda* c-pointer ((int w) (int h))
       "return(SDL_SetVideoMode(w, h, 8, SDL_RESIZABLE));")
     w h))
  (print "h: " (surface-height screen)))

(define release-surface
  (foreign-lambda void "SDL_FreeSurface" c-pointer))

(define flip 
  (foreign-lambda void "SDL_Flip" c-pointer))

(define (blit ptr x y)
  ((foreign-lambda* void ((c-pointer bmp) (c-pointer dest) (int x) (int y))
     "SDL_Rect r;"
     "r.x = x; r.y = y;"
     "SDL_BlitSurface(bmp, NULL, dest, &r);")
   ptr screen x y))

(define (render-ucs-text str r g b)
  ((foreign-lambda* c-pointer ((u16vector str) (c-pointer font)
                               (int r) (int g) (int b))
     "SDL_Color c;"
     "c.r = r; c.g = g; c.b = b;"
     "return(TTF_RenderUNICODE_Blended(font, str, c));")
   str font r g b))

(define (render-ucs-text/plain str r g b)
  ((foreign-lambda* c-pointer ((u16vector str) (c-pointer font)
                               (int r) (int g) (int b))
     "SDL_Color c;"
     "c.r = r; c.g = g; c.b = b;"
     "return(TTF_RenderUNICODE_Solid(font, str, c));")
   str font r g b))

(define (render-utf8-text str r g b)
  ((foreign-lambda* c-pointer ((c-string str) (c-pointer font)
                               (int r) (int g) (int b))
     "SDL_Color c;"
     "c.r = r; c.g = g; c.b = b;"
     "return(TTF_RenderUTF8_Blended(font, str, c));")
   str font r g b))

(define surface-width
  (foreign-lambda* int ((c-pointer bmp)) "return(((SDL_Surface *)bmp)->w);"))

(define surface-height
  (foreign-lambda* int ((c-pointer bmp)) "return(((SDL_Surface *)bmp)->h);"))

(define get-next-event
  (foreign-lambda* bool ()
    "return(SDL_WaitEvent(&event));"))

(define peek-event
  (foreign-lambda* bool ()
    "return(SDL_PollEvent(&event));"))

(define event-type
  (foreign-lambda* int () "return(event.type);"))

(define event-x
  (foreign-lambda* int ()
    "switch(event.type) {"
    "case SDL_MOUSEMOTION: return(event.motion.x);"
    "case SDL_MOUSEBUTTONDOWN:"
    "case SDL_MOUSEBUTTONUP: return(event.button.x);"
    "default: return(0);}"))

(define event-y
  (foreign-lambda* int ()
    "switch(event.type) {"
    "case SDL_MOUSEMOTION: return(event.motion.y);"
    "case SDL_MOUSEBUTTONDOWN:"
    "case SDL_MOUSEBUTTONUP: return(event.button.y);"
    "default: return(0);}"))

(define event-w
  (foreign-lambda* int ()
    "switch(event.type) {"
    "case SDL_VIDEORESIZE: return(event.resize.w);"
    "default: return(0);}"))

(define event-h
  (foreign-lambda* int ()
    "switch(event.type) {"
    "case SDL_VIDEORESIZE: return(event.resize.h);"
    "default: return(0);}"))

(define event-key-scancode
  (foreign-lambda* int ()
    "switch(event.type) {"
    "case SDL_KEYDOWN:"
    "case SDL_KEYUP: return(event.key.keysym.scancode);"
    "default: return(0);}"))

(define event-key-code
  (foreign-lambda* int ()
    "switch(event.type) {"
    "case SDL_KEYDOWN:"
    "case SDL_KEYUP: return(event.key.keysym.sym);"
    "default: return(0);}"))

(define event-key-unicode
  (foreign-lambda* int ()
    "switch(event.type) {"
    "case SDL_KEYDOWN:"
    "case SDL_KEYUP: return(event.key.keysym.unicode);"
    "default: return(0);}"))

(define event-modifier-keys
  (foreign-lambda* int ()
    "int c;"
    "switch(event.type) {"
    "case SDL_KEYDOWN:"
    "case SDL_KEYUP:"
    "c = (int)event.key.keysym.mod & 0x0fff;" ; this seems to be the case on Windows
    "c |= (c & KMOD_CTRL) ? KMOD_CTRL : 0;"
    "c |= (c & KMOD_SHIFT) ? KMOD_SHIFT : 0;"
    "c |= (c & KMOD_ALT) ? KMOD_ALT : 0;"
    "return(c);"
    "default: return(0);}"))

(define event-button
  (foreign-lambda* int ()
    "switch(event.type) {"
    "case SDL_MOUSEBUTTONDOWN:"
    "case SDL_MOUSEBUTTONUP: return(event.button.button);"
    "default: return(0);}"))

(define fill
  (foreign-lambda* void ((c-pointer bmp) (int x) (int y) (int w) (int h)
                         (int r) (int g) (int b))
    "SDL_Rect re;"
    "Uint32 c = SDL_MapRGB(((SDL_Surface *)bmp)->format, r, g, b);"
    "re.x = x; re.y = y; re.w = w; re.h = h;"
    "SDL_FillRect(bmp, &re, c);"))