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

;; name: lightning-h.gc
;; name in dgo: lightning-h
;; dgos: GAME

;; +++lightning-mode
(defenum lightning-mode
  :type uint8
  (lm-1 -1)
  (lm0 0)
  (lm1 1)
  (lm2 2)
  (lm3 3)
  )
;; ---lightning-mode


;; +++lightning-spec-flags
(defenum lightning-spec-flags
  :type uint16
  :bitfield #t
  (lsf0 0)
  (lsf1 1)
  (lsf2 2)
  (lsf3 3)
  (lsf4 4)
  (lsf5 5)
  (lsf6 6)
  (lsf7 7)
  (lsf8 8)
  (lsf9 9)
  (lsf10 10)
  (lsf11 11)
  (lsf12 12)
  (lsf13 13)
  (lsf14 14)
  (lsf15 15)
  )
;; ---lightning-spec-flags

(declare-type lightning-spec basic)
(define-extern *lightning-spec-id-table* (array lightning-spec))

(define-extern lightning-fractal-gen (function (inline-array vector) int int float lightning-spec none))
(define-extern lightning-uniform-gen (function (inline-array vector) int int float lightning-spec none))
(define-extern lightning-trail-uniform-gen (function (inline-array vector) (inline-array vector) float int symbol))
(define-extern lightning-trail-fractal-gen (function (inline-array vector) (inline-array vector) int int float lightning-spec none))
(define-extern process-drawable-art-error (state string process-drawable))
(define-extern unlink-lightning-spec-by-heap (function kheap none))
(define-extern lightning-draw-all (function none))

;; DECOMP BEGINS

(deftype lightning-spec (basic)
  ((name               string)
   (flags              lightning-spec-flags)
   (rand-func          uint8)
   (adjust-distance    uint8)
   (start-color        rgba)
   (end-color          rgba)
   (fade-to-color      rgba)
   (fade-start-factor  float)
   (fade-time          float)
   (texture            texture-id)
   (reduction          float)
   (num-points         int32)
   (box-size           float)
   (merge-factor       float)
   (merge-count        int32)
   (radius             float)
   (duration           float)
   (duration-rand      float)
   (sound              sound-spec)
   (delay              float)
   (delay-rand         float)
   )
  )


(defun lookup-lightning-spec-by-name ((arg0 string))
  (let* ((s5-0 *lightning-spec-id-table*)
         (s4-0 (-> s5-0 length))
         )
    (dotimes (s3-0 s4-0)
      (let ((s2-0 (-> s5-0 s3-0)))
        (if (and (nonzero? s2-0) (string= arg0 (-> s2-0 name)))
            (return s2-0)
            )
        )
      )
    )
  (the-as lightning-spec #f)
  )

(deftype lightning-state (structure)
  ((mode            uint8)
   (counter         float)
   (points-to-draw  int32)
   (box-size        float)
   (gcf-control     gcf-control  :inline)
   (line            vector-array)
   (meet            vector-array)
   (path            vector-array)
   (start-color     rgba)
   (end-color       rgba)
   )
  )


(deftype lightning-control (basic)
  ((spec     lightning-spec)
   (process  (pointer process))
   (state    lightning-state  :inline)
   )
  (:methods
    (new (symbol type lightning-spec process float) _type_)
    (change-mode (_type_ lightning-mode) lightning-mode)
    (get-mode (_type_) lightning-mode)
    (set-point! (_type_ int vector) none)
    (set-first-meet-point (_type_ vector) none)
    (set-last-meet-point (_type_ vector) none)
    )
  )


(defmethod change-mode ((this lightning-control) (arg0 lightning-mode))
  (let ((v1-1 (!= arg0 (-> this state mode))))
    (case arg0
      (((lightning-mode lm3))
       (if v1-1
           (set! (-> this state counter) 0.0)
           )
       )
      (((lightning-mode lm1))
       (set! (-> this state start-color) (-> this spec start-color))
       (set! (-> this state end-color) (-> this spec end-color))
       )
      )
    )
  (set! (-> this state mode) (the-as uint arg0))
  arg0
  )

;; WARN: Return type mismatch uint vs lightning-mode.
(defmethod get-mode ((this lightning-control))
  (the-as lightning-mode (-> this state mode))
  )

(defmethod set-point! ((this lightning-control) (arg0 int) (arg1 vector))
  (let ((v1-0 (-> this state)))
    (when (and (-> v1-0 path) (>= arg0 0) (< arg0 (-> v1-0 path length)))
      (vector-copy! (-> v1-0 path data arg0) arg1)
      (when (and (< (+ (-> v1-0 points-to-draw) -1) arg0) (case (-> v1-0 mode)
                                                            ((2 3)
                                                             #t
                                                             )
                                                            (else
                                                              #f
                                                              )
                                                            )
                 )
        (vector-copy! (-> v1-0 line data arg0) arg1)
        (vector-copy! (-> v1-0 meet data arg0) arg1)
        )
      )
    )
  0
  (none)
  )

;; WARN: Return type mismatch (inline-array vector) vs none.
(defmethod set-first-meet-point ((this lightning-control) (arg0 vector))
  (set! (-> this state meet data 0 quad) (-> arg0 quad))
  (none)
  )

;; WARN: Return type mismatch vector vs none.
(defmethod set-last-meet-point ((this lightning-control) (arg0 vector))
  (vector-copy! (-> this state meet data (+ (-> this state points-to-draw) -1)) arg0)
  (none)
  )

(defmethod relocate ((this lightning-control) (offset int))
  (&+! (-> this state line) offset)
  (&+! (-> this state meet) offset)
  (if (-> this state path)
      (&+! (-> this state path) offset)
      )
  (let ((v1-8 (-> this spec)))
    (if (and (>= (the-as int v1-8) (-> *kernel-context* relocating-min))
             (< (the-as int v1-8) (-> *kernel-context* relocating-max))
             )
        (&+! (-> this spec) offset)
        )
    )
  this
  )

;; WARN: Return type mismatch object vs lightning-control.
(defmethod new lightning-control ((allocation symbol) (type-to-make type) (arg0 lightning-spec) (arg1 process) (arg2 float))
  (with-pp
    (let ((gp-0 (the-as object (object-new allocation type-to-make (the-as int (-> type-to-make size))))))
      (when (zero? (the-as lightning-control gp-0))
        (go process-drawable-art-error "memory")
        (set! gp-0 0)
        (goto cfg-14)
        )
      (let ((s3-0 (-> arg0 num-points)))
        (let ((f0-0 (-> arg0 box-size)))
          (when (logtest? (-> arg0 flags) (lightning-spec-flags lsf4))
            (let ((f1-1 (fmax 1.0 (fmin 5.0 (/ arg2 (* 4096.0 (the float (-> arg0 adjust-distance))))))))
              (set! s3-0 (* s3-0 (the int f1-1)))
              (set! f0-0 (* f0-0 f1-1))
              )
            )
          (set! (-> (the-as lightning-control gp-0) state box-size) f0-0)
          )
        (set! (-> (the-as lightning-control gp-0) process) (process->ppointer arg1))
        (set! (-> (the-as lightning-control gp-0) state mode) (the-as uint 1))
        (set! (-> (the-as lightning-control gp-0) state line)
              ((method-of-type vector-array new) allocation vector-array s3-0)
              )
        (set! (-> (the-as lightning-control gp-0) state meet)
              ((method-of-type vector-array new) allocation vector-array s3-0)
              )
        (let ((v1-18 (-> arg0 rand-func)))
          (set! (-> (the-as lightning-control gp-0) state path)
                (if (or (= v1-18 2) (= v1-18 3))
                    ((method-of-type vector-array new) allocation vector-array s3-0)
                    (the-as vector-array #f)
                    )
                )
          )
        (set! (-> (the-as lightning-control gp-0) state counter) 0.0)
        (set! (-> (the-as lightning-control gp-0) state points-to-draw) s3-0)
        )
      (set! (-> (the-as lightning-control gp-0) spec) arg0)
      (set! (-> (the-as lightning-control gp-0) state start-color) (-> arg0 start-color))
      (set! (-> (the-as lightning-control gp-0) state end-color) (-> arg0 end-color))
      (add-connection *lightning-engine* pp nothing (the-as lightning-control gp-0) #f #f)
      (label cfg-14)
      (the-as lightning-control gp-0)
      )
    )
  )

(deftype lightning-probe-vars (basic)
  ((src-joint-index  uint32)
   (next-spawn-time  time-frame)
   (last-valid-time  time-frame)
   (point            vector  2 :inline)
   (start-pos        vector  :inline :overlay-at (-> point 0))
   (end-pos          vector  :inline :overlay-at (-> point 1))
   (probe-dirs       (inline-array vector))
   )
  )


(define *lightning-probe-vars*
  (new 'static 'lightning-probe-vars :probe-dirs (new 'static 'inline-array vector 6
                                                   (new 'static 'vector :z 1.0 :w 1.0)
                                                   (new 'static 'vector :x 1.0 :w 1.0)
                                                   (new 'static 'vector :z -1.0 :w 1.0)
                                                   (new 'static 'vector :x -1.0 :w 1.0)
                                                   (new 'static 'vector :y 1.0 :w 1.0)
                                                   (new 'static 'vector :y -1.0 :w 1.0)
                                                   )
                                     )
  )
