Functional PostScript Examples

Text Along a Circle

This program puts two strings of text around a circle. It takes four argument, top-string, top-space, bot-string, bot-space. top-string and bot-string are the text strings. top-space and bot-space are numbers that are multiples of the width of the blank space glyph. [PostScript Output]

(define circle-text 
  (let* ((radius      200)
	 (font        (font "Times-Roman" 48))
	 (space-w     (pt:x (end-pt (char->glyphpath 
                                     font #\space))))
	 (into-position-top (lambda (g) 
			      (translate radius 0 (rotate (- 1/2pi) g))))
	 (into-position-bot (lambda (g) 
			      (translate (+ radius 34) 0 (rotate 1/2pi g)))))
    
    (lambda (text-top n-top text-bot n-bot)
      (let* ((top-lst   (map (lambda (c) (char->glyphpath font c))
			     (string->list text-top)))
	     (bot-lst   (map (lambda (c) (char->glyphpath font c))
			     (string->list text-bot)))
	     (single-angle  (lambda (g n) (let ((w (pt:x (end-pt g))))
					    (* 2 (tan (/ (/ (+ (* space-w n) 
							       w) 2)
							 radius))))))
	     (top-angle (reduce (lambda (g angle) (+ (single-angle g n-top) 
						     angle))
				0 top-lst))
	     (bot-angle (reduce (lambda (g angle) (+ (single-angle g n-bot) 
						     angle))
				0 bot-lst)))
	(translate 
	 300 400
	 (stroke
	  (compose
	   (arc (pt 0 0) (- radius 24) 0 2pi)
	   (arc (pt 0 0) (+ radius 56) 0 2pi)
	   (apply compose
		  (let lp ((top-lst top-lst) 
			   (angle (+ top-angle (/ (- pi top-angle) 2))))
		    (if (null? top-lst)
			'()
			(cons (rotate angle (into-position-top (car top-lst)))
			      (lp (cdr top-lst) 
				  (- angle (single-angle 
					    (car top-lst) n-top)))))))
	   (apply compose
		  (let lp ((bot-lst bot-lst) 
			   (angle (- (- 2pi bot-angle) 
				     (/ (- pi bot-angle) 2))))
		    (if (null? bot-lst)
			'()
			(cons (rotate angle (into-position-bot (car bot-lst)))
			      (lp (cdr bot-lst) 
				  (+ angle (single-angle 
					    (car bot-lst) n-bot))))))))))))))

FPS Home | Prev Example | Next Example