Revision 17, Version 12 - Monad new example

Revision 17 has some fixes.  

We can make date type variables assigning a string for day & ime stamp:

global a as date="25/2/23 12:30:45"
print type$(a)
list

date  a[5]="27/10/23 12:30:45"
print type$(a[0])
print a[0]

dim b(10) as date="27/10/23 12:30:45"
print b(3)
list

https://rosettacode.org/wiki/Monads/Maybe_monad

• Construct a Maybe Monad by writing the 'bind' function and the 'unit' (sometimes known as 'return') function for that Monad (or just use what the language already has implemented)
• Make two functions, each which take a number and return a monadic number, e.g. Int -> Maybe Int and Int -> Maybe String
• Compose the two functions with bind

So this program make a monad/Maybe class which have a flag say "havevalue" when we construct it with e value. We can bind functions (in the example two functions), which  can return result or "none" if the private [val] has no value (so havevalue would be false).

We can put an integer (one time at the construction). We can get a copy and make new variables. We can't change the inner variable.

Class maybe {
private:
	variant [val]="none"
	boolean haveValue
public:
	property val {
		value  // val return the [val] value
	}
	function bind(f) {
		m=This  // we can read private because bind is function of same class as m
		if m.haveValue Then m.[val]=f(m.[val])
		=m // copy (not pointer)
	}
	Operator "=" (z as maybe) {
		if z.havevalue xor .havevalue then
			push false
		else
			Push z.[val]=.[val]
		end if
	}
	Function unit() {
		variant k
		if match("G") then  // so we can read maybe class
			read g as maybe // fail if not maybe class
	 		if g.havevalue then push g.val
	 	end if
		Read ? k
		m=This
		if not type$(k)="Empty" then
			integer v=k  ' fail if k can't convert to integer
			m.[val]=v
			m.haveValue=true
		else  // so now we can produce "none" from an object which isn't "none"
			m.[val]="none"
			m.haveValue=false
		end if
		=m // copy (not pointer)
	}
class:
	// after class: all are temporary for the constuction phase
	// module with class name is the contructor
	// the object constracted before enter this module
	// but we can change it. So we return a new one.
	module maybe {
		// so the constructor is the same as the .unit
		// ![] pick argument list and place to unit()
		// optionally we can skip the call if we have empty argument list
		if not empty then 
			this=.unit(![])
		end if
	}
}
none=maybe()
decrement =lambda (x as integer)->x-1%
triple =lambda (x as integer)->x*3%
variant emptyvariant
// 3 and 4 are double, 5 is integer type
SetA=(3,4,none,5%, emptyvariant, none.unit())
k=each(SetA)
document doc$
While K
	m1=none.unit(array(K))  // pick element k^
	m2=m1.bind(decrement).bind(triple)
	m3=maybe(m2)
      doc$=m1.val+" -> "+m2.val+" m2=m3 -> "+if$(m2=m3->"True", "False")+{
      }
End While
Try ok {
	m5=maybe("Hello")
}
Print not ok // true , "Hello" not accepted
report doc$
clipboard doc$

This is the version with pointers to groups (Advanced). A group may have one of three state according to the life cycle. A named or unfloat group life end like a local variable. Each member (including functions) are bound to module where we make it, as individual entities (so we can pass by reference). A float group has no name, and maybe has sort life (just as a return value), or maybe has a position in a container like an array, a list or a stack. So the life of a float group depends from the life of its container. A pointer to group, maybe is a weak reference, so the actual life group isn't depend of the pointer's life, or maybe is a real pointer and the life of group which the pointer points depend from the number of pointers who points to it, so when the last pointer deleted or point to some other group, the pointed group deleted. The float groups and the groups which  a pointer hold (a real pointer) are not bound to the module where we use them, except when we use them. To pass a member by reference, from a float group, can be done if we use This objectGroup { } structure which bound temporary the object to that point and we do whatever we want, like it is a named group, although we don't have a name, we use This or dot. We can open more than one (ten at the most) and we can use more dots as prefix to address the 2nd and others groups in the For object {} structure including any folding For object structure. There is a special case when we make a pointer from a float group (from an array item), which make the float group inside array a pointer (from a just float group).

Programmatically the "open" or "non floating" or named group is just a list of members, and all members exist as separate members of module (or if we make it as global, at global level, but the life of them ends at the module's exit). The float group has all the members on it. The pointer, the true one, has a pointer to the float group, and the field IamAPointer with True value. The pointer which isn't true, it is a weak reference has the name (with prefix the qualifier for the lexical scope), so a pName=>X convert to ReferencedName.X. The private members have a special character which not allow to find it at normal search, so if X is private ReferencedName.X not exist. Search is very quick, using internal Hash list.

When we pass a pointer of group to a module or function then we place just a pointer, and at the function/module we can control the way we want that pointer to use: If we don't use type, the default is "as is", a pointer. If we use "as group" or "as typeA" we get a copy as a group. If we use "as pointer" or "as *typeA" we get the pointer. If we pass a float group we can't use the pointer.

So this works:

class Alfa {
	x=10
}
b->Alfa()
module z(k as pointer) {
	? k=>x
}
z b

But this can't work:

class Alfa {
	x=10
}
b=Alfa()
module z(k as pointer) {
	? k=>x
}
z b

we have to use:

z pointer(b)

We can't constrain the input using type:

module z(k as *Alfa) {
	? k=>x
}
z pointer(b)

In the example bellow we use pointers but in the Unit and in the Operator we use Groups, so the pointer converted to Group (as a copy). See the "as maybe" this convert to group if get a pointer. Is the same if we pass a non pointer type group. (see the first implementation of Class maybe).

We use ->(m) to get the real pointer (the ->m return the reference, the fake poiuter). The ->maybe() return real pointer from a float group, because the maybe() return a float group. If we pass something to maybe() as parameter then maybe we get the result of Unit() which return a pointer, but this converted to float group (a real pointer has a float group, so actual we unbox the pointer and get the float group), when assigned to a normal named group (which is This, at the constructor). This is an example to show this. The k object is a group like the b object (with one member x, of type double). We assign to k the pointer of b (a real pointer, we get a copy of b as float and get a pointer to that object). The variable k hold a group's list so the assign now is a merger (we don't change the set member of the k at the Class definition, so we get the default behavior of merging)

class Alfa {
	x=10
}
b=Alfa()
b.x=1000
k=Alfa()
k.x=500
k=pointer((b))
Print k.x=1000
k.x=500
k=pointer((b))
Print k.x=1000

Basically  we need only one time to get a pointer as float group, and at the example below that happen in This=.Unit() and at reading "as maybe".  M2000 as the latest version 12, revision 18, don't behave the same if we use second assignment to k if the first one was done from fake pointer (a reference):

class Alfa {
	x=10
}
b=Alfa()
b.x=1000
k=Alfa()
k.x=500
k=pointer(b)  ' this is fake pointer, is a weak reference to b
Print k.x=1000
k.x=500
k=pointer(b)  ' or k=pointer((b))
Print k.x=500  ' not changed

Maybe this should be fixed in later revisions.

Class maybe {
private:
	variant [val]="none"
	boolean haveValue
public:
	property val {
		value  // val return the [val] value
	}
	function bind(f) {
		m=This  // we can read private because bind is function of same class as m
		if m.haveValue Then m.[val]=f(m.[val])
		->(m) // pointer
	}
	Operator "=" (z as maybe) {
		if z.havevalue xor .havevalue then
			push false
		else
			Push z.[val]=.[val]
		end if
	}
	Function unit() {
		variant k
		if match("G") then  // so we can read maybe class
			read g as maybe // fail if not maybe class
	 		if g.havevalue then push g.val
	 	end if
		Read ? k
		m=This
		if not type$(k)="Empty" then
			integer v=k  ' fail if k can't convert to integer
			m.[val]=v
			m.haveValue=true
		else  // so now we can produce "none" from an object which isn't "none"
			m.[val]="none"
			m.haveValue=false
		end if
		->(m) // pointer
	}
class:
	module maybe {
		if not empty then 
			this=.unit(![])
		end if
	}
}
none->maybe()
decrement =lambda (x as integer)->x-1%
triple =lambda (x as integer)->x*3%
variant emptyvariant
SetA=(3,4,none,5%, emptyvariant, none=>unit())
k=each(SetA)
document doc$
While k
	m1=none=>unit(array(k))  // pick element k^
	m2=m1=>bind(decrement)=>bind(triple)
	m3=maybe(m2)
      doc$=m1=>val+" -> "+m2=>val+" m2=m3 -> "+if$(m2=m3->"True", "False")+{
      }
End While
Try ok {
	m5=maybe("Hello")
}
Doc$= (not ok)+{
}  // true , "Hello" not accepted
report doc$
clipboard doc$

Revision 15, Version 12 (Varptr() function)

 This revision remove a bug on Hex conversion for long long types. Also introduce the VarPtr() and the first try to use interfaces from known objects types.

enum rettypes {
	vt_Unknown=13&
}
declare SHCreateMemStream lib "shlwapi.#12" {long init, long cbinit} as vt_Unknown
a=buffer("this.gif")
method a, "ExportToByte" as b
with b, "ArrPtr" as arrptr()
c=SHCreateMemStream(arrptr(0), len(a))
? type$(c)
d=getobject("stole","stdpicture")
? type$(d)

OutPut:
UnKnown
Picture

Example in info (VarPtr)

// these two functions expect on the second argument byvalue integer and Long type value. (only Long support for automatic conversion this version of M2000)
declare PutMem2 lib "msvbvm60.PutMem2" {long addr, newval} ' newval has to be integer
declare PutMem4 lib "msvbvm60.PutMem4" {long addr, Long newval}
// these two functions expect on the second argument by refernece so we have Long,
//             and we have to place Varptr() for at least the Bytes which the functions replace with new value
declare GetMem2 lib "msvbvm60.GetMem2" {long addr, long retValue}
declare GetMem4 lib "msvbvm60.GetMem4" {long addrl, long retVaule}
integer a[2], nv
With a, "ArrPtr" as global a.ArrPtr()
def aPtr(x as long)=a.ArrPtr(0)+x*2&
Hex "Varptr(a[0]) = ";a.ArrPtr(0), aPtr(0)
nv=123
call PutMem2(a.ArrPtr(0), nv)
call PutMem2(a.ArrPtr(0)+2&, nv+1%)
call PutMem2(a.ArrPtr(0)+4&, nv+2%)
Print a[0]=123, a[1]=124, a[2]=125
hex aPtr(0)
hex aPtr(1)
hex aPtr(2)

// variables
// all variable use a variant type container, but the VarPtr() return the address of the value
// excpet for Variant type which return the address of the first byte of the variant
// also Decimal type has 16 bytes, 18 for value and 2 for the type (always is a part of variant)
// M2000 knows which variable can change type (is variant by use) and which can't (has type)

long K=100
Print K
Call PutMem4(varptr(K), 1000&)
Print K
variant Z=100&
// We now that long value is at an offset of 8
Call PutMem4(varptr(Z)+8, 1234&)
Print Z
long retval
// We can read the type of variant (from the first two bytes)
Call GetMem2(varptr(Z), varptr(retval))
Print retval=3 ' vt_long
Call GetMem4(varptr(Z)+8, varptr(retval))
Print retval=1234

Map Range ( A Rosetta Code Task)

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

This are two modules which return the same output. We can use a class to make an object which return a value passing one parameter, or a lambda function which prepare another lambda function.

I didn't use types for numbers. Literal values 0, 10, -1 and 0 are of type Double. In class Map, private variables are by default double unless we give a type.  We can give either a as single or single a. The first typo has the type after the variable, which is the same for function/module's parameter list, and for constants using Const. Also used for Global/Local/Def. The second typo, has the type before the name. We can use it as is to declare or re-declare a variable. Also this typo supported by Local/Global.

Local make always new variables (and arrays) local scope

Global make always new variables (and arrays) global scope (but the life of these end when "named" code, like in a function and in a module exit.

Def make always local variables (and make local one line functions) , but raise error if we define a local variable second time. Values can be passed only literals

Boolean, Byte, Integer, Long, Long Long, Single, Double, Currency, Decimal, String define (local by default) variables and arrays (special type of arrays). We can combine this (not in a group/class definition) with Global/Local to make new variables for global or local scope.

Variables can be get type from the right expression (here M1 take Group (object) at the first example, and take lambda function at the second example). The I variable take double, so it is a double type.

There is an exception for these two types: Variant and Object. An object which have a tuple can get a list or a stack object. These are objects which we can enumerate with same functionality.

object a=(1,2,3,4)
Print a#sum()=10, a#val(2)=3
a=list:=1,2,3,4,5
Print len(a)=5, exist(a, 3)= true, exist(a, 10)=false
a=stack:=1,2,3,4
Print len(a)=4
stack a {
	Push number*number
}
Print a  ' 2, 3, 4

Variant type can take anything

variant b="ok"
Print b+b="okok"
b=100
Print b+b=200
class alfa {a=10}
b=alfa()
Print b=>a^2=100
b=(1,2,3,4)
Print "["+b#str$(", ")+"]"="[1, 2, 3, 4]"

All variables (except those in immediate mode) take only the same type, from the first assign (or first assign of type, which pass the "zero" value)

We can make constants, using Const and series of constants using Enum (we can define variables of specific enum type. Enum may have string or any numeric type. Operators ++ and -- change the "index" of the enum variable).

enum names {bob="Bob A", bob2="Bob B", jhon="John Doe"}
m=bob
for i=1 to 3
	? m  // we get the names
	m++
next

v=each(names)
while v
	Print eval$(v), eval(v)  ' bob bobA // ...
end while

And these are the MapRange module's (We can include both of them in the same module. The second definition change the current definition of the module MapRange)

module MapRange {
	class Map {
	private:
		a, b, f
	public:
		value (x){
			=.b+(x-.a)*.f
		}
	class:
		module Map (.a,a2,.b,b2) {
			if a2-.a=0 then error "wrong parameters"
			.f<=(b2-.b)/(a2-.a)
		}
	}
	
	m1=Map(0,10, -1, 0)
	for i=0 to 10
		Print i," maps to ";m1(i)
	next
}
MapRange

module MapRange {
	Map=lambda  (a,a2,b,b2) -> {
		if a2-a=0 then error "wrong parameters"
		f=(b2-b)/(a2-a)
		=lambda a,b,f (x)->b+(x-a)*f
	}
	m1=Map(0,10, -1, 0)
	for i=0 to 10
		Print i," maps to ";m1(i)
	next
}
MapRange

Creating an EMF part for drawing from M2000

 

The code:

pen 0
cls 15
form 80, 45
a=1800
b=a*3/4
c=1.5*b
x=6000
y=6000
rem {
	Width 8 {
		move 0+x,  a+y
		draw b, 0
		draw 0, -a
		draw c,a`
		draw -c, a
		draw 0, -a
		step c, -a
		draw 0, 2*a
		step 0, -a
		draw b,0
	}
	cls
}
drawing 4.6*a,2.8*a {
width 24 {
		move 0+a*.3,  a+a*.3
		draw b, 0
		draw 0, -a
		draw c,a
		draw -c, a
		draw 0, -a
		step c, -a
		draw 0, 2*a
		step 0, -a
		draw b,0	
}
} as emf

move 8000, 6000
image emf, 2000
move 8000, 8000
image emf, 2000,,45
move 8000, 8000
image emf, 2000,,-45
move 8000, 8000
image emf, 2000,,-60
move 8000, 10000
image emf, 2000,,-45
move 10000, 8000
image emf, 2000,,-60
move 6000, 8000
image emf, 2000,,45

clipboard  emf  as "emf"
open "part.emf" for output as #n
put #n, emf
close #n

Using the code above I do my experiments to adjust the part at different angles, to find the proper offset for the center of the drawing. The difficulty was by the rendering procedure which take account the drawing size from the width, height we give at Drawing structure (we can leave it blank, and the image "centered" to where the rendering procedure find as the center point). Also we have lines with a width over 1 pixel so this sometime "exclude" the side of the line which is out of bound at the final rendering. These all have to do with the rendering on M2000, and the bitmap export, and some times with the rendering on the paint application. InkScape always exclude info for a bounding rectangle and present the drawing as is, so we can group it and use it as one component. See the image from Inkscape. See the image from paint application which include the bounding hollow rectangle and adjust the size accordingly (see the white space at the right of the displayed bitmap).

Values for coordinates are in twips (twipsX and twipsY are the twips per pixel, and for 96 dpi these have values 15 and 15). The maths are easy here 1440 twips is a logic inch so 96 dpi means one logic inch has 96 pixles, or  1440/96 = 15 twips/pixel. Monitors inch are not real, but for printers it is real, so we can draw exactly 1 inch using 1440 twips for any dpi setting on printer. Monitors diffeents in size  may keeping same resolution as pixels on screen (say 1280 x 1024) and named "96" dpi, so 1280*15 = 19200 is the logical twips for width, but actual the size of monitor maybe a 17 inch or 19 inch has own real dpi. For phone screens we read about ppi, pixels per inch, which are the real dpi of screen, and not the dpi of the software which may varies.

We can import from clipboard to InkSpace.

We can also import to paint application (as a bitmap but with transparency until we leave the float format and make it persistent, at a fixed position).

Κώδικας Σκακιού! ( κείμενο κώδικα: 1042 γραμμές)

 Ο κώδικας υπάρχει στο Info (δες Setup). Εδώ μπήκε ως αναφορά. Είναι το μεγαλύτερο πρόγραμμα στο info, με 1042 γραμμές.

\\ George Karras, 2020

\\ Chess Example (a big one)
\\ Example Using sprites
\\ Rev. 6
\\ to add a chess engine:
\\ at m2000 console type: win dir$
\\ paste to that folder the engine.exe
\\ this engine is an executable file like stockfish_20090216_x64_modern.exe
\\ from https://stockfishchess.org/
\\ so get the proper exe file, copy to m2000 user folder (use win dir$ from m2000 console)
\\ then rename it as engine.exe

enginepath$=dir$+"engine"
blackComputer=exist(enginepath$+".exe")
gosub initengine

chessfont$="Arial Unicode MS"
Font chessfont$
if not Fontname$="Arial Unicode MS" then
	chessfont$="DejaVu Sans"
end if
Font "Verdana"
Thread.plan sequential
Set Fast
Hide
window 12, window
if random(1, 3)=1 then
window 12, scale.x*random(6,9)/10,scale.y*random(6,9)/10;
end if
form 48,34
def thismode
thismode=mode
global const  NoSound = False
Module NothingToMove {
	Layer {Print $(4)," Nothing to move",$(0);}
}
Module Proper {
	Layer {Print $(4)," Wrong color",$(0);}
}
Module Beep {
	Layer {Print $(4)," Not Possible",$(0);}
	if NoSound Else Beep
}
back {
	\\ we use a switch to alter the return code in Input ! variant, when we press Enter key
	\\ normally "-inp" return in Field  read only variable 1 when we press enter or down arrow
	\\ using "+inp" we can get 13 for enter and 1 for down arrow
	Cls 0,0
	font "Times"
	Pen 15
	Mode thismode*5
	cursor 0,height div 2
	Report 2, "Wait...."
	refresh 10000	
	Mode thismode

	set switches "+inp"
	Fkey Clear
	Escape off
	Cls #FFA000,0
	Pen 14
	bold 1
	mode thismode
	Def White$="PNBRQK", Black$="pnbrqk", WhiteDisp$="♙♘♗♖♕♔"
	Def BlackDisp$="♟♞♝♜♛♚", empty$="12345678", disp$
	disp$=WhiteDisp$+BlackDisp$ 
	Def White_♔_file, White_♔_rank, Black_♚_rank, Black_♚_file
	Def boolean White_♔_no_roke, Black_♚_no_roke
	Def boolean White_no_left_roke, Black_no_left_roke
	Def boolean White_no_right_roke, Black_no_right_roke
	Def Halfmove_clock, Fullmove_number, threat, Clip$
	Dim emptydisp$(1 to 8), BoardSq(1 to 8, 1 to 8)=(,)
	Def en_passant_rank=0, en_passant_file=0
	for i=1 to 8 :emptydisp$(i)=string$(" ",i):next i
	Def board$, status$, oldI, color1, color2, C=14
	color2=Color(209, 139, 71)
	color1=Color(255, 206,158)
	
	dim line$()
	Def flashtime=300
	Dim PastGames$(1 to 200)
	Def freeSlot=0, cur=0, ok=true, k$, condition$
	Def double ip, jp, ip1, jp1, si, sj, getone as boolean
	Def st, fig$, tr, mx, my, lx,ly, key=0, mmx,mmy, mmb
	Def movelogic as boolean=false, mvx, mvy
	sa=(,) : sb=each(sa)
	Double
	OldI=Italic
	Italic 1
	Def upperlimit
	Cursor 0,0
	Pen 15 {Report 2, "Chess Game "+if$(blackComputer->"UCI Engine", "for two")}
	Italic OldI
	Normal
	Move !      ' Move graphic cursor to character cursor  - Cursor !  the other way
	upperlimit=pos.y*1.6
	move 0, upperlimit*6/8
	Fill scale.x,scale.y-upperlimit*6/8, 3,5,1
	Set Fast !
	\\ calc based to height
	HalfWidth=(scale.y*.65) div 16
	def downlimit=0, White as boolean=True, fw
	DrawEmptyBoard((scale.x/2-HalfWidth*8),upperlimit, HalfWidth, 15)
	fw=HalfWidth*2-60
	\\ hold
	\\ set new game
	\\ -1 for no FEN
	def NoFEN(aGame$)=len(aGame$)<>len(filter$(aGame$,"/"))+7
	Inventory OnBoard
	Const NewGame$="rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"
	Def ThisGame$
	\\ CHECK IF A STRING IS IN STACK (SO THIS MAYBE A FEN NOTATION FOR A STARTING POSITION)
	if match("S") then
		For this {
			\\block for temporary definitions
			Local row$(),  i, nok, m
			Read ThisGame$
			row$()=piece$(ThisGame$, chr$(13)+chr$(10))
			\\ we drop lines by redim the array (dim also is a "dim preserve")
			while  len(row$())>1
				if row$(len(row$())-1)="" then dim row$(len(row$())-1) else exit
			end while
			if len(row$())>0  then
				m=each(row$())
				while m
					if NoFEN(array$(m)) Then nok=true: exit
				end while
			End if
			if nok then Push ThisGame$ : ThisGame$=NewGame$ : exit
			PastGames$()=row$()
			Dim PastGames$(1 to 200)
			freeSlot=len(row$())
			ThisGame$=PastGames$(freeSlot)
		}
	else
		ThisGame$=NewGame$
	End if
	
	SetBoard(ThisGame$)
	RedrawBoard(True)
	sx=scale.x
	sy=scale.y-downlimit
	move 0,downlimit
	fill  sx,sy, 5
	Layer {
		font "Verdanal"
		mode thismode, sx,sy
		motion center
		motion, downlimit
		Cls 5,0
		Pen 14
	}
	Refresh 60
	flush
	move$=""
	refresh
	\\ ctrl+F1 help
	About  ! "How to play", 14000,9000,{Give one or more moves in one input line.
		Each move has a letter a number a letter and  final a number
		so:
					e2e4   or  e2-e4  or e2..e4
					(symbols other than aebcdefgh and 123456789 are white space)
		move something from e2 to e4, but this
					e2e3e7e5
		give two moves (so we can paste a number of moves)
		before a move a new FEN string compiled and copied to clipboard.
		if nothing exist in e2 then we get a beep sound. If a move break a rule then no move happen and we get a beep. If King have a threat then we have to do a proper move to eliminate threat otherwise we get a beep.
		We can press enter without giving a move, so we asked for ending the game or not.
		If we press Y then a new input start to get a FEN board notation, so we can use ctrl+V to paste the string and pressing enter we get the new boad.
		* Castling work automatic. So if rules are ok wen can give a e1c1 for queen side castling for white king.
		* En passant works fine
		* A pawn at last rank turn to Queen
		You can call this module passing a FEN string as parameter.
		George Karras
		}
	Thread {
		if control$<>"MAIN" then continue
		mmb=mouse
		If mmb=0 then continue
		mmy=mouse.y : mmx=mouse.x
		if mmy>downlimit  then
			if  mmx<scale.x*.8 then
				if mmb=2  then Field New 99 : Input End
			else
				if mmb=1 then Input End
			end if
		else.if mmy<downlimit  and mmy>upperlimit then
			Field New if(mmy>((downlimit+upperlimit)/2)->1,-1)
			Input End
		end if
		
	} as Handler interval 100
	Thread Handler Hold
	Thread {
		if control$<>"MAIN" then continue
	
		if getone then
		move lx, ly
		Refresh 100
		sprite sprite$
		mx=mouse.x : my=mouse.y :mmb=mouse
		sb=each(BoardSq())
		
		St=(,)
		While sb
		sa=array(sb)
		if sa#val(3)-twipsX<=mx and sa#val(5)+twipsX>=mx and sa#val(4)-twipsY<=my and sa#val(6)+twipsY>=my then St=sa : exit
		End While
		if len(st)>0 then
			si=st#val(10) : sj=st#val(11)
			if mmb=0 then
				keyboard chr$(ip+96)+chr$(jp+48)+chr$(si+96)+chr$(sj+48)+chr$(13)
				getone=false:  refresh 100 : mouse.icon show
			else
				lx=mx : ly=my
				move lx, ly
				if st#val$(8)=" " or  (si=ip and sj=jp) then
					sprite fig$, tr
				else
					sprite fig$, tr,-10,,80
				end if
				refresh 100
			end if
		else.if mmb=0 then
			RedrawBoard(?)
			getone=false
			mouse.icon show
			Thread Sp restart
		end if
		if not getone  then Thread this hold
	} as pSp interval 1000/30
	Thread pSp hold
	Thread {
		if control$<>"MAIN" then continue
		if mouse=0 and movelogic then movelogic=false 
		if mouse.y<upperlimit then mouse.icon 15 else mouse.icon 1
		
		if not movelogic then if mouse.y<upperlimit and mouse=1 then  movelogic=true: mvx=mousea.x : mvy=mousea.y:continue
		if movelogic then if  mouse=1 then motion  motion.wx- mvx+mousea.x, motion.wy-mvy+mousea.y : continue
		
		mx=mouse.x : my=mouse.y
		if mouse=1 and my>downlimit then input end : Thread this hold
		if mouse=1 and not getone then{
		move mx, my
		if point=0 or point=#FFFFFF else exit
		sb=each(OnBoard)
		
		St=(,)
		While sb
		sa=eval(sb)
		if sa#val(3)<mx and sa#val(5)>mx and sa#val(4)<my and sa#val(6)>my then St=sa : exit
		End While
		if len(st)=0 then exit
		move st#val(3)+30, st#val(4)+30
		refresh 1000
		tr=point
		copy fw,fw to fig$
		Image fig$ to fig$,120,120
		fill fw,fw, tr
		move mx, my
		lx=mx:ly=my
		ip=st#val(10):jp=st#val(11)
		sprite fig$, tr
		mouse.icon hide
		getone=true
		Thread pSp restart
		Thread this hold
		}
	} as Sp interval 100
	mouse.icon show
	isok=true
	{
	
		{
			if white then		
				CheckThreat(white, White_♔_file, White_♔_rank, &threat)
			else
				CheckThreat(white, Black_♚_file, Black_♚_rank, &threat)
			end if
			if isok  then
				freeSlot++
				GetBoard(&Clip$)
				if freeSlot>Len(PastGames$()) then Dim PastGame$(1 to 2*Len(PastGames$()))
				PastGames$(freeSlot)=Clip$
			end if
			\\\test
			condition$=if$(White->"White move", "Black move") + if$(threat->" (check)","")+ if$(Halfmove_clock>50->"(You can draw)","")+":"
			Layer {
				Print Part $(4,5), right$(string$(chrcode$(8199), 3)+str$(Fullmove_number,""),3)+".", $(7,12),condition$,
			}
			if blackComputer then
				if not White then 	mymove$=@GetMove$(PastGames$(freeSlot)): keyboard left$(mymove$,4)+chr$(13)
			end if		
			White~
			if empty then
				Layer {
					Pen 15 {Input "",move$;}
				}
				\\\test !			
				Thread Sp hold
				Thread pSp Hold
				mouse.icon 1
				getone=false
				if move$="" then
					
					Layer {
						wait 100
						Refresh 60
						profiler
						Every 1000/60 {
							if timecount>flashtime then
								profiler
								Cls
								Pen C {Double : Report 2,"End this Game ?" : Normal}
								C=20-C
								Cursor width, Height
								Move !   \\ copy character cursor to graphic cursor
								Legend "Use Y or Left Mouse Click  to exit | Right Mouse Click or N to continue", FontName$, Mode*.7, 0,1, 1,twipsX
							end if
							k$=""
							if keypress(0x1B) then k$="Y":exit
							if keypress(0x4E) then exit
							if keypress(0x59) then  k$="Y":exit
							if keypress(1) then k$="Y": exit
							if keypress(2) then exit
							
						}
					}
					while not inkey$ ="" {Wait 1}  'drop key any
					If k$="Y" else
						\\ if stack has something then RedrawBoard mey use it (because read for optional variable)
						\\ we can be sure we set the optional value using ?
						White~ :RedrawBoard(?): Layer {Cls}
						getone=false
						Thread Sp restart
						flush ' make empty true (so stack is empty for sure)
						loop  ' set a flag for restart at end bracket of current block
					end if
				else
					move$=lcase$(move$)
					while len(move$)>0
						select case left$(move$,1)
						case "1" to "8"
							data asc(move$)-48
						case "a" to "h"
							data asc(move$)-96
						end select
						insert 1,1 move$=""
					end while
				end if
				isok=false
			end if
			if not empty then
				if stack.size mod 4 = 0 then
					try ok {
						MakeAmove(&isok)
						if not isok then flush : White~: exit
						if not empty then
						white~: refresh : wait 500 : loop
						end if
					}
					Layer {Print}
					getone=false
					if isok else RedrawBoard(?)
					
					if ok then loop : Thread Sp restart
				else
				
					flush : White~ : loop  : Thread Sp restart' loop processed at the end of the block, so only a flag raised here
				end if
			end if
			
		}
		Thread Sp Hold
		Thread pSp Hold
		cur=freeSlot
		Clip$=PastGames$(cur)
		Layer {
			if cur=0 then cur=1
			if cur>freeSlot then cur=freeSlot 
			if  Clip$<>PastGames$(cur) then
			Clip$=PastGames$(cur)
			if len(Clip$)=len(filter$(Clip$,"/"))+7  and  trim$(Clip$)<>"" then Back {SetBoard(Clip$) :RedrawBoard(?)}
			end if
			Refresh  60
			Cls
			Cursor width, Height
			Move !
			Legend "Right Mouse Click or Esc to Quit | Left Mouse Click right of the FEN to continue play | About Ctrl+F1", FontName$, Mode*.7, 0,1, 1,twipsX
			Cursor 0,0
			Report 2, "Replay the Game,(arrows u/d) or Start a new one setting a new FEN"
			Print Part $(7,7), "Board FEN: "
			Field New 13
			Thread Handler Restart
			Pen 15 {Input ! Clip$, width-7 len=100}
			Thread Handler Hold
			Report Clip$
			refresh 60
			if field=13 then exit
			if field=-1then cur-- : loop
			if field=99 then Clip$="": exit
			if field=1 then cur++ : loop
		}
		if len(Clip$)<>len(filter$(Clip$,"/"))+7  or  trim$(Clip$)="" then SaveGame():Layer {Cls} : exit
		if Clip$<>PastGames$(cur) then
			SaveGame()
			PastGames$(1)=Clip$:cur=1
		end if
		freeSlot=cur
		SetBoard(Clip$)
		RedrawBoard(?)
		Layer {Cls}
		Thread Sp restart
		Loop
	}
	Cls 0,0	
}
hide
threads erase
declare Engine nothing
wait 200
about ""
if module(info) then keyboard "info"+chr$(13)
Flush
set switches "-inp"
escape off
Window 12, window
form
form ;
About ! ""
end
Sub SaveGame()
if freeSlot=1 then exit sub
Local Out$
Document Out$     ' upgrade to Document
layer {
	Cls
	if ask("Copy the game to clipboard?","Finish","*Yes","No")=1  then
		Report "Wait..."
		for i=1 to freeSlot
			Out$+=PastGames$(i)
			if i<freeSlot then
			Out$={
			}
			end if
		next
		Clipboard Out$
		Save.Doc Out$, "LastGame.chess"
		Report "Done..."
		wait 300
	end if	
}
end sub
Sub SaveGame1()
local Out$, i
Document Out$  ' upgrate to document
layer {
}
End Sub
Sub DrawEmptyBoard(leftmargin, topmargin, squarewidth, labelcolor)
	Local a=true, z=bold : bold 0
	Local l=squarewidth, k=2*l, k1=k*.85, N1=6, N=6, M=4, B=k*8, B1
	Local d=0, im=0, jm=0
	Repeat
	N=N1
	N1+=.25
	Until K1<size.Y("A",chessfont$, N1)
	topmargin-=l
	leftmargin-=l
	move leftmargin+l,topmargin+l
	B1=(l div 300)*twipsX
	step -B1,-B1
	B+=B1*2
	Pen 0 {
	Width b1 div 2+1 {
		color color1 , 1{Polygon 0, B, 0, 0, B, -B, 0, 0, -B}
	}
	M=N*.65
	For i=1 to 9
		d=leftmargin
		move d, topmargin
		if i<9 then
			step 0, k
			Pen labelcolor{Legend str$(9-i,""), chessfont$, M,0,2}
			step 0, -k
			else
			N=M
		end if
		for j=1 to 8
			If i<9 then
				step l, l
				color  color1,1 {fill k,k, if(a->color1,color2)}
				step  -l, -l
				BoardSq(j, 9-i)=(N, pos.x, pos.y, pos.x-l+twipsX, pos.y-l+twipsX, pos.x+l-twipsX, pos.y+l-twipsX, k-twipsX*2, " ", a, j,9-i)
				a~
			else
				step k, k
				pen labelcolor {
					Legend mid$("abcdefgh",j,1), chessfont$, N, 0, 2
				}
			end If
			d+=k
			move d, topmargin
		next
		a~ : topmargin+=k
	next
	}
	bold z
	downlimit=topmargin+500
end sub
Sub MakeAmove( &ok, i, j, i1, j1)
Local z=bold, p$, p1$ : bold 0
Local t,t1, N=BoardSq(1,1)#val(0), again as boolean, playroke as boolean
ok=false
Local rule=true, threat as boolean
refresh 10000
Pen 0 {
	again=false
	t=BoardSq(i,j)
	t1=BoardSq(i1, j1)
	p$=t#val$(8)
	p1$=t1#val$(8)
	if p$=" " then NothingToMove : exit
	if t is t1 then NothingToMove : exit
	if p1$<>" " then if p1$<"♚" and p$<"♚" then Proper : exit
	if p1$<>" " then if p1$>="♚" and p$>="♚" then Proper : exit
	\\ white change logic here
	if not white and instr(WhiteDisp$, p$)=0 then Proper : exit
	if white and instr(BlackDisp$, p$)=0 then Proper :exit
	select case p$
	case "♔"
	{
		If not White_♔_no_roke  then
			CheckThreat(not white, White_♔_file, White_♔_rank, &threat)
			if not threat then
				if i1=3 and j1=1  then
					if p1$=" " and BoardSq(2,1)#val$(8)=" " and  BoardSq(4,1)#val$(8)=" " and not White_no_left_roke then
						CheckThreat(not white, 4, 1, &threat)
						if not threat then push 1, 4, 1, 1 : again=true : playroke=true
					end if
				else.if i1=7 and j1=1 then
					if p1$=" " and BoardSq(6,1)#val$(8)=" " and not White_no_right_roke then
						CheckThreat(not white, 6, 1, &threat)
						if not threat then push 1, 6, 1, 8 : again=true :  playroke=true
					end if
				end if
			end if
		end if
		if not playroke Then
			if abs(i-i1)>1 then rule=false: exit
			if abs(j-j1)>1 then rule=false: exit
			White_♔_no_roke=true
			White_no_right_roke=True
			White_no_left_roke=true
		end if
		CheckKing()
		if threat then
			rule=false
			if playroke then drop 4
		else
			White_♔_rank=j1
			White_♔_file=i1
		end if
	}
	case "♚"
	{
		If not Black_♚_no_roke  then
			CheckThreat(not white, Black_♚_file, Black_♚_rank, &threat)
			if not threat then
				if i1=3 and j1=8 then
					if p1$=" " and BoardSq(2,8)#val$(8)=" " and  BoardSq(4,8)#val$(8)=" " and not Black_no_left_roke then
						CheckThreat(not white, 4, 8, &threat)
						if not threat then push 8, 4, 8, 1 : again=true : playroke=true
					end if
				else.if i1=7 and j1=8 then
					if p1$=" " and BoardSq(6,8)#val$(8)=" " and not Black_no_right_roke then
						CheckThreat(not white, 6, 8, &threat)
						if not threat then push 8, 6, 8, 8 : again=true :  playroke=true
					end if
				end if
			end if
		end if
		if not playroke Then
			if abs(i-i1)>1 then rule=false: exit
			if abs(j-j1)>1 then rule=false: exit
			Black_♚_no_roke=true
			Black_no_right_roke=true
			Black_no_left_roke=true
		end if
		CheckKing()
		if threat then
			rule=false
			if playroke then drop 4
		else
			Black_♚_rank=j1
			Black_♚_file=i1
		end if
		}
	case "♕","♛"
	{
		if i1<>i and j1<>j then
			if abs(i1-i)<>abs(j1-j) then rule=false: exit
			jm=0
			if abs(i1-i)>1 then
				jm=j+sgn(j1-j)
				for im=i+sgn(i1-i) to i1-sgn(i1-i)
				if BoardSq(im,jm)#val$(8)<>" "  then jm=-1: exit for
				jm+=sgn(j1-j)
			next
			end if
		else
		jm=0:im=0
		if abs(i1-i)>1 then
			for im=i+sgn(i1-i) to i1-sgn(i1-i) 
				if BoardSq(im,j)#val$(8)<>" " then jm=-1: exit for
			next
		else.if abs(j1-j)>1 then
			for jm=j+sgn(j1-j) to j1-sgn(j1-j) 
				if BoardSq(i,jm)#val$(8)<>" " then im=-1 :exit for
			next
		end if
		if im=-1 or jm=-1 then rule=false:exit
		end if
		CheckIt()
	}
	case "♜"
	{
		If playroke then Black_no_right_roke=true : Black_no_left_roke=true : Black_♚_no_roke=True : exit
		if i1<>i and j1<>j then rule=false: exit
		jm=0:im=0
		if abs(i1-i)>1 then
			for im=i+sgn(i1-i) to i1-sgn(i1-i) 
				if BoardSq(im,j)#val$(8)<>" " then jm=-1: exit for
			next
		else.if abs(j1-j)>1 then
			for jm=j+sgn(j1-j) to j1-sgn(j1-j) 
				if BoardSq(i,jm)#val$(8)<>" " then im=-1 :exit for
			next
		end if
		if im=-1 or jm=-1 then rule=false:exit
		CheckIt()
		if not rule then exit
		if i=1 and j=8 then Black_no_left_roke=true
		if i=8 and j=8 then Black_no_right_roke=true
	}
	case "♖"
	{
		If playroke then White_no_right_roke=true : White_no_left_roke=true : White_♔_no_roke=True : exit
		if i1<>i and j1<>j then rule=false: exit
		jm=0:im=0
		if abs(i1-i)>1 then
			for im=i+sgn(i1-i) to i1-sgn(i1-i) 
				if BoardSq(im,j)#val$(8)<>" " then jm=-1: exit for
			next
		else.if abs(j1-j)>1 then
			for jm=j+sgn(j1-j) to j1-sgn(j1-j) 
				if BoardSq(i,jm)#val$(8)<>" " then im=-1 :exit for
			next
		end if
		if im=-1 or jm=-1 then rule=false:exit
		CheckIt()
		if not rule then exit
		if i=1 and j=1 then White_no_left_roke=true
		if i=8 and j=1 then White_no_right_roke=true
	}
	case "♗","♝"
	{
		if i1=i or j1=j then rule=false: exit
		if abs(i1-i)<>abs(j1-j) then rule=false: exit
		jm=0
		if abs(i1-i)>1 then
			jm=j+sgn(j1-j)
			for im=i+sgn(i1-i) to i1-sgn(i1-i)
				if BoardSq(im,jm)#val$(8)<>" "  then jm=-1: exit for
				jm+=sgn(j1-j)
			next
		end if
		if jm=-1 then rule=false:exit
		Checkit()
      	}
	case "♘","♞"
	{
		if abs(i1-i)=abs(j1-j) then rule=false: exit
		if abs(i1-i)=0 or abs(j1-j)=0 then rule=false: exit
		if abs(i1-i)+abs(j1-j)<>3 then rule=false: exit
		Checkit()
	}
	case "♙"
	{
		if j1<=j then rule=false:exit
		if i<>i1 then if i1<i-1 or i1>i+1 then rule=false: exit
		if j>2 then if j1>j+1 then rule=false:exit
		if j=2 and j1>j+2 then rule=false:exit
		if i=i1 and p1$<>" " then rule=false:exit
		if i<>i1 and p1$=" "and not (en_passant_file=i1 and en_passant_rank=j1-1)  then rule=false:exit
		if i<>i1 and j1>j+1 then rule=false exit
		if en_passant_file=i1 and en_passant_rank=j1-1 then
			Checkit2()
		else
			Checkit()
		End if
		en_passant_file=0
		en_passant_rank=0
		if j1=8 then p$="♕" else if j1=j+2 then en_passant_file=i1:en_passant_rank=j1
	}
	case "♟"
	{
		if j1>=j then rule=false:exit
		if i<>i1 then if i1<i-1 or i1>i+1 then rule=false: exit
		if j<7 then if j1<j-1 then rule=false:exit
		if j=7 and j1<j-2 then rule=false:exit
		if i=i1 and p1$<>" " then rule=false:exit
		if i<>i1 and p1$=" " and not (en_passant_file=i1 and en_passant_rank=j1+1) then rule=false:exit
		if i<>i1 and j1<j-1 then rule=false:exit
		if en_passant_file=i1 and en_passant_rank=j1+1 then
			Checkit2()
		else
			Checkit()
		End if
		en_passant_file=0
		en_passant_rank=0
		if j1=1 then p$="♛" else if j1=j-2 then en_passant_file=i1:en_passant_rank=j1
	}
	end select
	If not rule then beep : exit
	move t#val(3), t#val(4)
	return t, 8:=" "
	delete OnBoard, i*9+j
	if t#val(9) then fill t#val(7), t#val(7),color1 else fill t#val(7), t#val(7), color2
	
	t=t1
	move t#val(3), t#val(4)
	fill t#val(7), t#val(7),15
	if p1$<>" " then
		Halfmove_clock=0
		Return OnBoard, i1*9+j1:=t
	else
		Halfmove_clock++
		Append OnBoard, i1*9+j1:=t
	end if
	return t, 8:=p$
	move t#val(1), t#val(2): Legend p$, chessfont$, N, 0, 2,0
	move t#val(3)+twipsx*2, t#val(4)+twipsy*2
	if t#val(9) then floodfill  ,,color1 else floodfill , , color2
	if again then read  i, j, i1, j1 : Restart
	if p$<>"♙" and p$<>"♟" then en_passant_file=0 : en_passant_rank=0
	if white then Fullmove_number++
	Ok=true	
}
bold z
refresh 10000
end Sub

Sub RedrawBoard(NoRefresh as boolean=False)
Local z=bold, p$ : bold 0
Local t, N=BoardSq(1,1)#val(0)
If NoRefresh Else refresh 10000
Pen 0 {
	For j=1 to 8
		For i=1 to 8
			t=BoardSq(i,j)
			move t#val(3), t#val(4)
			fill t#val(7), t#val(7),15
			p$=t#val$(8)
			
			if p$=" " else move t#val(1), t#val(2): Legend p$, chessfont$, N, 0, 2,0
			move t#val(3)+twipsx*2, t#val(4)+twipsy*2	
			if t#val(9) then floodfill  ,,color1 else floodfill , , color2
		Next
	Next
}
bold z
If NoRefresh Else refresh 60
end Sub
Sub GetBoard(&chessboard$)
chessboard$=""
local i, j,a$, spc, line$
for j=8 to 1
line$=""
for i=1 to 8
a$=BoardSq(i,j)#val$(8)
if a$<>" " then
if spc>0 then line$+=str$(spc,""): spc=0

line$+=mid$("PNBRQKpnbrqk", instr("♙♘♗♖♕♔♟♞♝♜♛♚", a$),1)
else
spc++
end if
next
if spc>0 then line$+=str$(spc,""): spc=0
if j>1 then chessboard$+=line$+"/" else chessboard$+=line$+" "
next
if white then chessboard$+="w " else chessboard$+="b "
if  White_♔_no_roke and  Black_♚_no_roke then
	chessboard$+="-"
else
	if White_no_right_roke else chessboard$+="K"
	if White_no_left_roke else chessboard$+="Q"
	if Black_no_right_roke else chessboard$+="k"
	if Black_no_left_roke else chessboard$+="q"
end if
if not en_passant_file=0 then
	chessboard$+=" "+chr$(96+en_passant_file)+chr$(48+en_passant_rank)
else
	chessboard$+=" -"
end if
chessboard$+=str$(Halfmove_clock)
chessboard$+=str$(Fullmove_number)
End Sub
Sub SetBoard(chessboard$)
	Rem https://en.wikipedia.org/wiki/Forsyth–Edwards_Notation
	Clear OnBoard
	board$=leftpart$(chessboard$," ")
	if len(filter$(board$,"K"))<>len(board$)-1 Then  Error "Problem with White King"
	if len(filter$(board$,"k"))<>len(board$)-1 Then  Error "Problem with Black King"
	status$=ltrim$(rightpart$(chessboard$," "))
	white=left$(status$,1)="w" 
	status$=ltrim$(mid$(status$,2))
	if left$(status$,1)="-" then
		White_no_right_roke=True
		White_no_left_roke=True
		White_♔_no_roke =True
		Black_no_right_roke=True
		Black_no_left_roke=True
		Black_♚_no_roke=True
		status$=ltrim$(mid$(status$,2))
	else
		local L=len(status$)
		status$=filter$(status$,"K")
		White_no_right_roke= len(status$)=L
		L=len(status$) : status$=filter$(status$,"Q")
		White_no_left_roke= len(status$)=L
		White_♔_no_roke = White_no_right_roke and White_no_left_roke
		L=len(status$) : status$=filter$(status$,"k")
		Black_no_right_roke= len(status$)=L
		L=len(status$) : status$=filter$(status$,"q")
		Black_no_left_roke= len(status$)=L
		Black_♚_no_roke=Black_no_right_roke and Black_no_left_roke
		status$=ltrim$(status$)
		
	End if
	if left$(status$,1)="-" then
		en_passant_file=0
		en_passant_rank=0
		status$=mid$(status$,2)
	else
		en_passant_file=Asc(left$(status$,1))-96
		en_passant_rank=Asc(Mid$(status$,2,1))-48
		if en_passant_rank=3 then en_passant_rank=4 else en_passant_rank=5
		status$=mid$(status$,3)
	end if
	Local m 
	Halfmove_clock=val(status$, "int", &m)
	status$=mid$(status$,m)
	Fullmove_number=max.data(val(status$, "int", &m), 1)
	nl$={
	}
	for i=1 to 6
		board$=replace$(mid$(White$,i,1),mid$(WhiteDisp$,i,1), board$)
		board$=replace$(mid$(Black$,i,1),mid$(BlackDisp$,i,1), board$)
	next
	for j=1 to 8
		board$=replace$(str$(j,""),emptydisp$(j), board$)
	next
	line$()=piece$(board$,"/")
	local t
	dim line$(1 to 8)
	For j=1 to 8: For i=1 to 8
		t=BoardSq(i,j)
		return t, 8:=mid$(line$(9-j), i, 1)
		if t#val$(8)<>" " then Append OnBoard, i*9+j:=t
		if t#val$(8)="♔" then
			White_♔_rank=j
			White_♔_file=i
			if i<>5 and j<>1 then White_♔_no_roke=True : White_no_left_roke=true : White_no_right_roke=true
		else.if t#val$(8)="♚" then
			Black_♚_rank=j
			Black_♚_file=i
			if i<>5 and j<>8 then Black_♚_no_roke=True: Black_no_left_roke=true : Black_no_right_roke=true
		end if
	next : next
end Sub
Sub CheckIt()
		return t, 8:=" "
		return t1, 8:=p$
		if not white then		
			CheckThreat(not white, White_♔_file, White_♔_rank, &threat)
		else
			CheckThreat(not white, Black_♚_file, Black_♚_rank, &threat)
		end if
		if threat then rule=false
		return t, 8:=p$
		return t1, 8:=p1$
end Sub
Sub CheckIt2()
		return t, 8:=" "
		return t1, 8:=p$
		local t2=BoardSq(en_passant_file, en_passant_rank)
		local p2$=t2#val$(8)
		return t2, 8:=" "
		if not white then		
			CheckThreat(not white, White_♔_file, White_♔_rank, &threat)
		else
			CheckThreat(not white, Black_♚_file, Black_♚_rank, &threat)
		end if
		if threat then rule=false
		return t, 8:=p$
		return t1, 8:=p1$
		if  threat then
			return t2, 6:=p2$
		else
			move t2#val(3), t2#val(4)
			if t2#val(9) then
				fill t2#val(7), t2#val(7),color1
			else
				fill t2#val(7), t2#val(7), color2
			end if
			Halfmove_clock=-1
		end if
		
end Sub
Sub CheckKing()
		return t, 8:=" "
		return t1, 8:=p$
		CheckThreat(not white, i1, j1,&threat)
		if threat then rule=false
		return t, 8:=p$
		return t1, 8:=p1$
end Sub
Sub CheckThreat(White as boolean, c, c1, &Yes)
local i=1, i1=8, j=1, j1=8, k=c, k1=c1
if white then
	local oKin$="♚",hor$="♜♛", dia$="♝♛", Kni$="♞"
else
	local oKin$="♔",hor$="♖♕", dia$="♗♕", Kni$="♘"
end if
 
' WhiteDisp$="♙♘♗♖♕♔"
' BlackDisp$="♟♞♝♜♛♚"
Yes=false
if c1<7 and white then
	if c>1 then
		if BoardSq(c-1, c1+1)#val$(8)="♟" then Yes=True :exit sub
	end if
	if c<8 then
		if BoardSq(c+1, c1+1)#val$(8)="♟" then Yes=True :exit sub
	end If
else.if c1>1 and not white then
	if c>1 then
		if BoardSq(c-1, c1-1)#val$(8)="♙" then Yes=True :exit sub
	end if
	if c<8 then
		if BoardSq(c+1, c1-1)#val$(8)="♙" then Yes=True :exit sub
	end If
end if
for k=max.data(c-1, 1) to min.data(c+1, 8)
for k1=max.data(c1-1, 1) to min.data(c1+1, 8)
if k1=c1 and k=c else if BoardSq(k, k1)#val$(8) =oKin$ then Yes=True : Exit Sub
next
next
for k=c to i
	if Instr(hor$,BoardSq(k,c1)#val$(8))>0 then Yes=True :exit sub
	if k<>c then if Instr(disp$,BoardSq(k,c1)#val$(8))>0 then exit for
next
if c>1 and c1<8 then {
k1=c1+1
for k=c-1 to i   \\  look up left
	if Instr(Dia$,BoardSq(k,k1)#val$(8))>0 then Yes=True :exit sub
	if k<>c then if Instr(disp$,BoardSq(k,k1)#val$(8))>0 then exit for
	K1++
	if k1>8 then exit for
next
}
for k=c to i1
	if Instr(hor$,BoardSq(k,c1)#val$(8))>0 then Yes=True :exit sub
	if k<>c then if Instr(disp$,BoardSq(k,c1)#val$(8))>0 then exit for
next
if c<i1 and c1>1 then {
k1=c1-1
for k=c+1 to i1   \\  look down right
	if Instr(Dia$,BoardSq(k,k1)#val$(8))>0 then Yes=True :exit sub
	if Instr(disp$,BoardSq(k,k1)#val$(8))>0 then exit for
	K1--
	if k1<1 then exit for
next
}
for k1=c1 to j
	if Instr(hor$,BoardSq(c,k1)#val$(8))>0 then Yes=True :exit sub
	if k1<>c1 then if Instr(disp$,BoardSq(c,k1)#val$(8))>0 then exit for
next
if c1>j and c>1 then {
k=c-1
for k1=c1-1 to j   \\  look down left
	if Instr(Dia$,BoardSq(k,k1)#val$(8))>0 then Yes=True :exit sub
	if Instr(disp$,BoardSq(k,k1)#val$(8))>0 then exit for
	k--
	if k<1 then exit for
next
}
for k1=c1 to j1
	if Instr(hor$,BoardSq(c,k1)#val$(8))>0 then Yes=True :exit sub
	if k1<>c1 then if Instr(disp$,BoardSq(c,k1)#val$(8))>0 then exit for
next
if c1<j1 and c<8 then {
k=c+1
for k1=c1+1 to j1   \\ look up right
	if Instr(Dia$,BoardSq(k,k1)#val$(8))>0 then Yes=True :exit sub
	if Instr(disp$,BoardSq(k,k1)#val$(8))>0 then exit for
	k++
	if k>8 then exit for
next
}
rem test "here"
for k=max.data(c-2,i) to min.data(c+2, i1)
	for k1=max.data(c1-2,j) to min.data(c1+2, j1)
		if Abs(k-c)+Abs(k1-c1)=3 then if BoardSq(k,k1)#val$(8)=Kni$ then Yes=True :exit sub
	next
next
end Sub
\\ new from revision 5
Function GetMove$(Fen$)
	local aLine$
	method Engine, "SendLine" , "position fen "+Fen$
	method Engine, "SendLine" ,"go movetime"+str$(random(50, 200))
	every 50 {
		Method Engine, "ProcessLoop"
		if not Engine.Active then exit
		while  Engine.HasLine
			method Engine, "GetLine" as aLine$
			if left$(aLine$,8)="bestmove" then exit
                     End While
		if left$(aLine$,8)="bestmove" then =piece$(aLine$," ", 2) : exit
	}		
End Function
initengine:
declare Engine SHELLPIPE
with Engine, "Active" as Engine.Active, "Hasline" as Engine.HasLine
Method Engine, "Run",  enginepath$ as OkEngine
if OkEngine=0 then  Method Engine, "SendLine", "ucinewgame"
Return