Revision 26 Version 15

 New function Assembly():

' using assembly(code$) we get the machince code for running from the first offset
example1=Assembly({
    fild  dword [esp+4]    ; st0 = numerator
    fild  dword [esp+8]    ; st0 = divisor, st1 = numerator
    fdivp                  ; st1 = st1 / st0, pop st0
    mov eax, 0    
    ret 8
})
Declare Division Code example1(0) {long a, long b} as single
Print Division(34, 10)=3.4

' using assembly(code$, true) we get tuple, machinecode in a buffer and the object to get pointers from labels
(example1, Assembler)=Assembly({
    fild  dword [esp+4]    ; st0 = numerator
    fild  dword [esp+8]    ; st0 = divisor, st1 = numerator
    fdivp                  ; st1 = st1 / st0, pop st0
    mov eax, 0    
    ret 8
ASM_TEST_CPUID:
    ;mov eax, [esp+4]
    pushad ; 32 bytes
    xor eax, eax
    mov edi, [esp+36]
    xor eax, eax
    cpuid
    mov [edi+0], ebx
    mov [edi+4], edx
    mov [edi+8], ecx
    popad
    xor eax, eax
    ret 4
}, true)
Declare Division Code example1(0) {long a, long b} as single
Print Division(34, 10)=3.4
Dim Ret(12) as byte
addrPtr=Assembler=>LabelPtr("ASM_TEST_CPUID")
Hex "Call address of ASM_TEST_CPUID = ";addrPtr
Declare CPUID Code addrPtr {long ptrArrayItem}
call CPUID(VarPtr(Ret(0)))
' chr(number) return ansi string
for i=0 to len(Ret())-1
    Print chr(Ret(i));
next
Print
buffer clear retstring as byte*12
call CPUID(retstring(0))
' chr$(string_value) convert ANSI to UTF16LE
Print chr(retstring[0, 12])

Greek Version:

Παράδειγμα=ΚΩΔΙΚΑΣ({
    fild  dword [esp+4]    ; st0 = numerator
    fild  dword [esp+8]    ; st0 = divisor, st1 = numerator
    fdivp                  ; st1 = st1 / st0, pop st0
    mov eax, 0    
    ret 8
})
ΟΡΙΣΕ Διαίρεση ΚΩΔΙΚΑ Παράδειγμα(0) {ΜΑΚΡΥΣ α, ΜΑΚΡΥΣ β} ΩΣ ΑΠΛΟΣ
ΤΥΠΩΣΕ Διαίρεση(34, 10)=3.4

(Παράδειγμα1, Συνθέτης)=ΚΩΔΙΚΑΣ({
    fild  dword [esp+4]    ; st0 = numerator
    fild  dword [esp+8]    ; st0 = divisor, st1 = numerator
    fdivp                  ; st1 = st1 / st0, pop st0
    mov eax, 0    
    ret 8
ASM_TEST_CPUID:
    ;mov eax, [esp+4]
    pushad ; 32 bytes
    xor eax, eax
    mov edi, [esp+36]
    xor eax, eax
    cpuid
    mov [edi+0], ebx
    mov [edi+4], edx
    mov [edi+8], ecx
    popad
    xor eax, eax
    ret 4
}, ΑΛΗΘΕΣ)
ΟΡΙΣΕ Διαίρεση ΚΩΔΙΚΑ Παράδειγμα1(0) {ΜΑΚΡΥΣ Α, ΜΑΚΡΥΣ Β} ΩΣ ΑΠΛΟΣ
ΤΥΠΩΣΕ Διαίρεση(34, 10)=3.4
ΠΙΝΑΚΑΣ Επιστροφή(12) ΩΣ ΨΗΦΙΟ
Διεύθυνση_κλήσης=Συνθέτης=>LabelPtr("ASM_TEST_CPUID")
ΔΕΚΑΕΞ "Διεύθυνση κλήσης για το ASM_TEST_CPUID = ";Διεύθυνση_κλήσης
ΟΡΙΣΕ CPUID ΚΩΔΙΚΑ Διεύθυνση_κλήσης {ΜΑΚΡΥΣ ΔείκτηςΣεΣτοιχείοΠίνακα}
ΚΑΛΕΣΕ CPUID(ΔΙΕΥΘΜ(Επιστροφή(0)))
ΓΙΑ Ι=0 ΕΩΣ ΜΗΚΟΣ(Επιστροφή())-1
    ΤΥΠΩΣΕ ΧΑΡ(Επιστροφή(Ι));
ΕΠΟΜΕΝΟ
ΤΥΠΩΣΕ
ΔΙΑΡΘΡΩΣΗ ΚΕΝΗ επιστροφήΑλφαριθμητικό ΩΣ ΨΗΦΙΟ*12
ΚΑΛΕΣΕ CPUID(επιστροφήΑλφαριθμητικό(0))
ΤΥΠΩΣΕ ΧΑΡ(επιστροφήΑλφαριθμητικό[0, 12])

Revision 25 Version 15 Assembler x86 Upgrade

This is an example from the new assembler:

The first declare ..lib was not part of assembler. It is a way for M2000 to load and use a function from a dll. I made a new variant as declare ...code. The new variant get an address (the calling address). The old one get a dll name and a name for function or a cardinal number of function using #).

So the first declare make the function MessageBox() as M2000 function plus the name MessageBox as internal name (read only), for the address of the function. For this example we would like to call this function from the machine code. We need the address and the Hwnd value (the handler of current window, because we need the message box to be as a child window of our window). So @Hwnd and @MessageBox now can be used from assembler - Earlier version need a local variable to be used for each of these two. Names that are not known from assembler are looked as local variables. Also Assembler object need to be used after the call to obtain pointers from labels. See that Execute nee lassembler=>labeloffset( ), but Declare Code need assembler=>labelptr( )

Another difference from Execute is that functions can be pass any number of parameters. Execute get zero to 4  (always pass 4 long values), using the WindowProc internal function. Declare lib/code made functions called by DispCallFunc.

Function x86 called using Call Local. This place the caller scope as the callee scope. We need that because we have some local variables from the caller to be used as values from assembler.

You can see declare lib in SQLITE3 module in INFO which use c calls to handle sqlite3.dll. We can define the output variable (see the example which we define long long (int64)).

Although we make a signature for parameters, we can use the three points "..." for any number of parameters - c call. See Help Declare for this (Declare Global MyPrint Lib C "msvcrt.swprintf" { &sBuf$,  sFmt$, ... })

See also ASM4 in INFO file which saw the use of local variables in assembly plus the calling of M2000 code from the machine code.

Declare MessageBox Lib "user32.MessageBoxW" {long alfa, lptext$, lpcaption$, long type}
ASM_TEST = {    
start_code3:
	push dword 2 | push dword mCaption | push dword mText |  push dword @HWND
	Call @MessageBox
	ret    
	mText:          dw "HELLO THERE", 0
	mCaption:       dw "GEORGE", 0
start_code4:  ; C call then StdCall
	push dword [esp+16] | push dword [esp+16]
	push dword [esp+16] | push dword [esp+16] ; copy arguments
	Call @MessageBox
	ret
start_code5:  ; StdCall -> StdCall
	push dword [esp+16]	| push dword [esp+16]
	push dword [esp+16] | push dword [esp+16] ; copy arguments
	Call @MessageBox
	ret 16
}

Assembler=getobject("","m2000.x86")
function x86 (b as string, &outbuffer, useprep as boolean=false) {
	if Assembler=>assemble(b, true) then
		local OutPutSize=Assembler=>OutputSize
		buffer code outbuffer as byte*OutputSize
		Assembler=>BaseAddress = outbuffer(0)
		if Assembler=>assemble(b) then
			outbuffer=>FillDataFromMem Assembler=>GetOutPtr
		else
			error "x86 fault 2"
		end if
	else
		error "x86 fault 1"
	end if
}
var example1
call local x86(ASM_TEST, &example1)
Declare CallCode code c example1(0) As Long
Print CallCode()
' c call - by default ret value is long but here we place the type.
Declare MsgBox code c assembler=>labelptr("start_code4") {long alfa, lptext$, lpcaption$, long type} as long
Print MsgBox(hwnd, "This is the text", "This is the Caption", 2&)
wait 300
' stdcall
Declare MsgBox2 code assembler=>labelptr("start_code5") {long alfa, lptext$, lpcaption$, long type}
Print MsgBox2(hwnd, "This is the text", "This is the Caption", 2&)

Make Animation through Image Sequences (png files)

A small program written in M2000 produce in a folder a sequence of png files.

We can use Kdenlive to process the sequence as a video clip (we have to adjust th.e time for each image, we can give one video frame per image).

We apply a smart blurr effect to drop some pixels....

This is the code (included in zip file with the Orguss.png)

If not Exist("Orguss.png") then Error "Orguss.png not exit"
module SetFolder (that$) {
	dir user
	try ok {dir that$}
	' if we don't have the folder we make it
	if not ok then subdir that$
	'we can delete any files or we overwrite them
	' we send to two commands to cmd.exe
	' with ";" we don't see the window of cmd.exe
	' dos statement not work if we set a named user.
	' so the named user if the folder exist can:
	' 1) leave it and we get overwritten files or choose another name
	' 2) change the export folder name.	
	dos "cd "+dir$+"  && del *.bmp";
}
module savePNG (file$) {
	copy file$+".png"
}
module title.display (caption$, at as long=0, f$="ARIAL BLACK", sz as long=128){
	module formlabel1 {
		legend letter$, letter$, number, 0, number, 1
		'formlabel letter$, letter$, number, number
	}
	move scale.x/2,at
	Font.sizeY=size.y("|", f$, sz)
	width 4 {
		color {
		formlabel1 caption$, f$, sz, 2
		};
		'move 0,at
		'fill scale.x,Font.sizeY*2/3, 7,12, 0
		move 0, Font.sizeY*2/3+at
		fill scale.x, Font.sizeY/3, 11,3, 0
		 
		color {};
		move scale.x/2, at
		pen 0 {
			color {
				formlabel1 caption$, f$, sz, 2
			}
		}
	}
}
module title.display (caption$, at as long=0, f$="ARIAL BLACK", sz as long=128){
	module formlabel1 {
		legend letter$, letter$, number, 0, number, 0
	}
	
	Font.sizeY=size.y("|", f$, sz)
	move scale.x/2,at+Font.sizeY
	width 4 {
		color {
		formlabel1 caption$, f$, sz, 2
		};
		move 0,at+Font.sizeY
		fill scale.x,Font.sizeY*2/3, 7,12, 0
		move 0, Font.sizeY*2/3+at
		fill scale.x, Font.sizeY/3, 11,3, 0
		 
		color {};
		move scale.x/2, at+Font.sizeY
		pen 0 {
			color {
				formlabel1 caption$, f$, sz, 2
			}
		}
	}
}
module title.displaY (caption$, at as long=0, f$="ARIAL BLACK", sz as long=128){
	module formlabel1 {
		legend letter$, letter$, number, 0, number, 0
	}
	
	Font.sizeY=size.y("|", f$, sz)
		move scale.x/2,at+Font.sizeY/2 
	width 4 {	
		color {
			formlabel1 caption$, f$, sz, 2
		};
		move 0,at
		fill scale.x,Font.sizeY*2/3, 7,12, 0
		move 0, Font.sizeY*2/3+at
		fill scale.x, Font.sizeY/3, 11,3, 0			
		color {};
		move scale.x/2, at
		pen 0 {
			color {
				formlabel caption$, f$, sz, 2
			}
		}					
	}
}
Module SetSceenPixels (pixelsX, pixelsY) {
	Layer {
		font "courier new"
		window 4, pixelsX*twipsX, pixelsY*twipsY;
		mode 12
	}
}

' here we set the current output the background layer,
' which is behind the console layer. The background layer is the form, the console window.
' Console window by default exgtend to full screen.
'window 12, 18000, 12000;
' window 12, window
oldfont$=fontname$
oldmode=mode
'SetSceenPixels 1280, 1024
SetSceenPixels 1024, 768
'SetSceenPixels 640, 480

' so now we make some loambda functions (they hide some state inside as closures)
(cX, cY, cfx, cfy, cfo)=lambda ->{
	Back {
		cls 0,0
		MaxX=scale.x/1920/twipsX
		MaxY=scale.y/1080/twipsY
		OverAll=sqrt(scale.x*scale.y/1920/1080/twipsX/twipsY)
	}
	Data lambda MaxX (i)->{
		 =(8000+i*10)*MaxX
	}
	Data lambda MaxY (i)->{
		=(5000+i*4)*MaxY
	}
	Data lambda MaxX (i)->{
		=i*MaxX
	}	
	Data lambda MaxY (i)->{
		=i*MaxY
	}
	Data lambda OverAll (i)->{
		=i*OverAll
	}	
	=array([])
}()  ' auto execute the lambda

' first we hide the console layer - not the form
Hide
Back {
	' PREPARE BACKGROUND AND OBJECTS
	' we make an emf file in a buffer (in memory only)
		
	drawing 1920*twipsX, 1080*twipsY/2 {
		title.display "ORGUSS", 0, ? ,?
		title.display "Super Dimension Century Orguss", 3000, ?, 72
		
	} as titles
	' rendering emf file to a DIB in a string
	t$="" : image titles to t$ (15),  cfx(100)  ' (15) make the not used pixel as white.
	' some useful numbers
	IY=Image.Y(t$)*2/3
	M=100
	a$=""
	' now we read image orgus.png to a DIB in a string
	' dib is the RGB only representation
	' for this example we use Sprite statement with the simple DIB image.
	' Although Sprite handle Orguss as is : Sprite Orguss, ...
	image "Orguss.png" to a$
	' we save the output to a temporary in memory place
	' later we use Release to get it back
	' so the backgroud can be restrored using Release, one statement only
	' Now the background
	cls 1, 0  
	move 0,0
	fill scale.x, scale.y*3/5, 0,1,,1 
	move scale.x, scale.y*3/5
	' we use a pen with 120/255 opacity, only for the circle
	' we don't use FILL in Circle, but we use Color 14 { }
	' so we get a filled circle file without outline
	pen 14, 120 {color 14 {circle scale.y/1.5}}
	move 0, scale.y*3/5
	fill scale.x, scale.y*2/5, #aaccff, 4
	hold
	' now we move to standard user folder for M2000.
	module SetFolder "export"
	delay=1000/60
	' delay 1 second for the next refresh or the next refresh statement, any came first.
	refresh 1000
	counter=0
	i=1
	' best use for animation is the every statement
	every delay {
		release
		move scale.x/2, IY
		if i>500 then sprite t$,15,,,M,1: M*=.98
		move cx(i), cy(i)
		sprite a$, #FF00FF, 30-i/30, cfo(i/5),,1
		if i<500 then move scale.x/2, IY:Sprite t$, 15
		savePNG "frame"+str$(counter,"000")
		counter++
		refresh 1000
		i+=8: if i>1000 then exit
	}
	move cx(i)-cfx(180), cy(i)+cfy(90)
	' we can use a for next and wait inside.
	for k=1 to 100
		release
		sprite a$, #FF00FF, 30-i/30, cfo((i-k*12)/5),100-k,1
		savePNG "frame"+str$(counter,"000")
		counter++
		step cfx(-180), cfy(90)
		refresh 1000
		wait delay
	next
}
window 4, window
back {cls 0}
font oldfont$
Mode oldmode
dir user

orguss.zip

Snake and Ladder - A RosettaCode Example

https://rosettacode.org/wiki/Snake_and_ladder#M2000_Interpreter 

MODULE SNAKE_AND_LADDER {
	ESCAPE OFF	
	BOARD=LIST:= 4:=14, 9:=31, 17:=7, 20:=38, 28:=84, 40:=59, 51:=67, 54:=34
	APPEND BOARD, 62:=19, 63:=81, 64:=60, 71:=91, 87:=24, 93:=73, 95:=75, 99:=78
	BOARD2=LIST
	FOR I=1 TO 100
		IF EXIST(BOARD, I) THEN BOARD2(EVAL(BOARD))=I
	NEXT
	FOR I=1 TO 100
		IF NOT EXIST(BOARD, I) THEN BOARD(I)=I
		IF NOT EXIST(BOARD2, I) THEN BOARD2(I)=I
	NEXT
	CLS
	WW=SCALE.X/12
	HH=SCALE.Y/12
	DIM C()
	REFRESH 1000
	C()=NXN(10, WW, HH, WW, HH) 
	FOR I=1 TO 100
		J=BOARD(I)
		IF I<>J THEN
			LADDER I, J, WW, HH
		END IF
	NEXT 
	NXN_LABELS 10, WW, HH, WW, HH
	REFRESH 25
	HOLD
	LONG PLAYER1=0, COMPUTER=0
	MIN=MIN(WW, HH)/2
	ZARI=RANDOM(1, 6)
	BOOLEAN COMPUTER_PLAY=TRUE'-RANDOM(0, 1)
	EVERY 1000/8 {
		IF PLAYER1>0 THEN
			MOVE C(PLAYER1)#VAL(0)+WW DIV 2,C(PLAYER1)#VAL(1)+HH DIV 2	
			PEN 15 {WIDTH 8 {CIRCLE MIN}}
		END IF		
		IF COMPUTER>0 THEN
			MOVE C(COMPUTER)#VAL(0)+WW DIV 2,C(COMPUTER)#VAL(1)+HH DIV 2	
			PEN 11{WIDTH 8 {CIRCLE MIN}}
		END IF
		REFRESH 1000
		IF COMPUTER_PLAY THEN
			COMPUTER+=ZARI
			MOVE SCALE.X/2, SCALE.Y/2
			PEN 11 {LEGEND ""+ZARI,"ARIAL", HH/10,0,2} :REFRESH
			WAIT 500
			IF COMPUTER>101 THEN COMPUTER=101-COMPUTER+101
			IF COMPUTER=101 THEN RELEASE:EXIT		
			IF BOARD(COMPUTER)<>COMPUTER THEN COMPUTER=BOARD(COMPUTER)			
			COMPUTER_PLAY~
		ELSE.IF KEYPRESS(32) THEN
			PLAYER1+=ZARI
			MOVE SCALE.X/2, SCALE.Y/2
			PEN 15 {LEGEND ""+ZARI,"ARIAL", HH/10,0,2 }:REFRESH
			WHILE KEYPRESS(32) {WAIT 10}
			IF PLAYER1>101 THEN PLAYER1=101-PLAYER1+101
			IF PLAYER1=101 THEN RELEASE:EXIT		
			IF BOARD(PLAYER1)<>PLAYER1 THEN PLAYER1=BOARD(PLAYER1)
			COMPUTER_PLAY~
		END IF
		ZARI=RANDOM(1, 6)
		IF KEYPRESS(27) THEN EXIT
		RELEASE
	}
	IF PLAYER1=101 THEN	
		MOVE SCALE.X/2, SCALE.Y/2
		LEGEND "PLAYER WIN","ARIAL", HH/10,0,2 
	ELSE.IF COMPUTER=101 THEN	
		MOVE SCALE.X/2, SCALE.Y/2
		LEGEND "COMPUTER WIN","ARIAL", HH/10,0,2 
	ELSE
		WHILE KEYPRESS(27) {WAIT 10}
	END IF
	REFRESH 25
	ESCAPE ON
	FUNCTION NXN(N AS LONG, W AS LONG, H AS LONG, XT AS LONG, YT AS LONG)
		LOCAL LONG I, J, K=1, NN=101, S=-1
		LOCAL P(1 TO N*N), C()
		C()=(#2266AA, #114400)
		FOR I=1 TO N
			MOVE XT, YT
			FOR J=0 TO N-1
				NN+=S
				MOVE XT+J*W, YT
				P(NN)=(XT+J*W, YT)
				POLYGON C(K MOD 2), W, 0,0,H,-W,0,0,-H
				K++
			NEXT
			NN+=S:NN-=N:S*=-1
			K++	
			YT+=H
		NEXT
		=P()
	END FUNCTION
	SUB NXN_LABELS(N AS LONG, W AS LONG, H AS LONG, XT AS LONG, YT AS LONG)
		LOCAL LONG I, J, K=1, NN=101, S=-1
		FOR I=1 TO N
			MOVE XT, YT
			FOR J=0 TO N-1
				NN+=S
				MOVE XT+J*W, YT
				K++
				PATH{POLYGON 4, W, 0,0,H,-W,0,0,-H}
				IF BOARD(NN)<NN THEN
				 	STEP W/2,H/2 : PEN 0 {CIRCLE FILL 0, W/3,H/W}
					STEP -W/2,-H/2							 
				ELSE.IF BOARD(NN)>NN THEN
				 	STEP W/2,H/2 : PEN 14 {CIRCLE FILL 14, W/3,H/W}
					STEP -W/2,-H/2							 
				ELSE.IF BOARD2(NN)<NN THEN
				 	STEP W/2,H/2 : PEN 14 {CIRCLE FILL 14, W/3,H/W}
					STEP -W/2,-H/2							 
				ELSE.IF BOARD2(NN)>NN THEN
				 	STEP W/2,H/2 : PEN 0 {CIRCLE FILL 0, W/3,H/W}
					STEP -W/2,-H/2							 
				ELSE
				 	STEP W/2,H/2 : PEN 2 {CIRCLE FILL 2, W/3,H/W}
					STEP -W/2,-H/2							 			
				END IF  
				STEP W DIV 2, H/6-H/24			
				PATH 2 {FORMLABEL ""+NN,"LUCIDA",H/20*2/3, 2}
			NEXT
			NN+=S:NN-=N:S*=-1
			K++	
			YT+=H
		NEXT
	END SUB
	SUB LADDER(P1 AS INTEGER, P2 AS INTEGER, WW AS LONG, HH AS LONG)
		LOCAL Z
		IF P1<P2 THEN
			Z=14
		ELSE
			SWAP P1, P2 : Z=0
		END IF	
		MOVE C(P1)#VAL(0)+WW DIV 2,C(P1)#VAL(1)+HH DIV 2	
		LOCAL LONG DX=C(P2)#VAL(0)-C(P1)#VAL(0), DY=C(P2)#VAL(1)-C(P1)#VAL(1)
		IF DX=0 THEN DX=WW/2:IF DX=0 THEN DX=TWIPSX
		IF DY=0 THEN DY=HH/2:IF DY=0 THEN DY=TWIPSY
		IF WW DIV 4 = 0 THEN WW = 4
		LOCAL LONG DXN=DX DIV (WW DIV 4): IF DXN=0 THEN DXN=TWIPSX*SGN(DY)
		LOCAL DYN=(DY+HH/2) DIV (DX DIV DXN), J=POS.Y-HH/2
		FOR I=POS.X+DXN TO C(P2)#VAL(0)+WW/2 STEP DXN
			WIDTH 8 {DRAW TO I,J,Z}: J+=DYN		
		NEXT	
		WIDTH 8 {DRAW TO C(P2)#VAL(0)+WW DIV 2,C(P2)#VAL(1)+HH DIV 2, Z}	
	END SUB
}
SNAKE_AND_LADDER

Super Ellipse Plot

https://rosettacode.org/wiki/Superellipse#M2000_Interpreter

You can use: Font "Courier New": Window Mode, 12000, 10000;  for the exact output as in the rosettacode.org example.

Module Checkit {
	Module Superellipse (a As Long, b As Long, n As Double) {
		Const m_x = scale.x div 2
		Const m_y = scale.y div 2
		' myStep *2 because we set line Width 2 pixels 
	    Long x, m, myStep=twipsX*2, top=a div myStep
		Dim y(0 to top) as long
	
	    y(0) = b ' value for x = 0
	    y(top) = 0 ' value for x = a
	    ' 0,0 is in upper left corner
	
	    Move m_x, m_y - y(0) ' set starting point
		Pen #FFBBCC {
			Width 2 {
				For x = 1 To a-1 Step myStep
			        y(m) = Int( Exp( Ln(1 - ((x / a) ^ n)) / n ) * b )
			        draw to m_x + x, m_y - y(m):m++
			    Next			
			    For x = a To 0 Step myStep 
			        draw to m_x + x, m_y + y(m):m--
			    Next
			    For x = 0 To a Step myStep
			        m++:draw to m_x - x, m_y + y(m)
			    Next
			    For x = a To 0 Step myStep
			        draw to m_x - x, m_y - y(m):m--
			    Next
		    }
	    }
	}
	Cls #003300, 0
	Pen #ccffdd 

	VirtualScreenWidth=800
	VirtualScreenHeight=800
	VirtualEllipseSemiHeight=150
	VirtualEllipseSemiDiameter=200
	
	Long a=VirtualEllipseSemiDiameter/VirtualScreenWidth*scale.x
	Long b=VirtualEllipseSemiDiameter/VirtualScreenHeight*scale.y
	Double n = 2.5
	Refresh 2000 ' draw without refreshing the screen	
	Superellipse a, b, n
	Refresh 25 ' final refresh
	Cursor 0, height-1
	Print Over $(6),"hit any key to end program"
	Push Key$:Drop
	Cls
}
Checkit