common/operations.ss
#lang scheme
;; operations
;; Support for various geometric operations
(require "../utils.ss")

(require "point.ss"
         "vector.ss")

(provide (except-out (struct-out operation) make-operation)

         (except-out (struct-out rotation) make-rotation)
         (rename-out (my-make-rotation rotate*))
         (except-out (struct-out translation) make-translation)
         (rename-out (my-make-translation translate*))
         (except-out (struct-out scale) make-scale)
         (rename-out (my-make-scale scale*))

         (except-out (struct-out transform) make-transform)
         (rename-out (my-make-transform transform*)))


(define-struct operation
  ()
  #:transparent)

(define-struct (rotation operation)
  (object coordinate angle)
  #:transparent
  #:guard (lambda (o c a name)
            (assert (eq? name 'rotation)
;                    (list? o)
                    (memq c '(x y z)))
            (values o c a)))

(define (my-make-rotation o c a)
;  (make-rotation (ensure-list o) c a))
    (make-rotation o c a))

(define-struct (translation operation)
  (object coordinate magnitude)
  #:transparent
  #:guard (lambda (o c m name)
            (assert (eq? name 'translation)
;                    (list? o)
                    (memq c '(x y z)))
            (values o c m)))

(define (my-make-translation o c m)
  (make-translation o c m))

(define-struct (scale operation)
  (object coordinate units)
  #:transparent
  #:guard (lambda (o c a name)
            (assert (eq? name 'scale)
;                    (list? o)
                    (memq c '(x y z)))
            (values o c a)))

(define (my-make-scale o c u)
;  (make-scale (ensure-list o) c u))
    (make-scale o c u))


(define-struct (transform operation)
  (object matrix)
  #:transparent
  #:guard (lambda (o m name)
            (assert (eq? name 'transform)
;                    (list? o)
                    (and (= (length m) 4)
                         (andmap (lambda (x) (= (length x) 4))
                                 m)))
            (values o m)))

(define (my-make-transform o m)
;  (make-transform (ensure-list o) m))
    (make-transform o m))