mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-08-07 10:16:45 -04:00
Code Issues Packages Projects Releases Wiki Activity
Files
dfb75fc594b19bdfd0f38437e96e3c3c21e34bec
jak-project/goal_src/jak1/engine/ui/progress/progress.gc
T
water111 dfb75fc594 improve macro detection
2026-07-28 12:00:35 -07:00

1604 lines
92 KiB
Common Lisp
Raw Blame History

;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/ui/progress/progress-draw.gc")
(require "engine/ui/progress/progress-part.gc")
;; DECOMP BEGINS
(deftype progress-global-state (basic)
((aspect-ratio-choice symbol)
(video-mode-choice symbol)
(yes-no-choice symbol)
(which int32)
(starting-state progress-screen)
(last-slot-saved int32)
(slider-backup float)
(language-backup language-enum)
(on-off-backup symbol)
(center-x-backup int32)
(center-y-backup int32)
(aspect-ratio-backup symbol)
(last-slider-sound time-frame)))
(define *progress-state* (new 'static 'progress-global-state :yes-no-choice #f :which -1 :last-slot-saved -1))
(defun get-game-count ((level-index int))
"Return the collectable-count record for level-index."
(-> *game-counts* data level-index))
(defun progress-allowed? ()
"Return true when gameplay is in a state that permits opening the progress screen. Reject
movies, cameras, fades, letterbox or blackout transitions, autosave vetoes, a missing target,
and camera-cheat control."
(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))
(< (current-time) (-> *game-info* letterbox-time))
(< (current-time) (-> *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*)
(= *cheat-mode* 'camera)))))
(defun pause-allowed? ()
"Return true when gameplay permits pausing. Reject blackouts, background fades, an explicit
pause lock, an active autosave process, and a missing target."
(not (or (< (current-time) (-> *game-info* blackout-time))
(!= (-> *setting-control* current bg-a) 0.0)
(!= (-> *setting-control* current bg-a-force) 0.0)
(not (-> *setting-control* current allow-pause))
(handle->process (-> *game-info* auto-save-proc))
(not *target*))))
(defun init-game-options ((this progress))
"Build the progress-screen option-table mapping for the current build, territory, boot mode,
and title entry point, then connect each option to the setting value it edits."
;; start off by making them all invalid
(dotimes (i (progress-screen max))
(set! (-> *options-remap* i) #f))
;; main menu
(set! (-> *options-remap* (progress-screen settings))
(let ((boot-mode *kernel-boot-message*))
(case boot-mode
(('demo)
;; game demo
*main-options-demo*)
(('demo-shared)
;; game demo with external launcher
*main-options-demo-shared*)
(else
;; normal game
*main-options*))))
(set! (-> *options-remap* (progress-screen game-settings))
(cond
((!= *kernel-boot-message* 'play) (if (= (scf-get-territory) GAME_TERRITORY_SCEE) *game-options* *game-options-demo*))
((and (= (scf-get-territory) GAME_TERRITORY_SCEI)
(not (and (= *progress-cheat* 'language) (cpad-hold? 0 l2) (cpad-hold? 0 r2))))
;; if ntsc-j and we're not using language cheat (and holding l2+r2)
*game-options-japan*)
(else *game-options*)))
(set! (-> *options-remap* (progress-screen graphic-settings))
(if (and (= (-> *progress-state* starting-state) (progress-screen title))
(or (= (scf-get-territory) GAME_TERRITORY_SCEE) (and (= *progress-cheat* 'pal) (cpad-hold? 0 l2) (cpad-hold? 0 r2))))
;; (only if we came from title) if PAL or we're using the PAL cheat (and holding l2+r2)
*graphic-title-options-pal*
*graphic-options*))
(set! (-> *options-remap* (progress-screen sound-settings)) *sound-options*)
(set! (-> *options-remap* (progress-screen memcard-no-space)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-not-inserted)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-not-formatted)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-format)) *yes-no-options*)
(set! (-> *options-remap* (progress-screen memcard-data-exists)) *yes-no-options*)
(set! (-> *options-remap* (progress-screen memcard-insert)) *ok-options*)
(set! (-> *options-remap* (progress-screen load-game)) *load-options*)
(set! (-> *options-remap* (progress-screen save-game)) *save-options*)
(set! (-> *options-remap* (progress-screen save-game-title)) *save-options-title*)
(set! (-> *options-remap* (progress-screen memcard-error-loading)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-error-saving)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-error-formatting)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-error-creating)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-auto-save-error)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-removed)) *ok-options*)
(set! (-> *options-remap* (progress-screen memcard-no-data)) *yes-no-options*)
(set! (-> *options-remap* (progress-screen title)) *title*)
(set! (-> *options-remap* (progress-screen settings-title)) *options*)
(set! (-> *options-remap* (progress-screen auto-save)) *ok-options*)
(set! (-> *options-remap* (progress-screen pal-change-to-60hz)) *yes-no-options*)
(set! (-> *options-remap* (progress-screen pal-now-60hz)) *yes-no-options*)
(set! (-> *options-remap* (progress-screen no-disc)) *ok-options*)
(set! (-> *options-remap* (progress-screen bad-disc)) *ok-options*)
(set! (-> *options-remap* (progress-screen quit)) *yes-no-options*)
(set! (-> *progress-state* aspect-ratio-choice) (get-aspect-ratio))
(set! (-> *progress-state* video-mode-choice) (get-video-mode))
(set! (-> *progress-state* yes-no-choice) #f)
(set! (-> *game-options* 0 value-to-modify) (&-> *setting-control* default vibration))
(set! (-> *game-options* 1 value-to-modify) (&-> *setting-control* default play-hints))
(set! (-> *game-options* 2 value-to-modify) (&-> *setting-control* default language))
(set! (-> *game-options-japan* 0 value-to-modify) (&-> *setting-control* default vibration))
(set! (-> *game-options-japan* 1 value-to-modify) (&-> *setting-control* default play-hints))
(set! (-> *game-options-demo* 0 value-to-modify) (&-> *setting-control* default vibration))
(set! (-> *game-options-demo* 1 value-to-modify) (&-> *setting-control* default play-hints))
(set! (-> *graphic-options* 1 value-to-modify) (&-> *progress-state* aspect-ratio-choice))
(set! (-> *graphic-title-options-pal* 1 value-to-modify) (&-> *progress-state* video-mode-choice))
(set! (-> *graphic-title-options-pal* 2 value-to-modify) (&-> *progress-state* aspect-ratio-choice))
(set! (-> *sound-options* 0 value-to-modify) (&-> *setting-control* default sfx-volume))
(set! (-> *sound-options* 1 value-to-modify) (&-> *setting-control* default music-volume))
(set! (-> *sound-options* 2 value-to-modify) (&-> *setting-control* default dialog-volume))
(set! (-> *yes-no-options* 0 value-to-modify) (&-> *progress-state* yes-no-choice))
(none))
(defun make-current-level-available-to-progress ()
"Open the target's current border level in the progress screen when its remap index is valid.
Normal play opens any such level; demos only open Misty Island."
(when (and *target* (-> *level* border?))
(let* ((current-level (-> *target* current-level))
(level-index (+ (-> current-level info index) -1)))
(if (and (>= level-index 0)
(< level-index (-> *level-task-data-remap* length))
(zero? (-> *game-info* level-opened (-> *level-task-data-remap* level-index)))
(or (= *kernel-boot-message* 'play) (= (-> current-level nickname) 'mis)))
(set! (-> *game-info* level-opened (-> *level-task-data-remap* level-index)) (the-as uint 1)))))
0
(none))
(defun make-levels-with-tasks-available-to-progress ()
"Expose progress-screen entries from known tasks. Demos open Misty Island and cheat mode opens
each outer level. In normal play the shipped code reads and writes level-opened at the inner
task index, not the outer level index, when a non-scout-fly task becomes known."
;; go through EVERY LEVEL'S TASKS
(dotimes (level-index (length *level-task-data*))
;; level tasks
(let ((level-tasks (-> *level-task-data* level-index)))
;; unless there's no tasks or the level is already open...
(unless (or (= level-tasks #f) (= (-> *game-info* level-opened level-index) 1))
(cond
((!= *kernel-boot-message* 'play)
(if (= (-> level-tasks level-name-id) (text-id misty-level-name))
(set! (-> *game-info* level-opened level-index) (the-as uint 1))))
(*cheat-mode* (set! (-> *game-info* level-opened level-index) (the-as uint 1)))
(else
(dotimes (task-index (-> level-tasks nb-of-tasks))
(if (and (zero? (-> *game-info* level-opened task-index))
(!= task-index (-> level-tasks buzzer-task-index))
(task-known? (-> level-tasks task-info task-index task-id)))
(set! (-> *game-info* level-opened task-index) (the-as uint 1)))))))))
0
(none))
(defun get-next-task-up ((current-task-index int) (level-index int))
"Return the next known task after current-task-index in level-index, or the original index when
no later task is available. Cheat mode makes every task selectable."
(let ((result-task-index current-task-index))
(let ((candidate-task-index (+ current-task-index 1))
(level-tasks (-> *level-task-data* level-index)))
(while (and (< candidate-task-index (-> level-tasks nb-of-tasks)) (= result-task-index current-task-index))
(if (or *cheat-mode* (task-known? (-> level-tasks task-info candidate-task-index task-id)))
(set! result-task-index candidate-task-index))
(+! candidate-task-index 1)))
result-task-index))
(defun get-next-task-down ((current-task-index int) (level-index int))
"Return the previous known task before current-task-index in level-index, or the original index
when no earlier task is available. Cheat mode makes every task selectable."
(let ((result-task-index current-task-index))
(let ((candidate-task-index (+ current-task-index -1))
(level-tasks (-> *level-task-data* level-index)))
(while (and (>= candidate-task-index 0) (= result-task-index current-task-index))
(if (or *cheat-mode* (task-known? (-> level-tasks task-info candidate-task-index task-id)))
(set! result-task-index candidate-task-index))
(+! candidate-task-index -1)))
result-task-index))
(defun get-next-level-up ((level-index int))
"Return the next opened level after level-index, or the original index when none is available."
(let ((result-level-index level-index))
(let ((candidate-level-index (+ level-index 1)))
(while (and (< candidate-level-index (length *level-task-data*)) (= result-level-index level-index))
(if (= (-> *game-info* level-opened candidate-level-index) 1) (set! result-level-index candidate-level-index))
(+! candidate-level-index 1)))
result-level-index))
(defun get-next-level-down ((level-index int))
"Return the previous opened level before level-index, or the original index when none is
available."
(let ((result-level-index level-index))
(let ((candidate-level-index (+ level-index -1)))
(while (and (>= candidate-level-index 0) (= result-level-index level-index))
(if (= (-> *game-info* level-opened candidate-level-index) 1) (set! result-level-index candidate-level-index))
(+! candidate-level-index -1)))
result-level-index))
(defun calculate-completion ((the-progress progress))
"Calculate whole-game completion as 80 percent power cells, 10 percent precursor orbs, and
10 percent scout flies. When progress is nonfalse, also store each available total there."
(let ((current-cells 0)
(current-buzzers 0)
(current-orbs 0)
(total-cells 0)
(total-buzzers 0)
(total-orbs 0))
(dotimes (level-index (length *level-task-data*))
(let ((level-tasks (-> *level-task-data* level-index)))
(when (!= level-tasks #f)
(when (or (= *kernel-boot-message* 'play) (= (-> level-tasks level-name-id) (text-id misty-level-name)))
(dotimes (task-index (-> level-tasks nb-of-tasks))
(if (= (get-task-status (-> level-tasks task-info task-index task-id)) (task-status invalid)) (1+! current-cells)))
(set! total-cells (+ total-cells (-> level-tasks nb-of-tasks)))
(set! current-orbs (+ current-orbs (-> *game-info* money-per-level level-index)))
(set! total-orbs (+ total-orbs (-> *game-counts* data level-index money-count)))
(let ((buzzer-task-index (-> level-tasks buzzer-task-index)))
(when (!= buzzer-task-index -1)
(set! current-buzzers
(+ current-buzzers (buzzer-count *game-info* (-> level-tasks task-info buzzer-task-index task-id))))
(set! total-buzzers (+ total-buzzers (-> *game-counts* data level-index buzzer-count)))))))))
(when the-progress
(set! (-> the-progress total-nb-of-power-cells) total-cells)
(set! (-> the-progress total-nb-of-buzzers) total-buzzers)
(set! (-> the-progress total-nb-of-orbs) total-orbs))
(+ (/ (* 80.0 (the float current-cells)) (the float total-cells))
(/ (* 10.0 (the float current-orbs)) (the float total-orbs))
(/ (* 10.0 (the float current-buzzers)) (the float total-buzzers)))))
(define *progress-save-info* (new 'global 'mc-slot-info))
;; og:preserve-this
(defmacro progress-make-icon (this &key skel &key x &key y &key z &key scale-x &key scale-y)
`(when (< (-> ,this nb-of-icons) 6)
(let ((icon-idx (-> ,this nb-of-icons)))
(set! (-> ,this icons icon-idx) (new 'static 'hud-icon))
(let ((new-manipy (manipy-spawn (new 'static 'vector :w 1.0) #f ,skel #f :to ,this :stack *scratch-memory-top*)))
(when new-manipy
(set! (-> (-> new-manipy) draw dma-add-func) dma-add-process-drawable-hud)
(set-vector! (-> (-> new-manipy) root trans) 0.0 0.0 0.0 1.0)
(set-vector! (-> (-> new-manipy) root scale) ,scale-x ,scale-y ,scale-x 1.0)
(when #f
(send-event (ppointer->process new-manipy) 'trans-hook #f)))
(set! (-> ,this icons icon-idx icon) new-manipy)
(when new-manipy
(logior! (-> new-manipy 0 mask) (process-mask pause))
(logclear! (-> new-manipy 0 mask) (process-mask menu progress))
(set! (-> (-> new-manipy) root trans z) ,z)
(set! (-> ,this icons icon-idx icon-x) ,x)
(set! (-> ,this icons icon-idx icon-y) ,y)
(set! (-> ,this icons icon-idx icon-z) 0)
(set! (-> ,this icons icon-idx scale-x) ,scale-x)
(set! (-> ,this icons icon-idx scale-y) ,scale-y))))
(+! (-> ,this nb-of-icons) 1)))
(defmethod initialize-icons ((this progress))
"Create four power-cell and two precursor-orb model icons, assign their authored screen
positions and scales, and offset the power-cell animation frames."
(progress-make-icon this :skel *fuelcell-naked-sg* :x 256 :y 77 :z (meters 0.5) :scale-x 0.006 :scale-y 0.006)
(progress-make-icon this :skel *fuelcell-naked-sg* :x 256 :y 77 :z (meters 0.5) :scale-x 0.006 :scale-y 0.006)
(progress-make-icon this :skel *fuelcell-naked-sg* :x 256 :y 77 :z (meters 0.5) :scale-x 0.006 :scale-y 0.006)
(progress-make-icon this :skel *fuelcell-naked-sg* :x 256 :y 77 :z (meters 0.5) :scale-x 0.006 :scale-y 0.006)
(progress-make-icon this :skel *money-sg* :x -320 :y 253 :z (meters 17) :scale-x 0.013 :scale-y -0.015)
(progress-make-icon this :skel *money-sg* :x -320 :y 253 :z (meters 0.25) :scale-x 0.008 :scale-y -0.009)
(send-event (ppointer->process (-> this icons 1 icon)) 'set-frame-num 2.5)
(send-event (ppointer->process (-> this icons 2 icon)) 'set-frame-num 10.0)
(send-event (ppointer->process (-> this icons 3 icon)) 'set-frame-num 15.5)
0
(none))
(defmethod enter! ((this progress) (screen progress-screen) (option int))
"Enter screen at option. Reset the screen's selection state and transition speed, then
start any create, load, save, or format operation associated with the new screen."
(when (!= (-> this display-state) screen)
(set! (-> *progress-state* yes-no-choice) #f)
(set! (-> this selected-option) #f)
(set! (-> this option-index) option)
(set! (-> this last-option-index-change) (-> *display* real-frame-counter))
(set! (-> this display-state) screen)
(set! (-> this next-display-state) screen)
(set-transition-speed! this)
(case (-> this display-state)
(((progress-screen memcard-creating)) (auto-save-command 'create-file 0 0 this))
(((progress-screen memcard-loading))
(set! (-> *progress-state* last-slot-saved) (-> *progress-state* which))
(sound-volume-off)
(auto-save-command 'restore 0 (-> *progress-state* which) this))
(((progress-screen memcard-saving))
(set! (-> *progress-state* last-slot-saved) (-> *progress-state* which))
(auto-save-command 'save 0 (-> *progress-state* which) this))
(((progress-screen memcard-formatting)) (auto-save-command 'format-card 0 0 this))
(((progress-screen save-game) (progress-screen load-game))
(set! (-> this option-index) (max 0 (-> *progress-state* last-slot-saved))))
(((progress-screen memcard-removed)) (set! (-> *progress-state* last-slot-saved) 0))))
0
(none))
(defmethod push! ((this progress))
"Save the current screen and option index on the five-entry progress navigation stack.
Print an error and leave the stack unchanged when it is full."
(let ((stack-depth (-> this display-state-pos)))
(cond
((< stack-depth 5)
(set! (-> this display-state-stack stack-depth) (-> this display-state))
(set! (-> this option-index-stack stack-depth) (-> this option-index))
(set! (-> this display-state-pos) (+ stack-depth 1)))
(else (format #t "ERROR: Can't push any more states on the display-state-stack.~%"))))
0
(none))
(defmethod pop! ((this progress))
"Restore and enter the most recently saved progress screen. Return control to game mode
when the navigation stack is empty."
(let ((stack-depth (-> this display-state-pos)))
(cond
((> stack-depth 0)
(let ((previous-depth (+ stack-depth -1)))
(set! (-> this display-state-pos) previous-depth)
(enter! this (-> this display-state-stack previous-depth) (-> this option-index-stack previous-depth))))
(else (set-master-mode 'game))))
0
(none))
(defmethod set-transition-progress! ((this progress) (transition-offset int))
"Set the 0-to-512 transition offset and derive its inverse and normalized progress values."
(set! (-> this transition-offset) transition-offset)
(set! (-> this transition-offset-invert) (- 512 transition-offset))
(set! (-> this transition-percentage) (* (1/ 512) (the float transition-offset)))
(set! (-> this transition-percentage-invert) (- 1.0 (-> this transition-percentage)))
0
(none))
(defmethod set-transition-speed! ((this progress))
"Choose the screen-transition speed. Collectable and file-selection screens use the slower
value; other screens use the faster value."
(case (-> this display-state)
(((progress-screen fuel-cell)
(progress-screen money)
(progress-screen buzzer)
(progress-screen load-game)
(progress-screen save-game)
(progress-screen save-game-title))
(set! (-> this transition-speed) 15.0))
(else (set! (-> this transition-speed) 45.0)))
0
(none))
(defbehavior progress-init-by-other progress ()
"Initialize the progress process, its screen stack, particles, model icons, particle-state
slots, icon orientations, aspect ratios, and initial waiting state."
(logclear! (-> self mask) (process-mask menu progress))
(set! (-> self nb-of-particles) 0)
(set! (-> self max-nb-of-particles) 40)
(set! (-> self nb-of-icons) 0)
(set! (-> self in-out-position) 4096)
(set! (-> self current-debug-string) 0)
(set! (-> self current-debug-group) 0)
(set! (-> self display-level-index) 0)
(set! (-> self next-level-index) 0)
(set! (-> self option-index) 0)
(set! (-> self selected-option) #f)
(set! (-> self card-info) #f)
(set! (-> self last-option-index-change) (-> *display* real-frame-counter))
(set! (-> self display-state-pos) 0)
(set! (-> self in-transition) #f)
(set! (-> self force-transition) #f)
(set! (-> self stat-transition) #f)
(set! (-> self level-transition) 0)
(set! (-> self left-side-x-scale) 0.0)
(set! (-> self left-side-y-scale) 0.0)
(set! (-> self right-side-x-scale) 0.0)
(set! (-> self right-side-y-scale) 0.0)
(dotimes (i 5)
(set! (-> self display-state-stack i) (progress-screen fuel-cell)))
(init-game-options self)
(initialize-icons self)
(initialize-particles self)
(set! (-> self particle-state 0) 0)
(set! (-> self particle-state 1) 0)
(set! (-> self particle-state 2) 0)
(set! (-> self particle-state 3) 0)
(set! (-> self particle-state 4) 0)
(set! (-> self particle-state 5) 0)
(set! (-> self particle-state 6) 1)
(set! (-> self particle-state 7) 1)
(set! (-> self particle-state 8) 1)
(set! (-> self particle-state 9) 1)
(set! (-> self particle-state 10) 1)
(set! (-> self particle-state 11) 1)
(set! (-> self particle-state 12) 1)
(set! (-> self particle-state 13) 1)
(set! (-> self particle-state 14) 0)
(set! (-> self particle-state 15) 0)
(set! (-> self particle-state 16) 3)
(set! (-> self particle-state 17) 0)
(set! (-> self particle-state 18) 0)
(set! (-> self particle-state 19) 0)
(set! (-> self particle-state 20) 0)
(set! (-> self particle-state 21) 0)
(set! (-> self particle-state 22) 0)
(set! (-> self particle-state 23) 0)
(set! (-> self particle-state 24) 0)
(set! (-> self particle-state 25) 0)
(set! (-> self particle-state 26) 0)
(set! (-> self particle-state 27) 0)
(set! (-> self particle-state 28) 0)
(set! (-> self particle-state 29) 0)
(set! (-> self particle-state 30) 0)
(set! (-> self particle-state 31) 0)
(let ((icon-rotation (new 'stack-no-clear 'quaternion)))
(quaternion-axis-angle! icon-rotation 0.0 1.0 0.0 16384.0)
(quaternion*! (-> self icons 0 icon 0 root quat) icon-rotation (-> self icons 0 icon 0 root quat))
(quaternion-axis-angle! icon-rotation 0.0 1.0 0.0 32768.0)
(quaternion*! (-> self icons 1 icon 0 root quat) icon-rotation (-> self icons 1 icon 0 root quat))
(quaternion-axis-angle! icon-rotation 0.0 1.0 0.0 49152.0)
(quaternion*! (-> self icons 2 icon 0 root quat) icon-rotation (-> self icons 2 icon 0 root quat))
(quaternion-axis-angle! icon-rotation 0.0 1.0 0.0 0.0)
(quaternion*! (-> self icons 3 icon 0 root quat) icon-rotation (-> self icons 3 icon 0 root quat)))
(adjust-ratios self (get-aspect-ratio) (get-video-mode))
(adjust-icons self)
(set! (-> self event-hook) (-> progress-waiting event))
(go progress-waiting)
(none))
(define *progress-stack* (the-as (pointer uint8) (malloc 'global #x3800)))
;; og:preserve-this
(defconstant *progress-stack-top* (&-> *progress-stack* #x3800))
(defun activate-progress ((creator process) (screen progress-screen))
"Open screen in the progress process. Spawn and initialize the progress process when absent;
otherwise push the current screen before starting the requested transition."
(when *target*
(cond
((not *progress-process*)
(when (progress-allowed?)
(hide-hud)
(make-levels-with-tasks-available-to-progress)
(disable-level-text-file-loading)
(set! (-> *progress-state* starting-state) screen)
;; og:preserve-this
(set! *progress-process* (process-spawn progress :to creator :stack *progress-stack-top*))
(let ((progress-ptr *progress-process*))
(set! (-> progress-ptr 0 completion-percentage) (calculate-completion (-> progress-ptr 0)))
(set! *master-mode* 'progress)
(let ((current-level (-> *target* current-level)))
(cond
((!= *kernel-boot-message* 'play) (set! (-> progress-ptr 0 display-level-index) 4))
((or (= current-level #f) (< (length *level-task-data-remap*) (-> current-level info index)))
(set! (-> progress-ptr 0 display-level-index) 0)
0)
(else (set! (-> progress-ptr 0 display-level-index) (-> *level-task-data-remap* (+ (-> current-level info index) -1))))))
(set! (-> progress-ptr 0 next-level-index) (-> progress-ptr 0 display-level-index))
(set! (-> progress-ptr 0 display-state) (progress-screen invalid))
(set-transition-progress! (-> progress-ptr 0) 512)
(set! (-> progress-ptr 0 task-index) (get-next-task-up -1 (-> progress-ptr 0 display-level-index)))))
(when *progress-process*
(enter! (-> *progress-process* 0) screen 0)
(set! (-> *progress-process* 0 card-info) #f)))
(else
(push! (-> *progress-process* 0))
(set! (-> *progress-process* 0 next-display-state) screen)
(set! (-> *progress-process* 0 card-info) #f))))
0
(none))
(defun deactivate-progress ()
"When the progress process has reached progress-gone, apply settings, free its particle
launchers, deactivate it, clear the global pointer, and reenable level text loading."
(when (and *progress-process* (= (-> *progress-process* 0 next-state name) 'progress-gone))
(apply-settings *setting-control*)
(dotimes (i (-> *progress-process* 0 nb-of-particles))
(kill-and-free-particles (-> *progress-process* 0 particles i part))
(set! (-> *progress-process* 0 particles i part matrix) -1))
(set! (-> *progress-process* 0 nb-of-particles) 0)
(deactivate (-> *progress-process* 0))
(set! *progress-process* (the-as (pointer progress) #f))
(enable-level-text-file-loading))
0
(none))
(defun hide-progress-screen ()
"Ask the active progress process to leave."
(if *progress-process* (send-event (ppointer->process *progress-process*) 'go-away))
0
(none))
(defun hide-progress-icons ()
"Move every task, collectable, memory-card, button, and save-status particle offscreen, along
with the large orb icon."
(let ((particle-index 6))
(dotimes (i 8)
(set! (-> *progress-process* 0 particles particle-index init-pos x) -320.0)
(+! particle-index 1)))
(set! (-> *progress-process* 0 particles 5 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 14 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 15 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 19 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 20 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 21 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 22 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 23 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 24 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 25 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 26 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 27 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 28 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 29 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 30 init-pos x) -320.0)
(set! (-> *progress-process* 0 particles 31 init-pos x) -320.0)
(set! (-> *progress-process* 0 icons 4 icon-x) -320)
0
(none))
(defmethod relocate ((this game-count-info) (offset int))
"Load in the game-count-info. This is a bit of a hack."
(set! *game-counts* this)
this)
(defmethod relocate ((this progress) (offset int))
"Adjust every live particle launcher pointer after the progress process heap moves, then
relocate the inherited process fields."
(dotimes (i (-> this nb-of-particles))
(when (-> this particles i part)
(if (nonzero? (-> this particles i part))
(set! (-> this particles i part)
(the-as sparticle-launch-control (&+ (the-as pointer (-> this particles i part)) offset))))))
(the-as progress ((method-of-type process relocate) this offset)))
(defmethod adjust-sprites ((this progress))
"Update the progress screen's side-panel geometry from its slide position, transform every
particle from authored screen coordinates into the active display coordinates, update
allocated sprite matrices, and submit the particles."
(let ((in-out-fraction (* (1/ METER_LENGTH) (the float (-> this in-out-position)))))
;; right position
(set! (-> this particles 2 init-pos x) (the float (+ (-> this right-x-offset) 409 (the int (* 301.5 in-out-fraction)))))
;; left position
(set! (-> this particles 1 init-pos x) (the float (+ (-> this left-x-offset) 59)))
(set! (-> this left-side-x-scale)
(meters (+ (/ (if (= (-> *pc-settings* aspect-custom-x) 16) 5.0 3.5) (-> this sides-x-scale)) (* 10.0 in-out-fraction))))
(set! (-> this left-side-y-scale) (meters (+ (-> this sides-y-scale) (* 10.0 in-out-fraction))))
(set! (-> this right-side-x-scale)
(meters (+ (/ (if (= (-> *pc-settings* aspect-custom-x) 16) 8.5 6.0) (-> this sides-x-scale)) (* 4.0 in-out-fraction))))
(set! (-> this right-side-y-scale) (meters (+ (-> this sides-y-scale) (* 4.0 in-out-fraction)))))
(dotimes (i (-> this nb-of-particles))
(set! (-> this particles i pos x) (+ -256.0 (-> this particles i init-pos x)))
(set! (-> this particles i pos y)
(* 0.5
(- (* (-> this particles i init-pos y) (-> *video-parms* relative-y-scale)) (the float (-> *video-parms* screen-sy)))))
(set! (-> this particles i pos z) (-> this particles i init-pos z))
(if (> (-> this particles i part matrix) 0)
(set-vector! (sprite-get-user-hvdf (-> this particles i part matrix))
(the float (+ (the int (-> this particles i pos x)) 2048))
(the float (+ (the int (-> this particles i pos y)) 2048))
(- (-> *math-camera* hvdf-off z) (* 1024.0 (-> this particles i pos z)))
(-> *math-camera* hvdf-off w)))
(spawn (-> this particles i part) *null-vector*))
0
(none))
(defmethod adjust-icons ((this progress))
"Apply the active display scaling and screen offsets to the two precursor-orb model icons."
(dotimes (i (-> this nb-of-icons))
(when (>= i 4)
(set-vector! (-> this icons i icon 0 root scale)
(* (-> this icons i scale-x) (-> *video-parms* relative-x-scale))
(* (-> this icons i scale-y) (-> *video-parms* relative-y-scale))
(* (-> this icons i scale-x) (-> *video-parms* relative-x-scale))
1.0)
(set! (-> this icons i icon 0 root trans x) (the float (+ (-> this icons i icon-x) -256)))
(set! (-> this icons i icon 0 root trans y)
(* (-> *video-parms* relative-y-scale)
(- (* (-> *video-parms* relative-y-scale) (the float (-> this icons i icon-y)))
(the float (-> *video-parms* screen-sy)))))))
0
(none))
(defmethod adjust-ratios ((this progress) (aspect symbol) (video-mode symbol))
"Choose side-panel, button, slot, and precursor-orb layout values for aspect and video-mode.
PAL applies additional vertical compensation after the 4:3 or 16:9 layout is selected."
(case aspect
(('aspect4x3)
(set! (-> this sides-x-scale) 1.0)
(set! (-> this sides-y-scale) 13.0)
(set! (-> this left-x-offset) 0)
(set! (-> this right-x-offset) 0)
(set! (-> this button-scale) 1.0)
(set! (-> this slot-scale) 8192.0)
(set! (-> this small-orb-y-offset) 58)
(set! (-> this icons 5 scale-x) 0.008)
(set! (-> this icons 5 scale-y) -0.009)
(set! (-> this big-orb-y-offset) 243)
(set! (-> this icons 4 scale-x) 0.013)
(set! (-> this icons 4 scale-y) -0.015))
(('aspect16x9)
(set! (-> this sides-x-scale) 1.2)
(set! (-> this sides-y-scale) 9.8)
(set! (-> this left-x-offset) -10)
(set! (-> this right-x-offset) 17)
(set! (-> this button-scale) 1.05)
(set! (-> this slot-scale) 6144.0)
(set! (-> this small-orb-y-offset) 59)
(set! (-> this icons 5 scale-x) 0.008)
(set! (-> this icons 5 scale-y) -0.0098)
(set! (-> this big-orb-y-offset) 255)
(set! (-> this icons 4 scale-x) 0.017)
(set! (-> this icons 4 scale-y) -0.0205)))
(when (= video-mode 'pal)
(set! (-> this icons 5 scale-y) (* 1.15 (-> this icons 5 scale-y)))
(set! (-> this icons 4 scale-x) (* 1.05 (-> this icons 4 scale-x)))
(set! (-> this icons 4 scale-y) (* (-> this icons 4 scale-y) (the-as float (if (= aspect 'aspect16x9) 1.18 1.15))))
(+! (-> this big-orb-y-offset) (if (= aspect 'aspect16x9) 3 2)))
0
(none))
(defmethod can-go-back? ((this progress))
"Return true when the stable progress screen may process a back command. Transitions and
active option edits block it; collectable screens are always eligible, while settings
screens also require a compatible entry screen."
(let ((current-screen (-> *progress-process* 0 display-state))
(starting-screen (-> *progress-state* starting-state)))
(and (= (-> this next-state name) 'progress-normal)
(not (-> this in-transition))
(not (-> this selected-option))
(or (= current-screen (progress-screen fuel-cell))
(= current-screen (progress-screen money))
(= current-screen (progress-screen buzzer))
(and (or (= starting-screen (progress-screen fuel-cell))
(= starting-screen (progress-screen money))
(= starting-screen (progress-screen buzzer))
(= starting-screen (progress-screen title))
(= starting-screen (progress-screen speedrun-options)))
(#if (not PC_PORT)
(or (= current-screen (progress-screen settings))
(= current-screen (progress-screen game-settings))
(= current-screen (progress-screen graphic-settings))
(= current-screen (progress-screen sound-settings))
(= current-screen (progress-screen title))
(= current-screen (progress-screen settings-title)))
(or (= current-screen (progress-screen settings))
(= current-screen (progress-screen game-settings))
(= current-screen (progress-screen graphic-settings))
(= current-screen (progress-screen sound-settings))
(= current-screen (progress-screen title))
(= current-screen (progress-screen settings-title))
(= current-screen (progress-screen camera-options))
(= current-screen (progress-screen accessibility-options))
(= current-screen (progress-screen misc-options))
(= current-screen (progress-screen game-ps2-options))
(= current-screen (progress-screen gfx-ps2-options))
(= current-screen (progress-screen resolution))
(= current-screen (progress-screen aspect-ratio))
(= current-screen (progress-screen secrets))
(= current-screen (progress-screen cheats))
(= current-screen (progress-screen checkpoint-select))
(= current-screen (progress-screen music-player))
(= current-screen (progress-screen flava-player))
(= current-screen (progress-screen monitor))
(= current-screen (progress-screen speedrun-options))
(= current-screen (progress-screen speedrun-il-options))
(= current-screen (progress-screen speedrun-cat-ext-options))
(= current-screen (progress-screen input-options))
(= current-screen (progress-screen select-controller))
(= current-screen (progress-screen controller-binds))
(= current-screen (progress-screen keyboard-binds))
(= current-screen (progress-screen mouse-binds))
(= current-screen (progress-screen controller-options))
(= current-screen (progress-screen mouse-options))
(= current-screen (progress-screen reassign-binds-options)))))))))
(defmethod visible? ((this progress))
"Return true while the progress process exists and its screen has finished sliding in."
(the-as symbol (and *progress-process* (zero? (-> *progress-process* 0 in-out-position)))))
(defmethod hidden? ((this progress))
"Return true while the progress process is absent or its screen has finished sliding out."
(or (not *progress-process*) (= (-> *progress-process* 0 in-out-position) 4096)))
(defstate progress-waiting (progress)
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('go-away) (go progress-gone))))
:code
(behavior ()
(loop
(when (hud-hidden?)
(dotimes (i (-> self nb-of-particles))
(if (= (-> self particles i part matrix) -1) (set! (-> self particles i part matrix) (sprite-allocate-user-hvdf))))
(set-setting! 'common-page 'set 0.0 1)
(suspend)
(go progress-coming-in))
(suspend))))
(defstate progress-gone (progress)
:code
(behavior ()
(remove-setting! 'process-mask)
(apply-settings *setting-control*)
(logior! (-> self mask) (process-mask sleep))
(suspend)
0))
(defmethod set-memcard-screen ((this progress) (requested-screen progress-screen))
"Resolve requested-screen against the current memory-card presence, formatting, capacity,
initialization, and autosave state. Return the appropriate file, format, insert, space,
data, or removal screen, or leave the request unchanged."
(let ((card-info (-> this card-info))
(selected-screen requested-screen))
(when card-info
(case requested-screen
(((progress-screen memcard-no-space) (progress-screen memcard-not-inserted) (progress-screen memcard-not-formatted))
(cond
((zero? (-> card-info handle)) (set! selected-screen (progress-screen memcard-not-inserted)))
((zero? (-> card-info formatted))
(cond
((or (zero? (-> this display-state-pos))
(and (!= (-> *progress-state* starting-state) 27) (nonzero? (-> *progress-state* starting-state))))
(set-master-mode 'game))
(else
(if (!= requested-screen (progress-screen memcard-not-formatted)) (set! selected-screen (progress-screen memcard-format))))))
((and (zero? (-> card-info inited)) (< (-> card-info mem-actual) (-> card-info mem-required)))
(set! selected-screen (progress-screen memcard-no-space)))
((or (zero? (-> this display-state-pos))
(and (!= (-> *progress-state* starting-state) 27) (nonzero? (-> *progress-state* starting-state))))
(set-master-mode 'game))
(else (set! selected-screen (progress-screen save-game)))))
(((progress-screen memcard-insert)) (if (= (-> card-info inited) 1) (set! selected-screen (progress-screen load-game)))))
(cond
((zero? (-> card-info handle))
(cond
((-> *setting-control* current auto-save) (set! selected-screen (progress-screen memcard-removed)))
(else
(cond
((= requested-screen (progress-screen load-game)) (set! selected-screen (progress-screen memcard-insert)))
((or (= requested-screen (progress-screen memcard-format))
(= requested-screen (progress-screen memcard-no-space))
(= requested-screen (progress-screen memcard-not-formatted))
(= requested-screen (progress-screen save-game))
(= requested-screen (progress-screen save-game-title))
(= requested-screen (progress-screen memcard-no-data))
(= requested-screen (progress-screen memcard-data-exists)))
(set! selected-screen (progress-screen memcard-not-inserted)))))))
((zero? (-> card-info formatted))
(case requested-screen
(((progress-screen load-game)) (set! selected-screen (progress-screen memcard-insert)))
(((progress-screen save-game) (progress-screen save-game-title))
(set! selected-screen (progress-screen memcard-format)))))
((zero? (-> card-info inited))
(case requested-screen
(((progress-screen save-game) (progress-screen save-game-title))
(if (>= (-> card-info mem-actual) (-> card-info mem-required))
(set! selected-screen (progress-screen memcard-no-data))
(set! selected-screen (progress-screen memcard-no-space))))
(((progress-screen load-game)) (set! selected-screen (progress-screen memcard-insert)))))))
selected-screen))
(defmethod respond-memcard ((this progress))
"Handle confirmation on memory-card, video-mode, disc, autosave, and quit screens. Select
save slots, start requested card operations, follow yes/no choices, and return to the
appropriate prior screen or game mode."
(let ((card-info (-> this card-info)))
(when (and card-info (not (-> this in-transition)))
(when (or (cpad-pressed? 0 x) (cpad-pressed? 0 circle))
(cpad-clear! 0 x)
(cpad-clear! 0 circle)
(case (-> this display-state)
(((progress-screen load-game))
(cond
((< (-> this option-index) 4)
(when (nonzero? (-> card-info file (-> this option-index) present))
(sound-play "start-options")
(set! (-> *progress-state* which) (-> this option-index))
(set! (-> this next-display-state) (progress-screen memcard-loading))))
(else (sound-play "cursor-options") (set! (-> this next-display-state) (progress-screen invalid)))))
(((progress-screen save-game) (progress-screen save-game-title))
(cond
((< (-> this option-index) 4)
(sound-play "start-options")
(set! (-> *progress-state* which) (-> this option-index))
(if (zero? (-> card-info file (-> this option-index) present))
(set! (-> this next-display-state) (progress-screen memcard-saving))
(set! (-> this next-display-state) (progress-screen memcard-data-exists))))
((and (= (-> this display-state) (progress-screen save-game-title)) (= (-> this option-index) 4))
(sound-play "starts-options")
(sound-volume-off)
(set! (-> *game-info* mode) 'play)
(initialize! *game-info* 'game (the-as game-save #f) "intro-start")
(set-master-mode 'game))
(else (sound-play "cursor-options") (set! (-> this next-display-state) (progress-screen invalid)))))
(((progress-screen memcard-insert))
(sound-play "cursor-options")
(set! (-> this next-display-state) (progress-screen invalid)))
(((progress-screen memcard-data-exists))
(cond
((-> *progress-state* yes-no-choice)
(sound-play "start-options")
(set! (-> this next-display-state) (progress-screen memcard-saving)))
(else
(sound-play "cursor-options")
(if (= (-> this display-state-stack 0) (progress-screen title))
(set! (-> this next-display-state) (progress-screen save-game-title))
(set! (-> this next-display-state) (progress-screen save-game))))))
(((progress-screen memcard-no-data))
(cond
((-> *progress-state* yes-no-choice)
(sound-play "start-options")
(set! (-> this next-display-state) (progress-screen memcard-creating)))
;; og:preserve-this PAL & NTSC-J patch here
((= (-> this display-state-stack 0) (progress-screen title))
(sound-play "cursor-options")
(sound-volume-off)
(set! (-> *game-info* mode) 'play)
(initialize! *game-info* 'game (the-as game-save #f) "intro-start")
(set-master-mode 'game))
(else (sound-play "cursor-options") (set! (-> this next-display-state) (progress-screen invalid)))))
(((progress-screen memcard-no-space) (progress-screen memcard-not-inserted) (progress-screen memcard-not-formatted))
(cond
((= (-> this display-state-stack 0) (progress-screen title))
(sound-play "start-options")
(sound-volume-off)
(set! (-> *game-info* mode) 'play)
(initialize! *game-info* 'game (the-as game-save #f) "intro-start")
(set-master-mode 'game))
((nonzero? (-> this display-state-stack 0)) (sound-play "start-options") (set-master-mode 'game))
(else (sound-play "cursor-options") (set! (-> this next-display-state) (progress-screen invalid)))))
(((progress-screen memcard-error-loading)
(progress-screen memcard-error-saving)
(progress-screen memcard-error-formatting)
(progress-screen memcard-error-creating)
(progress-screen memcard-auto-save-error)
(progress-screen memcard-removed)
(progress-screen auto-save))
(sound-play "cursor-options")
(set! (-> this next-display-state) (progress-screen invalid)))
(((progress-screen pal-change-to-60hz))
(cond
((-> *progress-state* yes-no-choice)
(sound-play "start-options")
(set! (-> *setting-control* default video-mode) (-> *progress-state* video-mode-choice))
(set! (-> this video-mode-timeout) (-> *display* real-frame-counter))
(set! (-> this next-display-state) (progress-screen pal-now-60hz)))
(else
(sound-play "cursor-options")
(set! (-> *progress-state* video-mode-choice) 'pal)
(set! (-> this next-display-state) (progress-screen invalid)))))
(((progress-screen pal-now-60hz))
(cond
((not (-> *progress-state* yes-no-choice))
(set! (-> *progress-state* video-mode-choice) 'pal)
(set! (-> *setting-control* default video-mode) (-> *progress-state* video-mode-choice))
(sound-play "cursor-options"))
(else (sound-play "start-options")))
(set! (-> this next-display-state) (progress-screen invalid)))
(((progress-screen no-disc) (progress-screen bad-disc))
(when (is-cd-in?)
(sound-play "cursor-options")
(set! (-> this next-display-state) (progress-screen invalid))))
(((progress-screen quit))
(cond
((-> *progress-state* yes-no-choice)
(sound-play "start-options")
(sound-volume-off)
(set! (-> *game-info* mode) 'play)
(initialize! *game-info* 'game (the-as game-save #f) "title-start"))
(else (sound-play "cursor-options") (set! (-> this next-display-state) (progress-screen invalid)))))
(((progress-screen memcard-format))
(cond
((-> *progress-state* yes-no-choice)
(sound-play "start-options")
(set! (-> this next-display-state) (progress-screen memcard-formatting)))
;; og:preserve-this NTSC-J patch here
((= (-> this display-state-stack 0) (progress-screen title))
(sound-play "start-options")
(sound-volume-off)
(set! (-> *game-info* mode) 'play)
(initialize! *game-info* 'game (the-as game-save #f) "intro-start")
(set-master-mode 'game))
(else (sound-play "cursor-options") (set! (-> this next-display-state) (progress-screen invalid)))))))))
0
(none))
(defmethod respond-common ((this progress))
"Handle navigation and editing for the current option table. Up and down select rows,
left and right change values, confirm enters menus or begins editing, and cancel restores
the saved value or leaves the screen."
(mc-get-slot-info 0 *progress-save-info*)
(set! (-> this card-info) *progress-save-info*)
(let ((options (-> *options-remap* (-> this display-state))))
(when (and options (not (-> this in-transition)))
(cond
((cpad-hold? 0 up)
(cond
((cpad-pressed? 0 up)
(when (not (-> this selected-option))
(if (!= (length options) 1) (sound-play "cursor-up-down"))
(set! (-> this last-option-index-change) (-> *display* real-frame-counter))
(if (> (-> this option-index) 0) (+! (-> this option-index) -1) (set! (-> this option-index) (+ (length options) -1)))))
(else
(when (-> this selected-option)
(let ((moved-up? #f))
(case (-> options (-> this option-index) option-type)
(((game-option-type center-screen))
(when (< -48 (-> *setting-control* current screeny))
(set! moved-up? #t)
(+! (-> *setting-control* default screeny) -1))))
(when moved-up?
(when (< (seconds 0.3) (- (-> *display* real-frame-counter) (-> *progress-state* last-slider-sound)))
(set! (-> *progress-state* last-slider-sound) (-> *display* real-frame-counter))
(sound-play "slider2001"))))))))
((cpad-hold? 0 down)
(cond
((cpad-pressed? 0 down)
(when (not (-> this selected-option))
(if (!= (length options) 1) (sound-play "cursor-up-down"))
(set! (-> this last-option-index-change) (-> *display* real-frame-counter))
(cond
((< (-> this option-index) (+ (length options) -1)) (+! (-> this option-index) 1))
(else (set! (-> this option-index) 0) 0))))
(else
(when (-> this selected-option)
(let ((moved-down? #f))
(case (-> options (-> this option-index) option-type)
(((game-option-type center-screen))
(when (< (-> *setting-control* current screeny) 48)
(set! moved-down? #t)
(+! (-> *setting-control* default screeny) 1))))
(when moved-down?
(when (< (seconds 0.3) (- (-> *display* real-frame-counter) (-> *progress-state* last-slider-sound)))
(set! (-> *progress-state* last-slider-sound) (-> *display* real-frame-counter))
(sound-play "slider2001"))))))))
((cpad-hold? 0 left)
(cond
((cpad-pressed? 0 left)
(when (or (-> this selected-option) (= (-> options (-> this option-index) option-type) (game-option-type yes-no)))
(let ((changed-left? #f))
(case (-> options (-> this option-index) option-type)
(((game-option-type on-off) (game-option-type yes-no))
(when (not (-> (the-as (pointer uint32) (-> options (-> this option-index) value-to-modify))))
(set! changed-left? #t)
(if (= (-> options (-> this option-index) value-to-modify) (&-> *setting-control* current vibration))
(cpad-set-buzz! (-> *cpad-list* cpads 0) 1 255 (seconds 0.3))))
(set! (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify))) #t))
(((game-option-type aspect-ratio))
(set! changed-left? (= (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) 'aspect16x9))
(set! (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) 'aspect4x3))
(((game-option-type video-mode))
(set! changed-left? (= (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) 'ntsc))
(set! (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) 'pal))
(((game-option-type language))
(if (> (the-as int (-> (the-as (pointer uint64) (-> options (-> this option-index) value-to-modify)))) 0)
(+! (-> (the-as (pointer uint64) (-> options (-> this option-index) value-to-modify))) -1)
(set! (-> (the-as (pointer int64) (-> options (-> this option-index) value-to-modify)))
(if (and (= (scf-get-territory) GAME_TERRITORY_SCEA)
(not (and (= *progress-cheat* 'language) (cpad-hold? 0 l2) (cpad-hold? 0 r2))))
4
5)))
(set! (-> this language-transition) #t)
(set! (-> this language-direction) #t)
(set! changed-left? #t)))
(if changed-left? (sound-play "cursor-l-r")))))
(else
(when (-> this selected-option)
(let ((adjusted-left? #f))
(case (-> options (-> this option-index) option-type)
(((game-option-type slider))
(cond
((>= (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify)))
(+ 1.0 (-> options (-> this option-index) param1)))
(+! (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify))) -1.0)
(set! adjusted-left? #t))
((< (-> options (-> this option-index) param1)
(-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify))))
(set! (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify)))
(-> options (-> this option-index) param1))
(set! adjusted-left? #t))))
(((game-option-type center-screen))
(when (< -96 (-> *setting-control* default screenx))
(set! adjusted-left? #t)
(+! (-> *setting-control* default screenx) -1))))
(when adjusted-left?
(let ((left-slider-volume 100.0))
(case (-> options (-> this option-index) name)
(((text-id music-volume) (text-id speech-volume))
(set! left-slider-volume (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify))))))
(when (< (seconds 0.3) (- (-> *display* real-frame-counter) (-> *progress-state* last-slider-sound)))
(set! (-> *progress-state* last-slider-sound) (-> *display* real-frame-counter))
(sound-play "slider2001" :vol left-slider-volume)))))))))
((cpad-hold? 0 right)
(cond
((cpad-pressed? 0 right)
(when (or (-> this selected-option) (= (-> options (-> this option-index) option-type) (game-option-type yes-no)))
(let ((changed-right? (the-as object #f)))
(case (-> options (-> this option-index) option-type)
(((game-option-type on-off) (game-option-type yes-no))
(set! changed-right? (-> (the-as (pointer uint32) (-> options (-> this option-index) value-to-modify))))
(set! (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) #f))
(((game-option-type aspect-ratio))
(set! changed-right? (= (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) 'aspect4x3))
(set! (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) 'aspect16x9))
(((game-option-type video-mode))
(set! changed-right? (= (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) 'pal))
(set! (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0) 'ntsc))
(((game-option-type language))
(let ((maximum-language (if (and (= (scf-get-territory) GAME_TERRITORY_SCEA)
(not (and (= *progress-cheat* 'language) (cpad-hold? 0 l2) (cpad-hold? 0 r2))))
4
5)))
(cond
((< (the-as int (-> (the-as (pointer uint64) (-> options (-> this option-index) value-to-modify)))) maximum-language)
(+! (-> (the-as (pointer uint64) (-> options (-> this option-index) value-to-modify))) 1))
(else (set! (-> (the-as (pointer int64) (-> options (-> this option-index) value-to-modify))) 0) 0)))
(set! (-> this language-transition) #t)
(set! (-> this language-direction) #f)
(set! changed-right? #t)))
(if changed-right? (sound-play "cursor-l-r")))))
(else
(when (-> this selected-option)
(let ((adjusted-right? #f))
(case (-> options (-> this option-index) option-type)
(((game-option-type slider))
(cond
((>= (+ -1.0 (-> options (-> this option-index) param2))
(-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify))))
(+! (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify))) 1.0)
(set! adjusted-right? #t))
((< (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify)))
(-> options (-> this option-index) param2))
(set! (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify)))
(-> options (-> this option-index) param2))
(set! adjusted-right? #t))))
(((game-option-type center-screen))
(when (< (-> *setting-control* default screenx) 96)
(set! adjusted-right? #t)
(+! (-> *setting-control* default screenx) 1))))
(when adjusted-right?
(let ((right-slider-volume 100.0))
(case (-> options (-> this option-index) name)
(((text-id music-volume) (text-id speech-volume))
(set! right-slider-volume (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify))))))
(when (< (seconds 0.3) (- (-> *display* real-frame-counter) (-> *progress-state* last-slider-sound)))
(set! (-> *progress-state* last-slider-sound) (-> *display* real-frame-counter))
(sound-play "slider2001" :vol right-slider-volume)))))))))
((or (cpad-pressed? 0 square) (cpad-pressed? 0 triangle))
(cond
((-> this selected-option)
(case (-> options (-> this option-index) option-type)
(((game-option-type slider))
(set! (-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify)))
(-> *progress-state* slider-backup)))
(((game-option-type language))
(set! (-> (the-as (pointer language-enum) (-> options (-> this option-index) value-to-modify)) 0)
(-> *progress-state* language-backup)))
(((game-option-type on-off))
(set! (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0)
(-> *progress-state* on-off-backup)))
(((game-option-type center-screen))
(set! (-> *setting-control* default screenx) (-> *progress-state* center-x-backup))
(set! (-> *setting-control* default screeny) (-> *progress-state* center-y-backup)))
(((game-option-type aspect-ratio) (game-option-type video-mode))
(set! (-> (the-as (pointer symbol) (-> options (-> this option-index) value-to-modify)) 0)
(-> *progress-state* aspect-ratio-backup))))
(sound-play "cursor-options")
(set! (-> this selected-option) #f))
((or (can-go-back? this)
(= (-> this display-state) (progress-screen load-game))
(= (-> this display-state) (progress-screen save-game))
(= (-> this display-state) (progress-screen save-game-title)))
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons square))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square))
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons triangle))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons triangle))
(if (= (-> this display-state) (progress-screen settings)) (sound-play "menu-stats") (sound-play "cursor-options"))
(load-level-text-files (-> *level-task-data* (-> this display-level-index) text-group-index))
(set! (-> this next-display-state) (progress-screen invalid)))))
((or (cpad-pressed? 0 x) (cpad-pressed? 0 circle))
(cond
((not (-> this selected-option))
(cond
((= (-> options (-> this option-index) option-type) (game-option-type menu))
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons x))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x))
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons circle))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle))
(push! this)
(sound-play "select-option")
(set! (-> this next-display-state) (the-as progress-screen (-> options (-> this option-index) param3)))
(case (-> this next-display-state)
(((progress-screen load-game) (progress-screen save-game) (progress-screen save-game-title))
(set! (-> this next-display-state) (set-memcard-screen this (-> this next-display-state))))))
((= (-> options (-> this option-index) option-type) (game-option-type button))
(cond
((= (-> options (-> this option-index) name) (text-id exit-demo)) (set! *master-exit* 'force) (set-master-mode 'game))
((= (-> options (-> this option-index) name) (text-id back))
(if (= (-> this display-state) (progress-screen settings)) (sound-play "menu-stats") (sound-play "cursor-options"))
(load-level-text-files (-> *level-task-data* (-> this display-level-index) text-group-index))
(set! (-> this next-display-state) (progress-screen invalid)))))
((!= (-> options (-> this option-index) option-type) (game-option-type yes-no))
(case (-> options (-> this option-index) option-type)
(((game-option-type slider))
(set! (-> *progress-state* slider-backup)
(-> (the-as (pointer float) (-> options (-> this option-index) value-to-modify)))))
(((game-option-type language))
(set! (-> *progress-state* language-backup)
(-> (the-as (pointer language-enum) (-> options (-> this option-index) value-to-modify)))))
(((game-option-type on-off))
(set! (-> *progress-state* on-off-backup)
(the-as symbol (-> (the-as (pointer uint32) (-> options (-> this option-index) value-to-modify))))))
(((game-option-type center-screen))
(set! (-> *progress-state* center-x-backup) (-> *setting-control* default screenx))
(set! (-> *progress-state* center-y-backup) (-> *setting-control* default screeny)))
(((game-option-type aspect-ratio) (game-option-type video-mode))
(set! (-> *progress-state* aspect-ratio-backup)
(the-as symbol (-> (the-as (pointer uint32) (-> options (-> this option-index) value-to-modify)))))))
(sound-play "select-option")
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons x))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x))
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons circle))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle))
(set! (-> this selected-option) #t)
(when (= (-> options (-> this option-index) option-type) (game-option-type language))
(set! (-> this language-selection) (-> *setting-control* current language))
(set! (-> this language-direction) #t)
(set! (-> this language-transition) #f)
(set! (-> this language-x-offset) 0)
0))))
(else
(sound-play "start-options")
(set! (-> this selected-option) #f)
(case (-> options (-> this option-index) option-type)
(((game-option-type aspect-ratio))
(set! (-> *setting-control* default aspect-ratio)
(the-as symbol (-> (the-as (pointer uint32) (-> options (-> this option-index) value-to-modify))))))
(((game-option-type video-mode))
(case (-> (the-as (pointer uint32) (-> options (-> this option-index) value-to-modify)))
(('pal)
(set! (-> *setting-control* default video-mode)
(the-as symbol (-> (the-as (pointer uint32) (-> options (-> this option-index) value-to-modify))))))
(('ntsc) (push! this) (set! (-> this next-display-state) (progress-screen pal-change-to-60hz)))))
(((game-option-type language))
(if (not (-> this language-transition)) (load-level-text-files (-> this display-level-index)))))))))))
0
(none))
(defmethod respond-progress ((this progress))
"Handle controls on the collectable screens: move between opened levels, select the
power-cell, precursor-orb, or scout-fly view, open settings, and select known power-cell
tasks."
(when (not (-> this in-transition))
(cond
((cpad-pressed? 0 up)
(let ((previous-level-index (-> this display-level-index)))
(set! (-> this next-level-index) (get-next-level-down previous-level-index))
(when (!= previous-level-index (-> this next-level-index))
(sound-play "cursor-up-down")
(set! (-> this level-transition) 2))))
((cpad-pressed? 0 down)
(let ((previous-level-index (-> this next-level-index)))
(set! (-> this next-level-index) (get-next-level-up previous-level-index))
(when (!= previous-level-index (-> this next-level-index))
(sound-play "cursor-up-down")
(set! (-> this level-transition) 1))))
((cpad-pressed? 0 square)
(when (nonzero? (-> this display-state))
(sound-play "select-option")
(set! (-> this next-display-state) (progress-screen fuel-cell))
(set! (-> this stat-transition) #t)))
((cpad-pressed? 0 x)
(when (!= (-> this display-state) (progress-screen money))
(sound-play "select-option")
(set! (-> this next-display-state) (progress-screen money))
(set! (-> this stat-transition) #t)))
((cpad-pressed? 0 triangle)
(when (!= (-> this display-state) (progress-screen buzzer))
(sound-play "select-option")
(set! (-> this next-display-state) (progress-screen buzzer))
(set! (-> this stat-transition) #t)))
((cpad-pressed? 0 circle)
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons circle))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle))
(sound-play "start-options")
(push! this)
(set! (-> this next-display-state) (progress-screen settings)))
((= (-> this display-state) (progress-screen fuel-cell))
(cond
((cpad-pressed? 0 left)
(let ((previous-task-index (-> this task-index)))
(set! (-> this task-index) (get-next-task-down (-> this task-index) (-> this display-level-index)))
(if (!= previous-task-index (-> this task-index)) (sound-play "cursor-l-r"))))
((cpad-pressed? 0 right)
(let ((previous-task-index (-> this task-index)))
(set! (-> this task-index) (get-next-task-up (-> this task-index) (-> this display-level-index)))
(if (!= previous-task-index (-> this task-index)) (sound-play "cursor-l-r"))))))))
0
(none))
(defstate progress-normal (progress)
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(local-vars (next-screen-value object))
(case message
(('go-away) (go progress-going-out))
(('notify)
(cond
((= (-> block param 0) 'done)
(case (-> self display-state)
(((progress-screen memcard-saving))
(cond
((= (-> self display-state-stack 0) (progress-screen title))
(let ((saved-auto-save (-> *setting-control* default auto-save)))
(sound-volume-off)
(set! (-> *game-info* mode) 'play)
(cond
;; og:preserve-this start a new game differently if speedrunning mode is active
((= (-> *pc-settings* speedrunner-mode?) #t) (speedrun-start-full-game-run))
;; start the game normally
(else
(initialize! *game-info* 'game (the-as game-save #f) "intro-start")
(set! (-> *setting-control* default auto-save) saved-auto-save))))
(set-master-mode 'game))
(else
(set! next-screen-value -1)
(set! (-> self next-display-state) (the-as progress-screen next-screen-value))
next-screen-value)))
(((progress-screen memcard-formatting))
(set! (-> self force-transition) #t)
(set! next-screen-value 15)
(set! (-> self next-display-state) (the-as progress-screen next-screen-value))
next-screen-value)
(((progress-screen memcard-creating))
(cond
((= (-> self display-state-stack 0) (progress-screen title))
(set! next-screen-value 18)
(set! (-> self next-display-state) (the-as progress-screen next-screen-value)))
(else (set! next-screen-value 17) (set! (-> self next-display-state) (the-as progress-screen next-screen-value))))
next-screen-value)))
((= (-> block param 0) 'error)
(format #t "ERROR NOTIFY: ~S ~D~%" (enum->string mc-status-code (-> block param 1)) (-> self display-state))
(case (-> block param 1)
((14)
(set! next-screen-value 7)
(set! (-> self next-display-state) (the-as progress-screen next-screen-value))
next-screen-value)
(else
(case (-> self display-state)
(((progress-screen memcard-formatting))
(set! next-screen-value 24)
(set! (-> self next-display-state) (the-as progress-screen next-screen-value))
next-screen-value)
(((progress-screen memcard-creating))
(set! next-screen-value 25)
(set! (-> self next-display-state) (the-as progress-screen next-screen-value))
next-screen-value)
(((progress-screen memcard-saving))
(set! next-screen-value 21)
(set! (-> self next-display-state) (the-as progress-screen next-screen-value))
next-screen-value)
(((progress-screen memcard-loading))
(set! next-screen-value 20)
(set! (-> self next-display-state) (the-as progress-screen next-screen-value))
next-screen-value)))))))))
: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))
(>= (-> self task-index) 0))
(let ((task-id (-> *level-task-data* (-> self display-level-index) task-info (-> self task-index) task-id)))
(close-specific-task! task-id (task-status need-resolution))
(send-event *target* 'get-pickup 6 (the float task-id)))))
(if (and (= (-> self display-state) (-> self next-display-state))
(= (-> self display-level-index) (-> self next-level-index)))
(seekl! (-> self transition-offset)
0
(* (the int (* (-> self transition-speed) (-> *display* time-adjust-ratio)))
(if (or (-> self stat-transition) (nonzero? (-> self level-transition))) 2 1)))
(seekl! (-> self transition-offset)
512
(* (the int (* (-> self transition-speed) (-> *display* time-adjust-ratio)))
(if (or (-> self stat-transition) (nonzero? (-> self level-transition))) 2 1))))
(set-transition-progress! self (-> self transition-offset))
(set! (-> self in-transition) (or (-> self force-transition) (nonzero? (-> self transition-offset))))
(when (and (not (handle->process (-> *game-info* auto-save-proc)))
(or (-> self force-transition) (-> self in-transition))
(>= (-> self transition-offset)
(if (and (zero? (-> self level-transition))
(nonzero? (-> self next-display-state))
(!= (-> self next-display-state) 1)
(!= (-> self next-display-state) 2))
512
256)))
(if (>= (the-as int (-> self next-display-state)) 0) (enter! self (-> self next-display-state) 0) (pop! self))
(set! (-> self display-level-index) (-> self next-level-index))
(when (nonzero? (-> self level-transition))
(set! (-> self task-index) (get-next-task-up -1 (-> self display-level-index)))
(case (-> self level-transition)
((1) (set! (-> self level-transition) 2))
((2) (set! (-> self level-transition) 1))))
(set! (-> self force-transition) #f))
(when (zero? (-> self transition-offset))
(set! (-> self stat-transition) #f)
(set! (-> self level-transition) 0)
0)
(let ((has-next-level? #f))
(let ((has-previous-level? #f))
(case (-> self display-state)
(((progress-screen fuel-cell) (progress-screen money) (progress-screen buzzer))
(let ((level-index (-> self display-level-index)))
(when (and (< (mod (-> *display* real-frame-counter) (seconds 0.2)) (seconds 0.1))
(zero? (-> *progress-process* 0 in-out-position))
(not (-> self in-transition))
(zero? (-> self transition-offset)))
(set! has-next-level? (!= level-index (get-next-level-up level-index)))
(set! has-previous-level? (!= level-index (get-next-level-down level-index)))))))
(set! (-> self particles 3 init-pos x)
(the float (if has-previous-level? (- 195 (-> *progress-process* 0 left-x-offset)) -320))))
(set! (-> self particles 4 init-pos x)
(the float (if has-next-level? (- 195 (-> *progress-process* 0 left-x-offset)) -320))))
(respond-common self)
(set! (-> self next-display-state) (set-memcard-screen self (-> self next-display-state)))
(let ((current-screen (-> self display-state)))
(cond
((or (= current-screen (progress-screen fuel-cell))
(or (= current-screen (progress-screen money)) (= current-screen (progress-screen buzzer))))
(respond-progress self))
((or (= current-screen (progress-screen memcard-no-space))
(= current-screen (progress-screen memcard-format))
(= current-screen (progress-screen memcard-data-exists))
(= current-screen (progress-screen memcard-insert))
(= current-screen (progress-screen load-game))
(= current-screen (progress-screen save-game))
(= current-screen (progress-screen save-game-title))
(= current-screen (progress-screen memcard-error-loading))
(= current-screen (progress-screen memcard-error-saving))
(= current-screen (progress-screen memcard-error-formatting))
(= current-screen (progress-screen memcard-error-creating))
(= current-screen (progress-screen memcard-auto-save-error))
(= current-screen (progress-screen memcard-removed))
(= current-screen (progress-screen memcard-no-data))
(= current-screen (progress-screen memcard-not-inserted))
(= current-screen (progress-screen memcard-not-formatted))
(= current-screen (progress-screen auto-save))
(= current-screen (progress-screen pal-change-to-60hz))
(= current-screen (progress-screen pal-now-60hz))
(= current-screen (progress-screen no-disc))
(= current-screen (progress-screen bad-disc))
(= current-screen (progress-screen quit)))
(respond-memcard self))))
(suspend)))
:post
(behavior ()
(let* ((level-index (-> self display-level-index))
(level-tasks (-> *level-task-data* level-index)))
#t
(let ((draw-level-title? #f))
(case (-> self display-state)
(((progress-screen fuel-cell)) (set! draw-level-title? #t) (draw-fuel-cell-screen self level-index))
(((progress-screen money)) (set! draw-level-title? #t) (draw-money-screen self level-index))
(((progress-screen buzzer)) (set! draw-level-title? #t) (draw-buzzer-screen self level-index))
(((progress-screen game-settings) (progress-screen settings))
(hide-progress-icons)
(draw-options self 115 30 (the-as float 0.82)))
(((progress-screen graphic-settings)
(progress-screen sound-settings)
(progress-screen settings-title)
(progress-screen title))
(hide-progress-icons)
(draw-options self 115 30 (the-as float 0.82)))
(((progress-screen memcard-removed) (progress-screen memcard-auto-save-error))
(draw-notice-screen self)
(draw-options self 192 0 (the-as float 0.82)))
(((progress-screen memcard-no-data)) (draw-notice-screen self) (draw-options self 165 0 (the-as float 0.82)))
(((progress-screen memcard-format)) (draw-notice-screen self) (draw-options self 172 0 (the-as float 0.82)))
(((progress-screen memcard-no-space) (progress-screen memcard-not-inserted) (progress-screen memcard-not-formatted))
(draw-notice-screen self)
(draw-options self 195 0 (the-as float 0.82)))
(((progress-screen memcard-error-loading)
(progress-screen memcard-error-saving)
(progress-screen memcard-error-formatting)
(progress-screen memcard-error-creating)
(progress-screen memcard-auto-save-error))
(draw-notice-screen self)
(draw-options self 190 0 (the-as float 0.82)))
(((progress-screen pal-change-to-60hz)) (draw-notice-screen self) (draw-options self 190 0 (the-as float 0.82)))
(((progress-screen pal-now-60hz))
(when (< (seconds 10) (- (-> *display* real-frame-counter) (-> self video-mode-timeout)))
(set! (-> *progress-state* video-mode-choice) 'pal)
(set! (-> *setting-control* default video-mode) (-> *progress-state* video-mode-choice))
(set! (-> self next-display-state) (progress-screen invalid)))
(draw-notice-screen self)
(draw-options self 140 0 (the-as float 0.82)))
(((progress-screen no-disc) (progress-screen bad-disc))
(draw-notice-screen self)
(if (is-cd-in?) (draw-options self 170 0 (the-as float 0.82))))
(((progress-screen quit)) (draw-notice-screen self) (draw-options self 110 0 (the-as float 0.82)))
(((progress-screen auto-save)) (draw-notice-screen self) (draw-options self 190 0 (the-as float 0.82)))
(((progress-screen memcard-insert)) (draw-notice-screen self) (draw-options self 165 0 (the-as float 0.82)))
(((progress-screen memcard-data-exists)) (draw-notice-screen self) (draw-options self 168 0 (the-as float 0.82)))
(((progress-screen memcard-loading)
(progress-screen memcard-saving)
(progress-screen memcard-formatting)
(progress-screen memcard-creating))
(draw-notice-screen self))
(((progress-screen load-game) (progress-screen save-game))
(draw-notice-screen self)
(draw-options self 190 0 (the-as float 0.82)))
(((progress-screen save-game-title)) (draw-notice-screen self) (draw-options self 169 15 (the-as float 0.6))))
(when draw-level-title?
(let* ((title-slide-offset (cond
((-> self stat-transition) 0)
((= (-> self level-transition) 1) (- (-> self transition-offset)))
(else (-> self transition-offset))))
(title-opacity (the-as float (if (-> self stat-transition) 1.0 (-> self transition-percentage-invert))))
(title-font (new 'stack
'font-context
*font-default-matrix*
(- 32 (-> self left-x-offset))
(the int (* (+ 42.0 (the float (/ title-slide-offset 2))) title-opacity))
(the-as float 8325000.0)
(font-color progress-blue)
(font-flags shadow kerning))))
(set-width! title-font 328)
(set-height! title-font 45)
(set-flags! title-font (font-flags shadow kerning middle middle-vert large))
(print-game-text-scaled (lookup-text! *common-text* (-> level-tasks level-name-id) #f)
title-opacity
title-font
(the int (* 128.0 title-opacity)))))))
(case (-> self display-state)
(((progress-screen fuel-cell) (progress-screen money) (progress-screen buzzer)) (draw-progress self)))
(adjust-sprites self)
(adjust-icons self)))
(defstate progress-coming-in (progress)
:event
(-> progress-waiting
event)
:enter
(behavior ()
(sound-group-pause (sound-group sfx music dialog sog3 ambient sog5 sog6 sog7))
(logclear! (-> *setting-control* default process-mask) (process-mask pause menu))
(add-setting! 'process-mask 'set 0.0 (process-mask progress))
(apply-settings *setting-control*)
(sound-play "select-menu")
(set-blackout-frames 0)
(set! *pause-lock* #f))
:code
(behavior ()
(loop
(seekl! (-> self in-out-position) 0 (the int (* 170.0 (-> *display* time-adjust-ratio))))
(when (< (-> self in-out-position) 2867)
(seekl! (-> self transition-offset) 0 (the int (* (-> self transition-speed) (-> *display* time-adjust-ratio))))
(set-transition-progress! self (-> self transition-offset)))
(if (zero? (-> self in-out-position)) (go progress-normal))
(suspend)))
:post
(-> progress-normal
post))
(defstate progress-going-out (progress)
:enter
(behavior ()
(sound-play "menu-close")
(hide-progress-icons)
(set! (-> self particles 3 init-pos x) -320.0)
(set! (-> self particles 4 init-pos x) -320.0)
(case (-> self display-state)
(((progress-screen load-game) (progress-screen save-game) (progress-screen save-game-title))
(set! (-> self transition-speed) 30.0))))
:code
(behavior ()
(loop
(seekl! (-> self transition-offset) 512 (the int (* (-> self transition-speed) (-> *display* time-adjust-ratio))))
(set-transition-progress! self (-> self transition-offset))
(when (< 153 (-> self transition-offset))
(seekl! (-> self in-out-position) 4096 (the int (* 170.0 (-> *display* time-adjust-ratio))))
(if (= (-> self in-out-position) 4096) (go progress-gone)))
(suspend)))
:post
(-> progress-normal
post))
(defstate progress-debug (progress)
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('go-away) (go progress-going-out))))
:code
(behavior ()
(loop
(cond
((cpad-pressed? 0 left) (if (> (-> self current-debug-string) 0) (+! (-> self current-debug-string) -1)))
((cpad-pressed? 0 right)
(if (< (-> self current-debug-string) (+ (-> *common-text* length) -1)) (+! (-> self current-debug-string) 1)))
((cpad-pressed? 0 up)
(when (> (-> self current-debug-group) 0)
(+! (-> self current-debug-group) -1)
(set! (-> self current-debug-string) 0)
0))
((cpad-pressed? 0 down)
(when (< (-> self current-debug-group) (+ (-> *text-group-names* length) -1))
(+! (-> self current-debug-group) 1)
(set! (-> self current-debug-string) 0)
0))
((cpad-pressed? 0 l1)
(if (> (the-as int (-> *setting-control* default language)) 0) (+! (-> *setting-control* default language) -1)))
((cpad-pressed? 0 r1)
(if (< (the-as int (-> *setting-control* default language)) 6) (+! (-> *setting-control* default language) 1)))
((cpad-pressed? 0 l2)
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons l2))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons l2))
(go progress-normal)))
(load-game-text-info (-> *text-group-names* (-> self current-debug-group)) '*common-text* *common-text-heap*)
(suspend)))
:post
(behavior ()
(with-dma-buffer-add-bucket ((header-buffer (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-header draw-string-xy))
(let ((format-header format)
(header-text (clear *temp-string*))
(header-template "TEXT DEBUG: LANGUAGE ~S ID 0x~X")
(language (-> *setting-control* current language)))
(format-header header-text
header-template
(cond
((= language (language-enum uk-english)) "uk-english")
((= language (language-enum japanese)) "japanese")
((= language (language-enum italian)) "italian")
((= language (language-enum spanish)) "spanish")
((= language (language-enum german)) "german")
((= language (language-enum french)) "french")
((= language (language-enum english)) "english")
(else "*unknown*"))
(-> *common-text* data (-> self current-debug-string) id)))
(draw-header *temp-string* header-buffer 40 40 (font-color default) (font-flags shadow kerning))))
(let* ((string-help-buffer (-> *display* frames (-> *display* on-screen) frame global-buf))
(string-help-bucket-start (-> string-help-buffer base)))
(let ((draw-string-help draw-string-xy))
(format (clear *temp-string*) "USE LEFT/RIGHT TO SELECT STRING")
(draw-string-help *temp-string* string-help-buffer 40 155 (font-color default) (font-flags shadow kerning)))
(let ((string-help-bucket-tail (-> string-help-buffer base)))
(let ((string-help-packet (the-as dma-packet (-> string-help-buffer base))))
(set! (-> string-help-packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> string-help-packet vif0) (new 'static 'vif-tag))
(set! (-> string-help-packet vif1) (new 'static 'vif-tag))
(set! (-> string-help-buffer base) (the-as pointer (the-as dma-packet (&+ string-help-packet 16)))))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
string-help-bucket-start
(the-as (pointer dma-tag) string-help-bucket-tail))))
(let* ((group-help-buffer (-> *display* frames (-> *display* on-screen) frame global-buf))
(group-help-bucket-start (-> group-help-buffer base)))
(let ((draw-group-help draw-string-xy))
(format (clear *temp-string*) "USE UP/DOWN TO SELECT GROUP")
(draw-group-help *temp-string* group-help-buffer 40 165 (font-color default) (font-flags shadow kerning)))
(let ((group-help-bucket-tail (-> group-help-buffer base)))
(let ((group-help-packet (the-as dma-packet (-> group-help-buffer base))))
(set! (-> group-help-packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> group-help-packet vif0) (new 'static 'vif-tag))
(set! (-> group-help-packet vif1) (new 'static 'vif-tag))
(set! (-> group-help-buffer base) (the-as pointer (the-as dma-packet (&+ group-help-packet 16)))))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
group-help-bucket-start
(the-as (pointer dma-tag) group-help-bucket-tail))))
(let* ((language-help-buffer (-> *display* frames (-> *display* on-screen) frame global-buf))
(language-help-bucket-start (-> language-help-buffer base)))
(let ((draw-language-help draw-string-xy))
(format (clear *temp-string*) "USE L1/R1 TO SELECT LANGUAGE")
(draw-language-help *temp-string* language-help-buffer 40 175 (font-color default) (font-flags shadow kerning)))
(let ((language-help-bucket-tail (-> language-help-buffer base)))
(let ((language-help-packet (the-as dma-packet (-> language-help-buffer base))))
(set! (-> language-help-packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> language-help-packet vif0) (new 'static 'vif-tag))
(set! (-> language-help-packet vif1) (new 'static 'vif-tag))
(set! (-> language-help-buffer base) (the-as pointer (the-as dma-packet (&+ language-help-packet 16)))))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
language-help-bucket-start
(the-as (pointer dma-tag) language-help-bucket-tail))))
(let ((font (new 'stack 'font-context *font-default-matrix* 32 50 (the-as float 0.0) (font-color default) (font-flags shadow kerning))))
(set-width! font 328)
(set-height! font 100)
(logior! (-> font flags) (font-flags shadow kerning large))
(draw-debug-text-box font)
(print-game-text (-> *common-text* data (-> self current-debug-string) text) font #f 128 22))))
Reference in New Issue View Git Blame Copy Permalink