diff --git a/retropikzel/spite.scm b/retropikzel/spite.scm index 51aab36..4f8a9c0 100644 --- a/retropikzel/spite.scm +++ b/retropikzel/spite.scm @@ -297,76 +297,62 @@ (lambda () (set! events (list)))) -(define-record-type bitmap-font - (internal-make-bitmap-font data) +(define-record-type + (internal-make-bitmap-font image draw-width draw-height character-width character-height lookup-table) bitmap-font? - (data bitmap-font-data)) + (image bitmap-font-image) + (draw-width bitmap-font-draw-width) + (draw-height bitmap-font-draw-height) + (character-width bitmap-font-character-width) + (character-height bitmap-font-character-height) + (lookup-table bitmap-font-lookup-table)) -(define (bitmap-font-get key bitmap) - (cdr (assoc key (bitmap-font-data bitmap)))) - -(define-record-type bitmap-char - (make-bitmap-char char x y) - bitmap-char? - (char bitmap-char-char) - (x bitmap-char-x) - (y bitmap-char-y)) - -(define (make-bitmap-font image character-width character-height draw-width draw-height character-lines) - (let* ((line-items-count (string-length (car character-lines))) - (characters (apply string-append character-lines)) - (index -1) - (character-indexes (list)) - (character-positions - (map (lambda (character) - (set! index (+ index 1)) - (set! character-indexes (append character-indexes (list character index))) - (list character - (* (modulo index line-items-count) - character-width) - (* (floor (/ index line-items-count)) - character-height))) - (string->list characters)))) - (internal-make-bitmap-font - `((image . ,image) - (character-width . ,character-width) - (character-height . ,character-height) - (character-draw-width . ,draw-width) - (character-draw-height . ,draw-height) - (line-items-count . ,line-items-count) - (characters . ,characters) - (character-indexes . ,character-indexes) - (character-positions . ,character-positions))))) - -(define (set-bitmap-font font) - (set! current-bitmap-font font)) - -(define (make-bitmap-text text font) - (map - (lambda (c) - (make-bitmap-char - c - (cadr (assq c (bitmap-font-get 'character-positions font))) - (cadr (cdr (assq c (bitmap-font-get 'character-positions font)))))) - (string->list text))) +(define (make-bitmap-font image character-width character-height draw-width draw-height character-lists) + (let* ((line-index -1) + (character-index -1) + (lookup-table (make-vector 0))) + (for-each + (lambda (line) + (set! line-index (+ line-index 1)) + (set! character-index -1) + (for-each + (lambda (character) + (set! character-index (+ character-index 1)) + (let ((c-int (char->integer character))) + (when (<= (vector-length lookup-table) c-int) + (set! lookup-table + (vector-append + lookup-table + (make-vector (+ (- c-int (vector-length lookup-table)) 1) #f)))) + (vector-set! lookup-table + c-int + (vector character + (* character-index character-width) + (* line-index character-height))))) + line)) + character-lists) + (internal-make-bitmap-font image draw-width draw-height character-width character-height lookup-table))) +(define (set-bitmap-font font) (set! current-bitmap-font font)) (define draw-bitmap-text (lambda (text x y) (when (not current-bitmap-font) (error "Current bitmap font not set, use make-bitmap-font and set-bitmap-font")) - (let ((offset-x x)) + (let ((offset-x x) + (lookup-table (bitmap-font-lookup-table current-bitmap-font))) (for-each - (lambda (bitmap-char) - (draw-image-slice (bitmap-font-get 'image current-bitmap-font) - offset-x - y - (bitmap-font-get 'character-draw-width current-bitmap-font) - (bitmap-font-get 'character-draw-height current-bitmap-font) - (bitmap-char-x bitmap-char) - (bitmap-char-y bitmap-char) - (bitmap-font-get 'character-width current-bitmap-font) - (bitmap-font-get 'character-height current-bitmap-font)) - (set! offset-x (+ offset-x (bitmap-font-get 'character-draw-width current-bitmap-font)))) - (make-bitmap-text text current-bitmap-font))))) + (lambda (character) + (let ((char-data (vector-ref lookup-table (char->integer character)))) + (draw-image-slice (bitmap-font-image current-bitmap-font) + offset-x + y + (bitmap-font-draw-width current-bitmap-font) + (bitmap-font-draw-height current-bitmap-font) + (vector-ref char-data 1) + (vector-ref char-data 2) + (bitmap-font-character-width current-bitmap-font) + (bitmap-font-character-height current-bitmap-font)) + (set! offset-x (+ offset-x 14)))) + (string->list text))))) diff --git a/retropikzel/spite.sld b/retropikzel/spite.sld index 434ec2d..358f5ba 100644 --- a/retropikzel/spite.sld +++ b/retropikzel/spite.sld @@ -7,6 +7,7 @@ (scheme file) (scheme load) (scheme time) + (scheme char) (c2foreign-c sdl2 init) (c2foreign-c sdl2 video) (c2foreign-c sdl2 render) diff --git a/retropikzel/spite/VERSION b/retropikzel/spite/VERSION index 17e51c3..d917d3e 100644 --- a/retropikzel/spite/VERSION +++ b/retropikzel/spite/VERSION @@ -1 +1 @@ -0.1.1 +0.1.2 diff --git a/retropikzel/spite/test.scm b/retropikzel/spite/test.scm index e303d84..d8c0a37 100644 --- a/retropikzel/spite/test.scm +++ b/retropikzel/spite/test.scm @@ -5,6 +5,7 @@ (define player-y 100) (define font-image (load-image "test-resources/charmap-cellphone_black.png")) +(define icons-image (load-image "test-resources/icons.png")) (define black '(0 0 0)) (define blue '(0 0 255)) @@ -13,18 +14,19 @@ (define character-height 9) (define draw-width 14) (define draw-height 18) -(define character-lines (list " !\"#¤%&/()*+,-./01" - "23456789:;<=>?@ABC" - "DEFGHIJKLMNOPQRSTU" - "VWXYZ[\\]^_´abcdefg" - "hijklmnopqrstuvwxy" - "z{|}~")) +(define character-lists + `((#\space #\! #\" #\# #\$ #\% #\& #\/ #\( #\) #\* #\+ #\, #\- #\. #\0 #\1) + (#\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= #\> #\? #\@ #\A #\B #\C) + (#\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U) + (#\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g) + (#\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y) + (#\z #\{ #\| #\} #\~ #\~))) (define font (make-bitmap-font font-image character-width character-height draw-width draw-height - character-lines)) + character-lists)) (set-bitmap-font font) (define update @@ -53,6 +55,8 @@ (fill-rectangle (+ player-x 32) (+ player-y 32) 16 16) (draw-triangle 350 350 380 380 330 380) ;(fill-triangle 450 450 480 480 430 480) + (draw-image-slice icons-image 500 500 32 32 0 0 32 32) + (draw-image-slice icons-image 532 532 32 32 32 32 32 32) )) (spite-start update draw)