Update package export list

README

@@ -21,22 +21,25 @@ To then run the simulation:
 
 								SETUP
 
-Before the ASDF system can be loaded, you must build the Maxima
-sources locally and install them into a directory (I couldn't get
-Maxima's ASDF system to load successfully otherwise, though I'm not
-entirely sure why this fixes it).  This can be done with:
+If you have :sdl2 available and the sources are in ASDF's registry,
+loading the system should just work™:
 
-	cd maxima
-	mkdir $PWD-install
-	./bootstrap
-	./configure --prefix=$PWD-install
-	make -j
-	make install
+	(asdf:load-system :ham)
 
-I'll try to figure out if this step itself can be done with ASDF at
-some point ;)
+Otherwise, the full process fetching :sdl2 with Quicklisp and adding
+the current directory to ASDF's registry is
 
-Once that's done you should be able to load the system with
-(asdf:load-system :ham), given that the sources are in your ASDF
-registry.  The system also uses :sdl2, so make sure that's available
--- you can get it with (ql:quickload :sdl2) if you're so inclined.
+	(ql:quickload :sdl2)
+	(push *default-pathname-defaults* asdf:*central-registry*)
+	(asdf:load-system :ham)
+
+As it stands the system will only work with SBCL, though I don't think
+it would be *that* much work to get it working with other Common Lisp
+implementations.
+
+Maxima ended up being a bit of a pain to build fully within ASDF so
+the ASDF config first compiles it with its autotools set-up (so you'll
+need autoconf et al) and uses the FASLs from that build when possible.
+It's a little cursed but it does the job.  I did have to call
+asdf::mark-operation-done directly so it might break with future
+versions of ASDF (I'm using version 3.3.1 at time of writing).

ham.asd

@@ -4,14 +4,62 @@
 (in-package :asdf-user)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (let ((base-dir
-		  (make-pathname :directory (pathname-directory *load-pathname*))))
-	(pushnew (merge-pathnames "maxima/src/" base-dir)
-			 asdf:*central-registry*
-			 :test #'equal)
-	(pushnew (merge-pathnames "maxima-interface/" base-dir)
-			 asdf:*central-registry*
-			 :test #'equal)))
+  (let* ((base-dir
+           (make-pathname :directory (pathname-directory *load-pathname*)))
+         (maxima-dir (merge-pathnames "maxima/" base-dir))
+         (maxima-src-dir (merge-pathnames "src/" maxima-dir))
+         (maxima-install-dir (merge-pathnames "maxima-install/" base-dir)))
+    (unless (probe-file (merge-pathnames "bin/maxima" maxima-install-dir))
+      (uiop:with-current-directory (maxima-dir)
+        (uiop:run-program "./bootstrap"
+                          :output *standard-output*
+                          :error-output *error-output*)
+        (uiop:run-program (format nil "./configure --prefix=~A"
+                                  (namestring maxima-install-dir))
+                          :output *standard-output*
+                          :error-output *error-output*)
+        (uiop:run-program "make -j"
+                          :output *standard-output*
+                          :error-output *error-output*)
+        (uiop:run-program "make install"
+                          :output *standard-output*
+                          :error-output *error-output*)))
+    (pushnew maxima-src-dir
+             asdf:*central-registry*
+             :test #'equal)
+    (pushnew (merge-pathnames "maxima-interface/" base-dir)
+             asdf:*central-registry*
+             :test #'equal)
+    (defparameter *maxima-src-dir* maxima-src-dir)))
+
+(defun prebuilt-maxima-fasl (source-file)
+  (let ((source-path (asdf:component-pathname source-file)))
+    (when (uiop:subpathp source-path *maxima-src-dir*)
+      (let ((fasl-file
+              (make-pathname
+               :directory (substitute "src/binary-sbcl" "src"
+                                      (pathname-directory source-path)
+                                      :test #'string=)
+               :name (pathname-name source-path)
+               :type "fasl")))
+        (when (probe-file fasl-file)
+          (list fasl-file))))))
+
+(defmethod asdf:output-files :around ((op asdf:compile-op)
+                                      (c asdf:cl-source-file))
+  (or (prebuilt-maxima-fasl c)
+      (call-next-method)))
+
+(defmethod asdf:perform :around ((op asdf:compile-op)
+                                 (c asdf:cl-source-file))
+  (if (prebuilt-maxima-fasl c)
+      (asdf::mark-operation-done op c)
+      (call-next-method)))
+
+(defmethod asdf:input-files :around ((op asdf:load-op)
+                                     (c asdf:cl-source-file))
+  (or (prebuilt-maxima-fasl c)
+      (call-next-method)))
 
 (defsystem :ham
   :version "0.1.0"
@@ -20,6 +68,6 @@
   :description "A framework for creating physics simulations"
   :depends-on (:sdl2 :maxima :maxima-interface)
   :components ((:file "package")
-			   (:file "drawing" :depends-on ("package"))
-			   (:file "physics-compiler" :depends-on ("package"))
-			   (:file "simulation" :depends-on ("package" "drawing"))))
+               (:file "drawing" :depends-on ("package"))
+               (:file "physics-compiler" :depends-on ("package"))
+               (:file "simulation" :depends-on ("package" "drawing"))))

package.lisp

@@ -7,4 +7,4 @@
   (:use :common-lisp :sdl2)
   (:export :line :circle :rectangle :centre-rectangle
 		   :define-transform :translate :scale :rotate
-		   :overlay :graphics-context :cleanup :display-frame))
+		   :overlay :simulation :define-simulation))

physics-compiler.lisp

@@ -38,12 +38,6 @@
 	 ,(enmaxima-lagrangian lagrangian)
 	 ,(enmaxima-coords coords))))
 
-(defun momentum-symbol (q)
-  (intern (format nil "P_~a" (symbol-name q))))
-
-(defun flatten (l)
-  (apply #'append l))
-
 (defun unmaxima-expression (expr)
   (defun unmaxima-symbol (sym)
 	(let ((name (symbol-name sym)))
@@ -56,26 +50,33 @@
 	((listp expr) (mapcar #'unmaxima-expression expr))
 	(t expr)))
 
+(defun momentum-symbol (q)
+  (intern (format nil "P_~a" (symbol-name q))))
+
+(defun next-symbol (s)
+  (intern (format nil "NEXT-~a" (symbol-name s))))
+
 (defun update-logic (result coords)
-  (defun coord-updates (exprs q)
-	(let ((p (momentum-symbol q))
-		  (q-dot-expr (cadr exprs))
-		  (p-dot-expr (caddr exprs)))
-	  `((incf ,p (* dt ,(unmaxima-expression p-dot-expr)))
-		(incf ,q (* dt ,(unmaxima-expression q-dot-expr))))))
-  (flatten (loop for coord-expressions
-				   in (cdr (maxima-interface::maxima-to-lisp result))
-				 for q in coords
-				 collect (coord-updates coord-expressions q))))
+  (defun coord-update (q exprs)
+	`(,(next-symbol q)
+	  (+ ,q (* dt ,(unmaxima-expression (cadr exprs))))))
+  (defun momentum-update (q exprs)
+	(let ((p (momentum-symbol q)))
+	  `(,(next-symbol p)
+		(+ ,p (* dt ,(unmaxima-expression (caddr exprs)))))))
+  (loop for exprs in (cdr (maxima-interface::maxima-to-lisp result))
+        for q in coords
+		collect (coord-update q exprs)
+		collect (momentum-update q exprs)))
 
 (defun keys (plist)
   (loop for key in plist by #'cddr collect key))
 
 (defun update-body (result coords params)
   (let ((vars (append coords (mapcar #'momentum-symbol coords))))
-	`(let (,@(mapcar (lambda (s) `(,s (getf params ',s))) (keys params))
-		   ,@(mapcar (lambda (s) `(,s (getf state ',s))) vars))
-	   ,@(update-logic result coords)
-	   (list ,@(flatten
-				(mapcar (lambda (s) (list `',s s))
-						vars))))))
+    `(let (,@(mapcar (lambda (s) `(,s (getf params ',s))) (keys params))
+           ,@(mapcar (lambda (s) `(,s (getf state ',s))) vars))
+	   (let ,(update-logic result coords)
+		 (list ,@(loop for s in vars
+					   collect `',s
+					   collect (next-symbol s)))))))

simulation.lisp

@@ -20,35 +20,35 @@
 (defmethod run ((sim simulation))
   (sdl2:make-this-thread-main
    (lambda ()
-	 (with-slots (width height running) sim
-	   (with-graphics-context (ctx :width width :height height)
-		 (loop while running do
-		   (update sim (/ 1.0 60.0))	; assume 60 Hz
-		   (let ((frame (render sim)))
-			 (display-frame ctx frame))))))))
+     (with-slots (width height running) sim
+       (with-graphics-context (ctx :width width :height height)
+         (loop while running do
+           (update sim (/ 1.0 60.0))    ; assume 60 Hz
+           (let ((frame (render sim)))
+             (display-frame ctx frame))))))))
 
 (defmethod start ((sim simulation))
   (with-slots (running simulation-thread) sim
-	(setf running t)
-	(setf simulation-thread
-		  (sb-thread:make-thread (lambda () (run sim))
-								 :name "ham-simulation-thread"))))
+    (setf running t)
+    (setf simulation-thread
+          (sb-thread:make-thread (lambda () (run sim))
+                                 :name "ham-simulation-thread"))))
 
 (defmethod stop ((sim simulation))
   (with-slots (running simulation-thread) sim
-	(setf running nil)
-	(sb-thread:join-thread simulation-thread)))
+    (setf running nil)
+    (sb-thread:join-thread simulation-thread)))
 
 (defmacro define-simulation (name &key lagrangian coords render start params)
   `(progn
-	 (defclass ,name (simulation)
-	   ()
-	   (:default-initargs :start ',start :params ',params))
-	 (defmethod update ((sim ,name) dt)
-	   (with-slots (state params) sim
-		 (setf state ,(let ((eqns (hamilton-eqns lagrangian coords)))
-						(update-body eqns coords params)))))
-	 (defmethod render ((sim ,name))
-	   (with-slots (state) sim
-		 (let ,(mapcar (lambda (q) `(,q (getf state ',q))) coords)
-		   ,render)))))
+     (defclass ,name (simulation)
+       ()
+       (:default-initargs :start ',start :params ',params))
+     (defmethod update ((sim ,name) dt)
+       (with-slots (state params) sim
+         (setf state ,(let ((eqns (hamilton-eqns lagrangian coords)))
+                        (update-body eqns coords params)))))
+     (defmethod render ((sim ,name))
+       (with-slots (state) sim
+         (let ,(mapcar (lambda (q) `(,q (getf state ',q))) coords)
+           ,render)))))