source: project/release/4/sdl-ttf/trunk/tests/example.scm @ 27337

Last change on this file since 27337 was 27337, checked in by megane, 9 years ago

sdl-ttf: - supports whatever the sdl egg supported + some functionality to extract glyph metrics

File size: 2.5 KB
Line 
1(use sdl-base sdl-ttf)
2
3(define maxx 640)
4(define maxy 480)
5
6(define fontname "font.ttf")
7
8(print "sdl-init")
9(sdl-init SDL_INIT_EVERYTHING)
10
11(print "ttf-init")
12(ttf-init)
13
14(sdl-wm-set-caption "TestSDL" "TestSDL")
15(define s (sdl-set-video-mode maxx maxy 0 (+ SDL_HWSURFACE
16                                             SDL_HWPALETTE
17                                             SDL_DOUBLEBUF)))
18
19(print s)
20
21(sdl-show-cursor #f)
22
23(define f (ttf-open-font fontname 48))
24(assert f "couldn't open font" fontname)
25
26(define (print-font-info f)
27  (print "\nfont: " f)
28  (print "ttf-font-height: " (ttf-font-height f))
29  (print "ttf-font-ascent: " (ttf-font-ascent f))
30  (print "ttf-font-descent: " (ttf-font-descent f))
31  (print "ttf-font-line-skip: " (ttf-font-line-skip f))
32  (print "ttf-font-descent: " (ttf-font-descent f))
33  (print "ttf-font-faces: " (ttf-font-faces f))
34  (print "ttf-font-face-is-fixed-width?: " (ttf-font-face-is-fixed-width? f))
35  (print "ttf-font-face-family-name: " (ttf-font-face-family-name f))
36  (print "ttf-font-face-style-name: " (ttf-font-face-style-name f)))
37
38(print-font-info f)
39
40(define (print-metrics font char)
41  (let [(m (make-ttf-glyph))]
42    (print "\nchar " char " int: "(char->integer char))
43    (ttf-glyph-metrics font (char->integer char) m)
44    (print m "\n")))
45
46(print-metrics f #\c)
47
48(let ((r (make-sdl-rect 0 0 0 0)))
49  (ttf-size-text! f "Hello, world!" r)
50  (display "Size of text: ")
51  (display r)
52  (newline))
53
54(begin
55  (print "ttf-render-text-solid")
56  (define s2 (ttf-render-text-solid f "Solid text" (make-sdl-color 255 255 255)))
57  (sdl-blit-surface s2 #f s (make-sdl-rect 10 100 50 50))
58  (sdl-free-surface s2))
59
60(begin
61  (print "ttf-render-text-blended")
62  (define s2 (ttf-render-text-blended f "Blended text" (make-sdl-color 255 255 255)))
63  (sdl-blit-surface s2 #f s (make-sdl-rect 10 10 50 50))
64  (sdl-free-surface s2)
65  (sdl-free-surface s2)
66  (sdl-free-surface s2))
67
68(begin
69  (print "rendering some glyphs")
70  (let* [(x 0)
71         (y 200)
72         (font f)
73         (surf s)
74         (fg (make-sdl-color 255 100 100))
75         (bg (make-sdl-color 100 100 100))
76         (r (lambda (s2)
77              (sdl-blit-surface s2 #f
78                                s (make-sdl-rect x y
79                                                 (sdl-surface-width s2)
80                                                 (sdl-surface-height s2)))
81              (set! x (+ x 1 (sdl-surface-width s2)))))]
82    (r (ttf-render-glyph-solid font (char->integer #\s) fg))
83    (r (ttf-render-glyph-shaded font (char->integer #\s) fg bg))
84    (r (ttf-render-glyph-blended font (char->integer #\s) fg))))
85
86(print "close")
87(ttf-close-font f)
88(ttf-close-font f)
89(ttf-close-font f)
90
91(sdl-flip s)
92
93(use posix)
94(sleep 1)
95(print "ttf-quit")
96(ttf-quit)
97(print "sdl-quit")
98(sdl-quit)
99(print "end")
100(exit 0)
Note: See TracBrowser for help on using the repository browser.