tclsdl

TclSDL: SDL Tcl Binding

Supported

  • audio, cdrom, cpuinfo, error, events, keyboard, keysym, mouse, rwops, timer, version, video
  • mixer
  • ttf

IMG_TclSDL

Sprite Demo

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 ?