duskos

commit 7d7ee2d34fca3553c0056d04104506aad08a1a3f
parent fafec5d549e87dcbf908c9ead8c02872cded3189
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Mon,  2 Jan 2023 09:58:36 -0500

gr/plane: change :copy API

It's not a good idea to require one to change source plane's tx/ty in order to
make a copy. It lacks flexibility.

Diffstat:
M
fs/doc/gr/plane.txt
 | 
7
+++----
M
fs/gr/plane.fs
 | 
14
+++++++++-----
M
fs/tests/manual/screen.fs
 | 
8
++++----

3 files changed, 16 insertions(+), 13 deletions(-)
diff --git a/fs/doc/gr/plane.txt b/fs/doc/gr/plane.txt
@@ -49,7 +49,6 @@ Methods:
 :fill ( width height self -- )
   Fill the area in the rect tx,ty,width,height with field "color".
 
-:copy ( width height src self -- )
-  Copy the contents of a rectangle of size "width,height" from plane "src",
-  starting at point tx,ty (from src) into self at target position tx,ty. Color
-  encodings must be the same but pitch doesn't have to.
+:copy ( rect src self -- )
+  Copy the contents of "rect" from plane "src" into self at target position
+  tx,ty. Color encodings must be the same but pitch doesn't have to.
diff --git a/fs/gr/plane.fs b/fs/gr/plane.fs
@@ -24,8 +24,11 @@ extends Rect struct[ Plane
   : :allotbuf ( self -- ) >r \ V1=self
     here r@ pitch r@ height * allot r> to buffer ;
 
-  : _addr ( self -- a ) >r \ V1=self
-    r@ ty r@ pitch * r@ encoding _colorbytes r@ tx * + r> buffer + ;
+  : _xyoff ( x y self -- n )
+    tuck pitch * rot> encoding _colorbytes * + ;
+
+  : _addr ( self -- a )
+    dup buffer swap dup tx over ty rot _xyoff + ;
 
   : :pixel! ( self -- ) >r \ V1=self
     r@ color r@ _addr 16b !+ r> color 16 rshift swap c! ;
@@ -45,9 +48,10 @@ extends Rect struct[ Plane
       1 V1 :ty+ next ( w x )
     2drop rdrop ;
 
-  : :copy ( w h src self -- ) >r >r swap >r >r \ V1=self V2=src V3=w V4=h
-    V2 _addr V1 _addr ( R:h ) begin ( srcaddr dstaddr )
-      2dup V3 V1 encoding _colorbytes * ( src dst src dst u ) move
+  : :copy ( rect src self -- ) >r >r >r \ V1=self V2=src V3=rect
+    V3 x V3 y V2 _xyoff V2 buffer + ( srcaddr )
+    V1 _addr V3 height >r begin ( srcaddr dstaddr )
+      2dup V3 width V1 encoding _colorbytes * ( src dst src dst u ) move
       V1 pitch + swap V2 pitch + swap next ( src dst )
     2drop rfree ;
 
diff --git a/fs/tests/manual/screen.fs b/fs/tests/manual/screen.fs
@@ -1,7 +1,7 @@
-42 42 COLOR_RGB24 Plane :new structbind Plane myplane
+42 54 COLOR_RGB24 Plane :new structbind Plane myplane
 myplane :allotbuf
 255 0 0 r8g8b8>rgb24 to myplane color
-42 42 myplane :fill
+42 54 myplane :fill
 screen :activate
-screen width >> 21 - screen height >> 21 - screen :pos!
-42 42 myplane :self screen :copy
+screen width >> 21 - screen height >> 27 - screen :pos!
+myplane :self myplane :self screen :copy