solarpunk-guile
/
guile-guart
3
0
Fork 0
Code Issues Pull Requests Releases Activity

Fixed compile

This commit is contained in:
Vivianne 2024-03-08 19:20:58 -05:00
parent bc3fcc35fa
commit 867468e822
Signed by: vv
GPG Key ID: F3E249EDFAC7BE26
1 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gaart.scm
View File

@ -1,5 +1,6 @@
(define-module (gaart)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (ice-9 streams)
#:use-module (uniseg)
@ -46,7 +47,7 @@
"Draw a gaart to the provided buffer"
)
(define* (blank #:key (w 0) (h 1))
(define* (blank #:optional (w 0) (h 1))
(gaart w h (λ (okay? blit! rpos cpos) #f)))
(define (char ch)
@ -83,9 +84,9 @@
(unless (and (<= (+ xw cpos) matte-width)
(<= (+ xh rpos) matte-height))
(error (format #f "matte-at: Original (~ax~a@~a,~a) must fit inside matte (~ax~a)" xw xh cpos rpos matte-width matte-height)))
(place-at (blank mw mh) rpos cpos x)))
(place-at (blank matte-width matte-height) rpos cpos x)))
(define (matte matte-width matte-height x #:key (halign 'center) (valign 'center))
(define* (matte matte-width matte-height x #:key (halign 'center) (valign 'center))
(define width (or matte-width (gaart-w x)))
(define height (or matte-height (gaart-h x)))
(match-let ((($ <gaart> xw xh draw-x) x))
@ -112,7 +113,7 @@
x)))
(define (translate row-offset col-offset x)
(match-let ((($ <gaart> xw xh _)))
(match-let ((($ <gaart> xw xh _) x))
(matte-at (+ xw col-offset) (+ xh row-offset) col-offset row-offset x)))
@ -168,7 +169,7 @@
(($ <gaart> yw yh draw-y) y))
(unless (= xw yw)
;; TODO: proper error messages with irritants
(error (format #f "vappend2: Widths must be equal: ~d vs ~d" xw yw)))
(error (format #f "vappend2: Widths must be equal: ~a vs ~a" xw yw)))
(gaart
xw (+ xh yh)
(λ (okay? blit! rpos cpos)
@ -190,8 +191,8 @@
(define y-paint (matte new-width yh #:halign halign y))
(*vappend2 #:reverse? reverse? y-paint x-paint)))))
(define* (vappend r1 . rs #:key (halign #f) (reverse? #f))
(foldl (λ (a d) (vappend2 #:halign halign #:reverse? reverse? a d)) r1 rs))
(define* (vappend r1 #:key (halign #f) (reverse? #f) . rs)
(fold (λ (a d) (vappend2 a d #:halign halign #:reverse? reverse?)) r1 rs))
(define* (vappend* rs #:key (halign #f) (reverse? #f))
(apply vappend rs #:halign halign #:reverse? reverse?))
@ -200,7 +201,7 @@
(match-let ((($ <gaart> xw xh draw-x) x)
(($ <gaart> yw yh draw-y) y))
(unless (= xh yh)
(error "happend2: Heights must be equal: ~d vs ~d" xh yh))
(error "happend2: Heights must be equal: ~a vs ~a" xh yh))
(gaart
(+ xw yw) xh
(λ (okay? blit! rpos cpos)
@ -218,13 +219,13 @@
(match-let ((($ <gaart> xw xh draw-x) x)
(($ <gaart> yw yh draw-y) y))
(define new-height (max xh yh))
(define x-paint (matte hw new-height #:halign halign x))
(define y-paint (matte yw new-height #:halign halign y))
(define x-paint (matte xw new-height #:valign valign x))
(define y-paint (matte yw new-height #:valign valign y))
(*happend2 #:reverse? reverse? y-paint x-paint)))))
(define* (happend r1 . rs #:key (valign #f) (reverse? #f))
(foldl (λ (a d) (happend2 #:halign valign #:reverse? reverse? a d)) r1 rs))
(define* (happend r1 #:key (valign #f) (reverse? #f) . rs)
(fold (λ (a d) (happend2 a d #:valign valign #:reverse? reverse?)) r1 rs))
(define* (happend* rs #:key (valign #f) (reverse? #f))
(apply happend rs #:valign valign #:reverse? reverse?))