From c51618067d2fb1038ae6f12279d1494e86b63a4c Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Mon, 21 Feb 2022 10:02:25 -0800
Subject: [PATCH] Adding heart.

---
 ueforth/common/floats.h                 | 16 ++++++++++++++--
 ueforth/common/forth_namespace_tests.fs | 11 +++++++++++
 ueforth/common/grf_test.fs              | 18 ++++++++++++++++++
 3 files changed, 43 insertions(+), 2 deletions(-)

diff --git a/ueforth/common/floats.h b/ueforth/common/floats.h
index 5165adb..5b2cdfd 100644
--- a/ueforth/common/floats.h
+++ b/ueforth/common/floats.h
@@ -12,6 +12,8 @@
 // See the License for the specific language governing permissions and
 // limitations under the License.
 
+#include <math.h>
+
 #define FLOATING_POINT_LIST \
   YV(internals, DOFLIT, *++fp = *(float *) ip++) \
   X("FP@", FPAT, DUP; tos = (cell_t) fp) \
@@ -44,6 +46,16 @@
   Y(SFLOATS, tos *= sizeof(float)) \
   X("SFLOAT+", SFLOATPLUS, DUP; tos += sizeof(float)) \
   Y(PI, *++fp = 3.14159265359f) \
-  Y(FSQRT, float fx = *fp; float ft = 1.0f; \
-      for (w = 0; w < 20; ++w) ft = (fx / ft + ft) * 0.5f; *fp = ft) \
+  Y(FSIN, *fp = sin(*fp)) \
+  Y(FCOS, *fp = cos(*fp)) \
+  Y(FSINCOS, fp[1] = cos(*fp); *fp = sin(*fp); ++fp) \
+  Y(FATAN2, fp[-1] = atan2(fp[-1], *fp); --fp) \
+  X("F**", FSTARSTAR, fp[-1] = pow(fp[-1], *fp); --fp) \
+  Y(FLOOR, *fp = floor(*fp)) \
+  Y(FEXP, *fp = exp(*fp)) \
+  Y(FLN, *fp = log(*fp)) \
+  Y(FABS, *fp = fabs(*fp)) \
+  Y(FMIN, fp[-1] = fmin(fp[-1], *fp); --fp) \
+  Y(FMAX, fp[-1] = fmax(fp[-1], *fp); --fp) \
+  Y(FSQRT, *fp = sqrt(*fp))
 
diff --git a/ueforth/common/forth_namespace_tests.fs b/ueforth/common/forth_namespace_tests.fs
index 6b76f5b..64eeffd 100644
--- a/ueforth/common/forth_namespace_tests.fs
+++ b/ueforth/common/forth_namespace_tests.fs
@@ -284,6 +284,17 @@ e: check-float-opcodes
   out: SFLOATS 
   out: SFLOAT+ 
   out: PI 
+  out: FSIN 
+  out: FCOS 
+  out: FSINCOS 
+  out: FATAN2 
+  out: F** 
+  out: FLOOR 
+  out: FEXP 
+  out: FLN 
+  out: FABS 
+  out: FMIN 
+  out: FMAX 
   out: FSQRT 
 ;e
 
diff --git a/ueforth/common/grf_test.fs b/ueforth/common/grf_test.fs
index 1e29f38..345e426 100644
--- a/ueforth/common/grf_test.fs
+++ b/ueforth/common/grf_test.fs
@@ -31,6 +31,23 @@ $00ccff value color
   top h 1- for left over w hline 1+ next drop
 ;
 
+: heart-f ( f: t -- x y )
+  fdup fsin 3e f** 16e f* fswap
+  fdup fcos 13e f*
+  fover 2e f* fcos 5e f* f-
+  fover 3e f* fcos 2e f* f-
+  fswap 4e f* fcos f-
+;
+
+: heart
+  400 0 do
+    i s>f 200e f/ pi f* heart-f
+    10e f* fswap 10e f* fswap f>s f>s
+    300 + swap negate 200 +
+    4 4 box
+  loop
+;
+
 0 value clicking
 
 640 480 window
@@ -46,6 +63,7 @@ $00ccff value color
       mouse-x 100 - mouse-y 50 - i + 200 1 box
       color 2 + to color
     next
+    heart
     flip
   event FINISHED = until
   bye