]> gitweb.factorcode.org Git - factor-unmaintained.git/blobdiff - adsoda/adsoda.tests
unmaintained: New home for misfit Factor vocabularies.
[factor-unmaintained.git] / adsoda / adsoda.tests
diff --git a/adsoda/adsoda.tests b/adsoda/adsoda.tests
new file mode 100644 (file)
index 0000000..f0b0c54
--- /dev/null
@@ -0,0 +1,147 @@
+! : init-4D-demo ( -- space )\r
+! OK\r
+! espace de dimension 4 et de couleur 0,3 0.3 0.3\r
+<space> \r
+    4 >>dimension\r
+    { 0.3 0.3 0.3 } >>ambient-color\r
+    { 100 150 100  150 100 150 100 150 } "4cube1" 4cube suffix-solids\r
+   { 160 180  160 180 160 180 160 180 } "4cube2" 4cube suffix-solids\r
+    <light>\r
+        { -100 -100 -100 -100 } >>position\r
+        { 0.2 0.7 0.1 } >>color\r
+        suffix-lights\r
+! ;\r
+! : init-3D-demo ( -- space )\r
+! OK\r
+! espace de dimension 4 et de couleur 0,3 0.3 0.3\r
+<space> \r
+    3 >>dimension\r
+    { 0.3 0.3 0.3 } >>ambient-color\r
+    { 100 150 100  150 100 150 } "3cube1" 3cube suffix-solids\r
+  !  { -150 -10  -150 -10 -150 -10 -150 -10 } "4cube2" 4cube suffix-solids\r
+    <light>\r
+        { -100 -100 -100 -100 } >>position\r
+        { 0.2 0.7 0.1 } >>color\r
+        suffix-lights\r
+! ;\r
+\r
+\r
+: s1 ( -- solid )\r
+    <solid> \r
+    2 >>dimension\r
+    "s1" >>name\r
+    { 1 1 1 } >>color\r
+    { 1 -1 -5 } cut-solid \r
+    { -1 -1 -21 } cut-solid \r
+    { -1 0 -12 } cut-solid \r
+    { 1 2 16 } cut-solid\r
+;\r
+: solid1 ( -- solid )\r
+    <solid> \r
+    2 >>dimension\r
+    "solid1" >>name\r
+    { 1 -1 -5 } cut-solid \r
+    { -1 -1 -21 } cut-solid \r
+    { -1 0 -12 } cut-solid \r
+    { 1 2 16 } cut-solid\r
+    ensure-adjacencies\r
+    \r
+;\r
+: solid2 ( -- solid )\r
+    <solid> \r
+    2 >>dimension\r
+    "solid2" >>name\r
+    { -1 1 -10 } cut-solid \r
+    { -1 -1 -28 } cut-solid \r
+    { 1 0 13 } cut-solid \r
+ !   { 1 2 16 } cut-solid\r
+    ensure-adjacencies\r
+    \r
+;\r
+\r
+: solid3 ( -- solid )\r
+      <solid> \r
+    2 >>dimension\r
+    "solid3" >>name\r
+    { 1 1 1 } >>color\r
+    { 1 0 16 } cut-solid \r
+    { -1 0 -36 } cut-solid \r
+    { 0 1 1 } cut-solid \r
+    { 0 -1  -17 } cut-solid \r
+ !   { 1 2 16 } cut-solid\r
+    ensure-adjacencies\r
+    \r
+\r
+;\r
+\r
+: solid4 ( -- solid )\r
+      <solid> \r
+    2 >>dimension\r
+    "solid4" >>name\r
+    { 1 1 1 } >>color\r
+    { 1 0 21 } cut-solid \r
+    { -1 0 -36 } cut-solid \r
+    { 0 1 1 } cut-solid \r
+    { 0 -1  -17 } cut-solid \r
+    ensure-adjacencies\r
+    \r
+;\r
+\r
+: solid5 ( -- solid )\r
+      <solid> \r
+    2 >>dimension\r
+    "solid5" >>name\r
+    { 1 1 1 } >>color\r
+    { 1 0 6 } cut-solid \r
+    { -1 0 -17 } cut-solid \r
+    { 0 1 17 } cut-solid \r
+    { 0 -1  -19 } cut-solid \r
+    ensure-adjacencies\r
+    \r
+;\r
+\r
+: solid7 ( -- solid )\r
+      <solid> \r
+    2 >>dimension\r
+    "solid7" >>name\r
+    { 1 1 1 } >>color\r
+    { 1 0 38 } cut-solid \r
+    { 1 -5 -66 } cut-solid \r
+    { -2 1 -75 } cut-solid\r
+    ensure-adjacencies\r
+    \r
+;\r
+\r
+: solid6s ( -- seq )\r
+  solid3 clone solid2 clone subtract\r
+;\r
+\r
+: space1 ( -- space )\r
+    <space>\r
+        2 >>dimension\r
+     !    solid3 suffix-solids\r
+        solid1 suffix-solids\r
+        solid2 suffix-solids\r
+    !   solid6s [ suffix-solids ] each \r
+        solid4 suffix-solids\r
+     !   solid5 suffix-solids\r
+        solid7 suffix-solids\r
+        { 1 1 1 } >>ambient-color\r
+            <light>\r
+        { -100 -100 } >>position\r
+        { 0.2 0.7 0.1 } >>color\r
+        suffix-lights\r
+;\r
+\r
+: space2 ( -- space )\r
+    <space>\r
+        4 >>dimension\r
+       ! 4cube suffix-solids\r
+        { 1 1 1 } >>ambient-color\r
+            <light>\r
+        { -100 -100 } >>position\r
+        { 0.2 0.7 0.1 } >>color\r
+        suffix-lights\r
+\r
+       ;\r
+\r