Bump version to 0.1.2.
[guile-sdl2.git] / sdl2.scm
CommitLineData
9ce20c40
DT
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)
08224302 29 #:use-module (srfi srfi-9)
9ce20c40
DT
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
313e28f1 36 sdl-quit
08224302
DT
37 sdl-ticks
38
39 <color>
40 make-color
41 color?
42 color-r
43 color-g
44 color-b
45 color-a))
9ce20c40
DT
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
60version 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
67other SDL procedure.
68
69SUBSYSTEMS is an optional list of symbols that specifies the
70subsystems to initialize. All subsystems are initialized by default.
71The 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
88upon all exit conditions."
89 (ffi:sdl-quit))
313e28f1
DT
90
91(define (sdl-ticks)
92 "Return the number of milliseconds since the SDL library
93initialization."
94 (ffi:sdl-get-ticks))
08224302
DT
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)))))