;; Copyright (C) 2024 Tommi Höynälänmaa

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

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

(define-class <a> ()
  (x #:init-keyword #:x #:init-value #f))

(define-class <b> (<a>)
  (y #:init-keyword #:y #:init-value #f))

(define-class <c> ()
  (i #:init-keyword #:i #:init-value 0)
  (str #:init-keyword #:str #:init-value ""))

(define-class <d> (<c>)
  (r #:init-keyword #:r))

(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))

(define (make-invalid-c)
  (make <c> #:i 'abc #:str 0))

