;;-*-Lisp-*- (in-package goal) ;; name: editable.gc ;; name in dgo: editable ;; dgos: ENGINE, GAME ;; DECOMP BEGINS ;; this file is debug only (declare-file (debug)) (defmethod new editable-region ((allocation symbol) (type-to-make type)) (let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> gp-0 changed) #t) (set! (-> gp-0 locked) #f) (let ((v1-4 (level-get-target-inside *level*))) (set! (-> gp-0 level) (the-as string (if v1-4 (-> v1-4 info dbname) ) ) ) ) (set! (-> gp-0 tree) 'camera) (set! (-> gp-0 on-enter) #f) (set! (-> gp-0 on-exit) #f) (set! (-> gp-0 on-inside) #f) (set! (-> gp-0 filter) (editable-region-method-12 gp-0)) gp-0 ) ) (defmethod print ((this editable-region)) (format #t "#<~A region-~D ~A ~A @ #x~X>" (-> this type) (-> this id) (-> this level) (-> this tree) this) this ) (defmethod editable-region-method-10 ((this editable-region) (arg0 int)) (local-vars (sv-16 string) (sv-32 string)) (when (nonzero? (-> this id)) (let ((s5-0 (clear *temp-string*))) (format s5-0 "delete from region_sphere where region_id=~D" (-> this id)) (let ((a2-1 (sql-query s5-0))) (when (!= (-> a2-1 error) 'modify) (format 0 "ERROR: sql: modify error ~A for ~A~%" a2-1 this) (return #t) ) ) (clear s5-0) (format s5-0 "select region_face_id from region_face where region_id=~D" (-> this id)) (let ((s3-0 (sql-query s5-0))) (when (!= (-> s3-0 error) 'select) (format 0 "ERROR: sql: face select error ~A for ~A~%" s3-0 this) (return #t) ) (when (> (-> s3-0 len) 0) (clear s5-0) (format s5-0 "delete from region_point where region_face_id in (") (dotimes (s2-0 (-> s3-0 len)) (cond ((zero? s2-0) (let ((s1-0 format) (s0-0 s5-0) ) (set! sv-16 "~D") (let ((a2-4 (string->int (-> s3-0 data s2-0)))) (s1-0 s0-0 sv-16 a2-4) ) ) ) (else (let ((s1-1 format) (s0-1 s5-0) ) (set! sv-32 ",~D") (let ((a2-5 (string->int (-> s3-0 data s2-0)))) (s1-1 s0-1 sv-32 a2-5) ) ) ) ) ) (format s5-0 ")") (let ((a2-6 (sql-query s5-0))) (when (!= (-> a2-6 error) 'modify) (format 0 "ERROR: sql: modify error ~A for ~A~%" a2-6 this) (return #t) ) ) ) ) (clear s5-0) (format s5-0 "delete from region_face where region_id=~D" (-> this id)) (let ((a2-8 (sql-query s5-0))) (when (!= (-> a2-8 error) 'modify) (format 0 "ERROR: sql: modify error ~A for ~A~%" a2-8 this) (return #t) ) ) (when (zero? arg0) (clear s5-0) (format s5-0 "delete from region where region_id=~D" (-> this id)) (let ((a2-10 (sql-query s5-0))) (when (!= (-> a2-10 error) 'modify) (format 0 "ERROR: sql: modify error ~A for ~A~%" a2-10 this) (return #t) ) ) ) ) ) #f ) (defmethod editable-region-method-9 ((this editable-region) (arg0 editable-array) (arg1 int) (arg2 int)) (local-vars (v0-0 symbol) (v1-5 object) (v1-28 object)) (set! v0-0 (when (-> this changed) (format 0 "NOTICE: saving ~A~%" this) (let ((s5-0 *collapse-quote*)) (set! *collapse-quote* #f) (let ((v1-1 (-> this tree))) (b! (!= v1-1 'entity) cfg-3 :delay (nop!)) (b! #t cfg-78 :delay (nop!)) (label cfg-3) (b! (!= v1-1 'light) cfg-17 :delay (nop!)) (let ((s3-0 (-> arg0 length)) (s2-0 0) ) (let ((s1-0 (-> arg0 data s2-0))) (b! #t cfg-15 :delay (nop!)) (label cfg-5) (b! (not s1-0) cfg-10 :likely-delay (set! v1-5 s1-0)) (set! v1-5 (and (= (-> s1-0 region) this) (not (logtest? (-> s1-0 flags) (editable-flag no-save))))) (label cfg-10) (b! (not v1-5) cfg-14 :delay (empty-form)) (b! (editable-method-22 s1-0 arg0 1 0) cfg-14 :delay (empty-form)) (format 0 "ERROR: sql: insert error for ~A~%" s1-0) (return #f) (label cfg-14) (+! s2-0 1) (set! s1-0 (-> arg0 data s2-0)) ) (label cfg-15) (b! (< s2-0 s3-0) cfg-5) ) (b! #t cfg-78 :delay (nop!)) (label cfg-17) (b! (!= v1-1 'sample) cfg-37 :delay (nop!)) ) (let ((s3-1 (clear *temp-string*))) (format s3-1 "delete from sample_point where level_info_id=~D and source='manual'" (-> arg0 level-info-id)) (let ((a2-5 (sql-query s3-1))) (let ((v1-18 'modify)) (b! (= (-> a2-5 error) v1-18) cfg-21 :delay (empty-form)) ) (format 0 "ERROR: sql: modify error ~A for ~A~%" a2-5 this) ) (return #t) (label cfg-21) (format (clear s3-1) "update level_info set last_update=last_update, sample_point_update=NULL where level_info_id=~D" (-> arg0 level-info-id) ) (let ((a2-7 (sql-query s3-1))) (let ((v1-22 'modify)) (b! (= (-> a2-7 error) v1-22) cfg-24 :delay (empty-form)) ) (format 0 "ERROR: sql: modify error ~A for ~A~%" a2-7 this) ) ) (return #t) (label cfg-24) (let ((s3-2 (-> arg0 length)) (s2-2 0) ) (let ((s1-1 (-> arg0 data s2-2))) (b! #t cfg-35 :delay (nop!)) (label cfg-25) (b! (not s1-1) cfg-30 :likely-delay (set! v1-28 s1-1)) (set! v1-28 (and (= (-> s1-1 region) this) (not (logtest? (-> s1-1 flags) (editable-flag no-save))))) (label cfg-30) (b! (not v1-28) cfg-34 :delay (empty-form)) (b! (editable-method-22 s1-1 arg0 1 0) cfg-34 :delay (empty-form)) (format 0 "ERROR: sql: insert error for ~A~%" s1-1) (return #f) (label cfg-34) (+! s2-2 1) (set! s1-1 (-> arg0 data s2-2)) ) (label cfg-35) (b! (< s2-2 s3-2) cfg-25) ) (b! #t cfg-78 :delay (nop!)) (label cfg-37) (b! (nonzero? (-> this id)) cfg-53 :delay (nop!)) (let ((s3-3 (clear *temp-string*))) (format s3-3 "insert into region set level_name='~S',tree='~S'" (-> this level) (-> this tree)) (let ((a2-11 (-> this on-enter))) (b! (not a2-11) cfg-40 :delay (nop!)) (format s3-3 ",on_enter='~S'" a2-11) ) (b! #t cfg-41 :delay (nop!)) (label cfg-40) (format s3-3 ",on_enter=''") (label cfg-41) (let ((a2-12 (-> this on-exit))) (b! (not a2-12) cfg-43 :delay (nop!)) (format s3-3 ",on_exit='~S'" a2-12) ) (b! #t cfg-44 :delay (nop!)) (label cfg-43) (format s3-3 ",on_exit=''") (label cfg-44) (let ((a2-13 (-> this on-inside))) (b! (not a2-13) cfg-46 :delay (nop!)) (format s3-3 ",on_inside='~S'" a2-13) ) (b! #t cfg-47 :delay (nop!)) (label cfg-46) (format s3-3 ",on_inside=''") (label cfg-47) (let ((s3-4 (sql-query s3-3))) (let ((v1-48 'modify)) (b! (!= (-> s3-4 error) v1-48) cfg-51 :delay (empty-form)) ) (let ((v1-50 (sql-query "select LAST_INSERT_ID()"))) (let ((a0-36 'select)) (b! (!= (-> v1-50 error) a0-36) cfg-51 :delay (empty-form)) ) (set! (-> this id) (the-as uint (string->int (-> v1-50 data 0)))) ) (b! #t cfg-65 :delay (nop!)) (the-as none 0) (label cfg-51) (format 0 "ERROR: sql: insert error ~A for ~A~%" s3-4 this) ) ) (set! v0-0 #f) (b! #t cfg-79 :delay (nop!)) (the-as none 0) (b! #t cfg-65 :delay (nop!)) (label cfg-53) (let ((s3-5 (clear *temp-string*))) (format s3-5 "update region set level_name='~S',tree='~S'" (-> this level) (-> this tree)) (let ((a2-16 (-> this on-enter))) (b! (not a2-16) cfg-55 :delay (nop!)) (format s3-5 ",on_enter='~S'" a2-16) ) (b! #t cfg-56 :delay (nop!)) (label cfg-55) (format s3-5 ",on_enter=NULL") (label cfg-56) (let ((a2-17 (-> this on-exit))) (if a2-17 (format s3-5 ",on_exit='~S'" a2-17) (format s3-5 ",on_exit=NULL") ) ) (let ((a2-18 (-> this on-inside))) (if a2-18 (format s3-5 ",on_inside='~S'" a2-18) (format s3-5 ",on_inside=NULL") ) ) (format s3-5 " where region_id=~D" (-> this id)) (let ((a2-20 (sql-query s3-5))) (when (!= (-> a2-20 error) 'modify) (format 0 "ERROR: sql: update error ~A for ~A~%" a2-20 this) (return #f) ) ) ) (label cfg-65) (editable-region-method-10 this 1) (let* ((s3-6 (-> arg0 length)) (s2-3 0) (s1-2 (-> arg0 data s2-3)) ) (while (< s2-3 s3-6) (when (and s1-2 (= (-> s1-2 region) this) (not (logtest? (-> s1-2 flags) (editable-flag no-save)))) (when (not (editable-method-22 s1-2 arg0 1 0)) (format 0 "ERROR: sql: insert error for ~A~%" s1-2) (return #f) ) ) (+! s2-3 1) (set! s1-2 (-> arg0 data s2-3)) ) ) (label cfg-78) (set! (-> this changed) #f) (set! v0-0 #t) (set! *collapse-quote* s5-0) ) v0-0 ) ) (label cfg-79) v0-0 ) (defmethod editable-region-method-11 ((this editable-region) (arg0 vector) (arg1 int)) (local-vars (sv-32 vector2h)) (set! sv-32 (new 'stack 'vector2h)) (add-debug-x #t (bucket-id debug-no-zbuf1) arg0 (new 'static 'rgba :r #xff :g #xff :a #x80)) (let ((s3-0 add-debug-text-3d) (s2-0 #t) (s1-0 318) ) (format (clear *temp-string*) "region-~D~%" (-> this id)) (s3-0 s2-0 (the-as bucket-id s1-0) *temp-string* arg0 (font-color white) sv-32) ) (+! (-> sv-32 y) 8) (when (>= arg1 1) (let ((s4-1 (-> this on-enter))) (when s4-1 (let ((s3-1 add-debug-text-3d) (s2-1 #t) (s1-1 318) ) (format (clear *temp-string*) "(on-enter ~S)" s4-1) (s3-1 s2-1 (the-as bucket-id s1-1) *temp-string* arg0 (font-color white) sv-32) ) (+! (-> sv-32 y) 8) ) ) (let ((s4-2 (-> this on-inside))) (when s4-2 (let ((s3-2 add-debug-text-3d) (s2-2 #t) (s1-2 318) ) (format (clear *temp-string*) "(on-inside ~S)" s4-2) (s3-2 s2-2 (the-as bucket-id s1-2) *temp-string* arg0 (font-color white) sv-32) ) (+! (-> sv-32 y) 8) ) ) (let ((s5-1 (-> this on-exit))) (when s5-1 (let ((s4-3 add-debug-text-3d) (s3-3 #t) (s2-3 318) ) (format (clear *temp-string*) "(on-exit ~S)" s5-1) (s4-3 s3-3 (the-as bucket-id s2-3) *temp-string* arg0 (font-color white) sv-32) ) (+! (-> sv-32 y) 8) ) ) ) 0 (none) ) ;; WARN: Return type mismatch int vs editable-filter. (defmethod editable-region-method-12 ((this editable-region)) (let* ((s5-0 0) (s4-0 (lambda ((arg0 string)) (let ((gp-0 0)) (when (not (type? arg0 string)) (format (clear *temp-string*) "~A" arg0) (set! arg0 *temp-string*) ) (if (>= (string-position "(sound-play" arg0) 0) (set! gp-0 (logior gp-0 4)) ) (if (>= (string-position "(part-tracker" arg0) 0) (set! gp-0 (logior gp-0 8)) ) (if (>= (string-position "(want-" arg0) 0) (set! gp-0 (logior gp-0 64)) ) (if (>= (string-position "(setting-" arg0) 0) (set! gp-0 (logior gp-0 16)) ) (if (>= (string-position "(water" arg0) 0) (set! gp-0 (logior gp-0 128)) ) gp-0 ) ) ) (v0-3 (logior (logior (logior s5-0 (s4-0 (-> this on-inside))) (s4-0 (-> this on-enter))) (s4-0 (-> this on-exit))) ) ) (when (zero? v0-3) (if (and (not (-> this on-inside)) (not (-> this on-enter)) (not (-> this on-exit))) (set! v0-3 1) (set! v0-3 2) ) ) (case (-> this tree) (('target) (set! v0-3 (logior v0-3 512)) ) (('camera) (set! v0-3 (logior v0-3 256)) ) (('data) (set! v0-3 (logior v0-3 2048)) ) (('water) (set! v0-3 (logior v0-3 1024)) ) (('city_vis) (set! v0-3 4096) ) (('sample) (set! v0-3 8192) ) (('light) (set! v0-3 #x4000) ) (('entity) (set! v0-3 #x8000) ) ) (the-as editable-filter v0-3) ) ) (defmethod editable-method-23 ((this editable)) #t ) (defmethod editable-method-28 ((this editable) (arg0 editable-filter)) (let* ((s5-0 (-> this owner)) (a0-1 (car s5-0)) ) (while (not (null? s5-0)) (editable-method-28 (the-as editable a0-1) arg0) (set! s5-0 (cdr s5-0)) (set! a0-1 (car s5-0)) ) ) 0 (none) ) ;; WARN: Return type mismatch int vs symbol. (defmethod editable-method-29 ((this editable) (arg0 editable-filter)) (let* ((s5-0 (-> this owner)) (a0-1 (car s5-0)) ) (while (not (null? s5-0)) (editable-method-29 (the-as editable a0-1) arg0) (set! s5-0 (cdr s5-0)) (set! a0-1 (car s5-0)) ) ) (the-as symbol 0) ) (defmethod editable-method-21 ((this editable) (arg0 editable-region)) (when (not (and (-> this region) (-> this region locked))) (if arg0 (set! (-> arg0 changed) #t) ) (if (-> this region) (set! (-> this region changed) #t) ) (logior! (-> this flags) (editable-flag changed)) (set! (-> this region) arg0) ) 0 (none) ) ;; WARN: Return type mismatch int vs rgba. (defmethod get-color ((this editable) (arg0 int)) "Returns the [[rgba]] that corresponds to the type of [[editable]] TODO - document the colors" (the-as rgba (cond ((and (logtest? (-> this flags) (editable-flag selected)) (< (mod (-> *display* real-clock frame-counter) 60) 30) ) (the-as int (the-as uint #x80ffffff)) ) ((logtest? (-> this flags) (editable-flag no-save)) (shl #x80ff 16) ) ((= (-> this type) editable-point) (the-as int (the-as uint #x800080ff)) ) ((= (-> this type) editable-sample) (the-as int (the-as uint #x80ff8000)) ) ((= (-> this type) editable-light) (the-as int (the-as uint #x80ff0080)) ) ((= (-> this type) editable-entity) (the-as int (the-as uint #x80ff00ff)) ) (else (the-as int (the-as uint #x800000ff)) ) ) ) ) (defmethod editable-method-10 ((this editable)) (when (logtest? (-> this flags) (editable-flag selected)) (let ((s5-0 (new 'stack-no-clear 'vector))) (when (editable-method-11 this s5-0) (set! (-> s5-0 y) (-> s5-0 y)) (add-debug-x #t (bucket-id debug-no-zbuf1) s5-0 (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80)) ) ) (add-debug-x #t (bucket-id debug-no-zbuf1) (edit-get-trans this) (new 'static 'rgba :r #xff :g #xff :a #x80)) ) 0 (none) ) (defmethod select-editable! ((this editable) (arg0 symbol)) (case arg0 (('toggle) (logxor! (-> this flags) (editable-flag selected)) ) ((#f) (logclear! (-> this flags) (editable-flag selected)) ) (else (logior! (-> this flags) (editable-flag selected)) ) ) 0 (none) ) (defmethod edit-get-distance ((this editable) (arg0 vector)) "Returns the distance from the camera to the [[editable]], or -1.0" -1.0 ) (defmethod editable-method-20 ((this editable) (arg0 vector) (arg1 vector) (arg2 vector) (arg3 vector)) (local-vars (sv-48 vector) (sv-52 vector)) (set! sv-48 (new 'stack-no-clear 'vector)) (set! sv-52 (new 'stack-no-clear 'vector)) (let ((s4-0 (edit-get-trans this))) (reverse-transform-point! sv-48 s4-0 arg2 arg0) (reverse-transform-point! sv-52 s4-0 arg2 arg1) (vector-! arg3 sv-52 sv-48) (vector-! (new 'stack-no-clear 'vector) s4-0 (-> *math-camera* trans)) ) (if (< 20480.0 (vector-length arg3)) (vector-normalize! arg3 20480.0) ) (editable-method-15 this arg3 56) 0 (none) ) (defmethod editable-method-11 ((this editable) (arg0 vector)) (with-pp (let ((s5-0 (new 'stack 'collide-query))) (set! (-> s5-0 start-pos quad) (-> (edit-get-trans this) quad)) (set-vector! (-> s5-0 move-dist) 0.0 -204800.0 0.0 1.0) (let ((v1-5 s5-0)) (set! (-> v1-5 radius) 40.96) (set! (-> v1-5 collide-with) (collide-spec backgnd crate obstacle hit-by-player-list hit-by-others-list collectable pusher) ) (set! (-> v1-5 ignore-process0) pp) (set! (-> v1-5 ignore-process1) #f) (set! (-> v1-5 ignore-pat) (new 'static 'pat-surface :noentity #x1 :nojak #x1 :probe #x1 :noendlessfall #x1)) (set! (-> v1-5 action-mask) (collide-action solid)) ) (when (>= (fill-and-probe-using-line-sphere *collide-cache* s5-0) 0.0) (set! (-> arg0 quad) (-> s5-0 best-other-tri intersect quad)) #t ) ) ) ) (defmethod editable-method-24 ((this editable)) 0 (none) ) (defmethod editable-method-17 ((this editable) (arg0 vector)) 0 (none) ) (defmethod editable-method-22 ((this editable) (arg0 editable-array) (arg1 int) (arg2 int)) #t ) (defmethod editable-method-15 ((this editable) (arg0 vector) (arg1 int)) 0 (none) ) (defmethod edit-coord! ((this editable) (arg0 vector) (arg1 editable-flag)) 0 (none) ) (defmethod editable-method-18 ((this editable) (arg0 vector) (arg1 matrix)) 0 (none) ) (defmethod edit-get-trans ((this editable)) "Returns the `trans` [[vector]] or [[*null-vector*]]" *null-vector* ) (defmethod editable-method-19 ((this editable) (arg0 vector)) 0 (none) ) (defmethod editable-method-26 ((this editable) (arg0 editable) (arg1 editable-array)) 0 (none) ) (defmethod editable-method-25 ((this editable) (arg0 editable-array)) (let ((v1-0 (-> this region))) (if v1-0 (set! (-> v1-0 changed) #t) ) ) (logior! (-> this flags) (editable-flag changed)) (let* ((s4-0 (-> this owner)) (a0-3 (car s4-0)) ) (while (not (null? s4-0)) (editable-method-26 (the-as editable a0-3) this arg0) (set! s4-0 (cdr s4-0)) (set! a0-3 (car s4-0)) ) ) 0 (none) ) (defmethod editable-method-27 ((this editable) (arg0 editable-array)) (local-vars (s4-0 editable)) (let ((v1-0 0)) (while (< v1-0 (-> arg0 selection length)) (when (= this (-> arg0 selection v1-0)) (set! s4-0 (-> arg0 selection (+ v1-0 1))) (goto cfg-10) ) (+! v1-0 2) ) ) (let ((s3-0 (editable-array-method-11 arg0))) (set! s4-0 (when (>= s3-0 0) (set! s4-0 (copy this 'debug)) (let ((v1-9 (-> arg0 region))) (if v1-9 (set! (-> s4-0 region) v1-9) ) ) (set! (-> s4-0 region changed) #t) (logior! (-> this flags) (editable-flag changed)) (set! (-> s4-0 id) (the-as uint 0)) (set! (-> s4-0 owner) '()) (select-editable! s4-0 #f) (let ((s2-0 (new 'debug 'string 32 (the-as string #f)))) (format s2-0 "undefined-~d" *editable-temp-id*) (set! (-> s4-0 name) s2-0) ) (set! *editable-temp-id* (+ *editable-temp-id* 1)) (set! (-> arg0 data s3-0) s4-0) (set! (-> arg0 selection (-> arg0 selection length)) this) (set! (-> arg0 selection (+ (-> arg0 selection length) 1)) s4-0) (+! (-> arg0 selection length) 2) s4-0 ) ) ) (label cfg-10) s4-0 ) (defmethod print ((this editable-point)) (format #t "#<~A~S~m ~m ~m :r ~m" (-> this type) (if (logtest? (-> this flags) (editable-flag changed)) " (m)" "" ) (-> this trans x) (-> this trans y) (-> this trans z) (-> this radius) ) (format #t " @ #x~X>" this) this ) ;; WARN: Function (method 28 editable-point) has a return type of none, but the expression builder found a return statement. (defmethod editable-method-28 ((this editable-point) (arg0 editable-filter)) (if (logtest? arg0 (editable-filter water-command)) (return #f) ) (let ((s4-0 (-> *editable* 0 current))) (cond ((logtest? (-> this flags) (editable-flag top-set)) (let* ((s3-0 (-> s4-0 length)) (s2-0 0) (a0-1 (-> s4-0 data s2-0)) ) (while (< s2-0 s3-0) (if (and a0-1 (= (-> a0-1 region) (-> this region)) (logtest? (-> a0-1 flags) (editable-flag top-set))) (edit-coord! a0-1 (-> this trans) (editable-flag y no-update)) ) (+! s2-0 1) (set! a0-1 (-> s4-0 data s2-0)) ) ) ) ((logtest? (-> this flags) (editable-flag bot-set)) (let* ((s3-1 (-> s4-0 length)) (s2-1 0) (a0-2 (-> s4-0 data s2-1)) ) (while (< s2-1 s3-1) (if (and a0-2 (= (-> a0-2 region) (-> this region)) (logtest? (-> a0-2 flags) (editable-flag bot-set))) (edit-coord! a0-2 (-> this trans) (editable-flag y no-update)) ) (+! s2-1 1) (set! a0-2 (-> s4-0 data s2-1)) ) ) ) ) ) (call-parent-method this arg0) 0 (none) ) (defmethod editable-method-15 ((this editable-point) (arg0 vector) (arg1 int)) (let ((v1-0 (-> this region))) (if v1-0 (set! (-> v1-0 changed) #t) ) ) (logior! (-> this flags) (editable-flag changed)) (vector+! (-> this trans) (-> this trans) arg0) (editable-method-28 this (the-as editable-filter arg1)) 0 (none) ) (defmethod edit-coord! ((this editable-point) (arg0 vector) (arg1 editable-flag)) (let ((v1-0 (-> this region))) (if v1-0 (set! (-> v1-0 changed) #t) ) ) (logior! (-> this flags) (editable-flag changed)) (if (logtest? arg1 (editable-flag x)) (set! (-> this trans x) (-> arg0 x)) ) (if (logtest? arg1 (editable-flag y)) (set! (-> this trans y) (-> arg0 y)) ) (if (logtest? arg1 (editable-flag z)) (set! (-> this trans z) (-> arg0 z)) ) (editable-method-28 this (the-as editable-filter arg1)) 0 (none) ) (defmethod edit-get-trans ((this editable-point)) "Returns the `trans` [[vector]] or [[*null-vector*]]" (-> this trans) ) (defmethod editable-method-18 ((this editable-point) (arg0 vector) (arg1 matrix)) (let ((v1-0 (-> this region))) (if v1-0 (set! (-> v1-0 changed) #t) ) ) (logior! (-> this flags) (editable-flag changed)) (let ((s4-1 (vector-! (new 'stack-no-clear 'vector) (-> this trans) arg0))) (vector-matrix*! s4-1 s4-1 arg1) (vector+! (-> this trans) s4-1 arg0) ) 0 (none) ) (defmethod editable-method-10 ((this editable-point)) (let* ((s5-0 vector-vector-distance) (a0-1 (math-camera-pos)) (a1-0 (-> this trans)) (f0-1 (- (s5-0 a0-1 a1-0) (-> this radius))) (s2-0 (cond ((logtest? (-> this flags) (editable-flag selected)) 6 ) ((>= f0-1 983040.0) 3 ) ((>= f0-1 491520.0) 4 ) ((>= f0-1 245760.0) 5 ) (else 6 ) ) ) ) (add-debug-sphere-from-table (bucket-id debug2) (-> this trans) (-> this radius) (get-color this (the-as int a1-0)) s2-0 ) ) ((method-of-type editable editable-method-10) this) (none) ) (defmethod edit-get-distance ((this editable-point) (arg0 vector)) "Returns the distance from the camera to the [[editable]], or -1.0" (let ((a0-1 (new 'stack-no-clear 'sphere)) (s5-0 (new 'stack-no-clear 'vector)) ) (set! (-> a0-1 quad) (-> this trans quad)) (set! (-> a0-1 r) (-> this radius)) (when (sphere-in-view-frustum? a0-1) (reverse-transform-point! s5-0 (-> this trans) (-> *math-camera* inv-camera-rot vector 2) arg0) (let ((f0-1 (vector-vector-distance (edit-get-trans this) s5-0))) (if (>= (-> this radius) f0-1) (return f0-1) ) ) ) ) -1.0 ) (defmethod editable-method-19 ((this editable-point) (arg0 vector)) (let ((v1-0 (-> this region))) (if v1-0 (set! (-> v1-0 changed) #t) ) ) (let ((s4-1 (vector-! (new 'stack-no-clear 'vector) arg0 (-> this trans)))) (vector-normalize! s4-1 (-> this radius)) (vector-! (-> this trans) arg0 s4-1) ) (editable-method-28 this (editable-filter load)) 0 (none) ) (defmethod editable-method-22 ((this editable-point) (arg0 editable-array) (arg1 int) (arg2 int)) (case arg1 ((2) (let ((s3-0 (clear *temp-string*))) (format s3-0 "insert into region_point set region_face_id=LAST_INSERT_ID(),idx=~D,x=~f,y=~f,z=~f" arg2 (- (-> this trans x) (-> arg0 level-offset x)) (- (-> this trans y) (-> arg0 level-offset y)) (- (-> this trans z) (-> arg0 level-offset z)) ) (let ((a0-5 (sql-query s3-0))) (when (= (-> a0-5 error) 'modify) (logclear! (-> this flags) (editable-flag changed)) #t ) ) ) ) (else #t ) ) ) (defmethod editable-method-17 ((this editable-sphere) (arg0 vector)) (let ((v1-0 (-> this region))) (if v1-0 (set! (-> v1-0 changed) #t) ) ) (logior! (-> this flags) (editable-flag changed)) (if (= (-> arg0 y) 0.0) (+! (-> this radius) (-> arg0 x)) (set! (-> this radius) (-> arg0 y)) ) (if (< (-> this radius) 0.0) (set! (-> this radius) 0.0) ) (editable-method-28 this (editable-filter load)) 0 (none) ) (defmethod editable-method-22 ((this editable-sphere) (arg0 editable-array) (arg1 int) (arg2 int)) (let ((gp-0 (clear *temp-string*))) (format gp-0 "insert into region_sphere set region_id=~D,x=~f,y=~f,z=~f,r=~f" (-> this region id) (- (-> this trans x) (-> arg0 level-offset x)) (- (-> this trans y) (-> arg0 level-offset y)) (- (-> this trans z) (-> arg0 level-offset z)) (-> this radius) ) (= (-> (sql-query gp-0) error) 'modify) ) ) (defmethod editable-method-22 ((this editable-sample) (arg0 editable-array) (arg1 int) (arg2 int)) (let ((s5-0 (clear *temp-string*))) (format s5-0 "insert into sample_point set level_info_id=~D,x=~f,y=~f,z=~f,source='manual'" (-> arg0 level-info-id) (* 0.00024414062 (- (-> this trans x) (-> arg0 level-offset x))) (* 0.00024414062 (- (-> this trans y) (-> arg0 level-offset y))) (* 0.00024414062 (- (-> this trans z) (-> arg0 level-offset z))) ) (let ((a0-4 (sql-query s5-0))) (when (= (-> a0-4 error) 'modify) (logclear! (-> this flags) (editable-flag changed)) #t ) ) ) ) (defmethod print ((this editable-light)) (format #t "#<~A~S ~S ~m ~m ~m" (-> this type) (if (logtest? (-> this flags) (editable-flag changed)) " (m)" "" ) (-> this name) (-> this trans x) (-> this trans y) (-> this trans z) ) (format #t " :r ~m @ #x~X>" (-> this radius) this) this ) (defmethod editable-method-23 ((this editable-light)) (let ((v1-0 *light-hash*)) (let* ((a2-0 (-> v1-0 num-lights)) (a1-1 (-> v1-0 light-sphere-array a2-0)) ) (set! (-> a1-1 name) (-> this name)) (set! (-> a1-1 decay-start) (-> this decay-start)) (set! (-> a1-1 ambient-point-ratio) (-> this ambient-point-ratio)) (set! (-> a1-1 brightness) (-> this brightness)) (set! (-> a1-1 bsphere quad) (-> this trans quad)) (set! (-> a1-1 bsphere w) (-> this radius)) (set! (-> a1-1 direction quad) (-> this direction quad)) (set! (-> a1-1 color quad) (-> this color quad)) (set! (-> a1-1 palette-index) (the int (-> this color w))) ) (+! (-> v1-0 num-lights) 1) ) #t ) (defun update-light-sphere-from-editable-light ((arg0 editable-light)) (let ((v1-0 (lookup-light-sphere-by-name (-> arg0 name) *light-hash*))) (when v1-0 (set! (-> v1-0 name) (-> arg0 name)) (set! (-> v1-0 decay-start) (-> arg0 decay-start)) (set! (-> v1-0 ambient-point-ratio) (-> arg0 ambient-point-ratio)) (set! (-> v1-0 brightness) (-> arg0 brightness)) (set! (-> v1-0 bsphere quad) (-> arg0 trans quad)) (set! (-> v1-0 bsphere w) (-> arg0 radius)) (set! (-> v1-0 direction quad) (-> arg0 direction quad)) (set! (-> v1-0 color quad) (-> arg0 color quad)) (set! (-> v1-0 palette-index) (the int (-> arg0 color w))) ) ) (none) ) (defmethod editable-method-17 ((this editable-light) (arg0 vector)) (let ((v1-0 (-> this region))) (if v1-0 (set! (-> v1-0 changed) #t) ) ) (logior! (-> this flags) (editable-flag changed)) (if (= (-> arg0 y) 0.0) (+! (-> this radius) (-> arg0 x)) (set! (-> this radius) (-> arg0 y)) ) (if (< (-> this radius) 0.0) (set! (-> this radius) 0.0) ) (update-light-sphere-from-editable-light this) (editable-method-28 this (editable-filter load)) 0 (none) ) (defmethod editable-method-15 ((this editable-light) (arg0 vector) (arg1 int)) (let ((v1-0 (-> this region))) (if v1-0 (set! (-> v1-0 changed) #t) ) ) (logior! (-> this flags) (editable-flag changed)) (vector+! (-> this trans) (-> this trans) arg0) (update-light-sphere-from-editable-light this) (editable-method-28 this (the-as editable-filter arg1)) 0 (none) ) ;; WARN: Function (method 25 editable-light) has a return type of none, but the expression builder found a return statement. (defmethod editable-method-25 ((this editable-light) (arg0 editable-array)) (call-parent-method this arg0) (when (nonzero? (-> this id)) (let ((s5-1 (clear *temp-string*))) (format s5-1 "delete from light where light_id=~D" (-> this id)) (let ((a2-1 (sql-query s5-1))) (when (!= (-> a2-1 error) 'modify) (format 0 "ERROR: sql: modify error ~A for ~A~%" a2-1 this) (return 0) ) ) ) ) 0 (none) ) (defmethod editable-method-22 ((this editable-light) (arg0 editable-array) (arg1 int) (arg2 int)) (cond ((logtest? (-> this flags) (editable-flag changed)) (let ((s5-0 (clear *temp-string*))) (when (zero? (-> this id)) (format s5-0 "insert into light set level_name='~S'" (-> this region level)) (let ((s3-0 (sql-query s5-0))) (when (= (-> s3-0 error) 'modify) (let ((v1-7 (sql-query "select LAST_INSERT_ID()"))) (when (= (-> v1-7 error) 'select) (set! (-> this id) (the-as uint (string->int (-> v1-7 data 0)))) (goto cfg-8) ) ) ) (format 0 "ERROR: sql: id insert error ~A for ~A~%" s3-0 this) ) (return #f) (label cfg-8) (let ((s3-1 (new 'debug 'string 32 (the-as string #f)))) (format s3-1 "light-~d" (-> this id)) (set! (-> this name) s3-1) ) ) (format (clear s5-0) "update light set level_name='~S', name='~S'" (-> this region level) (-> this name)) (format s5-0 ", pos_x=~f, pos_y=~f, pos_z=~f, r=~f" (* 0.00024414062 (- (-> this trans x) (-> arg0 level-offset x))) (* 0.00024414062 (- (-> this trans y) (-> arg0 level-offset y))) (* 0.00024414062 (- (-> this trans z) (-> arg0 level-offset z))) (* 0.00024414062 (-> this radius)) ) (if (= (-> this direction w) 0.0) (format s5-0 ", dir_x=0.0, dir_y=0.0, dir_z=0.0") (format s5-0 ", dir_x=~f, dir_y=~f, dir_z=~f" (-> this direction x) (-> this direction y) (-> this direction z) ) ) (format s5-0 ", color0_r=~f, color0_g=~f, color0_b=~f, color0_a=~f" (-> this color x) (-> this color y) (-> this color z) (-> this color w) ) (format s5-0 ", decay_start=~f, ambient_point_ratio=~f, brightness=~f" (-> this decay-start) (-> this ambient-point-ratio) (-> this brightness) ) (format s5-0 " where light_id=~D" (-> this id)) (let ((a0-21 (sql-query s5-0))) (when (= (-> a0-21 error) 'modify) (logclear! (-> this flags) (editable-flag changed)) #t ) ) ) ) (else #t ) ) ) (defmethod editable-method-10 ((this editable-light)) (if (!= (-> this direction w) 0.0) (add-debug-vector #t (bucket-id debug-no-zbuf1) (edit-get-trans this) (-> this direction) (* -1.2 (-> this radius)) (new 'static 'rgba :r #xff :b #xff :a #x80) ) ) (when (-> *editable* 0 light-names) (let ((s5-1 add-debug-text-3d) (s4-1 #t) (s3-1 318) ) (format (clear *temp-string*) "~S~%" (-> this name)) (s5-1 s4-1 (the-as bucket-id s3-1) *temp-string* (-> this trans) (font-color white) (the-as vector2h #f)) ) ) ((method-of-type editable-sphere editable-method-10) this) (none) ) (defmethod edit-get-trans ((this editable-face)) "Returns the `trans` [[vector]] or [[*null-vector*]]" "The center of the obj." (cond ((>= (-> this length) 3) (let ((s5-0 (new 'static 'vector))) (set! (-> s5-0 quad) (the-as uint128 0)) (vector+! s5-0 s5-0 (edit-get-trans (-> this vertex 0))) (vector+! s5-0 s5-0 (edit-get-trans (-> this vertex 1))) (vector+! s5-0 s5-0 (edit-get-trans (-> this vertex 2))) (vector-float*! s5-0 s5-0 0.33333334) ) ) ((>= (-> this length) 2) (let ((s5-1 (new 'static 'vector))) (set! (-> s5-1 quad) (the-as uint128 0)) (vector+! s5-1 s5-1 (edit-get-trans (-> this vertex 0))) (vector+! s5-1 s5-1 (edit-get-trans (-> this vertex 1))) (vector-float*! s5-1 s5-1 0.5) ) ) (else *null-vector* ) ) ) (defmethod editable-method-22 ((this editable-face) (arg0 editable-array) (arg1 int) (arg2 int)) (let ((s4-0 (clear *temp-string*))) (format s4-0 "insert into region_face set kind='face',region_id=~D" (-> this region id)) (if (logtest? (-> this flags) (editable-flag orient)) (format s4-0 ",flags='orient'") ) (let ((a0-5 (sql-query s4-0))) (if (!= (-> a0-5 error) 'modify) (return #f) ) ) ) (dotimes (s4-1 (-> this length)) (editable-method-22 (-> this vertex s4-1) arg0 2 s4-1) ) (logclear! (-> this flags) (editable-flag changed)) #t ) (defmethod editable-method-25 ((this editable-face) (arg0 editable-array)) (dotimes (s4-0 (-> this length)) (let ((s3-0 (-> this vertex s4-0))) (set! (-> s3-0 owner) (delete! this (-> s3-0 owner))) ) ) (call-parent-method this arg0) (none) ) (defmethod editable-method-26 ((this editable-face) (arg0 editable) (arg1 editable-array)) (-> this length) (countdown (v1-1 (-> this length)) (when (= (-> this vertex v1-1) arg0) (let ((a0-5 v1-1) (a1-2 (+ (-> this length) -2)) ) (while (>= a1-2 a0-5) (set! (-> this vertex a0-5) (-> this vertex (+ a0-5 1))) (+! a0-5 1) ) ) (+! (-> this length) -1) ) ) (if (< (-> this length) 3) (editable-array-method-15 arg1 this) ) ((method-of-type editable editable-method-26) this arg0 arg1) (none) ) ;; WARN: Return type mismatch editable-face vs editable. (defmethod editable-method-27 ((this editable-face) (arg0 editable-array)) (let ((gp-1 (the-as editable-face (call-parent-method this arg0)))) (dotimes (s4-0 (-> gp-1 length)) (set! (-> gp-1 vertex s4-0) (the-as editable-point (editable-method-27 (-> gp-1 vertex s4-0) arg0))) (set! (-> gp-1 vertex s4-0 owner) (cons gp-1 (-> gp-1 vertex s4-0 owner))) ) (the-as editable gp-1) ) ) (defmethod editable-method-24 ((this editable-face)) (logxor! (-> this flags) (editable-flag orient)) (editable-face-method-31 this (-> this normal)) (logior! (-> this flags) (editable-flag changed)) (set! (-> this region changed) #t) 0 (none) ) (defmethod editable-face-method-30 ((this editable-face) (arg0 (inline-array vector))) (let ((v1-0 (-> this length))) (cond ((or (zero? v1-0) (= v1-0 1)) 0 ) ((= v1-0 2) (let ((s4-0 (edit-get-trans (-> this vertex 0))) (v1-3 (edit-get-trans (-> this vertex 1))) ) (set! (-> arg0 0 quad) (-> s4-0 quad)) (set! (-> arg0 1 quad) (-> s4-0 quad)) (set! (-> arg0 1 y) (-> v1-3 y)) (set! (-> arg0 2 quad) (-> v1-3 quad)) (set! (-> arg0 2 y) (-> s4-0 y)) (set! (-> arg0 3 quad) (-> v1-3 quad)) ) 4 ) (else (dotimes (s4-1 (-> this length)) (set! (-> arg0 s4-1 quad) (-> (edit-get-trans (-> this vertex s4-1)) quad)) ) (-> this length) ) ) ) ) (defmethod editable-face-method-31 ((this editable-face) (arg0 vector)) (let ((s4-0 (new 'stack-no-clear 'matrix))) (dotimes (v1-0 6) (set! (-> s4-0 quad v1-0) (the-as uint128 0)) ) (if (>= (editable-face-method-30 this (the-as (inline-array vector) s4-0)) 3) (normal-of-plane arg0 (the-as vector (-> s4-0 vector)) (-> s4-0 vector 1) (-> s4-0 vector 2)) ) ) (if (logtest? (-> this flags) (editable-flag orient)) (vector-negate! arg0 arg0) ) arg0 ) (defmethod edit-get-distance ((this editable-face) (arg0 vector)) "Returns the distance from the camera to the [[editable]], or -1.0" (let ((gp-0 (new 'stack-no-clear 'vector)) (s5-0 (editable-face-method-31 this (new 'stack-no-clear 'vector))) (s2-0 (new 'stack-no-clear 'vector)) ) (set! (-> s2-0 quad) (-> (edit-get-trans (-> this vertex 0)) quad)) (transform-point-vector! gp-0 s2-0) (when (< 0.0 (-> gp-0 z)) (reverse-transform-point! gp-0 s2-0 s5-0 arg0) (let ((points (new 'stack-no-clear 'inline-array 'vector 6))) (dotimes (v1-5 6) (set! (-> points v1-5 quad) (the-as uint128 0)) ) (let ((s4-1 (editable-face-method-30 this points)) (s2-1 0) (s1-1 (vector-negate! (new 'stack-no-clear 'vector) s5-0)) ) (while (< (+ s2-1 2) s4-1) (if (or (point-in-triangle-cross gp-0 s5-0 (-> points 0) (-> points 1) (-> points 2)) (point-in-triangle-cross gp-0 s1-1 (-> points 0) (-> points 1) (-> points 2)) ) (return (vector-vector-distance (camera-pos) gp-0)) ) (+! s2-1 1) (set! points (the-as (inline-array vector) (-> points 1))) ) ) ) ) ) -1.0 ) ;; WARN: Return type mismatch int vs symbol. (defmethod editable-method-29 ((this editable-face) (arg0 editable-filter)) (local-vars (sv-208 (inline-array vector)) (sv-216 int) (sv-288 array) (sv-292 int) (sv-296 int) (sv-368 matrix) (sv-372 editable-point) (sv-376 float) (sv-380 symbol) (sv-400 float) ) (format 0 "ugh 1~%") (if (or (logtest? arg0 (editable-filter water-command)) (logtest? (-> this flags) (editable-flag mark))) (return (the-as symbol #f)) ) (logior! (-> this flags) (editable-flag mark)) (format 0 "ugh 2~%") (let ((s5-0 (new 'stack-no-clear 'inline-array 'vector 6))) (dotimes (v1-7 6) (set! (-> s5-0 v1-7 quad) (the-as uint128 0)) ) (format 0 "ugh 21~%") (let ((s4-0 (editable-face-method-30 this s5-0))) (when (and (>= s4-0 4) (>= (-> this length) 3)) (let ((v1-14 0)) (dotimes (a0-7 s4-0) (if (logtest? (-> this vertex a0-7 flags) (editable-flag selected)) (+! v1-14 1) ) ) (cond ((= v1-14 s4-0) (set! arg0 (logior arg0 (editable-filter load))) ) ((= v1-14 2) (let ((v1-15 (new 'stack-no-clear 'inline-array 'vector 6))) (dotimes (a0-12 6) (set! (-> v1-15 a0-12 quad) (the-as uint128 0)) ) (set! sv-208 v1-15) ) (set! sv-216 0) (dotimes (s2-2 s4-0) (when (not (logtest? (-> this vertex s2-2 flags) (editable-flag selected))) (set! (-> sv-208 sv-216 quad) (-> (edit-get-trans (-> this vertex s2-2)) quad)) (set! sv-216 (+ sv-216 1)) ) ) (dotimes (s2-3 s4-0) (when (logtest? (-> this vertex s2-3 flags) (editable-flag selected)) (set! (-> sv-208 sv-216 quad) (-> (edit-get-trans (-> this vertex s2-3)) quad)) (set! sv-216 (+ sv-216 1)) ) ) (normal-of-plane (-> this normal) (-> sv-208 0) (-> sv-208 1) (-> sv-208 2)) (set! (-> this center quad) (-> (edit-get-trans this) quad)) ) ) ) (format 0 "ugh 22~%") (when (not (logtest? arg0 (editable-filter load))) (when (= (-> this normal w) 0.0) (editable-face-method-31 this (-> this normal)) (set! (-> this center quad) (-> (edit-get-trans this) quad)) ) (let ((s3-2 0) (s2-5 (-> this normal)) (s1-2 (-> this center)) ) (while (< s3-2 s4-0) (when (logtest? (-> this vertex s3-2 flags) (editable-flag selected)) (let* ((a1-14 (vector-! (new 'stack-no-clear 'vector) (-> s5-0 s3-2) s1-2)) (f0-2 (vector-dot a1-14 s2-5)) ) (edit-coord! (-> this vertex s3-2) (vector+float*! a1-14 (-> s5-0 s3-2) s2-5 (- f0-2)) (editable-flag x y z no-plane-snap) ) ) ) (+! s3-2 1) ) ) ) (format 0 "ugh 23~%") (set! sv-288 ((method-of-type array new) (the-as symbol (new 'stack-no-clear 'array 'editable-point 6)) array editable-point 6 ) ) (set! sv-292 (+ (-> this length) -1)) (set! sv-296 1) (format 0 "ugh 231~%") (editable-face-method-31 this (-> this normal)) (format 0 "ugh 232~%") (dotimes (v1-85 sv-292) (set! (-> (the-as (array editable-point) sv-288) v1-85) (-> this vertex (+ v1-85 1))) ) (format 0 "ugh 233~%") (set! sv-368 (new-stack-matrix0)) (format 0 "ugh 234~%") (set! sv-372 (the-as editable-point #f)) (set! sv-376 (the-as float 0.0)) (set! sv-380 #t) (vector-normalize! (vector-! (-> sv-368 vector 2) (edit-get-trans this) (edit-get-trans (-> this vertex 0))) 1.0 ) (vector-normalize! (editable-face-method-31 this (-> sv-368 vector 1)) 1.0) (vector-normalize! (vector-cross! (the-as vector (-> sv-368 vector)) (-> sv-368 vector 2) (-> sv-368 vector 1)) 1.0 ) (set! (-> sv-368 trans quad) (-> (edit-get-trans (-> this vertex 0)) quad)) (set! (-> sv-368 trans w) 1.0) (matrix-4x4-inverse! sv-368 sv-368) (while (< sv-296 (-> this length)) (set! sv-372 (the-as editable-point #f)) (dotimes (s5-4 sv-292) (when (-> (the-as (array editable-point) sv-288) s5-4) (let* ((a1-27 (edit-get-trans (-> (the-as (array editable-point) sv-288) s5-4))) (a0-48 (vector-matrix*! (new 'stack-no-clear 'vector) a1-27 sv-368)) ) (set! sv-400 (vector-y-angle a0-48)) ) (cond (sv-380 (when (or (not sv-372) (< sv-376 sv-400)) (set! sv-372 (-> (the-as (array editable-point) sv-288) s5-4)) (set! sv-376 sv-400) ) ) (else (when (or (not sv-372) (< sv-400 sv-376)) (set! sv-372 (-> (the-as (array editable-point) sv-288) s5-4)) (set! sv-376 sv-400) ) ) ) ) ) (set! (-> this vertex sv-296) sv-372) (dotimes (v1-137 sv-292) (if (= sv-372 (-> (the-as (array editable-point) sv-288) v1-137)) (set! (-> (the-as (array editable-point) sv-288) v1-137) #f) ) ) (set! sv-296 (+ sv-296 1)) (set! sv-380 (not sv-380)) ) (if (< (vector-dot (-> this normal) (editable-face-method-31 this (new 'stack-no-clear 'vector))) 0.0) (logxor! (-> this flags) (editable-flag orient)) ) ) ) ) (format 0 "ugh 3~%") (editable-face-method-31 this (-> this normal)) (format 0 "ugh 4~%") ;; TODO - we set the center ;; (set! (-> this center quad) (-> (edit-get-trans this) quad)) (the-as symbol 0) ) (defmethod editable-method-10 ((this editable-face)) ;; Greatly simplify the code here (let ((points (new 'stack-no-clear 'inline-array 'vector 4))) (dotimes (point-idx 4) ;; (inspect this) (set! (-> points point-idx quad) (-> this vertex point-idx trans quad)) ) ;; Draw the normal (add-debug-x #t (bucket-id debug-no-zbuf1) (-> this center) (new 'static 'rgba :r #xff :g #xff :a #x80)) (add-debug-vector #t (bucket-id debug-no-zbuf1) (-> this center) (-> this normal) (meters 2) (new 'static 'rgba :r #xff :g #xff :a #x30) ) ;; Draw the plane (add-debug-bound (bucket-id debug2) points 4 ;; 4 points ;; tone down the opacity of the boundary so you aren't blinded / can actually stand a chance at reading the text (if (logtest? (-> this flags) (editable-flag orient)) (new 'static 'rgba :r #xff :a #x30) (new 'static 'rgba :r #xff :g #xff :a #x30) ) (if (not (logtest? (-> this flags) (editable-flag orient))) (new 'static 'rgba :r #xff :a #x30) (new 'static 'rgba :r #xff :g #xff :a #x30) ) (if (logtest? (-> this flags) (editable-flag selected)) 1 0) ) ) ;; (local-vars (sv-112 int)) ;; (let ((gp-0 (new 'stack-no-clear 'inline-array 'vector 6))) ;; (dotimes (v1-0 6) ;; (set! (-> gp-0 v1-0 quad) (the-as uint128 0)) ;; ) ;; (set! sv-112 (editable-face-method-30 this gp-0)) ;; (when (>= sv-112 3) ;; (let ((s1-0 (editable-face-method-31 this (new 'stack-no-clear 'vector)))) ;; (add-debug-vector ;; #t ;; (bucket-id debug-no-zbuf1) ;; (edit-get-trans this) ;; s1-0 ;; (meters 2) ;; (new 'static 'rgba :r #xff :g #xff :a #x80) ;; ) ;; ) ;; (when (logtest? (-> this flags) (editable-flag selected)) ;; (dotimes (s4-1 sv-112) ;; (let ((s3-1 add-debug-text-3d) ;; (s2-1 #t) ;; (s1-1 318) ;; ) ;; (format (clear *temp-string*) "~D" s4-1) ;; (s3-1 ;; s2-1 ;; (the-as bucket-id s1-1) ;; *temp-string* ;; (-> gp-0 s4-1) ;; (if (logtest? (-> this flags) (editable-flag orient)) ;; (font-color yellow) ;; (font-color white) ;; ) ;; (the-as vector2h #f) ;; ) ;; ) ;; ) ;; ) ;; (add-debug-bound ;; (bucket-id debug2) ;; gp-0 ;; sv-112 ;; (if (logtest? (-> this flags) (editable-flag orient)) ;; (new 'static 'rgba :r #xff :a #x80) ;; (new 'static 'rgba :r #xff :g #xff :a #x80) ;; ) ;; (if (not (logtest? (-> this flags) (editable-flag orient))) ;; (new 'static 'rgba :r #xff :a #x80) ;; (new 'static 'rgba :r #xff :g #xff :a #x80) ;; ) ;; (if (logtest? (-> this flags) (editable-flag selected)) ;; 1 ;; 0 ;; ) ;; ) ;; ) ;; ) 0 (none) ) (defmethod edit-get-trans ((this editable-plane)) "Returns the `trans` [[vector]] or [[*null-vector*]]" (if (>= (-> this length) 1) (edit-get-trans (-> this vertex 0)) *null-vector* ) ) (defmethod editable-method-22 ((this editable-plane) (arg0 editable-array) (arg1 int) (arg2 int)) (format 0 "TODO - UPDATE THIS") ;; (let ((s4-0 (clear *temp-string*))) ;; (format ;; s4-0 ;; "insert into region_face set kind='plane',region_id=~D,radius=~f" ;; (-> this region id) ;; (-> this radius) ;; ) ;; (let ((a0-4 (sql-query s4-0))) ;; (if (!= (-> a0-4 error) 'modify) ;; (return #f) ;; ) ;; ) ;; ) ;; (dotimes (s4-1 (-> this length)) ;; (editable-method-22 (-> this vertex s4-1) arg0 2 s4-1) ;; ) ;; (logclear! (-> this flags) (editable-flag changed)) #t ) (defmethod editable-method-25 ((this editable-plane) (arg0 editable-array)) (dotimes (s4-0 (-> this length)) (let ((s3-0 (-> this vertex s4-0))) (set! (-> s3-0 owner) (delete! this (-> s3-0 owner))) ) ) (call-parent-method this arg0) (none) ) (defmethod editable-method-26 ((this editable-plane) (arg0 editable) (arg1 editable-array)) (editable-array-method-15 arg1 this) ((method-of-type editable editable-method-26) this arg0 arg1) (none) ) ;; WARN: Return type mismatch editable-plane vs editable. (defmethod editable-method-27 ((this editable-plane) (arg0 editable-array)) (let ((gp-1 (the-as editable-plane (call-parent-method this arg0)))) (dotimes (s4-0 (-> gp-1 length)) (set! (-> gp-1 vertex s4-0) (the-as editable-point (editable-method-27 (-> gp-1 vertex s4-0) arg0))) (set! (-> gp-1 vertex s4-0 owner) (cons gp-1 (-> gp-1 vertex s4-0 owner))) ) (the-as editable gp-1) ) ) (defmethod editable-method-24 ((this editable-plane)) (let ((s5-1 (vector-! (new 'stack-no-clear 'vector) (edit-get-trans (-> this vertex 1)) (edit-get-trans (-> this vertex 0)) ) ) ) (edit-coord! (-> this vertex 1) (vector-! s5-1 (edit-get-trans (-> this vertex 0)) s5-1) (editable-flag x y z) ) ) (set! (-> this region changed) #t) (logior! (-> this flags) (editable-flag changed)) 0 (none) ) (defmethod editable-plane-method-30 ((this editable-plane) (arg0 (inline-array vector))) ;; og:preserve-this ;; This function converts 2 points (defining the normal) along with the radius into the 4 points that describe the plane ;; this means that they can only generate square planes, so this code is no longer used ;; (case (-> this length) ;; ((2) ;; (let* ((v1-2 (editable-plane-method-31 this (new 'stack-no-clear 'vector))) ;; (s5-1 (vector-cross! ;; (new 'stack-no-clear 'vector) ;; v1-2 ;; (if (< 0.7 (fabs (vector-dot v1-2 (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) ;; ) ;; ) ;; ) ;; (s4-1 (vector-cross! (new 'stack-no-clear 'vector) s5-1 v1-2)) ;; (f30-0 (-> this radius)) ;; ) ;; (let ((v1-4 (edit-get-trans (-> this vertex 0)))) ;; (vector+float*! (-> arg0 0) v1-4 s5-1 f30-0) ;; (vector+float*! (-> arg0 0) (-> arg0 0) s4-1 (- f30-0)) ;; (vector+float*! (-> arg0 1) v1-4 s5-1 (- f30-0)) ;; (vector+float*! (-> arg0 1) (-> arg0 1) s4-1 (- f30-0)) ;; (vector+float*! (-> arg0 2) v1-4 s5-1 f30-0) ;; (vector+float*! (-> arg0 2) (-> arg0 2) s4-1 f30-0) ;; (vector+float*! (-> arg0 3) v1-4 s5-1 (- f30-0)) ;; ) ;; (vector+float*! (-> arg0 3) (-> arg0 3) s4-1 f30-0) ;; ) ;; 4 ;; ) ;; (else ;; 0 ;; ) ;; ) 0 ) (defmethod editable-plane-method-31 ((this editable-plane) (arg0 vector)) (case (-> this length) ((2) (let ((s3-0 (-> this vertex 0)) (a0-1 (-> this vertex 1)) ) (vector-! arg0 (edit-get-trans a0-1) (edit-get-trans s3-0)) ) (vector-normalize! arg0 1.0) ) ) arg0 ) (defmethod edit-get-distance ((this editable-plane) (arg0 vector)) "Returns the distance from the camera to the [[editable]], or -1.0" (let ((gp-0 (new 'stack-no-clear 'vector)) (s5-0 (editable-plane-method-31 this (new 'stack-no-clear 'vector))) ) (let ((s1-0 (new 'stack-no-clear 'vector))) (set! (-> s1-0 quad) (-> (edit-get-trans (-> this vertex 0)) quad)) (transform-point-vector! gp-0 s1-0) ) (when (< 0.0 (-> gp-0 z)) (reverse-transform-point! gp-0 (edit-get-trans (-> this vertex 0)) s5-0 arg0) (let ((points (new 'stack-no-clear 'inline-array 'vector 4))) (dotimes (v1-6 4) (set! (-> points v1-6 quad) (the-as uint128 0)) ) (let ((s4-1 (editable-plane-method-30 this points)) (s2-2 0) (s1-2 (vector-negate! (new 'stack-no-clear 'vector) s5-0)) ) (while (< (+ s2-2 2) s4-1) (if (or (point-in-triangle-cross gp-0 s5-0 (-> points 0) (-> points 1) (-> points 2)) (point-in-triangle-cross gp-0 s1-2 (-> points 0) (-> points 1) (-> points 2)) ) (return (vector-vector-distance (camera-pos) gp-0)) ) (+! s2-2 1) (set! points (the-as (inline-array vector) (-> points 1))) ) ) ) ) ) -1.0 ) (defmethod editable-method-10 ((this editable-plane)) (let ((points (new 'stack-no-clear 'inline-array 'vector 4))) (dotimes (point-idx 4) ;; (inspect this) (set! (-> points point-idx quad) (-> this vertex point-idx trans quad)) ) ;; Draw the normal (add-debug-x #t (bucket-id debug-no-zbuf1) (-> this position) (new 'static 'rgba :r #xff :g #xff :a #x80)) (add-debug-vector #t (bucket-id debug-no-zbuf1) (-> this position) (-> this normal) (meters 2) (new 'static 'rgba :r #xff :g #xff :a #x30) ) ;; Draw the plane (add-debug-bound (bucket-id debug2) points 4 ;; 4 points ;; tone down the opacity of the boundary so you aren't blinded / can actually stand a chance at reading the text (new 'static 'rgba :r #xff :g #xff :a #x30) (new 'static 'rgba :r #xff :a #x30) (if (logtest? (-> this flags) (editable-flag selected)) 1 0) ) ) 0 (none) ) (defmethod editable-method-17 ((this editable-plane) (arg0 vector)) (format 0 "TODO - UPDATE THIS") ;; (let ((v1-0 (-> this region))) ;; (if v1-0 ;; (set! (-> v1-0 changed) #t) ;; ) ;; ) ;; (logior! (-> this flags) (editable-flag changed)) ;; (if (= (-> arg0 y) 0.0) ;; (+! (-> this radius) (-> arg0 x)) ;; (set! (-> this radius) (-> arg0 y)) ;; ) ;; (if (< (-> this radius) 0.0) ;; (set! (-> this radius) 0.0) ;; ) ;; (editable-method-28 this (editable-filter load)) ;; 0 (none) ) ;; WARN: Return type mismatch (array editable) vs editable-array. (defmethod relocate ((this editable-array) (arg0 int)) (the-as editable-array (when (nonzero? (-> this selection)) (let ((v0-0 (&+ (-> this selection) arg0))) (set! (-> this selection) v0-0) v0-0 ) ) ) ) (defmethod length ((this editable-array)) (-> this length) ) ;; WARN: Return type mismatch uint vs int. (defmethod asize-of ((this editable-array)) (the-as int (+ (-> this type size) (* (-> this allocated-length) 4))) ) (defmethod editable-array-method-11 ((this editable-array)) (dotimes (v1-0 (-> this length)) (if (not (-> this data v1-0)) (return v1-0) ) ) (when (< (-> this length) (-> this allocated-length)) (+! (-> this length) 1) (return (+ (-> this length) -1)) ) -1 ) (defmethod editable-array-method-10 ((this editable-array) (arg0 vector) (arg1 int)) (when (or (!= (-> arg0 x) (-> *editable-work* last-x)) (!= (-> arg0 y) (-> *editable-work* last-y))) (set! (-> *editable-work* last-found) 0) (set! (-> *editable-work* last-x) (-> arg0 x)) (set! (-> *editable-work* last-y) (-> arg0 y)) ) 4095996000.0 (let ((s5-0 (the-as editable #f))) (set! (-> *editable-work* num-found) 0) (let* ((s2-0 (-> this length)) (s1-0 0) (s0-0 (-> this data s1-0)) ) (while (< s1-0 s2-0) (when (and s0-0 (or (and (logtest? (-> s0-0 region filter) (-> this filter 0)) (logtest? (-> s0-0 region filter) (-> this filter 1)) ) (logtest? (-> s0-0 flags) (editable-flag selected)) ) ) (let ((f0-5 (edit-get-distance s0-0 arg0))) (when (>= f0-5 0.0) (set! (-> *editable-work* found (-> *editable-work* num-found)) s0-0) (set! (-> *editable-work* dists (-> *editable-work* num-found)) (the-as uint f0-5)) (if (< (-> *editable-work* num-found) 255) (+! (-> *editable-work* num-found) 1) ) ) ) ) (+! s1-0 1) (set! s0-0 (-> this data s1-0)) ) ) (countdown (v1-43 (-> *editable-work* num-found)) (when (> v1-43 0) (countdown (a0-12 v1-43) (when (< (the-as float (-> *editable-work* dists v1-43)) (the-as float (-> *editable-work* dists a0-12))) (let ((a1-10 (-> *editable-work* found v1-43)) (f0-7 (-> *editable-work* dists v1-43)) ) (set! (-> *editable-work* found v1-43) (-> *editable-work* found a0-12)) (set! (-> *editable-work* dists v1-43) (-> *editable-work* dists a0-12)) (set! (-> *editable-work* found a0-12) a1-10) (set! (-> *editable-work* dists a0-12) f0-7) ) ) ) ) ) (when (nonzero? (-> *editable-work* num-found)) (when (>= (-> *editable-work* last-found) (-> *editable-work* num-found)) (set! (-> *editable-work* last-found) 0) 0 ) (set! s5-0 (cond ((zero? arg1) (set! s5-0 (-> *editable-work* found (-> *editable-work* last-found))) (+! (-> *editable-work* last-found) 1) s5-0 ) (else (-> *editable-work* found 0) ) ) ) ) s5-0 ) ) (defmethod editable-array-method-14 ((this editable-array) (arg0 (function editable editable-region symbol)) (arg1 editable-region)) (let ((gp-0 (-> this selection))) (set! (-> gp-0 length) 0) (let* ((s2-0 (-> this length)) (s1-0 0) (s0-0 (-> this data s1-0)) ) (while (< s1-0 s2-0) (when (and s0-0 (logtest? (-> s0-0 flags) (editable-flag selected))) (when (arg0 s0-0 arg1) (set! (-> gp-0 (-> gp-0 length)) s0-0) (+! (-> gp-0 length) 1) ) ) (+! s1-0 1) (set! s0-0 (-> this data s1-0)) ) ) gp-0 ) ) (defmethod editable-array-method-15 ((this editable-array) (arg0 editable)) (let ((gp-0 (-> arg0 region))) (when gp-0 (editable-method-25 arg0 this) (let* ((v1-3 (-> this length)) (a0-2 0) (a1-4 (-> this data a0-2)) ) (while (< a0-2 v1-3) (if (and a1-4 (= arg0 a1-4)) (set! (-> this data a0-2) #f) ) (+! a0-2 1) (set! a1-4 (-> this data a0-2)) ) ) (let* ((v1-6 (-> this length)) (a0-3 0) (a1-14 (-> this data a0-3)) ) (while (< a0-3 v1-6) (if (and a1-14 (= (-> a1-14 region) gp-0) (!= a1-14 arg0)) (goto cfg-21) ) (+! a0-3 1) (set! a1-14 (-> this data a0-3)) ) ) (editable-region-method-10 gp-0 0) ) ) (label cfg-21) 0 (none) ) ;; WARN: Return type mismatch symbol vs none. ;; WARN: Function (method 12 editable-array) has a return type of none, but the expression builder found a return statement. (defmethod editable-array-method-12 ((this editable-array) (arg0 editable-array)) (local-vars (sv-16 sql-result) (sv-20 sql-result) (sv-24 sql-result) (sv-28 sql-result) (sv-32 sql-result) (sv-36 editable-region) (sv-40 float) (sv-44 float) (sv-64 int) (sv-72 int) (sv-80 editable-plane) (sv-84 string) (sv-112 vector) (sv-120 int) (sv-128 editable-point) (sv-136 int) (sv-144 int) (sv-152 editable-face) (sv-156 string) (sv-176 vector) (sv-180 editable) (sv-184 int) (sv-192 int) (sv-200 editable-point) (sv-208 int) (sv-216 sql-result) (sv-240 sql-result) ) (format #t "sql: load from level ~A~%" arg0) (set! (-> *editable-sample-region* level) (the-as string arg0)) (set! (-> *editable-light-region* level) (the-as string arg0)) (set! (-> *editable-entity-region* level) (the-as string arg0)) (vector-reset! (-> this level-offset)) (set! (-> this level-info-id) (the-as uint -1)) (set! (-> this level) (the-as uint arg0)) (let ((s4-0 sql-query)) (format (clear *temp-string*) "select translate_x,translate_y,translate_z,level_info_id from level_info where name='~S'" arg0 ) (set! sv-16 (s4-0 *temp-string*)) ) (when (and (= (-> sv-16 error) 'select) (>= (-> sv-16 len) 3)) (set-vector! (-> this level-offset) (* 4096.0 (string->float (-> sv-16 data 0))) (* 4096.0 (string->float (-> sv-16 data 1))) (* 4096.0 (string->float (-> sv-16 data 2))) 1.0 ) (set! (-> this level-info-id) (the-as uint (string->int (-> sv-16 data 3)))) ) (let ((s4-2 sql-query)) (format (clear *temp-string*) "select region_id,level_name,tree,on_enter,on_exit,on_inside from region where level_name='~S'" arg0 ) (set! sv-20 (s4-2 *temp-string*)) ) (if (!= (-> sv-20 error) 'select) (return #f) ) (format #t "sql: read region ~D~%" (/ (-> sv-20 len) 6)) (let ((s4-3 sql-query)) (format (clear *temp-string*) "select region_face.region_id,region_face_id,kind,flags,normal_x,normal_y,normal_z,normal_w,pos_x,pos_y,pos_z,pos_w from region,region_face where level_name='~S' and region.region_id=region_face.region_id" arg0 ) (set! sv-24 (s4-3 *temp-string*)) ) (if (!= (-> sv-24 error) 'select) (return #f) ) (format #t "sql: read face ~D~%" (/ (-> sv-24 len) 12)) (let ((s4-4 sql-query)) (format (clear *temp-string*) "select region_face.region_face_id,idx,x,y,z,w from region,region_face,region_point where level_name='~S' and region.region_id=region_face.region_id and region_face.region_face_id=region_point.region_face_id" arg0 ) (set! sv-28 (s4-4 *temp-string*)) ) (if (!= (-> sv-28 error) 'select) (return #f) ) ;; og:preserve-this (format #t "sql: read point ~D~%" (/ (-> sv-28 len) 6)) (let ((s4-5 sql-query)) (format (clear *temp-string*) "select region_sphere.region_id,x,y,z,r from region,region_sphere where level_name='~S' and region.region_id=region_sphere.region_id" arg0 ) (set! sv-32 (s4-5 *temp-string*)) ) (if (!= (-> sv-32 error) 'select) (return #f) ) (format #t "sql: read sphere ~D~%" (/ (-> sv-32 len) 5)) (let ((s5-1 0)) (while (< s5-1 (-> sv-20 len)) (set! sv-36 (new 'debug 'editable-region)) (set! sv-40 (the-as float 4095996000.0)) (set! sv-44 (the-as float -4095996000.0)) (set! (-> sv-36 id) (the-as uint (string->int (-> sv-20 data s5-1)))) (set! (-> sv-36 level) (the-as string (string->symbol (-> sv-20 data (+ s5-1 1))))) (set! (-> sv-36 tree) (string->symbol (-> sv-20 data (+ s5-1 2)))) (set! (-> sv-36 on-enter) (if (string= (-> sv-20 data (+ s5-1 3)) "") (the-as string #f) (-> sv-20 data (+ s5-1 3)) ) ) (set! (-> sv-36 on-exit) (if (string= (-> sv-20 data (+ s5-1 4)) "") (the-as string #f) (-> sv-20 data (+ s5-1 4)) ) ) (set! (-> sv-36 on-inside) (if (string= (-> sv-20 data (+ s5-1 5)) "") (the-as string #f) (-> sv-20 data (+ s5-1 5)) ) ) (let* ((v1-75 (-> this length)) (a0-54 0) (a1-17 (-> this data a0-54)) ) (while (< a0-54 v1-75) (if (and a1-17 (-> a1-17 region) (= (-> a1-17 region id) (-> sv-36 id))) (set! (-> this data a0-54) #f) ) (+! a0-54 1) (set! a1-17 (-> this data a0-54)) ) ) (let ((s4-6 0)) (while (< s4-6 (-> sv-32 len)) (when (= (-> sv-36 id) (string->int (-> sv-32 data s4-6))) (let ((s3-5 (editable-array-method-11 this))) (when (>= s3-5 0) (let ((s2-1 (new 'stack-no-clear 'vector))) (set! (-> s2-1 x) (string->float (-> sv-32 data (+ s4-6 1)))) (set! (-> s2-1 y) (string->float (-> sv-32 data (+ s4-6 2)))) (set! (-> s2-1 z) (string->float (-> sv-32 data (+ s4-6 3)))) (set! (-> s2-1 w) 1.0) (vector+! s2-1 s2-1 (-> this level-offset)) (let ((s2-2 (new 'debug 'editable-sphere s2-1 2048.0 sv-36))) (set! (-> s2-2 radius) (string->float (-> sv-32 data (+ s4-6 4)))) (set! (-> this data s3-5) s2-2) ) ) ) ) ) (+! s4-6 5) ) ) (set! sv-64 0) (while (< sv-64 (-> sv-24 len)) (when (= (-> sv-36 id) (string->int (-> sv-24 data sv-64))) (cond ((string= (-> sv-24 data (+ sv-64 2)) "plane") (set! sv-72 (editable-array-method-11 this)) (set! sv-80 (new 'debug 'editable-plane sv-36)) (set! sv-84 (-> sv-24 data (+ sv-64 1))) (when (>= sv-72 0) (set! (-> this data sv-72) sv-80) (set! (-> sv-80 normal x) (string->float (-> sv-24 data (+ sv-64 4)))) (set! (-> sv-80 normal y) (string->float (-> sv-24 data (+ sv-64 5)))) (set! (-> sv-80 normal z) (string->float (-> sv-24 data (+ sv-64 6)))) (set! (-> sv-80 normal w) (string->float (-> sv-24 data (+ sv-64 7)))) (set! (-> sv-80 position x) (string->float (-> sv-24 data (+ sv-64 8)))) (set! (-> sv-80 position y) (string->float (-> sv-24 data (+ sv-64 9)))) (set! (-> sv-80 position z) (string->float (-> sv-24 data (+ sv-64 10)))) (set! (-> sv-80 position w) (string->float (-> sv-24 data (+ sv-64 11)))) (countdown (s4-7 (/ (-> sv-28 len) 6)) (when (string= (-> sv-28 data (+ (* 6 s4-7) 0)) sv-84) (let ((s3-6 (new 'stack-no-clear 'vector))) (set! (-> s3-6 x) (string->float (-> sv-28 data (+ (* 6 s4-7) 2)))) (set! (-> s3-6 y) (string->float (-> sv-28 data (+ (* 6 s4-7) 3)))) (set! (-> s3-6 z) (string->float (-> sv-28 data (+ (* 6 s4-7) 4)))) (set! (-> s3-6 w) (string->float (-> sv-28 data (+ (* 6 s4-7) 5)))) (set! sv-112 s3-6) ) (vector+! sv-112 sv-112 (-> this level-offset)) (set! sv-120 (editable-array-method-11 this)) (when (>= sv-120 0) (set! sv-128 (new 'debug 'editable-point sv-112 sv-36)) (set! sv-136 (string->int (-> sv-28 data (+ (* 6 s4-7) 1)))) (set! (-> this data sv-120) sv-128) (set! (-> sv-80 vertex sv-136) sv-128) (set! (-> sv-80 length) (max (-> sv-80 length) (+ sv-136 1))) (set! (-> sv-128 owner) (cons sv-80 (-> sv-128 owner))) ) ) ) (editable-method-28 sv-80 (editable-filter load)) (editable-method-29 sv-80 (editable-filter load)) ) ) ((string= (-> sv-24 data (+ sv-64 2)) "face") (set! sv-144 (editable-array-method-11 this)) (set! sv-152 (new 'debug 'editable-face sv-36)) (set! sv-156 (-> sv-24 data (+ sv-64 1))) (when (>= sv-144 0) (set! (-> this data sv-144) sv-152) (if (string= (-> sv-24 data (+ sv-64 3)) "orient") (logior! (-> sv-152 flags) (editable-flag orient)) ) (set! (-> sv-152 normal x) (string->float (-> sv-24 data (+ sv-64 4)))) (set! (-> sv-152 normal y) (string->float (-> sv-24 data (+ sv-64 5)))) (set! (-> sv-152 normal z) (string->float (-> sv-24 data (+ sv-64 6)))) (set! (-> sv-152 normal w) (string->float (-> sv-24 data (+ sv-64 7)))) (set! (-> sv-152 center x) (string->float (-> sv-24 data (+ sv-64 8)))) (set! (-> sv-152 center y) (string->float (-> sv-24 data (+ sv-64 9)))) (set! (-> sv-152 center z) (string->float (-> sv-24 data (+ sv-64 10)))) (set! (-> sv-152 center w) (string->float (-> sv-24 data (+ sv-64 11)))) (countdown (s4-8 (/ (-> sv-28 len) 6)) (when (string= (-> sv-28 data (+ (* 6 s4-8) 0)) sv-156) (let ((s3-7 (new 'stack-no-clear 'vector))) (set! (-> s3-7 x) (string->float (-> sv-28 data (+ (* 6 s4-8) 2)))) (set! (-> s3-7 y) (string->float (-> sv-28 data (+ (* 6 s4-8) 3)))) (set! (-> s3-7 z) (string->float (-> sv-28 data (+ (* 6 s4-8) 4)))) (set! (-> s3-7 w) (string->float (-> sv-28 data (+ (* 6 s4-8) 5)))) (set! sv-176 s3-7) ) (vector+! sv-176 sv-176 (-> this level-offset)) (let* ((s3-8 (-> this length)) (s2-3 0) (s1-0 (-> this data s2-3)) ) (while (< s2-3 s3-8) (when (and s1-0 (= (-> s1-0 region) sv-36) (type? s1-0 editable-point)) (when (vector= (-> (the-as editable-point s1-0) trans) sv-176) (set! sv-180 s1-0) (set! sv-184 (string->int (-> sv-28 data (+ (* 6 s4-8) 1)))) (set! (-> sv-152 vertex sv-184) (the-as editable-point sv-180)) (set! (-> sv-152 length) (max (-> sv-152 length) (+ sv-184 1))) (set! (-> sv-180 owner) (cons sv-152 (-> sv-180 owner))) ) ) (+! s2-3 1) (set! s1-0 (-> this data s2-3)) ) ) (if (< (-> sv-176 y) sv-40) (set! sv-40 (-> sv-176 y)) ) (if (< sv-44 (-> sv-176 y)) (set! sv-44 (the-as float (-> sv-176 y))) ) (set! sv-192 (editable-array-method-11 this)) (when (>= sv-192 0) (set! sv-200 (new 'debug 'editable-point sv-176 sv-36)) (set! sv-208 (string->int (-> sv-28 data (+ (* 6 s4-8) 1)))) (set! (-> this data sv-192) sv-200) (set! (-> sv-152 vertex sv-208) sv-200) (set! (-> sv-152 length) (max (-> sv-152 length) (+ sv-208 1))) (set! (-> sv-200 owner) (cons sv-152 (-> sv-200 owner))) ) )) (editable-method-28 sv-152 (editable-filter load)) ;; this seems to mostly derive fields that we have already included in the database ;; I'll have to figure out later if it does more when i care about supporting modifications ;; (editable-method-29 sv-152 (editable-filter load)) ) ) ) ) (set! sv-64 (+ sv-64 5)) ) (let* ((v1-293 (-> this length)) (a0-158 0) (a1-57 (-> this data a0-158)) ) (while (< a0-158 v1-293) (when (and a1-57 (= (-> a1-57 region) sv-36) (= (-> a1-57 type) editable-point)) (let ((a2-29 (-> (the-as editable-point a1-57) trans))) (if (= (-> a2-29 y) sv-40) (logior! (-> a1-57 flags) (editable-flag bot-set)) ) (if (= (-> a2-29 y) sv-44) (logior! (-> a1-57 flags) (editable-flag top-set)) ) ) ) (+! a0-158 1) (set! a1-57 (-> this data a0-158)) ) ) (set! (-> sv-36 changed) #f) (+! s5-1 6) ) ) (let ((s5-2 sql-query)) (format (clear *temp-string*) "select x,y,z from sample_point where level_info_id='~D' and source='manual'" (-> this level-info-id) ) (set! sv-216 (s5-2 *temp-string*)) ) (if (!= (-> sv-216 error) 'select) (return #f) ) (let ((s5-3 0)) (while (< s5-3 (-> sv-216 len)) (let ((s4-10 (editable-array-method-11 this))) (when (>= s4-10 0) (let ((s3-9 (new 'stack-no-clear 'vector))) (set! (-> s3-9 x) (* 4096.0 (string->float (-> sv-216 data s5-3)))) (set! (-> s3-9 y) (* 4096.0 (string->float (-> sv-216 data (+ s5-3 1))))) (set! (-> s3-9 z) (* 4096.0 (string->float (-> sv-216 data (+ s5-3 2))))) (set! (-> s3-9 w) 1.0) (vector+! s3-9 s3-9 (-> this level-offset)) (set! (-> this data s4-10) (new 'debug 'editable-sample s3-9 *editable-sample-region*)) ) ) ) (+! s5-3 3) ) ) (set! (-> *editable-sample-region* changed) #f) (let ((s5-4 sql-query)) (format (clear *temp-string*) "select light_id,name,pos_x,pos_y,pos_z,r,dir_x,dir_y,dir_z,color0_r,color0_g,color0_b,color0_a,decay_start,ambient_point_ratio,brightness from light where level_name='~S'" (-> this level) ) (set! sv-240 (s5-4 *temp-string*)) ) (format #t "sql: read light ~D~%" (/ (-> sv-240 len) 16)) (if (!= (-> sv-240 error) 'select) (return #f) ) (let ((s5-5 0)) (while (< s5-5 (-> sv-240 len)) (let ((s3-10 (editable-array-method-11 this))) (when (>= s3-10 0) (let ((s4-12 (new 'stack-no-clear 'vector))) (set! (-> s4-12 x) (* 4096.0 (string->float (-> sv-240 data (+ s5-5 2))))) (set! (-> s4-12 y) (* 4096.0 (string->float (-> sv-240 data (+ s5-5 3))))) (set! (-> s4-12 z) (* 4096.0 (string->float (-> sv-240 data (+ s5-5 4))))) (set! (-> s4-12 w) 1.0) (vector+! s4-12 s4-12 (-> this level-offset)) (let ((s4-13 (new 'debug 'editable-light s4-12 2048.0 *editable-light-region*))) (set! (-> this data s3-10) s4-13) (set! (-> s4-13 id) (the-as uint (string->int (-> sv-240 data s5-5)))) (set! (-> s4-13 name) (-> sv-240 data (+ s5-5 1))) (set! (-> s4-13 radius) (* 4096.0 (string->float (-> sv-240 data (+ s5-5 5))))) (set-vector! (-> s4-13 direction) (string->float (-> sv-240 data (+ s5-5 6))) (string->float (-> sv-240 data (+ s5-5 7))) (string->float (-> sv-240 data (+ s5-5 8))) 1.0 ) (if (and (= (-> s4-13 direction x) 0.0) (= (-> s4-13 direction y) 0.0) (= (-> s4-13 direction z) 0.0)) (set! (-> s4-13 direction w) 0.0) ) (set-vector! (-> s4-13 color) (string->float (-> sv-240 data (+ s5-5 9))) (string->float (-> sv-240 data (+ s5-5 10))) (string->float (-> sv-240 data (+ s5-5 11))) (string->float (-> sv-240 data (+ s5-5 12))) ) (set! (-> s4-13 decay-start) (string->float (-> sv-240 data (+ s5-5 13)))) (set! (-> s4-13 ambient-point-ratio) (string->float (-> sv-240 data (+ s5-5 14)))) (set! (-> s4-13 brightness) (string->float (-> sv-240 data (+ s5-5 15)))) ) ) ) ) (+! s5-5 16) ) ) (set! (-> *editable-light-region* changed) #f) (editable-array-method-9 this (editable-command refresh-filter) (the-as mouse-info #f)) #t (none) ) (defmethod editable-array-method-13 ((this editable-array) (arg0 editable-command) (arg1 editable-command) (arg2 string)) (set! (-> this target) #f) (set! (-> this target-mode) arg0) (set! (-> this target-command) arg1) (set! (-> this target-message) arg2) 0 (none) ) (defmethod editable-array-method-16 ((this editable-array)) (cond ((-> this edit-plane) (editable-plane-method-31 (-> this edit-plane) (-> this edit-plane-normal)) (set! (-> this edit-plane-center quad) (-> (edit-get-trans (-> this edit-plane vertex 0)) quad)) ) (else (vector-negate! (-> this edit-plane-normal) (-> *math-camera* inv-camera-rot vector 2)) (let ((v1-9 (vector-float*! (-> this edit-plane-center) (-> *math-camera* inv-camera-rot vector 2) 24576.0))) (vector+! v1-9 v1-9 (-> *math-camera* trans)) ) ) ) 0 (none) ) (defmethod editable-array-method-17 ((this editable-array) (arg0 vector) (arg1 vector)) (cond ((and (cpad-hold? 0 up) *target*) (set! (-> arg0 quad) (-> (get-trans *target* 0) quad)) ) ((and (cpad-hold? 0 down) *camera*) (set! (-> arg0 quad) (-> (math-camera-pos) quad)) ) (else (editable-array-method-16 this) (reverse-transform-point! arg0 (-> this edit-plane-center) (-> this edit-plane-normal) arg1) ) ) arg0 ) (when (zero? *editable-sample-region*) (let ((v1-4 (new 'debug 'editable-region))) (set! (-> v1-4 locked) #t) (set! (-> v1-4 changed) #f) (set! (-> v1-4 tree) 'sample) (set! (-> v1-4 filter) (editable-filter sample)) (set! *editable-sample-region* v1-4) ) (let ((v1-6 (new 'debug 'editable-region))) (set! (-> v1-6 locked) #t) (set! (-> v1-6 changed) #f) (set! (-> v1-6 tree) 'light) (set! (-> v1-6 filter) (editable-filter light)) (set! *editable-light-region* v1-6) ) (let ((v0-84 (new 'debug 'editable-region))) (set! (-> v0-84 locked) #t) (set! (-> v0-84 changed) #f) (set! (-> v0-84 tree) 'entity) (set! (-> v0-84 filter) (editable-filter entity)) (set! *editable-entity-region* v0-84) ) )