# HG changeset patch # User Steve Losh # Date 1472558692 0 # Node ID 56edfdd18674e897f0c88e5aa849d10d8fe55ce1 # Parent 8a0871a52d1d40eef71356f094632232bed0af07 Poke at colors diff -r 8a0871a52d1d -r 56edfdd18674 package.lisp --- a/package.lisp Fri Aug 26 23:19:06 2016 +0000 +++ b/package.lisp Tue Aug 30 12:04:52 2016 +0000 @@ -126,6 +126,7 @@ (:export )) +#+sbcl (defpackage #:sand.ffi (:use #:sb-alien @@ -137,3 +138,16 @@ #:sand.utils) (:export )) + +(defpackage #:sand.color-difference + (:use + #:cl + #:cl-arrows + #:losh + #:iterate + #:rs-colors + #:sand.quickutils + #:sand.utils) + (:export + )) + diff -r 8a0871a52d1d -r 56edfdd18674 sand.asd --- a/sand.asd Fri Aug 26 23:19:06 2016 +0000 +++ b/sand.asd Tue Aug 30 12:04:52 2016 +0000 @@ -23,6 +23,7 @@ #:plump #:clss #:cl-algebraic-data-type + #:rs-colors ) :serial t @@ -39,9 +40,10 @@ (:file "ascii") (:file "markov") (:file "dijkstra-maps") - (:file "ffi") + #+sbcl (:file "ffi") (:file "binary-decision-diagrams") (:file "huffman-trees") + (:file "color-difference") (:module "terrain" :serial t :components ((:file "diamond-square"))) diff -r 8a0871a52d1d -r 56edfdd18674 src/color-difference.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/color-difference.lisp Tue Aug 30 12:04:52 2016 +0000 @@ -0,0 +1,22 @@ +(in-package #:sand.color-difference) + +; https://en.wikipedia.org/wiki/Color_difference + +(defparameter *c1* (make-cie-rgb-color 0.0 1.0 1.0)) +(defparameter *c2* (make-cie-rgb-color 0.1 1.0 1.0)) +(defparameter *c3* (make-cie-rgb-color 0.7 1.0 1.0)) + + +(defun cie-76-distance (c1 c2) + (multiple-value-bind (l1 a1 b1) (cie-lab-color-coordinates c1) + (multiple-value-bind (l2 a2 b2) (cie-lab-color-coordinates c2) + (sqrt (+ (square (- l2 l1)) + (square (- a2 a1)) + (square (- b2 b1))))))) + + +; (cie-76-distance *c1* *c2*) + +; (defparameter *c* ) + +; (cie-lab-color-coordinates (make-cie-xyz-color 0 0 0)) diff -r 8a0871a52d1d -r 56edfdd18674 src/ffi.lisp --- a/src/ffi.lisp Fri Aug 26 23:19:06 2016 +0000 +++ b/src/ffi.lisp Tue Aug 30 12:04:52 2016 +0000 @@ -36,10 +36,10 @@ -(linenoise-history-set-max-len 10) -(linenoise-history-add "Alice") -(linenoise-history-add "Bob") -(iterate (for i :from 0 :to 20) - (linenoise-history-add (format nil "history entry ~d" i))) -(linenoise "? ") +; (linenoise-history-set-max-len 10) +; (linenoise-history-add "Alice") +; (linenoise-history-add "Bob") +; (iterate (for i :from 0 :to 20) +; (linenoise-history-add (format nil "history entry ~d" i))) +; (linenoise "? ") diff -r 8a0871a52d1d -r 56edfdd18674 src/sketch.lisp --- a/src/sketch.lisp Fri Aug 26 23:19:06 2016 +0000 +++ b/src/sketch.lisp Tue Aug 30 12:04:52 2016 +0000 @@ -59,38 +59,6 @@ ;;;; Sketch -(defparameter *tile-count* 20) -(defparameter *tile-width* (/ *width* *tile-count*)) -(defparameter *tile-height* (/ *height* *tile-count*)) - -(defparameter *wall-pen* (make-pen :fill (gray 0.0))) -(defparameter *floor-pen* (make-pen :fill (gray 1.0))) -(defparameter *goal-pen* (make-pen :fill (rgb 0.0 1.0 0.0))) - -(defun draw-map (map) - (iterate (for (v x y) :in-array map) - (with-pen (ecase v - (:blank *floor-pen*) - (:wall *wall-pen*) - (:goal *goal-pen*)) - (rect (* x *tile-width*) - (* y *tile-height*) - *tile-width* - *tile-height*)))) - -(defun draw-dijkstra (dm) - (iterate - (with max = (sand.dijkstra-maps:dm-maximum-value dm)) - (with data = (sand.dijkstra-maps::dm-map dm)) - (for (v x y) :in-array data) - (unless (= most-positive-single-float v) - (with-pen (make-pen :fill (rgb 1.0 0.0 0.0 - (/ v max))) - (rect (* x *tile-width*) - (* y *tile-height*) - *tile-width* - *tile-height*))))) - (defsketch demo ((width *width*) (height *height*) (y-axis :up) (title "Sketch") (copy-pixels t) @@ -99,24 +67,33 @@ (mouse-down-right nil) (dirty t) ;; Data - (map (make-array (list *tile-count* *tile-count*) - :element-type t - :initial-element :blank)) - (dm nil) + (palette (iterate (repeat 45) + (collect (rgb (random 1.0) (random 1.0) (random 1.0))))) + (ideal (rgb (random 1.0) (random 1.0) (random 1.0))) (lol (progn - (setf (aref map - (random-range 0 *tile-count*) - (random-range 0 *tile-count*)) - :goal) + ))) ;; (just-once dirty (with-setup - (setf dm (sand.dijkstra-maps::make-dijkstra-map map - (curry #'eql :goal) - (curry #'eql :wall))) - (draw-map map) - (draw-dijkstra dm))) + (iterate + (with tile-size = 40) + (with tile-count = (/ *width* tile-size)) + (for-nested ((y :from 0 :below 100) + (x :from 0 :below tile-count))) + (for color :in palette) + (with-pen (make-pen :fill color) + (rect (* x tile-size) (* y tile-size) tile-size tile-size))) + (text "Ideal Color" 0 (- *center-y* 20)) + (with-pen (make-pen :fill ideal) + (rect 0 *center-y* + (- (/ *width* 2) 10) + (/ *height* 2))) + (text "Closest Color" (+ 10 *center-x*) (- *center-y* 20)) + (with-pen (make-pen :fill (gray 0.5)) + (rect (+ 10 *center-x*) *center-y* + (- (/ *width* 2) 10) + (/ *height* 2))))) ;; ) @@ -134,21 +111,7 @@ (with-slots (mouse) instance (setf mouse (list x (- *height* y 1))) ;; - (when (or (slot-value instance 'mouse-down-left) - (slot-value instance 'mouse-down-right)) - (setf (slot-value instance 'dirty) t) - (let ((tx (floor x *tile-width*)) - (ty (floor (- *height* y 1) *tile-height*))) - (zapf (aref (slot-value instance 'map) tx ty) - (if (slot-value instance 'mouse-down-left) - (case % - (:blank :wall) - (:goal :goal) - (:wall :wall)) - (case % - (:blank :blank) - (:goal :goal) - (:wall :blank)))))) + ;; )) )