steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

cvs
Slava Pestov 2004-11-10 02:51:43 +00:00
parent a3bb6acf52
commit 2f1039eb05
12 changed files with 505 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
examples/dejong.factor
View File

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

210
examples/factoroids.factor
View File

@ -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 )
<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
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 )
<particle> [
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 ( -- )
<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 ( -- )
<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 ;
: 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.

3
examples/mandel.factor
View File

@ -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

2
library/math/pow.factor
View File

@ -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> ;

1
library/platform/native/boot-stage2.factor
View File

@ -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"
] [

2
library/sdl/sdl-event.factor
View File

@ -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

29
library/sdl/sdl-gfx.factor
View File

@ -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 -- )

282
library/sdl/sdl-keysym.factor Normal file
View File

@ -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

30
library/sdl/sdl-utils.factor
View File

@ -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

2
library/sdl/sdl-video.factor
View File

@ -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

13
native/boolean.c Normal file
View File

@ -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);
}

12
native/boolean.h Normal file
View File

@ -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);