Renaming to guart again

This commit is contained in:
Vivianne 2024-03-12 16:32:47 -04:00
parent 95849d1c29
commit 66b8797292
9 changed files with 67 additions and 67 deletions

View File

@ -1,10 +1,10 @@
# -*- mode: org; coding: utf-8; -*- # -*- mode: org; coding: utf-8; -*-
#+TITLE: Hacking guile-gaart #+TITLE: Hacking guile-guart
* Contributing * Contributing
By far the easiest way to hack on guile-gaart is to develop using Guix: By far the easiest way to hack on guile-guart is to develop using Guix:
#+BEGIN_SRC bash #+BEGIN_SRC bash
# Obtain the source code # Obtain the source code

View File

@ -23,9 +23,9 @@ SUFFIXES = .scm .go
.scm.go: .scm.go:
$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_TARGET) $(GUILE_WARNINGS) -o "$@" "$<" $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_TARGET) $(GUILE_WARNINGS) -o "$@" "$<"
SOURCES = gaart.scm \ SOURCES = guart.scm \
gaart/draw.scm \ guart/draw.scm \
gaart/buffer.scm guart/buffer.scm
TESTS = TESTS =
@ -43,7 +43,7 @@ AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)"
AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)"
info_TEXINFOS = doc/guile-gaart.texi info_TEXINFOS = doc/guile-guart.texi
EXTRA_DIST = README.org \ EXTRA_DIST = README.org \
HACKING \ HACKING \

View File

@ -1,8 +1,8 @@
# -*- mode: org; coding: utf-8; -*- # -*- mode: org; coding: utf-8; -*-
#+TITLE: README for Guile Gaart #+TITLE: README for Guile Guart
~guile-gaart~ is a library for making art with ascii (and unicode!) characters ~guile-guart~ is a library for making art with unicode characters.
This library is heavily inspired by the Racket library ~raart~. However, some aspects have been modernized and made to support Unicode better. The library is also more designed around making rich text interfaces than the original, so styles will be defined in a different way. This library is heavily inspired by the Racket library ~raart~. However, some aspects have been modernized and made to support Unicode better. The library is also more designed around making rich text interfaces than the original, so styles will be defined in a different way.

View File

@ -1,11 +1,11 @@
dnl -*- Autoconf -*- dnl -*- Autoconf -*-
AC_INIT(guile-gaart, 0.1) AC_INIT(guile-guart, 0.1)
AC_SUBST(HVERSION, "\"0.1\"") AC_SUBST(HVERSION, "\"0.1\"")
AC_SUBST(AUTHOR, "\"Vivanne Langdon\"") AC_SUBST(AUTHOR, "\"Vivanne Langdon\"")
AC_SUBST(COPYRIGHT, "'(2024)") AC_SUBST(COPYRIGHT, "'(2024)")
AC_SUBST(LICENSE, gpl3+) AC_SUBST(LICENSE, gpl3+)
AC_CONFIG_SRCDIR(gaart.scm) AC_CONFIG_SRCDIR(guart.scm)
AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_AUX_DIR([build-aux])
AM_INIT_AUTOMAKE([1.12 foreign silent-rules subdir-objects color-tests parallel-tests -Woverride -Wno-portability]) AM_INIT_AUTOMAKE([1.12 foreign silent-rules subdir-objects color-tests parallel-tests -Woverride -Wno-portability])
AM_SILENT_RULES([yes]) AM_SILENT_RULES([yes])

View File

@ -2,9 +2,9 @@
@c -*-texinfo-*- @c -*-texinfo-*-
@c %**start of header @c %**start of header
@setfilename gaart.info @setfilename guart.info
@documentencoding UTF-8 @documentencoding UTF-8
@settitle Gaart Reference Manual @settitle Guart Reference Manual
@c %**end of header @c %**end of header
@include version.texi @include version.texi
@ -22,11 +22,11 @@ Documentation License''.
@dircategory The Algorithmic Language Scheme @dircategory The Algorithmic Language Scheme
@direntry @direntry
* Gaart: (gaart). * Guart: (guart).
@end direntry @end direntry
@titlepage @titlepage
@title The Gaart Manual @title The Guart Manual
@author Vivianne Langdon @author Vivianne Langdon
@page @page
@ -41,12 +41,12 @@ Edition @value{EDITION} @*
@c ********************************************************************* @c *********************************************************************
@node Top @node Top
@top Gaart @top Guart
This document describes Gaart version @value{VERSION}. This document describes Guart version @value{VERSION}.
@menu @menu
* Introduction:: Why Gaart? * Introduction:: Why Guart?
@end menu @end menu
@c ********************************************************************* @c *********************************************************************

View File

@ -1,4 +1,4 @@
(define-module (gaart) (define-module (guart)
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -7,11 +7,11 @@
#:use-module (uniseg graphemes) #:use-module (uniseg graphemes)
#:use-module (uniseg graphemes stream) #:use-module (uniseg graphemes stream)
#:use-module (uniseg graphemes iterator) #:use-module (uniseg graphemes iterator)
#:export (<gaart> #:export (<guart>
gaart? guart?
gaart-w guart-w
gaart-h guart-h
gaart-draw guart-draw
blank blank
char char
text text
@ -43,23 +43,23 @@
(< a-y1 b-y2) (< a-y1 b-y2)
(> a-y2 b-y1))) (> a-y2 b-y1)))
(define-immutable-record-type <gaart> (define-immutable-record-type <guart>
(gaart w h draw) (guart w h draw)
gaart? guart?
(w gaart-w) (w guart-w)
(h gaart-h) (h guart-h)
(draw gaart-draw)) (draw guart-draw))
(define* (blank #:optional (w 0) (h 1)) (define* (blank #:optional (w 0) (h 1))
(gaart w h (λ (okay? blit! rpos cpos) #f))) (guart w h (λ (okay? blit! rpos cpos) #f)))
(define (char ch) (define (char ch)
(define grapheme (char->grapheme ch)) (define grapheme (char->grapheme ch))
(unless grapheme (unless grapheme
(scm-error 'convert-failure "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 (guart
1 1 1 1
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
(blit! rpos cpos grapheme) (blit! rpos cpos grapheme)
@ -73,7 +73,7 @@
(if halign (if halign
(vappend* (map text (string-split str #\newline)) #:halign halign) (vappend* (map text (string-split str #\newline)) #:halign halign)
(scm-error 'keyword-argument-error "text" "String contained newlines but no halign argument was set" '() (list halign))) (scm-error 'keyword-argument-error "text" "String contained newlines but no halign argument was set" '() (list halign)))
(gaart (guart
(string-width str) 1 (string-width str) 1
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
;; Go through each grapheme, print it and advance the position ;; Go through each grapheme, print it and advance the position
@ -87,24 +87,24 @@
#f)))) #f))))
(define (place-at back row-offset col-offset front) (define (place-at back row-offset col-offset front)
(match-let ((($ <gaart> bw bh draw-b) back) (match-let ((($ <guart> bw bh draw-b) back)
(($ <gaart> fw fh draw-f) front)) (($ <guart> fw fh draw-f) front))
(gaart bw bh (guart bw bh
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
(or (draw-b okay? blit! rpos cpos) (or (draw-b okay? blit! rpos cpos)
(draw-f okay? blit! (+ rpos row-offset) (+ cpos col-offset))))))) (draw-f okay? blit! (+ rpos row-offset) (+ cpos col-offset)))))))
(define (matte-at matte-width matte-height cpos rpos x) (define (matte-at matte-width matte-height cpos rpos x)
(match-let ((($ <gaart> xw xh _) x)) (match-let ((($ <guart> xw xh _) x))
(unless (and (<= (+ xw cpos) matte-width) (unless (and (<= (+ xw cpos) matte-width)
(<= (+ xh rpos) matte-height)) (<= (+ xh rpos) matte-height))
(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))) (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))) (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 width (or matte-width (guart-w x)))
(define height (or matte-height (gaart-h x))) (define height (or matte-height (guart-h x)))
(match-let ((($ <gaart> xw xh draw-x) x)) (match-let ((($ <guart> xw xh draw-x) x))
(unless (and (<= xw width) (unless (and (<= xw width)
(<= xh height)) (<= xh height))
(scm-error 'matte-error "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)))
@ -121,20 +121,20 @@
x))) x)))
(define (inset width-offset height-offset x) (define (inset width-offset height-offset x)
(match-let ((($ <gaart> xw xh _) x)) (match-let ((($ <guart> xw xh _) x))
(matte (+ width-offset xw width-offset) (matte (+ width-offset xw width-offset)
(+ height-offset xh height-offset) (+ height-offset xh height-offset)
x x
#:halign 'center #:valign 'center))) #:halign 'center #:valign 'center)))
(define (translate row-offset col-offset x) (define (translate row-offset col-offset x)
(match-let ((($ <gaart> xw xh _) x)) (match-let ((($ <guart> xw xh _) x))
(matte-at (+ xw col-offset) (+ xh row-offset) col-offset row-offset x))) (matte-at (+ xw col-offset) (+ xh row-offset) col-offset row-offset x)))
(define (mask mask-cpos mask-width mask-rpos mask-height x) (define (mask mask-cpos mask-width mask-rpos mask-height x)
(match-let ((($ <gaart> xw xh draw-x) x)) (match-let ((($ <guart> xw xh draw-x) x))
(gaart xw xh (guart xw xh
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
(draw-x (draw-x
;; okay? function definition for this art ;; okay? function definition for this art
@ -150,8 +150,8 @@
(define (crop crop-cpos crop-width crop-rpos crop-height x) (define (crop crop-cpos crop-width crop-rpos crop-height x)
(define mask-x (mask crop-cpos crop-width crop-rpos crop-height x)) (define mask-x (mask crop-cpos crop-width crop-rpos crop-height x))
(match-let ((($ <gaart> _ _ draw-m) mask-x)) (match-let ((($ <guart> _ _ draw-m) mask-x))
(gaart (guart
crop-width crop-width
crop-height crop-height
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
@ -165,16 +165,16 @@
rpos cpos))))) rpos cpos)))))
(define (if-drawn func x) (define (if-drawn func x)
(match-let ((($ <gaart> xw xh draw-x) x)) (match-let ((($ <guart> xw xh draw-x) x))
(gaart xw xh (guart xw xh
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
(define ? (draw-x okay? blit! rpos cpos)) (define ? (draw-x okay? blit! rpos cpos))
(when ? (func rpos cpos )) (when ? (func rpos cpos ))
?)))) ?))))
(define (place-cursor-after x cursor-rpos cursor-cpos) (define (place-cursor-after x cursor-rpos cursor-cpos)
(match-let ((($ <gaart> xw xh draw-x) x)) (match-let ((($ <guart> xw xh draw-x) x))
(gaart xw xh (guart xw xh
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
(or (draw-x okay? blit! rpos cpos) (or (draw-x okay? blit! rpos cpos)
(blit! cursor-rpos cursor-cpos #f)))))) (blit! cursor-rpos cursor-cpos #f))))))
@ -186,11 +186,11 @@
(item item))) (item item)))
(define* (*vappend2 y x #:key (reverse? #f)) (define* (*vappend2 y x #:key (reverse? #f))
(match-let ((($ <gaart> xw xh draw-x) x) (match-let ((($ <guart> xw xh draw-x) x)
(($ <gaart> yw yh draw-y) y)) (($ <guart> yw yh draw-y) y))
(unless (= xw yw) (unless (= xw yw)
(scm-error 'append-error "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 (guart
xw (+ xh yh) xw (+ xh yh)
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
(define (dx) (draw-x okay? blit! rpos cpos)) (define (dx) (draw-x okay? blit! rpos cpos))
@ -203,8 +203,8 @@
(cond (cond
((not halign) (*vappend2 y x #:reverse? reverse?)) ((not halign) (*vappend2 y x #:reverse? reverse?))
(else (else
(match-let ((($ <gaart> xw xh draw-x) x) (match-let ((($ <guart> xw xh draw-x) x)
(($ <gaart> yw yh draw-y) y)) (($ <guart> yw yh draw-y) y))
(define new-width (max xw yw)) (define new-width (max xw yw))
(define x-paint (matte new-width xh x #:halign halign)) (define x-paint (matte new-width xh x #:halign halign))
(define y-paint (matte new-width yh y #:halign halign)) (define y-paint (matte new-width yh y #:halign halign))
@ -217,11 +217,11 @@
(apply vappend (car rs) #:halign halign #:reverse? reverse? (cdr rs))) (apply vappend (car rs) #:halign halign #:reverse? reverse? (cdr rs)))
(define* (*happend2 y x #:key (reverse? #f)) (define* (*happend2 y x #:key (reverse? #f))
(match-let ((($ <gaart> xw xh draw-x) x) (match-let ((($ <guart> xw xh draw-x) x)
(($ <gaart> yw yh draw-y) y)) (($ <guart> yw yh draw-y) y))
(unless (= xh yh) (unless (= xh yh)
(scm-error 'append-error "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 (guart
(+ xw yw) xh (+ xw yw) xh
(λ (okay? blit! rpos cpos) (λ (okay? blit! rpos cpos)
(define (dx) (draw-x okay? blit! rpos cpos)) (define (dx) (draw-x okay? blit! rpos cpos))
@ -235,8 +235,8 @@
(cond (cond
((not valign) (*happend2 y x #:reverse? reverse?)) ((not valign) (*happend2 y x #:reverse? reverse?))
(else (else
(match-let ((($ <gaart> xw xh draw-x) x) (match-let ((($ <guart> xw xh draw-x) x)
(($ <gaart> yw yh draw-y) y)) (($ <guart> yw yh draw-y) y))
(define new-height (max xh yh)) (define new-height (max xh yh))
(define x-paint (matte xw new-height x #:valign valign)) (define x-paint (matte xw new-height x #:valign valign))
(define y-paint (matte yw new-height y #:valign valign)) (define y-paint (matte yw new-height y #:valign valign))
@ -262,7 +262,7 @@
(bottom-right #\┘) (bottom-right #\┘)
(horiz-line #\─) (horiz-line #\─)
(vert-line #\│)) (vert-line #\│))
(match-let* ((($ <gaart> width height _) x) (match-let* ((($ <guart> width height _) x)
(hl (hline width #:ch horiz-line)) (hl (hline width #:ch horiz-line))
(vl (vline height #:ch vert-line)) (vl (vline height #:ch vert-line))
(bl (blank width height))) (bl (blank width height)))

View File

@ -1,4 +1,4 @@
(define-module (gaart buffer) (define-module (guart buffer)
#:use-module (uniseg graphemes) #:use-module (uniseg graphemes)
#:use-module (srfi srfi-43) #:use-module (srfi srfi-43)
#:export (make-buffer #:export (make-buffer

View File

@ -1,6 +1,6 @@
(define-module (gaart draw) (define-module (guart draw)
#:use-module (gaart) #:use-module (guart)
#:use-module (gaart buffer) #:use-module (guart buffer)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (draw-here)) #:export (draw-here))
@ -8,7 +8,7 @@
(unless port (unless port
(set! port (current-output-port))) (set! port (current-output-port)))
(match-let* ((($ <gaart> w h draw) ga) (match-let* ((($ <guart> w h draw) ga)
(buf (make-buffer w h)) (buf (make-buffer w h))
(okay? (λ (width height rpos cpos) #t)) (okay? (λ (width height rpos cpos) #t))
(blit! (λ (rpos cpos grapheme) (blit! (λ (rpos cpos grapheme)

View File

@ -14,7 +14,7 @@
(srfi srfi-1)) (srfi srfi-1))
(package (package
(name "guile-gaart") (name "guile-guart")
(version "0.1") (version "0.1")
(source (source
(local-file (local-file
@ -36,5 +36,5 @@
(description (description
"A library for drawing visual elements to the terminal in a composable way.") "A library for drawing visual elements to the terminal in a composable way.")
(home-page (home-page
"https://git.solarpunk.moe/solarpunk-guile/guile-gaart") "https://git.solarpunk.moe/solarpunk-guile/guile-guart")
(license license:gpl3+)) (license license:gpl3+))