Skip to content

Defclass macro #2126

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
Brent-Hickey wants to merge 5 commits into
base: master
Choose a base branch
from
+739 −597
Draft

Defclass macro #2126

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
927a040
add defclass macro, refactor/rename wobbler, snow-ball
Brent-Hickey Jan 13, 2023
8a98ded
Merge branch 'open-goal:master' into defclass-macro-snowball
Brent-Hickey Jan 14, 2023
99ce564
forgot some things
Brent-Hickey Jan 14, 2023
2eb7a4f
Merge branch 'defclass-macro-snowball' of https://github.com/Brent-Hi…
Brent-Hickey Jan 14, 2023
77b78eb
skelgroup art-name fix
Brent-Hickey Jan 14, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
155 changes: 155 additions & 0 deletions goal_src/goal-lib.gc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1033,3 +1033,158 @@
(seval (fmt #t "Jak 2 Mode\n"))
)
)

(defmacro defnew (type-to-make bindings &rest body)
"Defines the new method, which allocates a new instance of the type and returns it"
`(defmethod new ,type-to-make ((allocation symbol) (new-type type) ,@bindings)
(let ((self (object-new allocation new-type (the-as int (-> new-type size))))
)
,@body
self
)
)
)

(defmacro defclass (type parent-type &rest elements)
"deftype that supports declaring fields, methods,
behaviors, states, skelgroups, options, other types, and globals within the type.
Automatically predeclares methods and states."
(with-gensyms (fields
methods
behaviors
states
skelgroups
options
types
globals
)
(set! fields '())
(set! methods '())
(set! behaviors '())
(set! states '())
(set! skelgroups '())
(set! options '())
(set! types '())
(set! globals '())
;; Collect elements based on the type tag
(apply (lambda (element)
(cond
((string? element)
;; docstrings can be placed before any element, ignored for now
#f)
((eq? (car element) (string->symbol ":fields"))
(set! fields (cdr element)))
((eq? (car element) (string->symbol ":methods"))
(set! methods (cdr element)))
((eq? (car element) (string->symbol ":behaviors"))
(set! behaviors (cdr element)))
((eq? (car element) (string->symbol ":states"))
(set! states (cdr element)))
((eq? (car element) (string->symbol ":skelgroups"))
(set! skelgroups (cdr element)))
((eq? (car element) (string->symbol ":options"))
(set! options (cdr element)))
((eq? (car element) (string->symbol ":types"))
(set! types (cdr element)))
((eq? (car element) (string->symbol ":globals"))
(set! globals (cdr element)))
(#t
;; Did not have any tag, so we assume it's a fields list
;; TODO: Check for unsupported tags and print a warning
(set! fields element)))
)
elements)
;; Define all of the elements that were collected
`(begin
;; predeclare parent type
(declare-type ,type ,@(if (eq? parent-type '()) `(basic) parent-type))
,@(if (eq? globals '())
`(#f)
(apply (lambda (global)
`(define ,(car global) ,(cadr global))
)
globals)
)
,@(if (eq? skelgroups '())
`(#f)
(apply (lambda (skelgroup)
;; defskelgroup name art-name joint geom joint-anim
`(defskelgroup ,(car skelgroup) ,(car (cdr skelgroup)) ,(car (cddr skelgroup)) ,(car (cdddr skelgroup))
;; skelgroup body
,@(cdr (cdddr skelgroup))
)
)
skelgroups)
)
,@(if (eq? types '())
`(#f)
(apply (lambda (type)
`(defclass ,(car type) ,(cadr type)
;; method body
,@(cddr type)
)
)
types)
)
(deftype ,type ,(if (eq? parent-type '()) `(basic) parent-type)
,fields
(:methods
,@(apply (lambda (method)
(if (eq? (car method) 'new)
`(new (symbol type ,@(apply (lambda (param-pair) (cadr param-pair)) (cadr method))) ,type 0)
;; name parameter types return type
`(,(car method) (_type_ ,@(apply (lambda (param-pair) (cadr param-pair)) (cadr method))) ,@(caddr method)))
)
methods)
)
(:states
,@(apply (lambda (state)
;; name
`(,(car state))
)
states)
)
,@(if (eq? options '())
`(#f)
options
)
)
,@(if (eq? methods '())
`(#f)
(apply (lambda (method)
(if (eq? (car method) 'new)
`(defnew ,type (,@(cadr method)) ,@(cddr method))
;; name parameter types ;; return type
`(defmethod ,(car method) ,type ((self ,type) ,@(cadr method))
;; method body
,@(cdddr method)
)
)
)
methods)
)
,@(if (eq? behaviors '())
`(#f)
(apply (lambda (behavior)
;; defbehavior name type parameters
`(defbehavior ,(car behavior) ,type ,(cadr behavior)
;; body
,@(cddr behavior)
)
)
behaviors)
)
,@(if (eq? states '())
`(#f)
(apply (lambda (state)
;; defstate name type
`(defstate ,(car state) (,type)
;; body
,@(cdr state)
)
)
states)
)
)
)
)
8 changes: 4 additions & 4 deletions goal_src/jak1/levels/beach/beach-obs.gc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1157,13 +1157,13 @@
(+! (-> self pos) (* (-> self vel) (-> *display* seconds-per-frame)))
;; PAL patch here
(set! (-> self vel) (* (-> self vel) (- 1.0 (* 0.05 (-> *display* time-adjust-ratio)))))
(move! (-> self wobbler))
(wobble! (-> self wobbler))
(let ((a1-0 (new 'stack-no-clear 'vector)))
(vector-float*! a1-0 (-> self dir) (-> self pos))
(vector+! a1-0 a1-0 (-> self start))
(move-to-point! (-> self root-override) a1-0)
)
(TODO-RENAME-12 (-> self wobbler) (-> self root-override quat))
(reorient-quat! (-> self wobbler) (-> self root-override quat))
(let ((a2-3 (quaternion-axis-angle! (new 'stack-no-clear 'quaternion) 0.0 1.0 0.0 -18204.445)))
(quaternion*! (-> self root-override quat) (-> self root-override quat) a2-3)
)
Expand Down Expand Up @@ -1228,8 +1228,8 @@
#f
#f
)
(move! (-> self wobbler))
(TODO-RENAME-12 (-> self wobbler) (-> self root-override quat))
(wobble! (-> self wobbler))
(reorient-quat! (-> self wobbler) (-> self root-override quat))
(let ((a2-6 (quaternion-axis-angle! (new 'stack-no-clear 'quaternion) 0.0 1.0 0.0 -18204.445)))
(quaternion*! (-> self root-override quat) (-> self root-override quat) a2-6)
)
Expand Down
117 changes: 57 additions & 60 deletions goal_src/jak1/levels/beach/wobbler.gc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,9 @@

;; DECOMP BEGINS

(deftype wobbler (basic)
(defclass wobbler (basic)
"Simulates the motion of a dampened spring.
This is used to make the flutflut egg wobble when being hit."
((posx float :offset-assert 4)
(posy float :offset-assert 8)
(velx float :offset-assert 12)
Expand All @@ -16,64 +18,59 @@
(damping float :offset-assert 24)
(height float :offset-assert 28)
)
:method-count-assert 13
:size-assert #x20
:flag-assert #xd00000020
(:methods
(reset! (_type_ float float float) none 9)
(inc-xy-vel! (_type_ float float) none 10)
(move! (_type_) none 11)
(TODO-RENAME-12 (_type_ quaternion) none 12)
(reset! ((spring float) (damping float) (height float)) (none)
"Resets position and velocity.
Sets the spring constant, damping factor, and height."
(set! (-> self posx) 0.0)
(set! (-> self posy) 0.0)
(set! (-> self velx) 0.0)
(set! (-> self vely) 0.0)
(set! (-> self spring) spring)
(set! (-> self damping) damping)
(set! (-> self height) height)
0
(none)
)
(inc-xy-vel! ((x float) (y float)) (none)
(+! (-> self velx) x)
(+! (-> self vely) y)
0
(none)
)
(wobble! () (none)
"Simulates a frame of a dampened spring, resulting in wobbling.
Updates the wobbler position and velocity based on the current position and velocity."
(+! (-> self posx) (* (-> self velx) (-> *display* seconds-per-frame)))
(+! (-> self posy) (* (-> self vely) (-> *display* seconds-per-frame)))
(set! (-> self velx) (* (-> self velx) (-> self damping)))
(set! (-> self vely) (* (-> self vely) (-> self damping)))
(+! (-> self velx) (* -1.0 (-> self posx) (-> self spring)))
(+! (-> self vely) (* -1.0 (-> self posy) (-> self spring)))
0
(none)
)
(reorient-quat! ((quat quaternion)) (none)
"Reorients a quaternion to point in the direction of the current wobbler position.
The quaternion is also rotated to point up or down based on the current position."
(let ((pos (new 'stack-no-clear 'vector)))
(set! (-> pos x) (-> self posy))
(set! (-> pos y) 0.0)
(set! (-> pos z) (- (-> self posx)))
(vector-normalize! pos 1.0)
(let* ((distance (/ (sqrtf (+ (* (-> self posx) (-> self posx)) (* (-> self posy) (-> self posy)))) (-> self height)))
(angle (atan distance 1.0))
)
(quaternion-vector-angle! quat pos angle)
)
)
0
(none)
)
)
)


(defmethod reset! wobbler ((obj wobbler) (arg0 float) (arg1 float) (arg2 float))
(set! (-> obj posx) 0.0)
(set! (-> obj posy) 0.0)
(set! (-> obj velx) 0.0)
(set! (-> obj vely) 0.0)
(set! (-> obj spring) arg0)
(set! (-> obj damping) arg1)
(set! (-> obj height) arg2)
0
(none)
)

(defmethod inc-xy-vel! wobbler ((obj wobbler) (arg0 float) (arg1 float))
(+! (-> obj velx) arg0)
(+! (-> obj vely) arg1)
0
(none)
)

(defmethod move! wobbler ((obj wobbler))
(+! (-> obj posx) (* (-> obj velx) (-> *display* seconds-per-frame)))
(+! (-> obj posy) (* (-> obj vely) (-> *display* seconds-per-frame)))
(set! (-> obj velx) (* (-> obj velx) (-> obj damping)))
(set! (-> obj vely) (* (-> obj vely) (-> obj damping)))
(+! (-> obj velx) (* -1.0 (-> obj posx) (-> obj spring)))
(+! (-> obj vely) (* -1.0 (-> obj posy) (-> obj spring)))
0
(none)
)

(defmethod TODO-RENAME-12 wobbler ((obj wobbler) (arg0 quaternion))
(let ((s5-0 (new 'stack-no-clear 'vector)))
(set! (-> s5-0 x) (-> obj posy))
(set! (-> s5-0 y) 0.0)
(set! (-> s5-0 z) (- (-> obj posx)))
(vector-normalize! s5-0 1.0)
(let* ((f0-8 (/ (sqrtf (+ (* (-> obj posx) (-> obj posx)) (* (-> obj posy) (-> obj posy)))) (-> obj height)))
(f0-9 (atan f0-8 1.0))
)
(quaternion-vector-angle! arg0 s5-0 f0-9)
)
)
0
(none)
)




(:options
:method-count-assert 13
:size-assert #x20
:flag-assert #xd00000020
)
)
Loading