X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=irrlicht%2Fbase.scm;h=db1de76f1bd8333f03a0a74bcb93528f74dcedb8;hb=c59d2be798005a3684d75c3f561568ad2cdac9c7;hp=bb04442f8a722f310fb73d61d9880bbd25b2bd7e;hpb=c9c098c6a9363eb59f435eb195a4bc5b9098b1dd;p=guile-irrlicht.git diff --git a/irrlicht/base.scm b/irrlicht/base.scm index bb04442..db1de76 100644 --- a/irrlicht/base.scm +++ b/irrlicht/base.scm @@ -22,14 +22,18 @@ #:use-module (oop goops) #:use-module (system foreign) #:export ( - wrapped-obj)) + irr-class + irr-pointer + is-empty?)) (define-class () - (irr-ptr #:init-value %null-pointer #:accessor irrlicht-pointer #:init-keyword #:ptr) - (irr-class #:init-value "irrlicht-base" #:getter irrlicht-class) - (wrapped-obj #:accessor wrapped-obj #:allocation #:virtual - #:slot-ref (lambda (obj) - (cons (slot-ref obj 'irr-class) - (slot-ref obj 'irr-ptr))) - #:slot-set! (lambda (obj wrapped) - (slot-set! obj 'irr-ptr (cdr wrapped))))) + (irr-class #:init-value "") + (irr-pointer #:init-value %null-pointer #:getter irr-pointer #:init-keyword #:irr-pointer)) + +;; irr-class getter is defined in this way to avoid problems with multiple getters +;; in multiple inherited classes +(define-method (irr-class (obj )) + (slot-ref obj 'irr-class)) + +(define-method (is-empty? (obj )) + (equal? (irr-pointer obj) %null-pointer))