surface: Add binding for SDL_ConvertSurfaceFormat.
[guile-sdl2.git] / sdl2.scm
1 ;;; guile-sdl2 --- FFI bindings for SDL2
2 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
3 ;;;
4 ;;; This file is part of guile-sdl2.
5 ;;;
6 ;;; Guile-sdl2 is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU Lesser General Public License as
8 ;;; published by the Free Software Foundation; either version 3 of the
9 ;;; License, or (at your option) any later version.
10 ;;;
11 ;;; Guile-sdl2 is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;; General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU Lesser General Public
17 ;;; License along with guile-sdl2. If not, see
18 ;;; <http://www.gnu.org/licenses/>.
19
20 ;;; Commentary:
21 ;;
22 ;; SDL initialization and error handling.
23 ;;
24 ;;; Code:
25
26 (define-module (sdl2)
27 #:use-module (ice-9 match)
28 #:use-module (srfi srfi-4)
29 #:use-module (srfi srfi-9)
30 #:use-module (system foreign)
31 #:use-module ((sdl2 bindings) #:prefix ffi:)
32 #:export (sdl-error-string
33 sdl-error
34 sdl-version
35 sdl-init
36 sdl-quit
37 sdl-ticks
38
39 <color>
40 make-color
41 color?
42 color-r
43 color-g
44 color-b
45 color-a))
46
47 (define %default-init-flags
48 '(timer audio video haptic game-controller events))
49
50 (define (sdl-error-string)
51 "Return the current SDL error string."
52 (pointer->string (ffi:sdl-get-error)))
53
54 (define (sdl-error func message . args)
55 (apply throw 'sdl-error func (string-append message ": ~A")
56 (append args (list (sdl-error-string)))))
57
58 (define (sdl-version)
59 "Return a three element list containing the major, minor, and patch
60 version of the linked SDL library."
61 (let ((bv (make-u8vector 3)))
62 (ffi:sdl-get-version (bytevector->pointer bv))
63 (u8vector->list bv)))
64
65 (define* (sdl-init #:optional (subsystems %default-init-flags))
66 "Initialize the SDL library. This must be called before using any
67 other SDL procedure.
68
69 SUBSYSTEMS is an optional list of symbols that specifies the
70 subsystems to initialize. All subsystems are initialized by default.
71 The possible flags are 'timer', 'audio', 'video', 'haptic',
72 'game-controller', and 'events'."
73 (let ((flags (apply logior
74 (map (match-lambda
75 ('timer ffi:SDL_INIT_TIMER)
76 ('audio ffi:SDL_INIT_AUDIO)
77 ('video ffi:SDL_INIT_VIDEO)
78 ('haptic ffi:SDL_INIT_HAPTIC)
79 ('game-controller ffi:SDL_INIT_GAMECONTROLLER)
80 ('events ffi:SDL_INIT_EVENTS))
81 subsystems))))
82 (unless (zero? (ffi:sdl-init flags))
83 (sdl-error "sdl-init" "failed to initialize subsystems ~S"
84 subsystems))))
85
86 (define (sdl-quit)
87 "Quit all activated SDL subsystems. This procedure should be called
88 upon all exit conditions."
89 (ffi:sdl-quit))
90
91 (define (sdl-ticks)
92 "Return the number of milliseconds since the SDL library
93 initialization."
94 (ffi:sdl-get-ticks))
95
96 ;; SDL_Color
97 (define-record-type <color>
98 (make-color r g b a)
99 color?
100 (r color-r)
101 (g color-g)
102 (b color-b)
103 (a color-a))
104
105 (define (color->struct color)
106 "Convert COLOR into a foreign struct."
107 (match color
108 (($ <color> r g b a)
109 (make-c-struct ffi:sdl-color (list r g b a)))))