Adding heart.

This commit is contained in:
Brad Nelson
2022-02-21 10:02:25 -08:00
parent 9f43403467
commit c51618067d
3 changed files with 43 additions and 2 deletions

View File

@ -12,6 +12,8 @@
// See the License for the specific language governing permissions and // See the License for the specific language governing permissions and
// limitations under the License. // limitations under the License.
#include <math.h>
#define FLOATING_POINT_LIST \ #define FLOATING_POINT_LIST \
YV(internals, DOFLIT, *++fp = *(float *) ip++) \ YV(internals, DOFLIT, *++fp = *(float *) ip++) \
X("FP@", FPAT, DUP; tos = (cell_t) fp) \ X("FP@", FPAT, DUP; tos = (cell_t) fp) \
@ -44,6 +46,16 @@
Y(SFLOATS, tos *= sizeof(float)) \ Y(SFLOATS, tos *= sizeof(float)) \
X("SFLOAT+", SFLOATPLUS, DUP; tos += sizeof(float)) \ X("SFLOAT+", SFLOATPLUS, DUP; tos += sizeof(float)) \
Y(PI, *++fp = 3.14159265359f) \ Y(PI, *++fp = 3.14159265359f) \
Y(FSQRT, float fx = *fp; float ft = 1.0f; \ Y(FSIN, *fp = sin(*fp)) \
for (w = 0; w < 20; ++w) ft = (fx / ft + ft) * 0.5f; *fp = ft) \ 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))

View File

@ -284,6 +284,17 @@ e: check-float-opcodes
out: SFLOATS out: SFLOATS
out: SFLOAT+ out: SFLOAT+
out: PI 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 out: FSQRT
;e ;e

View File

@ -31,6 +31,23 @@ $00ccff value color
top h 1- for left over w hline 1+ next drop 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 0 value clicking
640 480 window 640 480 window
@ -46,6 +63,7 @@ $00ccff value color
mouse-x 100 - mouse-y 50 - i + 200 1 box mouse-x 100 - mouse-y 50 - i + 200 1 box
color 2 + to color color 2 + to color
next next
heart
flip flip
event FINISHED = until event FINISHED = until
bye bye