Pull heart into standard library.

ueforth/Makefile

@@ -190,7 +190,7 @@ COMMON_PHASE2 = common/tasks.fs common/utils.fs common/locals.fs \
                 common/filetools.fs common/including.fs \
                 common/streams.fs common/blocks.fs
 
-COMMON_DESKTOP = common/ansi.fs common/desktop.fs common/grf.fs
+COMMON_DESKTOP = common/ansi.fs common/desktop.fs common/grf.fs common/heart.fs
 
 POSIX_BOOT =  $(COMMON_PHASE1) \
               posix/posix.fs posix/allocation.fs posix/termios.fs \

ueforth/common/grf.fs

@@ -1,4 +1,3 @@
-( ------------------------------------------------------------ )
 \ Copyright 2022 Bradley D. Nelson
 \
 \ Licensed under the Apache License, Version 2.0 (the "License");
@@ -55,7 +54,35 @@ vocabulary internals
 0 value event
 0 value width
 0 value height
+0 value color
+
+internals definitions
+
+0 value backbuffer
+
+grf definitions also internals
+
+: pixel ( w h -- a ) width * + 4* backbuffer + ;
+
+internals definitions
+
+: hline { x y w }
+  x y pixel w 1- for color over l! 4 + next drop ;
+
+grf definitions also internals
+
+: box { left top w h }
+  left w + top h + { right bottom }
+  left 0 max to left
+  top 0 max to top
+  right width min to right
+  bottom height min to bottom
+  left right >= top bottom >= or if exit then
+  right left - to w
+  bottom top - to h
+  top h 1- for left over w hline 1+ next drop
+;
 
 ( Rest of definitions per platform. )
 
-forth definitions
+only forth definitions

ueforth/common/grf_test.fs

@@ -14,78 +14,6 @@
 
 grf
 
-$00ccff value color
-
-: hline { x y w }
-  x y pixel w 1- for color over l! 4 + next drop ;
-
-: box { left top w h }
-  left w + top h + { right bottom }
-  left 0 max to left
-  top 0 max to top
-  right width min to right
-  bottom height min to bottom
-  left right >= top bottom >= or if exit then
-  right left - to w
-  bottom top - to h
-  top h 1- for left over w hline 1+ next drop
-;
-
-\ For t = 0 to 2pi
-\     x = -16 to 16
-\     y = -17 to 12
-\ Goes around clockwise
-\ x = 0 when t = pi
-\ x = 0, y = 5 when t = 0
-: 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-
-;
-
-4000 constant heart-steps
-1024 constant heart-size
-create heart-start heart-size allot
-create heart-end heart-size allot
-
-: cmin! ( n a ) dup >r c@ min r> c! ;
-: cmax! ( n a ) dup >r c@ max r> c! ;
-: heart-make
-  heart-start heart-size 0 fill
-  heart-end heart-size 0 fill
-  heart-start heart-size 7 29 */ 128 fill
-  heart-end heart-size 7 29 */ 128 fill
-  heart-steps 0 do
-    i s>f heart-steps s>f f/ pi f* heart-f
-    fnegate 12e f+ 29.01e f/ heart-size s>f f* fswap 16e f* f>s f>s
-    2dup heart-start + cmin!
-    heart-end + cmax!
-  loop
-  heart-size 0 do
-    heart-end i + c@ heart-start i + c@ - heart-end i + c!
-  loop
-;
-heart-make
-
-512 29 32 */ constant heart-ratio
-: heart 0 { x y s r }
-  y s 2/ - to y
-  s 0 do
-    i heart-size s */ to r
-    x heart-start r + c@ s heart-ratio */ +
-      y i +
-      heart-end r + c@ s heart-ratio */
-      1 box
-    x heart-start r + c@
-      heart-end r + c@ + s heart-ratio */ -
-      y i +
-      heart-end r + c@ s heart-ratio */
-      1 box
-  loop
-;
-
 0 value clicking
 
 640 480 window

ueforth/common/heart.fs

@@ -0,0 +1,76 @@
+\ Copyright 2022 Bradley D. Nelson
+\
+\ Licensed under the Apache License, Version 2.0 (the "License");
+\ you may not use this file except in compliance with the License.
+\ You may obtain a copy of the License at
+\
+\     http://www.apache.org/licenses/LICENSE-2.0
+\
+\ Unless required by applicable law or agreed to in writing, software
+\ distributed under the License is distributed on an "AS IS" BASIS,
+\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+\ See the License for the specific language governing permissions and
+\ limitations under the License.
+
+grf internals definitions
+
+\ For t = 0 to 2pi
+\     x = -16 to 16
+\     y = -17 to 12
+\ Goes around clockwise
+\ x = 0 when t = pi
+\ x = 0, y = 5 when t = 0
+: 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-
+;
+
+4000 constant heart-steps
+1024 constant heart-size
+create heart-start heart-size allot
+create heart-end heart-size allot
+heart-start heart-size 0 fill
+heart-end heart-size 0 fill
+
+: cmin! ( n a ) dup >r c@ min r> c! ;
+: cmax! ( n a ) dup >r c@ max r> c! ;
+
+: heart-initialize
+  heart-start heart-size 7 29 */ 128 fill
+  heart-end heart-size 7 29 */ 128 fill
+  heart-steps 0 do
+    i s>f heart-steps s>f f/ pi f* heart-f
+    fnegate 12e f+ 29.01e f/ heart-size s>f f* fswap 16e f* f>s f>s
+    2dup heart-start + cmin!
+    heart-end + cmax!
+  loop
+  heart-size 0 do
+    heart-end i + c@ heart-start i + c@ - heart-end i + c!
+  loop
+;
+
+512 29 32 */ constant heart-ratio
+
+grf definitions also internals
+
+: heart 0 { x y s r }
+  heart-start c@ 0= if heart-initialize then
+  y s 2/ - to y
+  s 0 do
+    i heart-size s */ to r
+    x heart-start r + c@ s heart-ratio */ +
+      y i +
+      heart-end r + c@ s heart-ratio */
+      1 box
+    x heart-start r + c@
+      heart-end r + c@ + s heart-ratio */ -
+      y i +
+      heart-end r + c@ s heart-ratio */
+      1 box
+  loop
+;
+
+only forth definitions

ueforth/windows/grf.fs

@@ -27,7 +27,6 @@ z" uEforth" constant GrfWindowTitle
 create ps PAINTSTRUCT allot
 create msgbuf MSG allot
 create binfo BITMAPINFO allot
-0 value backbuffer
 cell allocate throw to backbuffer
 
 : rescale { w h }
@@ -147,6 +146,4 @@ also windows
     backbuffer binfo DIB_RGB_COLORS SRCCOPY StretchDIBits drop
 ;
 
-: pixel ( w h -- a ) width * + 4* backbuffer + ;
-
 only forth definitions