Revision 13 Version 11

Fix three bugs, and one addition:

1) Enum alfa {a=1, b=2}: Push a: Print Number. This was error because a is an object in stack. Now interpreter take the value of enum a and return from Number (which also pop the value).

2) Print 10 div 2 //remark using //

This also was an error, because 10 div 2/2 is 10 div (2/2).

So now 10 div 2//any char 

is 10 div 2 (the // reject characters until the start of next line)

3)Statement codepage was a fault, because Win32 function (under the hood) return 1 or 0, and was Not retvalue, but in VB6 Not 0 is -1 (ok that), and Not 1 is -2, which is no zero so it is true again. So this change to revalue=0, for 0 give True, for non zero give false.

4)Structure alfa {x as integer, y as integer} by design not work with comma between field definitions, now work with comma and also comment type "//" work good too. Also a structure definition into a structure definition is posible, with or without *multiplier and a new symbol ";" can be used to break the union (which interpreter apply by default).

**** M2000Paper Updated (see Structures with new examples).

**** Updated the links in the Readme.txt file.

https://rosettacode.org/wiki/Category:M2000_Interpreter (384 tasks)

ExportM2000 all files with executables (you can get the ca.crt):

https://drive.google.com/drive/folders/1IbYgPtwaWpWC5pXLRqEaTaSoky37iK16

only source, with old revisions and a wiki, for executables see releases

https://github.com/M2000Interpreter/Environment

M2000language.exe (Chrome can't scan, say it is a virus - heuristic choise)

All exe files are signed

https://drive.google.com/u/0/uc?id=1hjEO6XvAu-l7TTwPYmPEkZZrxAXPtA41

M2000 paper (305 pages). Included in M2000language.exe

https://drive.google.com/file/d/1pHBjLVeaGkyMhyyfvXyvh42cJ3njY7wa

M2000 Greek Small Manual (488 pages). Included in M2000language.exe

https://drive.google.com/file/d/0BwSrrDW66vvvS2lzQzhvZWJ0RVE

Running M2000 from alternative version

 You can use M2000.exe with a specific M2000.dll and an info.gsb and a help2000utf8.dat in a folder say C:\Users\personAny\FolderM2000\

The M2000.exe compiled from mexe.vbp (open mexe.vbp in VB6)

The M2000.exe if has a link to execute then check if M2000.dll is in the same folder load this. Without a link the M2000.exe start the registered.on system M2000.dll, but if not found as registered then try to open the file as a local active-X using NewObjectFromActivexDll() function in ActiveX.bas or module2. To follow the code, see Sub Main in Module1, which define Dim mm As New RunM2000, and then call mm.doit

If you want to run mexe.vbp and m2000.vbp (which make the dll) at the same time, you can...But before load the M2000.vbp change from menu tools\options\edit format\ all text font as Courier New Greek. So the greek letters now  (from reserved words) can be seen. So now you can run both, and you can set breakpoints. Although you can't call m2000.exe second time when m2000.dll run from IDE, because hang. M2000dll can run multiple times (one time for each runnning m2000.exe) when is on compiled form.

Let say that you want to work on a folder c:\temp, and the folder exist (if not make it from explorer).

Open cmd and change dir to c:\temp using cd c:\temp

**batch file in a working directory

We want two commands, the %RunM2000% and the %M2000module%. The first run a gsb file, here the test2. We can put statements for execution, like the calling module, and the End statement to termiante the environment. If the test2.gsb has B:End as last line (not in a module) then these statements executed and not need to pass them from call from %RunM2000%. The second we use when we want a module from info.gsb (which we place in the user folder (if we use dir user statement), or in the m2000.exe folder (if we use dir appdir$ statement). See Setting of %M2000module% bellow.

So lets make the batch file (

notepad setM2000.bat

Now copy the four lines ahead but change the actual folder of M2000dir

set "M2000dir=C:\Users\personAny\FolderM2000\"
set "M2000=%M2000dir%M2000.EXE dir %cd%"
set "RunM2000=%M2000%:load "
set "M2000module=%M2000%:d123$=dir$:dir user:load modules info.gsb:dir d123$:clear:"

Save the file and now run the batch:

setM2000

**Open mEditor form info at current directory

%M2000module%meditor

**file test2.gsb

You can make this file using Notepad test2.gsb, save it as utf8 (which is the first choise for Notepad). Or ypu can make this from M2000 Editor (which will be run using the statement above).

module b {
print command$
input "A=", A
input "B=", B
print  A*B
print "ok"
push key$: drop
}

You can run the file from meditor (but make a test1234.gsb, which include a copy of the statements of the opened file and run this). Or you save the file as Test2 and run from the cmd using this

**Run test2.gsb calling b and then end program

%RunM2000%test2:B:End

The final test2.gsb version may have the B: End statements at the last line.

EnumClass defined as example using M2000 code

This example show the using of groups/ pointers to groups, and a way to use meta programming. We define a string which have the final code for a group, and then using:

Group nameOfGroup type CodeAsString$

This Group definition was written before M2000 get classes, and types (see label type: for hard write one or more types for a group). The idea was to define types, using global strings, but never used for that. Because the string can be made at run time, we can define the code of group at run time.

The function enumclass return a group using Group(aa) and not aa because aa call the value part of group if exist, which here exist, so we need Group() which checks the name if it is an object (and not evaluates numeric expression).

We play with p and z which are pointers to groups. We can check parameters if are pointers to group and specific type (which here we write it in the enumclass, first parameter).

M2000 has Enum (enumerated type) and we can define variables using  this type, see Help Enum/ This example defines Enum in a different way. Also I have left for exercise the EnumStringClass variant, where the value for each constant is a string. The Enum type of M2000 has no string values to constants, we can use a List  which have pairs like (name$, value$)

// enumclass function produce a pointer to object p
// enumclass(typename$, firstEnumName$, ValueNumber[, NextEnumName$, NextValueNumber])
//
// eval(p) is the current value of p=>name$
// p=>setValue AnyEnumName$
// z=p=>copy()  produce a new object with same value
// z=p=>copy(AnyEnumName$) produce a new object with any value
// print z=p   // return true by names
// print z==p   // return true by values
function enumclass(name$) {
	proto$=lambda$ name$ (na$, va) ->{
		tp$={type: }+name$+{
		private:
			val$=}+quote$("."+na$)+{
		public:
			group name$ {
				value {
					link parent val$ to val$
					=mid$(val$,2)
				}
			}
			Function Copy(a$="") {
				if a$="" then a$=mid$(.val$,2)
				if valid("."+a$) then
					m=this
				 	m.SetValue a$
				 	->group(m)
				 else
				 	error "not valid label"
				 end if
			}
			operator "=" (m) {
				push m=>name$=.name$
			}
			operator "==" (m) {
				push eval(m)=eval(.val$)
			}
			Module SetValue (a$) {
				if valid("."+a$) then .val$<="."+a$
			}
			value {
				=eval(.val$)
			}
		}
		tp$+="final "+na$+"="+str$(va)
		while not empty
			tp$+=", final "+letter$+"="+str$(number)
		end while
		=tp$
	}
	Group aa type proto$(![])
	=Group(aa)

}
z->enumclass("alfa", "one",100,"two", 200,"three", 300, "likeone", 100)
print eval(z), Eval("z=>"+z=>name$), z=>name$
z=>setValue "three"
print eval(z), Eval("z=>"+z=>name$), z=>name$
p=z=>copy()
print type$(p)
print eval(p), Eval("z=>"+p=>name$), p=>name$
p=z=>copy("two")
print type$(p)
print eval(p), Eval("z=>"+p=>name$), p=>name$
p=>setValue "three"
print z=p  // true
p=>setValue "one"
print z=p  // false
print z=>name$, p=>name$
function check(k as *alfa) {
	=eval(k)
}
print check(p)=100, check(z)=300
print valid(check(pointer()))=false
print valid(check(p))=true
select(p)		// "found one or likeone"
selectByName(p)	// "one"
select(z)		// "found three"
selectByName(z)	// "found three"
z=>setValue "likeone"
print p=z, p==z // false true

sub select(p as *alfa)
	for p {
		select case eval(this)   // eval(p) also can be used
		case .one
			print "found one or likeone"
		case .two
			print "found two"
		case .three
			print "found three"
		end select
	}
end sub
sub selectByName(p as *alfa)
	for p {
		select case .name$
		case "one"
			print "found one"
		case "two"
			print "found two"
		case "three"
			print "found three"
		case "likeone"
			print "found likeone"
		end select
	}
end sub

Using Locale Id for Date() and Date$()

 This is a small demo which show the use of locale id in Date() and Date$(). See also Locale statement (Locale is also a read only variable). Here Locale statement handle the language format for boolean values (M2000 knows only Greek Αληθές/Ψευδές and not Greek True/False), because boolean values are not part of System (which are day and month names).

So the object of the example is to show how we can convert December 11, 2002 from a string which have date as in 1033 and in 1032 locale. Also see that date$(37601) always return "11/12/2002", which is the same format for date("11/12/2002")

Locale 1033 // English

date("11/12/2002") --> 37601

date("11/12/2002", 1032)=37601 --> True

date$(37601, 1032, "short date")="11/12/2002" --> True

date$(37601, 1032, "long date") --> "Τετάρτη, 11 Δεκεμβρίου 2002"

date("12/11/2002", 1033)=37601 --> True

date$(37601, 1033, "short date")="12/11/2002" --> True

date$(37601, 1033, "long date") --> "Wednesday, December 11, 2002"

date$(37601)="11/12/2002" --> True

Locale 1032 // Greek

date("11/12/2002") --> 37601

date("11/12/2002", 1032)=37601 --> Αληθές

date$(37601, 1032, "short date")="11/12/2002" --> Αληθές

date$(37601, 1032, "long date") --> "Τετάρτη, 11 Δεκεμβρίου 2002"

date("12/11/2002", 1033)=37601 --> Αληθές

date$(37601, 1033, "short date")="12/11/2002" --> Αληθές

date$(37601, 1033, "long date") --> "Wednesday, December 11, 2002"

date$(37601)="11/12/2002" --> Αληθές

Open "date.txt" for wide output as #a
Print #a, chrcode$(0xFEFF); // BOM UTF16LE
locale 1033
Print #a,"Locale 1033 // English"
Print #a, {date("11/12/2002") --> }, date("11/12/2002")
Print #a, {date("11/12/2002", 1032)=37601 --> }, date("11/12/2002", 1032)=37601
Print #a, {date$(37601, 1032, "short date")="11/12/2002" --> }, date$(37601, 1032, "short date")="11/12/2002"
Print #a, {date$(37601, 1032, "long date") --> }+"""", date$(37601, 1032, "long date"),""""
Print #a, {date("12/11/2002", 1033)=37601 --> }, date("12/11/2002", 1033)=37601
Print #a, {date$(37601, 1033, "short date")="12/11/2002" --> }, date$(37601, 1033, "short date")="12/11/2002"
Print #a, {date$(37601, 1033, "long date") --> }+"""", date$(37601, 1033, "long date"), """"
Print #a, {date$(37601)="11/12/2002" --> }, date$(37601)="11/12/2002"
locale 1032
Print #a,"Locale 1032 // Greek"
Print #a, {date("11/12/2002") --> }, date("11/12/2002")
Print #a, {date("11/12/2002", 1032)=37601 --> },date("11/12/2002", 1032)=37601
Print #a, {date$(37601, 1032, "short date")="11/12/2002" --> }, date$(37601, 1032, "short date")="11/12/2002"
Print #a, {date$(37601, 1032, "long date") --> }+"""", date$(37601, 1032, "long date"), """"
Print #a, {date("12/11/2002", 1033)=37601 --> }, date("12/11/2002", 1033)=37601
Print #a, {date$(37601, 1033, "short date")="12/11/2002" --> },date$(37601, 1033, "short date")="12/11/2002"
Print #a, {date$(37601, 1033, "long date") --> }+"""",date$(37601, 1033, "long date"),""""
Print #a, {date$(37601)="11/12/2002" --> }, date$(37601)="11/12/2002"
close #a
document k$
load.doc k$, "date.txt"
report k$
clipBoard k$

Revision 11, Version 11

A lot of work. Update the Greek Manul, and some programs in info.gsb. Also the numbers like 1e34 allowed (previous we have to write 1.e34, see the dot). The old format is valid. Also this change the way we input float numbers using Input and EditBox for GUI (when selected for numbers input).

Revision 10 Version 11 - QRCODE

I found https://github.com/wqweto/VbQRCodegen/blob/master/src/mdQRCodegen.bas from vbforums.com user wqweto. So I bound this module to M2000 code.

simple use (we use 6000 width in twips, and height automatic calculated from ratio W/H):

Img1=Image("http://www.vbforums.com")
Move 3000, 3000
Image img1, 6000

All graphic statements can be used in console (any layer), on printer layer, on user forms layer, on image control on user forms. 

The Img1 is a buffer object which hold emf file of the QRcode (we can save it)

Open "vbforumsQrcode.emf" for Output as #f
Put #f, Img1, 1
close #f

Also we can copy the image to clipboard as emf

Clipboard img1 as "emf"

This is from Help Image( statement in M2000 console

Img1=Image("http://www.vbforums.com")

// color  0 - 15 ή color(R, G, B) R, G, B: 0 - 255 or #FF0077 (html color)

Img1=Image("http://www.vbforums.com", color(255, 0, 128))

// Error tolerate level

 0 ' The QR Code can tolerate about  7% erroneous codewords

 1 ' The QR Code can tolerate about 15% erroneous codewords

 2 ' The QR Code can tolerate about 25% erroneous codewords

 3 ' The QR Code can tolerate about 30% erroneous codewords

Img1=Image("http://www.vbforums.com", color(255, 0, 128), 3)

Img1=Image("http://www.vbforums.com", , 3)

LED CLOCK published in Rosetta Code

This small program draw a digital LED like clock, on desktop, in any monitor type (1280X1024, 1920X1080 etc), using transparent background (so we can click enything behind).

Also there is low demand for CPU usage.

You can find this programm as LED in INFO (the Info.gsb file included in M2000 Setup File)

The main loop is a block of type Every ms_number { }. We use 1000/2 (so 500ms, or 1/2 second) for refreshing the screen. Because M2000 use double buffering, we use Refresh 1000 statement to do two things: To redraw everything (from double buffer) and to suspend redrawing for 1000ms (1 second), where the auto redrawing happen. So because of the Every block we do a redraw each time the Every block run. The idle time goes to system by the Every Block.

About Arrays in M2000. We see here that we have an array D() which defined by the Dim statement. Also we see here that every item of D() array get a tuple (an auto array) using the parenthesis style. An empty tuple is this (,) and a tuple with one item say "Alfa" is this ("Alfa",). Array items can be anything including other arrays. From a "named" array like D() we get numeric values or objects (like arrays). If we have strings a Link D() to D$() make an interface for reading strings (so D$() is a reference of D()). In the call of subrutine LED() we passs the D(n) item (the n item of D() using n as index from low bound to upper bound). Auto arrays or tuple have always index low bound 0. So D(n) is an auto array which pass to a local to subroutine name S(). The S() is a copy of the tuple. If we use S without parenthesis, in LED() subrutine we pass the pointer of the object to that S. A S#val(0)  read the first item of array which pointed by S. Here we use S() a copy of an array (a tuple in D()).

For drawing the polygons, we use polygon statement. We use move statement to move the graphic cursor. The coordinates are in Twips (1440 for a inch, real for printers, but not real for monitors). The origin is always in top left corner (0,0). We draw on M2000 Console, a layer above the Back (Background) a layer which wecan draw also, but here we use a black color.  M2000 console has also 32 layers above the console layer, and also we can use Use Forms, and you can draw in Form Layer or on the layer of an Image control.

\\ if you have two monitors:
\\ Window mode, 1     \\ mode is a read only variable return the size of current font
// Window mode, 2    // selecet monitor 2
cls, 0
window 6, window

Module Led_Clock{
	Escape Off
	Smooth off
	Dim D(-1 to 9)
	D(-1)=(0,0,0,0,0,0,0)
	D(0)=(1,1,1,0,1,1,1)
	D(1)=(0,0,1,0,0,1,0)
	D(2)=(1,0,1,1,1,0,1)
	D(3)=(1,0,1,1,0,1,1)
	D(4)=(0,1,1,1,0,1,0)
	D(5)=(1,1,0,1,0,1,1)
	D(6)=(1,1,0,1,1,1,1)
	D(7)=(1,0,1,0,0,1,0)
	D(8)=(1,1,1,1,1,1,1)
	D(9)=(1,1,1,1,0,1,1)
	N=240
	XX=(scale.x-N*75) div 2
	YY=scale.y-N*22
	NN=N
	BackColor=0
	CLS BackColor, 0
	Back {CLS BackColor,0}
	desktop 255, BackColor
	Forecolor=12
	C=BackColor-Forecolor
	pen BackColor
	for i=0 to 9: cc=d(i): cc*=c:next
	m=1
	move XX+N*23.2, YY+N*5.2
	polygon BackColor-C, N,-N, N,N, -N, N, -N, -N
	move XX+N*23.2,YY+N*13.2
	polygon BackColor-C, N,-N, N,N, -N, N, -N, -N
	move XX+N*49.2,YY+N*5.2
	polygon BackColor-C, N,-N, N,N, -N, N, -N, -N
	move XX+N*49.2,YY+N*13.2
	polygon BackColor-C, N,-N, N,N, -N, N, -N, -N
	dsk=True
	every 1000/2 {
		k=now
		k1=val(str$(k, "hh"))
		k2=val(str$(k, "nn"))
		k3=val(str$(k, "ss"))
		LED(XX, D(k1 div 10))
		LED(XX+N*12, D(k1 mod 10))
		LED(XX+N*26, D(k2 div 10))
		LED(XX+N*38, D(k2 mod 10))
		LED(XX+N*52, D(k3 div 10))
		LED(XX+N*64, D(k3 mod 10))
		refresh 1000
		if keypress(32) then
			dsk~
			if dsk then 	desktop 255 else desktop 255, BackColor
		end if
		if keypress(27)  or mouse=2 then exit
	} 
	desktop 255
	pen 14
	refresh 50
	mode 16
	wait 1000
	Escape On

	sub LED(XX, S())
		move XX+N*1.2, YY+NN
		\\ LED  - UPPER
		polygon BackColor-S(0), N,-N,N*6,0, N,N, -N, N,-N*6,0, -N, -N
		\\ LED | LEFT UPPER
		move XX+N*1.2-N*1.2, YY+N*1.2+NN
		polygon BackColor-S(1), N,-N,N,N,0,N*6,-N, N, -N, -N, 0, -N*6
		move XX+N*1.2+N*7.2, YY+N*1.2+NN
		\\ LED | RIGHT UPPER
		polygon BackColor-S(2), N,-N,N,N,0,N*6,-N, N, -N, -N, 0, -N*6
		move XX+N*1.2, YY+N*8.4+NN
		\\ LED - MIDDLE
		polygon BackColor-S(3), N,-N,N*6,0, N,N, -N, N,-N*6,0, -N, -N
		\\ LED | LEFT BOTTOM
		move XX+N*1.2-N*1.2, YY+N*9.6+NN
		polygon BackColor-S(4), N,-N,N,N,0,N*6,-N, N, -N, -N, 0, -N*6
		\\ LED | RIGHT BOTTOM
		move XX+N*1.2+N*7.2, YY+N*9.6+NN
		polygon BackColor-S(5), N,-N,N,N,0,N*6,-N, N, -N, -N, 0, -N*6
		\\ LED - BOTTOM
		move XX+N*1.2, YY+N*16.8+NN
		polygon BackColor-S(6), N,-N,N*6,0, N,N, -N, N,-N*6,0, -N, -N
	end sub
}
Led_Clock