diff --git a/collects/htdp/matrix-client.ss b/collects/htdp/matrix-client.ss new file mode 100644 index 0000000000..e29121f740 --- /dev/null +++ b/collects/htdp/matrix-client.ss @@ -0,0 +1,83 @@ +;; The first three lines of this file were inserted by DrScheme. They record metadata +;; about the language level of this file in a form that our tools can easily process. +#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname matrix-client) (read-case-sensitive #t) (teachpacks ((lib "world.ss" "teachpack" "htdp") (lib "testing.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "world.ss" "teachpack" "htdp") (lib "testing.ss" "teachpack" "htdp"))))) +(require (lib "matrix.ss" "htdp")) +(require (lib "testing.ss" "htdp")) + +(define m1 (make-matrix 2 3 (list 'a 'b 'c 'd 'e 'f))) +(define m2 (matrix-set m1 1 1 'x)) + +(check-expect (matrix-ref m1 0 0) 'a) +(check-expect (matrix-ref m1 0 1) 'b) +(check-expect (matrix-ref m1 0 2) 'c) +(check-expect (matrix-ref m1 1 0) 'd) +(check-expect (matrix-ref m1 1 1) 'e) +(check-expect (matrix-ref m1 1 2) 'f) + +(check-expect (matrix-ref m2 1 1) 'x) + +(define matrix1 (make-matrix 2 3 '(a00 a01 a02 a10 a11 a12))) + +(define r1 '((a00 a01 a02) + (a10 a11 a12))) + +(check-expect (matrix-render matrix1) (matrix-render (rectangle->matrix r1))) +(check-expect (matrix-ref matrix1 0 0) 'a00) +(check-expect (matrix-ref matrix1 0 1) 'a01) +(check-expect (matrix-ref matrix1 0 2) 'a02) +(check-expect (matrix-ref matrix1 1 0) 'a10) +(check-expect (matrix-ref matrix1 1 1) 'a11) +(check-expect (matrix-ref matrix1 1 2) 'a12) + +(check-expect (matrix-render (build-matrix 2 3 (lambda (i j) (matrix-ref matrix1 i j)))) + (matrix-render matrix1)) + +(define matrix2 (make-matrix 2 2 '(a00 a01 a10 a11))) + +(check-expect (matrix-render (matrix-minor matrix2 0 0)) + (matrix-render (make-matrix 1 1 '(a11)))) + +(check-expect (matrix-render (matrix-minor matrix2 1 1)) + (matrix-render (make-matrix 1 1 '(a00)))) + +;; =========================================================================== + +;; Matrix -> Number +;; compute the determinat of a square (n x n) matrix +(define (determinant M) + (local + ((define n (matrix-n M)) + (define (series i) + (* (expt -1 i) (matrix-ref M 0 i) (determinant (matrix-minor M 0 i))))) + (if (= n 1) + (matrix-ref M 0 0) + (foldl + 0 (build-list n series))))) + + + +(check-expect (determinant (rectangle->matrix '((1 1) + (1 1)))) + 0) + +(check-expect (determinant (rectangle->matrix '((2 1) + (1 1)))) + 1) + +;; =========================================================================== +;; matrix with structure inside + +(define-struct p (x y)) + +(define matrix3 + (rectangle->matrix + (list (list (make-p 0 0) (make-p 0 1)) + (list (make-p 1 0) (make-p 1 1))))) + +(define matrix4 (matrix-set matrix3 0 0 "intentionally failing check")) + +(check-expect matrix3 matrix3) + +(check-expect matrix3 matrix4) +"the above test should fail" + +(generate-report) diff --git a/collects/htdp/matrix-invisible.ss b/collects/htdp/matrix-invisible.ss new file mode 100644 index 0000000000..dab6a613e1 --- /dev/null +++ b/collects/htdp/matrix-invisible.ss @@ -0,0 +1,23 @@ +#lang scheme + +(require (lib "matrix-sig.ss" "htdp") + (lib "matrix-unit.ss" "htdp") + (lib "matrix-render.ss" "htdp")) + +(define render@ + (unit (import) + (export matrix-render^) + (define-struct invisible (matrix)) + (define make-visible make-invisible) + (define visible-matrix invisible-matrix))) + +(define invisible-matrix@ + (compound-unit + (import) + (export m) + (link (((r : matrix-render^)) render@) + (((m : matrix^)) matrix@ r)))) + +(define-values/invoke-unit invisible-matrix@ (import) (export matrix^)) + +(provide-signature-elements matrix^) \ No newline at end of file diff --git a/collects/htdp/matrix-render.ss b/collects/htdp/matrix-render.ss new file mode 100644 index 0000000000..f8f6883adc --- /dev/null +++ b/collects/htdp/matrix-render.ss @@ -0,0 +1,6 @@ +#lang scheme/signature + +;; type: [VM X] +make-visible ;; [Matrix X] -> [VM X] + +visible-matrix ;; [VM X] -> [Matrix M] \ No newline at end of file diff --git a/collects/htdp/matrix-sig.ss b/collects/htdp/matrix-sig.ss new file mode 100644 index 0000000000..a9a7ab67ae --- /dev/null +++ b/collects/htdp/matrix-sig.ss @@ -0,0 +1,49 @@ +#lang scheme/signature + +;; CONVENTION: +;; [Rectangle X] = [Listof [Listof X]] +;; where all elements of the non-empty list are of equal non-empty length + +;; type: [Matrix X] +matrix? +;; is this a matrix? + +matrix-n ;; [Matrix X] -> Nat +;; what is n for an n x m Matrix + +matrix-m ;; [Matrix X] -> Nat +;; what is m for an n x m Matrix + +rectangle->matrix ;; [Rectangle X] -> [Matrix X] +;; create a matrix from a rectangle + +matrix->rectangle ;; [Matrix X] -> [Rectangle X] +;; create a rectangle from matrix + +;; ---------------------------------------------------------------------------- + +make-matrix ;; Nat Nat [Listof X] -> [Matrix X] +;; create an initialized n x m matrix from list l +;; NOTE: make-matrix would consume an optional number of entries, +;; if it were like make-vector + +build-matrix ;; Nat Nat (Nat Nat -> Number) -> Matrix +;; create a matrix from a function + +matrix-ref ;; [Matrix X] Nat Nat -> X +;; retrieve the content of the matrix at (i,j) + +matrix-set ;; [Matrix X] Nat Nat X -> [Matrix X] +;; create a new matrix with x at (i,j) and all other places the same + +matrix-where? ;; [Matrix X] (X -> Boolean) -> [Listof Posn] +;; (matrix-where? M P) :: list of (make-posn i j) s.t. (P (matrix-ref M i j)) + +matrix-render ;; [Matrix X] -> [Rectangle String] +;; render the matrix as a rectangle of strings + +matrix-minor ;; Matrix Nat Nat -> Matrix +;; create a matrix minor from M at (i,j) + +matrix-set! ;; [Matrix X] Nat Nat X -> [Matrix X] +;; set the matrix at (i,j) \ No newline at end of file diff --git a/collects/htdp/matrix-unit.ss b/collects/htdp/matrix-unit.ss new file mode 100644 index 0000000000..b7416d93ab --- /dev/null +++ b/collects/htdp/matrix-unit.ss @@ -0,0 +1,255 @@ +#lang scheme/unit + +(require (lib "matrix-sig.ss" "htdp") + (lib "matrix-render.ss" "htdp") + (lib "error.ss" "htdp") + (lib "posn.ss" "lang") + (lib "class.ss") + (lib "pconvert.ss") + (lib "pretty.ss")) + +(import matrix-render^) +(export matrix^) + + +(define (matrix-mixin% s%) + (class s% + (init-field n m mat) + ;; [InnerMatrix X] = Nat x Nat x [vectorof X] + ;; s.t. (= (* n m)(vector-length vector)) + (super-new))) + +;; [Matrix X] = [BST X] +(define bmatrix% (matrix-mixin% object%)) + +(define (create-matrix n m mat) + (new bmatrix% [n n] [m m] [mat mat])) + +(define matrix-get-mat (class-field-accessor bmatrix% mat)) +(define matrix-get-n (class-field-accessor bmatrix% n)) +(define matrix-get-m (class-field-accessor bmatrix% m)) + +(define-struct imatrix (left i j info right) #:transparent) +(define (set-imatrix-left n x) + (make-imatrix x (imatrix-i n) (imatrix-j n) (imatrix-info n) (imatrix-right n))) +(define (set-imatrix-right n x) + (make-imatrix (imatrix-left n) (imatrix-i n) (imatrix-j n) (imatrix-info n) x)) +(define (set-imatrix-info n x) + (make-imatrix (imatrix-left n) (imatrix-i n) (imatrix-j n) x (imatrix-right n))) + +;; [BST X] = [InnerMatrix X] | (make-imatrix [BST X] Nat Nat X [BST X]) + +;; Nat Nat Nat Nat -> Boolean +(define (bst-< i j imatrix-i imatrix-j) + (or (< i imatrix-i) (and (= i imatrix-i) (< j imatrix-j)))) + +;; Nat Nat Nat Nat -> Boolean +(define (bst-= i j imatrix-i imatrix-j) + (and (= i imatrix-i) (= j imatrix-j))) + +;; Nat Nat Nat Nat -> Boolean +(define (bst-> i j imatrix-i imatrix-j) + (not (or (bst-< i j imatrix-i imatrix-j) (bst-= i j imatrix-i imatrix-j)))) + +;; bst-insert : [BST X] Nat Nat X -> [BST X] +(define (bst-insert t i j x) + (cond + [(imatrix? t) + (cond + [(bst-< i j (imatrix-i t) (imatrix-j t)) (set-imatrix-left t (bst-insert (imatrix-left t) i j x))] + [(bst-= i j (imatrix-i t) (imatrix-j t)) (set-imatrix-info t x)] + [else ;; (bst-< i j (imatrix-i t) (imatrix-j t)) + (set-imatrix-right t (bst-insert (imatrix-right t) i j x))])] + [else (make-imatrix t i j x t)])) + +;; bst-lookup : [BST X] Nat Nat -> X +(define (bst-lookup t i j) + (cond + [(imatrix? t) + (cond + [(bst-< i j (imatrix-i t) (imatrix-j t)) (bst-lookup (imatrix-left t) i j)] + [(bst-= i j (imatrix-i t) (imatrix-j t)) (imatrix-info t)] + [else (bst-lookup (imatrix-left t) i j)])] + [else (inner-ref (matrix-get-mat t) (matrix-get-m t) i j)])) + + + +; +; +; ;;;;;; +; ; ; ; +; ; ; ;; ;; ;; ;; ;;; ;; ;; ;;;;; ;;;; +; ;;; ; ; ;; ; ; ; ;; ; ; ; +; ; ; ;; ; ; ; ; ; ; ;;; +; ; ;; ; ; ; ; ; ; ; +; ; ; ; ; ; ; ; ; ; ; ; ; ; +; ;;;;;; ;; ;; ;;;; ;;; ;;;;; ;;; ;;;; +; ; +; ;;; +; +; + +(define (matrix? x) (or (is-a? x bmatrix%) (imatrix? x))) + +(define (matrix-n M*) + (define-values (M n m) (check-matrix 'matrix-n M* 0 0)) + n) + +(define (matrix-m M*) + (define-values (M n m) (check-matrix 'matrix-n M* 0 0)) + m) + +(define (rectangle->matrix r) + ;; check rectangleness of r + (define n (length r)) + (define m (length (car r))) + (make-matrix n m (apply append r))) + +(define (matrix->rectangle M*) + (define-values (M n m) (check-matrix 'matrix->rectangle M* 0 0)) + (build-list n (lambda (i) (build-list m (lambda (j) (matrix-ref M i j)))))) + +;; ------------------------------------------------------------------------- + +(define (make-matrix n m l) + (check-arg 'make-matrix (natural? n) 'Nat "first" n) + (check-arg 'make-matrix (natural? m) 'Nat "second" m) + (check-arg 'make-matrix (list? l) 'list "third" l) + (check-arg 'make-matrix (= (length l) (* n m)) + (format "list of length ~a given, expected ~a items" + (length l) + (* n m)) + "third" l) + (make-visible + (let ([mat (make-vector (* n m) 0)]) + (let loop ([l l][i 0][j 0]) + (cond + [(null? l) (create-matrix n m mat)] + [else (begin (vector-set! mat (+ (* i m) j) (car l)) + (if (< j (- m 1)) + (loop (cdr l) i (+ j 1)) + (loop (cdr l) (+ i 1) 0)))]))))) + +(define (build-matrix n m f) + (check-arg 'make-matrix (natural? n) 'Nat "first" n) + (check-arg 'make-matrix (natural? m) 'Nat "second" m) + (check-proc 'make-matrix f 2 "third" "2 arguments") + (build-matrix-aux n m f)) +(define (build-matrix-aux n m f) + (define ns (build-list n (lambda (x) x))) + (define ms (build-list m (lambda (x) x))) + (define ** + (apply append (map (lambda (i) (map (lambda (j) (f i j)) ms)) ns))) + (make-matrix n m **)) + +(define (matrix-ref M* i j) + (define-values (M n m) (check-matrix 'matrix-ref M* i j)) + (bst-lookup M i j)) + +(define (matrix-set M* i j x) + (define-values (M m n) (check-matrix 'matrix-set M* i j)) + (make-visible (bst-insert M i j x))) + +(define (matrix-render M*) + (define-values (M n m) (check-matrix 'matrix-render M* 0 0)) + (define (make-row i) + (let loop ([j 0]) + (if (= j m) + '() + (cons (element->string (matrix-ref M i j)) (loop (+ j 1)))))) + (let loop ([i 0]) + (if (= i n) '() (cons (make-row i) (loop (+ i 1)))))) + +(define (matrix-where? M* pred?) + (define-values (M n m) (check-matrix 'matrix-where? M* 0 0)) + (define (select-from-row i) + (define (select-cell j) + (if (pred? (matrix-ref M i j)) (make-posn i j) #f)) + (filter posn? (build-list m select-cell))) + (apply append (build-list n select-from-row))) + +(define (matrix-minor M* i j) + (define-values (M n m) (check-matrix 'matrix-minor M* i j)) + (build-matrix (- n 1) (- m 1) + (lambda (i* j*) + (cond + [(< i* i) + (cond + [(< j* j) (matrix-ref M i* j*)] + [(>= j* j) (matrix-ref M i* (+ j* 1))])] + [(>= i* i) + (cond + [(< j* j) (matrix-ref M (+ i* 1) j*)] + + [(>= j* j) (matrix-ref M (+ i* 1) (+ j* 1))])])))) + +(define (matrix-set! M* i j x) + (define _ (when (imatrix? M) + (error 'matrix-set! "use functional updates instead"))) + (define-values (M n m) (check-matrix 'matrix-ref M* i j)) + (vector-set! (matrix-get-mat M) (+ (* i m) j) x) + M) + +; +; +; ;; +; ; +; ; ; ;; ;; ;; ;; ;;;; +; ; ; ; ; ; ; ; ; +; ; ; ; ; ;; ;;; +; ;;;;; ; ; ;; ; +; ; ; ; ;; ; ; ; ; +; ;;; ;;; ;; ;;;; ;; ;;;; +; +; +; +; + +;; [Vectorof X] Nat Nat Nat -> Nat +;; the internal referencing for element (i,j) in an _ x m matrix +(define (inner-ref V m i j) + (vector-ref V (+ (* i m) j))) + +;; X -> String +;; okay, not X, something renderable via constructor style printing +(define (element->string value) + (parameterize ([constructor-style-printing #t] + [pretty-print-columns 40]) + (let ([value1 0] + [text* (open-output-string)]) + (pretty-print (print-convert value) text*) + (close-output-port text*) + (let* ([s (get-output-string text*)] + [l (string->list s)] + [x (reverse l)]) + (if (char=? (car x) #\newline) + (list->string (reverse (cdr x))) + s))))) + +;; Symbol [Matrix X] Nat Nat ->* [Vectorof X] Nat Nat +;; contract checking for teaching languages; compute properties of matrix +(define (check-matrix tag M* i j) + (define M (if (matrix? M*) M* (visible-matrix M*))) + (check-arg tag (matrix? M) 'matrix "first" M) + (check-arg tag (natural? i) 'Nat "second" i) + (check-arg tag (natural? j) 'Nat "third" j) + ;; --- now that M is a matrix, i and j are natural numbers: + (check-aux tag M i j)) +(define (check-aux tag M* i j) + (define M (let loop ([M M*]) (if (imatrix? M) (loop (imatrix-left M)) M))) + (define n (matrix-get-n M)) + (define m (matrix-get-m M)) + ;; i and j have to be in Nat + (unless (< -1 i n) + (error tag "~ax~a matrix given, can't index into ~a~a row" n m i (th i))) + (unless (< -1 j m) + (error tag "~ax~a matrix given, can't index into ~a~a column" n m j (th j))) + (values M* n m)) + +;; Nat -> String +(define (th n) + (cond + [(= n 1) "st"] + [(= n 2) "nd"] + [(> n 3) "th"] + [else (error 'th "can't happen")])) diff --git a/collects/htdp/matrix.ss b/collects/htdp/matrix.ss new file mode 100644 index 0000000000..a968fc0b16 --- /dev/null +++ b/collects/htdp/matrix.ss @@ -0,0 +1,209 @@ +#lang scheme + +;; 4. integrate with snips + +(require (lib "matrix-sig.ss" "htdp") + (lib "matrix-unit.ss" "htdp") + (lib "matrix-render.ss" "htdp")) + +(require (lib "class.ss") + (lib "string.ss") + (lib "mred.ss" "mred") + (lib "cache-image-snip.ss" "mrlib")) + +(define matrix-snip-class 'missing) +(define matrix-snip-class% 'missing) + +;; --------------------------------------------------------------------------- +(provide (rename-out (matrix-snip-class snip-class)) + matrix-snip-class%) + +(define render@ + (unit (import matrix^) + (export matrix-render^) + + ;; representing a matrix that renders itself as an image, as in image.ss + (define visible-matrix% + (class cache-image-snip% + (inherit set-snipclass get-argb) + (init-field M) + (inherit-field dc-proc argb-proc width height argb px py) + + ;; create a matrix from this instance + (define/override (copy) + (new visible-matrix% + (M M) + (width width) (height height) (px px) (py py) (argb argb) + (dc-proc dc-proc) + (argb-proc argb-proc))) + + (define/override (write f) + (let ([str (string->bytes/utf-8 + (format "~s" + (list (matrix->rectangle M) + (list (argb-vector (get-argb)) + width + px + py))))]) + (send f put str))) + + (super-new) + (set-snipclass matrix-snip-class))) + + (define visible-matrix (class-field-accessor visible-matrix% M)) + + ;; the snip class for matricies + (define matrix-snip-class% + (class cache-image-snip-class% + (super-new) + (define/override (read f) + (data->snip (read-from-string (send f get-bytes) (lambda () #f)))) + (define/override (data->snip data) + (define _ (unless data (error 'read "in matrix-snip-class% failed"))) + (define new-cache-image-snip (super data->snip (cadr data))) + (define-values (w h) (send new-cache-image-snip get-size)) + (define M (rectangle->matrix (car data))) + ;; .. but we need to produce a visible-matrix% instead + (new visible-matrix% + (M M) + (dc-proc (send new-cache-image-snip get-dc-proc)) + (argb-proc (send new-cache-image-snip get-argb-proc)) + (width w) + (height h) + (argb (get-argb new-cache-image-snip)) + (px (get-px new-cache-image-snip)) + (py (get-py new-cache-image-snip)))))) + (define get-argb (class-field-accessor cache-image-snip% argb)) + (define get-px (class-field-accessor cache-image-snip% px)) + (define get-py (class-field-accessor cache-image-snip% py)) + + ;; setting up the 'snip class' + (define matrix-snip-class (new matrix-snip-class%)) + (send matrix-snip-class set-version 1) + (send matrix-snip-class set-classname (format "~s" `(lib "matrix.ss" "htdp"))) + (send the-drscheme-snip-class #;(get-the-snip-class-list) add matrix-snip-class) + + ;; the graphical stuff follows .. it is code based on image.ss + ;; Matrix -> VisibleMatrix + (define (make-visible M) + (define S (matrix-render M)) + (define indent 3) + (define xspan 3) + (define-values (row-heights col-widths) (text-sizes S)) + (define th ;; total height of matrix: 2 lines plus the text height + (+ 2 (apply + row-heights))) + (define tw ;; total width of matrix: 2 identations, n xspans + (+ 1 (* 2 indent) (apply + col-widths) (* (length col-widths) xspan))) + ;; + (define (draw-proc mode dc dx dy) + [define old-mode (send dc get-text-mode)] + [define old-fore (send dc get-text-foreground)] + [define old-font (send dc get-font)] + (send dc set-text-mode mode) + (send dc set-text-foreground COLOR) + (send dc set-font (get-font SIZE)) + ;; --- left bracket + (send dc draw-line dx dy (+ dx indent) dy) + (send dc draw-line dx (+ dy th -1) (+ dx indent) (+ dy th -1)) + (send dc draw-line dx dy dx (+ dy th -1)) + ;; --- right bracket + (send dc draw-line (+ dx tw (- indent) -1) dy (+ dx tw -1) dy) + (send dc draw-line (+ dx tw (- indent) -1) (+ dy th -1) (+ dx tw -1) (+ dy th -1)) + (send dc draw-line (+ dx tw -1) dy (+ dx tw -1) (+ dy th -1)) + ;; --- draw all matrix cells + (draw-matrix S dc dx dy indent xspan col-widths row-heights) + (send dc set-text-mode old-mode) + (send dc set-text-foreground old-fore) + (send dc set-font old-font)) + ;; + (define (argb-proc argb dx dy) + (define (bm-color-builder dc) + (define p (send the-pen-list find-or-create-pen "black" 1 'transparent)) + (define b (send the-brush-list find-or-create-brush COLOR 'solid)) + (send dc set-pen p) + (send dc set-brush b) + (send dc draw-rectangle 0 0 tw th)) + (define bm-color (build-bitmap bm-color-builder tw th)) + (define(bm-mask-builder dc) (draw-proc 'solid dc 0 0)) + (define bm-mask (build-bitmap bm-mask-builder tw th)) + (overlay-bitmap argb dx dy bm-color bm-mask)) + (new visible-matrix% + [M M] + [width tw] [height th] [px 0] [py 0] + [dc-proc (lambda (dc dx dy) (draw-proc 'transparent dc dx dy))] + [argb-proc argb-proc])) + + ;; [Rectangle String] DC Nat Nat Nat Nat [Listof Nat] [Listof Nat] -> Void + (define (draw-matrix S dc dx dy indent xspan col-widths row-heights) + (define dx0 dx) + (for-each (lambda (row deltay) + (set! dx (+ dx0 2 indent)) + (for-each (lambda (str deltax) + (draw-centrally dc str dx dy deltax deltay) + (set! dx (+ deltax xspan dx))) + row col-widths) + (set! dy (+ 2 deltay dy))) + S row-heights)) + + ;; basic constants + (define SIZE 12) + (define COLOR (send the-color-database find-color "black")) + + ;; String Nat Nat Nat Nat -> Void + ;; draw str centrally into a (deltax x deltay) rectangle of dc + ;; whose upper-left position is (dx,dy) + (define (draw-centrally dc str dx dy deltax deltay) + (define-values (w h) (get-text-size SIZE str)) + (define dx* (+ dx (quotient (- deltax w) 2))) + (define dy* (+ dy (quotient (- deltay h) 2))) + (send dc draw-text str dx* dy*)) + + ;; [Rectangle String] ->* [Listof Nat] [Listof Nat] + ;; determine the height of each row and the width of each column + (define (text-sizes S) + (define S-sizes + (map (lambda (row) + (map (lambda (cell) + (define-values (tw th) (get-text-size SIZE cell)) + (list tw th)) + row)) + S)) + (define row-heights (map (lambda (r) (apply max (map cadr r))) S-sizes)) + (define col-widths + (let loop ([S-sizes S-sizes]) + (if (andmap null? S-sizes) + '() + (cons (apply max (map car (map car S-sizes))) + (loop (map cdr S-sizes)))))) + (values row-heights col-widths)) + + ;; --- copied from image.ss --- needs refactoring + (define (get-text-size size string) + (unless (thread-cell-ref cached-bdc-for-text-size) + (let* ([bm (make-object bitmap% 1 1)] + [dc (make-object bitmap-dc% bm)]) + (thread-cell-set! cached-bdc-for-text-size dc))) + (let ([dc (thread-cell-ref cached-bdc-for-text-size)]) + (let-values ([(w h _1 _2) (send dc get-text-extent string (get-font size))]) + (values (inexact->exact (ceiling w)) + (inexact->exact (ceiling h)))))) + + (define (get-font size) + (send the-font-list find-or-create-font size + 'default 'normal 'normal #f + (case (system-type) + [(macosx) 'partly-smoothed] + [else 'smoothed]))) + + (define cached-bdc-for-text-size (make-thread-cell #f)))) + +(define invisible-matrix@ + (compound-unit + (import) + (export m r) + (link (((r : matrix-render^)) render@ m) + (((m : matrix^)) matrix@ r)))) + +(define-values/invoke-unit invisible-matrix@ (import) (export matrix^)) + +(provide-signature-elements matrix^)