New Revision
Fix Eval$(BufferObject) to return odd byte length strings. Normally strings are even byte length, but M2000 can use strings to write Ansi strings too, so a 5 letter Ansi string has 5 bytes, and Len(a$) return 2.5 (return length as 2 bytes per character, so 2.5*2=5 bytes). We can use Str$("AB") to get 2 bytes Ansi AB. We can use reverse function Chr$(Str$("AB")) to get 4 bytes AB.
Here is an example of how to make a bitmap and stored and read as
ppm in the binary form P6 for RGB (color space isn't the proper one,here is sRGB, but normally is BT.709 with a gamma 2.2 with a linear section for small intensities).
Bitmap stored in a buffer as M2000 stored a picture part in string. So we can get the string value of buffer and use it in picture render statements, like COPY.
Module
PPMbinaryP6 has the code. First we check version and revision of M2000 Interpreter. If we have the proper version/revision we call the Checkit Module.
There is a Function named Bitmap which return a Group, which link to a buffer. This Group has two properties, w for width, and h for height (because width and height are read only variables with a higher priority, we can't use them as properties in groups), and a number of lambda functions. W and H are read only properties (We use only the Value part, we didn't use the Set part)
We use lambda functions to include closures. A Buffer is an object, and variable for buffer is a pointer to buffer. Closures are copies, but a copy of pointer has the same mean as a reference. So all functions have a pointer to same buffer. SetPixels work using Call GroupName.SetPixels( parameters)
We have SetPixels and GetPixels for setting color, getting color. To set color we can use #FFAABB as html color literal, Color(0xBB, 0xAA, 0xFF), Color(15) for QBcolors (from 0 to 15) , Color(0x800000XX) (XX = 00 to 1B or more, for current Windows Theme)
Function Image$() return the string equivalent for image rendering. Also can by used to extract image to copy to a new image. If A=Bitmap(10,10) and B=Bitmap(10,10) then Call A.copy(Eval$(B)) copy B to A.
Using Copy statement we can make strings to be used to save to buffer bitmap.
Because each function in this group is a lambda function we can get a copy (we get a copy of pointer to buffer, not a copy of buffer), using a simple assign: k=A.SetPixel (see we didn't use SetPixel(), we want the variable which hold the lambda). Variables who holds lambda functions are unique objects, we don't have pointers to lambda functions. So we can use lambda function as any variable. We can change a lambda function easy, like changing a value. We can pass it by value or by reference. Here passing by value is the same because of buffer which is a pointer.
Function ToFile use a file handler (for an Ansi type file - no use of Wide in Open statement), to export the P6 format of ppm file (a binary type)
Function Bitmap get to arguments to make a white color bitmap, or one argument as a file handler to read an image.
We can use ppm files to export in same file more than one image, and to read more than one image. From any group which is an image we can export as many times we want to a ppm file. To reload we have to get a new bitmap reading bytes from a file and then we have to copy using Copy, or better, if thew new bitmap group is the A_new we can use A=A_new, and this make A a copy of A_new (not a same pointer to an instance). Groups are value types (although we can make pointers to groups, we didn;t get a pointer unless we use specific statement to get it, which is out of scope in this context). So groups also they are first citizens, like lambda function, and have members that we can use (a lambda object has one public member, the lambda function, and private members the closures)
This code is checked in Windows, and in Linux (Wine 3.6). The extracted PPM file can be opened in linux with
ristretto picture viewer, and other programs for graphics, like Gimp.
Module
PPMbinaryP6 {
If
Version<9.4 then
1000
If
Version=9.4 Then
if Revision<19 then
1000
Module
Checkit {
Function
Bitmap {
def
x as long,
y as
long
If
match("NN")
then {
Read
x,
y
}
else.if Match("N")
Then {
E$="Not
a ppm file"
Read
f as
long
buffer
whitespace as
byte
if
not Eof(f)
then {
get
#f,
whitespace :
iF eof(f)
then Error
E$
P6$=eval$(whitespace)
get
#f,
whitespace :
iF eof(f)
then Error
E$
P6$+=eval$(whitespace)
def
boolean getW=true,
getH=true,
getV=true
def
long v
\\
str$("P6") has 2 bytes. "P6" has 4
bytes
If
p6$=str$("P6")
Then
{
do
{
get
#f,
whitespace
if
Eval$(whitespace)=str$("#")
then
{
do
{
iF
eof(f) then
Error E$
get
#f,
whitespace
}
until
eval(whitespace)=10
}
else
{
select
case
eval(whitespace)
case
32, 9, 13,
10
{
if
getW and
x<>0
then
{
getW=false
}
else.if getH
and y<>0
then
{
getH=false
}
else.if getV
and v<>0
then
{
getV=false
}
}
case
48 to
57
{
if
getW then
{
x*=10
x+=eval(whitespace,
0)-48
}
else.if getH
then
{
y*=10
y+=eval(whitespace,
0)-48
}
else.if getV
then
{
v*=10
v+=eval(whitespace,
0)-48
}
}
End
Select
}
iF
eof(f) then
Error E$
}
until
getV=false
} else
Error "Not a P6 ppm"
}
}
else Error "No
proper arguments"
if
x<1 or
y<1 then
Error "Wrong
dimensions"
structure
rgb {
red
as byte
green
as byte
blue
as
byte
}
m=len(rgb)*x
mod 4
if
m>0 then
m=4-m
' add some bytes to raster
line
m+=len(rgb)
*x
Structure
rasterline {
{
pad
as
byte*m
}
\\
union pad+hline
hline
as
rgb*x
}
\\
we use union linesB and lines
\\
so we can address linesb as bytes
Structure
Raster {
magic
as integer*4
w
as integer*4
h
as
integer*4
{
linesB
as
byte*len(rasterline)*y
}
lines
as
rasterline*y
}
Buffer
Clear Image1 as
Raster
\\
24 chars as header to be used from bitmap render build in
functions
Return
Image1,
0!magic:="cDIB",
0!w:=Hex$(x,2),
0!h:=Hex$(y,
2)
\\
fill white (all 255)
\\
Str$(string) convert to ascii, so we get all characters from
words width to byte width
if
not valid(f)
then Return Image1,
0!lines:=Str$(String$(chrcode$(255),
Len(rasterline)*y))
Buffer
Clear Pad as
Byte*4
SetPixel=Lambda
Image1,
Pad,aLines=Len(Raster)-Len(Rasterline),
blines=-Len(Rasterline)
(x,
y, c)
->{
where=alines+3*x+blines*y
if
c>0 then
c=color(c)
c-!
Return
Pad, 0:=c
as long
Return
Image1,
0!where:=Eval(Pad,
2) as byte,
0!where+1:=Eval(Pad,
1) as byte,
0!where+2:=Eval(Pad,
0) as
byte
}
GetPixel=Lambda
Image1,aLines=Len(Raster)-Len(Rasterline),
blines=-Len(Rasterline)
(x,y)
->{
where=alines+3*x+blines*y
=color(Eval(image1,
where+2 as
byte), Eval(image1,
where+1 as
byte), Eval(image1,
where as
byte))
}
StrDib$=Lambda$
Image1,
Raster ->
{
=Eval$(Image1,
0,
Len(Raster))
}
CopyImage=Lambda
Image1 (image$)
-> {
if
left$(image$,12)=Eval$(Image1,
0, 24 ) Then
{
Return
Image1,
0:=Image$
}
Else Error "Can't
Copy Image"
}
Export2File=Lambda
Image1, x,
y (f)
-> {
\\
use this between open and close
Print
#f,
"P6";chr$(10);
Print
#f,"#
Created using M2000
Interpreter";chr$(10);
Print
#f,
x;"
";y;"
255";chr$(10);
x2=x-1
where=0
Buffer
pad as
byte*3
For
y1= 0 to
y-1
{
For
x1=0 to
x2
{
\\
use linesB which is array of
bytes
Return
pad,
0:=eval$(image1,
0!linesB!where,
3)
Push
Eval(pad,
2)
Return
pad,
2:=Eval(pad,
0),
0:=Number
Put
#f,
pad
where+=3
}
m=where
mod 4
if
m<>0
then
where+=4-m
}
}
if
valid(F)
then
{
x0=x-1
where=0
Buffer
Pad1 as
byte*3
For
y1=y-1
to 0
{
For
x1=0 to
x0
{
Get
#f,
Pad1 ' Read
binary
\\
reverse rgb
Push
Eval(pad1,
2)
Return
pad1,
2:=Eval(pad1,
0),
0:=Number
Return
Image1,
0!linesB!where:=Eval$(Pad1)
where+=3
}
m=where
mod
4
if
m<>0
then
where+=4-m
}
}
Group
Bitmap
{
SetPixel=SetPixel
GetPixel=GetPixel
Image$=StrDib$
Copy=CopyImage
ToFile=Export2File
}
=Bitmap
}
A=Bitmap(10,
10)
Call
A.SetPixel(5,5,
color(128,0,255))
Open
"A.PPM" for
Output as #F
Call
A.ToFile(F)
Close
#f
Print
"Saved"
Open
"A.PPM" for
Input as #F
C=Bitmap(f)
Copy
400*twipsx,200*twipsy
use C.Image$()
Close
#f
}
Checkit
End
1000
Error "Need Version 9.4, Revision
19 or higher"
}
PPMbinaryP6
