blob: ad894d0baec41210c471123d2de111222456a33d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
(module renderer
*
(import scheme
(chicken base)
(only srfi-1 iota for-each)
(prefix sdl2 "sdl2:")
(prefix sdl2-ttf "ttf:")
entity
tilemap
world)
;; --- Pure functions (no SDL2, testable) ---
;; Returns (x y w h) as a plain list — testable without SDL2
(define (entity-screen-coords entity camera)
(list (- (inexact->exact (floor (entity-ref entity #:x 0))) (camera-x camera))
(- (inexact->exact (floor (entity-ref entity #:y 0))) (camera-y camera))
(inexact->exact (floor (entity-ref entity #:width 0)))
(inexact->exact (floor (entity-ref entity #:height 0)))))
;; Returns sdl2:rect for actual drawing
(define (entity->screen-rect entity camera)
(apply sdl2:make-rect (entity-screen-coords entity camera)))
;; Returns flip list based on #:facing field
(define (entity-flip entity)
(if (= (entity-ref entity #:facing 1) -1) '(horizontal) '()))
;; --- Tilemap drawing ---
(define (draw-tile renderer camera tileset tileset-texture tile-id row-num col-num)
(let ((tile (tileset-tile tileset tile-id)))
(sdl2:render-copy! renderer tileset-texture
(tile-rect tile)
(sdl2:make-rect
(- (* col-num (tileset-tilewidth tileset)) (camera-x camera))
(- (* row-num (tileset-tileheight tileset)) (camera-y camera))
(tileset-tilewidth tileset)
(tileset-tileheight tileset)))))
(define (draw-tilemap-rows draw-fn rows row-num)
(unless (null? rows)
(for-each
(cut draw-fn <> row-num <>)
(car rows)
(iota (length (car rows))))
(draw-tilemap-rows draw-fn (cdr rows) (+ row-num 1))))
(define (draw-tilemap renderer camera tileset-texture tilemap)
(let ((map-layers (tilemap-layers tilemap))
(tileset (tilemap-tileset tilemap)))
(for-each
(lambda (layer)
(draw-tilemap-rows
(cut draw-tile renderer camera tileset tileset-texture <> <> <>)
(layer-map layer)
0))
map-layers)))
;; --- Entity drawing ---
(define (draw-entity renderer camera tileset tileset-texture entity)
(let ((tile-id (entity-ref entity #:tile-id #f)))
(when tile-id
(sdl2:render-copy-ex! renderer tileset-texture
(tile-rect (tileset-tile tileset tile-id))
(entity->screen-rect entity camera)
0.0
#f
(entity-flip entity)))))
(define (draw-entities renderer camera tileset tileset-texture entities)
(for-each
(lambda (e) (draw-entity renderer camera tileset tileset-texture e))
entities))
;; --- Text drawing ---
(define (draw-ui-text renderer font text color x y)
(let* ((surface (ttf:render-text-solid font text color))
(texture (sdl2:create-texture-from-surface renderer surface))
(dims (call-with-values (lambda () (ttf:size-utf8 font text)) cons))
(w (car dims))
(h (cdr dims)))
(sdl2:render-copy! renderer texture #f
(sdl2:make-rect x y w h))))
) ;; end module renderer
|
