Functional PostScript Examples

Sun

This procedure draws a sun with n number of spikes around a color wheel (with a disturbingly cute smile). It demonstrates how to use the with-attrib syntax to temporarily change the default style. [PostScript Output]

(define (sun n)
  (let* ((radius 50)  ;radius of circle
	 (l 20)       ;length of sun spikes
	 (sat 1)      ;saturation
	 (bri 1)      ;brightness
	 (stick      (line (pt 0 0) (pt radius 0)))
	 (long-stick (line (pt 0 0) (pt (+ radius l) 0)))
	 (full-step  (/ 2pi n))
	 (half-step  (/ full-step 2))
	 (hue-step3  (/ 1 n))
	 (hue-step1  (/ hue-step3 3))
	 (hue-step2  (* hue-step1 2)))
    (with-attrib ((:line-width 2))
      (translate 300 300
		 (compose
		  ;; add disturbing smiley face
		  (with-attrib ((:color (rgb 1 .1 .1)))
		    (compose
				;; right eye
		     (translate (* .3 radius) (* .1 radius)
				(fill (arc origin (* .1 radius) 0 2pi)))
		     ;; left eye
		     (translate (* -.3 radius) (* .1 radius)
				(fill (arc origin (* .1 radius) 0 2pi)))
		     ;; mouth
		     (stroke (arc origin (* .5 radius) pi 2pi))))
		  
		  (let lp ((n n) (hue 0))
		    (let ((spike-pt (end-pt (rotate half-step long-stick))))
		      (if (> n 0)
			  (compose
			   ;; first spike edge
			   (stroke
			    (line (end-pt stick) spike-pt)
			    (:color (hsb (- hue hue-step1) sat bri)))

			   ;; second spike edge
			   (stroke 
			    (line spike-pt (end-pt (rotate full-step stick)))
			    (:color (hsb hue sat bri)))
			   
			   ;; arc section
			   (stroke
			    (arc origin radius 0 full-step)
			    (:color (hsb (- hue hue-step2) sat bri)))
			   
			   ;; the other spikes
			   (rotate full-step (lp (- n 1) (+ hue hue-step3))))
			  
			  ;; recursion ends
			  the-empty-pict))))))))

FPS Home | Prev Example | Next Example