jak-project/goal_src/pc/subtitle.gc

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

#|

  Code for subtitles for the PC port. A PC actor pool is provided, and the subtitle process lives there.
  It automatically detects the currently playing cutscene and plays the subtitles for it on channel 0.
  Channel 1 and 2 are reserved for ambient sounds, which cannot be auto-detected, so the ambient-control needs to
  notify the subtitle process manually (TODO: verify this!)
  
  Similarly to the generic text file, only one subtitles text file is loaded at once, stored in a specific
  heap.
  
  In Jak 2, the subtitles are stored directly within the .STR files. We don't have that luxury here, unfortunately.

 |#


(#when PC_PORT


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defconstant PC_SUBTITLE_FILE_SIZE (* 64 1024))
(defconstant PC_SUBTITLE_FILE_NAME "subtit")
(defglobalconstant PC_SUBTITLE_DEBUG #f)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; types and enums
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;------------------------
;;  data
;;;------------------------

;; enum for the subtitle channels, no more than 2 bytes!
(defenum pc-subtitle-channel
  :type int16
  (invalid -1) (movie 0) (ambient 1) (hint 2))


;; information about a single line of subtitles
(deftype subtitle-keyframe (structure)
  (
   (frame  int32)      ;; the frame to play the subtitle line on
   (string string)     ;; the text for the subtitle line
   (speaker string)    ;; name of the speaker. leave blank for no speaker.
   (offscreen symbol)  ;; speaker is offscreen.
   )
  :pack-me
  )

;; an individual entry to a subtitle text making up a scene, comprised of a series of keyframes (frame+line of text)
(deftype subtitle-text (structure)
  (
   ;; the channel to play the text on, useful for lookup since it can also be used to tell subtitle types apart
   (kind  pc-subtitle-channel)
   ;; the amount of keyframes
   (length int16)
   ;; data
   (keyframes (inline-array subtitle-keyframe))
   
   ;; now we store a way to identify and lookup the subtitles.
   
   ;; the game-text-id if this is for a hint
   (id    game-text-id  :offset 8)
   ;; the name of the spool-anim
   (name  string        :offset 8)
   ;; the 8-character name for an ambient or hint
   (hash  uint64        :offset 8)
   
   
   )

  :size-assert #x10  ;; compact!
  )

;; the global subtitle text info bank
(deftype subtitle-text-info (basic)
  ((length  int32)
   (lang    pc-subtitle-lang)
   (dummy   int32)
   (data    subtitle-text :inline :dynamic)
   )
   
  (:methods
    (get-scene-by-name (_type_ pc-subtitle-channel string) subtitle-text)
    )
  )


;;;----------------------------------
;;  process type
;;;----------------------------------


;; the subtitle process! it lives on the PC actor pool and awaits for incoming subtitle messages, or a movie
(deftype subtitle (process)
  (
   (font font-context)
   (    spool-name string)
   (old-spool-name string)
   (cur-channel pc-subtitle-channel)
   )
  :heap-base #x10
  
  (:methods
    (subtitle-format (_type_ subtitle-keyframe) string)
    )
  )




;;;----------------------------------------------
;;  globals
;;;----------------------------------------------


;; the actor pool for PC processes! it has 1K of space for 1 process.
(define *pc-dead-pool* (new 'global 'dead-pool 1 (* 1 1024) '*pc-dead-pool*))
(define *subtitle-temp-string* (new 'global 'string 16 (the string #f)))
(define *subtitle* (the (pointer subtitle) #f))

;; subtitle text data
(define *subtitle-text* (the subtitle-text-info #f))
(kheap-alloc (define *subtitle-text-heap* (new 'global 'kheap)) PC_SUBTITLE_FILE_SIZE)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  loading files
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmethod get-scene-by-name subtitle-text-info ((obj subtitle-text-info) (kind pc-subtitle-channel) (name string))
  "get a subtitle scene info with the corresponding name. #f = none found"
  
  (dotimes (i (-> obj length))
    ;; name and kind matches, return that!
    (when (and (= kind (-> obj data i kind)) (string= (-> obj data i name) name))
      (return (-> obj data i))
      )
    )
  
  (the subtitle-text #f))

(defun load-subtitle-text-info ((txt-name string) (curr-text symbol) (heap kheap))
  "load a subtitles text file onto a heap.
   txt-name = language-agnostic file name
   curr-text = a symbol to a subtitle-text-info to link the file to
   heap = the text heap to load the file onto"

  (local-vars (v0-2 int) (heap-sym-heap subtitle-text-info) (lang pc-subtitle-lang) (load-status int) (heap-free int))
  (set! heap-sym-heap (the-as subtitle-text-info (-> curr-text value)))
  (set! lang (-> *pc-settings* subtitle-language))
  (set! load-status 0)
  (set! heap-free (&- (-> heap top) (the-as uint (-> heap base))))
  (when (or (= heap-sym-heap #f)
            (!= (-> heap-sym-heap lang) lang)
            )
    (kheap-reset heap)

    (while (not (str-load (string-format "~D~S.TXT" lang txt-name) -1 (logand -64 (&+ (-> heap current) 63)) (&- (-> heap top) (-> heap current))))
        (return 0)
        )

    (label retry)
    (let ((v1-20 (str-load-status (the-as (pointer int32) (& load-status)))))
      (when (= v1-20 'error)
        (format 0 "Error loading subtitle~%")
        (return 0)
        (goto loaded)
        )
      (cond
        ((>= load-status (+ heap-free -300))
         (format 0 "Game subtitle heap overrun!~%")
         (return 0)
         )
        ((= v1-20 'busy)
         (goto retry)
         )
        )
      )
    (label loaded)
    (let ((s2-1 (logand -64 (&+ (-> heap current) 63))))
        (flush-cache 0)
        (set! (-> curr-text value) (link s2-1 (-> (string-format "~D~S.TXT" lang txt-name) data) load-status heap 0))
        )
    (if (<= (the-as int (-> curr-text value)) 0)
        (set! (-> curr-text value) (the-as object #f))
        )
    )
  0)

(defun load-level-subtitle-files ((idx int))
  "If needed, load subtitles"

  ;; just load common. These flags are not yet understood.
  (if (or *level-text-file-load-flag* (>= idx 0))
      (load-subtitle-text-info PC_SUBTITLE_FILE_NAME '*subtitle-text* *subtitle-text-heap*)
      )
  (none)
  )



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  subtitle process and drawing!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmethod subtitle-format subtitle ((obj subtitle) (keyframe subtitle-keyframe))
  "check settings and format subtitle accordingly."
  
  (cond
    ((= 0 (length (-> keyframe speaker)))
     (string-format "~S" (-> keyframe string))
     )
    ((or (= #t (-> *pc-settings* subtitle-speaker?))
         (and (= 'auto (-> *pc-settings* subtitle-speaker?)) (-> keyframe offscreen)))
     (string-format "~3L~S:~0L ~S" (-> keyframe speaker) (-> keyframe string))
     )
    (else
     (string-format "~S" (-> keyframe string))
     )
    )
  
  )

(defun subtitle? ()
  "can a subtitle be displayed right now?"
  (and (-> *pc-settings* subtitles?)  ;; subtitles enabled
       (or *debug-segment* (= *master-mode* 'game))  ;; current mode is game, OR we are just debugging
       )
  )


(defstate subtitle-process (subtitle)
  
  :event (behavior ((from process) (argc int) (msg symbol) (block event-message-block))
    (case msg
      (('subtitle-start)
      0
       )
      )
    )
  :code (behavior ()
    (loop
      (suspend))
    )
  :trans (behavior ()
    (load-level-subtitle-files 0)
    ;; reset params
    (set! (-> self spool-name) #f)
    (set! (-> self cur-channel) (pc-subtitle-channel invalid))
    (none))
  :post (behavior ()
    ;; check what kind of subtitles are running
    (when (and (movie?) (-> *art-control* spool-lock) (-> *art-control* active-stream))
      ;; there's a cutscene happening and an active spool with a valid owner.
      (set! (-> self spool-name) (-> *art-control* active-stream))
      (set! (-> self cur-channel) (pc-subtitle-channel movie))
      (with-proc ((handle->process (-> *art-control* spool-lock)))
        (format *stdcon* "current spool frame is ~D~%" (the int (ja-aframe-num 0)))
        )
      )
    
    ;; do subtitles
    (case (-> self cur-channel)
      (((pc-subtitle-channel movie))
        ;; cutscenes, check if user toggled subtitles
        (if (and (= 'game *master-mode*) (cpad-pressed? 0 square))
            (not! (-> *pc-settings* subtitles?)))
        (when (subtitle?)
          ;; subtitles on! get a subtitle info that matches our current cutscene, and find at what point we're in.
          (let ((scene (get-scene-by-name *subtitle-text* (-> self cur-channel) (-> self spool-name))))
            (when scene
              ;; got a scene! get closest subtitle now.
              (let ((pos 0)
                    (keyframe (the subtitle-keyframe #f)))
                  ;; get frame num
                  (with-proc ((handle->process (-> *art-control* spool-lock)))
                    (set! pos (the int (ja-aframe-num 0)))
                    )
                  ;; find closest keyframe
                  (dotimes (i (-> scene length))
                    (when (>= pos (-> scene keyframes i frame))
                      (set! keyframe (-> scene keyframes i)))
                    )
                  (when keyframe
                    ;; we got the closest keyframe! finally just render the subtitles!
                    (print-game-text (subtitle-format self keyframe) (-> self font) #f 128 22)
                    (#when PC_SUBTITLE_DEBUG
                      (draw-debug-text-box (-> self font))
                      )
                    )
                )
              )
            )
          
          ;; keep this for later
          (set! (-> self old-spool-name) (-> self spool-name))
          )
        )
      )
    0)
  
  )



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; helper functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defmethod length subtitle-text-info ((obj subtitle-text-info))
  "Get the length (number of subtitle scenes) in a subtitle-text-info."
  (-> obj length)
  )

(defmethod length subtitle-text ((obj subtitle-text))
  "Get the length (number of subtitle lines) in a subtitle-text."
  (-> obj length)
  )



(defun subtitle-stop ()
  "kill the subtitle process"

  (kill-by-type subtitle *active-pool*)
  (set! *subtitle* (the (pointer subtitle) #f)))

(defun subtitle-start ()
  "start the subtitle process"

  (when *subtitle*
    (subtitle-stop)
    )
  
  (set! *subtitle* (make-init-process subtitle
                                    (lambda :behavior subtitle ()
                                        (set! (-> self font) (new 'process 'font-context *font-default-matrix*
                                                                  (the int (* 0.12 256)) (+ 112 (* 11 5)) 0.0
                                                                  (font-color default)
                                                                  (font-flags shadow kerning middle large)))
                                        (set-scale! (-> self font) 0.5)
                                        (set-width! (-> self font) (the int (* 0.88 256 2)))
                                        (set-height! (-> self font) (* 11 3))
                                        (go subtitle-process)
                                        )
                                    :from *pc-dead-pool* :to *active-pool*
                                    :stack-size (* 1 1024)))
  )


;; start the subtitle process
(subtitle-start)


)