jak-project/goal_src/engine/game/main.gc
2021-08-17 08:15:49 +01:00

1322 lines
46 KiB
Common Lisp

;;-*-Lisp-*-
(in-package goal)
;; name: main.gc
;; name in dgo: main
;; dgos: GAME, ENGINE
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Letterbox and blackout
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun set-letterbox-frames ((arg0 uint))
"Set the letterbox frame counter for arg0 frames in the future"
(let ((v0-0 (+ (-> *display* base-frame-counter) arg0)))
(set! (-> *game-info* letterbox-time) v0-0)
v0-0
)
)
(defun letterbox ()
"Draw the letterbox black rectangles"
(with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf))
(bucket-id debug-draw1)) ;; debug-draw1 is one of the last buckets
;; draw the two sprites
(draw-sprite2d-xy dma-buf 0 0 512 25 (new 'static 'rgba :a #x80))
(draw-sprite2d-xy dma-buf 0 199 512 26 (new 'static 'rgba :a #x80))
)
(none)
)
(defun set-blackout-frames ((arg0 int))
"Set the blackout frame counter. If arg0 is 0, disables blackout immediately.
Otherwise, this can only be used to increase the blackout period."
(cond
((zero? arg0)
(set! (-> *game-info* blackout-time) (-> *display* base-frame-counter))
)
(else
(set! (-> *game-info* blackout-time) (max (the int (-> *game-info* blackout-time))
(the int (+ (-> *display* base-frame-counter) arg0))))
)
)
)
(defun blackout ()
"Draw the blackout rectangle, convering the entire screen in darkness."
(with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf))
(bucket-id debug-draw1)) ;; debug-draw1 is one of the last buckets
(draw-sprite2d-xy dma-buf 0 0 512 224 (new 'static 'rgba :a #x80))
)
(none)
)
;;;;;;;;;;;;;;;;;;;;;
;; Pause/Master Mode
;;;;;;;;;;;;;;;;;;;;;
(defun paused? ()
"Are we paused? True if *master-mode* = pause, progress is not hidden, or *master-mode* = menu"
(the-as symbol
(or (= *master-mode* 'pause)
(or (and *progress-process* (not (hidden? (-> *progress-process* 0))))
(= *master-mode* 'menu)
)
)
)
)
(defun movie? ()
"Are we in a movie?"
(logtest? (-> *kernel-context* prevent-from-run) (process-mask movie))
)
(defun set-master-mode ((new-mode symbol))
"Update pause masks for the given mode, and set *master-mode*"
(set! *master-mode* new-mode)
;;(if *debug-segment*
;;(menu-respond-to-pause) TODO
;; )
(case *master-mode*
(('pause)
;; request the pause mask to be set in prevent-from-run.
;; this will block any process with pause from running, pausing most game objects.
(if (not *debug-pause*)
(set! (-> *setting-control* default process-mask)
(logior (-> *setting-control* default process-mask) (process-mask pause))
)
)
;; allow the menu to run.
(set! (-> *setting-control* default process-mask)
(logand (lognot (process-mask menu))
(-> *setting-control* default process-mask)
)
)
;; ??
(set! *pause-lock* #f)
(sound-group-pause (the-as uint 255))
;;(hide-progress-screen) TODO
)
(('menu)
;; I believe these masks are just to make the progress go away work.
(set! (-> *setting-control* default process-mask)
(logior (-> *setting-control* default process-mask) (process-mask menu))
)
(set! (-> *setting-control* default process-mask)
(logand (lognot (process-mask pause progress))
(-> *setting-control* default process-mask)
)
)
(set! *pause-lock* #f)
;;(hide-progress-screen) TODO
)
(('progress)
;; allow menu to run while in progress.
(set! (-> *setting-control* default process-mask)
(logand
(lognot (process-mask menu))
(-> *setting-control* default process-mask)
)
)
;; activate the progress menu.
(when (not *progress-process*)
(activate-progress *dproc* 0)
(if (not *progress-process*) ;; if it doesn't want to activate, back to game.
(set-master-mode 'game)
)
)
)
(('game)
;; allow pausable/menu to run.
(set! (-> *setting-control* default process-mask)
(logand (lognot (process-mask pause menu))
(-> *setting-control* default process-mask)
)
)
;; (sound-group-continue (the-as uint 255)) TODO (we need to flush sound commands)
;;(hide-progress-screen) TODO
)
)
;; apply settings now.
(copy-settings-from-target! *setting-control*)
0
(none)
)
(define *last-master-mode* 'game)
(defun toggle-pause ()
"Do pause/menu/progress transitions"
(case *master-mode*
(('game)
;; coming from normal gameplay
(set! *last-master-mode* *master-mode*)
(set-master-mode
(cond
;; first, check if the controller fell out, and jak is spawned
((and (nonzero? (logand (-> *cpad-list* cpads 0 valid) 128)) *target*)
(if (or *progress-process*
(not (-> *setting-control* current allow-pause))
)
*master-mode*
'pause ;; no controller, jak spawned, no progress open, pause allowed.
)
)
(else
(cond
;; try to open the debug menu:
((nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r3)))
;; R3 pushed, no target.
(if *debug-segment*
'menu ;; go to debug menu, when in debug mode.
*master-mode*
)
)
(else
(cond
;; debug mode pause allowed with select or R2.
((and (or (nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons select)))
(nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r2)))
)
*debug-segment*
)
;; pushing select or R2, and debug. allow pause.
'pause
)
(else
(cond
;; ignore anything below here, unless we are pressing start, or debug.
((and (not *debug-segment*)
(zero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons start)))
)
*master-mode*
)
;; if you pressed start, and progress isn't allowed, but pause is, do a pause.
((not (progress-allowed?))
(if (pause-allowed?)
'pause
*master-mode*
)
)
;; pushing start.
((nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons start)))
;; toggle between progress/game
(if *progress-process*
'game
'progress
)
)
(else
;; nothing requested, stay in game.
*master-mode*
)
)
)
)
)
)
)
)
)
)
(('menu)
;; in debug menu
(set-master-mode
(cond
;; push R3 to exit to previous master mode.
((nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r3)))
*last-master-mode*
)
;; select/R2 to pause.
((nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons select r2)))
(if *debug-segment*
'pause
*master-mode* ;; not sure we can get to menu in non-debug...
)
)
(else
(cond
((and (not (movie?)) (not *progress-process*))
(if (not *target*)
'pause
'progress
)
)
(else
'game
)
)
)
)
)
(set! *pause-lock*
(and *cheat-mode*
(nonzero?
(logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r2))
)
)
)
)
(('pause)
(set! *last-master-mode* *master-mode*)
(set-master-mode
(cond
;; pause -> debug menu
((nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r3)))
(if *debug-segment*
'menu
*master-mode*
)
)
(else
(cond
;; pause -> single frame advance (R2)
((and *cheat-mode*
(nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons select r2)))
)
'game
)
;; pause -> game
((nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons start)))
'game
)
(else
*master-mode*
)
)
)
)
)
(set! *pause-lock*
(and *cheat-mode* (nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r2))))
)
)
(('progress)
(set-master-mode
(cond
;; progress -> debug
((nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r3)))
(if *debug-segment*
'menu
*master-mode*
)
)
(else
;; un-progress
(if (nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons start)))
*last-master-mode*
*master-mode*
)
)
)
)
(set! *pause-lock*
(and *cheat-mode* (nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r2))))
)
)
)
0
)
(define *screen-filter*
(new 'static 'screen-filter
:draw? #f
:color (new 'static 'rgba :g #x20 :b #x40 :a #x50)
)
)
;;;;;;;;;;;;;;;;;;;;;;
;; Cheat Codes
;;;;;;;;;;;;;;;;;;;;;;
(define *cheat-temp* (the-as (pointer int32) (malloc 'global 16)))
(define *master-exit* #f)
(define *progress-cheat* #f)
(defun main-cheats ()
"Handle cheat codes and timeout"
;; look for codes when L3 is pushed
(when (and (nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons l3)))
(or *cheat-mode* (= *kernel-boot-message* 'play)) ;; not in demo
)
(when (nonzero? (-> *cpad-list* cpads 0 button0-rel 0))
(let ((cheatmode-state (-> *cheat-temp* 0)))
(cond
((zero? cheatmode-state)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons up)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 1)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons up)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 2)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons down)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 3)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons down)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 4)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons left)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 5)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons right)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 6)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons left)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 7)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons right)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 8)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 9)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 10)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 11)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 12)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square)))
(set! (-> *cheat-temp* 0) (+ (-> *cheat-temp* 0) 1))
)
(else (set! (-> *cheat-temp* 0) 0))
)
)
((= cheatmode-state 13)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle)))
;; got the code!
;; not sure what this does, but prevents you from having r1 pressed on entry.
(set! (-> *cpad-list* cpads 0 button0-abs 0)
(logand (lognot (pad-buttons r1)) (-> *cpad-list* cpads 0 button0-abs 0))
)
(set! (-> *cpad-list* cpads 0 button0-rel 0)
(logand (lognot (pad-buttons r1)) (-> *cpad-list* cpads 0 button0-rel 0))
)
;; toggle!
(set! *cheat-mode* (not *cheat-mode*))
(if *cheat-mode*
(sound-play-by-name (static-sound-name "select-menu") (new-sound-id) 1024 0 0 (the-as uint 1) (the-as vector #t))
(sound-play-by-name (static-sound-name "cursor-options") (new-sound-id) 1024 0 0 (the-as uint 1) (the-as vector #t))
)
(set! (-> *cheat-temp* 0) 0)
)
(else
;; bad code, reset.
(set! (-> *cheat-temp* 0) 0)
)
)
)
)
)
)
;; cheat mode, part 2
(when *cheat-mode*
(when (nonzero? (-> *cpad-list* cpads 0 button0-rel 0))
(let ((cheatmode-debug-state (-> *cheat-temp* 1)))
(cond
((zero? cheatmode-debug-state)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 1)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 2)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 3)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 4)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 5)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 6)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons right)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 7)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons left)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 8)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons right)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 9)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons left)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 10)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons down)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 11)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons down)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 12)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons up)))
(set! (-> *cheat-temp* 1) (+ (-> *cheat-temp* 1) 1))
)
(else (set! (-> *cheat-temp* 1) 0))
)
)
((= cheatmode-debug-state 13)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons up)))
;; got the code!
(set! (-> *cpad-list* cpads 0 button0-abs 0)
(logand (lognot (pad-buttons r1)) (-> *cpad-list* cpads 0 button0-abs 0))
)
(set! (-> *cpad-list* cpads 0 button0-rel 0)
(logand (lognot (pad-buttons r1)) (-> *cpad-list* cpads 0 button0-rel 0))
)
;; toggle between #t and debug.
(set! *cheat-mode*
(if (= *cheat-mode* 'debug)
#t
'debug
)
)
(if *cheat-mode*
(sound-play-by-name (static-sound-name "select-menu") (new-sound-id) 1024 0 0 (the-as uint 1) (the-as vector #t))
(sound-play-by-name (static-sound-name "cursor-options") (new-sound-id) 1024 0 0 (the-as uint 1) (the-as vector #t))
)
(set! (-> *cheat-temp* 1) 0)
0
)
(else
(set! (-> *cheat-temp* 1) 0)
0
)
)
)
)
)
)
)
;; language cheat
(case (scf-get-territory)
((2)
(when (nonzero? (-> *cpad-list* cpads 0 button0-rel 0))
(let ((cheat-language-state (-> *cheat-temp* 2)))
(cond
((zero? cheat-language-state)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons l1)))
(set! (-> *cheat-temp* 2) (+ (-> *cheat-temp* 2) 1))
)
(else (set! (-> *cheat-temp* 2) 0))
)
)
((= cheat-language-state 1)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons r1)))
(set! (-> *cheat-temp* 2) (+ (-> *cheat-temp* 2) 1))
)
(else (set! (-> *cheat-temp* 2) 0))
)
)
((= cheat-language-state 2)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons l1)))
(set! (-> *cheat-temp* 2) (+ (-> *cheat-temp* 2) 1))
)
(else (set! (-> *cheat-temp* 2) 0))
)
)
((= cheat-language-state 3)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons r1)))
(set! (-> *cheat-temp* 2) (+ (-> *cheat-temp* 2) 1))
)
(else (set! (-> *cheat-temp* 2) 0))
)
)
((= cheat-language-state 4)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons triangle)))
(set! (-> *cheat-temp* 2) (+ (-> *cheat-temp* 2) 1))
)
(else (set! (-> *cheat-temp* 2) 0))
)
)
((= cheat-language-state 5)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle)))
(set! (-> *cheat-temp* 2) (+ (-> *cheat-temp* 2) 1))
)
(else (set! (-> *cheat-temp* 2) 0))
)
)
((= cheat-language-state 6)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x)))
(set! (-> *cheat-temp* 2) (+ (-> *cheat-temp* 2) 1))
)
(else (set! (-> *cheat-temp* 2) 0))
)
)
((= cheat-language-state 7)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square)))
;; got it!
(set! (-> *cpad-list* cpads 0 button0-abs 0)
(logand (lognot (pad-buttons r1)) (-> *cpad-list* cpads 0 button0-abs 0))
)
(set! (-> *cpad-list* cpads 0 button0-rel 0)
(logand (lognot (pad-buttons r1)) (-> *cpad-list* cpads 0 button0-rel 0))
)
(set! *progress-cheat* (if *progress-cheat*
#f
'language
)
)
(if *progress-cheat*
(sound-play-by-name (static-sound-name "select-menu") (new-sound-id) 1024 0 0 (the-as uint 1) (the-as vector #t))
(sound-play-by-name (static-sound-name "cursor-options") (new-sound-id) 1024 0 0 (the-as uint 1) (the-as vector #t))
)
(set! (-> *cheat-temp* 2) 0)
)
(else
;; invalid code.
(set! (-> *cheat-temp* 2) 0)
)
)
)
)
)
)
)
)
;; debug only PAL code
(when *debug-segment*
(when (nonzero? (-> *cpad-list* cpads 0 button0-rel 0))
(let ((cheat-pal-state (-> *cheat-temp* 3)))
(cond
((zero? cheat-pal-state)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x)))
(set! (-> *cheat-temp* 3) (+ (-> *cheat-temp* 3) 1))
)
(else (set! (-> *cheat-temp* 3) 0))
)
)
((= cheat-pal-state 1)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square)))
(set! (-> *cheat-temp* 3) (+ (-> *cheat-temp* 3) 1))
)
(else (set! (-> *cheat-temp* 3) 0))
)
)
((= cheat-pal-state 2)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons triangle)))
(set! (-> *cheat-temp* 3) (+ (-> *cheat-temp* 3) 1))
)
(else (set! (-> *cheat-temp* 3) 0))
)
)
((= cheat-pal-state 3)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle)))
(set! (-> *cheat-temp* 3) (+ (-> *cheat-temp* 3) 1))
)
(else (set! (-> *cheat-temp* 3) 0))
)
)
((= cheat-pal-state 4)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons x)))
(set! (-> *cheat-temp* 3) (+ (-> *cheat-temp* 3) 1))
)
(else (set! (-> *cheat-temp* 3) 0))
)
)
((= cheat-pal-state 5)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square)))
(set! (-> *cheat-temp* 3) (+ (-> *cheat-temp* 3) 1))
)
(else (set! (-> *cheat-temp* 3) 0))
)
)
((= cheat-pal-state 6)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons triangle)))
(set! (-> *cheat-temp* 3) (+ (-> *cheat-temp* 3) 1))
)
(else (set! (-> *cheat-temp* 3) 0))
)
)
((= cheat-pal-state 7)
(cond
((nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons circle)))
(set! (-> *cpad-list* cpads 0 button0-abs 0)
(logand (lognot (pad-buttons r1)) (-> *cpad-list* cpads 0 button0-abs 0))
)
(set! (-> *cpad-list* cpads 0 button0-rel 0)
(logand (lognot (pad-buttons r1)) (-> *cpad-list* cpads 0 button0-rel 0))
)
(set! *progress-cheat*
(if *progress-cheat*
#f
'pal
)
)
(if *progress-cheat*
(sound-play-by-name (static-sound-name "select-menu") (new-sound-id) 1024 0 0 (the-as uint 1) (the-as vector #t))
(sound-play-by-name (static-sound-name "cursor-options") (new-sound-id) 1024 0 0 (the-as uint 1) (the-as vector #t))
)
(set! (-> *cheat-temp* 3) 0)
)
(else
;; bad code.
(set! (-> *cheat-temp* 3) 0)
0
)
)
)
)
)
)
)
)
;; if cheating, handle the inputs
(when (and (= *cheat-mode* 'debug) (not *debug-segment*))
;; target start/stop with l1/r1/l2/r2
(when (and (nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons l1)))
(nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons l2)))
(nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons r1)))
(nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons r2)))
)
(if *target*
(stop 'debug)
(start 'play (get-or-create-continue! *game-info*))
)
)
;; reinitialize to title-start with left, up, select
(if (and (nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons left)))
(nonzero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons up)))
(nonzero? (logand (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons select)))
)
(initialize! *game-info* 'game (the-as game-save #f) "title-start")
)
;; push R3 to print global heap status. not very useful.
(if (nonzero? (logand (-> *cpad-list* cpads 1 button0-rel 0) (pad-buttons r3)))
(inspect global)
)
;; push R3 to display IOP memory stats
(when (nonzero? (logand (-> *cpad-list* cpads 1 button0-abs 0) (pad-buttons r3)))
;; grab a dma buffer
(with-dma-buffer-add-bucket ((dma-buff (if *debug-segment*
(-> (current-frame) debug-buf)
(-> (current-frame) global-buf)
))
(bucket-id debug-draw0))
(show-iop-memory dma-buff)
)
)
;; push triangle to see level info
(if (nonzero? (logand (-> *cpad-list* cpads 1 button0-rel 0) (pad-buttons triangle)))
(set! *display-level-border* (not *display-level-border*))
)
)
;; handle timeouts
(when (!= *kernel-boot-message* 'play)
(let ((timeout (scf-get-timeout))
(inactive-timeout (scf-get-inactive-timeout))
)
(when (and (or
;; aboslute timout elapsed.
(and (nonzero? timeout)
(>= (the-as int (+ -300000 (the-as int (-> *display* real-frame-counter)))) (the int (* 300.0 (the float timeout))))
)
(and (nonzero? inactive-timeout)
(>= (the-as int (-
(-> *display* base-frame-counter)
(-> *cpad-list* cpads 0 change-time)
)
)
(the int (* 300.0 (the float inactive-timeout)))
)
)
(= *master-exit* 'force)
)
(progress-allowed?)
(!= *master-exit* #t)
)
;; spawn a process that blacks out the screen, turns things off, and kills the game.
(let ((game-end-proc (get-process *default-dead-pool* process #x4000)))
(if (when game-end-proc
(let ((t9-28 (method-of-type process activate)))
(t9-28
game-end-proc
*default-pool*
'process
(the-as pointer #x70004000)
)
)
((the-as (function cpu-thread function none) set-to-run)
(-> game-end-proc main-thread)
(lambda ()
(set-blackout-frames #x7530)
(set! (-> *setting-control* default allow-pause) #f)
(set! (-> *setting-control* default allow-progress) #f)
(copy-settings-from-target! *setting-control*)
(set! (-> *setting-control* default sfx-volume) 0.0)
(set! (-> *setting-control* default music-volume) 0.0)
(set! (-> *setting-control* default dialog-volume) 0.0)
(set! (-> *setting-control* default ambient-volume) 0.0)
(let ((gp-0 (-> *display* base-frame-counter)))
(until (begin
(suspend)
(>= (the-as int (- (-> *display* base-frame-counter) gp-0)) 30)
)
(empty)
)
)
(kernel-shutdown)
(none)
)
)
(-> game-end-proc ppointer)
)
;; failed to create process, just die.
(set! *master-exit* #t)
)
)
)
)
)
0
)
(defun display-loop ()
"This is in progress..."
;; increase our stack size.
(with-pp
(stack-size-set! (-> pp main-thread) 512)
)
(let ((disp *display*))
;; todo spad terrain context
(set! *teleport* #t)
(update-per-frame-settings! *setting-control*)
;;(init-time-of-day-context *time-of-day-context*) TODO
(display-sync disp)
(swap-display disp)
;; touching list
;; bler init
;; collide dma
(suspend)
(while *run*
;; blerc
;; texscroll
;; ripple
;; music pick
;; sound/flava
;; do ambients
;; math engine.
;; debug hook
;; main cheats
;; update-camera
;; draw hook
;; menu hook
(add-ee-profile-frame 'draw :g #x40)
;; make-current-level-availabe-to-progress
;; update-task-hitns
(load-level-text-files -1)
(add-ee-profile-frame 'unknown-cpu-time)
;; collect perf stats
(read! (-> *perf-stats* data (perf-stat-bucket all-code)))
(when (nonzero? (sync-path 0 0))
(*dma-timeout-hook*)
(reset-vif1-path)
(if *debug-segment*
(format
0
"profile bar at ~D.~%"
(->
*display*
frames
(-> *display* on-screen)
frame
profile-bar
1
profile-frame-count
)
)
)
)
(reset! (-> *perf-stats* data (perf-stat-bucket all-code)))
;; depth cue
;; screen filter
;; run letterbox if needed
(when (or (movie?)
(< (the-as int (-> *display* base-frame-counter))
(the-as int (-> *game-info* letterbox-time))
)
)
(if (< (the-as int (-> *game-info* letterbox-time))
(the-as int (-> *display* base-frame-counter))
)
(set! (-> *game-info* letterbox-time) (-> *display* base-frame-counter))
)
(if (= (-> *setting-control* current aspect-ratio) 'aspect4x3)
(letterbox)
)
)
;; do blackout if needed.
(if (< (the-as int (-> *display* base-frame-counter))
(the-as int (-> *game-info* blackout-time))
)
(set! (-> *setting-control* default bg-a-force) 1.0)
(set! (-> *setting-control* default bg-a-force) 0.0)
)
(read! (-> *perf-stats* data (perf-stat-bucket all-code)))
;; grab a buffer for drawing debug stuff.
;; we might draw even outside of debug mode if cheat-mode is disabled.
(let ((debug-txt-buf
(-> (if *debug-segment*
(-> disp frames (-> disp on-screen) frame debug-buf)
(-> disp frames (-> disp on-screen) frame global-buf)
)
base
)
)
)
;; debug drawing
(when *debug-segment*
(debug-draw-buffers) ;; lines/text
;; debug dma
(let* ((debug-buf (-> disp frames (-> disp on-screen) frame debug-buf))
(s4-3 (-> debug-buf base))
)
(when *display-profile*
(let* ((v1-172 debug-buf)
(a0-77 (the-as object (-> v1-172 base)))
)
(set! (-> (the-as dma-packet a0-77) dma) (new 'static 'dma-tag :qwc #xa :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet a0-77) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet a0-77) vif1) (new 'static 'vif-tag :imm #xa :cmd (vif-cmd direct) :msk #x1))
(set! (-> v1-172 base) (&+ (the-as pointer a0-77) 16))
)
(let* ((v1-173 debug-buf)
(a0-79 (the-as object (-> v1-173 base)))
)
(set! (-> (the-as gs-gif-tag a0-79) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x9))
(set! (-> (the-as gs-gif-tag a0-79) regs)
(new 'static 'gif-tag-regs
:regs0 (gif-reg-id a+d)
:regs1 (gif-reg-id a+d)
:regs2 (gif-reg-id a+d)
:regs3 (gif-reg-id a+d)
:regs4 (gif-reg-id a+d)
:regs5 (gif-reg-id a+d)
:regs6 (gif-reg-id a+d)
:regs7 (gif-reg-id a+d)
:regs8 (gif-reg-id a+d)
:regs9 (gif-reg-id a+d)
:regs10 (gif-reg-id a+d)
:regs11 (gif-reg-id a+d)
:regs12 (gif-reg-id a+d)
:regs13 (gif-reg-id a+d)
:regs14 (gif-reg-id a+d)
:regs15 (gif-reg-id a+d)
)
)
(set! (-> v1-173 base) (&+ (the-as pointer a0-79) 16))
)
(let* ((v1-174 debug-buf)
(a0-81 (-> v1-174 base))
)
(set! (-> (the-as (pointer gs-alpha) a0-81) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
(set! (-> (the-as (pointer gs-reg64) a0-81) 1) (gs-reg64 alpha-1))
(set! (-> (the-as (pointer gs-zbuf) a0-81) 2) (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24) :zmsk #x1))
(set! (-> (the-as (pointer gs-reg64) a0-81) 3) (gs-reg64 zbuf-1))
(set! (-> (the-as (pointer gs-test) a0-81) 4) (new 'static 'gs-test :zte #x1 :ztst (gs-ztest always)))
(set! (-> (the-as (pointer gs-reg64) a0-81) 5) (gs-reg64 test-1))
(set! (-> (the-as (pointer uint64) a0-81) 6) (the-as uint 0))
(set! (-> (the-as (pointer gs-reg64) a0-81) 7) (gs-reg64 pabe))
(set! (-> (the-as (pointer gs-clamp) a0-81) 8)
(new 'static 'gs-clamp
:wms (gs-tex-wrap-mode clamp)
:wmt (gs-tex-wrap-mode clamp)
)
)
(set! (-> (the-as (pointer gs-reg64) a0-81) 9) (gs-reg64 clamp-1))
(set! (-> (the-as (pointer gs-tex1) a0-81) 10)
(new 'static 'gs-tex1 :mmag #x1 :mmin #x1)
)
(set! (-> (the-as (pointer gs-reg64) a0-81) 11) (gs-reg64 tex1-1))
(set! (-> (the-as (pointer gs-texa) a0-81) 12)
(new 'static 'gs-texa :ta1 #x80)
)
(set! (-> (the-as (pointer gs-reg64) a0-81) 13) (gs-reg64 texa))
(set! (-> (the-as (pointer gs-texclut) a0-81) 14)
(new 'static 'gs-texclut :cbw #x4)
)
(set! (-> (the-as (pointer gs-reg64) a0-81) 15) (gs-reg64 texclut))
(set! (-> (the-as (pointer gs-fogcol) a0-81) 16)
(the-as gs-fogcol *fog-color*)
)
(set! (-> (the-as (pointer gs-reg64) a0-81) 17) (gs-reg64 fogcol))
(set! (-> v1-174 base) (&+ a0-81 144))
)
;; draw the profile bars
(dotimes (s2-0 2)
(let ((s1-0 (-> disp frames (-> disp on-screen) frame profile-bar s2-0)))
(add-end-frame
s1-0
'end-draw
(new 'static 'rgba :r #x40 :g #x40 :b #x40 :a #x40)
)
(draw s1-0 debug-buf (* 10 s2-0))
)
0
)
) ;; end profiler draw
(when *display-deci-count*
(let ((s2-1 draw-string-xy))
(format (clear *temp-string*) "~D" *deci-count*)
(s2-1 *temp-string* debug-buf 448 210 (font-color default) (font-flags shadow kerning))
)
)
(display-file-info)
;; add it all to debug-draw1
(let ((a3-6 (-> debug-buf base)))
(let ((v1-188 (the-as object (-> debug-buf base))))
(set! (-> (the-as dma-packet v1-188) dma)
(new 'static 'dma-tag :id (dma-tag-id next))
)
(set! (-> (the-as dma-packet v1-188) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-188) vif1) (new 'static 'vif-tag))
(set! (-> debug-buf base) (&+ (the-as pointer v1-188) 16))
)
(dma-bucket-insert-tag
(-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug-draw1)
s4-3
(the-as (pointer dma-tag) a3-6)
)
)
) ;; end dma let
) ;; end debug-segment
;; draw pause text.
(let* ((s3-1 (if *debug-segment*
(-> disp frames (-> disp on-screen) frame debug-buf)
(-> disp frames (-> disp on-screen) frame global-buf)
)
)
(s4-4 (-> s3-1 base))
)
(if (= *master-mode* 'pause)
(draw-string-xy
(lookup-text! *common-text* (game-text-id pause) #f)
s3-1 256 160 (font-color orange-red) (font-flags shadow kerning middle large))
)
;; draw console text on screen
(let ((a3-8 (the int (draw-string *stdcon0* s3-1 *font-context*))))
(draw-string-xy *stdcon1*
s3-1
(the int (-> *font-context* origin x))
a3-8
(font-color default)
(font-flags shadow kerning)
)
)
;; draw misc info
(if *display-iop-info*
(show-iop-info s3-1)
)
(if *display-memcard-info*
(show-mc-info s3-1)
)
;; draw to debug0
(let ((a3-9 (-> s3-1 base)))
(let ((v1-215 (the-as object (-> s3-1 base))))
(set! (-> (the-as dma-packet v1-215) dma)
(new 'static 'dma-tag :id (dma-tag-id next))
)
(set! (-> (the-as dma-packet v1-215) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-215) vif1) (new 'static 'vif-tag))
(set! (-> s3-1 base) (&+ (the-as pointer v1-215) 16))
)
(dma-bucket-insert-tag
(-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug-draw0)
s4-4
(the-as (pointer dma-tag) a3-9)
)
)
)
(let ((v1-220 *dma-mem-usage*))
(when (nonzero? v1-220)
(set! (-> v1-220 length) (max 85 (-> v1-220 length)))
(set! (-> v1-220 data 84 name) "debug")
(+! (-> v1-220 data 84 count) 1)
(+! (-> v1-220 data 84 used)
(&- (-> (if *debug-segment*
(-> disp frames (-> disp on-screen) frame debug-buf)
(-> disp frames (-> disp on-screen) frame global-buf)
)
base
)
(the-as uint debug-txt-buf)
)
)
(set! (-> v1-220 data 84 total) (-> v1-220 data 84 used))
)
)
)
;; console buffers
(set! *stdcon* (clear *stdcon0*))
;; here it is:
(swap-display disp)
;; swap display
;; particles
;; vif0 collid
;; swap sound
;; str play
;; level update
;; run mc
;; auto save check
;; suspend
(suspend)
)
)
0
)
(defun on ((release-mode symbol))
"Turn the game on."
(when (not *dproc*)
(unless release-mode
(if (= (-> *level* level0 status) 'inactive)
(bg 'halfpipe)
)
)
(set! *run* #t)
(let ((new-dproc (make-function-process *4k-dead-pool* *display-pool* process display-loop :name 'display)))
(set! *dproc* (the process (as-process new-dproc)))
)
(cond
((or (level-get-with-status *level* 'loaded)
(level-get-with-status *level* 'alive)
(level-get-with-status *level* 'active)
)
(activate-levels! *level*)
(when (not release-mode)
(let ((entity-cam (entity-by-type camera-start)))
(if (and entity-cam (type-type? (-> entity-cam type) entity-actor))
(camera-teleport-to-entity entity-cam)
)
)
)
)
(else
(kill-by-name 'display *active-pool*)
(set! *dproc* #f)
)
)
*dproc*
)
)
(defun off ()
"Turn the game off."
;; stop the game and set the mode to debug
(stop 'debug)
;; deactivate the levels
(dotimes (i (-> *level* length))
(let ((lev (-> *level* level i)))
(if (= (-> lev status) 'active)
(deactivate lev)
)
)
)
(set! *run* #f)
0
)
;; TODO - for credits
(define-extern scf-get-territory (function int))