Posted to tcl by ro at Mon Jan 07 19:15:06 GMT 2008view raw

  1.  
  2. SDL_Init $SDL_INIT_VIDEO
  3. set screen [SDL_SetVideoMode 400 600 32 0]
  4.  
  5. set pixel_format [$screen cget -format]
  6.  
  7. proc color {r g b} {
  8. global pixel_format
  9. SDL_MapRGB $pixel_format $r $g $b
  10. }
  11.  
  12. proc check_events {} {
  13. # if there are SDL events:
  14. if {[SDL_PollEvent NULL]} {
  15. process_events
  16. }
  17. after 10 check_events ;# this is the big cpu user
  18. }
  19.  
  20. set e [SDL_Event]
  21. proc process_events {} {
  22. global e
  23. while {[SDL_PollEvent $e]} {
  24. set type [$e cget -type]
  25. if {$type == $::SDL_MOUSEMOTION} {
  26. set motion [$e cget -motion]
  27. set dx [$motion cget -xrel]
  28. set dy [$motion cget -yrel]
  29. move_square $dx $dy
  30. }
  31. }
  32. return
  33. }
  34.  
  35.  
  36. set square_rect [SDL_Rect]
  37. $square_rect configure -x 100 -y 100 -w 100 -h 100
  38.  
  39. proc paint {} {
  40. global screen square_rect
  41. SDL_LockSurface $screen
  42. SDL_FillRect $screen NULL [color 0 0 255] ;# background
  43. SDL_FillRect $screen $square_rect [color 0 255 0] ;# square
  44. SDL_UnlockSurface $screen
  45. SDL_Flip $screen
  46. }
  47.  
  48. proc move_square {dx dy} {
  49. global square_rect
  50. #puts "moving by $dx $dy"
  51. set x [$square_rect cget -x]
  52. set y [$square_rect cget -y]
  53. set nx [expr {$x + $dx}]
  54. set ny [expr {$y + $dy}]
  55. if {$nx < 0} {set nx 0} ; if {$ny < 0} {set ny 0}
  56. if {$nx > 300} {set nx 300} ; if {$ny > 500} {set ny 500}
  57. $square_rect configure -x $nx -y $ny
  58. paint
  59. }
  60.  
  61. check_events
  62.