process-spawn + pretty printer improvements (#1428)

* some jp support to fix some errors in the original game

* music fade toggle

* recognize `process-new` macros!!

* strip casts in this macro

* rename macro

* fix cast typecheck

* update source 1

* detect kernel stack case

* less boilerplate

* `manipy-spawn` special case

* pretty printer improvements

* revert dumb thing from earlier

* use shell detection on `send-event`

* fix some events

* remove unused argument

* detect `static-attack-info` and add `CondNoElse` to shell detect

* better `attack-info` detect

* support `process-spawn` in multi-lets

* detect `rand-float-gen` pt 1

* detect as return value

* detect in `countdown` and  `dotimes`

* oops this wasnt working

* fancier `send-event`s

* clang

* update source!!

* fix tests

* fine jeez

* uh okay

* fix some accidental regressions

* fix more regressions

* regression fixes

* fix big bug...

* extra safety!
This commit is contained in:
ManDude
2022-06-10 02:18:08 +01:00
committed by GitHub
parent ffd8ade4e1
commit 7ce58f709f
559 changed files with 35205 additions and 66104 deletions
+34 -68
View File
@@ -51,30 +51,23 @@
;; definition for function progress-allowed?
(defun progress-allowed? ()
(with-pp
(not (or (-> *setting-control* current talking)
(-> *setting-control* current movie)
(movie?)
(handle->process (-> *game-info* pov-camera-handle))
(handle->process (-> *game-info* other-camera-handle))
(< (-> *display* base-frame-counter) (-> *game-info* letterbox-time))
(< (-> *display* base-frame-counter) (-> *game-info* blackout-time))
(!= (-> *setting-control* current bg-a) 0.0)
(!= (-> *setting-control* current bg-a-force) 0.0)
(not (-> *setting-control* current allow-progress))
(or (and (handle->process (-> *game-info* auto-save-proc))
(let ((a1-3 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-3 from) pp)
(set! (-> a1-3 num-params) 0)
(set! (-> a1-3 message) 'progress-allowed?)
(not (send-event-function (handle->process (-> *game-info* auto-save-proc)) a1-3))
)
)
(not *target*)
)
)
)
)
(not (or (-> *setting-control* current talking)
(-> *setting-control* current movie)
(movie?)
(handle->process (-> *game-info* pov-camera-handle))
(handle->process (-> *game-info* other-camera-handle))
(< (-> *display* base-frame-counter) (-> *game-info* letterbox-time))
(< (-> *display* base-frame-counter) (-> *game-info* blackout-time))
(!= (-> *setting-control* current bg-a) 0.0)
(!= (-> *setting-control* current bg-a-force) 0.0)
(not (-> *setting-control* current allow-progress))
(or (and (handle->process (-> *game-info* auto-save-proc))
(not (send-event (handle->process (-> *game-info* auto-save-proc)) 'progress-allowed?))
)
(not *target*)
)
)
)
)
;; definition for function pause-allowed?
@@ -820,18 +813,7 @@
(make-levels-with-tasks-available-to-progress)
(disable-level-text-file-loading)
(set! (-> *progress-state* starting-state) screen)
(let ((s4-0 (get-process *default-dead-pool* progress #x4000)))
(set! *progress-process*
(the-as (pointer progress) (when s4-0
(let ((t9-5 (method-of-type progress activate)))
(t9-5 (the-as progress s4-0) creator 'progress (&-> *progress-stack* 14336))
)
(run-now-in-process s4-0 progress-init-by-other)
(-> s4-0 ppointer)
)
)
)
)
(set! *progress-process* (process-spawn progress :to creator :stack (&-> *progress-stack* 14336)))
(let ((s5-1 *progress-process*))
(set! (-> s5-1 0 completion-percentage) (calculate-completion (-> s5-1 0)))
(set! *master-mode* 'progress)
@@ -1106,16 +1088,14 @@
;; failed to figure out what this is:
(defstate progress-waiting (progress)
:event
(behavior ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
:event (behavior ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(case arg2
(('go-away)
(go progress-gone)
)
)
)
:code
(behavior ()
:code (behavior ()
(loop
(when (hud-hidden?)
(dotimes (gp-0 (-> self nb-of-particles))
@@ -1135,8 +1115,7 @@
;; failed to figure out what this is:
(defstate progress-gone (progress)
:code
(behavior ()
:code (behavior ()
(clear-pending-settings-from-process *setting-control* self 'process-mask)
(copy-settings-from-target! *setting-control*)
(logior! (-> self mask) (process-mask sleep))
@@ -1960,8 +1939,7 @@
;; failed to figure out what this is:
(defstate progress-normal (progress)
:event
(behavior ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
:event (behavior ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(local-vars (v0-0 none))
(let ((v1-0 arg2))
(the-as object (cond
@@ -2120,8 +2098,7 @@
)
)
)
:code
(behavior ()
:code (behavior ()
(loop
(when (and (cpad-hold? 0 l1) (cpad-hold? 0 r1) *cheat-mode*)
(when (and (< (-> self task-index) (-> *level-task-data* (-> self display-level-index) nb-of-tasks))
@@ -2264,8 +2241,7 @@
)
(none)
)
:post
(behavior ()
:post (behavior ()
(let* ((a1-0 (-> self display-level-index))
(gp-0 (-> *level-task-data* a1-0))
)
@@ -2437,10 +2413,8 @@
;; failed to figure out what this is:
(defstate progress-coming-in (progress)
:event
(-> progress-waiting event)
:enter
(behavior ()
:event (-> progress-waiting event)
:enter (behavior ()
(sound-group-pause (the-as uint 255))
(logclear! (-> *setting-control* default process-mask) (process-mask pause menu))
(push-setting! *setting-control* self 'process-mask 'set 0.0 16)
@@ -2450,8 +2424,7 @@
(set! *pause-lock* #f)
(none)
)
:code
(behavior ()
:code (behavior ()
(loop
(seekl! (-> self in-out-position) 0 (the int (* 170.0 (-> *display* time-adjust-ratio))))
(when (< (-> self in-out-position) 2867)
@@ -2469,14 +2442,12 @@
)
(none)
)
:post
(-> progress-normal post)
:post (-> progress-normal post)
)
;; failed to figure out what this is:
(defstate progress-going-out (progress)
:enter
(behavior ()
:enter (behavior ()
(sound-play-by-name (static-sound-name "menu-close") (new-sound-id) 1024 0 0 1 #t)
(hide-progress-icons)
(set! (-> self particles 3 init-pos x) -320.0)
@@ -2488,8 +2459,7 @@
)
(none)
)
:code
(behavior ()
:code (behavior ()
(loop
(seekl!
(-> self transition-offset)
@@ -2507,22 +2477,19 @@
)
(none)
)
:post
(-> progress-normal post)
:post (-> progress-normal post)
)
;; failed to figure out what this is:
(defstate progress-debug (progress)
:event
(behavior ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
:event (behavior ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(case arg2
(('go-away)
(go progress-going-out)
)
)
)
:code
(behavior ()
:code (behavior ()
(loop
(cond
((cpad-pressed? 0 left)
@@ -2570,8 +2537,7 @@
)
(none)
)
:post
(behavior ()
:post (behavior ()
(let* ((s5-0 (-> *display* frames (-> *display* on-screen) frame global-buf))
(gp-0 (-> s5-0 base))
)