added sdl-keysyms, split sdl vocabulary, more factoroids work

examples/dejong.factor

@@ -13,6 +13,9 @@
 IN: dejong
 
 USE: sdl
+USE: sdl-event
+USE: sdl-gfx
+USE: sdl-video
 USE: namespaces
 USE: math
 USE: stack

examples/factoroids.factor

@@ -20,23 +20,29 @@ USE: namespaces
 USE: oop
 USE: random
 USE: sdl
+USE: sdl-event
+USE: sdl-gfx
+USE: sdl-keysym
+USE: sdl-video
 USE: stack
 
 ! Game objects
-GENERIC: draw ( -- )
+GENERIC: draw ( actor -- )
 #! Draw the actor.
 
-GENERIC: tick ( -- ? )
+GENERIC: tick ( actor -- ? )
 #! Return f if the actor should be removed.
 
+GENERIC: collide ( actor1 actor2 -- )
+#! Handle collision of two actors.
+
 ! Actor attributes
-SYMBOL: x
+SYMBOL: position
-SYMBOL: y
 SYMBOL: radius
 SYMBOL: len
-SYMBOL: dx
+SYMBOL: velocity
-SYMBOL: dy
 SYMBOL: color
+SYMBOL: active
 
 ! The list of actors is divided into layers. Note that an
 ! actor's tick method can only add actors to layers other than
@@ -46,100 +52,156 @@ SYMBOL: enemies
 SYMBOL: player-shots
 SYMBOL: enemy-shots
 
-: player-actor ( -- actor )
+: player-actor ( -- player )
-    player get car ;
+    player get dup [ car ] when ;
 
-: y-in-screen? ( -- ? ) y get 0 height get between? ;
+: x-in-screen? ( x -- ? ) 0 width get between? ;
-: x-in-screen? ( -- ? ) x get 0 width get between? ;
+: y-in-screen? ( y -- ? ) 0 height get between? ;
 
-: in-screen? ( -- ? )
+: in-screen? ( actor -- ? )
-    #! Is the current actor in the screen?
+    #! Is the actor in the screen?
-    x-in-screen? y-in-screen? and ;
-
-: velocity ( -- )
-    #! Add velocity vector to current actor's position vector.
-    dx get x +@  dy get y +@ ;
-
-: actor-tick ( actor -- ? )
-    #! Default tick behavior of an actor. Move actor according
-    #! to velocity, and remove it if it is not in the screen.
-    #! Player's ship always returns t.
     [
-        velocity
+        position get >rect y-in-screen? swap x-in-screen? and
-        namespace player-actor = [ t ] [ in-screen? ] ifte
     ] bind ;
 
+: move ( -- )
+    #! Add velocity vector to current actor's position vector.
+    velocity get position +@ ;
+
+: active? ( actor -- ? )
+    #! Push f if the actor should be removed.
+    [ active get ] bind ;
+
+: deactivate ( actor -- )
+    #! Cause the actor to be removed in the next tick cycle.
+    [ active off ] bind ;
+
 : screen-xy ( -- x y )
-    x get >fixnum y get >fixnum ;
+    position get >rect swap >fixnum swap >fixnum ;
 
 : actor-xy ( actor -- )
     #! Copy actor's x/y co-ordinates to this namespace.
-    [ x get y get ] bind y set x set ;
+    [ position get ] bind position set ;
+
+! Collision detection
+: distance ( actor1 actor2 -- x )
+    #! Distance between two actor's positions.
+    >r [ position get ] bind r> [ position get ] bind - abs ;
+
+: min-distance ( actor1 actor2 -- )
+    #! Minimum distance before there is a collision.
+    >r [ radius get ] bind r> [ radius get ] bind + ;
+
+: collision? ( actor1 actor2 -- ? )
+    2dup distance >r min-distance r> > ;
+
+: check-collision ( actor1 actor2 -- )
+    2dup collision? [ collide ] [ 2drop ] ifte ;
+
+: layer-actor-collision ( actor layer -- )
+    #! The layer is a list of actors.
+    [ dupd check-collision ] each drop ;
+
+: layer-collision ( layer layer -- )
+    swap [ over layer-actor-collision ] each drop ;
+
+: collisions ( -- )
+    #! Only collisions we allow are player colliding with an
+    #! enemy shot, and player shot colliding with enemy.
+    player get enemy-shots get layer-collision
+    enemies get player-shots get layer-collision ;
 
 ! The player's ship
+
+! Flags that can be set to move the ship
+SYMBOL: left
+SYMBOL: right
+
 TRAITS: ship
-M: ship draw ( -- )
+M: ship draw ( actor -- )
     [
         surface get screen-xy radius get color get
         filledCircleColor
     ] bind ;M
 
-M: ship tick ( -- ) actor-tick ;M
+M: ship tick ( actor -- ? ) dup [ move ] bind active? ;M
+
+: make-ship ( -- ship )
+    <ship> [
+        width get 2 /i  height get 50 - rect> position set
+        white color set
+        10 radius set
+        0 velocity set
+        active on
+    ] extend unit ;
 
 ! Projectiles
 TRAITS: plasma
-M: plasma draw ( -- )
+M: plasma draw ( actor -- )
     [
         surface get screen-xy dup len get + color get
         vlineColor
     ] bind ;M
 
-M: plasma tick ( -- ) actor-tick ;M
+M: plasma tick ( actor -- ? )
+    dup [ move ] bind dup in-screen? swap active? and ;M
+
+M: plasma collide ( actor1 actor2 -- )
+    #! Remove the other actor.
+    deactivate deactivate ;M
 
 : make-plasma ( actor dy -- plasma )
     <plasma> [
-        dy set
+        velocity set
-        0 dx set
         actor-xy
         blue color set
         10 len set
+        5 radius set
+        active on
     ] extend ;
 
 : player-fire ( -- )
-    player-actor -6 make-plasma player-shots cons@ ;
+    #! Do nothing if player is dead.
+    player-actor [
+        #{ 0 -6 } make-plasma player-shots cons@
+    ] when* ;
 
 : enemy-fire ( actor -- )
-    5 make-plasma enemy-shots cons@ ;
+    #{ 0 5 } make-plasma enemy-shots cons@ ;
 
 ! Background of stars
 TRAITS: particle
 
-M: particle draw ( -- )
+M: particle draw ( actor -- )
     [ surface get screen-xy color get pixelColor ] bind ;M
 
 : wrap ( -- )
     #! If current actor has gone beyond screen bounds, move it
     #! back.
-    width get x rem@  height get y rem@ ;
+    position get >rect
+    swap >fixnum width get rem
+    swap >fixnum height get rem
+    rect> position set ;
 
-M: particle tick ( -- )
+M: particle tick ( actor -- )
-    [ velocity wrap t ] bind ;M
+    [ move wrap t ] bind ;M
 
 SYMBOL: stars
 : star-count 100 ;
 
 : random-x 0 width get random-int ;
 : random-y 0 height get random-int ;
+: random-position random-x random-y rect> ;
 : random-byte 0 255 random-int ;
 : random-color random-byte random-byte random-byte 255 rgba ;
+: random-velocity 0 10 20 random-int 10 /f rect> ;
 
 : random-star ( -- star )
     <particle> [
-        random-x x set
+        random-position position set
-        random-y y set
         random-color color set
-        2 4 random-int dy set
+        random-velocity velocity set
-        0 dx set
+        active on
     ] extend ;
 
 : init-stars ( -- )
@@ -155,7 +217,7 @@ SYMBOL: stars
 : enemy-chance 50 ;
 
 TRAITS: enemy
-M: enemy draw ( -- )
+M: enemy draw ( actor -- )
     [
         surface get screen-xy radius get color get
         filledCircleColor
@@ -163,27 +225,30 @@ M: enemy draw ( -- )
 
 : attack-chance 30 ;
 
-: attack ( -- ) attack-chance chance [ enemy-fire ] when ;
+: attack ( actor -- )
+    #! Fire a shot some of the time.
+    attack-chance chance [ enemy-fire ] [ drop ] ifte ;
 
 SYMBOL: wiggle-x
 
 : wiggle ( -- )
     #! Wiggle from left to right.
     -3 3 random-int wiggle-x +@
-    wiggle-x get sgn dx set ;
+    wiggle-x get sgn 1 rect> velocity set ;
 
-M: enemy tick ( -- )
+M: enemy tick ( actor -- )
-    dup attack [ wiggle velocity y-in-screen? ] bind ;M
+    dup attack
+    dup [ wiggle move position get imaginary ] bind
+    y-in-screen? swap active? and ;M
 
 : spawn-enemy ( -- )
     <enemy> [
-        10 y set
+        random-x 10 rect> position set
-        random-x x set
         red color set
         0 wiggle-x set
-        0 dx set
+        0 velocity set
-        1 dy set
         10 radius set
+        active on
     ] extend ;
 
 : spawn-enemies ( -- )
@@ -193,7 +258,11 @@ M: enemy tick ( -- )
 SYMBOL: event
 
 : mouse-motion-event ( event -- )
-    motion-event-x player-actor [ x set ] bind ; 
+    motion-event-x player-actor dup [
+        [ position get imaginary rect> position set ] bind
+    ] [
+        2drop
+    ] ifte ;
 
 : mouse-down-event ( event -- )
     drop player-fire ;
@@ -217,46 +286,27 @@ SYMBOL: event
     ] ifte ;
 
 ! Game loop
-: init-player ( -- )
-    <ship> [
-        height get 50 - y set
-        width get 2 /i x set
-        white color set
-        10 radius set
-        0 dx set
-        0 dy set
-    ] extend unit player set ;
-
-: init-events ( -- ) <event> event set ;
-
 : init-game ( -- )
     #! Init game objects.
-    init-player init-stars init-events ;
+    init-stars
+    make-ship player set
+    <event> event set ;
 
 : each-layer ( quot -- )
     #! Apply quotation to each layer.
     [ enemies enemy-shots player player-shots ] swap each ;
 
-: draw-layer ( layer -- )
-    get [ draw ] each ;
-
 : draw-actors ( -- )
-    [ draw-layer ] each-layer ;
+    [ get [ draw ] each ] each-layer ;
-
-: tick-layer ( layer -- )
-    dup get [ tick ] subset put ;
 
 : tick-actors ( -- )
-    #! Advance game state by one frame.
+    #! Advance game state by one frame. Actors whose tick word
-    [ tick-layer ] each-layer ;
+    #! returns f are removed from the layer.
+    [ dup get [ tick ] subset put ] each-layer ;
 
 : render ( -- )
     #! Draw the scene.
-    [
+    [ black clear-surface draw-stars draw-actors ] with-surface ;
-        black clear-surface
-        draw-stars
-        draw-actors
-    ] with-surface ;
 
 : advance ( -- )
     #! Advance game state by one frame.
@@ -264,7 +314,7 @@ SYMBOL: event
 
 : game-loop ( -- )
     #! Render, advance game state, repeat.
-    render advance check-event [ game-loop ] when ;
+    render advance collisions check-event [ game-loop ] when ;
 
 : factoroids ( -- )
     #! Main word.

examples/mandel.factor

@@ -18,6 +18,9 @@ USE: logic
 USE: math
 USE: namespaces
 USE: sdl
+USE: sdl-event
+USE: sdl-gfx
+USE: sdl-video
 USE: stack
 USE: vectors
 USE: prettyprint

library/math/pow.factor

@@ -30,11 +30,11 @@ USE: combinators
 USE: math
 USE: real-math
 USE: kernel
+USE: logic
 USE: stack
 
 ! Power-related functions:
 !     exp log sqrt pow
-USE: logic
 
 : exp >rect swap fexp swap polar> ;
 : log >polar swap flog swap rect> ;

library/platform/native/boot-stage2.factor

@@ -164,6 +164,7 @@ cpu "x86" = [
         "/library/sdl/sdl-video.factor"
         "/library/sdl/sdl-event.factor"
         "/library/sdl/sdl-gfx.factor"
+        "/library/sdl/sdl-keysym.factor"
         "/library/sdl/sdl-utils.factor"
         "/library/sdl/hsv.factor"
     ] [

library/sdl/sdl-event.factor

@@ -25,7 +25,7 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-IN: sdl
+IN: sdl-event
 USE: alien
 
 BEGIN-ENUM: 0

library/sdl/sdl-gfx.factor

@@ -1,4 +1,31 @@
-IN: sdl
+! :folding=indent:collapseFolds=1:sidekick.parser=none:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: sdl-gfx
 USE: alien
 
 : pixelColor ( surface x y color -- )

library/sdl/sdl-keysym.factor

@@ -0,0 +1,282 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms ; with or without
+! modification ; are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice ;
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice ;
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ;
+! INCLUDING ; BUT NOT LIMITED TO ; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT ; INDIRECT ; INCIDENTAL ;
+! SPECIAL ; EXEMPLARY ; OR CONSEQUENTIAL DAMAGES (INCLUDING ; BUT NOT LIMITED TO ;
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE ; DATA ; OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY ;
+! WHETHER IN CONTRACT ; STRICT LIABILITY ; OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE ; EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: sdl-keysym
+
+! The keyboard syms have been cleverly chosen to map to ASCII
+: SDLK_UNKNOWN          0 ;
+: SDLK_FIRST            0 ;
+: SDLK_BACKSPACE        8 ;
+: SDLK_TAB              9 ;
+: SDLK_CLEAR            12 ;
+: SDLK_RETURN           13 ;
+: SDLK_PAUSE            19 ;
+: SDLK_ESCAPE           27 ;
+: SDLK_SPACE            32 ;
+: SDLK_EXCLAIM          33 ;
+: SDLK_QUOTEDBL         34 ;
+: SDLK_HASH             35 ;
+: SDLK_DOLLAR           36 ;
+: SDLK_AMPERSAND        38 ;
+: SDLK_QUOTE            39 ;
+: SDLK_LEFTPAREN        40 ;
+: SDLK_RIGHTPAREN       41 ;
+: SDLK_ASTERISK         42 ;
+: SDLK_PLUS             43 ;
+: SDLK_COMMA            44 ;
+: SDLK_MINUS            45 ;
+: SDLK_PERIOD           46 ;
+: SDLK_SLASH            47 ;
+: SDLK_0                48 ;
+: SDLK_1                49 ;
+: SDLK_2                50 ;
+: SDLK_3                51 ;
+: SDLK_4                52 ;
+: SDLK_5                53 ;
+: SDLK_6                54 ;
+: SDLK_7                55 ;
+: SDLK_8                56 ;
+: SDLK_9                57 ;
+: SDLK_COLON            58 ;
+: SDLK_SEMICOLON        59 ;
+: SDLK_LESS             60 ;
+: SDLK_EQUALS           61 ;
+: SDLK_GREATER          62 ;
+: SDLK_QUESTION         63 ;
+: SDLK_AT               64 ;
+
+! Skip uppercase letters
+: SDLK_LEFTBRACKET      91 ;
+: SDLK_BACKSLASH        92 ;
+: SDLK_RIGHTBRACKET     93 ;
+: SDLK_CARET            94 ;
+: SDLK_UNDERSCORE       95 ;
+: SDLK_BACKQUOTE        96 ;
+: SDLK_a                97 ;
+: SDLK_b                98 ;
+: SDLK_c                99 ;
+: SDLK_d                100 ;
+: SDLK_e                101 ;
+: SDLK_f                102 ;
+: SDLK_g                103 ;
+: SDLK_h                104 ;
+: SDLK_i                105 ;
+: SDLK_j                106 ;
+: SDLK_k                107 ;
+: SDLK_l                108 ;
+: SDLK_m                109 ;
+: SDLK_n                110 ;
+: SDLK_o                111 ;
+: SDLK_p                112 ;
+: SDLK_q                113 ;
+: SDLK_r                114 ;
+: SDLK_s                115 ;
+: SDLK_t                116 ;
+: SDLK_u                117 ;
+: SDLK_v                118 ;
+: SDLK_w                119 ;
+: SDLK_x                120 ;
+: SDLK_y                121 ;
+: SDLK_z                122 ;
+: SDLK_DELETE           127 ;
+
+! End of ASCII mapped keysyms
+
+! International keyboard syms
+
+: SDLK_WORLD_0          160 ;           ! 0xA0
+: SDLK_WORLD_1          161 ;
+: SDLK_WORLD_2          162 ;
+: SDLK_WORLD_3          163 ;
+: SDLK_WORLD_4          164 ;
+: SDLK_WORLD_5          165 ;
+: SDLK_WORLD_6          166 ;
+: SDLK_WORLD_7          167 ;
+: SDLK_WORLD_8          168 ;
+: SDLK_WORLD_9          169 ;
+: SDLK_WORLD_10         170 ;
+: SDLK_WORLD_11         171 ;
+: SDLK_WORLD_12         172 ;
+: SDLK_WORLD_13         173 ;
+: SDLK_WORLD_14         174 ;
+: SDLK_WORLD_15         175 ;
+: SDLK_WORLD_16         176 ;
+: SDLK_WORLD_17         177 ;
+: SDLK_WORLD_18         178 ;
+: SDLK_WORLD_19         179 ;
+: SDLK_WORLD_20         180 ;
+: SDLK_WORLD_21         181 ;
+: SDLK_WORLD_22         182 ;
+: SDLK_WORLD_23         183 ;
+: SDLK_WORLD_24         184 ;
+: SDLK_WORLD_25         185 ;
+: SDLK_WORLD_26         186 ;
+: SDLK_WORLD_27         187 ;
+: SDLK_WORLD_28         188 ;
+: SDLK_WORLD_29         189 ;
+: SDLK_WORLD_30         190 ;
+: SDLK_WORLD_31         191 ;
+: SDLK_WORLD_32         192 ;
+: SDLK_WORLD_33         193 ;
+: SDLK_WORLD_34         194 ;
+: SDLK_WORLD_35         195 ;
+: SDLK_WORLD_36         196 ;
+: SDLK_WORLD_37         197 ;
+: SDLK_WORLD_38         198 ;
+: SDLK_WORLD_39         199 ;
+: SDLK_WORLD_40         200 ;
+: SDLK_WORLD_41         201 ;
+: SDLK_WORLD_42         202 ;
+: SDLK_WORLD_43         203 ;
+: SDLK_WORLD_44         204 ;
+: SDLK_WORLD_45         205 ;
+: SDLK_WORLD_46         206 ;
+: SDLK_WORLD_47         207 ;
+: SDLK_WORLD_48         208 ;
+: SDLK_WORLD_49         209 ;
+: SDLK_WORLD_50         210 ;
+: SDLK_WORLD_51         211 ;
+: SDLK_WORLD_52         212 ;
+: SDLK_WORLD_53         213 ;
+: SDLK_WORLD_54         214 ;
+: SDLK_WORLD_55         215 ;
+: SDLK_WORLD_56         216 ;
+: SDLK_WORLD_57         217 ;
+: SDLK_WORLD_58         218 ;
+: SDLK_WORLD_59         219 ;
+: SDLK_WORLD_60         220 ;
+: SDLK_WORLD_61         221 ;
+: SDLK_WORLD_62         222 ;
+: SDLK_WORLD_63         223 ;
+: SDLK_WORLD_64         224 ;
+: SDLK_WORLD_65         225 ;
+: SDLK_WORLD_66         226 ;
+: SDLK_WORLD_67         227 ;
+: SDLK_WORLD_68         228 ;
+: SDLK_WORLD_69         229 ;
+: SDLK_WORLD_70         230 ;
+: SDLK_WORLD_71         231 ;
+: SDLK_WORLD_72         232 ;
+: SDLK_WORLD_73         233 ;
+: SDLK_WORLD_74         234 ;
+: SDLK_WORLD_75         235 ;
+: SDLK_WORLD_76         236 ;
+: SDLK_WORLD_77         237 ;
+: SDLK_WORLD_78         238 ;
+: SDLK_WORLD_79         239 ;
+: SDLK_WORLD_80         240 ;
+: SDLK_WORLD_81         241 ;
+: SDLK_WORLD_82         242 ;
+: SDLK_WORLD_83         243 ;
+: SDLK_WORLD_84         244 ;
+: SDLK_WORLD_85         245 ;
+: SDLK_WORLD_86         246 ;
+: SDLK_WORLD_87         247 ;
+: SDLK_WORLD_88         248 ;
+: SDLK_WORLD_89         249 ;
+: SDLK_WORLD_90         250 ;
+: SDLK_WORLD_91         251 ;
+: SDLK_WORLD_92         252 ;
+: SDLK_WORLD_93         253 ;
+: SDLK_WORLD_94         254 ;
+: SDLK_WORLD_95         255 ;           ! 0xFF
+
+! Numeric keypad
+: SDLK_KP0              256 ;
+: SDLK_KP1              257 ;
+: SDLK_KP2              258 ;
+: SDLK_KP3              259 ;
+: SDLK_KP4              260 ;
+: SDLK_KP5              261 ;
+: SDLK_KP6              262 ;
+: SDLK_KP7              263 ;
+: SDLK_KP8              264 ;
+: SDLK_KP9              265 ;
+: SDLK_KP_PERIOD        266 ;
+: SDLK_KP_DIVIDE        267 ;
+: SDLK_KP_MULTIPLY      268 ;
+: SDLK_KP_MINUS         269 ;
+: SDLK_KP_PLUS          270 ;
+: SDLK_KP_ENTER         271 ;
+: SDLK_KP_EQUALS        272 ;
+
+! Arrows + Home/End pad
+: SDLK_UP               273 ;
+: SDLK_DOWN             274 ;
+: SDLK_RIGHT            275 ;
+: SDLK_LEFT             276 ;
+: SDLK_INSERT           277 ;
+: SDLK_HOME             278 ;
+: SDLK_END              279 ;
+: SDLK_PAGEUP           280 ;
+: SDLK_PAGEDOWN         281 ;
+
+! Function keys
+: SDLK_F1               282 ;
+: SDLK_F2               283 ;
+: SDLK_F3               284 ;
+: SDLK_F4               285 ;
+: SDLK_F5               286 ;
+: SDLK_F6               287 ;
+: SDLK_F7               288 ;
+: SDLK_F8               289 ;
+: SDLK_F9               290 ;
+: SDLK_F10              291 ;
+: SDLK_F11              292 ;
+: SDLK_F12              293 ;
+: SDLK_F13              294 ;
+: SDLK_F14              295 ;
+: SDLK_F15              296 ;
+
+! Key state modifier keys
+: SDLK_NUMLOCK          300 ;
+: SDLK_CAPSLOCK         301 ;
+: SDLK_SCROLLOCK        302 ;
+: SDLK_RSHIFT           303 ;
+: SDLK_LSHIFT           304 ;
+: SDLK_RCTRL            305 ;
+: SDLK_LCTRL            306 ;
+: SDLK_RALT             307 ;
+: SDLK_LALT             308 ;
+: SDLK_RMETA            309 ;
+: SDLK_LMETA            310 ;
+: SDLK_LSUPER           311 ;           ! Left "Windows" key
+: SDLK_RSUPER           312 ;           ! Right "Windows" key
+: SDLK_MODE             313 ;           ! "Alt Gr" key
+: SDLK_COMPOSE          314 ;           ! Multi-key compose key
+
+! Miscellaneous function keys
+: SDLK_HELP             315 ;
+: SDLK_PRINT            316 ;
+: SDLK_SYSREQ           317 ;
+: SDLK_BREAK            318 ;
+: SDLK_MENU             319 ;
+: SDLK_POWER            320 ;           ! Power Macintosh power key
+: SDLK_EURO             321 ;           ! Some european keyboards
+: SDLK_UNDO             322 ;           ! Atari keyboard has Undo
+
+! Add any other keys here

library/sdl/sdl-utils.factor

@@ -1,3 +1,30 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
 IN: sdl
 USE: alien
 USE: math
@@ -12,6 +39,9 @@ USE: combinators
 USE: lists
 USE: logic
 USE: prettyprint
+USE: sdl-event
+USE: sdl-gfx
+USE: sdl-video
 
 SYMBOL: surface
 SYMBOL: width

library/sdl/sdl-video.factor

@@ -25,7 +25,7 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-IN: sdl
+IN: sdl-video
 USE: alien
 USE: combinators
 USE: compiler

native/boolean.c

@@ -0,0 +1,13 @@
+#include "factor.h"
+
+/* FFI calls this */
+void box_boolean(bool value)
+{
+	dpush(value ? T : F);
+}
+
+/* FFI calls this */
+bool unbox_boolean(void)
+{
+	return (dpop() != F);
+}

native/boolean.h

@@ -0,0 +1,12 @@
+INLINE CELL tag_boolean(CELL untagged)
+{
+	return (untagged == false ? F : T);
+}
+
+INLINE bool untag_boolean(CELL tagged)
+{
+	return (tagged == F ? false : true);
+}
+
+void box_boolean(bool value);
+bool unbox_boolean(void);