**TclSDL: SDL Tcl Binding** * Author: inhak.min@gmail.com * 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*** ****SDL**** * audio, cdrom, cpuinfo, error, events, keyboard, keysym, mouse, rwops, timer, version, video ****SDL_mixer**** ****SDL_ttf**** ***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. :-) ---- !!!!!! %| [SDL] | [Category Multimedia] |% !!!!!!