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"
: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"))))

4
physics-compiler.lisp
View File

@ -73,8 +73,8 @@
(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))
`(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))

46
simulation.lisp
View File

@ -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)))))