schaak

Vragen en suggesties over het programmeren van spelletjes, sprites en dergelijke in Liberty BASIC

Moderator: anthonio

schaak

Berichtdoor bluatigro » do dec 04, 2014 11:14 am

probeersel :schaak

ik denk dat ik alle stukken goed heb behalve de koning en de pion

todo :
- koning : schaak en schaakmat
- pion : ampasant slaan

error :
- er beweegt niets
Code: Selecteer alles
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
dim p( 12 * 12 ) , z( 200 , 1 )
global ztel , player , pawn , tower , horse , bishop , king , queen , empty , white , black
pawn = 1
tower = 2
horse = 3
bishop = 4
king = 5
queen = 6
empty = 7
white = 1
black = -1
zfrom = 0
zto = 1
player = white
nomainwin
open "chess" for graphics as #m
  #m "trapclose [quit]"
  #m "font Courier_new 40 bold"
  call restart
  call drawbord
  timer 1000 , [tmr]
wait
[tmr]
  call drawbord
  call generatemove player
  dice = int( rnd( 0 ) * ztel )
  f = z( dice , zfrom )
  t = z( dice , zto )
  p( t ) = p( f )
  p( f ) = empty
  player = 0 - player
wait
[quit]
  close #m
end
function in( x , y )
  in = x + y * 12
end function
sub restart
  restore
  for y = 0 to 11
    for x = 0 to 11
      read q
      p( in( x , y ) ) = q
    next x
  next y
  ''         a  b  c  d  e  f  g  h
  data -7,-7,-7,-7,-7,-7,-7,-7,-7,-7,-7,-7
  data -7,-7,-7,-7,-7,-7,-7,-7,-7,-7,-7,-7
  data -7,-7,-2,-4,-3,-5,-6,-3,-4,-2,-2,-7 ''8
  data -7,-7,-1,-1,-1,-1,-1,-1,-1,-1,-1,-7 ''7
  data -7,-7, 7, 7, 7, 7, 7, 7, 7, 7,-7,-7 ''6
  data -7,-7, 7, 7, 7, 7, 7, 7, 7, 7,-7,-7 ''5
  data -7,-7, 7, 7, 7, 7, 7, 7, 7, 7,-7,-7 ''4
  data -7,-7, 7, 7, 7, 7, 7, 7, 7, 7,-7,-7 ''3
  data -7,-7, 1, 1, 1, 1, 1, 1, 1, 1,-7,-7 ''2
  data -7,-7, 2, 4, 3, 5, 6, 3, 4, 2,-7,-7 ''1
  data -7,-7,-7,-7,-7,-7,-7,-7,-7,-7,-7,-7
  data -7,-7,-7,-7,-7,-7,-7,-7,-7,-7,-7,-7
end sub
sub drawbord
  for x = 2 to 9
    for y = 2 to 9
      if ( x + y ) mod 2 then
        #m "backcolor yellow"
      else
        #m "backcolor brown"
      end if
      if p( in( x , y ) ) < 0 then
        #m "color black"
      else
        #m "color white"
      end if
      q$ = "iTBHKQ "
      #m "goto " ; x * 50 ; " " ; y * 50
      #m "down"
      #m "\" ; mid$( q$ , abs(p(in(x,y))) , 1 )
      #m "up"
    next y
  next x
end sub
sub generatemove color
  ztel = 0
  for x = 2 to 9
    for y = 2 to 9
      if sign( color ) = sign( p( in( x , y ) ) ) then
        select case abs( p( in( x , y ) ) )
          case pawn
            call checkpawn x , y , color
          case tower
            call checktower x , y , color
          case bishop
            call checkbishop x , y , color
          case horse
            call checkhorse x , y , color
          case king
            call checkking x , y , color
          case queen
            call checkqueen x , y , color
          case else
        end select
      end if
    next y
  next x
end sub
sub checkpawn x , y , color
  if checkmove( x , y , 0 , color , color ) = 1 then
    dummy = checkmove( x , y , 0 , color * 2 , color )
  end if
end sub
sub checktower x , y , color
  i = 1
  while checkmove( x , y , 0 , i , color ) = 1
    i = i + 1
  wend
  i = 1
  while checkmove( x , y , i , 0 , color ) = 1
    i = i + 1
  wend
  i = 1
  while checkmove( x , y , 0 , 0-i , color ) = 1
    i = i + 1
  wend
  i = 1
  while checkmove( x , y , 0-i , 0 , color ) = 1
    i = i + 1
  wend
end sub
sub checkbishop x , y , color
  i = 1
  while checkmove( x , y , i , i , color ) = 1
    i = i + 1
  wend
  i = 1
  while checkmove( x , y , 0-i , i , color ) = 1
    i = i + 1
  wend
  i = 1
  while checkmove( x , y , i , 0-i , color ) = 1
    i = i + 1
  wend
  i = 1
  while checkmove( x , y , 0-i , 0-i , color ) = 1
    i = i + 1
  wend
end sub
sub checkhorse x , y , color
  dummy = checkmove( x , y ,  1 ,  2 , color )
  dummy = checkmove( x , y ,  1 , -2 , color )
  dummy = checkmove( x , y , -1 ,  2 , color )
  dummy = checkmove( x , y , -1 , -2 , color )
  dummy = checkmove( x , y ,  2 ,  1 , color )
  dummy = checkmove( x , y ,  2 , -1 , color )
  dummy = checkmove( x , y , -2 ,  1 , color )
  dummy = checkmove( x , y , -2 , -1 , color )
end sub
sub checkking x , y , color
  dummy = checkmove( x , y ,  0 ,  1 , color )
  dummy = checkmove( x , y ,  1 ,  1 , color )
  dummy = checkmove( x , y ,  1 ,  0 , color )
  dummy = checkmove( x , y ,  1 , -1 , color )
  dummy = checkmove( x , y ,  0 , -1 , color )
  dummy = checkmove( x , y , -1 , -1 , color )
  dummy = checkmove( x , y , -1 ,  0 , color )
  dummy = checkmove( x , y , -1 ,  1 , color )
end sub
sub checkqueen x , y , color
  call checkbishop x , y , color
  call checktower x , y , color
end sub
function checkmove( x , y , a , b , color )
  uit = 0
  if p( in( x + a , y + b ) ) <> 0 - empty _
  and ( p( in( x + a , y + b ) ) = empty _
  or sign( p( in( x + a , y + b ) ) ) <> sign( color ) ) then
    call storemove in(x,y), in(x+a,y+b)
    uit = 1
  end if
  checkmove = uit
end function
function sign( x )
  uit = 0
  if x < 0 then uit = -1
  if x > 0 then uit = 1
  sign = uit
end function
sub storemove from , too
  z( ztel , zfrom ) = from
  z( ztel , zto ) = too
  ztel = ztel + 1
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Keer terug naar Games

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron