
(define-module (theme-d testing custom2)
  #:export (<a>
	    <b>
	    make-a
	    get-x
	    set-x!
	    make-b
	    get-y
	    set-y!
	    my-rep
	    count-goops-classes))

(import (oop goops))
(import (theme-d runtime runtime-theme-d-environment))

(define-class <a> () x)

(define-class <b> (<a>) y)

(define (make-a x)
  (let ((a (make <a>)))
    (slot-set! a 'x x)
    a))

(define (get-x a) (slot-ref a 'x))

(define (set-x! a x) (slot-set! a 'x x))

(define (make-b x y)
  (let ((b (make <b>)))
    (slot-set! b 'x x)
    (slot-set! b 'y y)
    b))

(define (get-y b) (slot-ref b 'y))

(define (set-y! b y) (slot-set! b 'y y))

(define-method (my-rep (a <a>) (prefix <string>))
  (string-append prefix (number->string (slot-ref a 'x))))

(define-method (my-rep (b <b>) (prefix <string>))
  (string-append prefix
		 (number->string (slot-ref b 'x))
		 (number->string (slot-ref b 'y))))

(define (count-goops-classes)
  (let ((i-count 0))
    (hash-count (lambda (key value) (if (eq? key <a>)
					(set! i-count (+ i-count 1))))
	      gl-ht-goops-assoc)
    i-count))
