Keskustelu: Koodit: Scheme: SDL_ttf ja tekstin rivitys

(require-extension sdl)

;; Kopioitu Ohjelmointiputkan SDL-oppaasta

(define blit-image
  (lambda
    (screen image x y)
    (sdl-blit-surface image #f screen (make-sdl-rect x y 0 0))))

;; Pieni apufunktio draw-textin helpottamiseksi, palauttaa annetun
;; tekstin leveyden kyseisellä fontilla.

(define text-width
  (lambda
    (font text)
    (let ((rect (make-sdl-rect 0 0 0 0)))
      (ttf-size-text! font text rect)
      (sdl-rect-w rect))))

;; Piirtää tekstiä rivitetysti, leveys korkeintaan width

(define draw-text
  (lambda
    (screen font text start-x start-y width color)
    (let ((space (text-width font " ")))
      (let draw-words ((words (string-split text)) (x start-x) (y start-y) (first? #t))
        (if (null? words) 'done
            (let* ((surface (ttf-render-text-blended font (car words) color))
                  (w (text-width font (car words)))
                  (wrap? (and (> (+ x w) (+ start-x width)) (not first?)))
                  (neu-x (if wrap? start-x x))
                  (neu-y (if wrap? (+ y (ttf-font-height font)) y)))
              (blit-image screen surface neu-x neu-y)
              (sdl-free-surface surface)
              (draw-words (cdr words) (+ neu-x w space) neu-y #f)))))))

;; Esimerkki

(sdl-init SDL_INIT_VIDEO)
(define naytto (sdl-set-video-mode 640 480 0 (+ SDL_HWSURFACE SDL_DOUBLEBUF)))

(ttf-init)
(define fontti (ttf-open-font "VeraSe.ttf" 48))

(define max-width 260)  ; piirretään korkeintaan 260 pikseliä leveä teksti

(sdl-fill-rect naytto (make-sdl-rect 10 10 max-width 470)
               (make-sdl-color 100 100 100))

(draw-text naytto fontti "Muutosmielinen hassu majava nautti ison punaisen tomaatin."
           10 10 max-width (make-sdl-color 255 200 200))

(sdl-flip naytto)

(sdl-delay 5000)

(sdl-free-surface naytto)
(ttf-close-font fontti)

(sdl-quit)