--- 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
+ ))
+
--- 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")))
--- /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))
--- 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 "? ")
--- 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))))))
+
;;
))
)