home | new paste

(import (chezscheme))

;; save some typing
(define-syntax library-types
  (syntax-rules ()
    [(_ (name type object) ...)
     (begin
       (begin
	 (define-ftype type object)
	 (define name (make-ftype-pointer type (foreign-alloc (ftype-sizeof type)))))
       ...)]))

(define-syntax library-entries
  (syntax-rules ()
    [(_ (name entry (parameters ...) type) ...)
     (begin
       (define name (foreign-procedure entry (parameters ...) type))
       ...)]))

;; bind sdl library
(load-shared-object "c:/lib/SDL2.dll")

(library-types
 (window Window void*)
 (renderer Renderer void*)
 (event Event unsigned-32))

(library-entries
 (sdl:start "SDL_Init" (unsigned-32) int)
 (sdl:window "SDL_CreateWindowAndRenderer" (int int unsigned-32 (* void*) (* void*)) int)
 (sdl:event "SDL_PollEvent" ((* Event)) int)
 (sdl:color "SDL_SetRenderDrawColor" (Renderer unsigned-8 unsigned-8 unsigned-8 unsigned-8) int)
 (sdl:clear "SDL_RenderClear" (Renderer) int)
 (sdl:render "SDL_RenderPresent" (Renderer) void)
 (sdl:%renderer "SDL_DestroyRenderer" (Renderer) void)
 (sdl:%window "SDL_DestroyWindow" (Window) void)
 (sdl:exit "SDL_Quit" () void))

;; render a blue texture
(sdl:start #x0020)
(sdl:window 320 240 #x0020 window renderer)

(let ([&renderer (ftype-ref Renderer () renderer)]
      [&window (ftype-ref Window () window)])
  (let loop ()
    (sdl:event event)
    (unless (= #x0100 (ftype-ref Event () event))
      (sdl:color &renderer #x00 #x00 #xff #x00)
      (sdl:clear &renderer)
      (sdl:render &renderer)
      (loop)))
  (sdl:%renderer &renderer)
  (sdl:%window &window))

(sdl:exit)