Simple mem-texture example for Martin

Makefile.in

@@ -371,7 +371,8 @@ MINOS2_SRC = gl-helper.fs gl-terminal.fs jpeg-exif.fs linux-gl.fs	     \
 	android-actors.fs wayland-actors.fs widgets-test.fs presentation.fs  \
 	presentation-support.fs mts-tools.fs mkv-tools.fs omx-example.fs     \
 	mkv-tags.fs android-recorder.fs animation.fs need-x.fs font-style.fs \
-	text-style.fs gst-helper.fs plot.fs md-viewer.fs md-test.fs
+	text-style.fs gst-helper.fs plot.fs md-viewer.fs md-test.fs	     \
+	mem-texture.fs
 
 MINOS2_BIN = ascii.png button.png button2.png button3.png bad-gateway.png \
 	net2o-minos2.png lbubble.png rbubble.png white.png thumb.png

minos2/mem-texture.fs

+\ simple draw-into-memory style canvas
+
+\ Author: Bernd Paysan
+\ Copyright (C) 2020 Bernd Paysan
+
+\ This file is part of Gforth.
+
+\ Gforth is free software; you can redistribute it and/or
+\ modify it under the terms of the GNU General Public License
+\ as published by the Free Software Foundation, either version 3
+\ of the License, or (at your option) any later version.
+
+\ This program is distributed in the hope that it will be useful,
+\ but WITHOUT ANY WARRANTY; without even the implied warranty of
+\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+\ GNU General Public License for more details.
+
+\ You should have received a copy of the GNU General Public License
+\ along with this program. If not, see http://www.gnu.org/licenses/.
+
+require widgets.fs
+
+also minos
+
+ctx 0= [IF]  window-init  [THEN]
+
+require minos2/font-style.fs
+
+44e update-size#
+
+require minos2/text-style.fs
+require presentation-support.fs
+
+tex: memimage
+
+256 Value mem-w
+256 Value mem-h
+
+mem-w mem-h * sfloats Value mem-size
+mem-size allocate throw Value mem-buf
+
+: pixel! ( rgba x y -- )
+    mem-w * + sfloats mem-buf + be-l! ;
+: update-memimage ( -- )
+    memimage mem-buf mem-w mem-h rgba-texture mipmap ;
+: test-image ( -- )
+    mem-w 0 DO
+	mem-h 0 DO
+	    I 24 lshift J 16 lshift + $FF + I J pixel!
+	LOOP
+    LOOP  update-memimage ;
+test-image
+
+glue new >o
+mem-w 2* s>f hglue-c df!
+mem-h 2* s>f vglue-c df!
+o o> Constant memimage-glue
+
+{{
+    $000000FF $FFFFFFFF pres-frame
+    {{
+	glue*l }}glue
+	{{
+	    glue*l }}glue
+	memimage-glue ' memimage white# }}image
+	    glue*l }}glue
+	}}h box[]
+	glue*l }}glue
+    }}v box[]
+}}z box[] to top-widget
+
+presentation
+bye

minos2/presentation.fs

@@ -4,7 +4,7 @@
 \ Copyright (C) 2018 Bernd Paysan
 
 \ This program is free software: you can redistribute it and/or modify
-\ it under the terms of the GNU Affero General Public License as published by
+\ it under the terms of the GNU General Public License as published by
 \ the Free Software Foundation, either version 3 of the License, or
 \ (at your option) any later version.
 
@@ -13,7 +13,7 @@
 \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 \ GNU Affero General Public License for more details.
 
-\ You should have received a copy of the GNU Affero General Public License
+\ You should have received a copy of the GNU General Public License
 \ along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 require widgets.fs

minos2/soil-texture.fs

@@ -31,7 +31,7 @@ require jpeg-exif.fs
 also soil
 
 : >texture ( addr w h -- )
-    2 pick >r rgba-texture wrap-texture mipmap linear-mipmap r> free throw ;
+    2 pick >r rgba-texture mipmap linear-mipmap r> free throw ;
 : mem>texture ( addr u -- w h )
     over >r  { | w^ w w^ h w^ ch# }
     w h ch# SOIL_LOAD_RGBA SOIL_load_image_from_memory