Skip to content
Browse files

-tweaking the box generator's auto scale function

  • Loading branch information...
1 parent 504b54a commit d7d171f8861c9a7d52ddf6d8d19f472fa69c3e8e ingram committed Sep 9, 2010
Showing with 7 additions and 6 deletions.
  1. +4 −2 form-terms.ss
  2. +3 −4 main.ss
View
6 form-terms.ss
@@ -1,12 +1,14 @@
#lang scheme
-(require "main.ss")
+(require "main.ss"
+ mzlib/pregexp)
+;; (require "main.ss" "form-terms.ss")
(define (table pt columns)
(text pt "Hello" #:font (font "Helvetica" 32) #:color "000000"))
(define (text-field point label #:font (label-font (font "Helvetica" 6)) #:width (width #f) #:height (height 20))
(let* ((font-size (string->number (second (pregexp-match #px"(\\d+?) scalefont" label-font))))
- (box-width (if width width (* font-size (string-length label)))))
+ (box-width (if width width (* 2 font-size (string-length label)))))
(with (translate (car point) (cdr point))
(stroke (rect '(0 . 0) box-width height))
(text '(3 . 3) label #:font label-font #:color "666666"))))
View
7 main.ss
@@ -50,12 +50,11 @@
`(define (,name . body)
(string-append (string-append ,open "\n") (apply string-append body) (string-append ,close "\n"))))
-;;;PostScript Primitive declarations
-;;Point operations (because they're really REALLY common
+;;Point operations (because they seem to be fairly common)
(def-pt-op pt- -)
(def-pt-op pt+ +)
-;;Primitives
+;;;Postscript Primitives
(define (show msg) (format "(~a) show~n" msg))
(define (charpath flag msg) (format "(~a) ~a charpath~n" msg (if flag "true" "false")))
@@ -123,7 +122,7 @@
(let* ((rad (cond ((number? radius) (build-list 4 (lambda (n) radius)))
((= 2 (length radius)) (list (cadr radius) (car radius) (car radius) (cadr radius)))
(else (take radius 4))))
- ;;;These are out of order so that the radius can be in clockwise order from the bottom left
+ ;;These are out of order so that the radius can be in clockwise order from the bottom left
(r1 (first rad)) (r2 (fourth rad)) (r3 (third rad)) (r4 (second rad))
(c1 (pt+ pt r1))
(c2 (pt+ (pt+ pt `(,width . 0)) `(,(- r2) . ,r2)))

0 comments on commit d7d171f

Please sign in to comment.
Something went wrong with that request. Please try again.