duskos

commit 2fa2cf60d22cf7e9b52175e4bc0300b920c1e9f0
parent 7d7ee2d34fca3553c0056d04104506aad08a1a3f
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Mon,  2 Jan 2023 10:38:07 -0500

gr/plane: split :copy into :copy< and :copy>

see doc/gr/plane. There's even ascii art!

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

3 files changed, 39 insertions(+), 8 deletions(-)
diff --git a/fs/doc/gr/plane.txt b/fs/doc/gr/plane.txt
@@ -49,6 +49,27 @@ Methods:
 :fill ( width height self -- )
   Fill the area in the rect tx,ty,width,height with field "color".
 
-:copy ( rect src self -- )
+: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.
+
+:copy> ( rect dst self -- )
+  Copy the contents with the size of "rect" from "self" into plane "dst"'s. The
+  position of the rectangle at source is self.tx,self.ty and the origin of the
+  rectangle at dst is rect.x,rect,y.
+
+  Confused? yeah, it is a little bit. Here's the idea: :copy< and :copy> allows
+  a plane to copy contents in and out of another plane without changing that
+  other plane's tx/ty fields. In both copy directions, it is "self" fields that
+  change.
+
+   self            src/dst
++-----------+   +-----------+
+|  ty       |   |  rectxy   |
+|tx+--+     |   |  +--+     |
+|  |  |-------copy>|  |     |
+|  |  |     |   |  |  |     |
+|  |  |copy<-------|  |     |
+|  +--+     |   |  +--+     |
+|    rectwh |   |    rectwh |
++-----------+   +-----------+
diff --git a/fs/gr/plane.fs b/fs/gr/plane.fs
@@ -27,6 +27,10 @@ extends Rect struct[ Plane
   : _xyoff ( x y self -- n )
     tuck pitch * rot> encoding _colorbytes * + ;
 
+  : _rectaddr ( rect self -- )
+    tuck over x rot y ( self self x y )
+    rot _xyoff swap buffer + ;
+
   : _addr ( self -- a )
     dup buffer swap dup tx over ty rot _xyoff + ;
 
@@ -48,11 +52,15 @@ extends Rect struct[ Plane
       1 V1 :ty+ next ( w x )
     2drop rdrop ;
 
-  : :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 )
+  : :copy< ( rect src self -- ) >r >r >r \ V1=self V2=src V3=rect
+    V3 V2 _rectaddr 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 ;
 
+  : :copy> ( rect dst self -- ) >r >r >r \ V1=self V2=dst V3=rect
+    V1 _addr V3 V2 _rectaddr V3 height >r begin ( srcaddr dstaddr )
+      2dup V3 width V1 encoding _colorbytes * ( src dst src dst u ) move
+      V2 pitch + swap V1 pitch + swap next ( src dst )
+    2drop rfree ;
 ]struct
diff --git a/fs/tests/manual/screen.fs b/fs/tests/manual/screen.fs
@@ -1,7 +1,9 @@
-42 54 COLOR_RGB24 Plane :new structbind Plane myplane
+42 const WIDTH
+54 const HEIGHT
+WIDTH HEIGHT COLOR_RGB24 Plane :new structbind Plane myplane
 myplane :allotbuf
 255 0 0 r8g8b8>rgb24 to myplane color
-42 54 myplane :fill
+WIDTH HEIGHT myplane :fill
 screen :activate
-screen width >> 21 - screen height >> 27 - screen :pos!
-myplane :self myplane :self screen :copy
+screen width >> WIDTH >> - screen height >> HEIGHT >> - WIDTH HEIGHT Rect :new
+screen :self myplane :copy>