Add kitty stuff (wip)

This commit is contained in:
Jay McCarthy 2018-12-08 21:52:24 -05:00
parent b517ab5065
commit a23fdb7796
3 changed files with 91 additions and 0 deletions

7
kitty-init.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang racket/base
(require racket/init
raart/kitty)
(install-kitty-print!)
(provide (all-from-out racket/init))

53
kitty.rkt Normal file
View File

@ -0,0 +1,53 @@
#lang racket/base
(require racket/match
(prefix-in pict: pict)
file/convertible
racket/class
racket/gui/base)
(define (convert->png-bytes v)
(and (convertible? v)
(convert v 'png-bytes+bounds #f)))
(define (snip? v) (is-a? v snip%))
;; Replace "racket -t file"
;; with
;; "racket -I raart/kitty-init -i -t file -e '(exit 0)'"
(define (install-kitty-print!)
(define t (environment-variables-ref (current-environment-variables) #"TERM"))
(when (equal? t #"xterm-kitty")
;; XXX This could do better and use
#;(pretty-print-size-hook)
;; and
#;(pretty-print-print-hook)
;; to pretty these things inside other structures
;; but, then I believe I could not rely on icat, but I'd have to implement it myself
(define old-print (current-print))
(define (new-print v)
(match (or (convert->png-bytes v) v)
[(list bs w h d v)
(define-values
(sp stdout stdin stderr)
(subprocess (current-output-port) #f (current-error-port)
(find-executable-path "kitty")
"+kitten" "icat"))
(write-bytes bs stdin)
(close-output-port stdin)
(subprocess-wait sp)]
[(? snip?)
(define wb (box #f))
(define hb (box #f))
(send v get-extent (pict:dc-for-text-size) 0 0 wb hb)
(define w (unbox wb))
(define h (unbox hb))
(new-print
(pict:dc (λ (dc x y)
(send v draw dc x y 0 0 w h 0 0 'no-caret))
w h))]
[v (old-print v)]))
(current-print new-print)))
(provide install-kitty-print!)

31
t/kitty.rkt Normal file
View File

@ -0,0 +1,31 @@
#lang racket/base
(define p
(let ()
(local-require pict)
(disk 40 #:color "Chartreuse" #:border-color "Medium Aquamarine" #:border-width 5)))
(define i
(let ()
(local-require 2htdp/image)
(add-line
(rectangle 100 100 "solid" "darkolivegreen")
25 25 75 75
(make-pen "goldenrod" 30 "solid" "round" "round"))))
(define pl
(let ()
(local-require plot racket/math racket/class racket/gui/base file/convertible)
(define r (plot (function sin (- pi) pi #:label "y = sin(x)")))
(displayln (vector (convertible? r) (is-a? r snip%)))
r))
"Not convertible"
1
(list "foo" "bar")
p
(list "foo" p "bar")
i
(list "foo" i "bar")
pl
(list "foo" pl "bar")