cdo/ham
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Untabify sources

Browse Source
This commit is contained in:
Camden Dixie O'Brien 2025-05-29 01:15:55 +01:00
parent d035c62bdb
commit 76a61e4477
3 changed files with 28 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ham.asd
View File

@ -20,6 +20,6 @@
:description "A framework for creating physics simulations" :description "A framework for creating physics simulations"
:depends-on (:sdl2 :maxima :maxima-interface) :depends-on (:sdl2 :maxima :maxima-interface)
:components ((:file "package") :components ((:file "package")
(:file "drawing" :depends-on ("package")) (:file "drawing" :depends-on ("package"))
(:file "physics-compiler" :depends-on ("package")) (:file "physics-compiler" :depends-on ("package"))
(:file "simulation" :depends-on ("package" "drawing")))) (:file "simulation" :depends-on ("package" "drawing"))))

4
physics-compiler.lisp
View File

@ -73,8 +73,8 @@
(defun update-body (result coords params) (defun update-body (result coords params)
(let ((vars (append coords (mapcar #'momentum-symbol coords)))) (let ((vars (append coords (mapcar #'momentum-symbol coords))))
`(let (,@(mapcar (lambda (s) `(,s (getf params ',s))) (keys params)) `(let (,@(mapcar (lambda (s) `(,s (getf params ',s))) (keys params))
,@(mapcar (lambda (s) `(,s (getf state ',s))) vars)) ,@(mapcar (lambda (s) `(,s (getf state ',s))) vars))
,@(update-logic result coords) ,@(update-logic result coords)
(list ,@(flatten (list ,@(flatten
(mapcar (lambda (s) (list `',s s)) (mapcar (lambda (s) (list `',s s))

46
simulation.lisp
View File

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