(require-extension sdl)
(define maxx 640)
(define maxy 480)

(if (< (length (argv)) 2)
    (begin (display "Usage: test-sdl path-to-ttf-font")
           (newline)
	   (exit 1)))
(define fontname (cadr (argv)))
(ttf-init)

(sdl-wm-set-caption "TestSDL" "TestSDL")
(define s (sdl-set-video-mode maxx maxy 0 (+ SDL_HWSURFACE
					     SDL_HWPALETTE
					     SDL_DOUBLEBUF)))

(sdl-show-cursor #f)

(define (draw-random-rect!)
  (sdl-fill-rect s
		 (make-sdl-rect (random maxx)
				(random maxy)
				(random maxx)
				(random maxy))
		 (sdl-map-rgb (sdl-surface-pixel-format s)
			      (random 255)
			      (random 255)
			      (random 255))))

(do ((i 0 (+ i 1)))
    ((= i 1000))
  (draw-random-rect!))

(define (periodic-rectangle)
  (draw-random-rect!)
  (sdl-flip s)
  (sdl-add-relative-timer! 1.0 periodic-rectangle))
(sdl-add-relative-timer! 4.0 periodic-rectangle)

(sdl-fill-rect s (make-sdl-rect 10 10 300 250) (make-sdl-color 0 0 255))

(define f (ttf-open-font fontname 48))
(let ((r (make-sdl-rect 0 0 0 0)))
  (ttf-size-text! f "Hello, world!" r)
  (display "Size of text: ")
  (display r)
  (newline))
(define s2 (ttf-render-text-solid f "Hello, world!" (make-sdl-color 255 255 255)))
(sdl-blit-surface s2 #f s (make-sdl-rect 10 100 50 50))
(sdl-free-surface s2)
(define s2 (ttf-render-text-blended f "Hello, world!" (make-sdl-color 255 255 255)))
(sdl-blit-surface s2 #f s (make-sdl-rect 10 10 50 50))
(sdl-free-surface s2)

(let* ((x (img-load "unknown2-scale8.jpg"))
       (x2 (rotozoom-surface x 55 0.5 #t)))
  (sdl-blit-surface x #f s (make-sdl-rect 300 200 300 300))
  (sdl-blit-surface x2 #f s (make-sdl-rect 380 20 300 300))
  (sdl-free-surface x)
  (sdl-free-surface x2))

(sdl-flip s)

(let ((event (make-sdl-event)))
  (let loop ()
    (sdl-wait-event! event)
    (let ((t (sdl-event-type event)))
      (if (= t SDL_QUIT)
	  'done
	  (begin (cond
		  ((= t SDL_KEYDOWN) (let* ((i (sdl-event-sym event))
					    (c (integer->char i)))
				       (if (or (= i 27) (memv c '(#\q #\Q)))
					   (begin (sdl-event-type-set! event SDL_QUIT)
						  (sdl-push-event event))
					   (begin (display (list 'got-key c)) (newline)))))
		  (else (display (list 'event t)) (newline)))
		 (loop))))))

(ttf-quit)