Tagged: sdl

September 18, 2010

Using Gambit Scheme on Windows with SDL and OpenGL

As you can see from past posts, I usually develop software within a GNU/Linux environment. However, I do recognize the importance of being able to target Windows for binaries. Here’s a quick rundown of what you need to do to compile a quick test using Gambit Scheme, OpenGL SDL and SDL_image on Windows 7.

Step 1: MinGW

Download mingw-get-inst-20100909.exe from here (look in the Automated MinGW Installer\mingw-get-inst\mingw-get-insta-20100909 sub-folder). When running the installer, I used the “Use pre-packaged repository catalogues” option, put the files in C:\MinGW and insalled these components: C Compiler, C++ Compiler, MSYS Basic System and MinGW Developer ToolKit. Maybe other ways to setup MinGW work — I’m not a MinGW expert.

This gets you a basic gcc setup from which you can compile software in Windows. It also comes with a shell to make you feel a little more at home — if you’re used to Unix, that is. Gambit needs gcc to create binaries too.

Step 2: Gambit Scheme

Get the installer from Gambit’s main page. Install the software with default settings. Quick and painless.

The next few steps install dependencies for SDL and SDL_image.

Step 3: ZLib

Download zlib125.zip source code from the website. Unzip the source code, open up a MinGW shell (accessible from the Windows start menu), “cd” into the source directory and execute:

$ make -f win32/Makefile.gcc

After the compile is done, copy the static libraries to user local from within the MinGW shell

$ cp -iv zconf.h zlib.h /usr/local/include/

`zconf.h' -> `/usr/local/include/zconf.h'
`zlib.h' -> `/usr/local/include/zlib.h'

$ cp -iv libz.a /usr/local/lib
`libz.a' -> `/usr/local/lib/libz.a'

Step 4: Libpng

Download libpng source code from the website. Make sure to get the .tar.gz version so that the configure scripts are included (libpng-1.4.3.tar.gz). In a MinGW shell, extract the source code, “cd” into the directory and execute:

$ configure --disable-shared --enable-static CFLAGS="-I/usr/local/include" LDFLAGS="-L/usr/local/lib"

This builds only static libraries, which is what we’ll use for now. This way you do not have to mess with making sure DLLs can be found. The CFLAGS and LDFLAGS setting help the configure script find zlib and other libraries we will be building.

Complete the build by executing:

$ make

and then

$ make install

Step 5: JPEG library

Download the jpegsrc.v8b.tar.gz source code package from the website. In a MinGW shell, extract the source code, “cd” into the directory and execute:

$ configure --disable-shared --enable-static CFLAGS="-I/usr/local/include" LDFLAGS="-L/usr/local/lib"

Again, we’re only building the static libraries. Follow this up with:

$ make

and

$ make install

Step 6: SDL

Download the SDL-1.2.14.zip source code from the website. In a MinGW shell, extract the source code, “cd” into the directory and execute:

$ configure --disable-shared --enable-static CFLAGS="-I/usr/local/include" LDFLAGS="-L/usr/local/lib"

Again, follow this up with:

$ make

and

$ make install

With SDL installed, you should be able to execute the “sdl-config” program in the shell to access what flags to use while compiling software. With what I’ve built so far, here’s the output of sdl-config for me:

$ sdl-config --cflags
-I/usr/local/include/SDL -D_GNU_SOURCE=1 -Dmain=SDL_main

$ sdl-config --libs
-L/usr/local/lib -lmingw32 -lSDLmain -lSDL -mwindows -liconv -lm -luser32 -lgdi32 -lwinmm

$ sdl-config --static-libs
-L/usr/local/lib -lmingw32 -lSDLmain -lSDL -mwindows -liconv -lm -luser32 -lgdi32 -lwinmm

Step 7: SDL_image

1 Download SDL_image-1.2.10.zip source code from the website. For my quick test, I’m only going to enable the png and jpeg support libraries (built in steps 4 and 5 above). This means the tiff format will not be supported, but if this is important to you there is a library for that as well. In a MinGW shell, extract the source code, “cd” into the directory and execute:

$ configure --disable-shared --enable-static --enable-jpg --enable-png CFLAGS="-I/usr/local/include" LDFLAGS="-L/usr/local/lib"

followed by

$ make

and

$ make install

Step 8: Test Time!

Use the code from this post of mine (download from here). Save the test-03.scm and water-128×128.png files to a directory, run a MinGW shell, “cd” to this directory and compile the scheme source code with the Gambit compiler like this:

$ gsc -cc-options "-I/usr/local/include/SDL/" -ld-options "-L/usr/local/lib/ -lmingw32 -lSDLmain -lSDL -mwindows -liconv -lm -luser32 -lgdi32 -lwinmm -lopengl32 -lSDL_image -lpng -ljpeg -lz" -exe test-03.scm

This should produce a “test-03.exe” file that has all of the files statically linked.

Now, there are legal ramifications of static linking SDL, SDL_image and other LGPL projects. Essentially, you have to provide a way for the user to relink your project which essentially means you cannot use it in closed source applications. The fix for that is to dynamically link the software.

Extra: How to dynamically link?

Zlib, libpng and libjpeg can all be linked statically without any repercussions per their respective licenses. This means we just have SDL and SDL_image to worry about.

Within the MinGW shell, change directories to the SDL library source code and run:

$ make uninstall

$ make clean

$ configure --enable-shared --disable-static CFLAGS="-I/usr/local/include" LDFLAGS="-L/usr/local/lib"

Copy SDL.dll from C:\MinGW\msys\1.0\local\bin\SDL.dll to the test directory where test-03.scm is compiled.

For the SDL_image library, within the shell, change directories to the SDL_image library source code and run:

make uninstall

make clean

$ configure --enable-shared --disable-static --enable-png --enable-jpg CFLAGS="-I/usr/local/include" LDFLAGS="-L/usr/local/lib"

Copy SDL_image.dll from C:\MinGW\msys\1.0\local\bin\SDL.dll to test directory. This DLL depends on SDL.dll which was already copied.

Now recompile the code with gambit using a simplified command:

$ gsc -cc-options "-I/usr/local/include/SDL/" -ld-options "-L/usr/local/lib/ -lmingw32 -lSDLmain -lSDL -lopengl32 -lSDL_image" -exe test-03.scm

This should produce a slightly lighter executable (2.65 MB stripped, 3.29 MB unstripped) that only needs the SDL and SDL_image DLL files next to it.

July 22, 2010

Brief FFI tutorial for Gambit Scheme and SDL

This brief post will show how to create a “Hello World” type application using SDL and Gambit scheme under Linux. Knowledge of the Scheme programming language is assumed.

The Gambit scheme system is a popular scheme-to-c compiler that produces fast, native executables. I’m new to it. In the past I’ve used Chicken scheme and Racket (formerly known as plt-scheme) to implement web servers. There were things that I disliked about them, so I decided to try something new.

My current programming interest is video game development. I know Gambit has been used for this. It has even been used to create iPhone apps! Ypsilon is said to be good for game development, but it looks like development on it has stalled. The OpenGL interface it supported is only version 1.x as well. While the OpenGL interfaces available for Gambit are not any better, the system is still under active development has has a great reputation.

Enough with the miscellany. Gambit provides an easy to use FFI that makes calling foreign libraries relatively painless. When defining Gambit scheme lambdas that wrap c library functions, remember that the compiler will make a c file from the scheme file. You can opt to include code as-is into this intermediate c file. At a bare minimum, this will likely need to be an include directive pointing to the library header file.

(c-declare "#include \"SDL.h\"")

Without this, the c compiler won’t be able to find the functions we’re going to reference from SDL.

Lets start with a simple example of how to wrap a c function. SDL_Quit is called to shutdown SDL. It does not take arguments and does not return a value. In Gambit, you’d wrap it like this:

(define sdl-quit (c-lambda () void "SDL_Quit"))

This defines a function called sdl-quit and maps it to the c function SDL_Quit using the c-lambda special form of Gambit. Because there are no arguments or return value, no conversions take place. Because we used a c-declare to force a c #include to SDL.h, the c compiler will be able to find the declaration to this function.

Before using the SDL library, you need to initialize it. This is done by calling SDL_Init. In Gambit scheme, you wrap this function like this:

(define sdl-init (c-lambda (unsigned-int32) int "SDL_Init"))

This defines a function in scheme called sdl-init — the body of which is again a call to c-lambda special form. When this is invoked, it converts the arguments to their corresponding c type, as defined in the special form, and then passes them to the c function specified. The returned value from the c function will be converted into a scheme type and given as the result.

For sdl-init, the c function SDL_Init is wrapped that returns an integer and takes a single argument that is an unsigned 32 bit integer. The unsigned integer argument is actually one of the values defined in SDL.h. These do not have to be wrapped and can just be defined as numbers in scheme.

(define sdl-init-timer       #x00000001)
(define sdl-init-audio       #x00000010)
(define sdl-init-video       #x00000020)
(define sdl-init-cdrom       #x00000100)
(define sdl-init-joystick    #x00000200)
(define sdl-init-noparachute #x00100000)
(define sdl-init-eventthread #x01000000)
(define sdl-init-everything #x0000FFFF)

Creating a window in SDL involves a call to SDL_SetVideoMode.

(define sdl-set-video-mode (c-lambda (int int int unsigned-int32) (pointer "SDL_Surface") "SDL_SetVideoMode"))

For this function four arguments are converted to their c types and the return type is a pointer to a SDL_Surface instance. Once this is called, a call to SDL_WM_SetCaption will set the window caption.

(define sdl-wm-set-caption (c-lambda (char-string char-string) void "SDL_WM_SetCaption"))

Here’s a simple example that includes the above definitions and simply invokes them with basic parameters to create a SDL window, show it for five seconds, then quit.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

(c-declare "#include \"SDL.h\"")

;;; SDL Constants ;;;
(define sdl-init-timer       #x00000001)
(define sdl-init-audio       #x00000010)
(define sdl-init-video       #x00000020)
(define sdl-init-cdrom       #x00000100)
(define sdl-init-joystick    #x00000200)
(define sdl-init-noparachute #x00100000)
(define sdl-init-eventthread #x01000000)
(define sdl-init-everything #x0000FFFF)

;;; SDL Functions ;;;
(define sdl-quit (c-lambda () void "SDL_Quit"))
(define sdl-init (c-lambda (unsigned-int32) int "SDL_Init"))
(define sdl-set-video-mode (c-lambda (int int int unsigned-int32) (pointer "SDL_Surface") "SDL_SetVideoMode"))
(define sdl-wm-set-caption (c-lambda (char-string char-string) void "SDL_WM_SetCaption"))

;;; simple program to create a window and display it for five seconds ;;;

(sdl-init sdl-init-everything)
(sdl-set-video-mode 640 480 32 0)
(sdl-wm-set-caption "Test" "Test Window!")
(thread-sleep! 5)
(sdl-quit)

If the above code was put into a file called test.scm, it can be compile into an executable in Linux with Gambit like this:

gsc -cc-options "-I/usr/include/SDL -D_GNU_SOURCE=1 -D_REENTRANT" -ld-options "-L/usr/lib -lSDL" -exe test.scm

This invokes the Gambit compiler passing include and linker paths to gcc. You may need to adjust them on your system. The “-exe” option is what tells Gambit to produce an executable. If you omit this option, you’ll just end up with a file called test.o1, which is just an object file.

If you’re curious about the c code generated by the compiler, you can pass the “-c” flag instead of “-exe” and it will generate a test.c file. On my Ubuntu 10.04 system with Gambit 4.6.0, this is produced:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490

#ifdef ___LINKER_INFO
; File: "test.c", produced by Gambit-C v4.6.0
(
406000
" test"
(" test")
(
"SDL_Surface*"
)
(
)
(
" test"
" test#0"
" test#1"
" test#2"
" test#3"
"sdl-init"
"sdl-init-everything"
"sdl-quit"
"sdl-set-video-mode"
"sdl-wm-set-caption"
)
(
"sdl-init-audio"
"sdl-init-cdrom"
"sdl-init-eventthread"
"sdl-init-joystick"
"sdl-init-noparachute"
"sdl-init-timer"
"sdl-init-video"
)
(
"thread-sleep!"
)
#f
)
#else
#define ___VERSION 406000
#define ___MODULE_NAME " test"
#define ___LINKER_ID ____20_test
#define ___MH_PROC ___H__20_test
#define ___SCRIPT_LINE 0
#define ___SYM_COUNT 1
#define ___GLO_COUNT 18
#define ___SUP_COUNT 17
#define ___CNS_COUNT 1
#define ___SUB_COUNT 2
#define ___LBL_COUNT 20
#include "gambit.h"

___NEED_SYM(___S_SDL__Surface_2a_)

___NEED_GLO(___G__20_test)
___NEED_GLO(___G__20_test_23_0)
___NEED_GLO(___G__20_test_23_1)
___NEED_GLO(___G__20_test_23_2)
___NEED_GLO(___G__20_test_23_3)
___NEED_GLO(___G_sdl_2d_init)
___NEED_GLO(___G_sdl_2d_init_2d_audio)
___NEED_GLO(___G_sdl_2d_init_2d_cdrom)
___NEED_GLO(___G_sdl_2d_init_2d_eventthread)
___NEED_GLO(___G_sdl_2d_init_2d_everything)
___NEED_GLO(___G_sdl_2d_init_2d_joystick)
___NEED_GLO(___G_sdl_2d_init_2d_noparachute)
___NEED_GLO(___G_sdl_2d_init_2d_timer)
___NEED_GLO(___G_sdl_2d_init_2d_video)
___NEED_GLO(___G_sdl_2d_quit)
___NEED_GLO(___G_sdl_2d_set_2d_video_2d_mode)
___NEED_GLO(___G_sdl_2d_wm_2d_set_2d_caption)
___NEED_GLO(___G_thread_2d_sleep_21_)

___BEGIN_SYM1
___DEF_SYM1(0,___S_SDL__Surface_2a_,"SDL_Surface*")
___END_SYM1

___BEGIN_GLO
___DEF_GLO(0," test")
___DEF_GLO(1," test#0")
___DEF_GLO(2," test#1")
___DEF_GLO(3," test#2")
___DEF_GLO(4," test#3")
___DEF_GLO(5,"sdl-init")
___DEF_GLO(6,"sdl-init-audio")
___DEF_GLO(7,"sdl-init-cdrom")
___DEF_GLO(8,"sdl-init-eventthread")
___DEF_GLO(9,"sdl-init-everything")
___DEF_GLO(10,"sdl-init-joystick")
___DEF_GLO(11,"sdl-init-noparachute")
___DEF_GLO(12,"sdl-init-timer")
___DEF_GLO(13,"sdl-init-video")
___DEF_GLO(14,"sdl-quit")
___DEF_GLO(15,"sdl-set-video-mode")
___DEF_GLO(16,"sdl-wm-set-caption")
___DEF_GLO(17,"thread-sleep!")
___END_GLO

___BEGIN_CNS
___DEF_CNS(___REF_SYM(0,___S_SDL__Surface_2a_),___REF_NUL)
___END_CNS

___DEF_SUB_STR(___X0,12)
___STR8(84,101,115,116,32,87,105,110)
___STR4(100,111,119,33)
___DEF_SUB_STR(___X1,4)
___STR4(84,101,115,116)

___BEGIN_SUB
___DEF_SUB(___X0)
,___DEF_SUB(___X1)
___END_SUB

#define ___C_OBJ_0 ___CNS(0)

#include "SDL.h"

#undef ___MD_ALL
#define ___MD_ALL ___D_FP ___D_R0 ___D_R1 ___D_R2 ___D_R3 ___D_R4
#undef ___MR_ALL
#define ___MR_ALL ___R_FP ___R_R0 ___R_R1 ___R_R2 ___R_R3 ___R_R4
#undef ___MW_ALL
#define ___MW_ALL ___W_FP ___W_R0 ___W_R1 ___W_R2 ___W_R3 ___W_R4
___BEGIN_M_COD
___BEGIN_M_HLBL
___DEF_M_HLBL_INTRO
___DEF_M_HLBL(___L0__20_test)
___DEF_M_HLBL(___L1__20_test)
___DEF_M_HLBL(___L2__20_test)
___DEF_M_HLBL(___L3__20_test)
___DEF_M_HLBL(___L4__20_test)
___DEF_M_HLBL(___L5__20_test)
___DEF_M_HLBL(___L6__20_test)
___DEF_M_HLBL_INTRO
___DEF_M_HLBL(___L0__20_test_23_0)
___DEF_M_HLBL(___L1__20_test_23_0)
___DEF_M_HLBL_INTRO
___DEF_M_HLBL(___L0__20_test_23_1)
___DEF_M_HLBL(___L1__20_test_23_1)
___DEF_M_HLBL_INTRO
___DEF_M_HLBL(___L0__20_test_23_2)
___DEF_M_HLBL(___L1__20_test_23_2)
___DEF_M_HLBL_INTRO
___DEF_M_HLBL(___L0__20_test_23_3)
___DEF_M_HLBL(___L1__20_test_23_3)
___END_M_HLBL

___BEGIN_M_SW

#undef ___PH_PROC
#define ___PH_PROC ___H__20_test
#undef ___PH_LBL0
#define ___PH_LBL0 1
#undef ___PD_ALL
#define ___PD_ALL ___D_FP ___D_R0 ___D_R1 ___D_R2 ___D_R3 ___D_R4
#undef ___PR_ALL
#define ___PR_ALL ___R_FP ___R_R0 ___R_R1 ___R_R2 ___R_R3 ___R_R4
#undef ___PW_ALL
#define ___PW_ALL ___W_FP ___W_R0 ___W_R1 ___W_R2 ___W_R3 ___W_R4
___BEGIN_P_COD
___BEGIN_P_HLBL
___DEF_P_HLBL_INTRO
___DEF_P_HLBL(___L0__20_test)
___DEF_P_HLBL(___L1__20_test)
___DEF_P_HLBL(___L2__20_test)
___DEF_P_HLBL(___L3__20_test)
___DEF_P_HLBL(___L4__20_test)
___DEF_P_HLBL(___L5__20_test)
___DEF_P_HLBL(___L6__20_test)
___END_P_HLBL
___BEGIN_P_SW
___DEF_SLBL(0,___L0__20_test)
___IF_NARGS_EQ(0,___NOTHING)
___WRONG_NARGS(0,0,0,0)
___DEF_GLBL(___L__20_test)
___SET_GLO(12,___G_sdl_2d_init_2d_timer,___FIX(1L))
___SET_GLO(6,___G_sdl_2d_init_2d_audio,___FIX(16L))
___SET_GLO(13,___G_sdl_2d_init_2d_video,___FIX(32L))
___SET_GLO(7,___G_sdl_2d_init_2d_cdrom,___FIX(256L))
___SET_GLO(10,___G_sdl_2d_init_2d_joystick,___FIX(512L))
___SET_GLO(11,___G_sdl_2d_init_2d_noparachute,___FIX(1048576L))
___SET_GLO(8,___G_sdl_2d_init_2d_eventthread,___FIX(16777216L))
___SET_GLO(9,___G_sdl_2d_init_2d_everything,___FIX(65535L))
___SET_GLO(14,___G_sdl_2d_quit,___PRC(9))
___SET_GLO(5,___G_sdl_2d_init,___PRC(12))
___SET_GLO(15,___G_sdl_2d_set_2d_video_2d_mode,___PRC(15))
___SET_GLO(16,___G_sdl_2d_wm_2d_set_2d_caption,___PRC(18))
___SET_STK(1,___R0)
___SET_R1(___GLO(9,___G_sdl_2d_init_2d_everything))
___SET_R0(___LBL(2))
___ADJFP(4)
___POLL(1)
___DEF_SLBL(1,___L1__20_test)
___JUMPGLOSAFE(___SET_NARGS(1),5,___G_sdl_2d_init)
___DEF_SLBL(2,___L2__20_test)
___SET_STK(1,___FIX(640L))
___SET_R3(___FIX(0L))
___SET_R2(___FIX(32L))
___SET_R1(___FIX(480L))
___SET_R0(___LBL(3))
___ADJFP(1)
___JUMPGLOSAFE(___SET_NARGS(4),15,___G_sdl_2d_set_2d_video_2d_mode)
___DEF_SLBL(3,___L3__20_test)
___SET_R2(___SUB(0))
___SET_R1(___SUB(1))
___SET_R0(___LBL(4))
___JUMPGLOSAFE(___SET_NARGS(2),16,___G_sdl_2d_wm_2d_set_2d_caption)
___DEF_SLBL(4,___L4__20_test)
___SET_R1(___FIX(5L))
___SET_R0(___LBL(5))
___JUMPGLOSAFE(___SET_NARGS(1),17,___G_thread_2d_sleep_21_)
___DEF_SLBL(5,___L5__20_test)
___SET_R0(___STK(-3))
___POLL(6)
___DEF_SLBL(6,___L6__20_test)
___ADJFP(-4)
___JUMPGLOSAFE(___SET_NARGS(0),14,___G_sdl_2d_quit)
___END_P_SW
___END_P_COD

#undef ___PH_PROC
#define ___PH_PROC ___H__20_test_23_0
#undef ___PH_LBL0
#define ___PH_LBL0 9
#undef ___PD_ALL
#define ___PD_ALL ___D_FP ___D_R0
#undef ___PR_ALL
#define ___PR_ALL ___R_FP ___R_R0
#undef ___PW_ALL
#define ___PW_ALL ___W_FP ___W_R0
___BEGIN_P_COD
___BEGIN_P_HLBL
___DEF_P_HLBL_INTRO
___DEF_P_HLBL(___L0__20_test_23_0)
___DEF_P_HLBL(___L1__20_test_23_0)
___END_P_HLBL
___BEGIN_P_SW
___DEF_SLBL(0,___L0__20_test_23_0)
___IF_NARGS_EQ(0,___NOTHING)
___WRONG_NARGS(0,0,0,0)
___DEF_GLBL(___L__20_test_23_0)
___SET_STK(1,___R0)
___SET_R0(___LBL(1))
___ADJFP(4)
#define ___NARGS 0
___BEGIN_CFUN_VOID
___BEGIN_CFUN_BODY
#undef ___AT_END
___CFUN_CALL_VOID(SDL_Quit())
#ifndef ___AT_END
#define ___AT_END
#endif
___CFUN_SET_RESULT_VOID
___END_CFUN_BODY
___CFUN_ERROR_VOID
___END_CFUN_VOID
#undef ___NARGS
___JUMPPRM(___NOTHING,___R0)
___DEF_SLBL(1,___L1__20_test_23_0)
___ADJFP(-4)
___JUMPPRM(___NOTHING,___STK(1))
___END_P_SW
___END_P_COD

#undef ___PH_PROC
#define ___PH_PROC ___H__20_test_23_1
#undef ___PH_LBL0
#define ___PH_LBL0 12
#undef ___PD_ALL
#define ___PD_ALL ___D_FP ___D_R0 ___D_R1
#undef ___PR_ALL
#define ___PR_ALL ___R_FP ___R_R0 ___R_R1
#undef ___PW_ALL
#define ___PW_ALL ___W_FP ___W_R0
___BEGIN_P_COD
___BEGIN_P_HLBL
___DEF_P_HLBL_INTRO
___DEF_P_HLBL(___L0__20_test_23_1)
___DEF_P_HLBL(___L1__20_test_23_1)
___END_P_HLBL
___BEGIN_P_SW
___DEF_SLBL(0,___L0__20_test_23_1)
___IF_NARGS_EQ(1,___NOTHING)
___WRONG_NARGS(0,1,0,0)
___DEF_GLBL(___L__20_test_23_1)
___SET_STK(1,___R1)
___SET_STK(2,___R0)
___SET_R0(___LBL(1))
___ADJFP(8)
#define ___NARGS 1
___BEGIN_CFUN(int ___result)
#define ___ARG1 ___CFUN_ARG(1)
___BEGIN_CFUN_ARG(1,___U32 ___arg1)
___BEGIN_CFUN_SCMOBJ_TO_U32(___ARG1,___arg1,1)
___BEGIN_CFUN_BODY
#undef ___AT_END
___CFUN_CALL(___result,SDL_Init(___arg1))
#ifndef ___AT_END
#define ___AT_END
#endif
___BEGIN_CFUN_INT_TO_SCMOBJ(___result,___CFUN_RESULT)
___CFUN_SET_RESULT
___END_CFUN_INT_TO_SCMOBJ(___result,___CFUN_RESULT)
___END_CFUN_BODY
___END_CFUN_SCMOBJ_TO_U32(___ARG1,___arg1,1)
___END_CFUN_ARG(1)
#undef ___ARG1
___CFUN_ERROR
___END_CFUN
#undef ___NARGS
___JUMPPRM(___NOTHING,___R0)
___DEF_SLBL(1,___L1__20_test_23_1)
___ADJFP(-8)
___JUMPPRM(___NOTHING,___STK(2))
___END_P_SW
___END_P_COD

#undef ___PH_PROC
#define ___PH_PROC ___H__20_test_23_2
#undef ___PH_LBL0
#define ___PH_LBL0 15
#undef ___PD_ALL
#define ___PD_ALL ___D_FP ___D_R0 ___D_R1 ___D_R2 ___D_R3
#undef ___PR_ALL
#define ___PR_ALL ___R_FP ___R_R0 ___R_R1 ___R_R2 ___R_R3
#undef ___PW_ALL
#define ___PW_ALL ___W_FP ___W_R0
___BEGIN_P_COD
___BEGIN_P_HLBL
___DEF_P_HLBL_INTRO
___DEF_P_HLBL(___L0__20_test_23_2)
___DEF_P_HLBL(___L1__20_test_23_2)
___END_P_HLBL
___BEGIN_P_SW
___DEF_SLBL(0,___L0__20_test_23_2)
___IF_NARGS_EQ(4,___NOTHING)
___WRONG_NARGS(0,4,0,0)
___DEF_GLBL(___L__20_test_23_2)
___SET_STK(1,___R1)
___SET_STK(2,___R2)
___SET_STK(3,___R3)
___SET_STK(4,___R0)
___SET_R0(___LBL(1))
___ADJFP(7)
#define ___NARGS 4
#define ___result ___CFUN_CAST(SDL_Surface*,___result_voidstar)
___BEGIN_CFUN(void* ___result_voidstar)
#define ___ARG1 ___CFUN_ARG(1)
___BEGIN_CFUN_ARG(1,int ___arg1)
___BEGIN_CFUN_SCMOBJ_TO_INT(___ARG1,___arg1,1)
#define ___ARG2 ___CFUN_ARG(2)
___BEGIN_CFUN_ARG(2,int ___arg2)
___BEGIN_CFUN_SCMOBJ_TO_INT(___ARG2,___arg2,2)
#define ___ARG3 ___CFUN_ARG(3)
___BEGIN_CFUN_ARG(3,int ___arg3)
___BEGIN_CFUN_SCMOBJ_TO_INT(___ARG3,___arg3,3)
#define ___ARG4 ___CFUN_ARG(4)
___BEGIN_CFUN_ARG(4,___U32 ___arg4)
___BEGIN_CFUN_SCMOBJ_TO_U32(___ARG4,___arg4,4)
___BEGIN_CFUN_BODY
#undef ___AT_END
___CFUN_CALL_POINTER(___result_voidstar,SDL_SetVideoMode(___arg1,___arg2,___arg3,___arg4))
#ifndef ___AT_END
#define ___AT_END
#endif
___BEGIN_CFUN_POINTER_TO_SCMOBJ(___result_voidstar,___C_OBJ_0,___RELEASE_POINTER,___CFUN_RESULT)
___CFUN_SET_RESULT
___END_CFUN_POINTER_TO_SCMOBJ(___result_voidstar,___C_OBJ_0,___RELEASE_POINTER,___CFUN_RESULT)
___END_CFUN_BODY
___END_CFUN_SCMOBJ_TO_U32(___ARG4,___arg4,4)
___END_CFUN_ARG(4)
#undef ___ARG4
___END_CFUN_SCMOBJ_TO_INT(___ARG3,___arg3,3)
___END_CFUN_ARG(3)
#undef ___ARG3
___END_CFUN_SCMOBJ_TO_INT(___ARG2,___arg2,2)
___END_CFUN_ARG(2)
#undef ___ARG2
___END_CFUN_SCMOBJ_TO_INT(___ARG1,___arg1,1)
___END_CFUN_ARG(1)
#undef ___ARG1
___CFUN_ERROR
___END_CFUN
#undef ___result
#undef ___NARGS
___JUMPPRM(___NOTHING,___R0)
___DEF_SLBL(1,___L1__20_test_23_2)
___ADJFP(-8)
___JUMPPRM(___NOTHING,___STK(5))
___END_P_SW
___END_P_COD

#undef ___PH_PROC
#define ___PH_PROC ___H__20_test_23_3
#undef ___PH_LBL0
#define ___PH_LBL0 18
#undef ___PD_ALL
#define ___PD_ALL ___D_FP ___D_R0 ___D_R1 ___D_R2
#undef ___PR_ALL
#define ___PR_ALL ___R_FP ___R_R0 ___R_R1 ___R_R2
#undef ___PW_ALL
#define ___PW_ALL ___W_FP ___W_R0
___BEGIN_P_COD
___BEGIN_P_HLBL
___DEF_P_HLBL_INTRO
___DEF_P_HLBL(___L0__20_test_23_3)
___DEF_P_HLBL(___L1__20_test_23_3)
___END_P_HLBL
___BEGIN_P_SW
___DEF_SLBL(0,___L0__20_test_23_3)
___IF_NARGS_EQ(2,___NOTHING)
___WRONG_NARGS(0,2,0,0)
___DEF_GLBL(___L__20_test_23_3)
___SET_STK(1,___R1)
___SET_STK(2,___R2)
___SET_STK(3,___R0)
___SET_R0(___LBL(1))
___ADJFP(8)
#define ___NARGS 2
___BEGIN_CFUN_VOID
#define ___ARG1 ___CFUN_ARG(1)
___BEGIN_CFUN_ARG(1,char* ___arg1)
___BEGIN_CFUN_SCMOBJ_TO_CHARSTRING(___ARG1,___arg1,1)
#define ___ARG2 ___CFUN_ARG(2)
___BEGIN_CFUN_ARG(2,char* ___arg2)
___BEGIN_CFUN_SCMOBJ_TO_CHARSTRING(___ARG2,___arg2,2)
___BEGIN_CFUN_BODY_CLEANUP
#undef ___AT_END
___CFUN_CALL_VOID(SDL_WM_SetCaption(___arg1,___arg2))
#ifndef ___AT_END
#define ___AT_END
#endif
___CFUN_SET_RESULT_VOID
___END_CFUN_BODY_CLEANUP
___END_CFUN_SCMOBJ_TO_CHARSTRING(___ARG2,___arg2,2)
___END_CFUN_ARG(2)
#undef ___ARG2
___END_CFUN_SCMOBJ_TO_CHARSTRING(___ARG1,___arg1,1)
___END_CFUN_ARG(1)
#undef ___ARG1
___CFUN_ERROR_CLEANUP_VOID
___END_CFUN_VOID
#undef ___NARGS
___JUMPPRM(___NOTHING,___R0)
___DEF_SLBL(1,___L1__20_test_23_3)
___ADJFP(-8)
___JUMPPRM(___NOTHING,___STK(3))
___END_P_SW
___END_P_COD

___END_M_SW
___END_M_COD

___BEGIN_LBL
___DEF_LBL_INTRO(___H__20_test," test",___REF_FAL,7,0)
,___DEF_LBL_PROC(___H__20_test,0,0)
,___DEF_LBL_RET(___H__20_test,___IFD(___RETI,4,0,0x3f1L))
,___DEF_LBL_RET(___H__20_test,___IFD(___RETN,1,0,0x1L))
,___DEF_LBL_RET(___H__20_test,___IFD(___RETN,1,0,0x1L))
,___DEF_LBL_RET(___H__20_test,___IFD(___RETN,1,0,0x1L))
,___DEF_LBL_RET(___H__20_test,___IFD(___RETN,1,0,0x1L))
,___DEF_LBL_RET(___H__20_test,___IFD(___RETI,4,4,0x3f0L))
,___DEF_LBL_INTRO(___H__20_test_23_0," test#0",___REF_FAL,2,0)
,___DEF_LBL_PROC(___H__20_test_23_0,0,0)
,___DEF_LBL_RET(___H__20_test_23_0,___IFD(___RETN,1,0,0x1L))
,___DEF_LBL_INTRO(___H__20_test_23_1," test#1",___REF_FAL,2,0)
,___DEF_LBL_PROC(___H__20_test_23_1,1,0)
,___DEF_LBL_RET(___H__20_test_23_1,___IFD(___RETN,2,1,0x3L))
,___DEF_LBL_INTRO(___H__20_test_23_2," test#2",___REF_FAL,2,0)
,___DEF_LBL_PROC(___H__20_test_23_2,4,0)
,___DEF_LBL_RET(___H__20_test_23_2,___IFD(___RETN,5,4,0x1fL))
,___DEF_LBL_INTRO(___H__20_test_23_3," test#3",___REF_FAL,2,0)
,___DEF_LBL_PROC(___H__20_test_23_3,2,0)
,___DEF_LBL_RET(___H__20_test_23_3,___IFD(___RETN,3,2,0x7L))
___END_LBL

___BEGIN_MOD1
___DEF_PRM(0,___G__20_test,1)
___DEF_PRM(1,___G__20_test_23_0,9)
___DEF_PRM(2,___G__20_test_23_1,12)
___DEF_PRM(3,___G__20_test_23_2,15)
___DEF_PRM(4,___G__20_test_23_3,18)
___END_MOD1

___BEGIN_MOD2
___DEF_SYM2(0,___S_SDL__Surface_2a_,"SDL_Surface*")
___END_MOD2

#endif

Yikes! I’m glad the compiler can make sense of that.

With the above command line to compile the sample, a 5.2 MB dynamically-linked executable is produced which strips down to 4.5 MB.

http://www.libsdl.org/cgi/docwiki.cgi/SDL_SetVideoMode

April 26, 2010

Simple math and JSON in Haskell – (SDL game series part 4)

(This is part 4 in a series of blog posts.)

There’s been a lot of changes in the project since part 3. The project has been officially renamed to Exit Strategy and the source code is hosted on github. The game mechanics have been prototyped with wet-erase hex mat and seem to work okay. I’ve managed to successfully build the project in Windows. The basic functionality of the map editor is now complete.

Since the source code of the project is now too unwieldy to post into a single entry, I’ll stick to covering things that I think are useful. Any code posted is released under GPLv3 like the project itself and should correspond to the 0.0.3 version as tagged on github.

Simple math in Haskell

Someone new to Haskell might get a bit upset when they do something like this:

timothy@angry:~/projects/exitstrategy$ ghci
GHCi, version 6.12.1: http://www.haskell.org/ghc/ :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Prelude> let test = 64
Prelude> test
64
Prelude> test / 4

<interactive>:1:0:
No instance for (Fractional Integer)
arising from a use of `/' at <interactive>:1:0-7
Possible fix: add an instance declaration for (Fractional Integer)
In the expression: test / 4
In the definition of `it': it = test / 4
Prelude>

This leaves a bad impression. How can it not not be able to divide 64 by 4 without error?! When I seen that, I started questioning whether or not Haskell was the language for me.

However, as with a lot of things in Haskell, the reason for this boils down to types. And the types are set up so that you have to be specific with the type of math you’re trying to perform. While a little more painful to learn up front, it really does root out a lot of errors that might have slipped by in other languages.

Here are two useful links about basic math operations: a gentle introduction to Haskell: numbers, and converting numbers.

Lets look at a real example. This is part of the calcCoordinate function from Editor.lhs. It takes the height and width of the graphic tiles and a mouse cursor point and returns a game map location. Basically, it takes the mouse cursor position and finds the corresponding hex-grid map location. The algorithm is complicated by the shape of the hexagon as opposed to simple square grids.

> calcCoordinate :: Int -> Int -> Point -> Point
> calcCoordinate tileW tileH (mx, my) = (flatX + diffX + 1, flatY + diffY + 1)
> where
> halfW = quot tileW 2
> scaleH = round $ toRational tileH * 3 / 4
> flatY = quot my scaleH
> offsetX = if even flatY
> then halfW
> else 0
> modifiedMx = mx - offsetX
> flatX = quot modifiedMx tileW
[...]

You can see that halfW is defined with the quot function. This performs integer division and returns and integer result. Already we can repeat the initial experiment using quot instead of (/).

In scaleH, toRational is used to convert tileH to a rational number before doing the multiplication and division. By doing this, division can be be performed without the missing Fractional Integer instance error.

Another useful function is fromIntegral. An example how I used it is in the checkEvent function from Editor.lhs. In this function, the SDL.MouseMotion event is handled. The event is given four parameters: two Word16 objects and then two Int16 objects.

[...]
> SDL.MouseMotion x y xr yr -> do
> if elem SDL.ButtonRight $ uiMouseButtonsDown ui
> then eventLoop $ rightMouseBMHandler ui
> (fromIntegral xr)
> (fromIntegral yr)
[...]
> rightMouseBMHandler :: UIState -> Int -> Int -> UIState
[...]

Passing the Int16 parameters xr and yr to rightMuseBMHandler unchanged — without the call to fromIntegral — will result in a type error:

timothy@angry:~/projects/exitstrategy$ cabal build
Preprocessing executables for ExitStrategy-0.0.3...
Building ExitStrategy-0.0.3...
[6 of 6] Compiling Main ( Editor.lhs, dist/build/exitstrategy-editor/exitstrategy-editor-tmp/Main.o )

Editor.lhs:346:58:
Couldn't match expected type `Int'
against inferred type `GHC.Int.Int16'
In the second argument of `rightMouseBMHandler', namely `xr'
In the second argument of `($)', namely
`rightMouseBMHandler ui xr yr'
In the expression: eventLoop $ rightMouseBMHandler ui xr yr

The use of fromIntegral solves this problem.

Using JSON to serialize data

Incorporating the Text.JSON module is fairly easy. As shown in Magnus’s blog, the boilerplate code can be generated automatically if all that needs to be done is encoding the data type to JSON.

My data types and JSON instances to read and write the game map are very straight forward. The code is lifted from GameMap.lhs.

> import Text.JSON
> import qualified Data.Map as DMap

[...]

> data GameMap = GameMap
> {
> gmFileVersion :: Int,
> gmHeight :: Int,
> gmWidth :: Int,
> gmTileSetName :: String,
> gmLocations :: DMap.Map Point GameMapLoc
> } deriving (Eq, Show)

> data GameMapLoc = GameMapLoc
> {
> gmlTileName :: String
> } deriving (Eq, Show)

> instance JSON GameMap where
> showJSON gm = makeObj
> [ ("version", showJSON $ gmFileVersion gm)
> , ("height", showJSON $ gmHeight gm)
> , ("width", showJSON $ gmWidth gm)
> , ("tileSetName", showJSON $ gmTileSetName gm)
> , ("locations", showJSON $ gmLocations gm)
> ]
>
> readJSON (JSObject obj) = do
> let objA = fromJSObject obj
> v <- lookupM "version" objA >>= readJSON
> h <- lookupM "height" objA >>= readJSON
> w <- lookupM "width" objA >>= readJSON
> tsn <- lookupM "tileSetName" objA >>= readJSON
> locs <- lookupM "locations" objA >>= readJSON
> return $ GameMap v h w tsn locs

> instance JSON GameMapLoc where
> showJSON gml = makeObj
> [ ("tileName", showJSON $ gmlTileName gml)
> ]
>
> readJSON (JSObject obj) = do
> let objA = fromJSObject obj
> tn <- lookupM "tileName" objA >>= readJSON
> return $ GameMapLoc tn

Unfortunately, it seems as if deriving from Data.Data and Data.Typeable is not enough for Text.JSON to automatically work.

To read and write these files, I wrote a few helper functions. They use System.FilePath and System.Directory for path manipulation.

> import System.FilePath as FP
> import System.Directory as Dir

[...]

> writeMapToFile :: String -> GameMap -> IO ()
> writeMapToFile fn gm = do
> audDir <- Dir.getAppUserDataDirectory appName
> let dirp = FP.combine audDir "maps"
> let fp = FP.combine dirp $ FP.replaceExtension fn "map"
> createDirectoryIfMissing True dirp
> writeFile fp $ encode gm
> return ()

> readMapFromFile :: String -> IO (Maybe GameMap)
> readMapFromFile fn = do
> audDir <- Dir.getAppUserDataDirectory appName
> let dirp = FP.combine audDir "maps"
> let fp = FP.combine dirp $ FP.replaceExtension fn "map"
> exists <- doesFileExist fp
> if exists
> then do
> f <- readFile fp
> let json = decode f :: Result GameMap
> case json of
> Ok gm -> return $ Just gm
> _ -> return Nothing
> else
> return Nothing

There’s very little error handling going on there. Several possibilites exist for the function to fail out. Other than that, you can see how easy it is to serialize.

April 17, 2010

A Haskell adventure in Windows

I’ve been blogging about my recent project using Haskell – a strategy game using SDL. I use GNU/Linux as my primary operating system, Ubuntu 10.4 to be exact, but I wanted to make sure my project can run in Windows too because that’s what my wife uses. This turned out to be much harder than I first anticipated, considering the general ease in which you can code Haskell in linux.

For this post, I’m using a fresh installation of Windows 7 x64 running inside VirtualBox 3.1.6 OSE. Your mileage with other versions of Windows may vary. Installing Haskell and manually installing FFI bindings, as well as installing git tools to clone the source code repository and building it, will all be covered here. This is mostly here to preserve my notes for myself, though maybe someone else on the Internet will find it useful.

The first thing I do is install some basic free software that I find very useful: the great Firefox web browser, a nice programming text editor called Notepad++, a better command line called Console2 and a good archive utility called 7-zip. These packages provide the needed functionality to accomplish everything below, though are not strictly required if you have other software to handle the job.

Installing Haskell, the SDL, SDL-image, SDL-ttf FFI bindings

Installing the Haskell Platform for Windows is easy. You can download the latest version here. I used the 2010.1.0.0 version. Accepting the defaults while installing will be fine. This gives you the GHC compiler and GHCi interpreter and adds the binaries to your PATH environment variable.

The platform only installs commonly used packages and SDL and associated libraries don’t make the cut. Installing the libraries on Windows must be done by hand with edits made to the build files.

Download that SDL development package for MinGW32, SDL-devel-1.2.14-mingw32.tar.gz; then the SDL_image development package, SDL_image-devel-1.2.10-VC.zip; then the SDL_ttf development package, SDL_ttf-devel-2.0.9-VC8.zip .I unzipped all of them to the C:\ folder as shown in this screen shot:

This will provide the c headers and libraries that we’ll need for the Haskell FFI bindings. The first binding we’ll install will be SDL. Go to the SDL page on hackage, and download the SDL-0.5.9.tar.gz archive at the bottom. Unzip it somewhere that’s convenient for you, but the exact location isn’t important.

Inside the SDL-0.5.9 folder there is a WIN32 file that describes the process of building the Haskell bindings on Windows. The following is an abbreviated version:

1. Open the SDL-0.5.9/SDL.cabal file in your favorite editor.

2. Change the line that reads “Extra-Libraries: SDL” to “Extra-Libraries: SDL.dll SDLmain”

3. Below the line you just edited, add the following two lines (corrected from original version):

Include-Dirs: C:\SDL-1.2.14\include\SDL
Extra-Lib-Dirs: C:\SDL-1.2.14\lib

4. Open up a command line window – either cmd.exe or use Console2. I run this as administrator because I’ll be using this command line to install the Haskell packages which, by default, end up installing to C:\Program Files (x64).

5. Run the following command:

runghc Setup.lhs configure

You’ll see this error message about the use of a configure script but ignore it:

6. Run the next two commands. The last one will require admin rights to write to the C:\Program Files (x86)\Haskell folder.

runghc Setup.lhs build
runghc Setup.lhs install

After building the main SDL binding, it is time to build the SDL-image binding. A lot of the steps will be similar to what we just did for SDL. Go to the SDL-image page on hackage and download the SDL-image-0.5.2.tar.gz file. Unzip it somewhere convenient; I put it on my desktop.

1. Open up the SDL-image-0.5.2\SDL-image.cabal file in your favorite editor. Add the following line to the end of the file.

Include-Dirs: C:\SDL_image-1.2.10\include

2. Open up the SDL-image-0.5.2\Graphics\UI\SDL\Image\Version.hsc file and underneath #include “SDL_image.h” add:

#include "SDL.h"
#ifdef main
#undef main
#endif

This fix was originally found here.

3. Run the following commands ignoring the complaints about the configure script:

runghc Setup.lhs configure
runghc Setup.lhs build
runghc Setup.lhs install

Proof that this too can be installed is here:

The last binding necessary is SDL_ttf. The process should be familiar to you now. Go to the SDL-ttf page on hackage and download the SDL-ttf-0.5.5.tar.gz file. Unzip it somewhere.

1. Open up the SDL-ttf-0.5.5\SDL-ttf.cabal file in your favorite editor. Add the following line to the end of the file.

Include-Dirs: C:\SDL_ttf-2.0.9\include

2. Open up the SDL-ttf-0.5.5\Graphics\UI\SDL\TTF\Version.hsc file and underneath #include “SDL_ttf.h” add:

#include "SDL.h"
#ifdef main
#undef main
#endif

3. Run the following commands ignoring the complaints about the configure script:

runghc Setup.lhs configure
runghc Setup.lhs build
runghc Setup.lhs install

I’ll spare the boring screen shot of a terminal.

Installing git and cloning the source code

Per the Pro Git book, I use msysgit to provide the basic git functionality. Do not follow the “InstallMSysGit” wiki page because it will lead you down the wrong path. Just download the full installer for git (Git-1.7.0.2-preview20100309.exe) and install it. I use all of the default settings in the installer except the one regarding the PATH variable – I choose “Run Git from the Windows Command Prompt.”

To get a good difference view, I install the KDiff3 package, which integrates well with the next tool I install. Download the KDiff3 installer and install it.

Next up is the GitExtentions package. This is a nicer GUI for dealing with git. Grab the complete installer here. I install it will all default settings. When it first runs, it will scan your system and try to find the software it wants to use. If you have set up git and kdiff3 as above, it should automatically find them. To complete the GitExtensions setup, switch to the Global settings tab in the Settings window and enter a user name and email. Switch back to the Checklist tab and click the “Save and rescan” button, then the “Ok”button to finish the setup.

Click the “Clone repository” button and use http://github.com/tbogdala/ExitStrategy.git as the repository to clone (link). I set the destination to C:\Projects as that is my standard folder. Click “Clone” to download a copy of the source files.

For more information on git, check out the Pro Git book. The Seeker’s Quill has a good post on using git. There’s also a blog series on lostechies that I found helpful.

Building the game

Now that we have the prerequisite software installed and a copy of the source code for the project we’re all set to go …

Well, not quite. If you perform a cabal configure and build on the project right now you get massive linker errors pointing to SDL-image and SDL-ttf. Undefined reference to ‘IMG_Load_RW’, undefined reference to ‘IMG_Load’, etc …

1. Open up the exitstrategy.cabal file and add these two lines to the end:

Extra-Lib-Dirs: C:\SDL_image-1.2.10\lib, C:\SDL_ttf-2.0.9\lib
Extra-Libraries: SDL_image, SDL_ttf

2. Go to the C:\SDL_image\lib folder and make a copy of SDL_image.dll and call it libSDL_image.dll.a (lib*.a)

3. Go to the C:\SDL_ttf-2.0.9\lib folder and make a copy of SDL_ttf.dll and call it libSDL_ttf.dll.a, similar to what we did in step 2.

After that, the project will build.

One last step is to make a copy of the following files and place them in C:\Projects\ExitStrategy\dist\build\exitstrategy-editor:

C:\SDL-1.2.14\bin\SDL.dll
C:\SDL_image-1.2.10\lib\jpeg.dll
C:\SDL_image-1.2.10\lib\libpng12-0.dll
C:\SDL_image-1.2.10\lib\libtiff-3.dll
C:\SDL_image-1.2.10\lib\SDL_image.dll
C:\SDL_image-1.2.10\lib\zlib1.dll
C:\SDL_ttf-2.0.9\lib\libfreetype-6.dll
C:\SDL_ttf-2.0.9\lib\SDL_ttf.dll

Finally, from the C:\Projects\ExitStrategy folder, run “dist\build\exitstrategy-editor\exitstrategy-editor.exe” in the command line. Success!

For now, double clicking on the exitstrategy-editor.exe file won’t work because it won’t find the art/64×74 folder where all of the art is (unless you also copy that folder to the build directory with the dlls). That will be fixed in a future version.

Version History

Apr 26, 2010: Updates: Project name changed to Exit Strategy. Updated the steps to reference the project with the new name. The steps should work with version v0.0.3 as tagged in gitthub.

Apr 19, 2010: Updated to include SDL_ttf for the master git branch. The new steps should fix the problems caused by adding the SDL_ttf dependency, but I have not run through all of the steps from scratch again to verify this. Leave a comment if something doesn’t work.

Apr 17, 2010: Originally published.

April 11, 2010

Profiling in Haskell (SDL game series part 3)

In this post, I’ll show how I profiled the SDL project. The code shown is a continuation of the efforts in part one and part two. The starting point will be this version of the project: strat-0.0.1.tar.gz.

With version 0.0.1 from part two, I noticed that whenever I did a right mouse button drag to scroll the map, the redraw would always lag behind my mouse movement. Since I’m new to Haskell, I don’t yet have an instinctual feel for what code actually costs me at run time. I figured now is as good of a time as any to take a peek. I’m not interested in getting it as fast as possible, but I feel uncomfortable proceeding without at least checking out some numbers.

First, I would like to reference this blog post by Nathan Sanders. That page, and the profiling chapter in Real World Haskell, got me up and running. For the official version, check out GHC’s user guide on profiling.

The first step in profiling is rebuilding everything with profiling support if it has not been done already. You can execute cabal commands to do this on a package-by-package basis:

cabal install SDL -p --reinstall

The ‘-p’ flag tells cabal to build the library with profiling support.

Doing this for everything on my system quickly got annoying. In the end, I deleted my ~/.ghc and ~/.cabal folder and started from scratch. After the initial ‘cabal update’, edit the ~/.cabal/config file and set library-profiling to True.

Once the dependencies were reinstalled with profiling enabled, I executed a new cabal configure command to enable profiling for the SDL game:

cabal clean
cabal configure --enable-executable-profiling
cabal build

When GHC generates code that can be profiled the binaries come out thicker. Unstripped, my non-profile version of strat is 2.4 MB. The profiled version is 4.0 MB.

To generate a profiling report you must pass a command line flag to the run-time system of the executable. Here’s the command to run from the source directory of the project:

./dist/build/strat/strat +RTS -p

This will start up the SDL game. Move the mouse around a bit and exit. Once the program stops, you’ll notice a file called strat.prof. Here’s what was generated for me with the current settings:

Tue Apr 13 19:27 2010 Time and Allocation Profiling Report (Final)

strat +RTS -p -RTS

total time = 2.28 secs (114 ticks @ 20 ms)
total alloc = 772,177,168 bytes (excludes profiling overheads)

COST CENTRE MODULE %time %alloc

MAIN MAIN 100.0 100.0

individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc

MAIN MAIN 1 0 100.0 100.0 100.0 100.0
CAF Main 348 13 0.0 0.0 0.0 0.0
CAF GHC.Float 325 7 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.FD 286 2 0.0 0.0 0.0 0.0
CAF System.Posix.Internals 285 1 0.0 0.0 0.0 0.0
CAF GHC.Conc 269 1 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.Internals 260 1 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding.Iconv 254 5 0.0 0.0 0.0 0.0
CAF UIState 251 1 0.0 0.0 0.0 0.0
CAF Graphics.UI.SDL.General 227 1 0.0 0.0 0.0 0.0
CAF Graphics.UI.SDL.Events 223 1 0.0 0.0 0.0 0.0
CAF Graphics.UI.SDL.Video 215 3 0.0 0.0 0.0 0.0
CAF System.Random 210 1 0.0 0.0 0.0 0.0
CAF Data.Time.Clock.POSIX 203 2 0.0 0.0 0.0 0.0
CAF Data.Time.Clock.CTimeval 202 1 0.0 0.0 0.0 0.0

Not very helpful is it? It basically only profiled main and some CAFs (Constant Applicative Function – fancy name for functions without arguments).

What we need to do is pass some more build flags to tell GHC to profile more than just that.

cabal build --ghc-options="-caf-all -auto-all -fforce-recomp"

The ‘-caf-all’ option tells GHC to profile all top-level CAFs separately instead of as a group (the default behavior, as shown above). The ‘-auto-all’ option tells GHC to profile all top-level functions. Lastly, the ‘-fforce-recomp’ option forces the recompilation of the files, thereby making sure we have the profiling code we want. With the new executable, try this:

./dist/build/strat/strat +RTS -p

Which generates this report:

Tue Apr 13 19:39 2010 Time and Allocation Profiling Report (Final)

strat +RTS -p -RTS

total time = 3.42 secs (171 ticks @ 20 ms)
total alloc = 1,303,852,488 bytes (excludes profiling overheads)

COST CENTRE MODULE %time %alloc

drawTile Main 72.5 35.8
redrawScreen Main 22.2 57.9
getHexmapOffset Main 2.3 4.8
tileInViewPort Main 1.8 0.0
makeRandomMap Main 0.6 1.3

individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc

MAIN MAIN 1 0 0.0 0.0 100.0 100.0
main Main 432 383 0.6 0.0 100.0 100.0
vpY UIState 465 320 0.0 0.0 0.0 0.0
vpX UIState 464 320 0.0 0.0 0.0 0.0
uiViewPort UIState 463 320 0.0 0.0 0.0 0.0
uiMouseButtonsDown UIState 462 3 0.0 0.0 0.0 0.0
redrawScreen Main 448 393 22.2 57.9 98.8 98.5
drawTile Main 449 3930000 72.5 35.8 76.6 40.6
==_aNo UIState 458 75680 0.0 0.0 0.0 0.0
tileInViewPort Main 452 3930000 1.8 0.0 1.8 0.0
getHexmapOffset Main 450 0 2.3 4.8 2.3 4.8
makeRandomMap Main 445 102 0.6 1.3 0.6 1.5
getRandomTerrain Main 446 100 0.0 0.3 0.0 0.3
toEnum_aOi UIState 461 155 0.0 0.0 0.0 0.0
loadArt Main 436 1 0.0 0.0 0.0 0.0
CAF:artFilePaths Main 426 1 0.0 0.0 0.0 0.0
artFilePaths Main 437 1 0.0 0.0 0.0 0.0
CAF:main18 Main 425 1 0.0 0.0 0.0 0.0
artFilePaths Main 439 0 0.0 0.0 0.0 0.0
CAF:main19 Main 424 1 0.0 0.0 0.0 0.0
artFilePaths Main 441 0 0.0 0.0 0.0 0.0
CAF:main20 Main 423 1 0.0 0.0 0.0 0.0
artFilePaths Main 443 0 0.0 0.0 0.0 0.0
CAF:tileWidth_r3OL Main 422 1 0.0 0.0 0.0 0.0
tileWidth Main 451 1 0.0 0.0 0.0 0.0
CAF:tileHeight_r3ON Main 421 1 0.0 0.0 0.0 0.0
tileHeight Main 454 1 0.0 0.0 0.0 0.0
CAF:windowWidth Main 420 1 0.0 0.0 0.0 0.0
windowWidth Main 453 1 0.0 0.0 0.0 0.0
CAF:windowHeight Main 419 1 0.0 0.0 0.0 0.0
windowHeight Main 455 1 0.0 0.0 0.0 0.0
CAF:mapColumns Main 418 1 0.0 0.0 0.0 0.0
mapColumns Main 447 1 0.0 0.0 0.0 0.0
CAF:main24 Main 417 1 0.0 0.0 0.0 0.0
artFilePaths Main 438 0 0.0 0.0 0.0 0.0
CAF:main23 Main 416 1 0.0 0.0 0.0 0.0
artFilePaths Main 440 0 0.0 0.0 0.0 0.0
CAF:main22 Main 415 1 0.0 0.0 0.0 0.0
artFilePaths Main 442 0 0.0 0.0 0.0 0.0
CAF:main21 Main 414 1 0.0 0.0 0.0 0.0
artFilePaths Main 444 0 0.0 0.0 0.0 0.0
CAF:main27 Main 413 1 0.0 0.0 0.0 0.0
main Main 434 0 0.0 0.0 0.0 0.0
CAF:main26 Main 412 1 0.0 0.0 0.0 0.0
main Main 435 0 0.0 0.0 0.0 0.0
CAF:main4 Main 411 1 0.0 0.0 0.0 0.0
main Main 466 0 0.0 0.0 0.0 0.0
CAF:main29 Main 410 1 0.0 0.0 0.0 0.0
CAF GHC.Float 387 7 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.FD 348 2 0.0 0.0 0.0 0.0
CAF System.Posix.Internals 347 1 0.0 0.0 0.0 0.0
CAF GHC.Conc 331 1 0.0 0.0 0.0 0.0
CAF GHC.IO.Handle.Internals 322 1 0.0 0.0 0.0 0.0
CAF GHC.IO.Encoding.Iconv 316 5 0.0 0.0 0.0 0.0
CAF:terrainMaxBound UIState 307 1 0.0 0.0 0.0 0.0
terrainMaxBound UIState 459 1 0.0 0.0 0.0 0.0
fromEnum_aOn UIState 460 1 0.0 0.0 0.0 0.0
CAF:terrainTypes UIState 306 1 0.0 0.0 0.0 0.0
terrainTypes UIState 456 1 0.0 0.0 0.0 0.0
enumFrom_aOx UIState 457 1 0.0 0.0 0.0 0.0
CAF Graphics.UI.SDL.General 266 1 0.0 0.0 0.0 0.0
CAF Graphics.UI.SDL.Events 262 1 0.0 0.0 0.0 0.0
CAF Graphics.UI.SDL.Video 254 3 0.0 0.0 0.0 0.0
CAF System.Random 249 1 0.0 0.0 0.0 0.0
CAF Data.Time.Clock.POSIX 242 2 0.0 0.0 0.0 0.0
CAF Data.Time.Clock.CTimeval 241 1 0.0 0.0 0.0 0.0

Much better! Near the top of the report there is a short list of the most expensive functions. We can see that drawTile takes about 72% of execution time and redrawScreen takes about 22%. The next few functions after that barely cost anything by comparison.

If we wanted to see some memory profiling data on the garbage collector we can execute the binary with these options:

./dist/build/strat/strat +RTS -sstderr

Which outputs this to stderr:

dist/build/strat/strat +RTS -sstderr
done
2,722,681,960 bytes allocated in the heap
644,419,088 bytes copied during GC
4,732,608 bytes maximum residency (78 sample(s))
149,912 bytes maximum slop
14 MB total memory in use (0 MB lost due to fragmentation)

Generation 0: 5106 collections, 0 parallel, 0.50s, 0.52s elapsed
Generation 1: 78 collections, 0 parallel, 0.42s, 0.42s elapsed

INIT time 0.00s ( 0.00s elapsed)
MUT time 4.59s ( 6.27s elapsed)
GC time 0.92s ( 0.94s elapsed)
RP time 0.00s ( 0.00s elapsed)
PROF time 0.00s ( 0.00s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 5.51s ( 7.21s elapsed)

%GC time 16.7% (13.1% elapsed)

Alloc rate 593,646,382 bytes per MUT second

Productivity 83.3% of total user, 63.6% of total elapsed

There are ways to profile the heap as well. For this program, the results from that were not enlightening.

So what to do now? It does not appear that we are having major GC or memory errors. Lets change the two most expensive functions and manually place ‘call centers’ around most expressions. This way we can see the cost of almost everything in the functions.

> drawTile :: UIState -> Point -> IO ()
> drawTile (UIState vp _ mainSurf terrainSurfs tm) (x,y) = do
> let sr = {-# SCC "dT-sr" #-} Just (SDL.Rect 0 0 tileWidth tileHeight)
> (tX, tY) = {-# SCC "dT-gP2V" #-} gamePoint2View vp $ {-# SCC "dT-gHO" #-} getHexmapOffset tileWidth tileHeight x y
> dr = {-# SCC "dT-dr" #-} Just $ SDL.Rect tX tY 0 0
> tt = DM.fromJust $ {-# SCC "dT-tmLookup" #-} DMap.lookup (x,y) tm
> terrainSurf = DM.fromJust $ {-# SCC "dT-tsLookup" #-} lookup tt terrainSurfs
> if {-# SCC "dT-tIVP" #-} tileInViewPort vp tileWidth tileHeight (tX,tY)
> then do
> {-# SCC "dT-blit" #-} SDL.blitSurface terrainSurf sr mainSurf dr
> return ()
> else
> return ()

> redrawScreen :: UIState -> IO ()
> redrawScreen ui@(UIState vp _ mainSurf terrainSurfs terrainMap) = do
> {-# SCC "rS-fillRect" #-} SDL.fillRect mainSurf Nothing (SDL.Pixel 0)
> {-# SCC "rS-mDrawTile" #-} mapM_ (drawTile ui) $ {-# SCC "rS-tmKeys" #-} DMap.keys terrainMap
> {-# SCC "rS-flip" #-} SDL.flip mainSurf
> return ()

The “{-# SCC “LABEL” #-} set a cost center for the expression that follows it. With this, rebuild the project and run the binary with profiling enabled.

cabal build --ghc-options="-caf-all -auto-all"
dist/build/strat/strat +RTS -p

This will generate a report that looks like this (only part of the report is shown):

Tue Apr 13 21:05 2010 Time and Allocation Profiling Report (Final)

strat +RTS -p -RTS

total time = 12.72 secs (636 ticks @ 20 ms)
total alloc = 4,299,436,864 bytes (excludes profiling overheads)

COST CENTRE MODULE %time %alloc

dT-blit Main 58.2 0.8
rS-tmKeys Main 10.8 44.9
dT-gHO Main 7.2 24.7
gamePoint2View Main 6.1 24.7
rS-mDrawTile Main 4.1 0.0
dT-gP2V Main 3.9 0.0
drawTile Main 3.0 0.2
getHexmapOffset Main 1.7 3.7
rS-fillRect Main 1.6 0.0
tileInViewPort Main 1.1 0.0

individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc

MAIN MAIN 1 0 0.0 0.0 100.0 100.0
main Main 452 987 0.5 0.0 100.0 100.0
vpY UIState 513 443 0.0 0.0 0.0 0.0
vpX UIState 512 443 0.0 0.0 0.0 0.0
uiViewPort UIState 511 443 0.0 0.0 0.0 0.0
uiMouseButtonsDown UIState 510 6 0.0 0.0 0.0 0.0
redrawScreen Main 472 1006 0.0 0.0 99.1 99.5
rS-flip Main 509 1006 0.0 0.0 0.0 0.0
rS-mDrawTile Main 474 10062012 4.1 0.0 97.5 99.5
drawTile Main 476 10060000 3.0 0.2 82.5 54.6
dT-tmLookup Main 505 109188 0.2 0.1 0.2 0.1
dT-tsLookup Main 501 109188 0.2 0.0 0.3 0.0
==_aO1 UIState 504 385235 0.2 0.0 0.2 0.0
dT-blit Main 488 109188 58.2 0.8 58.2 0.8
dT-dr Main 487 109188 0.0 0.2 0.0 0.2
dT-tIVP Main 482 10060000 0.8 0.0 1.9 0.0
tileInViewPort Main 483 10060000 1.1 0.0 1.1 0.0
dT-gP2V Main 477 10060000 3.9 0.0 19.0 53.2
gamePoint2View Main 479 10060000 6.1 24.7 6.1 24.7
dT-gHO Main 478 10060000 7.2 24.7 9.0 28.5
getHexmapOffset Main 480 0 1.7 3.7 1.7 3.7
rS-tmKeys Main 475 1006 10.8 44.9 10.8 44.9
rS-fillRect Main 473 1006 1.6 0.0 1.6 0.0
makeRandomMap Main 469 102 0.3 0.4 0.5 0.5
getRandomTerrain Main 470 100 0.2 0.1 0.2 0.1
toEnum_aOV UIState 508 294 0.0 0.0 0.0 0.0
loadArt Main 456 1 0.0 0.0 0.0 0.0

Now we have a decent idea what expressions are really costing us in execution.

The call to SDL.blitSurface is by far the most costly. This is natural as this is the function doing all the actual rendering IO work behind the scenes.

What caught me off guard was the hit taken by calling Data.Map.keys. Almost half of my memory allocations are coming from this call.

Lets add a list comprehension to generate the coordinates just once, since that’s all the terrainMap’s keys were anyway.

> mapCoordinates :: [Point]
> mapCoordinates = [(x,y) | x <- [1..mapRows]
> , y <- [1..mapColumns]]

> redrawScreen :: UIState -> IO ()
> redrawScreen ui@(UIState vp _ mainSurf terrainSurfs terrainMap) = do
> {-# SCC "rS-fillRect" #-} SDL.fillRect mainSurf Nothing (SDL.Pixel 0)
> {-# SCC "rS-mDrawTile" #-} mapM_ (drawTile ui) $ {-# SCC "rS-mapCoords" #-} mapCoordinates
> {-# SCC "rS-flip" #-} SDL.flip mainSurf
> return ()

A recompile and another run with ‘+RTS -p’ yeilds a profile report with these as the top call centers:

Tue Apr 13 21:55 2010 Time and Allocation Profiling Report

strat +RTS -p -RTS

total time = 8.10 secs (405 ticks @ 20 ms)
total alloc = 1,868,126,656 bytes (excludes profiling overheads)

COST CENTRE MODULE %time %alloc

dT-blit Main 64.7 1.4
dT-gHO Main 9.1 44.8
drawTile Main 4.9 0.4
gamePoint2View Main 4.2 44.8
dT-gP2V Main 3.7 0.0
rS-mDrawTile Main 3.5 0.0
rS-fillRect Main 3.0 0.0
getHexmapOffset Main 2.5 6.8
dT-tIVP Main 2.2 0.0

A run with ‘+RTS -sstderr’ gives this output:

dist/build/strat/strat +RTS -sstderr
2,082,792,480 bytes allocated in the heap
33,971,320 bytes copied during GC
4,853,488 bytes maximum residency (6 sample(s))
95,640 bytes maximum slop
13 MB total memory in use (0 MB lost due to fragmentation)

Generation 0: 3955 collections, 0 parallel, 0.07s, 0.06s elapsed
Generation 1: 6 collections, 0 parallel, 0.02s, 0.03s elapsed

INIT time 0.00s ( 0.00s elapsed)
MUT time 5.05s ( 6.54s elapsed)
GC time 0.09s ( 0.09s elapsed)
RP time 0.00s ( 0.00s elapsed)
PROF time 0.00s ( 0.00s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 5.14s ( 6.63s elapsed)

%GC time 1.8% (1.3% elapsed)

Alloc rate 412,461,270 bytes per MUT second

Productivity 98.2% of total user, 76.2% of total elapsed

That change alone eliminated a ton of GC copies and drastically reduced the amount of time spent in the GC. The program felt snappier as well.

However, the big payoff comes from realizing that I need to cut down on my blits. Our main’s inner function eventLoop looks like this:

> eventLoop ui = do
> redrawScreen ui
> e <- SDL.waitEvent
> checkEvent ui e

This means that for every event sent by SDL the screen is redrawn. Mouse movement generates lots of events! Recall how fast they printed out to console when we were writing tracing output at the beginning of part two?

A better solution is to process all of the events in the queue before redrawing the screen. After the screen is redrawn, we can block on waiting for an event. Replace the code above with this:

> eventLoop ui = do
> e <- SDL.pollEvent
> checkEvent ui e
> checkEvent ui (SDL.NoEvent) = do
> redrawScreen ui
> e <- SDL.waitEvent
> checkEvent ui e

It adds another pattern match for checkEvent that will run when no events are available. This made an enormous difference in the scroll speed.

With that change, I’m happy with the performance of the game for now.

Here’s a preview of the new programmer art that will be used in the next post: