;;-*-Lisp-*-
(in-package goal)

;; name: main.gc
;; name in dgo: main
;; dgos: GAME, ENGINE

;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Letterbox and blackout
;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun set-letterbox-frames ((arg0 int))
  "Set the letterbox frame counter for arg0 frames in the future"
  (let ((v0-0 (+ (current-time) 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) (current-time))
     )
    (else
     (set! (-> *game-info* blackout-time) (max (the int (-> *game-info* blackout-time))
                                               (the int (+ (current-time) 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)
      )
  (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*)
         (logior! (-> *setting-control* default process-mask) (process-mask pause))
         )

     ;; allow the menu to run.
     (logclear! (-> *setting-control* default process-mask) (process-mask menu))

     ;; ??
     (set! *pause-lock* #f)
     (sound-group-pause (the-as uint 255))
     (hide-progress-screen)
     )
    (('menu)
     ;; I believe these masks are just to make the progress go away work.
     (logior! (-> *setting-control* default process-mask) (process-mask menu))
     (logclear! (-> *setting-control* default process-mask) (process-mask pause progress))
     (set! *pause-lock* #f)
     (hide-progress-screen)
     )
    (('progress)
     ;; allow menu to run while in progress.
     (logclear! (-> *setting-control* default process-mask) (process-mask menu))

     ;; activate the progress menu.
     (when (not *progress-process*)
       (activate-progress *dproc* (progress-screen fuel-cell))
       (if (not *progress-process*) ;; if it doesn't want to activate, back to game.
           (set-master-mode 'game)
           )
       )
     )
    (('game)
     ;; allow pausable/menu to run.
     (logclear! (-> *setting-control* default process-mask) (process-mask pause menu))
     ;; (sound-group-continue (the-as uint 255)) TODO (we need to flush sound commands)
     (hide-progress-screen)
     )
    )
  ;; 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:
           ((cpad-hold? 0 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 (cpad-hold? 0 select)
                        (cpad-hold? 0 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.
                 ((cpad-hold? 0 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.
        ((cpad-hold? 0 r3)
         *last-master-mode*
         )
        ;; select/R2 to pause.
        ((cpad-hold? 0 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
        ((cpad-hold? 0 r3)
         (if *debug-segment*
             'menu
             *master-mode*
             )
         )
        (else
         (cond
           ;; pause -> single frame advance (R2)
           ((and *cheat-mode*
                 (cpad-hold? 0 select r2)
                 )
            'game
            )
           ;; pause -> game
           ((cpad-hold? 0 start)
            'game
            )
           (else
            *master-mode*
            )
           )
         )
        )
      )
     (set! *pause-lock*
           (and *cheat-mode* (cpad-hold? 0 r2))
           )
     )
    (('progress)
     (set-master-mode
      (cond
        ;; progress -> debug
        ((cpad-hold? 0 r3)
         (if *debug-segment*
             'menu
             *master-mode*
             )
         )
        (else
         ;; un-progress
         (if (cpad-hold? 0 start)
             *last-master-mode*
             *master-mode*
             )
         )
        )
      )
     (set! *pause-lock*
           (and *cheat-mode* (cpad-hold? 0 r2))
           )
     )
    )
  0
  )

(define *screen-filter*
    (new 'static 'screen-filter
         :draw? #f
         :color (new 'static 'rgba :g #x20 :b #x40 :a #x50)
         )
  )

(defmethod draw screen-filter ((obj screen-filter))
  (with-dma-buffer-add-bucket ((buf (-> (current-frame) global-buf)) (bucket-id debug-draw1))
    (draw-sprite2d-xy buf -256 (- (-> *video-parms* screen-hy)) 512 (-> *video-parms* screen-sy) (-> obj color))
    )
  (none)
  )

;;;;;;;;;;;;;;;;;;;;;;
;; Cheat Codes
;;;;;;;;;;;;;;;;;;;;;;

(define *cheat-temp* (the-as (pointer int32) (malloc 'global 20))) ;; 16 -> 20 (PAL)
(define *master-exit* #f)
(define *progress-cheat* #f)
(define *first-boot* #t) ;; PAL

(defmacro cheats-sound-play (cheat?)
  "play the appropriate sound for inputting a cheat code"

  `(if ,cheat?
      (sound-play-by-name (static-sound-name "select-menu") (new-sound-id) 1024 0 0 1 #t)
      (sound-play-by-name (static-sound-name "cursor-options") (new-sound-id) 1024 0 0 1 #t)
      )
  )

(defun main-cheats ()
  "Handle cheat codes and timeout"

  ;; look for codes when L3 is pushed
  (when (and (cpad-hold? 0 l3)
             (or *cheat-mode* (= *kernel-boot-message* 'play)) ;; not in demo
             )

    ;; cheat mode
    (check-cheat-code (-> *cheat-temp* 0) 0
        (up up down down left right left right x x square circle square circle)
          (cpad-clear-buttons! 0 r1)
          ;; toggle!
          (not! *cheat-mode*)
          (cheats-sound-play *cheat-mode*)
        )

    ;; debug mode
    (when *cheat-mode*
      (check-cheat-code (-> *cheat-temp* 1) 0
          (circle square circle square x x right left right left down down up up)
            (cpad-clear-buttons! 0 r1)
            ;; toggle between #t and debug.
            (set! *cheat-mode* (if (= *cheat-mode* 'debug)
                                        #t
                                        'debug
                                        ))
            (cheats-sound-play *cheat-mode*)
          )
      )

    ;; language cheat
    (case (scf-get-territory)
      ;; japan-only
      ((GAME_TERRITORY_SCEI)
        (check-cheat-code (-> *cheat-temp* 2) 0
            (l1 r1 l1 r1 triangle circle x square)
              (cpad-clear-buttons! 0 r1)
              (set! *progress-cheat* (if *progress-cheat*
                                           #f
                                           'language
                                           ))
              (cheats-sound-play *progress-cheat*)
            )
       )
      )


    ;; debug only PAL cheat
    (when *debug-segment*
      (check-cheat-code (-> *cheat-temp* 3) 0
          (x square triangle circle x square triangle circle)
            (cpad-clear-buttons! 0 r1)
            (set! *progress-cheat* (if *progress-cheat*
                                         #f
                                         'pal
                                         ))
            (cheats-sound-play *progress-cheat*)
          )

      ;; added in PAL
      (check-cheat-code (-> *cheat-temp* 4) 0 ;; they erroneously used (-> *cheat-temp* 5) here!
          (triangle x circle square triangle x circle square)
            (cpad-clear-buttons! 0 r1)
            (set! *cheat-mode* (if (= *cheat-mode* 'camera)
                                        #f
                                        'camera
                                        ))
            (cond
             (*cheat-mode*
              (if (not *external-cam-mode*)
               (external-cam-reset!)
               )
              (set! *external-cam-mode* 'pad-1)
              (sound-play-by-name (static-sound-name "select-menu") (new-sound-id) 1024 0 0 1 #t)
              )
             (else
              (set! *external-cam-mode* #f)
              (sound-play-by-name (static-sound-name "cursor-options") (new-sound-id) 1024 0 0 1 #t)
              )
             )
          )
      )
    )


  ;; debug cheats on retail builds
  (when (and (= *cheat-mode* 'debug) (not *debug-segment*))

    ;; target start/stop with l1/r1/l2/r2
    (when (and (cpad-hold? 0 l1)
               (cpad-hold? 0 l2)
               (cpad-hold? 0 r1)
               (cpad-pressed? 0 r2)
               )
      (if *target*
          (stop 'debug)
          (start 'play (get-or-create-continue! *game-info*))
          )
      )


    ;; reinitialize to title-start with left, up, select
    (if (and (cpad-hold? 0 left)
             (cpad-hold? 0 up)
             (cpad-pressed? 0 select)
             )
        (initialize! *game-info* 'game (the-as game-save #f) "title-start")
        )

    ;; push R3 to print global heap status. not very useful.
    (if (cpad-pressed? 1 r3)
     (inspect global)
     )

    ;; push R3 to display IOP memory stats
    (when (cpad-hold? 1 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 (cpad-pressed? 1 triangle)
      (not! *display-level-border*)
      )
    )

  ;; handle timeouts
  (when (!= *kernel-boot-message* 'play) ;; not regular game mode?
    (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 (- (current-time) (cpad-change-time 0)))
                           (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.
        (if (make-function-process process :stack *scratch-memory-top*
              (lambda :behavior process ()
                (set-blackout-frames (seconds 100))
                (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 (current-time)))
                  (until (>= (the-as int (- (current-time) gp-0)) (seconds 0.1))
                    (suspend)
                    )
                  )
                (kernel-shutdown)
                (none)
                )
              )

            (set! *master-exit* #t) ;; process created successfully, set to exit
            )
        )
      )
    )
  0
  )


(defbehavior display-loop process ()
  "This is in progress..."

  ;; increase our stack size.
  (stack-size-set! (-> self 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 PROF
      (add-ee-profile-frame 'draw :r #x40 :b #x40)
      ;; debug hook
      (main-cheats)
      (update-camera)
      (*draw-hook*)
      (add-ee-profile-frame 'draw :g #x80)

      (*menu-hook*)
      (add-ee-profile-frame 'draw :g #x40)

      ;; (make-current-level-available-to-progress) TODO target
      ;; update-task-hints
      (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.~%" (-> (current-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 (current-time))
                   (the-as int (-> *game-info* letterbox-time))
                   )
                )
        (if (< (the-as int (-> *game-info* letterbox-time))
               (the-as int (current-time))
               )
            (set! (-> *game-info* letterbox-time) (current-time))
            )
        (if (= (-> *setting-control* current aspect-ratio) 'aspect4x3)
            (letterbox)
            )
        )

      ;; do blackout if needed.
      (if (< (the-as int (current-time))
             (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
          (with-dma-buffer-add-bucket ((debug-buf (-> disp frames (-> disp on-screen) frame debug-buf))
                                       (bucket-id debug-draw1))
            (when *display-profile*
              (dma-buffer-add-gs-set debug-buf
                      (alpha-1 (new 'static 'gs-alpha :b 1 :d 1))
                      (zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24) :zmsk 1))
                      (test-1 (new 'static 'gs-test :zte 1 :ztst (gs-ztest always)))
                      (pabe 0)
                      (clamp-1 (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
                      (tex1-1 (new 'static 'gs-tex1 :mmag 1 :mmin 1))
                      (texa (new 'static 'gs-texa :ta1 #x80))
                      (texclut (new 'static 'gs-texclut :cbw 4))
                      (fogcol *fog-color*)
                      )

              ;; 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 (static-rgba #x40 #x40 #x40 #x40))
                  (draw s1-0 debug-buf (* 10 s2-0))
                  )
                0
                )
              ) ;; end profiler draw


            (when *display-deci-count*
              (draw-string-xy (string-format "~D" *deci-count*) debug-buf 448 210 (font-color default) (font-flags shadow kerning))
              )

            ;; added
            ; (format *stdcon* "~3Lglobal heap at ~,,2fK remaining~0L~%"
            ;                   (* (1/ 1024) (&- (-> global top) (-> global current))))
            (format *stdcon* "~3Lglob: ~d free debug: ~d free~0L~%"
                    (dma-buffer-free (-> disp frames (-> disp on-screen) frame global-buf))
                    (dma-buffer-free (-> disp frames (-> disp on-screen) frame debug-buf))
                    )
            #|
            ;; added, prints some level status.
            (dotimes (i 2)
              (let ((level-heap (-> *level* level i heap)))
                (format *stdcon* "~17Llevel ~d: ~A ~A ~,,2fK remaining~0L~%"
                        i
                        (-> *level* level i name)
                        (-> *level* level i status)
                        (* (1/ 1024) (&- (-> level-heap top) (-> level-heap current)))
                        )
                )
              )
              |#

            (display-file-info)
            ) ;; end dma let
          ) ;; end debug-segment

        ;; draw pause text.
        (with-dma-buffer-add-bucket ((s3-1 (if *debug-segment*
                                               (-> disp frames (-> disp on-screen) frame debug-buf)
                                               (-> disp frames (-> disp on-screen) frame global-buf)
                                               ))
                                     (bucket-id debug-draw0))
          (if (and (= *master-mode* 'pause) (!= *cheat-mode* 'camera))
              (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)
              )
          )
        (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*))

      ;; <--------------------------- SWAP DISPLAY!
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      (swap-display disp)
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      ;; teleport stuff
      ;; perf stats
      
      (process-particles)


      ;; vif0 collide
      ;; swap sound
      ;; str play
      (level-update *level*) ;; also updates settings.
      (mc-run)
      ;; 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 process display-loop :name 'display
                                                                 :from *4k-dead-pool* :to *display-pool*)))
      (set! *dproc* (the process (ppointer->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
  )