e05ab7ec7e6c default tip

Remove some of the bitrot.  It still doesn't really work.
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Mon, 07 Jan 2019 18:25:15 -0500
parents 8323ee4c3700
children (none)
branches/tags default tip
files package.lisp src/2d/ballistics.lisp src/2d/demo.lisp src/2d/particles.lisp src/2d/points.lisp src/2d/vectors.lisp src/3d/demo.lisp src/fps.lisp src/math.lisp src/utils.lisp

Changes

--- a/package.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/package.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -2,7 +2,6 @@
 (defpackage #:coding-math.utils
   (:use
     #:cl
-    #:losh
     #:sketch
     #:iterate
     #:coding-math.quickutils)
@@ -23,7 +22,6 @@
 (defpackage #:coding-math.math
   (:use
     #:cl
-    #:losh
     #:coding-math.quickutils
     #:coding-math.utils)
   (:export
@@ -44,7 +42,6 @@
 (defpackage #:coding-math.fps
   (:use
     #:cl
-    #:losh
     #:sketch
     #:coding-math.quickutils
     #:coding-math.math
@@ -56,7 +53,6 @@
 (defpackage #:coding-math.tween
   (:use
     #:cl
-    #:losh
     #:coding-math.quickutils
     #:coding-math.math
     #:coding-math.utils)
@@ -168,7 +164,6 @@
 (defpackage #:coding-math.2d.vectors
   (:use
     #:cl
-    #:losh
     #:coding-math.math
     #:coding-math.quickutils
     #:coding-math.utils)
@@ -206,7 +201,6 @@
 (defpackage #:coding-math.2d.hitboxes
   (:use
     #:cl
-    #:losh
     #:sketch
     #:coding-math.2d.vectors
     #:coding-math.math
@@ -228,7 +222,6 @@
 (defpackage #:coding-math.2d.particles
   (:use
     #:cl
-    #:losh
     #:coding-math.math
     #:coding-math.2d.vectors
     #:coding-math.2d.hitboxes
@@ -263,7 +256,6 @@
 (defpackage #:coding-math.2d.points
   (:use
     #:cl
-    #:losh
     #:sketch
     #:coding-math.math
     #:coding-math.2d.vectors
@@ -281,7 +273,6 @@
 (defpackage #:coding-math.2d.lines
   (:use
     #:cl
-    #:losh
     #:sketch
     #:coding-math.math
     #:coding-math.2d.vectors
@@ -305,7 +296,6 @@
   (:use
     #:cl
     #:cl-arrows
-    #:losh
     #:sketch
     #:iterate
     #:coding-math.quickutils
@@ -326,7 +316,6 @@
 (defpackage #:coding-math.2d.ballistics
   (:use
     #:cl
-    #:losh
     #:sketch
     #:coding-math.quickutils
     #:coding-math.tween
@@ -341,7 +330,6 @@
 (defpackage #:coding-math.3d.vectors
   (:use
     #:cl
-    #:losh
     #:sb-cga
     #:coding-math.math
     #:coding-math.utils
@@ -358,7 +346,6 @@
 (defpackage #:coding-math.3d.coordinates
   (:use
     #:cl
-    #:losh
     #:sb-cga
     #:coding-math.math
     #:coding-math.3d.vectors
@@ -373,7 +360,6 @@
 (defpackage #:coding-math.3d.demo
   (:use
     #:cl
-    #:losh
     #:iterate
     #:sketch
     #:coding-math.quickutils
--- a/src/2d/ballistics.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/2d/ballistics.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -1,6 +1,7 @@
 (in-package #:coding-math.2d.ballistics)
 
 ;;;; Config
+(defparameter *demo* nil)
 (defparameter *width* 600)
 (defparameter *height* 400)
 
@@ -34,7 +35,7 @@
   (with-pen *force-fg-pen*
     (circle 20
             (- *height* 50)
-            (map-range -1.0 1.0 0 15 force))))
+            (losh:map-range -1.0 1.0 0 15 force))))
 
 (defun draw-target (target)
   (when target
@@ -47,10 +48,10 @@
 ;;;; Game
 (defun aim (gun x y)
   (setf (getf gun 'angle)
-        (clamp (- (/ tau 4))
-               -0.3
-               (atan (- y (getf gun 'y))
-                     (- x (getf gun 'x))))))
+        (losh:clamp (- (/ losh:tau 4))
+                    -0.3
+                    (atan (- y (getf gun 'y))
+                          (- x (getf gun 'x))))))
 
 (defun shoot (game)
   (force-output)
@@ -60,7 +61,7 @@
         firedp t
         (particle-x cannonball) (+ (getf gun 'x) (* 40 (cos angle)))
         (particle-y cannonball) (+ (getf gun 'y) (* 40 (sin angle)))
-        (particle-speed cannonball) (map-range -1.0 1.0 2 20.0 raw-force)
+        (particle-speed cannonball) (losh:map-range -1.0 1.0 2 20.0 raw-force)
         (particle-direction cannonball) angle))))
 
 (defun update-ball (game)
@@ -72,10 +73,10 @@
       (setf firedp nil))))
 
 (defun check-target (game)
-  (when (and (target game)
-             (circles-collide-p (cannonball game)
-                                (target game)))
-    (setf (win game) t)))
+  (when (and (game-target game)
+             (circles-collide-p (game-cannonball game)
+                                (game-target game)))
+    (setf (game-win game) t)))
 
 (defun random-target ()
   (list :x (random-range 200 *width*)
@@ -112,9 +113,9 @@
     (draw-force raw-force)
     (draw-target target)
 
-    (when firedp
-      (update-ball sketch::sketch-window)
-      (check-target sketch::sketch-window))
+    (when (and *demo* firedp)
+      (update-ball *demo*)
+      (check-target *demo*))
     (when win
       (text "You win!" *center-x* *center-y*))
 
@@ -148,7 +149,7 @@
 (defun keyup (game scancode)
   (scancode-case scancode
     (:scancode-space
-     (when (not (firedp game))
+     (when (not (game-firedp game))
        (shoot game)))))
 
 
@@ -162,4 +163,4 @@
 
 
 ;;;; Run
-; (defparameter *demo* (make-instance 'game))
+;; (defparameter *demo* (make-instance 'game))
--- a/src/2d/demo.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/2d/demo.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -1,7 +1,7 @@
 (in-package #:coding-math.2d.demo)
 
 ;;;; Config
-(setf *bypass-cache* t)
+(defparameter *bypass-cache* t)
 (defparameter *width* 600)
 (defparameter *height* 600)
 
@@ -107,7 +107,7 @@
                              0.00 0.00 0.00 0.00
                              0.00 0.00 0.00 1.00)))
      (weights (list 0.85 0.07 0.07 0.01))
-     (wl (make-weightlist transforms weights))
+     (wl (losh:make-weightlist (mapcar #'cons weights transforms)))
      (point (sb-cga::vec (random 1.0) (random 1.0) 0.0))
      (dirty t)
      ;; Pens
@@ -136,7 +136,7 @@
                      (* 50 (aref point 1))
                      0.5
                      0.5))
-      (zapf point (sb-cga::transform-point % (weightlist-random wl))))
+      (setf point (sb-cga::transform-point point (losh:weightlist-random wl))))
 
     )
   ;;
@@ -221,4 +221,4 @@
 
 
 ;;;; Run
-; (defparameter *demo* (make-instance 'demo))
+;; (defparameter *demo* (make-instance 'demo))
--- a/src/2d/particles.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/2d/particles.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -29,7 +29,7 @@
   (make-particle%
     :pos (make-vec x y)
     :vel (make-vec-md speed direction)
-    :grv (make-vec-md gravity (/ tau 4))
+    :grv (make-vec-md gravity (/ losh:tau 4))
     :friction friction
     :mass mass
     :radius radius))
@@ -90,8 +90,7 @@
   (push target (particle-gravitations particle)))
 
 (defun particle-gravitate-remove! (particle target)
-  (zapf (particle-gravitations particle)
-        (remove target %)))
+  (alexandria:removef (particle-gravitations particle) target))
 
 (defun particle-gravitate-to! (particle attractor-particle)
   (let ((distance (particle-distance-to particle attractor-particle)))
@@ -115,8 +114,7 @@
         (particle-springs particle)))
 
 (defun particle-spring-remove! (particle target)
-  (zapf (particle-springs particle)
-        (remove target % :key #'spring-target)))
+  (alexandria:removef (particle-springs particle) target :key #'spring-target))
 
 
 (defun particle-update! (particle)
--- a/src/2d/points.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/2d/points.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -11,11 +11,11 @@
               (tx ty) to
               (cx cy) control)
     (setf (vec-x destination)
-          (+ (* (square (- 1 n)) fx)
+          (+ (* (losh:square (- 1 n)) fx)
              (* 2 (- 1 n) n cx)
              (* n n tx))
           (vec-y destination)
-          (+ (* (square (- 1 n)) fy)
+          (+ (* (losh:square (- 1 n)) fy)
              (* 2 (- 1 n) n cy)
              (* n n ty))))
   destination)
--- a/src/2d/vectors.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/2d/vectors.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -127,8 +127,8 @@
 (defun vec-lerp (v1 v2 n)
   (with-vecs ((x1 y1) v1
               (x2 y2) v2)
-    (make-vec (lerp x1 x2 n)
-              (lerp y1 y2 n))))
+    (make-vec (losh:lerp x1 x2 n)
+              (losh:lerp y1 y2 n))))
 
 
 (defun vec-to-string (v)
--- a/src/3d/demo.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/3d/demo.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -2,7 +2,7 @@
 
 
 ;;;; Config
-(setf *bypass-cache* nil)
+(defparameter *bypass-cache* nil)
 (defparameter *width* 600)
 (defparameter *height* 400)
 
@@ -234,10 +234,10 @@
       (:scancode-lgui (setf *command* t))
       (:scancode-lalt (setf *option* t))
       ;;
-      (:scancode-left  (decf (car player)) (clampf (car player) 0 (1- *map-width*)))
-      (:scancode-right (incf (car player)) (clampf (car player) 0 (1- *map-width*)))
-      (:scancode-up    (decf (cdr player)) (clampf (cdr player) 0 (1- *map-height*)))
-      (:scancode-down  (incf (cdr player)) (clampf (cdr player) 0 (1- *map-height*)))
+      (:scancode-left  (decf (car player)) (losh:clampf (car player) 0 (1- *map-width*)))
+      (:scancode-right (incf (car player)) (losh:clampf (car player) 0 (1- *map-width*)))
+      (:scancode-up    (decf (cdr player)) (losh:clampf (cdr player) 0 (1- *map-height*)))
+      (:scancode-down  (incf (cdr player)) (losh:clampf (cdr player) 0 (1- *map-height*)))
       ;;
       )))
 
@@ -260,4 +260,4 @@
 
 
 ;;;; Run
-; (defparameter *demo* (make-instance 'demo))
+(defparameter *demo* (make-instance 'demo))
--- a/src/fps.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/fps.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -35,5 +35,5 @@
       (update-average (- (get-internal-real-time) ,start))
       (draw-fps)
       (incf *frame*)
-      (when (dividesp *frame* 15)
+      (when (losh:dividesp *frame* 15)
         (update-fps)))))
--- a/src/math.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/math.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -7,8 +7,8 @@
 
 ;; Geometry
 (defun distance (x0 y0 x1 y1)
-  (sqrt (+ (square (- x0 x1))
-           (square (- y0 y1)))))
+  (sqrt (+ (losh:square (- x0 x1))
+           (losh:square (- y0 y1)))))
 
 
 ;;;; Random
@@ -37,7 +37,7 @@
           (- max min))))
 
 (defmacro wrapf (place min max)
-  `(zapf ,place (wrap-range ,min ,max %)))
+  `(losh:zapf ,place (wrap-range ,min ,max losh:%)))
 
 
 (defun insidep (from to val)
--- a/src/utils.lisp	Sat Aug 20 15:52:35 2016 +0000
+++ b/src/utils.lisp	Mon Jan 07 18:25:15 2019 -0500
@@ -62,7 +62,7 @@
            (lerp dest-from dest-to
                  (norm source-from source-to source-val))))
       (apply #'polyline
-             (mapcan (juxt
+             (mapcan (losh:juxt
                        (lambda (x)
                          (map-range fn-start fn-end graph-start graph-end x))
                        (lambda (x)