(use sdl-base sdl-ttf)

(define maxx 640)
(define maxy 480)

(define fontname "font.ttf")

(print "sdl-init")
(sdl-init SDL_INIT_EVERYTHING)

(print "ttf-init")
(ttf-init)

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

(print s)

(sdl-show-cursor #f)

(define f (ttf-open-font fontname 48))
(assert f "couldn't open font" fontname)

(define (print-font-info f)
  (print "\nfont: " f)
  (print "ttf-font-height: " (ttf-font-height f))
  (print "ttf-font-ascent: " (ttf-font-ascent f))
  (print "ttf-font-descent: " (ttf-font-descent f))
  (print "ttf-font-line-skip: " (ttf-font-line-skip f))
  (print "ttf-font-descent: " (ttf-font-descent f))
  (print "ttf-font-faces: " (ttf-font-faces f))
  (print "ttf-font-face-is-fixed-width?: " (ttf-font-face-is-fixed-width? f))
  (print "ttf-font-face-family-name: " (ttf-font-face-family-name f))
  (print "ttf-font-face-style-name: " (ttf-font-face-style-name f)))

(print-font-info f)

(define (print-metrics font char)
  (let [(m (make-ttf-glyph))]
    (print "\nchar " char " int: "(char->integer char))
    (ttf-glyph-metrics font (char->integer char) m)
    (print m "\n")))

(print-metrics f #\c)

(let ((r (make-sdl-rect 0 0 0 0)))
  (ttf-size-text! f "Hello, world!" r)
  (display "Size of text: ")
  (display r)
  (newline))

(begin
  (print "ttf-render-text-solid")
  (define s2 (ttf-render-text-solid f "Solid text" (make-sdl-color 255 255 255)))
  (sdl-blit-surface s2 #f s (make-sdl-rect 10 100 50 50))
  (sdl-free-surface s2))

(begin
  (print "ttf-render-text-blended")
  (define s2 (ttf-render-text-blended f "Blended text" (make-sdl-color 255 255 255)))
  (sdl-blit-surface s2 #f s (make-sdl-rect 10 10 50 50))
  (sdl-free-surface s2)
  (sdl-free-surface s2)
  (sdl-free-surface s2))

(begin
  (print "rendering some glyphs")
  (let* [(x 0)
	 (y 200)
	 (font f)
	 (surf s)
	 (fg (make-sdl-color 255 100 100))
	 (bg (make-sdl-color 100 100 100))
	 (r (lambda (s2)
	      (sdl-blit-surface s2 #f
				s (make-sdl-rect x y
						 (sdl-surface-width s2)
						 (sdl-surface-height s2)))
	      (set! x (+ x 1 (sdl-surface-width s2)))))]
    (r (ttf-render-glyph-solid font (char->integer #\s) fg))
    (r (ttf-render-glyph-shaded font (char->integer #\s) fg bg))
    (r (ttf-render-glyph-blended font (char->integer #\s) fg))))

(print "close")
(ttf-close-font f)
(ttf-close-font f)
(ttf-close-font f)

(sdl-flip s)

(use posix)
(sleep 1)
(print "ttf-quit")
(ttf-quit)
(print "sdl-quit")
(sdl-quit)
(print "end")
(exit 0)