#lang scheme
(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)
(memq c '(x y z)))
(values o c a)))
(define (my-make-rotation 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)
(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)
(memq c '(x y z)))
(values o c a)))
(define (my-make-scale o c u)
(make-scale o c u))
(define-struct (transform operation)
(object matrix)
#:transparent
#:guard (lambda (o m name)
(assert (eq? name 'transform)
(and (= (length m) 4)
(andmap (lambda (x) (= (length x) 4))
m)))
(values o m)))
(define (my-make-transform o m)
(make-transform o m))