; =====================================
; Cuboideroids
; would-be game, if mouse-over worked
; =====================================

(save-name "cuboideroids-0.0.1.scm")

; =====================================
; object
; =====================================
(define object
  (lambda args
    (let ((class object) (super '()))
      (define (make) (assoc-set! '() 'class class))
      (let ((self (car args)))
        (define (get-class) (assoc-ref self 'class))
        (cond ; must declare methods
          ((eq? (car args) 'make) (apply make (cdr args)))
          ((eq? (cadr args) 'get-class) (apply get-class (cddr args)))
          (else (display "no method: ") (display args) (newline))
        )
      )
    )
  )
)

; =====================================
; dynamic method dispatcher
; =====================================
(define oo
  (lambda args
    (apply (object (car args) 'get-class) args)
  )
)

; =====================================
; actor
; =====================================
(define actor
  (lambda args
    (let ((class actor) (super object))
      (define (make)
        (assoc-set! (super 'make) 'class class)
      )
      (let ((self (car args)))
        (define (update!) 0)
        (define (render) 0)
        (define (alive?) #t)
        (cond
          ((eq? (car args) 'make) (apply make (cdr args)))
          ((eq? (cadr args) 'update!) (apply update! (cddr args)))
          ((eq? (cadr args) 'render) (apply render (cddr args)))
          ((eq? (cadr args) 'alive?) (apply alive? (cddr args)))
        )
      )
    )
  )
)

; =====================================
; actors
; =====================================
(define actors
  (lambda args
    (let ((class actors) (super actor))
      (define (make)
        (assoc-set! (assoc-set! (super 'make) 'class class) 'contents '())
      )
      (let ((self (car args)))
        (define (add! x)
          (assoc-set! self 'contents (cons x (assoc-ref self 'contents)))
        )
        (define (update!)
          (for-each (lambda (o) (oo o 'update!))
            (assoc-ref self 'contents))
          (assoc-set! self 'contents (filter (lambda (o) (oo o 'alive?))
            (assoc-ref self 'contents)))
        )
        (define (render) (for-each (lambda (o) (oo o 'render))
            (assoc-ref self 'contents)))
        (define (alive?) (< 0 (length (assoc-ref self 'contents))))
        (cond ; declare methods
          ((eq? (car  args) 'make) (apply make (cdr args)))
          ((eq? (cadr args) 'add!) (apply add! (cddr args)))
          ((eq? (cadr args) 'update!) (apply update! (cddr args)))
          ((eq? (cadr args) 'render) (apply render (cddr args)))
          ((eq? (cadr args) 'alive?) (apply alive? (cddr args)))
          (else (apply super args)) ; delegate to super-class
        )
      )
    )
  )
)

(define maus-over '())

; =====================================
; cuboideroid
; =====================================
(define cuboideroid
  (lambda args
    (let ((class cuboideroid) (super actor))
      (define (make)
        (let ((obj (build-cube)))
          (active-box obj)
          (assoc-set! (assoc-set! (assoc-set!
            (super 'make)
            'class class) 'alive #t) 'obj obj)
        )
      )
      (let ((self (car args)))
        (define (update!)
          (let ((obj (assoc-ref self 'obj)))
            (if (and (equal? maus-over obj) (mouse-button 1))
              (begin
                (destroy obj)
                (assoc-set! self 'obj '())
                (assoc-set! self 'alive #f)
              )
            )
          )
        )
        (define (render) self)
        (define (alive?) (assoc-ref self 'alive))
        (cond
          ((eq? (car args) 'make) (apply make (cdr args)))
          ((eq? (cadr args) 'update!) (apply update! (cddr args)))
          ((eq? (cadr args) 'render) (apply render (cddr args)))
          ((eq? (cadr args) 'alive?) (apply alive? (cddr args)))
          (else (apply super args))
        )
      )
    )
  )
)

; =====================================
; global options
; =====================================

(clear)
(gravity (vector 0 0 0))
(collisions 1)
(surface-params 0.4 0.4 3 5)

; =====================================
; container
; =====================================

(define box '())
(ground-plane (vector 0 0 1) -3)
(ground-plane (vector 0 0 -1) -3)
(ground-plane (vector 0 1 0) -3)
(ground-plane (vector 0 -1 0) -3)
(ground-plane (vector 1 0 0) -3)
(ground-plane (vector -1 0 0) -3)
(push)
(backfacecull 0)
(hint-none)
(hint-wire)
(wire-colour (vector 1 1 1))
(scale (vector 6 6 6))
(set! box (build-cube))
(pop)
(grab box)
(selectable 0)
(ungrab)

; =====================================
; populate a universe
; =====================================

(define universe (actors 'make))

(define (add-cuboideroid)
  (oo universe 'add! (cuboideroid 'make))
)

(add-cuboideroid)
(add-cuboideroid)
(add-cuboideroid)
(add-cuboideroid)

(display "UNIVERSE")(newline)(display universe)(newline)

; =====================================
; main loop
; =====================================

(define (render)
  (set! maus-over (mouse-over))
  (if maus-over (begin (display maus-over)(newline)))
  (oo universe 'update!)
  (oo universe 'render)
)

(every-frame (render))

(show-fps 1)

; =====================================
; EOF
; =====================================