From e607ac4fd5dfb0411d5a3f67d16d87d12b731377 Mon Sep 17 00:00:00 2001
From: FelixBrendel <felix.brendel@freenet.de>
Date: Sat, 2 Mar 2019 22:41:09 +0100
Subject: [PATCH] made test file tests

---
 .projectile                 |  2 +
 .rgignore                   |  2 +
 bin/tests/class_macro.slime | 81 +++++++++++++++++++++++++++++++++++++
 3 files changed, 85 insertions(+)
 create mode 100644 .projectile
 create mode 100644 .rgignore
 create mode 100644 bin/tests/class_macro.slime

diff --git a/.projectile b/.projectile
new file mode 100644
index 0000000..19bb99d
--- /dev/null
+++ b/.projectile
@@ -0,0 +1,2 @@
+-/vs
+-/build
\ No newline at end of file
diff --git a/.rgignore b/.rgignore
new file mode 100644
index 0000000..a0965f9
--- /dev/null
+++ b/.rgignore
@@ -0,0 +1,2 @@
+/vs
+/build
diff --git a/bin/tests/class_macro.slime b/bin/tests/class_macro.slime
new file mode 100644
index 0000000..b74b4f1
--- /dev/null
+++ b/bin/tests/class_macro.slime
@@ -0,0 +1,81 @@
+(defun type-wrap (obj type)
+  (set-type obj type)
+  obj)
+
+(define-syntax defclass (name members :rest body)
+  "Macro for creatating classes."
+  (defun underscore (sym)
+    (string->symbol (concat-strings "_" (symbol->string sym))))
+
+  (define underscored-members (map underscore members))
+
+  ;; the wrapping let environment
+  (define let-body (list 'let (zip members underscored-members)))
+
+  ;; the body
+  (map (lambda (fun) (append let-body fun)) body)
+
+  ;; the dispatch function
+  (append let-body '(special-lambda (message :rest args)
+                         "This is the docs for the handle"
+                         (eval (extend (list message) args))))
+
+  ;; stuff it all in the constructor function
+  (eval (list defun (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members
+           "This is the handle to an object of the class "
+           let-body)))
+
+;; (v1 print)
+;; (v1 length)
+;; (v1 get-x)
+;; (v1 set-x 10)
+
+(defclass vector3 (x y z)
+  (defun get-x () x)
+  (defun get-y () y)
+  (defun get-z () z)
+
+  (defun set-x  (new-x) (mutate x new-x))
+  (defun set-y  (new-y) (mutate y new-y))
+  (defun set-z  (new-z) (mutate z new-z))
+
+  (defun length ()
+    (** (+ (* x x) (* y y) (* z z)) 0.5))
+
+  (defun scale (fac)
+    (mutate x (* fac x))
+    (mutate y (* fac y))
+    (mutate z (* fac z))
+    fac)
+
+  (defun add (other)
+    (make-vector3
+     (+ x (other get-x))
+     (+ y (other get-y))
+     (+ z (other get-z))))
+
+  (defun subtract (other)
+    (make-vector3
+     (- x (other get-x))
+     (- y (other get-y))
+     (- z (other get-z))))
+
+  (defun scalar-product (other)
+    (+ (* x (other get-x))
+       (* y (other get-y))
+       (* z (other get-z))))
+
+  (defun cross-product (other)
+    (make-vector3
+     (- (* y (other get-z)) (* z (other get-y)))
+     (- (* z (other get-x)) (* x (other get-z)))
+     (- (* x (other get-y)) (* y (other get-x)))))
+
+  (defun printout ()
+    (printf "[vector3] (" x  y  z ")"))
+  )
+
+(define v1 (make-vector3 1 2 3))
+(define v2 (make-vector3 3 2 1))
+
+(v1 scalar-product v2)