Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

-Fixed some bugs to do with the text functions

-Started on the table definition
  • Loading branch information...
commit 888ee1b5abbf47d47ff0f4b0f3fdbfa7c0d7386d 1 parent e75d5f9
ingram authored
Showing with 23 additions and 5 deletions.
  1. +4 −3 primitives.ss
  2. +19 −2 psPrelim.ss
View
7 primitives.ss
@@ -6,15 +6,16 @@
(def-pt-op pt+ +)
;;;Primitives
-(define (text message)
- (path (format "(~a) show~n" message)))
+(define (show msg) (format "(~a) show~n" msg))
+(define (charpath flag msg) (format "(~a) ~a charpath~n" msg (if flag "true" "false")))
(define (font name size)
(format "/~a findfont ~a scalefont setfont~n" name size))
(define (for start step stop . body)
(format "~a ~a ~a{~n ~a}for~n" start step stop (apply string-append body)))
-
+
+(def-keyword setlinewidth width)
(def-keyword setrgbcolor r g b)
(def-keyword setcymkcolor c m y k)
(def-keyword translate x y)
View
21 psPrelim.ss
@@ -1,4 +1,4 @@
-#lang scheme
+;;#lang scheme
;;psPrelim.ss
(require mzlib/defmacro
"syntax.ss"
@@ -17,6 +17,19 @@
(cond ((= (length c) 3) (apply setrgbcolor c))
((= (length c) 4) (apply setcymkcolor c)))))
+(define (text pt message
+ #:font (a-font (font "Helvetica" 14))
+ #:stroke-width (stroke-width 0)
+ #:stroke-color (stroke-color "000000")
+ #:fill (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))))
+
(define (shape pts)
(path (moveto (car pts))
(apply string-append (map lineto (cdr pts)))))
@@ -51,6 +64,10 @@
(define (circle pt radius)
(path (arc pt radius 0 360)))
+(define (table pt columns)
+ (with (font "Helvetica" 32) (color "dddddd")
+ (text pt "Hello")))
+
;; (ps #f (0 0 612 792)
;; (page
;; (translate 500 500)
@@ -61,4 +78,4 @@
;; (page (stroke (circle '(150 . 50) 150)))
;; (page (stroke (circle '(50 . 0) 200))))
-(provide (all-defined-out))
+;;(provide (all-defined-out))
Please sign in to comment.
Something went wrong with that request. Please try again.