37d71dad1f25

Clean up the sketch file a bit
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Thu, 18 Aug 2016 12:16:41 +0000
parents 4199b9a26696
children d03941f38bca
branches/tags (none)
files src/markov.lisp src/sketch.lisp

Changes

--- a/src/markov.lisp	Wed Aug 17 15:25:07 2016 +0000
+++ b/src/markov.lisp	Thu Aug 18 12:16:41 2016 +0000
@@ -174,13 +174,13 @@
                        :into reviews)
             (finally (return (format nil "~{~A~%~}" reviews)))))))
 
-(defparameter *m*
-  (build-markov-generator (concatenate 'string *hn* *wine*) 2))
+; (defparameter *m*
+;   (build-markov-generator (concatenate 'string *hn* *wine*) 2))
 
 
-(iterate (repeat 50)
-         (for sentence = (generate-sentence *m*))
-         (when (<= (length sentence) 140)
-           (terpri)
-           (terpri)
-           (princ sentence)))
+; (iterate (repeat 50)
+;          (for sentence = (generate-sentence *m*))
+;          (when (<= (length sentence) 140)
+;            (terpri)
+;            (terpri)
+;            (princ sentence)))
--- a/src/sketch.lisp	Wed Aug 17 15:25:07 2016 +0000
+++ b/src/sketch.lisp	Thu Aug 18 12:16:41 2016 +0000
@@ -16,20 +16,31 @@
 (defvar *option* nil)
 
 
+(defparameter *black-pen*
+  (make-pen :stroke (rgb 0 0 0) :fill (rgb 0.4 0.4 0.4) :weight 1 :curve-steps 50))
+
+(defparameter *red-pen*
+  (make-pen :stroke (rgb 0.6 0 0) :fill (rgb 0.9 0 0) :weight 1 :curve-steps 50))
+
+(defparameter *green-pen*
+  (make-pen :stroke (rgb 0 0.6 0) :fill (rgb 0 0.9 0) :weight 1 :curve-steps 50))
+
+(defparameter *blue-pen*
+  (make-pen :stroke (rgb 0 0 0.6) :fill (rgb 0 0 0.9) :weight 1 :curve-steps 50))
+
+
 ;;;; Utils
 (defmacro with-setup (&body body)
   `(progn
     (background (gray 1))
     ,@body))
 
-
 (defmacro in-context (&body body)
   `(prog1
     (push-matrix)
     (progn ,@body)
     (pop-matrix)))
 
-
 (defmacro scancode-case (scancode-form &rest pairs)
   (with-gensyms (scancode)
     `(let ((,scancode ,scancode-form))
@@ -40,8 +51,13 @@
                         ,@body)))
            pairs)))))
 
+(defmacro just-once (dirty-place &body body)
+  `(when ,dirty-place
+     (setf ,dirty-place nil)
+     ,@body))
 
-;;;; Box
+
+;;;; Diamond Square
 (defparameter *world-exponent* 4)
 (defparameter *world-size* (expt 2 *world-exponent*))
 
@@ -66,64 +82,59 @@
               (/ (- v min) span)))
       (return heightmap))))
 
-
 (defun draw-hm (hm ox oy ts)
   (let ((size (first (array-dimensions hm))))
     (in-context
       (translate (* ox (* ts size))
                  (* oy (* ts size)))
       (iterate
-        (for x :from 0 :below size)
-        (iterate
-          (for y :from 0 :below size)
-          (for h = (aref hm x y))
-          (with-pen (make-pen :fill (if (<= 0.0 h 1.0)
-                                      (gray h)
-                                      (rgb 1.0 0 0)))
-            (rect (* x ts) (* y ts)
-                  ts ts))))
-      (with-pen (make-pen :fill nil :stroke (rgb 1.0 0 0))
-        ; (rect 0 0 (* ts size) (* ts size))
-        ))))
+        (for (h x y) :in-array hm)
+        (with-pen (make-pen :fill (gray h))
+          (rect (* x ts) (* y ts)
+                ts ts)))
+      (with-pen (make-pen :fill nil :stroke (rgb 1.0 0 0 0.5))
+        (rect 0 0 (* ts size) (* ts size))))))
 
 
-(defmacro just-once (done &body body)
-  `(when (not ,done)
-     (setf ,done t)
-     ,@body))
-
-
-;;;; Sketch
 (defsketch demo
-    ((width *width*) (height *height*) (y-axis :up) (title "Sketch")
+    ((width *width*) (height *height*) (y-axis :up) (title "Diamond Square")
      (copy-pixels t)
      (mouse (list 0 0))
-     (frame 0)
-     (done nil)
+     (dirty t)
      ;; Data
      (size (1+ (expt 2 4)))
      (hm (sand.terrain.diamond-square::diamond-square
            5 :tileable t :spread 0.7 :spread-reduction 0.5))
      (tile-size 3)
-     ;; Pens
-     (black-pen (make-pen :stroke (rgb 0 0 0) :fill (rgb 0.4 0.4 0.4) :weight 1 :curve-steps 50))
-     (red-pen (make-pen :stroke (rgb 0.6 0 0) :fill (rgb 0.9 0 0) :weight 1 :curve-steps 50))
-     (green-pen (make-pen :stroke (rgb 0 0.6 0) :fill (rgb 0 0.9 0) :weight 1 :curve-steps 50))
-     (blue-pen (make-pen :stroke (rgb 0 0 0.6) :fill (rgb 0 0 0.9) :weight 1 :curve-steps 50))
      )
-  (incf frame)
   ;;
-  (just-once done
+  (just-once dirty
     (with-setup
       (iterate
-        (for x :from 0 :to (floor *width* (* size tile-size)))
-        (iterate
-          (for y :from 0 :to (floor *height* (* size tile-size)))
-          (draw-hm hm x y tile-size)))))
+        (for-nested ((x :from 0 :to (floor *width* (* size tile-size)))
+                     (y :from 0 :to (floor *height* (* size tile-size)))))
+        (draw-hm hm x y tile-size))))
   ;;
 
   )
 
+;;;; Template
+(defsketch demo
+    ((width *width*) (height *height*) (y-axis :up) (title "Sketch")
+     (copy-pixels t)
+     (mouse (list 0 0))
+     (dirty t)
+     ;; Data
+     )
+  ;;
+  (just-once dirty
+    (with-setup
+      (text "Demo" (- *center-x* 23) (- *center-y* 10))
+
+      ))
+  ;;
+
+  )
 
 ;;;; Mouse
 (defun mousemove (instance x y)