diff --git a/ueforth/Makefile b/ueforth/Makefile index d83201e..7efa973 100644 --- a/ueforth/Makefile +++ b/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 \ diff --git a/ueforth/common/grf.fs b/ueforth/common/grf.fs index fcea8fd..d401213 100644 --- a/ueforth/common/grf.fs +++ b/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 diff --git a/ueforth/common/grf_test.fs b/ueforth/common/grf_test.fs index 8888cee..aadb633 100644 --- a/ueforth/common/grf_test.fs +++ b/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 diff --git a/ueforth/common/heart.fs b/ueforth/common/heart.fs new file mode 100644 index 0000000..cbba7aa --- /dev/null +++ b/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 diff --git a/ueforth/windows/grf.fs b/ueforth/windows/grf.fs index 16a8586..a226df7 100644 --- a/ueforth/windows/grf.fs +++ b/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