56edfdd18674

Poke at colors
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 30 Aug 2016 12:04:52 +0000
parents 8a0871a52d1d
children 778814a3ff72
branches/tags (none)
files package.lisp sand.asd src/color-difference.lisp src/ffi.lisp src/sketch.lisp

Changes

--- 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))))))
+      
       ;;
       ))
   )