;;-*-Lisp-*- (in-package goal) ;; name: loader-h.gc ;; name in dgo: loader-h ;; dgos: GAME, ENGINE (define-extern art-group type) ;; This type didn't have an inspect method, so these field names are made up. (deftype load-dir (basic) ((unknown basic) (string-array (array string)) ;; these are the names (data-array (array basic)) ;; this is the file data. ) :flag-assert #xb00000010 (:methods (new (symbol type int basic) _type_ 0) (dummy-9 () none 9) (dummy-10 () none 10) ) ) ;; specialization of load-dir where the data-array holds art-groups. (deftype load-dir-art-group (load-dir) () (:methods (new (symbol type int basic) _type_ 0) ) :flag-assert #xb00000010 ) (defmethod new load-dir ((allocation symbol) (type-to-make type) (length int) (unk basic)) "Allocate a new load-dir with room for length entries" (let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> obj unknown) unk) ;; create the name array (set! (-> obj string-array) (the-as (array string) ((method-of-type array new) allocation array string length) ) ) (set! (-> obj string-array length) 0) ;; create the data array (set! (-> obj data-array) (the-as (array basic) ((method-of-type array new) allocation array basic length) )) (set! (-> obj data-array length) 0) obj ) ) (defmethod new load-dir-art-group ((allocation symbol) (type-to-make type) (length int) (unk basic)) "Allocate a new load-dir with room for length art-groups" ;; call parent ctor. (let ((obj ((method-of-type load-dir new) allocation type-to-make length unk))) ;; override the content type (set! (-> obj data-array content-type) art-group) ;; and cast to child. (the-as load-dir-art-group obj) ) ) (deftype external-art-buffer (basic) ((index int32 :offset-assert 4) (other external-art-buffer :offset-assert 8) (status basic :offset-assert 12) (locked? basic :offset-assert 16) (frame-lock basic :offset-assert 20) (heap kheap :inline :offset-assert 32) (pending-load-file basic :offset-assert 48) (pending-load-file-part int32 :offset-assert 52) (pending-load-file-owner uint64 :offset-assert 56) (pending-load-file-priority float :offset-assert 64) (load-file basic :offset-assert 68) (load-file-part int32 :offset-assert 72) (load-file-owner uint64 :offset-assert 80) (load-file-priority float :offset-assert 88) (buf uint32 :offset-assert 92) (len int32 :offset-assert 96) (art-group basic :offset-assert 100) ) :method-count-assert 16 :size-assert #x68 :flag-assert #x1000000068 (:methods (new (symbol type int) _type_ 0) (dummy-9 () none 9) (dummy-10 () none 10) (dummy-11 () none 11) (dummy-12 () none 12) (dummy-13 () none 13) (dummy-14 () none 14) (dummy-15 () none 15) ) ) (defmethod new external-art-buffer ((allocation symbol) (type-to-make type) (idx int)) "Allocate a new external-art-buffer" (let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> obj index) idx) (set! (-> obj load-file) #f) (set! (-> obj load-file-part) -1) (set! (-> obj load-file-owner) (the-as uint #f)) (set! (-> obj load-file-priority) 100000000.0) (set! (-> obj pending-load-file) #f) (set! (-> obj pending-load-file-part) -1) (set! (-> obj pending-load-file-owner) (the-as uint #f)) (set! (-> obj pending-load-file-priority) 100000000.0) (set! (-> obj art-group) #f) (set! (-> obj status) 'initialize) (set! (-> obj locked?) #f) (set! (-> obj other) #f) obj ) ) (deftype spool-anim (basic) ((name basic :offset 16) ;; why? (index int32 :offset-assert 20) (parts int32 :offset-assert 24) (priority float :offset-assert 28) (owner uint64 :offset-assert 32) (command-list basic :offset-assert 40) ) :pack-me :method-count-assert 9 :size-assert #x2c :flag-assert #x90000002c ) (deftype external-art-control (basic) ((buffer external-art-buffer 2 :offset-assert 4) (rec spool-anim 3 :inline) (spool-lock uint64 :offset-assert 160) (reserve-buffer basic :offset-assert 168) (reserve-buffer-count int32 :offset-assert 172) (active-stream basic :offset-assert 176) (preload-stream spool-anim :inline :offset-assert 184) (last-preload-stream spool-anim :inline :offset-assert 232) (end-pad uint32) ) :method-count-assert 17 :size-assert #x118 :flag-assert #x1100000118 (:methods (new (symbol type) _type_ 0) (dummy-9 () none 9) (dummy-10 () none 10) (dummy-11 () none 11) (dummy-12 () none 12) (dummy-13 () none 13) (dummy-14 () none 14) (dummy-15 () none 15) (dummy-16 () none 16) ) ) (defmethod new external-art-control ((allocation symbol) (type-to-make type)) (let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size))))) ;; allocate buffers. (dotimes (buff-idx 2) (set! (-> obj buffer buff-idx) ((method-of-type external-art-buffer new) allocation external-art-buffer buff-idx) ) ) ;; point buffers to each other (set! (-> obj buffer 0 other) (-> obj buffer 1)) (set! (-> obj buffer 1 other) (-> obj buffer 0)) ;; set up recs (dotimes (rec-idx 3) (set! (-> obj rec rec-idx name) #f) (set! (-> obj rec rec-idx priority) 100000000.0) (set! (-> obj rec rec-idx owner) (the-as uint #f)) ) ;; set up defaults. (set! (-> obj spool-lock) (the-as uint #f)) (set! (-> obj reserve-buffer) #f) (set! (-> obj active-stream) #f) (set! (-> obj preload-stream name) #f) (set! (-> obj preload-stream priority) 100000000.0) (set! (-> obj preload-stream owner) (the-as uint #f)) (set! (-> obj last-preload-stream name) #f) (set! (-> obj last-preload-stream priority) 100000000.0) (set! (-> obj last-preload-stream owner) (the-as uint #f)) obj ) )