Skip to content
Browse files

-Added info.ss

-Bugfix to the `ps` macro which didn't let it accept variable filenames (it still accepts path and string literals, and handles them intelligently, but that's really just an effect of its development history)
  • Loading branch information...
1 parent d7d171f commit 4d3da62ae610bd269f8920923bfde4462a6dbf1b ingram committed Sep 17, 2010
Showing with 20 additions and 5 deletions.
  1. +13 −4 form-terms.ss
  2. +6 −0 info.ss
  3. +1 −1 main.ss
View
17 form-terms.ss
@@ -6,11 +6,20 @@
(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))
+(define (radio-button pt label)
+ (let ((radius 5))
+ (with (stroke (circle (pt+ pt radius) radius))
+ (text (pt+ pt `(,(* 3 radius) . 0)) label #:font (font "Helvetica" 10)))))
+
+(define (check-box pt label)
+ (let ((width 10))
+ (with (stroke (square pt width))
+ (text (pt+ pt `(,(round (* 1.5 width)) . 0)) label #:font (font "Helvetica" 10)))))
+
+(define (text-field pt 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 (* 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"))))
+ (with (stroke (rect pt box-width height))
+ (text (pt+ pt `(3 . ,(- height (+ 2 font-size)))) label #:font label-font #:color "666666"))))
(provide (all-defined-out))
View
6 info.ss
@@ -0,0 +1,6 @@
+#lang setup/infotab
+(define name "Simple PostScript implementation")
+(define blurb
+ '("An implementation of PostScript for generating files in PLT-Scheme"))
+(define primary-file "main.ss")
+(define categories '(media datastructures io))
View
2 main.ss
@@ -19,7 +19,7 @@
,@(map apply-page pages (build-list (length pages) (lambda (n) (+ 1 n)))))))
(if filename
(let ((destination (cond ((string? filename) (string->path filename))
- ((path? filename) filename))))
+ (else filename))))
`(display-to-file ,contents ,destination #:mode 'text #:exists 'replace))
`(printf ,contents))))

0 comments on commit 4d3da62

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