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

Last change on this file since 25842 was 25842, checked in by felix winkelmann, 9 years ago

added kitaaba (work in progress, far from finished)

  • Property svn:executable set to *
File size: 5.2 KB
Line 
1;;;; sdl.scm
2
3
4(foreign-declare #<<EOF
5
6#include <SDL/SDL.h>
7#include <SDL/SDL_ttf.h>
8
9#ifdef _WIN32
10#include <windows.h>
11#endif
12
13SDL_Event event;
14
15EOF
16)
17
18
19(define-enum event-type-code event-code-type
20  NOEVENT
21  ACTIVEEVENT
22  KEYDOWN
23  KEYUP
24  MOUSEMOTION
25  MOUSEBUTTONDOWN
26  MOUSEBUTTONUP
27  (QUIT 12)
28  (VIDEORESIZE 16)
29  VIDEOEXPOSE)
30
31(define-enum modifier-key-code modifier-key-name
32  (SHIFT #x0003)
33  (CTRL #x00c0)
34  (ALT #x0300))
35
36
37(define screen #f)                      ; POINTER
38(define font #f)                        ; POINTER
39
40
41(define (open-font ttf size)
42  (set! font
43    ((foreign-lambda* c-pointer ((c-string name) (int size))
44       "return(TTF_OpenFont(name, size));")
45     ttf size))
46  (set! char-width
47    ((foreign-lambda* int ((c-pointer fnt))
48       "int w, h;"
49       "TTF_SizeText((TTF_Font *)fnt, \"_\", &w, &h);"
50       "return(w);")
51     font))
52  (set! line-height size))              ;XXX configurable
53
54;;XXX use indexed color mode
55(define (open-screen w h)
56  (set! screen
57    ((foreign-lambda* c-pointer ((int w) (int h))
58       "SDL_Init(SDL_INIT_EVERYTHING | SDL_INIT_NOPARACHUTE);"
59       "TTF_Init();"
60       "SDL_EnableKeyRepeat(SDL_DEFAULT_REPEAT_DELAY, SDL_DEFAULT_REPEAT_INTERVAL);"
61       "SDL_EnableUNICODE(1);"
62       "return(SDL_SetVideoMode(w, h, 8, SDL_RESIZABLE));")
63     w h))
64  (print "h: " (surface-height screen)))
65
66(define (resize-screen w h)
67  (set! screen
68    ((foreign-lambda* c-pointer ((int w) (int h))
69       "return(SDL_SetVideoMode(w, h, 8, SDL_RESIZABLE));")
70     w h))
71  (print "h: " (surface-height screen)))
72
73(define release-surface
74  (foreign-lambda void "SDL_FreeSurface" c-pointer))
75
76(define flip 
77  (foreign-lambda void "SDL_Flip" c-pointer))
78
79(define (blit ptr x y)
80  ((foreign-lambda* void ((c-pointer bmp) (c-pointer dest) (int x) (int y))
81     "SDL_Rect r;"
82     "r.x = x; r.y = y;"
83     "SDL_BlitSurface(bmp, NULL, dest, &r);")
84   ptr screen x y))
85
86(define (render-ucs-text str r g b)
87  ((foreign-lambda* c-pointer ((u16vector str) (c-pointer font)
88                               (int r) (int g) (int b))
89     "SDL_Color c;"
90     "c.r = r; c.g = g; c.b = b;"
91     "return(TTF_RenderUNICODE_Blended(font, str, c));")
92   str font r g b))
93
94(define (render-ucs-text/plain str r g b)
95  ((foreign-lambda* c-pointer ((u16vector str) (c-pointer font)
96                               (int r) (int g) (int b))
97     "SDL_Color c;"
98     "c.r = r; c.g = g; c.b = b;"
99     "return(TTF_RenderUNICODE_Solid(font, str, c));")
100   str font r g b))
101
102(define (render-utf8-text str r g b)
103  ((foreign-lambda* c-pointer ((c-string str) (c-pointer font)
104                               (int r) (int g) (int b))
105     "SDL_Color c;"
106     "c.r = r; c.g = g; c.b = b;"
107     "return(TTF_RenderUTF8_Blended(font, str, c));")
108   str font r g b))
109
110(define surface-width
111  (foreign-lambda* int ((c-pointer bmp)) "return(((SDL_Surface *)bmp)->w);"))
112
113(define surface-height
114  (foreign-lambda* int ((c-pointer bmp)) "return(((SDL_Surface *)bmp)->h);"))
115
116(define get-next-event
117  (foreign-lambda* bool ()
118    "return(SDL_WaitEvent(&event));"))
119
120(define peek-event
121  (foreign-lambda* bool ()
122    "return(SDL_PollEvent(&event));"))
123
124(define event-type
125  (foreign-lambda* int () "return(event.type);"))
126
127(define event-x
128  (foreign-lambda* int ()
129    "switch(event.type) {"
130    "case SDL_MOUSEMOTION: return(event.motion.x);"
131    "case SDL_MOUSEBUTTONDOWN:"
132    "case SDL_MOUSEBUTTONUP: return(event.button.x);"
133    "default: return(0);}"))
134
135(define event-y
136  (foreign-lambda* int ()
137    "switch(event.type) {"
138    "case SDL_MOUSEMOTION: return(event.motion.y);"
139    "case SDL_MOUSEBUTTONDOWN:"
140    "case SDL_MOUSEBUTTONUP: return(event.button.y);"
141    "default: return(0);}"))
142
143(define event-w
144  (foreign-lambda* int ()
145    "switch(event.type) {"
146    "case SDL_VIDEORESIZE: return(event.resize.w);"
147    "default: return(0);}"))
148
149(define event-h
150  (foreign-lambda* int ()
151    "switch(event.type) {"
152    "case SDL_VIDEORESIZE: return(event.resize.h);"
153    "default: return(0);}"))
154
155(define event-key-scancode
156  (foreign-lambda* int ()
157    "switch(event.type) {"
158    "case SDL_KEYDOWN:"
159    "case SDL_KEYUP: return(event.key.keysym.scancode);"
160    "default: return(0);}"))
161
162(define event-key-code
163  (foreign-lambda* int ()
164    "switch(event.type) {"
165    "case SDL_KEYDOWN:"
166    "case SDL_KEYUP: return(event.key.keysym.sym);"
167    "default: return(0);}"))
168
169(define event-key-unicode
170  (foreign-lambda* int ()
171    "switch(event.type) {"
172    "case SDL_KEYDOWN:"
173    "case SDL_KEYUP: return(event.key.keysym.unicode);"
174    "default: return(0);}"))
175
176(define event-modifier-keys
177  (foreign-lambda* int ()
178    "int c;"
179    "switch(event.type) {"
180    "case SDL_KEYDOWN:"
181    "case SDL_KEYUP:"
182    "c = (int)event.key.keysym.mod & 0x0fff;" ; this seems to be the case on Windows
183    "c |= (c & KMOD_CTRL) ? KMOD_CTRL : 0;"
184    "c |= (c & KMOD_SHIFT) ? KMOD_SHIFT : 0;"
185    "c |= (c & KMOD_ALT) ? KMOD_ALT : 0;"
186    "return(c);"
187    "default: return(0);}"))
188
189(define event-button
190  (foreign-lambda* int ()
191    "switch(event.type) {"
192    "case SDL_MOUSEBUTTONDOWN:"
193    "case SDL_MOUSEBUTTONUP: return(event.button.button);"
194    "default: return(0);}"))
195
196(define fill
197  (foreign-lambda* void ((c-pointer bmp) (int x) (int y) (int w) (int h)
198                         (int r) (int g) (int b))
199    "SDL_Rect re;"
200    "Uint32 c = SDL_MapRGB(((SDL_Surface *)bmp)->format, r, g, b);"
201    "re.x = x; re.y = y; re.w = w; re.h = h;"
202    "SDL_FillRect(bmp, &re, c);"))
Note: See TracBrowser for help on using the repository browser.