Rename grf -> graphics.

Full names are better.

common/graphics_utils.fs

@@ -0,0 +1,100 @@
+\ 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.
+
+( Graphics Utilities )
+\ Pen:
+\   ( $rrggbb ) to color
+\ Drawing:
+\   box ( x y w h -- )
+\ Transforms:
+\   g{ ( -- ) Preserve transform
+\   }g ( -- ) Restore transform
+\   translate ( x y -- )
+\   scale ( nx dx ny dy -- )
+\   viewport ( w h -- )
+\   vertical-flip ( -- ) Use math style viewport.
+\ Conversions:
+\   screen>g ( x y -- x' y' ) Transform screen to viewport
+
+also internals
+graphics definitions
+
+0 value color
+
+internals definitions
+
+( Scale to be divided by $10000 )
+$10000 value sx   $10000 value sy
+( Translation )
+0 value tx   0 value ty
+
+: hline { x y w }
+  \ x y pixel w 1- for color over l! 4 + next drop ;
+  x y pixel w color fill32 ;
+
+create gstack 1024 cells allot
+gstack value gp
+: >g ( n -- ) gp ! gp cell+ to gp ;
+: g> ( -- n ) gp cell - to gp gp @ ;
+
+: raw-box { left top w h }
+  left w + top h + { right bottom }
+  left right 2dup min to left max to right
+  top bottom 2dup min to top max to 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
+;
+
+graphics definitions also internals
+
+: box { left top w h }
+  left sx * tx + 16 rshift
+  top sy * ty + 16 rshift
+  w sx * 16 rshift
+  h sy * 16 rshift
+  raw-box
+;
+
+: screen>g ( x y -- x' y' ) 16 lshift ty - sy / swap
+                            16 lshift tx - sx / swap ;
+
+: g{   sx >g   sy >g   tx >g   ty >g ;
+: }g   g> to ty   g> to tx   g> to sy   g> to sx ;
+: translate ( x y -- ) sy * +to ty   sx * +to tx ;
+: scale ( nx dx ny dy -- )
+  sy -rot */ to sy
+  sx -rot */ to sx ;
+: viewport { w h }
+  width 2/ height 2/ translate
+  10000 width height */ 10000 w h */ < if
+    width w  width h w */ 1 max h scale
+  else
+    height w h */ 1 max w  height h scale
+  then
+  w 2/ negate h 2/ negate translate
+;
+
+: vertical-flip
+  0 height 2/ translate
+  1 1 -1 1 scale
+  0 height 2/ negate translate
+;
+
+only forth definitions