Permalink
Browse files

-Started up form terms

-Did some debugging on stroke displat for the "text" function
-Revised the table use of text (previously, it had a with statement that applied color and font. This works now, thanks to the debugging above, but text already provides hooks for both of those things)
  • Loading branch information...
1 parent c9f016e commit ce3d4a63af16eb7ec6bc85364e8b81d20bd18124 ingram committed Sep 8, 2010
Showing with 35 additions and 12 deletions.
  1. +12 −0 form-terms.ss
  2. +20 −11 main.ss
  3. +3 −1 syntax.ss
View
12 form-terms.ss
@@ -0,0 +1,12 @@
+#lang scheme
+(require "main.ss"
+ "syntax.ss"
+ "primitives.ss")
+
+(define (text-field point label #:font (a-font (font "Helvetica" 14)) #:width (width #f) #:height (height 20))
+ (with (translate (car point) (cdr point))
+ (stroke (rect '(0 . 0) width height))
+ (with a-font (color "666666")
+ (text '(3 . 3) label))))
+
+(provide (all-defined-out))
View
31 main.ss
@@ -1,4 +1,4 @@
-;;#lang scheme
+#lang scheme
;;psPrelim.ss
(require mzlib/defmacro
"syntax.ss"
@@ -19,16 +19,18 @@
(define (text pt message
#:font (a-font (font "Helvetica" 14))
- #:stroke-width (stroke-width 0)
- #:stroke-color (stroke-color "000000")
- #:fill (a-fill "000000"))
+ #:stroke-width (stroke-width #f)
+ #:stroke-color (stroke-color #f)
+ #:color (a-fill "000000"))
(with (color a-fill) a-font
(moveto pt)
(fill (charpath #t message))
(moveto pt)
- (color stroke-color)
- (setlinewidth stroke-width)
- (stroke (charpath #f message))))
+ (if (or stroke-color stroke-width)
+ (with (if stroke-color (color stroke-color) "")
+ (if stroke-width (setlinewidth stroke-width) "")
+ (stroke (charpath #f message)))
+ "")))
(define (shape pts)
(path (moveto (car pts))
@@ -65,10 +67,9 @@
(path (arc pt radius 0 360)))
(define (table pt columns)
- (with (font "Helvetica" 32) (color "dddddd")
- (text pt "Hello")))
+ (text pt "Hello" #:font (font "Helvetica" 32) #:color "000000"))
-;; (ps #f (0 0 612 792)
+;; (ps "test0.ps" (0 0 612 792)
;; (page
;; (translate 500 500)
;; (for 0 10 360
@@ -78,4 +79,12 @@
;; (page (stroke (circle '(150 . 50) 150)))
;; (page (stroke (circle '(50 . 0) 200))))
-;;(provide (all-defined-out))
+;; (ps "test1.ps" (0 0 612 792)
+;; (page (translate 50 50)
+;; (table '(100 . 100) '(la la la la))
+;; (stroke (square '(0 . 0) 100))))
+
+;; (ps "test2.ps" (0 0 612 792)
+;; (page (text-field '(50 . 50) "Hello")))
+
+(provide (all-defined-out))
View
4 syntax.ss
@@ -16,7 +16,9 @@
,(length pages) ,@bounding-box)
,@(map apply-page pages (build-list (length pages) (lambda (n) (+ 1 n)))))))
(if filename
- `(display-to-file ,contents ,(build-path filename) #:mode 'text #:exists 'replace)
+ (let ((destination (cond ((string? filename) (string->path filename))
+ ((path? filename) filename))))
+ `(display-to-file ,contents ,destination #:mode 'text #:exists 'replace))
`(printf ,contents))))
(define-macro (def-pt-op name op)

0 comments on commit ce3d4a6

Please sign in to comment.