PPM bitmap handle

This is an example published in Rosetta Code https://rosettacode.org/wiki/Grayscale_image#M2000_Interpreter

In a module P6P5 we have a function Bitmap which return an object of type Group. This object has a series of lambda functions which hold pointers to structures (as closures).

To create a bitmap we use the function with one or two parameters. Using two parametes we give horixontal pixels width and vertical pixels height. Using one parameter we give the file handler, from a ppm file type of P5 (Grayscale) or P6 (RGB). The P5 and P6 subtypes of ppm file use binary data for color values. (P2 & P3 use ascii plain text for color values, not implemented here).

All members of Bitmap group are lambda functions. Actual data are passed as closures to these lambda functions. Some of them are of type Buffer, which is a special object which hold a block of memory. So the image is in raster form ready to be used from render commands like Copy, Image, Sprite. Because the actual raster form is BGR and first line is the bottom line we have to swap bytes for each pixel, and change the order of raster lines as the ppm type specifies. Also the raster has raster lines align to 32 bit boundaries, but that not hold for ppm files. M2000 use a either a Buffer to store an image as a copy of file, which means data maybe compressed, or a string variable, which has a private header and actual bytes, not compressed, from the DIB representation for Windows OS. DIB means device independent bitmap, where device is the output devive, so here we don't have information about output device. We use the DIB in this module through Bitmap type of objects which we define, and the actual data (plus a header) sending to COPY command for rendering to M2000 Console. We use Image$() function to get a copy of DIB in a string.

            Group Bitmap {
                  SetPixel=SetPixel
                  GetPixel=GetPixel
                  Image$=StrDib$
                  Copy=CopyImage
                  ToFile=Export2File
                  ToFileGray=Export2FileGray
                  GetPixelGray=GetPixelGray
            }

This is the output of the example which call module P5P6. Also we get two files:

P6example.ppm and P5example.ppm in M2000 User Folder.

We can open this folder with a command Win Dir$ which open Explorer showing Dir$

Use Print Dir$ to see the path of M2000 User Folder

We can open these ppm files using GIMP, tested with GIMP 2.10.28 

About handling files. Using OPEN we open a file for Input or Output or Append (and Random,  a special for Random Access using fields of a specific length). Using For Wide Input we get text files in UTF16LE, but using For Input we get bytes, which maybe text ANSI (8 bit) or binary data. We use Get statement with Buffers to get as many bytes as buffer's size. So the OPEN command which is primary for text files, can be used for binary files. The Random type not offer binary handle. The Append type can be used to get and put binary data. We can ue Seek statement and Seek() for handling the file cursor. Also we can open a file in exclusive mode (so no other program, and file handler can be used for this file). The file cursor can handle large files (above 4 GB) (early revisions of version 10 and all before those can't handle large files). Curren version of M2000 Interpreter is 11.

Memory for programs/data are limited to 2 GB. M2000 Interpreter runs in a Win 32 program (32bit), the M2000 Environment. Handling for large files can be a partial process, read some data then process those and then write data back to same or on another file

As a task for the reader. Create a real big ppm file P6, and make a Bitmap2 object to get a small square, and then write back to big file. At creation time give a corner at (Left, Top) and Width and Height of bitmap in pixels, to be extract, plus the file handler. Make a copy back function, so the data can be writen to file at different (Left, Top).

Module  P6P5 {
      Function Bitmap {
            def x as long, y as long, Import as boolean, P5 as boolean
            If match("NN") then {
                 Read x, y
            } else.if Match("N") Then {
                  \\ is a file?
                  Read f as long
                  buffer whitespace as byte
                  if not Eof(f) then {
                        get #f, whitespace :P6$=eval$(whitespace)
                        get #f, whitespace : P6$+=eval$(whitespace)
                        def boolean getW=true, getH=true, getV=true
                        def long v
                        \\ str$("P6") has 2 bytes. "P6" has 4 bytes
                        P5=p6$=str$("P5")
                        If p6$=str$("P6") or P5 Then {
                              do {
                                    get #f, whitespace
                                    if Eval$(whitespace)=str$("#") then {
                                          do {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 "Not a ppm file"
                              } until getV=false
                        }  else Error "Not a P6 ppm or P5 ppm file"
                        Import=True
                  }
            } 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
                  }
                  hline as rgb*x
            }
            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
            Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2)
            if not Import 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))
            }
            GetPixelGray=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{
                  where=alines+3*x+blines*y
                  grayval=round(0.2126*Eval(image1, where+2 as byte) + 0.7152*Eval(image1, where+1 as byte) + 0.0722*Eval(image1, where as byte), 0)
                  =color(grayval,grayval,grayval)
            }
            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) -> {
                  Print #f, "P6";chr$(10);"# Created using M2000 Interpreter";chr$(10);
                  Print #f, x;" ";y;" 255";chr$(10);
                  x2=x-1 : where=0 : rasterline=x*3
                  m=rasterline mod 4 : if m<>0 then rasterline+=4-m
                  Buffer pad as byte*3
                  For y1=y-1 to 0 {
                        where=rasterline*y1
                        For x1=0 to x2 {
                             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
                        }
                  }
            }
            Export2FileGray=Lambda Image1, x, y (f) -> {
                  Print #f, "P5";chr$(10);"# Created using M2000 Interpreter";chr$(10);
                  Print #f, x;" ";y;" 255";chr$(10);
                  x2=x-1 : where=0 : rasterline=x*3
                  m=rasterline mod 4 : if m<>0 then rasterline+=4-m
                  Buffer pad as byte*3
                  Buffer bytepad as byte
                  const R=0.2126, G=0.7152, B=0.0722
                  For y1=y-1 to 0 {
                        where=rasterline*y1
                        For x1=0 to x2 {
                             Return pad, 0:=eval$(image1, 0!linesB!where, 3)
                             Return bytepad, 0:=round(R*Eval(pad, 2) + G*Eval(pad, 1) + B*Eval(pad, 0), 0)
                             Put #f, bytepad : where+=3
                        }
                  }
            }
            if Import then {
                  x0=x-1 : where=0
                  Buffer Pad1 as byte*3
                  Buffer Pad2 as byte
                  local rasterline=x*3
                  m=rasterline mod 4 : if m<>0 then rasterline+=4-m
                  For y1=y-1 to 0 {
                        where=rasterline*y1
                        For x1=0 to x0 {
                              if p5 then
                                    Get #f, Pad2: m=eval(Pad2,0) : Return pad1, 0:=m, 1:=m, 2:=m
                              else
                                    Get #f, Pad1 : Push Eval(pad1, 2) : Return pad1, 2:=Eval(pad1, 0), 0:=Number
                              End if
                              Return Image1, 0!linesB!where:=Eval$(Pad1) : where+=3
                        }
                  }
            }
            Group Bitmap {
                  SetPixel=SetPixel
                  GetPixel=GetPixel
                  Image$=StrDib$
                  Copy=CopyImage
                  ToFile=Export2File
                  ToFileGray=Export2FileGray
                  GetPixelGray=GetPixelGray
            }
            =Bitmap
      }
      Cls 5,0
      A=Bitmap(15,10)
      B=Bitmap(15,10)
      c1=color(100, 200, 255)
      c2=color(180, 250, 128)
      For i=0 to 8
            Call A.SetPixel(i, i, c1)
            Call A.SetPixel(9, i,c2)
      Next
      Call A.SetPixel(i,i,c1)
      // make a new one GrayScale (but 24bit) as B
      For i=0 to 14 { For J=0 to 9 {Call B.SetPixel(i, j, A.GetPixelGray(i,j))}}
      // place image A  at 200 pixel from left margin, 100 pixel from top margin
      Copy 200*twipsX, 100*twipsY use A.Image$(), 0, 400 ' zoom 400%, angle 0
      // place image B at 400 pixel from left margin, 100 pixel from top margin
      Copy 400*twipsX, 100*twipsY use B.Image$(), 0, 400 ' zoom 400%
      Try {
            Open "P6example.ppm" For Output as #f
            Call A.Tofile(f)
            Close #f
            Open "P5example.ppm" For Output as #f
            Call A.TofileGray(f)
            Close #f
            Open "P5example.ppm" For Input as #f
            C=Bitmap(f)
            close #f
            Copy 600*twipsX, 100*twipsY use C.Image$(), 0, 400 ' zoom 400%
            Open "P6example.ppm" For Input as #f
            C=Bitmap(f)
            close #f
            // use of Top clause to make the border color transparent at rotation
            Copy 800*twipsX, 100*twipsY top C.Image$(), 30, 400 ' zoom 400%, angle 30 degree
      }
      Print "Done"      
}
P6P5

 

Url Encoding (using OOP plus convertions from and to UTF8 and UTF16)

First apear here: https://rosettacode.org/wiki/URL_encoding#M2000_Interpreter

A Module in M2000 is like a procedure, which has own namespace (may contain other modules/functions).

Module checkit has a function decodeUrl$() which finally use decoding from utf8 to utf16LE (for proper reender to M2000 console). This module also has an object Parse$. The $ in Parse$ means that this object return a string (see the Value part of this group), and also has a set function to get a new string value as Parse$()= stringExpUtf16LE or Parse$(variationType) = stringExpUtf16LE. The group formed direct from a Group statement, so it is like a local variable, which deleted at the end of the module execution. The name Parse and Parse$() are reserved. The first one Parse used with dot notation. By default all members are public, so Parse.HTML5 is public too, and has type UrlType.

At the main part of Checkit, we see this m=each(Parse.UrlType), where m is a local object used to walk through each Parse.UrlType using a While End While structure (or While { }, we see that on original post in rosettacode.org). So see at decodeUrl$() the use of each() for arrays, where we use a start value of 2 (the second from start). There we have k as the object, and the k^ is the return value from internal counter. The Chr$(StrExp) and Str$(StrExp) usd for conversions from 8 bit to 16bit. Use Help Chr$ to find out how this works.

So we feed UTF16LE to parse object, and internal this converted to UTF8. The parse.decode$() return string with UTF8 and Url Enconding, and decodeUrl() get the UTF8 string and return a UTF16LE, which we can print it to M2000 console.

module Checkit {
	function decodeUrl$(a$) {
		dim a$()
		a$()=Piece$(a$, "%")
		if len(a$())=1 then =str$(a$):exit
		k=each(a$(),2)
		acc$=str$(a$(0))
		while k
			acc$+=str$(Chr$(Eval("0x"+left$(a$(k^),2)))+Mid$(a$(k^),3))
		end while
		=string$(acc$ as utf8dec)
	}
	group Parse$ {
		all$, c=1
		tc$=""
		Enum UrlType {None=0, RFC3986, HTML5}
		variation
		TypeData=("","-._~","-._*")
		function Next() {
			.tc$<=mid$(.all$,.c,1) 
			.c++
			=.tc$<>""
		}
		Value {
			=.tc$
		}
		function DecodeOne$() {
			if .tc$="" then exit
			if .tc$ ~"[A-Za-z0-9]" then =.tc$ : exit
			If .tc$=" " Then =if$(.variation=.HTML5->"+","%20") :exit
			if instr(.TypeData#val$(.variation),.tc$)>0 then =.tc$ :exit
			="%"+hex$(asc(.tc$), 1)
		}
		function Decode$() {
			acc$=""
			.c<=1
			while .Next()
				acc$+=.DecodeOne$()
			end while
			=acc$
		}
		Set () {
			\\ using optional argument
			var=.None
			Read a$, ? var
			a$=chr$(string$(a$ as utf8enc))
			.variation<=var
			.all$<=a$
			.c<=1
		}
	}
	\\ MAIN
	Parse$()="http://foo bar/"
	print Quote$(Parse.Decode$())
	Parse.variation=Parse.HTML5
	print Quote$(Parse.Decode$())
	Parse.variation=Parse.RFC3986
	print Quote$(Parse.Decode$())
	Parse$(Parse.RFC3986) ={mailto:"Irma User" <irma.user@mail.com>}
	print Quote$(Parse.Decode$())
	Parse$(Parse.RFC3986) ={http://foo.bar.com/~user-name/_subdir/*~.html}
	m=each(Parse.UrlType)
	while m
		Parse.variation=eval(m)
		print Quote$(Parse.Decode$())
		print decodeUrl$(Parse.Decode$())
	end while
}
Rem {This example print this on M2000 console:
	"http%3A%2F%2Ffoo%20bar%2F"
	"http%3A%2F%2Ffoo+bar%2F"
	"http%3A%2F%2Ffoo%20bar%2F"
	"mailto%3A%22Irma%20User%22%20%3Cirma.user%40mail.com%3E"
	"http%3A%2F%2Ffoo%2Ebar%2Ecom%2F%7Euser%2Dname%2F%5Fsubdir%2F%2A%7E%2Ehtml"
	http://foo.bar.com/~user-name/_subdir/*~.html
	"http%3A%2F%2Ffoo.bar.com%2F~user-name%2F_subdir%2F%2A~.html"
	http://foo.bar.com/~user-name/_subdir/*~.html
	"http%3A%2F%2Ffoo.bar.com%2F%7Euser-name%2F_subdir%2F*%7E.html"
	http://foo.bar.com/~user-name/_subdir/*~.html
}
Form 80, 28

CheckIt