Remove SDL binding
slava
parent
afb648d99d
commit
662a2c9125
|
|
@ -1,14 +0,0 @@
|
|||
USING: parser sequences ;
|
||||
|
||||
{
|
||||
"/library/sdl/sdl.factor"
|
||||
"/library/sdl/sdl-video.factor"
|
||||
"/library/sdl/sdl-event.factor"
|
||||
"/library/sdl/sdl-keysym.factor"
|
||||
"/library/sdl/sdl-keyboard.factor"
|
||||
"/library/sdl/sdl-utils.factor"
|
||||
"/library/sdl/sdl.factor"
|
||||
"/library/sdl/sdl-video.factor"
|
||||
} [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -1,213 +0,0 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: sdl USING: alien arrays generic kernel ;
|
||||
|
||||
BEGIN-ENUM: 0
|
||||
ENUM: SDL_NOEVENT ! Unused (do not remove)
|
||||
ENUM: SDL_ACTIVEEVENT ! Application loses/gains visibility
|
||||
ENUM: SDL_KEYDOWN ! Keys pressed
|
||||
ENUM: SDL_KEYUP ! Keys released
|
||||
ENUM: SDL_MOUSEMOTION ! Mouse moved
|
||||
ENUM: SDL_MOUSEBUTTONDOWN ! Mouse button pressed
|
||||
ENUM: SDL_MOUSEBUTTONUP ! Mouse button released
|
||||
ENUM: SDL_JOYAXISMOTION ! Joystick axis motion
|
||||
ENUM: SDL_JOYBALLMOTION ! Joystick trackball motion
|
||||
ENUM: SDL_JOYHATMOTION ! Joystick hat position change
|
||||
ENUM: SDL_JOYBUTTONDOWN ! Joystick button pressed
|
||||
ENUM: SDL_JOYBUTTONUP ! Joystick button released
|
||||
ENUM: SDL_QUIT ! User-requested quit
|
||||
ENUM: SDL_SYSWMEVENT ! System specific event
|
||||
ENUM: SDL_EVENT_RESERVEDA ! Reserved for future use..
|
||||
ENUM: SDL_EVENT_RESERVEDB ! Reserved for future use..
|
||||
ENUM: SDL_VIDEORESIZE ! User resized video mode
|
||||
ENUM: SDL_VIDEOEXPOSE ! Screen needs to be redrawn
|
||||
ENUM: SDL_EVENT_RESERVED2 ! Reserved for future use..
|
||||
ENUM: SDL_EVENT_RESERVED3 ! Reserved for future use..
|
||||
ENUM: SDL_EVENT_RESERVED4 ! Reserved for future use..
|
||||
ENUM: SDL_EVENT_RESERVED5 ! Reserved for future use..
|
||||
ENUM: SDL_EVENT_RESERVED6 ! Reserved for future use..
|
||||
ENUM: SDL_EVENT_RESERVED7 ! Reserved for future use..
|
||||
END-ENUM
|
||||
|
||||
! Events SDL_USEREVENT through SDL_MAXEVENTS-1 are for your use
|
||||
: SDL_USEREVENT 24 ;
|
||||
: SDL_MAXEVENT 32 ;
|
||||
|
||||
: SDL_ACTIVEEVENTMASK 2 ;
|
||||
: SDL_KEYDOWNMASK 4 ;
|
||||
: SDL_KEYUPMASK 8 ;
|
||||
: SDL_MOUSEMOTIONMASK 16 ;
|
||||
: SDL_MOUSEBUTTONDOWNMASK 32 ;
|
||||
: SDL_MOUSEBUTTONUPMASK 64 ;
|
||||
: SDL_MOUSEEVENTMASK 112 ;
|
||||
: SDL_JOYAXISMOTIONMASK 128 ;
|
||||
: SDL_JOYBALLMOTIONMASK 256 ;
|
||||
: SDL_JOYHATMOTIONMASK 512 ;
|
||||
: SDL_JOYBUTTONDOWNMASK 1024 ;
|
||||
: SDL_JOYBUTTONUPMASK 2048 ;
|
||||
: SDL_JOYEVENTMASK 3968 ;
|
||||
: SDL_VIDEORESIZEMASK 65536 ;
|
||||
: SDL_VIDEOEXPOSEMASK 131072 ;
|
||||
: SDL_QUITMASK 4096 ;
|
||||
: SDL_SYSWMEVENTMASK 8192 ;
|
||||
|
||||
: SDL_ALLEVENTS HEX: ffffffff ;
|
||||
|
||||
BEGIN-STRUCT: active-event
|
||||
FIELD: uchar type ! SDL_ACTIVEEVENT
|
||||
FIELD: uchar gain ! Whether given states were gained or lost (1/0)
|
||||
FIELD: uchar state ! A mask of the focus states
|
||||
END-STRUCT
|
||||
|
||||
BEGIN-STRUCT: keyboard-event
|
||||
FIELD: uchar type ! SDL_KEYDOWN or SDL_KEYUP
|
||||
FIELD: uchar which ! The keyboard device index
|
||||
FIELD: uchar state ! SDL_PRESSED or SDL_RELEASED
|
||||
! YUCK!
|
||||
FIELD: uchar pad
|
||||
FIELD: uchar pad
|
||||
FIELD: uchar pad
|
||||
! Later: inline structs
|
||||
FIELD: uchar scancode
|
||||
FIELD: int sym
|
||||
FIELD: int mod
|
||||
FIELD: ushort unicode
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array key-down-event
|
||||
keyboard-event-type SDL_KEYDOWN = ;
|
||||
|
||||
PREDICATE: byte-array key-up-event
|
||||
keyboard-event-type SDL_KEYUP = ;
|
||||
|
||||
BEGIN-STRUCT: motion-event
|
||||
FIELD: uchar type ! SDL_MOUSEMOTION
|
||||
FIELD: uchar which ! The mouse device index
|
||||
FIELD: uchar state ! The current button state
|
||||
FIELD: ushort x ! The X/Y coordinates of the mouse
|
||||
FIELD: ushort y
|
||||
FIELD: short xrel ! The relative motion in the X direction
|
||||
FIELD: short yrel ! The relative motion in the Y direction
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array motion-event
|
||||
motion-event-type SDL_MOUSEMOTION = ;
|
||||
|
||||
BEGIN-STRUCT: button-event
|
||||
FIELD: uchar type ! SDL_MOUSEBUTTONDOWN or SDL_MOUSEBUTTONUP
|
||||
FIELD: uchar which ! The mouse device index
|
||||
FIELD: uchar button ! The mouse button index
|
||||
FIELD: uchar state ! SDL_PRESSED or SDL_RELEASED
|
||||
FIELD: ushort x
|
||||
FIELD: ushort y ! The X/Y coordinates of the mouse at press time
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array button-down-event
|
||||
button-event-type SDL_MOUSEBUTTONDOWN = ;
|
||||
|
||||
PREDICATE: byte-array button-up-event
|
||||
button-event-type SDL_MOUSEBUTTONUP = ;
|
||||
|
||||
BEGIN-STRUCT: joy-axis-event
|
||||
FIELD: uchar type ! SDL_JOYAXISMOTION
|
||||
FIELD: uchar which ! The joystick device index
|
||||
FIELD: uchar axis ! The joystick axis index
|
||||
FIELD: short value ! The axis value
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array joy-axis-event
|
||||
joy-axis-event-type SDL_JOYAXISMOTION = ;
|
||||
|
||||
BEGIN-STRUCT: joy-ball-event
|
||||
FIELD: uchar type ! SDL_JOYBALLMOTION
|
||||
FIELD: uchar which ! The joystick device index
|
||||
FIELD: uchar ball ! The joystick trackball index
|
||||
FIELD: short xrel ! The relative motion in the X direction
|
||||
FIELD: short yrel ! The relative motion in the Y direction
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array joy-ball-event
|
||||
joy-ball-event-type SDL_JOYBALLMOTION = ;
|
||||
|
||||
BEGIN-STRUCT: joy-hat-event
|
||||
FIELD: uchar type ! SDL_JOYHATMOTION
|
||||
FIELD: uchar which ! The joystick device index
|
||||
FIELD: uchar hat ! The joystick hat index
|
||||
FIELD: uchar value ! The hat position value:
|
||||
! SDL_HAT_LEFTUP SDL_HAT_UP SDL_HAT_RIGHTUP
|
||||
! SDL_HAT_LEFT SDL_HAT_CENTERED SDL_HAT_RIGHT
|
||||
! SDL_HAT_LEFTDOWN SDL_HAT_DOWN SDL_HAT_RIGHTDOWN
|
||||
! Note that zero means the POV is centered.
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array joy-hat-event
|
||||
joy-hat-event-type SDL_JOYHATMOTION = ;
|
||||
|
||||
BEGIN-STRUCT: joy-button-event
|
||||
FIELD: uchar type ! SDL_JOYBUTTONDOWN or SDL_JOYBUTTONUP
|
||||
FIELD: uchar which ! The joystick device index
|
||||
FIELD: uchar button ! The joystick button index
|
||||
FIELD: uchar state ! SDL_PRESSED or SDL_RELEASED
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array joy-button-down-event
|
||||
joy-button-event-type SDL_JOYBUTTONDOWN = ;
|
||||
|
||||
PREDICATE: byte-array joy-button-up-event
|
||||
joy-button-event-type SDL_JOYBUTTONUP = ;
|
||||
|
||||
BEGIN-STRUCT: resize-event
|
||||
FIELD: uchar type ! SDL_VIDEORESIZE
|
||||
FIELD: int w ! New width
|
||||
FIELD: int h ! New height
|
||||
END-STRUCT
|
||||
|
||||
BEGIN-STRUCT: expose-event
|
||||
FIELD: uchar type ! SDL_VIDEOEXPOSE
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array resize-event
|
||||
resize-event-type SDL_VIDEORESIZE = ;
|
||||
|
||||
BEGIN-STRUCT: quit-event
|
||||
FIELD: uchar type ! SDL_QUIT
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array quit-event
|
||||
quit-event-type SDL_QUIT = ;
|
||||
|
||||
BEGIN-STRUCT: user-event
|
||||
FIELD: uchar type ! SDL_USREVENT through SDL_NUMEVENTS-1
|
||||
FIELD: int code
|
||||
FIELD: void* data1
|
||||
FIELD: void* data2
|
||||
END-STRUCT
|
||||
|
||||
PREDICATE: byte-array user-event
|
||||
user-event-type SDL_QUIT = ;
|
||||
|
||||
BEGIN-STRUCT: event
|
||||
FIELD: uchar type
|
||||
END-STRUCT
|
||||
|
||||
BEGIN-UNION: event
|
||||
MEMBER: event
|
||||
MEMBER: active-event
|
||||
MEMBER: keyboard-event
|
||||
MEMBER: motion-event
|
||||
MEMBER: button-event
|
||||
MEMBER: joy-axis-event
|
||||
MEMBER: joy-ball-event
|
||||
MEMBER: joy-hat-event
|
||||
MEMBER: joy-button-event
|
||||
MEMBER: resize-event
|
||||
MEMBER: expose-event
|
||||
MEMBER: quit-event
|
||||
MEMBER: user-event
|
||||
END-UNION
|
||||
|
||||
: SDL_WaitEvent ( event -- ? )
|
||||
"bool" "sdl" "SDL_WaitEvent" [ "event*" ] alien-invoke ;
|
||||
|
||||
: SDL_PollEvent ( event -- ? )
|
||||
"bool" "sdl" "SDL_PollEvent" [ "event*" ] alien-invoke ;
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: sdl
|
||||
USING: alien lists namespaces kernel math hashtables
|
||||
sequences ;
|
||||
|
||||
: SDL_EnableUNICODE ( enable -- )
|
||||
"int" "sdl" "SDL_EnableUNICODE" [ "int" ] alien-invoke ;
|
||||
|
||||
: SDL_DEFAULT_REPEAT_DELAY 500 ;
|
||||
: SDL_DEFAULT_REPEAT_INTERVAL 30 ;
|
||||
|
||||
: SDL_EnableKeyRepeat ( delay interval -- )
|
||||
"int" "sdl" "SDL_EnableKeyRepeat" [ "int" "int" ] alien-invoke ;
|
||||
|
||||
: modifier ( mod -- str )
|
||||
[ modifiers [ uncons rot bitand 0 > ?, ] each-with ] [ ] make ;
|
||||
|
||||
: keysym ( sym -- str )
|
||||
#! Return the original keysym number if its unknown.
|
||||
[ keysyms hash dup ] keep ? ;
|
||||
|
||||
: keyboard-event>binding ( event -- binding )
|
||||
#! Turn a key event into a binding, which is a list where
|
||||
#! all elements but the last one are modifier names looked
|
||||
#! up the modifiers alist, and the last element is a keysym
|
||||
#! look up in the keysyms hash.
|
||||
dup keyboard-event-mod modifier
|
||||
swap keyboard-event-sym keysym add ;
|
||||
|
|
@ -1,260 +0,0 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: sdl USING: namespaces ;
|
||||
|
||||
! Here we smash left/right control/shift/alt for convinience.
|
||||
! Later, something better needs to be done.
|
||||
|
||||
: modifiers
|
||||
{
|
||||
[[ "SHIFT" HEX: 0003 ]]
|
||||
[[ "CTRL" HEX: 00c0 ]]
|
||||
[[ "ALT" HEX: 0300 ]]
|
||||
[[ "META" HEX: 0c00 ]]
|
||||
} ;
|
||||
|
||||
: keysyms
|
||||
H{
|
||||
! The keyboard syms have been cleverly chosen to map to ASCII
|
||||
{ 0 "UNKNOWN" }
|
||||
{ 8 "BACKSPACE" }
|
||||
{ 9 "TAB" }
|
||||
{ 12 "CLEAR" }
|
||||
{ 13 "RETURN" }
|
||||
{ 19 "PAUSE" }
|
||||
{ 27 "ESCAPE" }
|
||||
{ 32 "SPACE" }
|
||||
{ 33 "EXCLAIM" }
|
||||
{ 34 "QUOTEDBL" }
|
||||
{ 35 "HASH" }
|
||||
{ 36 "DOLLAR" }
|
||||
{ 38 "AMPERSAND" }
|
||||
{ 39 "QUOTE" }
|
||||
{ 40 "LEFTPAREN" }
|
||||
{ 41 "RIGHTPAREN" }
|
||||
{ 42 "ASTERISK" }
|
||||
{ 43 "PLUS" }
|
||||
{ 44 "COMMA" }
|
||||
{ 45 "MINUS" }
|
||||
{ 46 "PERIOD" }
|
||||
{ 47 "SLASH" }
|
||||
{ 48 0 }
|
||||
{ 49 1 }
|
||||
{ 50 2 }
|
||||
{ 51 3 }
|
||||
{ 52 4 }
|
||||
{ 53 5 }
|
||||
{ 54 6 }
|
||||
{ 55 7 }
|
||||
{ 56 8 }
|
||||
{ 57 9 }
|
||||
{ 58 "COLON" }
|
||||
{ 59 "SEMICOLON" }
|
||||
{ 60 "LESS" }
|
||||
{ 61 "EQUALS" }
|
||||
{ 62 "GREATER" }
|
||||
{ 63 "QUESTION" }
|
||||
{ 64 "AT" }
|
||||
! Skip uppercase letters
|
||||
{ 91 "LEFTBRACKET" }
|
||||
{ 92 "BACKSLASH" }
|
||||
{ 93 "RIGHTBRACKET" }
|
||||
{ 94 "CARET" }
|
||||
{ 95 "UNDERSCORE" }
|
||||
{ 96 "BACKQUOTE" }
|
||||
{ 97 "a" }
|
||||
{ 98 "b" }
|
||||
{ 99 "c" }
|
||||
{ 100 "d" }
|
||||
{ 101 "e" }
|
||||
{ 102 "f" }
|
||||
{ 103 "g" }
|
||||
{ 104 "h" }
|
||||
{ 105 "i" }
|
||||
{ 106 "j" }
|
||||
{ 107 "k" }
|
||||
{ 108 "l" }
|
||||
{ 109 "m" }
|
||||
{ 110 "n" }
|
||||
{ 111 "o" }
|
||||
{ 112 "p" }
|
||||
{ 113 "q" }
|
||||
{ 114 "r" }
|
||||
{ 115 "s" }
|
||||
{ 116 "t" }
|
||||
{ 117 "u" }
|
||||
{ 118 "v" }
|
||||
{ 119 "w" }
|
||||
{ 120 "x" }
|
||||
{ 121 "y" }
|
||||
{ 122 "z" }
|
||||
{ 127 "DELETE" }
|
||||
! End of ASCII mapped keysyms
|
||||
! International keyboard syms
|
||||
{ 160 "WORLD_0" } ! 0xA0
|
||||
{ 161 "WORLD_1" }
|
||||
{ 162 "WORLD_2" }
|
||||
{ 163 "WORLD_3" }
|
||||
{ 164 "WORLD_4" }
|
||||
{ 165 "WORLD_5" }
|
||||
{ 166 "WORLD_6" }
|
||||
{ 167 "WORLD_7" }
|
||||
{ 168 "WORLD_8" }
|
||||
{ 169 "WORLD_9" }
|
||||
{ 170 "WORLD_10" }
|
||||
{ 171 "WORLD_11" }
|
||||
{ 172 "WORLD_12" }
|
||||
{ 173 "WORLD_13" }
|
||||
{ 174 "WORLD_14" }
|
||||
{ 175 "WORLD_15" }
|
||||
{ 176 "WORLD_16" }
|
||||
{ 177 "WORLD_17" }
|
||||
{ 178 "WORLD_18" }
|
||||
{ 179 "WORLD_19" }
|
||||
{ 180 "WORLD_20" }
|
||||
{ 181 "WORLD_21" }
|
||||
{ 182 "WORLD_22" }
|
||||
{ 183 "WORLD_23" }
|
||||
{ 184 "WORLD_24" }
|
||||
{ 185 "WORLD_25" }
|
||||
{ 186 "WORLD_26" }
|
||||
{ 187 "WORLD_27" }
|
||||
{ 188 "WORLD_28" }
|
||||
{ 189 "WORLD_29" }
|
||||
{ 190 "WORLD_30" }
|
||||
{ 191 "WORLD_31" }
|
||||
{ 192 "WORLD_32" }
|
||||
{ 193 "WORLD_33" }
|
||||
{ 194 "WORLD_34" }
|
||||
{ 195 "WORLD_35" }
|
||||
{ 196 "WORLD_36" }
|
||||
{ 197 "WORLD_37" }
|
||||
{ 198 "WORLD_38" }
|
||||
{ 199 "WORLD_39" }
|
||||
{ 200 "WORLD_40" }
|
||||
{ 201 "WORLD_41" }
|
||||
{ 202 "WORLD_42" }
|
||||
{ 203 "WORLD_43" }
|
||||
{ 204 "WORLD_44" }
|
||||
{ 205 "WORLD_45" }
|
||||
{ 206 "WORLD_46" }
|
||||
{ 207 "WORLD_47" }
|
||||
{ 208 "WORLD_48" }
|
||||
{ 209 "WORLD_49" }
|
||||
{ 210 "WORLD_50" }
|
||||
{ 211 "WORLD_51" }
|
||||
{ 212 "WORLD_52" }
|
||||
{ 213 "WORLD_53" }
|
||||
{ 214 "WORLD_54" }
|
||||
{ 215 "WORLD_55" }
|
||||
{ 216 "WORLD_56" }
|
||||
{ 217 "WORLD_57" }
|
||||
{ 218 "WORLD_58" }
|
||||
{ 219 "WORLD_59" }
|
||||
{ 220 "WORLD_60" }
|
||||
{ 221 "WORLD_61" }
|
||||
{ 222 "WORLD_62" }
|
||||
{ 223 "WORLD_63" }
|
||||
{ 224 "WORLD_64" }
|
||||
{ 225 "WORLD_65" }
|
||||
{ 226 "WORLD_66" }
|
||||
{ 227 "WORLD_67" }
|
||||
{ 228 "WORLD_68" }
|
||||
{ 229 "WORLD_69" }
|
||||
{ 230 "WORLD_70" }
|
||||
{ 231 "WORLD_71" }
|
||||
{ 232 "WORLD_72" }
|
||||
{ 233 "WORLD_73" }
|
||||
{ 234 "WORLD_74" }
|
||||
{ 235 "WORLD_75" }
|
||||
{ 236 "WORLD_76" }
|
||||
{ 237 "WORLD_77" }
|
||||
{ 238 "WORLD_78" }
|
||||
{ 239 "WORLD_79" }
|
||||
{ 240 "WORLD_80" }
|
||||
{ 241 "WORLD_81" }
|
||||
{ 242 "WORLD_82" }
|
||||
{ 243 "WORLD_83" }
|
||||
{ 244 "WORLD_84" }
|
||||
{ 245 "WORLD_85" }
|
||||
{ 246 "WORLD_86" }
|
||||
{ 247 "WORLD_87" }
|
||||
{ 248 "WORLD_88" }
|
||||
{ 249 "WORLD_89" }
|
||||
{ 250 "WORLD_90" }
|
||||
{ 251 "WORLD_91" }
|
||||
{ 252 "WORLD_92" }
|
||||
{ 253 "WORLD_93" }
|
||||
{ 254 "WORLD_94" }
|
||||
{ 255 "WORLD_95" } ! 0xFF
|
||||
! Numeric keypad
|
||||
{ 256 "KP0" }
|
||||
{ 257 "KP1" }
|
||||
{ 258 "KP2" }
|
||||
{ 259 "KP3" }
|
||||
{ 260 "KP4" }
|
||||
{ 261 "KP5" }
|
||||
{ 262 "KP6" }
|
||||
{ 263 "KP7" }
|
||||
{ 264 "KP8" }
|
||||
{ 265 "KP9" }
|
||||
{ 266 "KP_PERIOD" }
|
||||
{ 267 "KP_DIVIDE" }
|
||||
{ 268 "KP_MULTIPLY" }
|
||||
{ 269 "KP_MINUS" }
|
||||
{ 270 "KP_PLUS" }
|
||||
{ 271 "KP_ENTER" }
|
||||
{ 272 "KP_EQUALS" }
|
||||
! Arrows + Home/End pad
|
||||
{ 273 "UP" }
|
||||
{ 274 "DOWN" }
|
||||
{ 275 "RIGHT" }
|
||||
{ 276 "LEFT" }
|
||||
{ 277 "INSERT" }
|
||||
{ 278 "HOME" }
|
||||
{ 279 "END" }
|
||||
{ 280 "PAGEUP" }
|
||||
{ 281 "PAGEDOWN" }
|
||||
! Function keys
|
||||
{ 282 "F1" }
|
||||
{ 283 "F2" }
|
||||
{ 284 "F3" }
|
||||
{ 285 "F4" }
|
||||
{ 286 "F5" }
|
||||
{ 287 "F6" }
|
||||
{ 288 "F7" }
|
||||
{ 289 "F8" }
|
||||
{ 290 "F9" }
|
||||
{ 291 "F10" }
|
||||
{ 292 "F11" }
|
||||
{ 293 "F12" }
|
||||
{ 294 "F13" }
|
||||
{ 295 "F14" }
|
||||
{ 296 "F15" }
|
||||
! Key state modifier keys
|
||||
{ 300 "NUMLOCK" }
|
||||
{ 301 "CAPSLOCK" }
|
||||
{ 302 "SCROLLOCK" }
|
||||
{ 303 "RSHIFT" }
|
||||
{ 304 "LSHIFT" }
|
||||
{ 305 "RCTRL" }
|
||||
{ 306 "LCTRL" }
|
||||
{ 307 "RALT" }
|
||||
{ 308 "LALT" }
|
||||
{ 309 "RMETA" }
|
||||
{ 310 "LMETA" }
|
||||
{ 311 "LSUPER" } ! Left "Windows" key
|
||||
{ 312 "RSUPER" } ! Right "Windows" key
|
||||
{ 313 "MODE" } ! "Alt Gr" key
|
||||
{ 314 "COMPOSE" } ! Multi-key compose key
|
||||
! Miscellaneous function keys
|
||||
{ 315 "HELP" }
|
||||
{ 316 "PRINT" }
|
||||
{ 317 "SYSREQ" }
|
||||
{ 318 "BREAK" }
|
||||
{ 319 "MENU" }
|
||||
{ 320 "POWER" } ! Power Macintosh power key
|
||||
{ 321 "EURO" } ! Some european keyboards
|
||||
{ 322 "UNDO" } ! Atari keyboard has Undo
|
||||
! Add any other keys here
|
||||
} ;
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: sdl
|
||||
USING: alien arrays errors hashtables io kernel lists math
|
||||
namespaces sequences styles ;
|
||||
|
||||
SYMBOL: surface
|
||||
SYMBOL: width
|
||||
SYMBOL: height
|
||||
SYMBOL: bpp
|
||||
|
||||
: sdl-error ( 0/-1 -- )
|
||||
zero? [ SDL_GetError throw ] unless ;
|
||||
|
||||
: init-keyboard ( -- )
|
||||
1 SDL_EnableUNICODE drop
|
||||
SDL_DEFAULT_REPEAT_DELAY SDL_DEFAULT_REPEAT_INTERVAL
|
||||
SDL_EnableKeyRepeat drop ;
|
||||
|
||||
: init-surface ( width height bpp flags -- )
|
||||
>r 3dup bpp set height set width set r>
|
||||
SDL_SetVideoMode surface set ;
|
||||
|
||||
: init-sdl ( width height bpp flags -- )
|
||||
SDL_INIT_EVERYTHING SDL_Init sdl-error
|
||||
init-keyboard init-surface ;
|
||||
|
||||
: with-screen ( width height bpp flags quot -- )
|
||||
#! Set up SDL graphics and call the quotation.
|
||||
[ [ >r init-sdl r> call ] [ SDL_Quit ] cleanup ] with-scope ;
|
||||
inline
|
||||
|
||||
: must-lock-surface? ( -- ? )
|
||||
#! This is a macro in SDL_video.h.
|
||||
surface get dup surface-offset zero? [
|
||||
surface-flags
|
||||
SDL_HWSURFACE SDL_ASYNCBLIT bitor SDL_RLEACCEL bitor
|
||||
bitand zero? not
|
||||
] [
|
||||
drop t
|
||||
] if ;
|
||||
|
||||
: lock-surface ( -- )
|
||||
must-lock-surface? [ surface get SDL_LockSurface drop ] when ;
|
||||
|
||||
: unlock-surface ( -- )
|
||||
must-lock-surface? [ surface get SDL_UnlockSurface ] when ;
|
||||
|
||||
: with-surface ( quot -- )
|
||||
#! Execute a quotation, locking the current surface if it
|
||||
#! is required (eg, hardware surface).
|
||||
[ lock-surface call ]
|
||||
[ unlock-surface surface get SDL_Flip ]
|
||||
cleanup ; inline
|
||||
|
|
@ -1,146 +0,0 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: sdl USING: alien kernel math ;
|
||||
|
||||
! These are the currently supported flags for the SDL_surface
|
||||
! Available for SDL_CreateRGBSurface() or SDL_SetVideoMode()
|
||||
: SDL_SWSURFACE HEX: 00000000 ; ! Surface is in system memory
|
||||
: SDL_HWSURFACE HEX: 00000001 ; ! Surface is in video memory
|
||||
: SDL_ASYNCBLIT HEX: 00000004 ; ! Use asynchronous blits if possible
|
||||
! Available for SDL_SetVideoMode()
|
||||
: SDL_ANYFORMAT HEX: 10000000 ; ! Allow any video depth/pixel-format
|
||||
: SDL_HWPALETTE HEX: 20000000 ; ! Surface has exclusive palette
|
||||
: SDL_DOUBLEBUF HEX: 40000000 ; ! Set up double-buffered video mode
|
||||
: SDL_FULLSCREEN HEX: 80000000 ; ! Surface is a full screen display
|
||||
: SDL_OPENGL HEX: 00000002 ; ! Create an OpenGL rendering context
|
||||
: SDL_OPENGLBLIT HEX: 0000000A ; ! Create an OpenGL rendering context and use it for blitting
|
||||
: SDL_RESIZABLE HEX: 00000010 ; ! This video mode may be resized
|
||||
: SDL_NOFRAME HEX: 00000020 ; ! No window caption or edge frame
|
||||
! Used internally (read-only)
|
||||
: SDL_HWACCEL HEX: 00000100 ; ! Blit uses hardware acceleration
|
||||
: SDL_SRCCOLORKEY HEX: 00001000 ; ! Blit uses a source color key
|
||||
: SDL_RLEACCELOK HEX: 00002000 ; ! Private flag
|
||||
: SDL_RLEACCEL HEX: 00004000 ; ! Surface is RLE encoded
|
||||
: SDL_SRCALPHA HEX: 00010000 ; ! Blit uses source alpha blending
|
||||
: SDL_PREALLOC HEX: 01000000 ; ! Surface uses preallocated memory
|
||||
|
||||
BEGIN-STRUCT: sdl-rect
|
||||
FIELD: short x
|
||||
FIELD: short y
|
||||
FIELD: ushort w
|
||||
FIELD: ushort h
|
||||
END-STRUCT
|
||||
|
||||
BEGIN-STRUCT: sdl-color
|
||||
FIELD: uchar r
|
||||
FIELD: uchar g
|
||||
FIELD: uchar b
|
||||
FIELD: uchar unused
|
||||
END-STRUCT
|
||||
|
||||
BEGIN-STRUCT: sdl-format
|
||||
FIELD: void* palette
|
||||
FIELD: uchar BitsPerPixel
|
||||
FIELD: uchar BytesPerPixel
|
||||
FIELD: uchar Rloss
|
||||
FIELD: uchar Gloss
|
||||
FIELD: uchar Bloss
|
||||
FIELD: uchar Aloss
|
||||
FIELD: uchar Rshift
|
||||
FIELD: uchar Gshift
|
||||
FIELD: uchar Bshift
|
||||
FIELD: uchar Ashift
|
||||
FIELD: uint Rmask
|
||||
FIELD: uint Gmask
|
||||
FIELD: uint Bmask
|
||||
FIELD: uint Amask
|
||||
FIELD: uint colorkey
|
||||
FIELD: uchar alpha
|
||||
END-STRUCT
|
||||
|
||||
BEGIN-STRUCT: surface
|
||||
FIELD: uint flags
|
||||
FIELD: sdl-format* format
|
||||
FIELD: int w
|
||||
FIELD: int h
|
||||
FIELD: ushort pitch
|
||||
FIELD: void* pixels
|
||||
FIELD: int offset
|
||||
FIELD: void* hwdata
|
||||
FIELD: short clip-x
|
||||
FIELD: short clip-y
|
||||
FIELD: ushort clip-w
|
||||
FIELD: ushort clip-h
|
||||
FIELD: uint unused1
|
||||
FIELD: uint locked
|
||||
FIELD: int map
|
||||
FIELD: uint format_version
|
||||
FIELD: int refcount
|
||||
END-STRUCT
|
||||
|
||||
: SDL_VideoInit ( driver-name flags -- )
|
||||
"int" "sdl" "SDL_VideoInit"
|
||||
[ "char*" "int" ] alien-invoke ;
|
||||
|
||||
: SDL_VideoQuit ( -- )
|
||||
"void" "sdl" "SDL_VideoQuit" [ ] alien-invoke ;
|
||||
|
||||
! SDL_VideoDriverName -- needs strings as out params.
|
||||
|
||||
: SDL_GetVideoSurface ( -- surface )
|
||||
"surface*" "sdl" "SDL_GetVideoSurface" [ ] alien-invoke ;
|
||||
|
||||
! SDL_GetVideoInfo needs C struct bitfield support
|
||||
|
||||
: SDL_VideoModeOK ( width height bpp flags -- )
|
||||
"int" "sdl" "SDL_VideoModeOK"
|
||||
[ "int" "int" "int" "int" ] alien-invoke ;
|
||||
|
||||
! SDL_ListModes needs array of structs support
|
||||
|
||||
: SDL_SetVideoMode ( width height bpp flags -- )
|
||||
"surface*" "sdl" "SDL_SetVideoMode"
|
||||
[ "int" "int" "int" "int" ] alien-invoke ;
|
||||
|
||||
! UpdateRects, UpdateRect
|
||||
|
||||
: SDL_Flip ( surface -- )
|
||||
"void" "sdl" "SDL_Flip" [ "surface*" ] alien-invoke ;
|
||||
|
||||
! SDL_SetGamma: float types
|
||||
|
||||
: SDL_MapRGB ( surface r g b -- rgb )
|
||||
"uint" "sdl" "SDL_MapRGB"
|
||||
[ "surface*" "uchar" "uchar" "uchar" ] alien-invoke ;
|
||||
|
||||
: SDL_LockSurface ( surface -- ? )
|
||||
"bool" "sdl" "SDL_LockSurface" [ "surface*" ] alien-invoke ;
|
||||
|
||||
: SDL_UnlockSurface ( surface -- )
|
||||
"void" "sdl" "SDL_UnlockSurface" [ "surface*" ] alien-invoke ;
|
||||
|
||||
: SDL_SetClipRect ( surface rect -- ? )
|
||||
"bool" "sdl" "SDL_SetClipRect" [ "surface*" "sdl-rect*" ] alien-invoke ;
|
||||
|
||||
: SDL_FreeSurface ( surface -- )
|
||||
"void" "sdl" "SDL_FreeSurface" [ "surface*" ] alien-invoke ;
|
||||
|
||||
: SDL_UpperBlit ( src srcrect dst dstrect -- )
|
||||
#! The blit function should not be called on a locked
|
||||
#! surface.
|
||||
"int" "sdl" "SDL_UpperBlit" [
|
||||
"surface*" "sdl-rect*"
|
||||
"surface*" "sdl-rect*"
|
||||
] alien-invoke ;
|
||||
|
||||
: SDL_FillRect ( surface rect color -- n )
|
||||
#! If rect is null, fills entire surface.
|
||||
"bool" "sdl" "SDL_FillRect"
|
||||
[ "surface*" "sdl-rect*" "uint" ] alien-invoke ;
|
||||
|
||||
: SDL_WM_SetCaption ( title icon -- )
|
||||
"void" "sdl" "SDL_WM_SetCaption"
|
||||
[ "char*" "char*" ] alien-invoke ;
|
||||
|
||||
: SDL_GL_SwapBuffers ( -- )
|
||||
"void" "sdl" "SDL_GL_SwapBuffers" [ ] alien-invoke ;
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: sdl
|
||||
USING: alien kernel ;
|
||||
|
||||
{
|
||||
{ [ os "macosx" = ] [ ] }
|
||||
{ [ os "win32" = ] [ "sdl" "sdl.dll" "cdecl" add-library ] }
|
||||
{ [ t ] [ "sdl" "libSDL.so" "cdecl" add-library ] }
|
||||
} cond
|
||||
|
||||
: SDL_INIT_TIMER HEX: 00000001 ;
|
||||
: SDL_INIT_AUDIO HEX: 00000010 ;
|
||||
: SDL_INIT_VIDEO HEX: 00000020 ;
|
||||
: SDL_INIT_CDROM HEX: 00000100 ;
|
||||
: SDL_INIT_JOYSTICK HEX: 00000200 ;
|
||||
: SDL_INIT_NOPARACHUTE HEX: 00100000 ;
|
||||
: SDL_INIT_EVENTTHREAD HEX: 01000000 ;
|
||||
: SDL_INIT_EVERYTHING HEX: 0000FFFF ;
|
||||
|
||||
: SDL_Init ( mode -- 0/1 )
|
||||
"int" "sdl" "SDL_Init" [ "int" ] alien-invoke ;
|
||||
|
||||
: SDL_GetError ( -- error )
|
||||
"char*" "sdl" "SDL_GetError" [ ] alien-invoke ;
|
||||
|
||||
: SDL_Quit ( -- )
|
||||
"void" "sdl" "SDL_Quit" [ ] alien-invoke ;
|
||||
Loading…
Reference in New Issue