Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
59 lines (54 sloc) 2.41 KB
;;;; $Id: 1979f6357459652341a9079baf09b3672d726bb3 $
;;;;
;;;; Copyright (c) 2010 Steve Knight <stkni@gmail.com>
;;;;
;;;; Permission is hereby granted, free of charge, to any person obtaining
;;;; a copy of this software and associated documentation files (the
;;;; "Software"), to deal in the Software without restriction, including
;;;; without limitation the rights to use, copy, modify, merge, publish,
;;;; distribute, sublicense, and/or sell copies of the Software, and to
;;;; permit persons to whom the Software is furnished to do so, subject to
;;;; the following conditions:
;;;;
;;;; The above copyright notice and this permission notice shall be
;;;; included in all copies or substantial portions of the Software.
;;;;
;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
;;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
;;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
;;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;;;;
(asdf:oos 'asdf:load-op 'vecto)
(use-package 'vecto)
(defun draw-problem (pels file-name &optional (margin 50))
(let ((radius (- pels margin))
(origin (/ margin 2.0))
(theta-radians (* (/ 1.0 6.0) pi)))
(with-canvas (:width pels :height pels)
(flet ((quarter-circle (x y t1 t2)
(arc x y radius (* theta-radians t1) (* theta-radians t2))))
(set-rgba-fill 1.0 1.0 1.0 1.0)
(set-rgb-stroke 0.0 0.0 0.0)
;; The hard outside
(quarter-circle origin origin 0 3)
(stroke)
(quarter-circle (+ radius origin) origin 3 6)
(stroke)
(quarter-circle (+ radius origin) (+ radius origin) 6 9)
(stroke)
(quarter-circle origin (+ radius origin) 9 12)
(stroke)
(rectangle origin origin radius radius)
(stroke)
;; The soft-centre
(set-rgba-fill 1.0 0.5 0.5 0.5)
(quarter-circle origin origin 1 2)
(quarter-circle (+ radius origin) origin 4 5)
(quarter-circle (+ radius origin) (+ radius origin) 7 8)
(quarter-circle origin (+ radius origin) 10 11)
(fill-path)
(save-png file-name)))))
;(draw-problem 200 #P"/home/steve/shape.png")