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

maybe fix errors?

Browse source
This commit is contained in:
Vivianne 2024-03-11 00:57:52 -04:00
parent aceb2475f1
commit 95849d1c29
Signed by: vv
GPG key ID: F3E249EDFAC7BE26
1 changed files with 6 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gaart.scm
View file

@ -57,7 +57,7 @@
(define (char ch)
(define grapheme (char->grapheme ch))
(unless grapheme
(scm-error #f "char" "Unable to convert ~s to a valid unicode grapheme" (list ch) (list ch)))
(scm-error 'convert-failure "char" "Unable to convert ~s to a valid unicode grapheme" (list ch) (list ch)))
(gaart
1 1
@ -98,7 +98,7 @@
(match-let ((($ <gaart> xw xh _) x))
(unless (and (<= (+ xw cpos) matte-width)
(<= (+ xh rpos) matte-height))
(scm-error #f "matte-at" "Original (~ax~a@~a,~a) must fit inside matte (~ax~a)" (list xw xh cpos rpos matte-width matte-height) (list x)))
(scm-error 'matte-error "matte-at" "Original (~ax~a@~a,~a) must fit inside matte (~ax~a)" (list xw xh cpos rpos matte-width matte-height) (list x)))
(place-at (blank matte-width matte-height) rpos cpos x)))
(define* (matte matte-width matte-height x #:key (halign 'center) (valign 'center))
@ -107,7 +107,7 @@
(match-let ((($ <gaart> xw xh draw-x) x))
(unless (and (<= xw width)
(<= xh height))
(scm-error #f "matte" "Original (~ax~a) must fit inside matte (~ax~a)" (list xw xh width height) (list x)))
(scm-error 'matte-error "matte" "Original (~ax~a) must fit inside matte (~ax~a)" (list xw xh width height) (list x)))
(matte-at width height
(match halign
@ -189,7 +189,7 @@
(match-let ((($ <gaart> xw xh draw-x) x)
(($ <gaart> yw yh draw-y) y))
(unless (= xw yw)
(scm-error #f "vappend2" "Widths must be equal: ~a vs ~a" (list xw yw) (list xw yw)))
(scm-error 'append-error "vappend2" "Widths must be equal: ~a vs ~a" (list xw yw) (list xw yw)))
(gaart
xw (+ xh yh)
(λ (okay? blit! rpos cpos)
@ -220,7 +220,7 @@
(match-let ((($ <gaart> xw xh draw-x) x)
(($ <gaart> yw yh draw-y) y))
(unless (= xh yh)
(scm-error #f "happend2" "Heights must be equal: ~a vs ~a" (list xh yh) (list xh yh)))
(scm-error 'append-error "happend2" "Heights must be equal: ~a vs ~a" (list xh yh) (list xh yh)))
(gaart
(+ xw yw) xh
(λ (okay? blit! rpos cpos)
@ -230,6 +230,7 @@
(or (dy) (dx))
(or (dx) (dy)))))))
;; TODO: for both v and h: need to better detect and error if the alignments are not set and are needed.
(define* (happend2 y x #:key (valign #f) (reverse? #f))
(cond
((not valign) (*happend2 y x #:reverse? reverse?))