'###----------------------------------------------
'
' Chessforeva Chess
'   for SmallBasic (http://smallbasic.sourceforge.net)
' 2015
'
'###---------------------------------------------

'### constants
const Pieces = ".PNBRQKpnbrqk"
const Pevals = [0,100,300,310,500,900,9999,-100,-300,-310,-500,-900,-9999]
const asc_a = asc("a")
const asc_1 = asc("1")
const leftBoMrgn = 60
const topBoMrgn = 60
const EvDepth = 2  'This is slow interpreted basic
const evInfinity = 99999
const thH = 8 'height of progress bar
const thW = 60 'width

'### global variables
Dim Bo(8,8)  'chess board
local wm     'white to move
local cs     'status of castlings "KQkq"
local ep     'en-passant  -1=none, 0=a, ..., 7=h
local glist  'possible moves list

local Im     'My side 0-white,1-black

Dim hist(200)  'history of moves made
local Hc     'count of elements in history list

local move     'move data by user or AI to
 'piece placement scores for position evaluations for both sides
Dim epV(13,8,8)

'other globals for user interface
local Csq=""    'cursor square
local Dsq=""    'drag square
local aKey=0    'to capture arrow keys
local Dumb=1    'dumb AI mode is ON
local Auto=0    'automode
local AIwas     'try not to move twice


'### CHESS LOGIC - move generator

Func hv2sq(h,v) ' h,v to square "e4"
  hv2sq = chr(asc_a+h) + chr(asc_1+v)
End

Sub sq2hv(sq, byref h, byref v) ' "e4" to h,v
  h = asc( mid(sq,1,1) )-asc_a
  v = asc( mid(sq,2,1) )-asc_1
End

' Set starting chess position
Sub SetStartPos 
  local j,c,v=7,h=0
  for j=1 to 39
    c = mid("rnbqkbnr/pppppppp/////PPPPPPPP/RNBQKBNR",j,1)
    if(c=="/") then
      while h<8
        Bo(v,h)=".": h++
      wend
      v-- : h=0
    else
      Bo(v,h)=c : h++
    fi 'endif
  next j
  wm = 1
  cs = "KQkq"
  ep = -1
  Hc = 0
End
  
'Prints board for debugging
Sub PrintBo
  local v,h,s
  for v=7 to 0 step -1
    s=""
    for h=0 to 7
      s+=Bo(v,h)
    next h
    print(s)
  next v       
End
  
'Generates moves
Sub GenMoves(byref list)
  local v,h
  list = ""
  for v=0 to 7
    for h=0 to 7
      select case Bo(v,h)
      case if(wm, "P", "p")
        GenPawn list,v,h
      case if(wm, "N", "n")
        GenKnight list,v,h
      case if(wm, "B", "b")
        GenLines list,v,h, 1, false 'diogn.
      case if(wm, "R", "r")
        GenLines list,v,h, 3, false 'vert.+horiz.
      case if(wm, "Q", "q")
        GenLines list,v,h, 2, false 'both
      case if(wm, "K", "k")
        GenLines list,v,h, 2, true 'one square around
      end select
    next h
  next v
  ValidateGen list
End

Func isEmpty(v,h)
  isEmpty = (Bo(v,h)==".")
End

Func isWhite(v,h)
  isWhite = Bo(v,h)>"A" and Bo(v,h)<"a"
End

Func isBlack(v,h)
  isBlack = Bo(v,h)>"a"
End

'Add move to the list
Sub AddMv(byref l,fv,fh,tv,th)
  list+=hv2sq(fh,fv)+hv2sq(th,tv)+";" 'e2e4;e7e5;
End

'Generates moves of pawns
Sub GenPawn(byref l,v,h)
  if(wm) then
    if(isEmpty(v+1,h)) then
      AddMv l,v,h,v+1,h 'e2e3
      if(v==1 and isEmpty(v+2,h)) then AddMv l,v,h,v+2,h 'e2e4
    fi
    if(h>0 and (isBlack(v+1,h-1) or (v==4 and h-1==ep))) then AddMv l,v,h,v+1,h-1 'e2xd3
    if(h<7 and (isBlack(v+1,h+1) or (v==4 and h+1==ep))) then AddMv l,v,h,v+1,h+1 'e2xf3
  else
    if(isEmpty(v-1,h)) then
      AddMv l,v,h,v-1,h 'e7e6
      if(v==6 and isEmpty(v-2,h)) then AddMv l,v,h,v-2,h 'e7e5
    fi
    if(h>0 and (isWhite(v-1,h-1) or (v==3 and h-1==ep))) then AddMv l,v,h,v-1,h-1 'e7xd6
    if(h<7 and (isWhite(v-1,h+1) or (v==3 and h+1==ep))) then AddMv l,v,h,v-1,h+1 'e7xf6
  fi
End

'Generates moves of rooks, bishops, queens, also king
Sub GenLines(byref l,v,h,u,k)
  local x,y,dx,dy,e,c
  for dx = -1 to 1 'directions
    for dy = -1 to 1
      if((u<3 and (dx<>0 and dy<>0)) or  (u>1 and (dx==0 or dy==0) and (dx<>0 or dy<>0))) then
        x=h : y=v
        repeat 'move long line to direction
          x+=dx : y+=dy
          if(x<0 or x>7 or y<0 or y>7) then exit
          e = isEmpty(y,x)
          if( e or if(wm,isBlack(y,x),isWhite(y,x)) ) then AddMv l,v,h,y,x
        until !e or k 'stop when piece reached
      fi
    next dy
  next dx

  if(k) then
    c = if(wm,"K","k") : if(instr(cs,c)>0) then canCastle l,v, 1,2
    c = if(wm,"Q","q") : if(instr(cs,c)>0) then canCastle l,v, -1,3
  fi
End

' add castling moves
Sub canCastle(byref l, v, dx, n)
  local i,h,f
  f=true
  h=4
  for i=1 to n 'are squares empty
    h+=dx
    if(!isEmpty(v,h)) then f=false 'not empty square
  next i
  h=4
  for i=0 to n 'are squares valid
    if( f and isAttacked(v,h) ) then f=false
    h+=dx
  next i
  if(f) then AddMv l,v,4,v,(4+dx+dx)
End

'Generates moves of knights
Sub GenKnight(byref l,v,h)
  local x,y,dx,dy
  for dx = -2 to 2
    for dy = -2 to 2
      if(abs(dx)+abs(dy)==3) then
        x=h+dx : y=v+dy  
        if(x>=0 and x<8 and y>=0 and y<8) then
          if( isEmpty(y,x) or if(wm,isBlack(y,x),isWhite(y,x)) ) then AddMv l,v,h,y,x
        fi
      fi
    next dy
  next dx  
End

' function validates (king) possition
Func isAttacked(v,h)
  local r,x,y,dx,dy,c,e,bq,rq,k,n,p,d,i
  bq = if(wm,"bq","BQ")
  rq = if(wm,"rq","RQ")
  n = if(wm,"n","N")
  k = if(wm,"k","K")
  p = if(wm,"p","P")
  r = false
  for dx = -1 to 1
    for dy = -1 to 1
      if(not(r) and (dx<>0 or dy<>0)) then
        x=h : y=v : d=true
        repeat
          x+=dx : y+=dy
          if(x<0 or x>7 or y<0 or y>7) then exit
          e = isEmpty(y,x)
          if(!e) then
            c = Bo(y,x)
            if((dx<>0 and dy<>0) and instr(bq,c)>0) then r = true 'bishop,queen
            if((dx==0 or dy==0) and instr(rq,c)>0) then r = true 'rook,queen
            if(d) then
              if(c==k) then r = true 'king
              if(c==p and dx<>0 and dy==if(wm,1,-1)) then r=true 'pawn
            fi
          fi
          if(d) then 'is there a knight around
            if (dx==0) then 'v+-1, see h+-2
              if((x>1) and (Bo(y,x-2)==n)) then r= true
              if((x<6) and (Bo(y,x+2)==n)) then r = true
            fi
            if (dy==0) then 'h+-1, see v+-2
              if((y>1) and (Bo(y-2,x)==n)) then r= true
              if((y<6) and (Bo(y+2,x)==n)) then r = true
            fi
          fi
          d=false
        until !e
      fi
    next dy
  next dx
  isAttacked = r
End

' revise list for invalid moves, king should not be under attack after movement
Sub ValidateGen(byref l)
  local i,w,hf,vf,ht,vt,k,v,h,o, kv,kh, pf,pt
  k = if(wm,"K","k") 'find position of king
  for v=0 to 7
    for h=0 to 7
      if(Bo(v,h)==k) then exit 'detect square of king
    next h
    if h<8 then exit
  next v
    
  w = len(l)
  o = ""
  for i=1 to w step 5
    sq2hv mid(l,i,2), hf, vf
    sq2hv mid(l,i+2,2), ht, vt
    pf=Bo(vf,hf) : pt=Bo(vt,ht)
    Bo(vt,ht)=pf : Bo(vf,hf) = "." ' try to move and validate
    if(hf==h and vf==v) then
      kh = ht : kv = vt
    else
      kh = h : kv = v
    fi
    if(!isAttacked(kv,kh)) then o += mid(l,i,5) 'if our king is attacked, then this move is invalid
    Bo(vt,ht)=pt : Bo(vf,hf) = pf ' restore
  next i
  list = o
  
End

' is Check+ right now
Func isCheck
  local r,v,h,k
  k = if(wm,"K","k") 'find position of king
  for v=0 to 7
    for h=0 to 7
      if(Bo(v,h)==k) then exit 'detect square of king
    next h
    if h<8 then exit
  next v
  isCheck = isAttacked(v,h)
End

'### MOVE
' make a move
Sub DoMove(fSq,tSq)
  local hf,vf,ht,vt,q,g,p,j
  sq2hv fSq, hf, vf
  sq2hv tSq, ht, vt
  Hc++ 'save to history
  q = Bo(vf,hf) : g = Bo(vt,ht)
  hist(Hc).hf = hf  
  hist(Hc).vf = vf  
  hist(Hc).ht = ht
  hist(Hc).vt = vt
  hist(Hc).q = q 'piece was on "from" square
  hist(Hc).g = g 'piece was on "to" square
  hist(Hc).p = " " 'promoted piece
  p = ( q==if(wm,"P","p") ) 'is pawn
  if( p and vt==if(wm,7,0) ) then
     q=if(wm,"Q","q") 'just promote Queen without asking user
     hist(Hc).p = q
  fi
  Bo(vt,ht) = q
  Bo(vf,hf) = "."
  hist(Hc).ep = ep 'save en-passant flag
  hist(Hc).cs = cs 'save castlings
  
  hist(Hc).e = 0
  if(p and (g==".") and (hf<>ht)) then
    hist(Hc).e = vf ' en-passant capturing right now
    Bo(vf,ht) = "."
  fi
  hist(Hc).c = 0 'is it castling of king
  
  if( len(cs)>0 ) then
    if( q==if(wm,"K","k") ) then 'should move rook too
      if ( fSq==if(wm,"e1","e8") ) then 
        j = if(wm,0,7)
        select case tSq
        case if(wm,"g1","g8")
          hist(Hc).c = 1          
          Bo(j,5) = Bo(j,7) :  Bo(j,7) = "."
        case if(wm,"c1","c8")
          hist(Hc).c = -1
          Bo(j,3) = Bo(j,0) :  Bo(j,0) = "."
        end select
      fi
      rmvCast 0,wm 'remove Qq
      rmvCast 1,wm 'remove Kk
    fi
    if( q==if(wm,"R","r") ) then
      select case fSq
      case if(wm,"h1","h8")
        rmvCast 1, wm 'remove Kk
      case if(wm,"a1","a8")
        rmvCast 0, wm 'remove Qq
      end select
    fi
  
    select case tSq
    case if(wm,"h8","h1")
      rmvCast 1, (1-wm) 'remove kK
    case if(wm,"a8","a1")
      rmvCast 0, (1-wm) 'remove qQ
    end select
  fi
  wm = 1-wm
  ep = if( p and abs(vt-vf)==2, ht, -1 ) 'is en-passant capturing possible right now
End

' undo last move
Sub UndoMove
  local hf,vf,ht,vt, j,c,e
  if(Hc>0) then 'skip for starting position
    hf = hist(Hc).hf : vf = hist(Hc).vf
    ht = hist(Hc).ht : vt = hist(Hc).vt
    Bo(vt,ht) = hist(Hc).g
    Bo(vf,hf) = hist(Hc).q
    c = hist(Hc).c
    if(c) then ' if rook goes back to a1,h1 or a8,h8
      j = if(wm,7,0)
      if(c>0) then
        Bo(j,7) = Bo(j,5) :  Bo(j,5) = "."
      else
        Bo(j,0) = Bo(j,3) :  Bo(j,3) = "."
      fi
    fi
    e = hist(Hc).e ' if en-passant captured pawn should be restored
    if(e) then Bo(e,ht) = if(wm,"P","p")
    ep = hist(Hc).ep
    cs = hist(Hc).cs
    Hc--
    wm = 1-wm
  fi
End

' Remove castling if possible in list -not allowed anymore
Sub rmvCast(k,w)
  local i,s
  s = if(k>0, if(w,"K","k"), if(w,"Q","q") )
  i = instr(cs,s)
  if(i>0) then cs = replace(cs,i,"", 1)
End

'### A SMALL CHESS AI

'Prepare arrays
Sub PrepEvals
  local i,b,t,cV,cH,fV,ct,h,v,e
  for i=0 to 12 'for empty sq. + all 12 pieces
    for v=0 to 7
      for h=0 to 7
        e = 0
        if(i>0) then
          b = (i>6) 'side 0-white,1-black
          t = ((i-1)%6) 'piece type
          cV = 10-abs(v+v-7) 'center vert.
          cH = 10-abs(h+h-7) 'center horiz.
          ct = cV+cH
          fV = if(b,7-v,v) 'go forward
          select case t
          case 0 'pawns
            e = ct+int((cH*fV*2)/3) 'move to center and forward
          case 1 'knights
            e = ct+fV 'to center and forward
            if(v==if(b,7,0)) then
              if(h==1 or h==6) then e-=8 'if not moved
            fi
          case 2 'bishops
            e = ct+fV
            e = int(e/2) 'little to center and forward
            if(v==if(b,7,0)) then
              if(h==2 or h==5) then e-=10 'if not moved
            fi
          case 3 'rooks
            e = cH+fV
            e = int(e/3)
            if(v==if(b,7,0)) then e+=cH 'e1,d1
            if(v==if(b,1,6)) then e+=5  'go to 1,7th line
          case 4 'queens
            e = ct+fV
            e = int(e/3) 'little to center and forward
          case 5 'kings
            if(v==if(b,7,0)) then
              if(h==4) then e+=4 'do not touch
              if(h==6 or h==2) then e+=15 'castling is good
            fi
          end select
        fi
        epV(i,v,h) = if(b,-e,e)
      next h
    next v
  next i
End

'Evaluate position +for white,-for black
' Very simple for faster calculations
' Ignores:
'   king must help to checkmate in endgame 
'   checkmate in 1, sacrifices of pieces - because depth is too low
'   ignores activity of pieces, pins and threats
Func EvPos
  local E,v,h,i,c
  E = 0
  for v=0 to 7
    for h=0 to 7
      c = Bo(v,h)
      i = instr(Pieces,c): i--
      E += Pevals(i) 'Material
      E += epV(i,v,h) 'Position on board
    next h
  next v
  E +=  rnd*5 'randomize little bit
  EvPos = if(wm,-E,E)
End



'Search and prepare move
Sub DoAImove
  if( not(move.f) ) then
    if( Auto or wm==Im ) then SrchABtop
  fi
End

'Iterative Alpha-Beta search (top, AI moves possible now)
Sub SrchABtop

  local alpha, beta, best, score, i,w, f,t,j,z, key, n,m,v
  z = 0
  alpha = -evInfinity
  beta = evInfinity
  best = alpha  'best score
  
  w = len(glist)
  
  if(Hc<20) then AIwas=""
   
  for i=1 to w step 5 ' do each move
    
    f = mid(glist,i,2) 'from square
    t = mid(glist,i+2,2) 'to square
    
    if(i==1) then
      move.f=1 : move.fSq = f :  move.tSq = t
      j = 0 : z = (w/5)
    fi

    j++
    DrawThermo j,z 'draw wait progress bar
      
    DoMove f, t

    score = -SrchAB( if(Dumb,0,EvDepth-1) , -beta, -alpha)  'count move score
    
    n = len(AIwas)-3
    m = 0 : v = 0
    while n>0 and v<10
      if(mid(AIwas,n,4)==(f+t)) then m++
      n-=4 : v++
    wend
    if (m>0) then 'if move was 2x then try not to move again
      score += 5*m*(1-(2*rnd))
    fi
    
    UndoMove 'restore position

    if ( score > best ) then
      best = score 'move score better    
      move.fSq = f :  move.tSq = t
    fi
    
    if ( best > alpha ) then alpha = best 'margin
    if ( alpha >= beta ) then 'margin and exit
       best = alpha
       exit
    fi

    key = inkey$
    if(key=="M" or key=="m") then exit
 
  next i
  
  if(z>0) then  DrawThermo -1,z
  
  AIwas+=(f+t)

End

'Iterative Alpha-Beta search
Func SrchAB(depth,alpha,beta)

  local best, score, l,i,w
  best = -evInfinity  'best score
  
  GenMoves l 'generate list of possible moves right now
  w = len(l)
   
  for i=1 to w step 5 ' do each move
              
    DoMove mid(l,i,2), mid(l,i+2,2)

    if (depth==0) then
       score = EvPos 'just position score
    else
       score = -SrchAB(depth-1, -beta, -alpha)  'count move score
    fi
    
    UndoMove 'restore position

    if ( score > best ) then best = score 'move score better   
    if ( best > alpha ) then alpha = best 'margin
    if ( alpha >= beta ) then 'margin and exit
       best = alpha
       exit
    fi
  next i
  
  SrchAB = best
End

'### DRAWINGS AND VISUALS

' Draws a piece on screen at x,y
Sub DrawPiece(piece,x,y)

  local i,j,dw, pc, px,py
  dw = "BM" + str(x)+","+str(y)
  pc = (piece%6)
  
  for j=0 to 1
    color if( piece<6, if(j==0, 14, 4), if(j==0, 3, 0) )
    
    draw dw
    select case pc
    case 0 'pawn
      draw "BR14BD9R3D1R1D2L1D1R2D2R1D2L1D1G1R1D1R1F1D1R1D2R1D3L16"
      draw "U2E1U1E2L1E1R1E1U1L1U1H1U1E2NR1U2E1"  
    case 1 'knight
      draw "BR9BD5R1F2U1R1U1R2D1R1G1R4D1R2D1R1D1R1D1R1D2R1D3R1G1R1D4R1D6L17U2R1U2R1U1R1U1R1U1R1"
      draw "U2R1U4E1L1D1G1D1L1D1L1D1L2D1L1D1L1D1G1L1E1L3H1U4R1F1D1U1H1U2R1U2R1U2R1U1R1BF1D1G1BU3U4"
    case 2 'bishop
      draw "BR15BD3R1D1R1D2D2R1F1R1D1F1D1F1D2G1D1L1D3R1D2G2D1R7D1R1D1L10U1L3"
      draw "D1L10U1R1U1R7U1H2U2R1U3L1U1L1U4R1U2R1U1R1E1R1E1L1U3R1U1"   
    case 3 'rook
      draw "BR7BD6R3D1R4U1R3D1R4U1R3D3L1D2L1D11R1D2F1NL2R1D2L19U2R1NR2E1U2E1U10L1U2L1U3"
    case 4 'queen
      draw "BR3BD7R2D3F1D2R1D1R1D1F1U9L1U2E1R1F1D1G1D3R1G1R1G1D4G1R4U3"
      draw "L1U2L1BR3BD5U6R1U5L1U2R1U1R1D1R1D2L1D5R1D6L3BR4U3R1U2R1U2E1"
      draw "U2L1U2R1U1R1D1R1D2L1D3L1F1L1F1L1F1L1D4L3BR4U2R1H1R2U1R1U2E1U3R2"
      draw "F1G1L1D1G1D5L1D2L3E1L1BR3BD1D1G1D1L2F1D2R1D3L17U3R1U2E1L2U1H1U1R4BL4U2L1U5H1U1L1H1E1"
      if (j==0) then
        px = [3, 9, 15, 21, 27, 15, 8, 12, 15, 20, 24]
        py = [8, 6, 5, 6, 8, 20, 16, 16, 16, 16, 16]
        for i=0 to 10
          paint x+px(i),y+py(i) 'bunch of paints
        next i
      fi
    case 5 'king
      draw "BR14BD5E1R1F1L3F1R1D2R1D1F1D2R1E1R5D1R1D1R1D4G1D1L1D1L2G1R1"
      draw "D5L2D1L3D1L6E1L4U1L1U5L1U1L1U1L1U1L1U5E2R5D1R2U2E1U1R1U1"
    end select
    
    if (j==0) then paint x+15, y+10 'fill piece with colour
    
    ' draw details after paint
    select case pc
    case 2
      draw "BD8R1D1R1G1L1H1R1U1BL4BD7R9BR1BD3L11BR1BD2R3BR6L3BR2BD1L6"
    case 3
      draw "BR2BD6R12BR1BD8L12BL2BD2R13"
    case 4
      draw "BR14BD13L3BL6BD3R15BR1BD2L5BL12R5"
    case 5
      draw "BL2BD5D1R1D1F1D3R1U3E1U1R1BR5BD7L4H1L7D1L3"
      draw "BD3R3E1R7D1R4"
      draw "BD2BL3L3U1L3D1L3BR3D1R3"
    end select

  next j
  color 0
  draw dw
End

' Redraw square at "e4"
Sub DrawSquare(sq)
  local h,v,p, x,y,x2,y2
  sq2hv sq,h,v
  
  x = leftBoMrgn+(h*32): x2=x+32
  y = topBoMrgn+224-(v*32): y2=y+32
  rect x,y,x2,y2, if((h+v)%2==0, 6, 15) filled
  rect x,y,x2,y2
  p = instr( Pieces, Bo(v,h) )
  if (p>1) then DrawPiece p-2, x, y
  if (sq==Csq) then ' draw cursor rectangle 2px
     rect x,y,x2,y2, 9
     rect x+1,y+1,x2-1,y2-1, 9
  fi
End

' Redraw complete board
Sub DrawBoard
  local v,h
  for v=0 to 7
    for h=0 to 7
      DrawSquare hv2sq( h,v )
    next h
  next v
  if( len(Csq)>0 ) then DrawSquare Csq
End

' Fraw frame of board and labels
Sub DrawFrame
 
  local h,v,sq,h2,v2,x,y,x2,y2,i,j,k
  x = leftBoMrgn-20: x2=x+296
  y = topBoMrgn-20: y2=y+296
  
  color 5
  for v=0 to 7 'draw labels a-h,1-8
    for h=0 to 7
      sq = hv2sq(h,v): h2 = mid(sq,1,1): v2 = mid(sq,2,1)
      j=x+32+(h*32)
      k=y2-43-(v*32)
      at x+6,k: print v2
      at x2-12,k: print v2
      at j,y2-17: print h2
      at j,y+2: print h2
    next h
  next v
  
  for i=0 to 1 'draw frame
    rect x,y,x2-i,y2-i
    rect x+18,y+18,x2-i-18,y2-i-18
    x++ : y++
  next i
  for i=0 to 120 'texture
    j = int(294*rnd) : k = int(294*rnd)
    if((j<20 or j>276) or (k<20 or k>276)) then
      draw "BM" + str(x+j) + "," + str(y+k) + "G2"
    fi
  next i
  paint x+2,y+2,7
  color 0
  
End

' shortly remove cursor
Sub hideCursor
  local sq
  if( len(Csq)>0 ) then
    sq = Csq : Csq = ""
    DrawSquare sq
    Csq = sq
  fi 
End

' put and remove lines to squares of possible movements
Sub squaresToX(u)
  local i,z,n, sq, sq1,sq2, h,v, hf,vf, x,y,x2,y2, dh,dv,b,s
  i = if( len(Dsq)==0, 0, instr( ";"+glist, ";"+Dsq ) )
  if(i) then
    z = len(glist)
    sq2hv Dsq,hf,vf
    x = leftBoMrgn+(hf*32)+16
    y = topBoMrgn+224-(vf*32)+16 
    n = (Bo(vf,hf)==if(wm,"N","n"))
    s = "" ' optimize faster redraw 
    repeat ' for all moves from this square
      
      if(mid(glist,i,2)<>Dsq) then exit
      sq = mid(glist,i+2,2)
      sq2hv sq,h,v
      
      if(u<0) then
       
       if(n) then ' if knight
         DrawSquare sq
         if(abs(h-hf)==2) then
           x = (h+hf)/2 : sq1 = hv2sq(x,vf) : sq2 = hv2sq(x,v)
         else
           y = (v+vf)/2 : sq1 = hv2sq(hf,y) : sq2 = hv2sq(h,y)
         fi
         DrawSquare sq1 : DrawSquare sq2 'redraw two squaeres in-between to remove lines
         s+=sq1 : s+=sq2
       else
         dh = sgn( h-hf ) : dv = sgn( v-vf )
         x = hf : y = vf
         repeat
           x+=dh : y+=dv
           b = hv2sq(x,y)
           if(instr(s,b)==0) then ' do not draw twice
             DrawSquare b 'remove lines and dots
             s+=b
           fi
         until (b==sq)
       fi
      else
       sq2hv sq,h,v
       x2 = leftBoMrgn+(h*32)+16
       y2 = topBoMrgn+240-(v*32)
       line x,y,x2,y2,12 ' line of possible move
       rect x2-2,y2-2,x2+2,y2+2, 12 filled 'big dot
      fi
      i+=5
    until (i>z)

    if(u<0) then DrawSquare Dsq
  fi
End

' Display current status
Sub DispStatus
  local s,c
  s = ""
  c = isCheck
  if(wm<>Im) then s+= "Your move  "
  if(len(glist)==0) then
    if(c) then
      s="Checkmate! " + if(wm,"0-1","1-0")
    else
      s="Stalemate! 1/2-1/2"
    fi
    Auto = 0
  else
    if(c) then s+="check+"
  fi
  MessToUser(s)
End

' Display message to user
Sub MessToUser(txt)
  local Y,X
  X = leftBoMrgn+20
  Y = topBoMrgn+290
  txt += space(40-len(txt))
  at X,Y : print txt
End

' this shows percentage of thinking progress
Sub DrawThermo(cur, dlen)
  local Y,X,w
  X = leftBoMrgn+20
  Y = topBoMrgn+290
  if (cur<0) then
    color point(1,1)
    for i=0 to 1 'remove
      at X,Y+(16*i) : print space(30)
    next i
    color 0
  else
    w = (thW/dlen) * cur
    at X,Y : print "Let me think, press M to force"
    X+=10 : Y+=16
    if (cur==1) then rect X,Y,X+thW,Y+thH, 1
    rect X,Y,X+w,Y+thH, 1 filled 
  fi
End

'### User control

Sub aLeft ' Left arrow key
  Auto = 0
  aKey=1
End
Sub aRight ' Right arrow key
  Auto = 0
  aKey=2
End
Sub aUp ' Up arrow key
  Auto = 0
  aKey=3
End
Sub aDown ' Down arrow key
  Auto = 0
  aKey=4
End
Sub aF12 ' F12 pressed
  Auto = 0
  aKey=5
End

data "Use mouse"
data " or arrow keys, Enter/Space","Other keys:"
data "  U-undo move"
data "  N-new game"
data "  D-dumb AI On/Off"
data "  A-autoplay game"
data "  F12- End"
  
' This is the loop with user interface, mouse, keyboard controls etc.
Sub MainUserLoop

  pen on ' Enable tracking of mouse
  
  ' Pen(1) = X of mouse position "Last mouse button down X"
  ' Pen(2) = Y of mouse position "Last mouse button down Y"

  local k,key, H,V,sq, ch,cv,i,j,w, sq1,sq2,m
  move.f = false 'no current moves in queue
  Im = 0 'white
  ch = 4 : cv = if(wm,1,6) 'cursor at e2 or e7 
  Csq = hv2sq(ch,cv)
  Dsq = "" ' drag square
  
  GenMoves glist
  DrawBoard
  DispStatus
  
  aKey = 0 'define event-functions for arrow key
  defineKey 0xFF04, aLeft
  defineKey 0xFF05, aRight
  defineKey 0xFF09, aUp
  defineKey 0xFF0A, aDown
  defineKey 0xFFFC, aF12

  repeat
    
    key = inkey$
    k = if(key=="",0,asc(key))
    sq = ""
    if( Pen(0) ) then
      H = Pen(1)-leftBoMrgn : V = Pen(2)-topBoMrgn
      if(H>0 and H<256 and V>0 and V<256) then sq = hv2sq( int(H/32), 7-int(V/32) )
    fi
    if( k==13 or k==32 ) then sq = hv2sq(ch,cv) 'Enter or Space

    if( aKey>0 ) then
      select case aKey
      case 1
        if(ch>0) then ch-- 'Left
      case 2
        if(ch<7) then ch++ 'Right
      case 3
        if(cv<7) then cv++ 'Up
      case 4
        if(cv>0) then cv-- 'Down
      case 5
        k = 0xF12 ' Exit program
      end select
      hideCursor 
      Csq = hv2sq(ch,cv)
      DrawSquare Csq
      squaresToX 1
      aKey=0
    fi
    
    if( len(sq)>0 ) then
       hideCursor
       sq2hv sq,ch,cv
       Csq = sq
       
       if( len(Dsq)>0 ) then
         i = instr( glist, Dsq+sq )
         if(i>0) then
           squaresToX -1
           move.f=true : move.fSq=Dsq : move.tSq=sq
           Dsq = ""
         fi
       fi       
       if( not (move.f)) then
         i = instr( ";"+glist, ";"+sq )
         if(i>0) then
           squaresToX -1
           Dsq = mid(glist,i,2)
         fi
       fi
       DrawSquare sq
       squaresToX 1
    fi
    
    if(key == "n" or key=="N") then ' Start a new game
      SetStartPos
      GenMoves glist
      DrawBoard
      Dsq = ""
      Im=1-Im
    fi
    
    if(key == "d" or key=="D") then ' Set dumb mode ON or OFF
      Dumb = 1-Dumb
      MessToUser("Dumb mode is "+if(Dumb,"On","Off"))
    fi

    if(key == "a" or key=="A") then ' Set automode ON
      Auto = 1-Auto
      MessToUser("Autoplay")
    fi
    
    if(key == "u" or key=="U") then ' Undo last move
      squaresToX -1
      Dsq = ""
      for m=0 to 1 '2-moves
      w = wm
      UndoMove ' try undo last move
      if(w<>wm) then
         w =hist(Hc+1).c 
         if(w) then 'redraw castling rook squares
           j = if(wm,0,7)
           if(w>0) then
             sq1 = hv2sq(7,j) : sq2 = hv2sq(5,j)
           else
             sq1 = hv2sq(0,j) : sq2 = hv2sq(3,j)
           fi    
           DrawSquare sq1 : DrawSquare sq2  'Rook goes back
         fi
         w = hist(Hc+1).e
         if(w) then DrawSquare hv2sq( hist(Hc+1).ht, w)
         sq1 = hv2sq( hist(Hc+1).hf, hist(Hc+1).vf )
         sq2 = hv2sq( hist(Hc+1).ht, hist(Hc+1).vt )
         DrawSquare sq1 : DrawSquare sq2 'Put piece back
         GenMoves glist
      fi
      next m
      DispStatus
    fi
    
    repeat
      DoAImove 'Start AI if should
        
      'if a move should be performed then move pieces and redraw squares
      if(move.f) then
        DoMove move.fsq, move.tsq
        GenMoves glist
        DrawSquare move.fsq
        DrawSquare move.tsq
        w =hist(Hc).c 
        if(w) then 'redraw castling rook squares
          j = if(wm,7,0)
          if(w>0) then
            sq1 = hv2sq(7,j) : sq2 = hv2sq(5,j)
          else
            sq1 = hv2sq(0,j) : sq2 = hv2sq(3,j)
          fi    
          DrawSquare sq1 : DrawSquare sq2 ' rooks
        fi
        w = hist(Hc).e
        if(w) then DrawSquare hv2sq( hist(Hc).ht ,w)
        move.f=false
        DispStatus
      fi
    until (Auto==0)  ' this loop is for AI vs AI game to avoid capturing of keyboard and mouse
                 
  until ( k==0xF12 ) 'F12 pressed 

  pen off ' Stop mouse tracking
End

'### Keys and help displaying
Sub DispTopic
  local i, s
  for i=0 to 7
    read s 'read topics from data and print by lines
    at 360,(i+6)*16
    print s
  next i
End


'### The program starts here

Cls
Color 0
DispTopic
PrepEvals

SetStartPos
GenMoves glist
'PrintBo

DrawFrame
DrawBoard
MainUserLoop

at 0,0
print "End of program"