Skip to content
Browse files

Initial checkin.

  • Loading branch information...
0 parents commit 2e64a2f7516abb5092e4470838f15cc2b161db2c @xach committed Jun 25, 2011
Showing with 177 additions and 0 deletions.
  1. +19 −0 LICENSE.txt
  2. +13 −0 README.txt
  3. +12 −0 art.asd
  4. +31 −0 art.lisp
  5. +31 −0 circly.lisp
  6. +66 −0 hexagraphic.lisp
  7. BIN output/circly.png
  8. BIN output/hexagraphic.png
  9. +5 −0 package.lisp
19 LICENSE.txt
@@ -0,0 +1,19 @@
+Copyright (c) 2011 Zachary Beane <xach@xach.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.
13 README.txt
@@ -0,0 +1,13 @@
+The "art" project has various little Lisp graphics hacks I've thrown
+together.
+
+The code is half-baked and not meant to be taken seriously by serious
+people. It only runs on SBCL and depends on several unreleased or
+half-baked projects, like:
+
+ https://github.com/xach/commando
+ https://github.com/xach/geometry
+ https://github.com/xach/vectometry
+
+Zach Beane <xach@xach.com>
+2011-06-25
12 art.asd
@@ -0,0 +1,12 @@
+;;;; art.asd
+
+(asdf:defsystem #:art
+ :serial t
+ :depends-on (#:vectometry
+ #:commando
+ #:alexandria)
+ :components ((:file "package")
+ (:file "art")
+ (:file "circly")
+ (:file "hexagraphic")))
+
31 art.lisp
@@ -0,0 +1,31 @@
+;;;; art.lisp
+
+(in-package #:art)
+
+;;; "art" goes here. Hacks and glory await!
+
+(defvar *image-viewer-command*
+ (or (probe-file "/usr/bin/open")
+ (probe-file "/usr/bin/gnome-open")
+ nil)
+ "Set this to a command that can display image files.")
+
+(defconstant 2pi (* pi 2))
+
+(defun view (file)
+ (unless *image-viewer-command*
+ (error "Don't know how to view stuff; set ~S to something"
+ '*image-viewer-command*))
+ (commando:run *image-viewer-command* (pathname file)))
+
+(defun rdegrees (radians)
+ (* radians (/ 180 pi)))
+
+(defun choose-one (&rest options)
+ (elt options (random (length options))))
+
+(define-compiler-macro choose-one (&rest options)
+ `(aref #(,@options) (random ,(length options))))
+
+
+
31 circly.lisp
@@ -0,0 +1,31 @@
+;;;; circly.lisp
+
+(in-package #:art)
+
+(defun circly (output-file &key (width 500) (height 500)
+ (line-width 10)
+ (line-gap 4))
+ (let* ((canvas (box 0 0 width height))
+ (center (centerpoint canvas))
+ (step (+ line-width line-gap))
+ (radius 0))
+ (with-box-canvas canvas
+ (translate center)
+ (set-fill-color *black*)
+ (clear-canvas)
+ (set-line-width line-width)
+ (set-line-cap :round)
+ (set-line-width line-width)
+ (loop
+ (incf radius step)
+ (when (< width radius)
+ (return))
+ (dotimes (i 8)
+ (rotate (random 2pi))
+ (set-stroke-color (hsv-color (- 30 (random 60)) 1.0
+ (aref #(1.0 0.0) (random 2))))
+ (apply #'arc *origin* radius
+ (sort (list (random 2pi) (random 2pi))
+ #'<))
+ (stroke)))
+ (save-png output-file))))
66 hexagraphic.lisp
@@ -0,0 +1,66 @@
+;;;; hexagraphic.lisp
+
+(in-package #:art)
+
+(defun hexagon (center radius &key (rotation 0))
+ "Draw a hexagon at CENTER with vertexes inscribed in a circle of
+RADIUS size."
+ (let* ((step (/ pi 3))
+ (angle rotation)
+ (point (add center (apoint angle radius))))
+ (move-to point)
+ (dotimes (i 5)
+ (incf angle step)
+ (line-to (add center (apoint angle radius))))
+ (close-subpath)))
+
+(defun call-for-tiling (&key box fun radius)
+ "Call FUN with the centerpoint of each hexagon of size RADIUS tiled
+ into BOX"
+ (let* ((r radius)
+ (oddp nil)
+ (offset r)
+ (width (+ r (width box)))
+ (height (+ r (height box)))
+ (xstep (sqrt (- (expt (* r 2) 2)
+ (expt r 2))))
+ (ystep (* r 2)))
+ (print xstep)
+ (loop for x below width by xstep
+ do
+ (if oddp
+ (setf oddp nil offset 0)
+ (setf oddp t offset r))
+ (loop for y below height by ystep
+ do
+ (funcall fun (point x (+ offset y)))))))
+
+(defun colorizer (point)
+ (lambda (p)
+ (let ((a (angle point p)))
+ (hsv-color (rdegrees a) 1 (choose-one 0.2 0.3 0.4 0.5)))))
+
+(defun tiler (&key width height radius file)
+ (let* ((canvas (box 0 0 width height))
+ (colorizer (colorizer (centerpoint canvas))))
+ (with-box-canvas canvas
+ (set-fill-color *black*)
+ (clear-canvas)
+ (call-for-tiling :box canvas
+ :radius radius
+ :fun (lambda (point)
+ (hexagon point radius)
+ (set-fill-color (funcall colorizer point))
+ (fill-path)
+ (set-fill-color (rgba-color 0 0 0
+ (choose-one 0.75
+ 0.85)))
+ (hexagon point (* radius
+ (choose-one 0.9 0.85)))
+ (fill-path)))
+ (save-png file))))
+
+
+
+
+
BIN output/circly.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
BIN output/hexagraphic.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
5 package.lisp
@@ -0,0 +1,5 @@
+;;;; package.lisp
+
+(defpackage #:art
+ (:use #:cl #:vectometry))
+

0 comments on commit 2e64a2f

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