From 526e6cdcdf1025d5e29680bc99ab910c79789764 Mon Sep 17 00:00:00 2001 From: Gene Pasquet Date: Sun, 5 Apr 2026 14:17:51 +0100 Subject: Initial port of macroknight to an engine --- renderer.scm | 88 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) create mode 100644 renderer.scm (limited to 'renderer.scm') diff --git a/renderer.scm b/renderer.scm new file mode 100644 index 0000000..ad894d0 --- /dev/null +++ b/renderer.scm @@ -0,0 +1,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 -- cgit v1.2.3