Mercurial > repos > tabletprog
annotate samples/sdl.tp @ 310:2308336790d4
WIP compiler module for low-level dialect
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Fri, 01 Aug 2014 18:56:39 -0700 |
parents | 2b045d5b673b |
children | 4c669942c30d |
rev | line source |
---|---|
274
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
1 #{ |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
2 import: [ |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
3 video |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
4 timer |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
5 ] from: (sdl subsystems) |
291
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
6 import: [ |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
7 quit |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
8 keyDown |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
9 keyUp |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
10 mouseDown |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
11 mouseUp |
293
2b045d5b673b
Add binding for sdl mouse motion event
Michael Pavone <pavone@retrodev.com>
parents:
291
diff
changeset
|
12 mouseMotion |
291
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
13 ] from: (sdl eventTypes) |
274
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
14 main <- { |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
15 if: (sdl init: (video or timer)) = 0 { |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
16 (sdl createWindow: "SDL Test" pos: 0 0 size: 640 480 flags: 0u32) value: :window { |
277
2b58eafa360b
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it
Michael Pavone <pavone@retrodev.com>
parents:
274
diff
changeset
|
17 (window createRenderer: -1 flags: ((window renderOpts) accelerated)) value: :render { |
2b58eafa360b
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it
Michael Pavone <pavone@retrodev.com>
parents:
274
diff
changeset
|
18 render drawColor!: (sdl r: 0u8 g: 0u8 b: 255u8) |
2b58eafa360b
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it
Michael Pavone <pavone@retrodev.com>
parents:
274
diff
changeset
|
19 render clear |
278
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
20 (sdl loadBMP: "944.bmp") value: :surf { |
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
21 (surf asTexture: render) value: :tex { |
291
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
22 surf free |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
23 angle <- 45.0f32 |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
24 continue? <- true |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
25 while: { continue? } do: { |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
26 tex copy |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
27 tex copyTo: (sdl rect: 160 120 size: 320 224) |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
28 tex copyRect: (sdl rect: 80 60 size: 160 120) To: (sdl rect: 40 30 size: 320 224) |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
29 tex copyTo: (sdl rect: 320 240 size: 320 224) rotated: angle |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
30 render present |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
31 angle <- angle + 1.0f32 |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
32 |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
33 event <- option none |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
34 while: { |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
35 event <- sdl pollEvent |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
36 event value? |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
37 } do: { |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
38 event value: :ev { |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
39 if: (ev type) = quit { |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
40 continue? <- false |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
41 } else: { |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
42 if: (ev type) = keyDown || (ev type) = keyUp { |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
43 print: "Key event for: " . (ev keyChar) . ", pressed?: " . (ev pressed?) . "\n" |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
44 } else: { |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
45 if: (ev type) = mouseDown || (ev type) = mouseUp { |
293
2b045d5b673b
Add binding for sdl mouse motion event
Michael Pavone <pavone@retrodev.com>
parents:
291
diff
changeset
|
46 print: "Mouse button event at: " . (ev x) . ", " . (ev y) . " for button " . (ev button) . "\n" |
2b045d5b673b
Add binding for sdl mouse motion event
Michael Pavone <pavone@retrodev.com>
parents:
291
diff
changeset
|
47 } else: { |
2b045d5b673b
Add binding for sdl mouse motion event
Michael Pavone <pavone@retrodev.com>
parents:
291
diff
changeset
|
48 if: (ev type) = mouseMotion { |
2b045d5b673b
Add binding for sdl mouse motion event
Michael Pavone <pavone@retrodev.com>
parents:
291
diff
changeset
|
49 print: "Mouse motion event: " . (ev xRel) . ", " . (ev yRel) . "\n" |
2b045d5b673b
Add binding for sdl mouse motion event
Michael Pavone <pavone@retrodev.com>
parents:
291
diff
changeset
|
50 } |
291
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
51 } |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
52 } |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
53 } |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
54 } none: {} |
38bbbf74b735
Initial work on event support in SDL module
Michael Pavone <pavone@retrodev.com>
parents:
287
diff
changeset
|
55 } |
278
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
56 } |
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
57 tex destroy |
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
58 } none: { |
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
59 surf free |
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
60 } |
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
61 } none: { |
1205c7a43cb4
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy
Michael Pavone <pavone@retrodev.com>
parents:
277
diff
changeset
|
62 } |
277
2b58eafa360b
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it
Michael Pavone <pavone@retrodev.com>
parents:
274
diff
changeset
|
63 render destroy |
2b58eafa360b
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it
Michael Pavone <pavone@retrodev.com>
parents:
274
diff
changeset
|
64 } none: { |
2b58eafa360b
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it
Michael Pavone <pavone@retrodev.com>
parents:
274
diff
changeset
|
65 print: "Failed to create renderer\n" |
2b58eafa360b
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it
Michael Pavone <pavone@retrodev.com>
parents:
274
diff
changeset
|
66 } |
274
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
67 window destroy |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
68 } none: { |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
69 print: "Failed to create window\n" |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
70 1 |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
71 } |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
72 } else: { |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
73 print: "Failed to initialize SDL\n" |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
74 1 |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
75 } |
a923b5b7da3d
Initial work on an SDL2 binding
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
76 } |
277
2b58eafa360b
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it
Michael Pavone <pavone@retrodev.com>
parents:
274
diff
changeset
|
77 } |