Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

-ps can now take #f or a file-path. If it's passed #f, it prints outp…

…ut to screen instead of to a file
  • Loading branch information...
commit e75d5f9e63b40b6007f673d3d779b626ada1f8b7 1 parent 614ccff
authored June 25, 2010

Showing 2 changed files with 19 additions and 11 deletions. Show diff stats Hide diff stats

  1. 13  psPrelim.ss
  2. 17  syntax.ss
13  psPrelim.ss
@@ -21,6 +21,10 @@
21 21
   (path (moveto (car pts))
22 22
         (apply string-append (map lineto (cdr pts)))))
23 23
 
  24
+(define (curve-shape pts)
  25
+  (path (moveto (car pts))
  26
+        (apply string-append (map curveto(cdr pts)))))
  27
+
24 28
 (define (rounded-rect pt width height radius)
25 29
   (let* ((rad (cond ((number? radius) (build-list 4 (lambda (n) radius)))
26 30
                     ((= 2 (length radius)) (list (cadr radius) (car radius) (car radius) (cadr radius)))
@@ -47,8 +51,13 @@
47 51
 (define (circle pt radius)
48 52
   (path (arc pt radius 0 360)))
49 53
 
50  
-;; (ps (0 0 612 792)
51  
-;;     (page (stroke (circle '(200 . 300) 100)))
  54
+;; (ps #f (0 0 612 792)
  55
+;;     (page 
  56
+;;      (translate 500 500)
  57
+;;      (for 0 10 360
  58
+;;           (scale 1.1 1.1)
  59
+;;           (with (rotate)
  60
+;;                 (stroke (circle '(200 . 300) 100)))))
52 61
 ;;     (page (stroke (circle '(150 . 50) 150)))
53 62
 ;;     (page (stroke (circle '(50 . 0) 200))))
54 63
 
17  syntax.ss
@@ -3,7 +3,7 @@
3 3
 
4 4
 (define (page . body)
5 5
   (lambda (page-num page-total b1 b2 b3 b4)
6  
-    (string-append (format "%%Page: ~a ~a~n%%BeginPageSetup~n%%PageBoundingBox: ~a ~a ~a ~a~n%%EndPageSetup~n~n"
  6
+    (string-append (format "%%Page: ~a ~a~n%%BeginPageSetup~n%%PageBoundingBox: ~a ~a ~a ~a~n%%EndPageSetup~n"
7 7
                            page-num page-total b1 b2 b3 b4)
8 8
                    (apply string-append body)
9 9
                    "showpage\n\n")))
@@ -11,14 +11,13 @@
11 11
 (define-macro (ps filename bounding-box . pages)
12 12
   (define (apply-page page num)
13 13
     `(,page ,num ,(length pages) ,@bounding-box))
14  
-  `(display-to-file
15  
-    (apply string-append
16  
-           (cons (format "%!PS-Adobe-3.0~n%%Pages: ~a~n%%BoundingBox: ~a ~a ~a ~a~n%%DocumentData: Clean7Bit~n%%LanguageLevel: 2~n~n"
17  
-                         ,(length pages) ,@bounding-box)
18  
-                 (list ,@(map apply-page
19  
-                              pages
20  
-                              (build-list (length pages) (lambda (n) (+ 1 n)))))))
21  
-    ,(build-path filename) #:mode 'text #:exists 'replace))
  14
+  (let ((contents `(string-append
  15
+                    (format "%!PS-Adobe-3.0~n%%Pages: ~a~n%%BoundingBox: ~a ~a ~a ~a~n%%DocumentData: Clean7Bit~n%%LanguageLevel: 2~n~n"
  16
+                            ,(length pages) ,@bounding-box)
  17
+                    ,@(map apply-page pages (build-list (length pages) (lambda (n) (+ 1 n)))))))
  18
+    (if filename
  19
+        `(display-to-file ,contents ,(build-path filename) #:mode 'text #:exists 'replace)
  20
+        `(printf ,contents))))
22 21
 
23 22
 (define-macro (def-pt-op name op)
24 23
   `(define (,name pt term)

0 notes on commit e75d5f9

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