From b9f12e6f1548258f6704f0d4ebe13125b4f39cc4 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Wed, 26 Nov 2008 20:31:09 -0600
Subject: [PATCH] fix roots demo, cons tests/benchmarks

---
 test/roots.lisp | 12 +++++++-----
 test/test.lisp  | 30 +++++++++++++++++++++++++++---
 2 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/test/roots.lisp b/test/roots.lisp
index 2f1b3ca..ce35749 100644
--- a/test/roots.lisp
+++ b/test/roots.lisp
@@ -3,11 +3,13 @@
 
 (define-special %to-double (a)
   `(,@(scompile a)
-    (:convert-double)))
+      (:convert-double)
+      (:coerce-any)))
 
 (define-special %to-integer (a)
   `(,@(scompile a)
-    (:convert-integer)))
+      (:convert-integer)
+      (:coerce-any)))
 
 (with-open-file (s "/tmp/roots.swf"
                    :direction :output
@@ -95,7 +97,7 @@
                  (color (rgb  (- 0.8 (* v 0.25))
                               0.8
                               (- 0.8 v))))
-            (%set-local alpha (flash::Math.max 0.0 (- alpha (* i decay))))
+            (%set-local alpha (max 0.0 (- alpha (* i decay))))
 
             ;; stop if alpha gets below 1/256 or so
             (when (> alpha 0.004)
@@ -122,8 +124,8 @@
                 (when (and (> depth 0) (> (random 1.0) 0.85))
                   (root canvas x y (+ angle (random-range -60 60))
                         (1- depth) alpha decay))
-                (%set-local x (%to-double dx))
-                (%set-local y (%to-double dy))))))
+                (%set-local x dx)
+                (%set-local y dy)))))
 
         (when (and (> depth 0) (> (random 1.0) 0.7))
           (root canvas x y angle (1- depth) alpha decay))))))
\ No newline at end of file
diff --git a/test/test.lisp b/test/test.lisp
index 668d3b3..b738e97 100644
--- a/test/test.lisp
+++ b/test/test.lisp
@@ -8,7 +8,7 @@
                               :if-exists :supersede)
   (with-compilation-to-stream s ("frame1" `((0 "testClass")))
 
-    (def-swf-class :test-class "test-class" flash.display::sprite ()
+    (def-swf-class :test-class "test-class" flash.display::sprite (blob)
                    (()
                     (main this)))
 
@@ -47,7 +47,7 @@
     (swf-defmemfun cons-test ()
       (let* ((a (cons 2 3))
              (b (cons 1 a)))
-        (%set-property (cdr b) %car 123)
+;        (%set-property (cdr b) %car 123)
         (+ "(" (car a) " " (car b) ")")))
 
     (swf-defmemfun dolist-test ()
@@ -62,6 +62,23 @@
                               (%set-local temp (+ temp a)))
                             "}"))))
 
+    (swf-defmemfun rest-test (a b c &rest d)
+      (+ "(" a " " b " " c " " d ")"))
+
+    (swf-defmemfun space-test (obj count)
+      (let ((now (%new date 0))
+            (cons nil))
+        (%set-property obj blob (dotimes (a count cons)
+                              (push 1 cons)))
+        (+ "[" (/ (- (%new date 0) now) 1000.0) "sec]")))
+
+    (swf-defmemfun car-speed-test (obj count)
+      (let ((now (%new date 0))
+            (sum 0))
+        (dolist (a (blob obj))
+          (incf sum a))
+        (+ "[" (/ (- (%new date 0) now) 1000.0) "sec,sum=" sum "]")))
+
     (swf-defmemfun i255 (a)
       (flash::Math.max (flash::Math.min (floor (* a 256)) 255) 0))
 
@@ -164,7 +181,14 @@
             (%set-local str (+ str " || dolist=" (dolist-test)))
             (incf str (+ " || dotimes=" (dotimes-test)))
             ;;(dotimes (a 5) (incf str a))
-)
+            (incf str (+ " || nth (0 1 2 3 4) 3=" (nth 3 (list 0 1 2 3 4))))
+            (incf str (+ " || opt test=" (rest-test 1 2 3 4 5 6 )))
+            #+nil(incf str (+ " || space test=" (space-test arg 10000000)))
+            #+nil(incf str (+ " || car speed =" (car-speed-test arg 10000000)))
+            (let ((foo 4))
+              (when (and (> foo 0) (> (random 1.0) 0.2))
+                (incf str "||rand")))
+            )
 
           (%set-property foo :text (+ str " || " (%call-property (%array 1 2 3) :to-string))))
         (:add-child arg canvas)
-- 
2.11.4.GIT