├── .gitignore ├── LICENSE ├── README ├── buffer.rkt ├── draw.rkt ├── info.rkt ├── kitty-init.rkt ├── kitty-key.json ├── kitty.rkt ├── lux-chaos.rkt ├── main.rkt ├── raart.scrbl ├── size.rkt └── t ├── draw.rkt ├── hack.rkt ├── key.rkt └── kitty.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | \#* 3 | .\#* 4 | .DS_Store 5 | compiled/ 6 | /doc/ 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This code is available according to same terms as Racket: 2 | 3 | http://download.racket-lang.org/license.html 4 | 5 | Copyright © Jay McCarthy 6 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | raart - racket ansi art 2 | -------------------------------------------------------------------------------- /buffer.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/generic 3 | racket/match 4 | racket/contract/base 5 | (prefix-in A: ansi) 6 | struct-define) 7 | 8 | (define-generics buffer 9 | (buffer-resize! buffer rows cols) 10 | (buffer-start! buffer rows cols) 11 | (buffer-commit! buffer #:cursor? [cursor?])) 12 | 13 | (define symbol->style 14 | `#hasheq([normal . ,A:style-normal] 15 | [bold . ,A:style-bold] 16 | [inverse . ,A:style-inverse] 17 | [underline . ,A:style-underline])) 18 | (define style/c (apply or/c (hash-keys symbol->style))) 19 | 20 | (define symbol->color 21 | `#hasheq( 22 | [black . 0] [red . 1] [green . 2] [yellow . 3] 23 | [blue . 4] [magenta . 5] [cyan . 6] [white . 7] 24 | [brblack . 8] [brred . 9] [brgreen . 10] [bryellow . 11] 25 | [brblue . 12] [brmagenta . 13] [brcyan . 14] [brwhite . 15])) 26 | (define color/c (apply or/c byte? #f (hash-keys symbol->color))) 27 | (define (color->code c) 28 | (if (byte? c) c 29 | (hash-ref symbol->color c))) 30 | 31 | (define (select-style* s) 32 | (define (k s) (A:select-graphic-rendition (hash-ref symbol->style s))) 33 | (if (eq? s 'normal) (k s) 34 | (string-append (k 'normal) (k s)))) 35 | (define (select-text-color* c) 36 | (if c 37 | (A:select-xterm-256-text-color (color->code c)) 38 | (A:select-graphic-rendition A:style-default-text-color))) 39 | (define (select-background-color* c) 40 | (if c 41 | (A:select-xterm-256-background-color (color->code c)) 42 | (A:select-graphic-rendition A:style-default-background-color))) 43 | 44 | (define (make-terminal-buffer term-rows term-cols 45 | #:clear? [clear? #t] 46 | #:output [op (current-output-port)]) 47 | (terminal-buffer clear? op term-rows term-cols)) 48 | (define-struct-define terminal-buffer-define terminal-buffer) 49 | (struct terminal-buffer (clear? op [term-rows #:mutable] [term-cols #:mutable]) 50 | #:methods gen:buffer 51 | [(define (buffer-resize! buf new-rows new-cols) 52 | (terminal-buffer-define buf) 53 | (set! term-rows new-rows) 54 | (set! term-cols new-cols)) 55 | (define (buffer-start! buf draw-rows draw-cols) 56 | (terminal-buffer-define buf) 57 | (define-syntax-rule 58 | (maybe-update last-X X select-X) 59 | (unless (eq? last-X X) 60 | (display (select-X X) op) 61 | (set! last-X X))) 62 | 63 | (display (A:dec-soft-terminal-reset) op) 64 | (when (terminal-buffer-clear? buf) 65 | (display (A:clear-screen/home) op)) 66 | (display (A:hide-cursor) op) 67 | (define last-s #f) 68 | (define last-f #f) 69 | (define last-b #f) 70 | (define cur-r -1) 71 | (define cur-c -1) 72 | (values 73 | term-rows term-cols 74 | (λ (s f b r c ch) 75 | (cond 76 | [(or (< r 0) 77 | (<= term-rows r) 78 | (< c 0) 79 | (<= term-cols c)) 80 | #f] 81 | [else 82 | (maybe-update last-s s select-style*) 83 | (maybe-update last-f f select-text-color*) 84 | (maybe-update last-b b select-background-color*) 85 | 86 | (define tr (add1 r)) 87 | (define tc (add1 c)) 88 | (unless (and (= cur-r tr) 89 | (= cur-c tc)) 90 | (display (A:goto tr tc) op) 91 | (set! cur-r tr) 92 | (set! cur-c tc)) 93 | 94 | (when ch 95 | (display ch op) 96 | (set! cur-c (add1 cur-c))) 97 | 98 | #t])))) 99 | (define (buffer-commit! buf #:cursor? [cursor? #t]) 100 | (terminal-buffer-define buf) 101 | (when cursor? (display (A:show-cursor) op)) 102 | (flush-output op))]) 103 | 104 | (struct output-cell (s f b ch) #:mutable #:transparent) 105 | (define (clear-cell! c) 106 | (set-output-cell-s! c 'normal) 107 | (set-output-cell-f! c #f) 108 | (set-output-cell-b! c #f) 109 | (set-output-cell-ch! c #f)) 110 | (define (default-cell) (output-cell 'normal #f #f #f)) 111 | 112 | (struct cells (rows cols vec) #:mutable) 113 | (define (maybe-make-cells old new-rows new-cols) 114 | (match-define (cells old-rows old-cols vec) old) 115 | ;; XXX support shrinking/growing while preserving information 116 | (if (and (= old-rows new-rows) 117 | (= old-cols new-cols)) 118 | old 119 | (make-cells new-rows new-cols))) 120 | (define (make-cells rows cols) 121 | (cells rows cols 122 | (build-vector 123 | rows 124 | (λ (r) 125 | (build-vector cols (λ (c) (default-cell))))))) 126 | (define (clear-cells! cs) 127 | (match-define (cells _ _ vec) cs) 128 | (for* ([row (in-vector vec)] 129 | [cell (in-vector row)]) 130 | (clear-cell! cell))) 131 | (define (draw-cell! cs) 132 | (match-define (cells ok-rows ok-cols vec) cs) 133 | (λ (s f b r c ch) 134 | (cond 135 | [(or (< r 0) 136 | (<= ok-rows r) 137 | (< c 0) 138 | (<= ok-cols c)) 139 | #f] 140 | [else 141 | (define oc (vector-ref (vector-ref vec r) c)) 142 | (set-output-cell-s! oc s) 143 | (set-output-cell-f! oc f) 144 | (set-output-cell-b! oc b) 145 | (when ch 146 | (set-output-cell-ch! oc ch)) 147 | #t]))) 148 | 149 | (define (make-output-buffer #:output [op (current-output-port)]) 150 | (output-buffer op (make-cells 0 0))) 151 | (define-struct-define output-buffer-define output-buffer) 152 | (struct output-buffer (op [cells #:mutable]) 153 | #:methods gen:buffer 154 | [(define (buffer-resize! buf new-rows new-cols) 155 | (output-buffer-define buf) 156 | (set! cells (maybe-make-cells cells new-rows new-cols))) 157 | (define (buffer-start! buf draw-rows draw-cols) 158 | (output-buffer-define buf) 159 | (buffer-resize! buf draw-rows draw-cols) 160 | (clear-cells! cells) 161 | (values draw-rows draw-cols (draw-cell! cells))) 162 | (define (buffer-commit! buf #:cursor? [cursor? #t]) 163 | (output-buffer-define buf) 164 | (for/fold ([last-s #f] [last-f #f] [last-b #f]) 165 | ([row (in-vector (cells-vec cells))]) 166 | (begin0 167 | (for/fold ([last-s last-s] [last-f last-f] [last-b last-b]) 168 | ([oc (in-vector row)]) 169 | (match-define (output-cell s f b ch) oc) 170 | (unless (eq? last-s s) 171 | (display (select-style* s) op)) 172 | (unless (eq? last-f f) 173 | (display (select-text-color* f) op)) 174 | (unless (eq? last-b b) 175 | (display (select-background-color* b) op)) 176 | (display (or ch #\space) op) 177 | (values s f b)) 178 | (newline op))) 179 | (flush-output op) 180 | (void))]) 181 | 182 | (define (make-cached-buffer term-rows term-cols 183 | #:output [op (current-output-port)]) 184 | (define (mk-term clear?) 185 | (make-terminal-buffer term-rows term-cols 186 | #:clear? clear? 187 | #:output op)) 188 | (cached-buffer 189 | #t 190 | (mk-term #f) (mk-term #t) 191 | term-rows term-cols 192 | (make-cells term-rows term-cols) 193 | (make-cells term-rows term-cols) 194 | 0 0)) 195 | (define-struct-define cached-buffer-define cached-buffer) 196 | (struct cached-buffer 197 | ([clear-next? #:mutable] 198 | term-nclear term-yclear 199 | [term-rows #:mutable] [term-cols #:mutable] 200 | [cur-cells #:mutable] [new-cells #:mutable] 201 | [last-row #:mutable] [last-col #:mutable]) 202 | #:methods gen:buffer 203 | [(define/generic super-buffer-resize! buffer-resize!) 204 | (define/generic super-buffer-start! buffer-start!) 205 | (define/generic super-buffer-commit! buffer-commit!) 206 | 207 | (define (buffer-resize! buf new-rows new-cols) 208 | (cached-buffer-define buf) 209 | (set! clear-next? #t) 210 | (set! cur-cells (maybe-make-cells cur-cells new-rows new-cols)) 211 | (set! new-cells (maybe-make-cells new-cells new-rows new-cols)) 212 | (super-buffer-resize! term-nclear new-rows new-cols) 213 | (super-buffer-resize! term-yclear new-rows new-cols) 214 | (set! term-rows new-rows) 215 | (set! term-cols new-cols) 216 | (clear-cells! cur-cells)) 217 | (define (buffer-start! buf draw-rows draw-cols) 218 | (cached-buffer-define buf) 219 | (clear-cells! new-cells) 220 | (define dc (draw-cell! new-cells)) 221 | (values term-rows term-cols 222 | (λ (s f b r c ch) 223 | (set! last-row r) 224 | (set! last-col c) 225 | (dc s f b r c ch)))) 226 | (define (buffer-commit! buf #:cursor? [cursor? #t]) 227 | (cached-buffer-define buf) 228 | (define inner-buf (if clear-next? term-yclear term-nclear)) 229 | (set! clear-next? #f) 230 | (define-values (ok-rows ok-cols draw!) 231 | (super-buffer-start! inner-buf term-rows term-cols)) 232 | (for ([cur-row (in-vector (cells-vec cur-cells))] 233 | [new-row (in-vector (cells-vec new-cells))] 234 | [r (in-naturals)]) 235 | (for ([cur-cell (in-vector cur-row)] 236 | [new-cell (in-vector new-row)] 237 | [c (in-naturals)]) 238 | (unless (equal? cur-cell new-cell) 239 | (match-define (output-cell _ _ _ cur-ch) cur-cell) 240 | (match-define (output-cell s f b new-ch) new-cell) 241 | (draw! s f b r c (or new-ch #\space))))) 242 | (draw! 'normal #f #f last-row last-col #f) 243 | (super-buffer-commit! inner-buf #:cursor? cursor?) 244 | (swap! new-cells cur-cells))]) 245 | 246 | (define-syntax-rule (swap! x y) 247 | (let ([tmp x]) 248 | (set! x y) 249 | (set! y tmp))) 250 | 251 | (module+ internal 252 | (provide 253 | (contract-out 254 | [buffer-resize! 255 | (-> buffer? 256 | exact-nonnegative-integer? exact-nonnegative-integer? 257 | void?)] 258 | [buffer-start! 259 | (-> buffer? 260 | exact-nonnegative-integer? exact-nonnegative-integer? 261 | (values exact-nonnegative-integer? 262 | exact-nonnegative-integer? 263 | (-> style/c color/c color/c 264 | exact-nonnegative-integer? 265 | exact-nonnegative-integer? 266 | (or/c char? #f) 267 | boolean?)))] 268 | [buffer-commit! 269 | (->* (buffer?) (#:cursor? boolean?) void?)]))) 270 | 271 | (provide 272 | (contract-out 273 | [color/c contract?] 274 | [style/c contract?] 275 | [buffer? (-> any/c boolean?)] 276 | [make-terminal-buffer 277 | (->* (exact-nonnegative-integer? exact-nonnegative-integer?) 278 | (#:clear? boolean? #:output output-port?) 279 | buffer?)] 280 | [make-output-buffer 281 | (->* () (#:output output-port?) buffer?)] 282 | [make-cached-buffer 283 | (->* (exact-nonnegative-integer? exact-nonnegative-integer?) 284 | (#:output output-port?) 285 | buffer?)])) 286 | 287 | 288 | -------------------------------------------------------------------------------- /draw.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/match 3 | racket/list 4 | racket/string 5 | racket/contract/base 6 | (for-syntax racket/base 7 | syntax/parse) 8 | "buffer.rkt" 9 | (submod "buffer.rkt" internal)) 10 | 11 | ;; XXX ensure that argument order is ALWAYS w h r c 12 | 13 | (define (strict-or a b) (or a b)) 14 | 15 | (define current-style (make-parameter 'normal)) 16 | (define current-fg (make-parameter #f)) 17 | (define current-bg (make-parameter #f)) 18 | (define-syntax (with-maybe-parameterize stx) 19 | (syntax-parse stx 20 | [(_ () . body) #'(let () . body)] 21 | [(_ ([p:id v:id] . m) . body) 22 | #'(let ([t (λ () (with-maybe-parameterize m . body))]) 23 | (if v (parameterize ([p v]) (t)) (t)))])) 24 | 25 | (define (rectangle-intersect a-x1 a-y1 26 | a-x2 a-y2 27 | b-x1 b-y1 28 | b-x2 b-y2) 29 | (and (< a-x1 b-x2) 30 | (> a-x2 b-x1) 31 | (< a-y1 b-y2) 32 | (> a-y2 b-y1))) 33 | 34 | ;; w : exact-nonnegative-integer? 35 | ;; h : exact-nonnegative-integer? 36 | ;; ! : okay? (row col char -> void) row col -> bool 37 | (struct raart (w h !)) 38 | 39 | (struct meta-raart raart (m)) 40 | (define (without-cursor x) 41 | (match-define (raart w h !) x) 42 | (meta-raart w h ! '(without-cursor))) 43 | 44 | (define (draw buf x) 45 | (match-define (raart w h !) x) 46 | (define-values 47 | (max-rows max-cols draw-char!) 48 | (buffer-start! buf h w)) 49 | (define (draw-with-params r c ch) 50 | (unless (or (negative? r) (negative? c)) 51 | (draw-char! (current-style) (current-fg) (current-bg) 52 | r c ch))) 53 | (define (on-screen? w h r c) 54 | (rectangle-intersect 0 0 55 | max-cols max-rows 56 | c r 57 | (+ c w) (+ r h))) 58 | (! on-screen? draw-with-params 0 0) 59 | (define without-cursor? 60 | (memq 'without-cursor (if (meta-raart? x) (meta-raart-m x) '()))) 61 | (buffer-commit! #:cursor? (not without-cursor) buf)) 62 | 63 | (define (raart* w h !) 64 | (raart w h 65 | (λ (okay? d r c) 66 | (and (okay? w h r c) 67 | (! okay? d r c))))) 68 | 69 | ;; Core forms 70 | (define (with-drawing s f b x) 71 | (match-define (raart w h !) x) 72 | (raart* w h (λ (okay? d r c) 73 | (with-maybe-parameterize ([current-style s] 74 | [current-fg f] 75 | [current-bg b]) 76 | (! okay? d r c))))) 77 | 78 | (define (blank [w 0] [h 1]) 79 | (raart* w h (λ (okay? d r c) #f))) 80 | 81 | (define (char ch) 82 | (when (char-iso-control? ch) 83 | (error 'char "Illegal character: ~v" ch)) 84 | (raart* 1 1 (λ (okay? d r c) (d r c ch)))) 85 | 86 | (define (text s) 87 | (for ([ch (in-string s)] 88 | #:when (char-iso-control? ch)) 89 | (error 'text "Illegal character in string: ~v" ch)) 90 | (raart* (string-length s) 1 91 | (λ (okay? d r c) 92 | (for ([ch (in-string s)] 93 | [dc (in-naturals)]) 94 | (d r (+ c dc) ch))))) 95 | 96 | (define (place-at back dr dc front) 97 | (match-define (raart bw bh b!) back) 98 | (match-define (raart fw fh f!) front) 99 | (unless (and (<= fw bw) (<= fh bh)) 100 | (error 'place-at "Foreground must fit inside background")) 101 | (raart* bw bh 102 | (λ (okay? d r c) 103 | (strict-or 104 | (b! okay? d r c) 105 | (f! okay? d (+ r dr) (+ c dc)))))) 106 | 107 | (define (mask mc mw mr mh x) 108 | (match-define (raart xw xh x!) x) 109 | (raart* xw xh 110 | (λ (okay? d r c) 111 | (x! 112 | (λ (w h r c) 113 | (and (okay? w h r c) 114 | (rectangle-intersect mc mr 115 | (+ mc mw) (+ mr mh) 116 | c r 117 | (+ c w) (+ r h)))) 118 | d r c)))) 119 | 120 | (define (crop cc cw cr ch x) 121 | (define mx (mask cc cw cr ch x)) 122 | (match-define (raart mw mh m!) mx) 123 | (raart* cw ch 124 | (λ (okay? d r c) 125 | (m! (λ (w h r c) 126 | (okay? w h (- r cr) (- c cc))) 127 | (λ (r c ch) 128 | (d (- r cr) (- c cc) ch)) 129 | r c)))) 130 | 131 | (define (if-drawn f x) 132 | (match-define (raart w h !) x) 133 | (raart* w h (λ (okay? d r c) 134 | (define ? (! okay? d r c)) 135 | (when ? (f r c w h)) 136 | ?))) 137 | 138 | (define (place-cursor-after x cr cc) 139 | (match-define (raart w h !) x) 140 | (raart* w h (λ (okay? d r c) 141 | (strict-or (! okay? d r c) 142 | (d cr cc #f))))) 143 | 144 | (define (*vappend2 #:reverse? [reverse? #f] y x) 145 | (match-define (raart xw xh x!) x) 146 | (match-define (raart yw yh y!) y) 147 | (unless (= xw yw) 148 | (error '*vappend2 "Widths must be equal: ~e vs ~e" xw yw)) 149 | (raart* xw (+ xh yh) 150 | (λ (okay? d r c) 151 | (define (dx) (x! okay? d (+ r 0) c)) 152 | (define (dy) (y! okay? d (+ r xh) c)) 153 | (if reverse? 154 | (strict-or (dy) (dx)) 155 | (strict-or (dx) (dy)))))) 156 | 157 | (define (*happend2 #:reverse? [reverse? #f] y x) 158 | (match-define (raart xw xh x!) x) 159 | (match-define (raart yw yh y!) y) 160 | (unless (= xh yh) 161 | (error '*happend2 "Heights must be equal: ~e vs ~e" xh yh)) 162 | (raart* (+ xw yw) xh 163 | (λ (okay? d r c) 164 | (define (dx) (x! okay? d r (+ c 0))) 165 | (define (dy) (y! okay? d r (+ c xw))) 166 | (if reverse? 167 | (strict-or (dy) (dx)) 168 | (strict-or (dx) (dy)))))) 169 | 170 | ;; Library 171 | (define (style s x) (with-drawing s #f #f x)) 172 | (define (fg f x) (with-drawing #f f #f x)) 173 | (define (bg b x) (with-drawing #f #f b x)) 174 | 175 | (define-syntax (place-at* stx) 176 | (syntax-parse stx 177 | [(_ b:expr) #'b] 178 | [(_ b:expr [dr:expr dc:expr f:expr] . more:expr) 179 | #'(place-at* (place-at b dr dc f) . more)])) 180 | 181 | (define (matte-at mw mh @c @r x) 182 | (match-define (raart xw xh x!) x) 183 | (unless (and (<= (+ xw @c) mw) 184 | (<= (+ xh @r) mh)) 185 | (error 'matte-at "Original (~ax~a@~a,~a) must fit inside matte (~ax~a)" 186 | xw xh @c @r mw mh)) 187 | (place-at (blank mw mh) @r @c x)) 188 | 189 | (define (translate dr dc x) 190 | (match-define (raart xw xh x!) x) 191 | (matte-at (+ xw dc) (+ xh dr) dc dr x)) 192 | 193 | (define (matte aw ah 194 | #:halign [ws 'center] 195 | #:valign [hs 'center] 196 | x) 197 | (define w (or aw (raart-w x))) 198 | (define h (or ah (raart-h x))) 199 | (match-define (raart xw xh x!) x) 200 | (unless (and (<= xw w) (<= xh h)) 201 | (error 'matte "Original (~ax~a) must fit inside matte (~ax~a)" 202 | xw xh w h)) 203 | (matte-at w h 204 | (match ws 205 | ['left 0] 206 | ['center (floor (/ (- w xw) 2))] 207 | ['right (- w xw)]) 208 | (match hs 209 | ['top 0] 210 | ['center (floor (/ (- h xh) 2))] 211 | ['bottom (- h xh)]) 212 | x)) 213 | 214 | (define (inset dw dh x) 215 | (match-define (raart w h !) x) 216 | (matte (+ dw w dw) (+ dh h dh) 217 | #:halign 'center #:valign 'center 218 | x)) 219 | 220 | (define (vappend2 y x #:halign [halign #f] #:reverse? [reverse? #f]) 221 | (cond 222 | [(not halign) (*vappend2 #:reverse? reverse? y x)] 223 | [else 224 | (match-define (raart xw xh x!) x) 225 | (match-define (raart yw yh y!) y) 226 | (define nw (max xw yw)) 227 | (define xp (matte nw xh #:halign halign x)) 228 | (define yp (matte nw yh #:halign halign y)) 229 | (*vappend2 #:reverse? reverse? yp xp)])) 230 | (define (vappend #:halign [halign #f] #:reverse? [reverse? #f] r1 . rs) 231 | (foldl (λ (a d) (vappend2 #:halign halign #:reverse? reverse? a d)) r1 rs)) 232 | (define (vappend* #:halign [halign #f] #:reverse? [reverse? #f] rs) 233 | (apply vappend rs #:halign halign #:reverse? reverse?)) 234 | 235 | (define (happend2 y x #:valign [valign #f] #:reverse? [reverse? #f]) 236 | (cond 237 | [(not valign) (*happend2 #:reverse? reverse? y x)] 238 | [else 239 | (match-define (raart xw xh x!) x) 240 | (match-define (raart yw yh y!) y) 241 | (define nh (max xh yh)) 242 | (define xp (matte xw nh #:valign valign x)) 243 | (define yp (matte yw nh #:valign valign y)) 244 | (*happend2 #:reverse? reverse? yp xp)])) 245 | (define (happend #:valign [valign #f] #:reverse? [reverse? #f] r1 . rs) 246 | (foldl (λ (a d) (happend2 #:valign valign #:reverse? reverse? a d)) r1 rs)) 247 | (define (happend* #:valign [valign #f] #:reverse? [reverse? #f] rs) 248 | (apply happend rs #:valign valign #:reverse? reverse?)) 249 | 250 | (define (hline w) 251 | (text (make-string w #\─))) 252 | (define (vline h) 253 | (vappend* (make-list h (char #\│)))) 254 | 255 | (define (frame #:style [s #f] #:fg [f #f] #:bg [b #f] x) 256 | (match-define (raart w h _) x) 257 | (place-at 258 | (with-drawing s f b 259 | (vappend 260 | (happend (char #\┌) (hline w ) (char #\┐)) 261 | (happend (vline h) (blank w h) (vline h)) 262 | (happend (char #\└) (hline w ) (char #\┘)))) 263 | 1 1 x)) 264 | 265 | (define (table rows 266 | ;; XXX add more options to frames 267 | #:frames? [frames? #t] 268 | #:style [s #f] #:fg [f #f] #:bg [b #f] 269 | #:inset-dw [dw 0] 270 | #:inset-dh [dh 0] 271 | #:valign [row-valign 'top] 272 | #:halign [halign 'left]) 273 | (define (list-ref* i l) 274 | (list-ref l (min i (sub1 (length l))))) 275 | (define (col-halign-sel i halign) 276 | (match halign 277 | [(? symbol?) halign] 278 | [(? list?) (list-ref* i halign)])) 279 | (define (col-halign col-i) 280 | (col-halign-sel col-i halign)) 281 | (define col-ws 282 | (for/list ([i (in-range (length (first rows)))]) 283 | (define col (map (λ (r) (list-ref r i)) rows)) 284 | (apply max (map raart-w col)))) 285 | (define last-col (sub1 (length col-ws))) 286 | 287 | (define (make-bar left middle right) 288 | (happend* 289 | (cons 290 | (char left) 291 | (for/list ([col-w (in-list col-ws)] 292 | [col-i (in-naturals)]) 293 | (happend (hline (+ dw col-w dw)) 294 | (if (= last-col col-i) 295 | (char right) 296 | (char middle))))))) 297 | 298 | (define header (make-bar #\┌ #\┬ #\┐)) 299 | (define inbetween (make-bar #\├ #\┼ #\┤)) 300 | (define footer (make-bar #\└ #\┴ #\┘)) 301 | (define last-row (sub1 (length rows))) 302 | (vappend* 303 | (for/list ([row (in-list rows)] 304 | [row-i (in-naturals)]) 305 | (define row-h (apply max (map raart-h row))) 306 | (define cell-h (+ dh row-h dh)) 307 | (define cell-wall (vline cell-h)) 308 | (define the-row 309 | (happend* 310 | (for/list ([col (in-list row)] 311 | [col-w (in-list col-ws)] 312 | [col-i (in-naturals)]) 313 | (define cell-w (+ dw col-w dw)) 314 | (define the-cell 315 | (matte cell-w #:halign (col-halign col-i) 316 | cell-h #:valign row-valign 317 | (inset dw dh col))) 318 | (define cell+left 319 | (if frames? (happend cell-wall the-cell) the-cell)) 320 | (if (and frames? (= col-i last-col)) 321 | (happend cell+left cell-wall) 322 | cell+left)))) 323 | (define include-header? (zero? row-i)) 324 | (define row-and-above 325 | (if (and frames? include-header?) (vappend header the-row) the-row)) 326 | (define include-footer? (= row-i last-row)) 327 | (define row-and-below 328 | (if frames? 329 | (vappend row-and-above 330 | (if include-footer? 331 | footer 332 | inbetween)) 333 | row-and-above)) 334 | row-and-below))) 335 | (define (text-rows rows) 336 | (local-require racket/format) 337 | (for/list ([row (in-list rows)]) 338 | (for/list ([col (in-list row)]) 339 | (if (raart? col) col (text (~a col)))))) 340 | 341 | (define (para mw s #:halign [halign 'left]) 342 | (para* mw (map text (string-split s " ")) #:halign halign #:gap (text " "))) 343 | (define (para* mw rs #:halign [halign 'left] #:gap [gap (blank)]) 344 | (for/fold ([all-rows (list (blank))] 345 | #:result 346 | (vappend* #:halign halign (reverse all-rows))) 347 | ([r (in-list rs)]) 348 | (match-define (cons last-row rows) all-rows) 349 | (if (< (+ (raart-w last-row) (raart-w r)) mw) 350 | (cons (happend last-row gap r) rows) 351 | (cons r all-rows)))) 352 | 353 | (define (draw-here r) 354 | (draw (make-output-buffer) r)) 355 | 356 | (define valign/c (or/c 'top 'center 'bottom)) 357 | (define halign/c (or/c 'left 'center 'right)) 358 | (provide 359 | (contract-out 360 | [raart? (-> any/c boolean?)] 361 | [raart-w (-> raart? integer?)] 362 | [raart-h (-> raart? integer?)] 363 | [draw 364 | (-> buffer? raart? 365 | void?)] 366 | [draw-here (-> raart? void?)] 367 | [style (-> style/c raart? raart?)] 368 | [fg (-> color/c raart? raart?)] 369 | [bg (-> color/c raart? raart?)] 370 | [with-drawing 371 | (-> (or/c style/c #f) 372 | (or/c color/c #f) 373 | (or/c color/c #f) 374 | raart? raart?)] 375 | [blank (->* () (exact-nonnegative-integer? exact-nonnegative-integer?) raart?)] 376 | [char (-> (and/c char? (not/c char-iso-control?)) raart?)] 377 | [text (-> string? raart?)] 378 | [hline (-> exact-nonnegative-integer? raart?)] 379 | [vline (-> exact-nonnegative-integer? raart?)] 380 | [vappend2 (->* (raart? raart?) 381 | (#:halign (or/c halign/c #f) #:reverse? boolean?) 382 | raart?)] 383 | [vappend (->* (raart?) 384 | (#:halign (or/c halign/c #f) #:reverse? boolean?) 385 | #:rest (listof raart?) 386 | raart?)] 387 | [vappend* (->* ((non-empty-listof raart?)) 388 | (#:halign (or/c halign/c #f) #:reverse? boolean?) 389 | raart?)] 390 | [happend2 (->* (raart? raart?) 391 | (#:valign (or/c valign/c #f) #:reverse? boolean?) 392 | raart?)] 393 | [happend (->* (raart?) 394 | (#:valign (or/c valign/c #f) #:reverse? boolean?) 395 | #:rest (listof raart?) 396 | raart?)] 397 | [happend* (->* ((non-empty-listof raart?)) 398 | (#:valign (or/c valign/c #f) #:reverse? boolean?) 399 | raart?)] 400 | [place-at (-> raart? exact-nonnegative-integer? exact-nonnegative-integer? raart? 401 | raart?)] 402 | [frame (->* (raart?) 403 | (#:style (or/c style/c #f) #:fg (or/c color/c #f) #:bg (or/c color/c #f)) 404 | raart?)] 405 | [matte-at (-> exact-nonnegative-integer? exact-nonnegative-integer? 406 | exact-nonnegative-integer? exact-nonnegative-integer? 407 | raart? 408 | raart?)] 409 | [translate (-> exact-nonnegative-integer? exact-nonnegative-integer? 410 | raart? raart?)] 411 | [halign/c contract?] 412 | [valign/c contract?] 413 | [matte (->* ((or/c exact-nonnegative-integer? false/c) 414 | (or/c exact-nonnegative-integer? false/c) 415 | raart?) 416 | (#:halign halign/c #:valign valign/c) 417 | raart?)] 418 | [inset (-> exact-nonnegative-integer? exact-nonnegative-integer? raart? raart?)] 419 | [mask (-> exact-nonnegative-integer? exact-nonnegative-integer? 420 | exact-nonnegative-integer? exact-nonnegative-integer? 421 | raart? raart?)] 422 | [crop (-> exact-nonnegative-integer? exact-nonnegative-integer? 423 | exact-nonnegative-integer? exact-nonnegative-integer? 424 | raart? raart?)] 425 | [table (->* ((listof (listof raart?))) 426 | (#:frames? boolean? 427 | #:style (or/c style/c #f) 428 | #:fg (or/c color/c #f) 429 | #:bg (or/c color/c #f) 430 | #:inset-dw exact-nonnegative-integer? 431 | #:inset-dh exact-nonnegative-integer? 432 | #:valign valign/c 433 | #:halign (or/c halign/c (list*of halign/c (or/c halign/c '())))) 434 | raart?)] 435 | [text-rows (-> (listof (listof any/c)) 436 | (listof (listof raart?)))] 437 | [para (->* (exact-nonnegative-integer? string?) 438 | (#:halign halign/c) 439 | raart?)] 440 | [para* (->* (exact-nonnegative-integer? (listof raart?)) 441 | (#:halign halign/c #:gap raart?) 442 | raart?)] 443 | [if-drawn (-> (-> exact-nonnegative-integer? exact-nonnegative-integer? 444 | exact-nonnegative-integer? exact-nonnegative-integer? 445 | any) 446 | raart? raart?)] 447 | [place-cursor-after 448 | (-> raart? exact-nonnegative-integer? exact-nonnegative-integer? 449 | raart?)] 450 | [without-cursor 451 | (-> raart? raart?)]) 452 | place-at*) 453 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define collection "raart") 3 | (define deps '("gui-lib" 4 | "htdp-lib" 5 | "pict-lib" 6 | "plot-gui-lib" 7 | "plot-lib" 8 | "lux" 9 | "unix-signals" 10 | "reprovide-lang" 11 | "ansi" 12 | "struct-define" 13 | "base")) 14 | (define build-deps '("sandbox-lib" 15 | "htdp-doc" 16 | "racket-doc" 17 | "scribble-lib" 18 | )) 19 | (define version "0.1") 20 | (define pkg-authors '(jeapostrophe)) 21 | (define scribblings '(("raart.scrbl" () ("UI")))) 22 | -------------------------------------------------------------------------------- /kitty-init.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/init 3 | raart/kitty) 4 | 5 | (install-kitty-print!) 6 | 7 | (provide (all-from-out racket/init)) 8 | -------------------------------------------------------------------------------- /kitty-key.json: -------------------------------------------------------------------------------- 1 | { 2 | "0": "G", 3 | "1": "H", 4 | "2": "I", 5 | "3": "J", 6 | "4": "K", 7 | "5": "L", 8 | "6": "M", 9 | "7": "N", 10 | "8": "O", 11 | "9": "P", 12 | "A": "S", 13 | "'": "B", 14 | "B": "T", 15 | "C": "U", 16 | ",": "C", 17 | "D": "V", 18 | "E": "W", 19 | "=": "R", 20 | "F": "X", 21 | "f1": "/", 22 | "f10": "]", 23 | "f11": "{", 24 | "f12": "}", 25 | "f13": "@", 26 | "f14": "%", 27 | "f15": "$", 28 | "f16": "#", 29 | "f17": "BA", 30 | "f18": "BB", 31 | "f19": "BC", 32 | "f2": "*", 33 | "f20": "BD", 34 | "f21": "BE", 35 | "f22": "BF", 36 | "f23": "BG", 37 | "f24": "BH", 38 | "f25": "BI", 39 | "f3": "?", 40 | "f4": "&", 41 | "f5": "<", 42 | "f6": ">", 43 | "f7": "(", 44 | "f8": ")", 45 | "f9": "[", 46 | "G": "Y", 47 | "`": "v", 48 | "H": "Z", 49 | "home": ".", 50 | "I": "a", 51 | "insert": "2", 52 | "J": "b", 53 | "K": "c", 54 | "kp0": "BJ", 55 | "kp1": "BK", 56 | "kp2": "BL", 57 | "kp3": "BM", 58 | "kp4": "BN", 59 | "kp5": "BO", 60 | "kp6": "BP", 61 | "kp7": "BQ", 62 | "kp8": "BR", 63 | "kp9": "BS", 64 | "kp+": "BX", 65 | "kp.": "BT", 66 | "kp/": "BU", 67 | "kpret": "BY", 68 | "kp=": "BZ", 69 | "kp*": "BV", 70 | "kp-": "BW", 71 | "L": "d", 72 | "left": "5", 73 | "left-alt": "Bc", 74 | "[": "s", 75 | "left-ctrl": "Bb", 76 | "left-shift": "Ba", 77 | "left-super": "Bd", 78 | "M": "e", 79 | "-": "D", 80 | "N": "f", 81 | "numlock": "=", 82 | "O": "g", 83 | "P": "h", 84 | "page-down": "9", 85 | "page-up": "8", 86 | "pause": "!", 87 | ".": "E", 88 | "print-screen": "^", 89 | "Q": "i", 90 | "R": "j", 91 | "right": "4", 92 | "right-alt": "Bg", 93 | "]": "u", 94 | "right-ctrl": "Bf", 95 | "right-shift": "Be", 96 | "right-super": "Bh", 97 | "S": "k", 98 | "scroll-lock": "+", 99 | ";": "Q", 100 | "/": "F", 101 | " ": "A", 102 | "T": "l", 103 | "tab": "0", 104 | "U": "m", 105 | "up": "7", 106 | "V": "n", 107 | "W": "o", 108 | "world1": "w", 109 | "world2": "x", 110 | "X": "p", 111 | "Y": "q", 112 | "Z": "r", 113 | "\\": "t", 114 | "backspace": "1", 115 | "caps-lock": ":", 116 | "delete": "3", 117 | "down": "6", 118 | "end": "-", 119 | "return": "z", 120 | "esc": "y" 121 | } 122 | -------------------------------------------------------------------------------- /kitty.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/match 3 | racket/set 4 | racket/runtime-path 5 | json 6 | (prefix-in pict: pict) 7 | file/convertible 8 | racket/class 9 | racket/gui/dynamic) 10 | 11 | (define (convert->png-bytes v) 12 | (and (convertible? v) 13 | (convert v 'png-bytes+bounds #f))) 14 | 15 | ;; Replace "racket -t file" 16 | ;; with 17 | ;; "racket -I raart/kitty-init -i -t file -e '(exit 0)'" 18 | 19 | (define (term-is-kitty?) 20 | (define t (environment-variables-ref (current-environment-variables) #"TERM")) 21 | (equal? t #"xterm-kitty")) 22 | 23 | (define (install-kitty-print!) 24 | (when (term-is-kitty?) 25 | (define (snip? v) 26 | (and (gui-available?) 27 | (is-a? v (gui-dynamic-require 'snip%)))) 28 | ;; XXX This could do better and use 29 | #;(pretty-print-size-hook) 30 | ;; and 31 | #;(pretty-print-print-hook) 32 | ;; to pretty these things inside other structures 33 | ;; but, then I believe I could not rely on icat, but I'd have to implement it myself 34 | 35 | (define old-print (current-print)) 36 | (define (new-print v) 37 | (match (or (convert->png-bytes v) v) 38 | [(list bs w h d v) 39 | (define-values 40 | (sp stdout stdin stderr) 41 | (subprocess (current-output-port) #f (current-error-port) 42 | (find-executable-path "kitty") 43 | "+kitten" "icat")) 44 | (write-bytes bs stdin) 45 | (close-output-port stdin) 46 | (subprocess-wait sp)] 47 | [(? snip?) 48 | (define wb (box #f)) 49 | (define hb (box #f)) 50 | (send v get-extent (pict:dc-for-text-size) 0 0 wb hb) 51 | (define w (unbox wb)) 52 | (define h (unbox hb)) 53 | (new-print 54 | (pict:dc (λ (dc x y) 55 | (send v draw dc x y 0 0 w h 0 0 'no-caret)) 56 | w h))] 57 | [v (old-print v)])) 58 | (current-print new-print))) 59 | 60 | (define-runtime-path kk.j "kitty-key.json") 61 | (define kk-ht 62 | (for/hash ([(s e) (in-hash (with-input-from-file kk.j read-json))]) 63 | (define o (symbol->string s)) 64 | (values (string->bytes/utf-8 e) 65 | (cond 66 | [(= 1 (string-length o)) 67 | (string-ref o 0)] 68 | [else o])))) 69 | (define (kitty-key-lookup k) 70 | (hash-ref kk-ht k (λ () k))) 71 | 72 | (define (kitty-mods-lookup mb) 73 | (define mn 74 | (- (bytes-ref mb 0) (char->integer #\A))) 75 | (for/fold ([s (seteq)]) 76 | ([m (in-list '(shift meta control super))] 77 | [i (in-list '(1 2 4 8))]) 78 | (if (zero? (bitwise-and mn i)) s 79 | (set-add s m)))) 80 | 81 | (provide install-kitty-print! 82 | term-is-kitty? 83 | kitty-key-lookup 84 | kitty-mods-lookup) 85 | -------------------------------------------------------------------------------- /lux-chaos.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/match 3 | racket/contract/base 4 | racket/list 5 | racket/set 6 | racket/async-channel 7 | racket/system 8 | net/base64 9 | ansi 10 | unix-signals 11 | lux/chaos 12 | raart/draw 13 | raart/buffer 14 | (submod raart/buffer internal) 15 | struct-define 16 | "kitty.rkt") 17 | 18 | (struct term (f in out)) 19 | 20 | (define-syntax-rule (define-stty-term open-term close-term) 21 | (begin 22 | (define default-tty "/dev/tty") 23 | (define stty-minus-f-arg-string 24 | (case (system-type 'os) 25 | ((macosx) "-f") 26 | (else "-F"))) 27 | (define (open-term #:tty [tty default-tty]) 28 | (system* "/bin/stty" stty-minus-f-arg-string tty 29 | "raw" "pass8" "-echo") 30 | (define-values (in out) 31 | (open-input-output-file tty #:exists 'update)) 32 | (file-stream-buffer-mode in 'none) 33 | (file-stream-buffer-mode out 'none) 34 | (term tty in out)) 35 | (define (close-term t) 36 | (match-define (term tty in out) t) 37 | (close-input-port in) 38 | (close-output-port out) 39 | (system* "/bin/stty" stty-minus-f-arg-string tty 40 | "sane")))) 41 | 42 | (define-syntax-rule (define-stdin-term open-term close-term) 43 | (begin 44 | (require ansi/private/tty-raw-extension) 45 | (define (open-term #:tty [tty #f]) 46 | (when tty 47 | (error 'open-term "Custom tty not supported in this version")) 48 | (tty-raw!) 49 | (term #f (current-input-port) (current-output-port))) 50 | (define (close-term t) 51 | (tty-restore!)))) 52 | 53 | #;(define-stty-term open-term close-term) 54 | (define-stdin-term open-term close-term) 55 | 56 | (define (display/term t v) 57 | (define op (term-out t)) 58 | (unless (port-closed? op) 59 | (display v op) 60 | (flush-output op))) 61 | 62 | ;; Lux 63 | (define x11-mouse-on 64 | (string-append (set-mode x11-focus-event-mode) 65 | (set-mode x11-any-event-mouse-tracking-mode) 66 | (set-mode x11-extended-mouse-tracking-mode))) 67 | (define x11-mouse-off 68 | (string-append (reset-mode x11-extended-mouse-tracking-mode) 69 | (reset-mode x11-any-event-mouse-tracking-mode) 70 | (reset-mode x11-focus-event-mode))) 71 | 72 | (define (convert-key v) 73 | (match v 74 | [(key value mods) 75 | (format "~a~a~a~a~a" 76 | (if (set-member? mods 'super) "s-" "") 77 | (if (set-member? mods 'meta) "M-" "") 78 | (if (set-member? mods 'control) "C-" "") 79 | (if (set-member? mods 'shift) "S-" "") 80 | (if (char? value) 81 | value 82 | (format "<~a>" value)))] 83 | [_ v])) 84 | 85 | (define (make-raart #:mouse? [mouse? #f]) 86 | (define alternate? #t) 87 | (define ch (make-async-channel)) 88 | (*term alternate? mouse? #f #f ch #f #f #f #f)) 89 | 90 | (define-struct-define term-define *term) 91 | (struct *term 92 | (alternate? mouse? t buf ch sig-th input-th rows cols) 93 | #:mutable 94 | #:methods gen:chaos 95 | [(define (chaos-event c) 96 | (term-define c) 97 | (handle-evt ch 98 | (match-lambda 99 | [(and e (screen-size-report new-rows new-cols)) 100 | (set! rows new-rows) 101 | (set! cols new-cols) 102 | (buffer-resize! buf rows cols) 103 | e] 104 | [e e]))) 105 | (define (chaos-output! c o) 106 | (when o 107 | (draw (*term-buf c) o))) 108 | (define (chaos-label! c l) 109 | (display/term (*term-t c) (xterm-set-window-title l))) 110 | (define (chaos-start! c) 111 | (term-define c) 112 | (set! t (open-term)) 113 | (set! rows 24) 114 | (set! cols 80) 115 | (set! buf (make-cached-buffer rows cols #:output (term-out t))) 116 | 117 | ;; Save the current title and colors 118 | (when (term-is-kitty?) 119 | (display/term t "\e[?2017h") 120 | (display/term t "\e]30001\e\\")) 121 | (display/term t "\e[22t") 122 | 123 | ;; Initialize term 124 | (when alternate? 125 | (display/term t (set-mode alternate-screen-mode))) 126 | (when mouse? 127 | (display/term t x11-mouse-on) 128 | (plumber-add-flush! (current-plumber) 129 | (lambda (handle) 130 | (display/term t x11-mouse-off)))) 131 | 132 | ;; Listen for input 133 | (set! input-th 134 | (thread 135 | (λ () 136 | (define iport (term-in t)) 137 | (define (std-lex1) 138 | (lex-lcd-input iport #:utf-8? #t)) 139 | (define (kitty-lex1) 140 | (cond 141 | [(regexp-try-match #rx#"^\e_K([prt])(.)(..?)\e\\\\" iport) 142 | => (match-lambda 143 | [(list lexeme type mods-b64 key-b64) 144 | (cond 145 | [(bytes=? type #"p") 146 | (key (kitty-key-lookup key-b64) 147 | (kitty-mods-lookup mods-b64))] 148 | [else 149 | (kitty-lex1)])])] 150 | [else 151 | (std-lex1)])) 152 | (define lex1 (if (term-is-kitty?) kitty-lex1 std-lex1)) 153 | (let loop () 154 | (define v (lex1)) 155 | (unless (eof-object? v) 156 | (when (or (any-mouse-event? v) 157 | (screen-size-report? v) 158 | (key? v)) 159 | (async-channel-put ch (convert-key v))) 160 | (loop)))))) 161 | 162 | ;; Register for window change events 163 | (display/term t (device-request-screen-size)) 164 | (set! sig-th 165 | (thread 166 | (λ () 167 | (let loop () 168 | (define s (read-signal)) 169 | (match (lookup-signal-name s) 170 | ['SIGWINCH (display/term t (device-request-screen-size)) 171 | (loop)]))))) 172 | (capture-signal! 'SIGWINCH) 173 | 174 | (void)) 175 | (define (chaos-stop! c) 176 | (term-define c) 177 | 178 | (release-signal! 'SIGWINCH) 179 | (kill-thread sig-th) 180 | 181 | (kill-thread input-th) 182 | 183 | (when mouse? 184 | (display/term t x11-mouse-off)) 185 | (when alternate? 186 | (display/term t (reset-mode alternate-screen-mode))) 187 | 188 | (display/term t "\e[?12l\e[?25h") 189 | 190 | ;; Restore the old title 191 | (display/term t "\e[23t") 192 | (when (term-is-kitty?) 193 | (display/term t "\e]30101\e\\") 194 | (display/term t "\e[?2017l")) 195 | 196 | (close-term t))]) 197 | 198 | (provide 199 | (struct-out screen-size-report) 200 | (struct-out any-mouse-event) 201 | (struct-out mouse-focus-event) 202 | (struct-out mouse-event) 203 | (contract-out 204 | [make-raart 205 | (->* () (#:mouse? boolean?) chaos?)])) 206 | -------------------------------------------------------------------------------- /main.rkt: -------------------------------------------------------------------------------- 1 | #lang reprovide 2 | "buffer.rkt" 3 | "draw.rkt" 4 | "lux-chaos.rkt" 5 | -------------------------------------------------------------------------------- /raart.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require (for-syntax racket/base) 3 | (for-label raart 4 | lux/chaos 5 | ansi 6 | racket/format 7 | racket/contract 8 | racket/base) 9 | racket/sandbox 10 | scribble/example) 11 | 12 | @(define ev 13 | (parameterize ([sandbox-output 'string] 14 | [sandbox-error-output 'string] 15 | [sandbox-memory-limit 50] 16 | ;; Need to load the tty-raw extension and we don't 17 | ;; know where it is. 18 | [sandbox-path-permissions '((execute #rx#""))]) 19 | (make-evaluator 'racket/base))) 20 | @(ev '(require raart/draw)) 21 | @(define-syntax-rule (ex r ...) (examples #:eval ev r ...)) 22 | 23 | @title{raart: Racket ASCII Art and Interfaces} 24 | @author{Jay McCarthy} 25 | 26 | @defmodule[raart] 27 | 28 | The @racketmodname[raart] module provides an algebraic model of ASCII 29 | that can be used for art, user interfaces, and diagrams. It is 30 | comparable to @racketmodname[2htdp/image]. 31 | 32 | Check out some examples in the 33 | @link["https://github.com/jeapostrophe/raart/tree/master/t"]{test} 34 | directory in the source. 35 | 36 | @local-table-of-contents[] 37 | 38 | @section{Buffers} 39 | @defmodule[raart/buffer] 40 | 41 | When drawing, @racketmodname[raart] renders to a @deftech{buffer}. In 42 | almost all circumstances, you should use @racket[make-cached-buffer]. 43 | 44 | @defproc[(buffer? [x any/c]) boolean?]{Identifiers @tech{buffer}s.} 45 | 46 | @defproc[(make-output-buffer [#:output output output-port? (current-output-port)]) 47 | buffer?]{ 48 | 49 | A @tech{buffer} that displays to @racket[output]. 50 | 51 | } 52 | 53 | @defproc[(make-terminal-buffer [rows exact-nonnegative-integer?] 54 | [cols exact-nonnegative-integer?] 55 | [#:clear? clear? boolean? #t] 56 | [#:output output output-port? (current-output-port)]) 57 | buffer?]{ 58 | 59 | A @tech{buffer} that displays to a terminal of @racket[rows] rows and 60 | @racket[cols] columns via the port @racket[output]. If @racket[clear?] 61 | is non-false, then the terminal will be cleared before display. 62 | 63 | } 64 | 65 | @defproc[(make-cached-buffer [rows exact-nonnegative-integer?] 66 | [cols exact-nonnegative-integer?] 67 | [#:output output output-port? (current-output-port)]) 68 | buffer?]{ 69 | 70 | A @tech{buffer} that displays to a terminal of @racket[rows] rows and 71 | @racket[cols] columns via the port @racket[output], with minimal 72 | output to the terminal implemented via client-side caching of the 73 | screen content so only updates are output. } 74 | 75 | @defthing[color/c contract?]{ 76 | 77 | A contract that recognizes the ASCII colors from the list 78 | @racket['(black red green yellow blue magenta cyan white brblack brred 79 | brgreen bryellow brblue brmagenta brcyan brwhite)], as well as any 80 | @racket[byte?] value. The actual color display depends on the terminal 81 | configuration. } 82 | 83 | @defthing[style/c contract?]{ 84 | 85 | A contract that recognizes the ASCII styles from the list 86 | @racket['(normal bold inverse underline)]. The actual font displayed 87 | may depend on the terminal configuration. } 88 | 89 | @section{Drawing} 90 | @defmodule[raart/draw] 91 | 92 | @racketmodname[raart] represents ASCII art algebraically as an 93 | abstract @racket[raart?] object. 94 | 95 | @defproc[(raart? [x any/c]) boolean?]{Identifies ASCII art.} 96 | 97 | @defproc[(raart-w [x raart?]) exact-nonnegative-integer?]{Returns the 98 | width of the art.} 99 | 100 | @defproc[(raart-h [x raart?]) exact-nonnegative-integer?]{Returns the 101 | height of the art.} 102 | 103 | @defproc[(draw [b buffer?] [r raart?]) void?]{Displays @racket[r] to 104 | the @racket[b] buffer.} 105 | 106 | @defproc[(draw-here [r raart?]) void?]{Displays @racket[r] with a 107 | freshly created buffer made with @racket[make-output-buffer].} 108 | 109 | @defproc[(style [s style/c] [r raart?]) raart?]{@racket[r], except 110 | with the style given by @racket[s].} 111 | 112 | @defproc[(fg [c color/c] [r raart?]) raart?]{@racket[r], except with 113 | the foreground color given by @racket[c].} 114 | 115 | @defproc[(bg [c color/c] [r raart?]) raart?]{@racket[r], except with 116 | the background color given by @racket[c].} 117 | 118 | @defproc[(with-drawing [s (or/c style/c #f)] [fc (or/c color/c #f)] 119 | [bc (or/c color/c #f)] [r raart?]) raart?]{Wraps @racket[r] in calls 120 | to @racket[style], @racket[fg], and @racket[bg] if @racket[s], 121 | @racket[fc], or @racket[bc] (respectively) are provided as non-false.} 122 | 123 | @defproc[(blank [w exact-nonnegative-integer? 0] [h 124 | exact-nonnegative-integer? 0]) raart?]{A blank art of width @racket[w] 125 | and height @racket[h]. 126 | 127 | @ex[(draw-here (blank 2 2)) 128 | (draw-here (blank 5 5))] 129 | 130 | } 131 | 132 | @defproc[(char [c (and/c char? (not/c char-iso-control?))]) raart?]{An 133 | art displaying @racket[c]. 134 | 135 | @ex[(draw-here (char #\a)) (draw-here (char #\b))]} 136 | 137 | @defproc[(text [s string?]) raart?]{An art displaying @racket[s], 138 | which must not contain any @racket[char-iso-control?] characters. 139 | 140 | @ex[(draw-here (text "Hello World!"))]} 141 | 142 | @defproc[(hline [w exact-nonnegative-integer?]) raart?]{A horizontal 143 | line of @litchar{-} characters of width @racket[w]. 144 | 145 | @ex[(draw-here (hline 5))]} 146 | 147 | @defproc[(vline [h exact-nonnegative-integer?]) raart?]{A vertical 148 | line of @litchar{|} characters of height @racket[h]. 149 | 150 | @ex[(draw-here (vline 3))]} 151 | 152 | @defthing[halign/c contract?]{A contract for the horizontal alignment modes @racket['(left center right)]. @racket['left] means that the art will be extended with blanks to the right@";" @racket['center] places the blanks equally on both sides@";" and @racket['right] places the blanks to the left.} 153 | 154 | @defthing[valign/c contract?]{A contract for the vertical alignment modes @racket['(top center bottom)]. @racket['top] means that the art will be extended with blanks below";" @racket['center] places the blanks equally on both sides@";" and @racket['bottom] places the blanks above.} 155 | 156 | @defproc[(vappend2 [y raart?] [x raart?] [#:halign halign (or/c 157 | halign/c #f) #f] [#:reverse? reverse? boolean? #f]) raart?]{ Renders 158 | @racket[y] vertically above @racket[x]. (If @racket[reverse?] is true, 159 | then the effects are evaluated in the opposite order.) Uses 160 | @racket[halign] to determine the horizontal alignment. If 161 | @racket[halign] is @racket[#f], then the arts must have the same 162 | width. 163 | 164 | @ex[(draw-here (vappend2 (text "Hello") (text "World"))) 165 | (eval:error 166 | (draw-here (vappend2 (text "Short") (text "Very Very Long")))) 167 | (draw-here (vappend2 (text "Short") (text "Very Very Long") #:halign 'left)) 168 | (draw-here (vappend2 (text "Short") (text "Very Very Long") #:halign 'right)) 169 | (draw-here (vappend2 (text "Short") (text "Very Very Long") #:halign 'center))]} 170 | 171 | @defproc[(vappend [y raart?] [x raart?] ... [#:halign halign (or/c 172 | halign/c #f) #f] [#:reverse? reverse? boolean? #f]) raart?]{Like 173 | @racket[vappend2], but for many arguments. 174 | 175 | @ex[(draw-here (vappend (text "Short") (text "A Little Medium") (text "Very Very Long") #:halign 'right))]} 176 | 177 | @defproc[(vappend* [y-and-xs (non-empty-listof raart?)] [#:halign 178 | halign (or/c halign/c #f) #f] [#:reverse? reverse? boolean? #f]) 179 | raart?]{Like @racket[vappend], but accepts arguments as a list. 180 | 181 | @ex[(draw-here (vappend* (list (text "Short") (text "A Little Medium") (text "Very Very Long")) #:halign 'right))]} 182 | 183 | @defproc[(happend2 [y raart?] [x raart?] [#:valign valign (or/c 184 | valign/c #f) #f] [#:reverse? reverse? boolean? #f]) raart?]{ Renders 185 | @racket[y] horizontally to the left of @racket[x]. (If 186 | @racket[reverse?] is true, then the effects are evaluated in the 187 | opposite order.) Uses @racket[valign] to determine the vertical 188 | alignment. If @racket[valign] is @racket[#f], then the arts must have 189 | the same height. 190 | 191 | @ex[(draw-here (happend2 (vline 2) (vline 2))) 192 | (eval:error 193 | (draw-here (happend2 (vline 2) (vline 4)))) 194 | (draw-here (happend2 (vline 2) (vline 4) #:valign 'top)) 195 | (draw-here (happend2 (vline 2) (vline 4) #:valign 'center)) 196 | (draw-here (happend2 (vline 2) (vline 4) #:valign 'bottom))]} 197 | 198 | @defproc[(happend [y raart?] [x raart?] ... [#:valign valign (or/c 199 | valign/c #f) #f] [#:reverse? reverse? boolean? #f]) raart?]{Like 200 | @racket[happend2], but for many arguments. 201 | 202 | @ex[(draw-here (happend (vline 2) (vline 3) (vline 4) #:valign 'top))]} 203 | 204 | @defproc[(happend* [y-and-xs (non-empty-listof raart?)] [#:valign 205 | valign (or/c valign/c #f) #f] [#:reverse? reverse? boolean? #f]) 206 | raart?]{Like @racket[happend], but accepts arguments as a list. 207 | 208 | @ex[(draw-here (happend* (list (vline 2) (vline 3) (vline 4)) #:valign 'top))]} 209 | 210 | @defproc[(para [max-width exact-nonnegative-integer?] [s string?] [#:halign halign halign/c 'left]) raart?]{An art displaying @racket[s], that is at most @racket[max-width] wide, taking multiple lines if necessary. 211 | 212 | @ex[(draw-here (para 45 "And it came to pass that I, Nephi, said unto my father: I will go and do the things which the Lord hath commanded, for I know that the Lord giveth no commandments unto the children of men, save he shall prepare a way for them that they may accomplish the thing which he commandeth them."))]} 213 | 214 | @defproc[(para* [max-width exact-nonnegative-integer?] [rs (listof raart?)] [#:halign halign halign/c 'left] [#:gap gap raart? (blank)]) raart?]{Like @racket[happend*], but limits the total width and uses @racket[vappend] when things get too long. @racket[para] uses this after splitting the input string into words and supplies @racket[(text " ")] as the @racket[gap].} 215 | 216 | @defproc[(place-at [back raart?] [dr exact-nonnegative-integer?] [dh 217 | exact-nonnegative-integer?] [front raart?]) raart?]{Renders 218 | @racket[front] on top of @racket[back] offset by @racket[dr] rows and 219 | @racket[dh] columns.} 220 | 221 | @defform[(place-at* back [dr dc fore] ...) #:contracts ([back raart?] 222 | [dr exact-nonnegative-integer?] [dc exact-nonnegative-integer?] [fore 223 | raart?])]{Calls @racket[place-at] on a sequence of art objects from 224 | back on the left to front on the right.} 225 | 226 | @defproc[(frame [#:style s (or/c style/c #f) #f] [#:fg fc (or/c 227 | color/c #f)] [#:bg bc (or/c color/c #f)] [x raart?]) raart?]{Renders 228 | @racket[x] with a frame where the frame character's style is 229 | controlled by @racket[s], @racket[fc], and @racket[bc].} 230 | 231 | @defproc[(matte-at [mw exact-nonnegative-integer?] [mh 232 | exact-nonnegative-integer?] [c exact-nonnegative-integer?] [r 233 | exact-nonnegative-integer?] [x raart?]) raart?]{Mattes @racket[x] 234 | inside a blank of size @racket[mw] columns and @racket[mh] rows at row 235 | @racket[r] and column @racket[c].} 236 | 237 | @defproc[(translate [dr exact-nonnegative-integer?] [dc 238 | exact-nonnegative-integer?] [x raart?]) raart?]{Translates @racket[x] 239 | by @racket[dr] rows and @racket[dc] columns.} 240 | 241 | @defproc[(matte [w exact-nonnegative-integer?] [h 242 | exact-nonnegative-integer?] [#:halign halign halign/c 'center] 243 | [#:valign valign valign/c 'center] [x raart?]) raart?]{Mattes 244 | @racket[x] inside a blank of size @racket[w]x@racket[h] with the given 245 | alignment.} 246 | 247 | @defproc[(inset [dw exact-nonnegative-integer?] [dh 248 | exact-nonnegative-integer?] [x raart?]) raart?]{Insets @racket[x] with 249 | @racket[dw] columns and @racket[dh] rows of blanks.} 250 | 251 | @defproc[(mask [mc exact-nonnegative-integer?] [mw 252 | exact-nonnegative-integer?] [mr exact-nonnegative-integer?] [mh 253 | exact-nonnegative-integer?] [x raart?]) raart?]{Renders the portion of 254 | @racket[x] inside the rectangle (@racket[mc],@racket[mr]) 255 | to (@racket[(+ mc mw)],@racket[(+ mr mh)]).} 256 | 257 | @defproc[(crop [cc exact-nonnegative-integer?] [cw 258 | exact-nonnegative-integer?] [cr exact-nonnegative-integer?] [ch 259 | exact-nonnegative-integer?] [x raart?]) raart?]{Renders the portion of 260 | @racket[x] inside the rectangle (@racket[cc],@racket[cr]) 261 | to (@racket[(+ cc cw)],@racket[(+ cr ch)]) and removes the surrounding 262 | blanks.} 263 | 264 | @defproc[(table [cells (listof (listof raart?))] [#:frames? frames? 265 | boolean? #t] [#:style s (or/c style/c #f) #f] [#:fg f (or/c color/c 266 | #f) #f] [#:bg b (or/c color/c #f) #f] [#:inset-dw dw 267 | exact-nonnegative-integer? 0] [#:inset-dh dh 268 | exact-nonnegative-integer? 0] [#:valign row-valign valign/c 'top] 269 | [#:halign halign (or/c halign/c (list*of halign/c (or/c halign/c 270 | '()))) 'left]) raart?]{Renders a table of cells where frames are added 271 | if @racket[frames?] is non-false with style and color given by the 272 | arguments. Cells are inset by @racket[inset-dh] rows and 273 | @racket[inset-dw] columns. Cells are horizontally aligned with 274 | @racket[halign]. Rows are vertically aligned with 275 | @racket[row-valign].} 276 | 277 | @defproc[(text-rows [cells (listof (listof any/c))]) (listof (listof 278 | raart?))]{Transforms a matrix of content into a matrix of art objects, 279 | using @racket[~a] composed with @racket[text] if they are not already 280 | art objects.} 281 | 282 | @defproc[(if-drawn [f (-> exact-nonnegative-integer? 283 | exact-nonnegative-integer? exact-nonnegative-integer? 284 | exact-nonnegative-integer? any)] [x raart?]) raart?]{Renders 285 | @racket[x] and if it ends up being displayed, then calls @racket[f] 286 | with the actual bounding box, given as a row, column, width, and 287 | height.} 288 | 289 | @defproc[(place-cursor-after [x raart?] [cr 290 | exact-nonnegative-integer?] [ch exact-nonnegative-integer?]) 291 | raart?]{Renders @racket[x] but places the cursor at row @racket[cr] 292 | and column @racket[ch] afterwards.} 293 | 294 | @defproc[(without-cursor [x raart?]) raart?]{Renders @racket[x], but 295 | signals to @racket[draw] to not display the cursor, if this is the art 296 | object given to it. (That is, this has no effect if composed with 297 | other drawing operations.)} 298 | 299 | @section{lux integration} 300 | @defmodule[raart/lux-chaos] 301 | 302 | @racketmodname[raart] provides integration with @racketmodname[lux] 303 | via the @racketmodname[ansi] module. 304 | 305 | @defproc[(make-raart [#:mouse? mouse? boolean? #f]) chaos?]{ 306 | 307 | Returns a @tech[#:doc '(lib "lux/scribblings/lux.scrbl")]{chaos} that 308 | manages the terminal. 309 | 310 | The values that @racket[word-event] is called with are characters or 311 | @racket[screen-size-report] structures. If @racket[mouse?] is 312 | non-false, then @racket[any-mouse-event], @racket[mouse-focus-event], 313 | or @racket[mouse-event] structures may also be provided. 314 | 315 | The values that @racket[word-output] should return are @racket[raart?] 316 | objects. The drawing will use @racket[make-cached-buffer] to optimize 317 | the display process. 318 | 319 | } 320 | -------------------------------------------------------------------------------- /size.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | ;; xxx Do the rune thing as well (and think about mouse events) 4 | 5 | ;; xxx cool to support images (iterm2, urxvt, kitty, etc, but seem to 6 | ;; all be broken in tmux) 7 | 8 | ;; xxx render xexpr-like thing 9 | ;; xxx text... (fit text inside a width) 10 | ;; xxx paragraph (fit text inside a box) 11 | 12 | ;; xxx make a "Web" browser 13 | ;; xxx use if-drawn to figure out what links are on screen 14 | 15 | ;; xxx interactable thing --- figure out pos&dimensions on screen for 16 | ;; supporting mouse 17 | -------------------------------------------------------------------------------- /t/draw.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/format 3 | raart) 4 | (module+ test 5 | (define here (make-output-buffer))) 6 | 7 | (module+ test 8 | (draw 9 | here 10 | (crop 1 80 1 20 11 | ;;70 80 10 20 12 | (matte 80 20 13 | #:halign 'right 14 | (fg 17 15 | (frame #:fg 'red 16 | (inset 17 | 4 5 18 | (happend (style 'underline (text "Left")) 19 | (blank 4) 20 | (style 'bold (text "Right"))))))))) 21 | (newline)) 22 | 23 | (module+ test 24 | (draw 25 | here 26 | (translate 27 | 2 10 28 | (table 29 | #:frames? #t 30 | #:inset-dw 2 31 | #:valign 'center 32 | #:halign '(right left left left) 33 | (text-rows 34 | `([ "ID" "First Name" "Last Name" "Grade"] 35 | [70022 "John" "Smith" "A+"] 36 | [ 22 "Macumber" "Stark" "B"] 37 | [ 1223 "Sarah" ,(vappend (text "Top") 38 | (text "Mid") 39 | (text "Bot")) "C"]))))) 40 | (newline)) 41 | 42 | (module+ test 43 | (define seen? (list)) 44 | (draw 45 | here 46 | (crop 0 80 70 10 47 | (vappend* 48 | #:halign 'left 49 | (for/list ([i (in-range 80)]) 50 | (if-drawn 51 | (λ (r c w h) (set! seen? (cons i seen?))) 52 | (text (~a "Row " i))))))) 53 | (newline) 54 | (printf "Drawn: ~v\n" (reverse seen?))) 55 | -------------------------------------------------------------------------------- /t/hack.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/match 3 | racket/format 4 | racket/list 5 | lux 6 | raart 7 | struct-define) 8 | 9 | (define rows 24) 10 | (define cols 80) 11 | (define world-rows (- rows 3)) 12 | (define world-cols cols) 13 | 14 | (struct obj (ox oy oc)) 15 | (define-struct-define obj-define obj) 16 | 17 | (define-struct-define hack-define hack) 18 | (define (step w dx dy) 19 | (hack-define w) 20 | (check 21 | (hack (add1 steps) 22 | (modulo (+ dx px) world-cols) 23 | (modulo (+ dy py) world-rows) 24 | score 25 | objs))) 26 | (define (check w) 27 | (hack-define w) 28 | (cond 29 | [(empty? objs) 30 | #f] 31 | [else 32 | (for/fold ([score score] 33 | [objs '()] 34 | #:result (hack steps px py score objs)) 35 | ([o (in-list objs)]) 36 | (obj-define o) 37 | (if (and (= ox px) (= oy py)) 38 | (values (add1 score) objs) 39 | (values score (cons o objs))))])) 40 | 41 | (struct hack (steps px py score objs) 42 | #:methods gen:word 43 | [(define (word-fps w) 0.0) 44 | (define (word-label w ft) "Hack") 45 | (define (word-event w e) 46 | (hack-define w) 47 | (match e 48 | [(screen-size-report _ _) w] 49 | ["" (step w -1 0)] 50 | ["" (step w +1 0)] 51 | ["" (step w 0 -1)] 52 | ["" (step w 0 +1)] 53 | ["q" #f])) 54 | (define (word-output w) 55 | (hack-define w) 56 | (without-cursor 57 | (crop 0 cols 0 rows 58 | (vappend 59 | #:halign 'left 60 | (text (~a "Hello Jack! Enjoy the hacking! Press q to quit.")) 61 | (place-at* 62 | (for/fold ([c (blank world-cols world-rows)]) 63 | ([o (in-list objs)]) 64 | (obj-define o) 65 | (place-at c oy ox (fg 'blue (char oc)))) 66 | [py px (fg 'red (char #\@))]) 67 | (text (~a "Jack the Paren Hunter")) 68 | (happend (text (~a "Steps: " steps " Score: " score))))))) 69 | (define (word-return w) 70 | (hack-define w) 71 | (~a "You got " score " parens in " steps " steps!"))]) 72 | (define (initial-hack-state) 73 | (hack 0 0 0 0 74 | (for/list ([i (in-range 8)]) 75 | (obj (random world-cols) (random world-rows) 76 | (if (zero? (random 2)) #\( #\)))))) 77 | 78 | (module+ main 79 | (call-with-chaos 80 | (make-raart) 81 | (λ () (fiat-lux (initial-hack-state))))) 82 | -------------------------------------------------------------------------------- /t/key.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/list 3 | racket/format 4 | racket/match 5 | lux 6 | raart) 7 | 8 | (define (key) 9 | (define base (word #:fps 0.0 #:label "Key Debug" #:return (void))) 10 | 11 | (define (show-key k) 12 | (word base 13 | #:output (text (~a k)) 14 | #:event 15 | (match-lambda 16 | [(or "C-C" "q") #f] 17 | [x (show-key x)]))) 18 | 19 | (show-key "Please enter a key.")) 20 | 21 | (module+ main 22 | (require raart/lux-chaos) 23 | (call-with-chaos 24 | (make-raart) 25 | (λ () 26 | (fiat-lux (key))))) 27 | -------------------------------------------------------------------------------- /t/kitty.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (define p 4 | (let () 5 | (local-require pict) 6 | (disk 40 #:color "Chartreuse" #:border-color "Medium Aquamarine" #:border-width 5))) 7 | 8 | (define i 9 | (let () 10 | (local-require 2htdp/image) 11 | (add-line 12 | (rectangle 100 100 "solid" "darkolivegreen") 13 | 25 25 75 75 14 | (make-pen "goldenrod" 30 "solid" "round" "round")))) 15 | 16 | (define pl 17 | (let () 18 | (local-require plot racket/math racket/class racket/gui/base file/convertible) 19 | (plot (function sin (- pi) pi #:label "y = sin(x)")))) 20 | 21 | "Not convertible" 22 | 1 23 | (list "foo" "bar") 24 | p 25 | (list "foo" p "bar") 26 | i 27 | (list "foo" i "bar") 28 | pl 29 | (list "foo" pl "bar") 30 | --------------------------------------------------------------------------------