HOME | DD

burtonsamograd — X-11

Published: 2015-02-14 05:21:02 +0000 UTC; Views: 937; Favourites: 1; Downloads: 0
Redirect to original
Description (eval-when (:compile-toplevel :load-toplevel)
  (require 'vecto))
(in-package :vecto)

(defun j (x n)
  (+ (- x n) (random (* 2 n))))

(defun render (file)
  (let* ((w (/ 10800 1)) (h (/ 7800 1)) (s (coerce (/ w 64) 'float)) (n 1500))
    (with-canvas (:width w :height h)
      (set-rgba-fill 1 1 1 1)
      (rectangle 0 0 w h)
      (fill-path)

      (dotimes (i 2)
        (let ((ps (sort
                   (sort (let (ps)
                           (push (cons 0 0) ps)
                           (push (cons 0 w) ps)
                           (push (cons w h) ps)
                           (push (cons 0 h) ps)
                           (dotimes (i n ps)
                             (push (cons (random w) (random h)) ps)))
                         (lambda (p1 p2)
                           (< (car p1) (car p2))))
                   #'< :key #'cdr)))
          
          (flet ((dist (p1 p2)
                   (let ((dx (- (car p1) (car p2)))
                         (dy (- (cdr p1) (cdr p2))))
                     (sqrt (+ (expt dx 2) (expt dy 2))))))
            (mapcar (lambda (x)
                      (let* ((x1 (first x))
                             (x2 (second x))
                             (x3 (third x))
                             (x4 (fourth x))
                             (x5 (fifth x))
                             (x6 (sixth x))
                             (p1 (second x1))
                             (p2 (third x1))
                             (p3 (third x2))
                             (p4 (third x3))
                             (p5 (third x4))
                             (p6 (third x5))
                             (p7 (third x6))
                             )
                        (move-to (car p1) (cdr p1))
                        (line-to (car p2) (cdr p2))
                        (line-to (car p3) (cdr p3))
                        (line-to (car p4) (cdr p4))
                        (line-to (car p5) (cdr p5))
                        (set-rgba-fill (random 1.0) (random 1.0) (random 1.0) (random 1.0))
                        (fill-path)
                        
                        (set-line-width (/ s 12))
                        (move-to (car p1) (cdr p1))
                        (line-to (car p2) (cdr p2))
                        (line-to (car p3) (cdr p3))
                        (line-to (car p4) (cdr p4))
                        (line-to (car p5) (cdr p5))
                        (set-rgba-stroke 0 0 0 .75)
                        (stroke)
                        ))
                    (mapcar (lambda (x)
                              (sort x #'< :key #'car))
                            (mapcar (lambda (p1)
                                      (remove-if #'zerop
                                                 (mapcar (lambda (p2)
                                                           (let ((d (dist p1 p2)))
                                                             (list d p1 p2))) ps)
                                                 :key #'car)) ps))))))
      
        ;; signature
        (set-rgba-fill 0 0 0 1)
        (set-font (get-font "~/OCRABold.ttf") (/ w 128))
        (draw-string (- w (/ w 32)) (/ h 32) "X")
        (fill-path)
        
        (save-png file))))
(render "x-11.png")
Related content
Comments: 0