diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..cbeed51 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +maxima-install diff --git a/ham.asd b/ham.asd index 5038a01..cb1c6f0 100644 --- a/ham.asd +++ b/ham.asd @@ -3,12 +3,23 @@ (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))) + (defsystem :ham :version "0.1.0" :author "Camden Dixie O'Brien" :license "AGPL-3.0-only" :description "A framework for creating physics simulations" - :depends-on (:sdl2) + :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")))) diff --git a/physics-compiler.lisp b/physics-compiler.lisp new file mode 100644 index 0000000..00db9e7 --- /dev/null +++ b/physics-compiler.lisp @@ -0,0 +1,81 @@ +;; Copyright (c) Camden Dixie O'Brien +;; SPDX-License-Identifier: AGPL-3.0-only + +(in-package :ham) + +(eval-when (:load-toplevel :execute) + (maxima-interface:maxima-eval + `((maxima::$load) + ,(namestring (asdf:system-relative-pathname :ham "ham.mac"))))) + +(defun enmaxima-symbol (sym) + (intern (format nil "$~a" (symbol-name sym)) + (find-package :maxima))) + +(defun enmaxima-lagrangian (expr) + (defun prepare (expr) + (cond + ((symbolp expr) (enmaxima-symbol expr)) + ((and (listp expr) (eq 'dot (car expr))) + (append '(maxima::%derivative) + (mapcar #'prepare (cdr expr)) + '(maxima::$t))) + ((and (listp expr) (eq '^ (car expr))) + (cons 'expt + (mapcar #'prepare (cdr expr)))) + ((listp expr) + (cons (car expr) + (mapcar #'prepare (cdr expr)))) + (t expr))) + (maxima-interface::lisp-to-maxima (prepare expr))) + +(defun enmaxima-coords (coords) + (cons '(maxima::mlist) (mapcar #'enmaxima-symbol coords))) + +(defun hamilton-eqns (lagrangian coords) + (maxima-interface:maxima-eval + `((maxima::$ham) + ,(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))) + (if (and (eq (symbol-package sym) (find-package :maxima)) + (> (length name) 1) + (char= (char name 0) #\$)) + (intern (subseq name 1)) sym))) + (cond + ((symbolp expr) (unmaxima-symbol expr)) + ((listp expr) (mapcar #'unmaxima-expression expr)) + (t expr))) + +(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 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))))))