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

;; name: load-dgo.gc
;; name in dgo: load-dgo
;; dgos: ENGINE, GAME

;; status flag sent from OVERLORD about a DGO load.
(defenum load-msg-result
  :type uint16
  :bitfield #f
  (done 0)       ;; dgo fully loaded!
  (error 1)      ;; loading failed (file not found, etc)
  (more 2)       ;; more files exist!
  (aborted 3)    ;; status returned after a request to cancel.
  (invalid 666)  ;; invalid status indicating a communication error.
  )

;; DECOMP BEGINS

(deftype load-dgo-msg (structure)
  ((rsvd     uint16)
   (result   load-msg-result)
   (b1       pointer)
   (b2       pointer)
   (bt       pointer)
   (name     uint128)
   (address  uint32  :overlay-at b1)
   )
  )


(deftype load-chunk-msg (structure)
  ((rsvd      uint16)
   (result    load-msg-result)
   (address   pointer)
   (section   uint32)
   (maxlen    uint32)
   (dummy     uint32             4)
   (basename  sound-stream-name  :inline)
   )
  )


(deftype play-chunk-msg (structure)
  ((rsvd      uint16)
   (result    uint16)
   (address   pointer)
   (section   uint32)
   (maxlen    uint32)
   (id        uint32             4)
   (basename  sound-stream-name  4 :inline)
   )
  )


(deftype dgo-header (structure)
  ((length    uint32)
   (rootname  uint8  60)
   )
  )

(define-extern *load-dgo-rpc* rpc-buffer-pair)
(when (zero? *load-dgo-rpc*)
  (define *load-dgo-rpc* (new 'global 'rpc-buffer-pair (the-as uint 32) (the-as uint 1) 3))
  (define *load-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 64) (the-as uint 1) 4))
  (define *play-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 256) (the-as uint 2) 5))
  (define *load-str-lock* #f)
  (define *que-str-lock* #f)
  (define *dgo-name* (new 'global 'string 64 (the-as string #f)))
  )

(defun str-load ((arg0 string) (arg1 int) (arg2 pointer) (arg3 int))
  (if (or (check-busy *load-str-rpc*) *load-str-lock*)
      (return #f)
      )
  (let ((s2-0 (the-as load-chunk-msg (add-element *load-str-rpc*))))
    (set! (-> s2-0 result) (load-msg-result invalid))
    (set! (-> s2-0 address) arg2)
    (set! (-> s2-0 section) (the-as uint arg1))
    (set! (-> s2-0 maxlen) (the-as uint arg3))
    (copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename)) arg0 48)
    (call *load-str-rpc* (the-as uint 0) (the-as pointer s2-0) (the-as uint 32))
    )
  (set! *load-str-lock* #t)
  (set! *que-str-lock* #t)
  #t
  )

(defun str-load-status ((arg0 (pointer int32)))
  (if (check-busy *load-str-rpc*)
      (return 'busy)
      )
  (set! *load-str-lock* #f)
  (set! *que-str-lock* #t)
  (let ((v1-7 (the-as load-chunk-msg (pop-last-received *load-str-rpc*))))
    (if (= (-> v1-7 result) (load-msg-result error))
        (return 'error)
        )
    (set! (-> arg0 0) (the-as int (-> v1-7 maxlen)))
    )
  'complete
  )

(defun str-load-cancel ()
  (set! *load-str-lock* #f)
  (set! *que-str-lock* #t)
  0
  (none)
  )

(defun str-play-async ((arg0 string) (arg1 sound-id))
  (set! *que-str-lock* #t)
  (let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
    (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) arg0 48)
    (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
    (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
    (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
    (set! (-> s4-0 id 0) (the-as uint arg1))
    (set! (-> s4-0 id 1) (the-as uint 0))
    (set! (-> s4-0 id 2) (the-as uint 0))
    (set! (-> s4-0 id 3) (the-as uint 0))
    (set! (-> s4-0 result) (the-as uint 0))
    )
  0
  0
  (none)
  )

(defun str-play-stop ((arg0 string) (arg1 sound-id))
  (set! *que-str-lock* #t)
  (let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
    (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) arg0 48)
    (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
    (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
    (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
    (set! (-> s4-0 id 0) (the-as uint arg1))
    (set! (-> s4-0 id 1) (the-as uint 0))
    (set! (-> s4-0 id 2) (the-as uint 0))
    (set! (-> s4-0 id 3) (the-as uint 0))
    (set! (-> s4-0 result) (the-as uint 1))
    )
  0
  (none)
  )

(defun str-play-queue ((arg0 string) (arg1 string) (arg2 string) (arg3 string) (arg4 (pointer uint32)) (arg5 pointer))
  (when (and (not (check-busy *play-str-rpc*)) (not *load-str-lock*) (not *que-str-lock*))
    (let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
      (if arg0
          (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) arg0 48)
          (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) "" 48)
          )
      (if arg1
          (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) arg1 48)
          (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
          )
      (if arg2
          (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) arg2 48)
          (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
          )
      (if arg3
          (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) arg3 48)
          (copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
          )
      (dotimes (v1-15 4)
        (set! (-> s4-0 id v1-15) (-> arg4 v1-15))
        )
      (set! (-> s4-0 address) arg5)
      (set! (-> s4-0 result) (the-as uint 2))
      )
    )
  (set! *que-str-lock* #f)
  0
  (none)
  )

(defun str-ambient-play ((arg0 string))
  (set! *que-str-lock* #t)
  (let ((s5-0 (the-as load-chunk-msg (add-element *play-str-rpc*))))
    (set! (-> s5-0 basename name 0) (the-as uint 36))
    (copyn-charp<-string (&-> s5-0 basename name 1) arg0 48)
    (set! (-> s5-0 result) (load-msg-result done))
    )
  0
  0
  (none)
  )

(defun str-ambient-stop ((arg0 string))
  (set! *que-str-lock* #t)
  (let ((s5-0 (the-as load-chunk-msg (add-element *play-str-rpc*))))
    (set! (-> s5-0 basename name 0) (the-as uint 36))
    (copyn-charp<-string (&-> s5-0 basename name 1) arg0 48)
    (set! (-> s5-0 result) (load-msg-result error))
    )
  0
  (none)
  )

(defun str-play-kick ()
  (cond
    ((check-busy *play-str-rpc*)
     )
    (else
      (call *play-str-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
      )
    )
  0
  (none)
  )

(define *dgo-time* (the-as time-frame 0))

(defun dgo-load-begin ((arg0 string) (arg1 pointer) (arg2 pointer) (arg3 pointer))
  (set! *dgo-time* (the-as time-frame (-> *display* real-clock integral-frame-counter)))
  (format 0 "Starting level load clock~%")
  (sync *load-dgo-rpc* #t)
  (let ((s2-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
    (set! (-> s2-0 result) (load-msg-result invalid))
    (set! (-> s2-0 b1) arg1)
    (set! (-> s2-0 b2) arg2)
    (set! (-> s2-0 bt) arg3)
    (set! (-> s2-0 name) (string->sound-name arg0))
    (call *load-dgo-rpc* (the-as uint 0) (the-as pointer s2-0) (the-as uint 32))
    s2-0
    )
  )

(defun dgo-load-get-next ((arg0 (pointer symbol)))
  (set! (-> arg0 0) #f)
  (let ((gp-0 (the-as pointer #f)))
    (when (not (check-busy *load-dgo-rpc*))
      (let ((v1-4 (the-as load-dgo-msg (pop-last-received *load-dgo-rpc*))))
        (when v1-4
          (when (or (= (-> v1-4 result) (load-msg-result done)) (= (-> v1-4 result) (load-msg-result more)))
            (set! gp-0 (-> v1-4 b1))
            (set! (-> arg0 0) #t)
            )
          (if (= (-> v1-4 result) (load-msg-result more))
              (set! (-> arg0 0) #f)
              )
          (if (= (-> v1-4 result) (load-msg-result done))
              (format
                0
                "Elapsed time for level = ~Fs~%"
                (* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) (the-as uint *dgo-time*))))
                )
              )
          )
        )
      )
    gp-0
    )
  )

(defun dgo-load-continue ((arg0 pointer) (arg1 pointer) (arg2 pointer))
  (let ((gp-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
    (set! (-> gp-0 result) (load-msg-result invalid))
    (set! (-> gp-0 b1) arg0)
    (set! (-> gp-0 b2) arg1)
    (set! (-> gp-0 bt) arg2)
    (set! (-> gp-0 name) (the-as uint128 0))
    (call *load-dgo-rpc* (the-as uint 1) (the-as pointer gp-0) (the-as uint 32))
    gp-0
    )
  )

(defun dgo-load-cancel ()
  (sync *load-dgo-rpc* #t)
  (let ((a2-0 (add-element *load-dgo-rpc*)))
    (call *load-dgo-rpc* (the-as uint 2) a2-0 (the-as uint 32))
    )
  0
  (none)
  )

(defun find-temp-buffer ((arg0 int))
  (let ((gp-0 (+ (/ arg0 16) 2)))
    (cond
      ((< (the-as uint gp-0)
          (the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
          )
       (logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
       )
      ((< (the-as uint gp-0)
          (the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
          )
       (logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
       )
      )
    )
  )

(defun dgo-load-link ((arg0 dgo-header) (arg1 kheap) (arg2 uint) (arg3 symbol) (arg4 symbol))
  (let ((s4-0 (the-as object (&+ arg0 64))))
    (let ((v1-0 arg2))
      (cond
        ((>= (the-as int (+ (the-as uint s4-0) (-> arg0 length))) (the-as int (-> arg1 top-base)))
         (format
           0
           "ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes.  This is very bad!~%"
           (-> arg0 rootname)
           arg0
           arg1
           (- (+ (the-as uint s4-0) (-> arg0 length)) (the-as uint (-> arg1 top-base)))
           )
         )
        ((and (< (the-as int arg0) (the-as int v1-0))
              (>= (the-as int (+ (the-as uint s4-0) (-> arg0 length))) (the-as int v1-0))
              )
         (format
           0
           "ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes.  This is very bad!~%"
           (-> arg0 rootname)
           arg0
           arg1
           (- (+ (the-as uint s4-0) (-> arg0 length)) v1-0)
           )
         )
        )
      )
    (if arg4
        (format
          0
          "NOTICE: loaded ~g, ~D bytes (~f K) at top ~D at #x~X~%"
          (-> arg0 rootname)
          (-> arg0 length)
          (* 0.0009765625 (the float (-> arg0 length)))
          (- (+ (the-as uint s4-0) (-> arg0 length)) (the-as uint (-> arg1 base)))
          arg0
          )
        )
    (string<-charp (clear *dgo-name*) (-> arg0 rootname))
    (nonzero? (link-begin
                (the-as pointer s4-0)
                (-> *dgo-name* data)
                (the-as int (-> arg0 length))
                arg1
                (if arg3
                    (link-flag output-load-msg output-load-true-msg execute-login print-login fast-link)
                    (link-flag output-load-msg output-load-true-msg execute-login fast-link)
                    )
                )
              )
    )
  )

(defun destroy-mem ((arg0 (pointer uint32)) (arg1 (pointer uint32)))
  (while (< (the-as int arg0) (the-as int arg1))
    (set! (-> arg0 0) (the-as uint #xffffffff))
    (set! arg0 (&-> arg0 1))
    )
  0
  (none)
  )