**TclSDL: SDL Tcl Binding**
* Author: [email protected]
* Homepage: http://mytcl.tcltk.co.kr/?q=node/67
* Demo: http://archive.tcltk.co.kr/index.php?dir=laboratory/tclsdl/demo/
* Download Source & Binary: http://archive.tcltk.co.kr/index.php?dir=laboratory/tclsdl/
* Document: http://www.libsdl.org/cgi/docwiki.cgi
***Supported***
* audio, cdrom, cpuinfo, error, events, keyboard, keysym, mouse, rwops, timer, version, video
* mixer
* ttf
[IMG_TclSDL]
***Sprite Demo***[http://archive.tcltk.co.kr/laboratory/tclsdl/demo/sprite/sprite.png]
======
load ../../tclsdl.dll
set SCREEN_WIDTH 640
set SCREEN_HEIGHT 480
set SPRITE_SIZE 32
set ::rcSprite [new_SDL_Rect]
SDL_Rect_x_set $::rcSprite 0
SDL_Rect_y_set $::rcSprite 0
SDL_Rect_w_set $::rcSprite 0
SDL_Rect_h_set $::rcSprite 0
set ::rcSrc [new_SDL_Rect]
SDL_Rect_x_set $::rcSrc 0
SDL_Rect_y_set $::rcSrc 0
SDL_Rect_w_set $::rcSrc 0
SDL_Rect_h_set $::rcSrc 0
proc HandleEvent {event} {
set event_type [SDL_Event_type_get $event]
if { $event_type == "$::SDL_QUIT" } {
delete_SDL_Rect $::rcSprite
delete_SDL_Rect $::rcSrc
exit
}
if { $event_type == "$::SDL_KEYDOWN" } {
set key_event [SDL_Event_key_get $event]
set keysym_event [SDL_KeyboardEvent_keysym_get $key_event]
set key_name [SDL_GetKeyName [SDL_keysym_sym_get $keysym_event]]
if { $key_name == "escape" || $key_name == "q" } {
delete_SDL_Rect $::rcSprite
delete_SDL_Rect $::rcSrc
exit
}
if { $key_name == "left" } {
set x [SDL_Rect_x_get $::rcSrc]
if { $x == 192 } {
SDL_Rect_x_set $::rcSrc 224
} else {
SDL_Rect_x_set $::rcSrc 192
}
set x [SDL_Rect_x_get $::rcSprite]
SDL_Rect_x_set $::rcSprite [expr $x-5]
}
if { $key_name == "right" } {
set x [SDL_Rect_x_get $::rcSrc]
if { $x == 64 } {
SDL_Rect_x_set $::rcSrc 96
} else {
SDL_Rect_x_set $::rcSrc 64
}
set x [SDL_Rect_x_get $::rcSprite]
SDL_Rect_x_set $::rcSprite [expr $x+5]
}
if { $key_name == "up" } {
set x [SDL_Rect_x_get $::rcSrc]
if { $x == 0 } {
SDL_Rect_x_set $::rcSrc 32
} else {
SDL_Rect_x_set $::rcSrc 0
}
set y [SDL_Rect_y_get $::rcSprite]
SDL_Rect_y_set $::rcSprite [expr $y-5]
}
if { $key_name == "down" } {
set x [SDL_Rect_x_get $::rcSrc]
if { $x == 128 } {
SDL_Rect_x_set $::rcSrc 160
} else {
SDL_Rect_x_set $::rcSrc 128
}
set y [SDL_Rect_y_get $::rcSprite]
SDL_Rect_y_set $::rcSprite [expr $y+5]
}
}
}
proc SDL_LoadBMP {filename} {
set loadedimage [SDL_LoadBMP_RW [SDL_RWFromFile $filename "r"] 1]
set optimizedImage [SDL_DisplayFormat $loadedimage]
SDL_FreeSurface $loadedimage
return $optimizedImage
}
SDL_Init $SDL_INIT_VIDEO
SDL_WM_SetCaption "TclSDL Sprite Demo" "SDL Sprite Demo"
set screen [SDL_SetVideoMode $SCREEN_WIDTH $SCREEN_HEIGHT 0 0]
SDL_EnableKeyRepeat 40 40
# load sprite
set temp [SDL_LoadBMP "sprite.bmp"]
set sprite [SDL_DisplayFormat $temp]
SDL_FreeSurface $temp
set format [SDL_Surface_format_get $screen]
set colorkey [SDL_MapRGB $format 255 0 255]
SDL_SetColorKey $sprite [expr $SDL_SRCCOLORKEY|$SDL_RLEACCEL] $colorkey
# load grass
set temp [SDL_LoadBMP "grass.bmp"]
set grass [SDL_DisplayFormat $temp]
SDL_FreeSurface $temp
SDL_Rect_x_set $::rcSprite 150
SDL_Rect_y_set $::rcSprite 150
SDL_Rect_x_set $::rcSrc 128
SDL_Rect_y_set $::rcSrc 0
SDL_Rect_w_set $::rcSrc $SPRITE_SIZE
SDL_Rect_h_set $::rcSrc $SPRITE_SIZE
set gameover 0
set event [SDL_Event]
while { 1 } {
if { [SDL_PollEvent $event] } {
HandleEvent $event
}
# collide with edges of screen
set x [SDL_Rect_x_get $::rcSprite]
if { $x <= 0 } {
SDL_Rect_x_set $::rcSprite 0
}
if { $x >= [expr $SCREEN_WIDTH - $SPRITE_SIZE] } {
SDL_Rect_x_set $::rcSprite [expr $SCREEN_WIDTH - $SPRITE_SIZE]
}
set y [SDL_Rect_y_get $::rcSprite]
if { $y <= 0 } {
SDL_Rect_y_set $::rcSprite 0
}
if { $y >= [expr $SCREEN_HEIGHT - $SPRITE_SIZE] } {
SDL_Rect_y_set $::rcSprite [expr $SCREEN_HEIGHT - $SPRITE_SIZE]
}
set ::rcGrass [new_SDL_Rect]
SDL_Rect_x_set $::rcGrass 0
SDL_Rect_y_set $::rcGrass 0
SDL_Rect_w_set $::rcGrass 0
SDL_Rect_h_set $::rcGrass 0
# draw the grass
for {set x 0} {$x < [expr $SCREEN_WIDTH / $SPRITE_SIZE]} {incr x} {
for {set y 0} {$y < [expr $SCREEN_HEIGHT / $SPRITE_SIZE]} {incr y} {
SDL_Rect_x_set $::rcGrass [expr $x * $SPRITE_SIZE]
SDL_Rect_y_set $::rcGrass [expr $y * $SPRITE_SIZE]
SDL_UpperBlit $grass NULL $screen $rcGrass
}
}
delete_SDL_Rect $::rcGrass
# draw the sprite
SDL_UpperBlit $sprite $::rcSrc $screen $::rcSprite
# update the screen
SDL_UpdateRect $screen 0 0 0 0
}
SDL_FreeSurface $sprite
SDL_FreeSurface $grass
SDL_Quit
======
***Mixer Demo***
======
load ../../tclsdl.dll
SDL_Init [expr $SDL_INIT_VIDEO|$SDL_INIT_AUDIO]
SDL_SetVideoMode 320 200 32 $SDL_DOUBLEBUF
SDL_WM_SetCaption "SDL Mixer Example" ""
Mix_OpenAudio 44100 $MIX_DEFAULT_FORMAT 2 4096
Mix_AllocateChannels 16
set music [Mix_LoadMUS "2nd_pm.s3m"]
Mix_PlayMusic $music 0
if { [Mix_GetMusicType $music] == $MUS_MOD } {
puts "Playing MOD..."
}
set sound [Mix_LoadWAV_RW [SDL_RWFromFile "reload.ogg" "rb"] 1]
set event [SDL_Event]
while { [SDL_PollEvent $event] >= 0 } {
set event_type [SDL_Event_type_get $event]
if { $event_type == "$SDL_KEYDOWN" } {
set key_event [SDL_Event_key_get $event]
set keysym_event [SDL_KeyboardEvent_keysym_get $key_event]
set key_name [SDL_GetKeyName [SDL_keysym_sym_get $keysym_event]]
if { $key_name == "q" } { break }
if { $key_name == "s" } {
Mix_PlayChannelTimed -1 $sound 0 -1
}
}
SDL_Delay 1
}
Mix_HaltMusic
Mix_FreeMusic $music
======
----
[Googie] 15 May 2009 - Nice to see someone handling this subject. I was playing with SDL + Tcl some time ago, without acceptable results. This one looks very promising. I think that some nice pure-TclOO wrap over this SDL-like interface would be also nice, it's just an idea. Anyway I have a question - is sourcecode planned to be released? I couldn't find it at homepage.
[In-Hak Min] 15 May 2009 - Thanks interested. I will be release source code after some bug fix. i'm sorry. my english skill is bad. :-)
[GS] 17 march 2023 - Does it exist a version of TclDSL compatible with Tcl8.6 ?
<<categories>> SDL | Multimedia