Adding heart.
This commit is contained in:
@ -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))
|
||||||
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user