added render-lw

svn: r11255

collects/redex/pict.ss

@@ -83,4 +83,6 @@
  [set-arrow-pict! (-> symbol? (-> pict?) void?)]
  
  [lw->pict
+  (-> (or/c (listof symbol?) compiled-lang?) lw? pict?)]
+ [render-lw
   (-> (or/c (listof symbol?) compiled-lang?) lw? pict?)])

collects/redex/private/bitmap-test.ss

@@ -1,7 +1,6 @@
 (module bitmap-test mzscheme
   (require "bitmap-test-util.ss"
-           "../pict.ss"
+           "../main.ss")
-           "../reduction-semantics.ss")
   
   ;; tests: 
   ;;  - language,
@@ -40,5 +39,12 @@
   (test (render-metafunction S)
         "metafunction.png")
   
+  ;; in this test, teh `x' is italic and the 'z' is sf, since 'x' is in the grammar, and 'z' is not.
+  (test (render-lw 
+         lang 
+         (to-lw ((λ (x) (x x))
+                 (λ (z) (z z)))))
+        "lw.png")
+  
   (printf "bitmap-test.ss: ")
   (done))

collects/redex/private/core-layout.ss

@@ -1,16 +1,19 @@
+#lang scheme/base
 
-(module core-layout mzscheme
+(require "loc-wrapper.ss"
-  (require "loc-wrapper.ss"
+         "matcher.ss"
-           "matcher.ss"
+         "reduction-semantics.ss"
-           "reduction-semantics.ss"
+         
-           (lib "list.ss")
+         texpict/utils
-           (lib "utils.ss" "texpict")
+         texpict/mrpict
-           (lib "mrpict.ss" "texpict")
+         
-           (lib "etc.ss")
+         scheme/gui/base
-           (lib "mred.ss" "mred")
+         scheme/class)
-           (lib "struct.ss"))
+
+(require (for-syntax scheme/base))
   
   (provide find-enclosing-loc-wrapper
+           render-lw
            lw->pict
            basic-text
            metafunction-text
@@ -36,10 +39,10 @@
            
            ;; for test suite
            build-lines
-           (struct token (column span))
+           (struct-out token)
-           (struct string-token (string style))
+           (struct-out string-token)
-           (struct pict-token (pict))
+           (struct-out pict-token)
-           (struct spacer-token ())
+           (struct-out spacer-token)
            
            current-text)
   
@@ -117,25 +120,29 @@
   
   ;; token = string-token | spacer-token | pict-token | align-token
   
-  (define-struct token (column span) (make-inspector))
+  (define-struct token (column span) #:inspector (make-inspector))
   
   ;; string : string
   ;; style : valid third argument to mrpict.ss's `text' function
-  (define-struct (string-token token) (string style) (make-inspector))
+  (define-struct (string-token token) (string style) #:inspector (make-inspector))
   
   ;; width : number
   ;; pict : pict
-  (define-struct (pict-token token) (pict) (make-inspector))
+  (define-struct (pict-token token) (pict) #:inspector (make-inspector))
   
   ;; spacer : number
-  (define-struct (spacer-token token) () (make-inspector))
+  (define-struct (spacer-token token) () #:inspector (make-inspector))
 
   ;; pict : pict
   ;; this token always appears at the beginning of a line and its width
   ;; is the x-coordinate of the pict inside itself (which must appear on
   ;; an earlier line)
-  (define-struct align-token (pict) (make-inspector))
+  (define-struct align-token (pict) #:inspector (make-inspector))
 
+  (define (render-lw nts lw)
+    (parameterize ([dc-for-text-size (make-object bitmap-dc% (make-object bitmap% 1 1))])
+      (lw->pict nts lw)))
+  
   (define (lw->pict nts lw)
     (lines->pict 
      (setup-lines 
@@ -156,13 +163,13 @@
                      ((current-unquote-rewriter) w-out-term-let)
                      w-out-term-let)])
            (if (equal? rewritten an-lw)
-               (copy-struct lw
+               (struct-copy lw
                             an-lw
-                            [lw-e (ar/e (lw-e an-lw)
+                            [e (ar/e (lw-e an-lw)
-                                        (lw-line an-lw)
+                                     (lw-line an-lw)
-                                        (lw-line-span an-lw)
+                                     (lw-line-span an-lw)
-                                        (lw-column an-lw)
+                                     (lw-column an-lw)
-                                        (lw-column-span an-lw))])
+                                     (lw-column-span an-lw))])
                (ar/lw rewritten)))]))
     
     (define (remove-term-let an-lw)
@@ -172,9 +179,9 @@
                      (pair? (cdr content))
                      (lw? (cadr content))
                      (equal? 'term-let (lw-e (cadr content))))
-                (copy-struct lw
+                (struct-copy lw
                              an-lw
-                             [lw-e (lw-e (second-to-last content))])
+                             [e (lw-e (second-to-last content))])
                 an-lw))
           an-lw))
     
@@ -755,6 +762,4 @@
         [else (for-each find/lw e)]))
     
     (find/e in-lws)
-    lws)
+    lws)
-
-  )

collects/redex/private/pict.ss

@@ -37,7 +37,7 @@
          linebreaks
          
          just-before
-         just-after
+         just-after         
          
          rule-pict-style
          arrow-space

collects/redex/redex.scrbl

@@ -1152,12 +1152,15 @@ This section documents two classes of operations, one for
 direct use of creating postscript figures for use in papers
 and for use in DrScheme to easily adjust the typesetting:
 @scheme[render-language],
-@scheme[render-reduction-relation], and
+@scheme[render-reduction-relation], 
-@scheme[render-metafunction], and one
+@scheme[render-metafunction], and
+@scheme[render-lw], 
+and one
 for use in combination with other libraries that operate on picts
 @scheme[language->pict],
-@scheme[reduction-relation->pict], and
+@scheme[reduction-relation->pict],
-@scheme[metafunction->pict].
+@scheme[metafunction->pict], and
+@scheme[lw->pict].
 The primary difference between these functions is that the former list
 sets @scheme[dc-for-text-size] and the latter does not.
 
@@ -1622,6 +1625,30 @@ the empty string and the @scheme[x] in the typeset output.
 
 }
 
+@defproc[(render-lw (language/nts (or/c (listof symbol?) compiled-lang?))
+                    (lw lw?)) pict?]{
+
+  Produces a pict that corresponds to the @scheme[lw] object
+  argument, using @scheme[language/nts] to determine which
+  of the identifiers in the @scheme[lw] argument are
+  non-terminals.
+
+  This function sets @scheme[dc-for-text-size]. See also
+  @scheme[lw->pict].
+}
+
+@defproc[(lw->pict (language/ntw (or/c (listof symbol?) compiled-lang?))
+                   (lw lw?)) pict?]{
+
+  Produces a pict that corresponds to the @scheme[lw] object
+  argument, using @scheme[language/nts] to determine which
+  of the identifiers in the @scheme[lw] argument are
+  non-terminals.
+
+  This does not set the @scheme[dc-for-text-size] parameter. See also
+  @scheme[render-lw].
+}
+
 @deftogether[[
 @defproc[(just-before [stuff (or/c pict? string? symbol?)]
                       [lw lw?])