From beace9955a6c41b85358975a5d93c35fd16043e9 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Sat, 16 Jul 2022 09:39:47 -0500
Subject: [rename] example 10; [add] example readme

---
 examples/10-canvas.lisp | 117 ------------------------------------------------
 1 file changed, 117 deletions(-)
 delete mode 100644 examples/10-canvas.lisp

(limited to 'examples/10-canvas.lisp')

diff --git a/examples/10-canvas.lisp b/examples/10-canvas.lisp
deleted file mode 100644
index 453ef0e..0000000
--- a/examples/10-canvas.lisp
+++ /dev/null
@@ -1,117 +0,0 @@
-;;;; examples/10-canvas.lisp
-
-(defpackage #:ww.examples/10
-  (:use #:cl)
-  (:export #:start)
-  (:import-from #:defclass-std #:defclass/std))
-
-(in-package #:ww.examples/10)
-
-;;; CLASSES
-
-(defclass/std sneking (ww:application)
-  ((sneks snek-pit)
-   (population :std 10)))
-
-(defclass/std snek ()
-  ((x y)
-   (dx dy :std 1)
-   (brain :std 0.0)
-   (bod :std (list))
-   (len :std 4)
-   (color :std (list 255 255 255))
-   (home :std (list 0 0 100 100))))
-
-(defun snek-is-home-p (snek)
-  (with-slots (x y home) snek
-    (destructuring-bind (left bottom right top) home
-      (and (<= left x (1- right))
-           (<= bottom y (1- top))))))
-
-(defun random-between (lo hi)
-  (+ lo (random (1+ (- hi lo)))))
-
-(defun snek-change-mind (snek)
-  (if (zerop (random 2))
-      (setf (dx snek) (random-between -1 1))
-      (setf (dy snek) (random-between -1 1))))
-
-(defun advance-snek-pos (snek)
-  (with-slots (x y dx dy home bod len) snek
-    (incf x dx)
-    (incf y dy)
-    (unless (snek-is-home-p snek)
-      (decf y dy)
-      (decf x dx)
-      (snek-change-mind snek))
-    (push y bod)
-    (push x bod)
-    (when (< len (length bod)) 
-      (setf bod (nreverse (cddr (nreverse bod)))))))
-
-(defun snek-thots (snek)
-  (incf (brain snek) 0.01)
-  (when (< (random 1.0) (brain snek))
-    (setf (brain snek) 0.0)
-    (snek-change-mind snek)))
-
-(defun update-snek (snek)
-  (advance-snek-pos snek)
-  (snek-thots snek))
-
-(defun draw-snek (snek canvas)
-  (with-slots (bod color) snek
-    (destructuring-bind (red green blue) color 
-      (let ((alpha 255))
-        (loop
-          for (x y . more) on bod by #'cddr
-          do (ww::with-pixel (r g b a) (ww::pixel canvas x y)
-               (setf r red g green b blue a alpha))
-             (setf alpha (max 0 (- alpha  10))))))))
-
-(defun random-snek (&optional (boundx 100) (boundy 100))
-  (make-instance 'snek
-                 :color (list (random 256) (random 256) (random 256))
-                 :dy (random-between -1 1)
-                 :dx (random-between -1 1)
-                 :len (random-between 50 100)
-                 :home (list 0 0 boundx boundy)
-                 :x (random boundx)
-                 :y (random boundy)))
-
-(ww:defhandler sneks-a-go-go
-    (ww::on-perframe (app ticks)
-      (with-slots (sneks snek-pit) app
-        (ww::clear-canvas snek-pit)
-        (dolist (snek sneks)
-          (update-snek snek)
-          (draw-snek snek snek-pit))
-        (ww::blit snek-pit))))
-
-(defmethod ww::boot ((app sneking ))
-  "Adds the intro text and sets up the start button handler."
-  (setf (snek-pit app)
-        (make-instance 'ww:canvas :pixel-width 100 :pixel-height 100)
-        (sneks app)
-        (loop repeat (population app) collect (random-snek 100 100)))
-  (setf (ww:width (snek-pit app)) (ww::application-width app)
-        (ww:height (snek-pit app)) (ww::application-width app))
-  (ww::add-unit app (snek-pit app))
-  (ww:add-handler app #'sneks-a-go-go))
-
-(defun start (&key (side 800) (population 50))
-  (ww::start
-   (make-instance
-    'sneking    
-    :population population
-    :fps 60
-    :width side
-    :height side 
-    :refocus-on-mousedown-p nil
-    :title "sneks"
-    :asset-root
-    (merge-pathnames
-     "examples/"
-     (asdf:system-source-directory :wheelwork)))))
-
-
-- 
cgit v1.2.3