From 2f1039eb05ffc4f400fc883eec2dd97ea8cf3f53 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 10 Nov 2004 02:51:43 +0000 Subject: [PATCH] added sdl-keysyms, split sdl vocabulary, more factoroids work --- examples/dejong.factor | 3 + examples/factoroids.factor | 210 +++++++++------ examples/mandel.factor | 3 + library/math/pow.factor | 2 +- library/platform/native/boot-stage2.factor | 1 + library/sdl/sdl-event.factor | 2 +- library/sdl/sdl-gfx.factor | 29 ++- library/sdl/sdl-keysym.factor | 282 +++++++++++++++++++++ library/sdl/sdl-utils.factor | 30 +++ library/sdl/sdl-video.factor | 2 +- native/boolean.c | 13 + native/boolean.h | 12 + 12 files changed, 505 insertions(+), 84 deletions(-) create mode 100644 library/sdl/sdl-keysym.factor create mode 100644 native/boolean.c create mode 100644 native/boolean.h diff --git a/examples/dejong.factor b/examples/dejong.factor index 0eb755a8f9..b73a7a03a5 100644 --- a/examples/dejong.factor +++ b/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 diff --git a/examples/factoroids.factor b/examples/factoroids.factor index d5f8870586..bb4384eb84 100644 --- a/examples/factoroids.factor +++ b/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: y +SYMBOL: position SYMBOL: radius SYMBOL: len -SYMBOL: dx -SYMBOL: dy +SYMBOL: velocity 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 get car ; +: player-actor ( -- player ) + player get dup [ car ] when ; -: y-in-screen? ( -- ? ) y get 0 height get between? ; -: x-in-screen? ( -- ? ) x get 0 width get between? ; +: x-in-screen? ( x -- ? ) 0 width get between? ; +: y-in-screen? ( y -- ? ) 0 height get between? ; -: in-screen? ( -- ? ) - #! Is the current 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. +: in-screen? ( actor -- ? ) + #! Is the actor in the screen? [ - velocity - namespace player-actor = [ t ] [ in-screen? ] ifte + position get >rect y-in-screen? swap x-in-screen? and ] 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 ) + [ + 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 ) [ - dy set - 0 dx set + velocity 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 ( -- ) - [ velocity wrap t ] bind ;M +M: particle tick ( actor -- ) + [ 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 ) [ - random-x x set - random-y y set + random-position position set random-color color set - 2 4 random-int dy set - 0 dx set + random-velocity velocity 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 ( -- ) - dup attack [ wiggle velocity y-in-screen? ] bind ;M +M: enemy tick ( actor -- ) + dup attack + dup [ wiggle move position get imaginary ] bind + y-in-screen? swap active? and ;M : spawn-enemy ( -- ) [ - 10 y set - random-x x set + random-x 10 rect> position set red color set 0 wiggle-x set - 0 dx set - 1 dy set + 0 velocity 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 ( -- ) - [ - 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 set ; - : init-game ( -- ) #! Init game objects. - init-player init-stars init-events ; + init-stars + make-ship player set + 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 ; - -: tick-layer ( layer -- ) - dup get [ tick ] subset put ; + [ get [ draw ] each ] each-layer ; : tick-actors ( -- ) - #! Advance game state by one frame. - [ tick-layer ] each-layer ; + #! Advance game state by one frame. Actors whose tick word + #! 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. diff --git a/examples/mandel.factor b/examples/mandel.factor index 50d2a183bd..3bb2d5731f 100644 --- a/examples/mandel.factor +++ b/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 diff --git a/library/math/pow.factor b/library/math/pow.factor index 031633212b..f703b69c6a 100644 --- a/library/math/pow.factor +++ b/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> ; diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor index e68a697293..efb5ef937b 100644 --- a/library/platform/native/boot-stage2.factor +++ b/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" ] [ diff --git a/library/sdl/sdl-event.factor b/library/sdl/sdl-event.factor index 70a9c3b545..d6308db95a 100644 --- a/library/sdl/sdl-event.factor +++ b/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 diff --git a/library/sdl/sdl-gfx.factor b/library/sdl/sdl-gfx.factor index 816f211725..02178434b4 100644 --- a/library/sdl/sdl-gfx.factor +++ b/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 -- ) diff --git a/library/sdl/sdl-keysym.factor b/library/sdl/sdl-keysym.factor new file mode 100644 index 0000000000..26bdd269fc --- /dev/null +++ b/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 diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor index 8aa346681f..a5ec8c3df3 100644 --- a/library/sdl/sdl-utils.factor +++ b/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 diff --git a/library/sdl/sdl-video.factor b/library/sdl/sdl-video.factor index e57fc6e16b..eca6f55a3f 100644 --- a/library/sdl/sdl-video.factor +++ b/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 diff --git a/native/boolean.c b/native/boolean.c new file mode 100644 index 0000000000..81f7c647b5 --- /dev/null +++ b/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); +} diff --git a/native/boolean.h b/native/boolean.h new file mode 100644 index 0000000000..f2be6292ad --- /dev/null +++ b/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);