Older Version Newer Version

bluatigro bluatigro Apr 4, 2010

[[user:bluatigro|1270230827]]

[[code format="vbnet"]]

dim plek( 150 ) , piece( 10 , 100 ) , move( 1000 )
global black , white , human , comp , zet$
global king0 , king , queen , bishop , horse
global pawn0 , pawn , tower0 , tower
global empty , wall , winx , winy , play1 , play2
black = 0 - 1 : white = 1
king0 = 1 : king = 2 : queen = 3 : bishop = 4
horse = 5 : pawn0 = 6 : pawn = 7 : tower0 = 8 : tower = 9
empty = 0 : wall = 10
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
winx = WindowWidth
winy = WindowHeight
nomainwin
confirm "You take white ?" ; whiteJN$
if whiteJN$ = "yes" then
human = white
comp = black
else
human = black
comp = white
end if
call setup
textbox #m.move , winx / 2 - 100 , 10 * winy / 12 , 100 , 40
button #m.ok , "ok" , [ok] , UL , winx / 2 , 10 * winy / 12 , 40 , 40
open "SCHAAK" for graphics as #m
#m "trapclose [quit]"
#m.move "!font Courier_New 24 bold"
#m.move "!setfocus"
call draw
while 1
call computermove 1
call draw
call computermove 0 - 1
call draw
wend
wait
[ok]
#m.move "!contents? zet$"
if len( zet$ ) <> 4 then
notice "Move must be 4 long !!"
wait
end if
l1$ = upper$( left$( zet$ , 1 ) )
if instr( "ABCDEFGH" , l1$ ) = 0 then
notice "First char unkown !!"
wait
end if
n1 = val( mid$( zet$ , 2 , 1 ) )
if n1 < 1 or n1 > 8 then
notice "First digit unkown !!"
wait
end if
l2$ = upper$( mid$( zet$ , 3 , 1 ) )
if instr( "ABCDEFGH" , l2$ ) = 0 then
notice "Second char unkown !!"
wait
end if
n2 = val( mid$( zet$ , 4 , 1 ) )
if n2 < 1 or n2 > 8 then
notice "Second digit unkown !!"
wait
end if
q1 = instr( "ABCDEFGH" , l1$ )
if plek( index( q1 , n1 ) ) = empty then
notice "Take a peace !!"
wait
end if
if sign( plek( index( q1 , n1 ) ) ) = comp then
notice "Take Yours please !!"
wait
end if
q2 = instr( "ABCDEFGH" , l2$ )
plek( index( q2 , 9 - n2 ) ) = plek( index( q1 , 9 - n1 ) )
plek( index( q1 , 9 - n1 ) ) = empty
call draw
wait
function sign( x )
if x < 0 then sign = 0 - 1
if x > 0 then sign = 1
sign = 0
end function
sub computermove clr
tel = 0
for x = 1 to 8
for y = 1 to 8
plekis = plek( index( x , y ) )
i = 0
if sign( plekis ) = clr then
p = plek( index( x , y ) )
while p <> wall and p <> 0 _
and sign( p ) <> clr
p = plek( index( x , y ) _
+ piece( abs( plekis ) , i ) )
if p = 0 _
or sign( p ) <> clr then
move( tel ) = 100 * index( x , y ) _
+ index( x , y ) _
+ piece( abs( plekis ) , i )
tel = tel + 1
end if
i = i + 1
wend
end if
next y
next x
txt$ = ""
for t = 0 to tel
m = move( tel )
from = int( m / 100 )
too = m - from
txt$ = _
mid$( "ABCDEFGH" , int( from / 10 ) , 1 ) _
+ str$( from - int( from / 10 ) ) _
+ mid$( "ABCDEFGH" , int( too / 10 ) , 1 ) _
+ str$( too - int( too / 10 ) ) + " "
if t and 8 then
txt$ = txt$ + chr$( 13 )
end if
next t
notice txt$
dice = int( rnd( 0 ) * tel )
m = move( dice )
from = int( m / 100 )
too = m - from
plek( too ) = plek( from )
plek( from ) = empty
end sub
sub draw
#m "font Courier_new 40 bold"
for x = 1 to 8
#m "backcolor white"
#m "color black"
#m "goto " ; ( x + 0.5 ) * winx / 10 - 24 ; " 50"
#m "down"
#m "\" ; mid$( "ABCDEFGH" , x , 1 )
#m "up"
#m "goto " ; ( x + 0.5 ) * winx / 10 - 24 ; " " _
; 10 * winy / 12
#m "down"
#m "\" ; mid$( "ABCDEFGH" , x , 1 )
#m "up"
#m "goto " ; winx / 10 - 48 ; " " ; ( x + 1 ) * winy / 12
#m "down"
#m "\" ; mid$( "87654321" , x , 1 )
#m "up"
#m "goto " ; 9 * winx / 10 ; " " ; ( x + 1 ) * winy / 12
#m "down"
#m "\" ; mid$( "87654321" , x , 1 )
#m "up"
for y = 1 to 8
if ( x + y ) and 1 then
#m "color white"
#m "backcolor blue"
else
#m "color white"
#m "backcolor red"
end if
#m "goto " ; x * winx / 10 ; " " ; y * winy / 12
#m "down"
#m "boxfilled " ; ( x + 1 ) * winx / 10 ; " " _
; ( y + 1 ) * winy / 12
#m "up"
if plek( index( x , y ) ) < 0 then
#m "color cyan"
#m "backcolor cyan"
else
#m "color yellow"
#m "backcolor yellow"
end if
plekis = abs( plek( index( x , y ) ) )
select case plekis
case tower0 , tower
call box x , y , 0.1 , 0.2 , 0.3 , 0.4
call box x , y , 0.2 , 0.4 , 0.8 , 0.9
call box x , y , 0.4 , 0.2 , 0.6 , 0.4
call box x , y , 0.7 , 0.2 , 0.9 , 0.4
case pawn0 , pawn
call box x , y , 0.4 , 0.5 , 0.6 , 0.9
call circle x , y , 0.5 , 0.3 , 0.2
case king0 , king
call box x , y , 0.1 , 0.4 , 0.9 , 0.6
call box x , y , 0.4 , 0.1 , 0.6 , 0.9
case bishop
call circle x , y , 0.5 , 0.5 , 0.8
#m "color darkgreen"
#m "backcolor darkgreen"
call box x , y , 0.4 , 0.3 , 0.6 , 0.8
call box x , y , 0.3 , 0.4 , 0.7 , 0.5
case horse
call box x , y , 0.4 , 0.4 , 0.6 , 0.9
call box x , y , 0.2 , 0.1 , 0.6 , 0.4
case queen
call circle x , y , 0.3 , 0.3 , 0.3
call circle x , y , 0.5 , 0.3 , 0.3
call circle x , y , 0.7 , 0.3 , 0.3
call circle x , y , 0.5 , 0.6 , 0.5
case else
''empty fielt
end select
next y
next x
#m "flush"
end sub
sub box x , y , x1 , y1 , x2 , y2
#m "goto " ; ( x + x1 ) * winx / 10 ; " " _
; ( y + y1 ) * winy / 12
#m "down"
#m "boxfilled " ; ( x + x2 ) * winx / 10 _
; " " ; ( y + y2 ) * winy / 12
#m "up"
end sub
sub circle x , y , mx , my , d
#m "goto " ; ( x + mx ) * winx / 10 ; " " _
; ( y + my ) * winy / 12
#m "down"
#m "ellipsefilled " ; d * winx / 10 _
; " " ; d * winy / 12
#m "up"
end sub
sub setup
restore [data]
t = 0
while a$ <> "="
read a$
for i = 1 to len( a$ )
plek( index( i , t ) ) = wall
select case mid$( a$ , i , 1 )

case "k" : plek( index( i - 1 , t ) ) = king0 * black
case "q" : plek( index( i - 1 , t ) ) = queen * black
case "b" : plek( index( i - 1 , t ) ) = bishop * black
case "h" : plek( index( i - 1 , t ) ) = horse * black
case "t" : plek( index( i - 1 , t ) ) = tower0 * black
case "p" : plek( index( i - 1 , t ) ) = pawn0 * black

case "K" : plek( index( i - 1 , t ) ) = king0 * white
case "Q" : plek( index( i - 1 , t ) ) = queen * white
case "B" : plek( index( i - 1 , t ) ) = bishop * white
case "H" : plek( index( i - 1 , t ) ) = horse * white
case "P" : plek( index( i - 1 , t ) ) = pawn0 * white
case "T" : plek( index( i - 1 , t ) ) = tower0 * white

case "@" : plek( index( i - 1 , t ) ) = wall
case else : plek( index( i - 1 , t ) ) = empty
end select
next i
t = t + 1
wend
for i = 0 to 7
read z
piece( horse , i ) = z
next i
for i = 0 to 13
read z
piece( tower0 , i ) = z
piece( tower0 , i + 8 ) = 0 - z
piece( tower , i ) = z
piece( tower , i + 8 ) = 0 - z
next i
for i = 0 to 27
read z
piece( queen , i ) = z
piece( queen , i + 28) = 0 - z
next i
for i = 0 to 13
read z
piece( bishop , i ) = z
piece( bishop , i + 14 ) = 0 - z
next i
for i = 0 to 7
read z
piece( king0 , i ) = z
piece( king , i ) = z
next i
piece( pawn0 , 0 ) = 10
piece( pawn0 , 1 ) = 20
piece( pawn , 0 ) = 10

[data]
data "@@@@@@@@@@"
data "@thbqkbht@"
data "@pppppppp@"
data "@........@"
data "@........@"
data "@........@"
data "@........@"
data "@PPPPPPPP@"
data "@THBQKBHT@"
data "@@@@@@@@@@"
data "="
''horse
data 12 , 21 , 8 , 19 , -12 , -21 , -8 , -19
''tower
data 01,02,03,04,05,06,07,10,20,30,40,50,60,70
''queen
data 01,02,03,04,05,06,07,10,20,30,40,50,60,70 _
,09,18,27,36,45,54,63,11,22,33,44,55,66,77
''bishop
data 09,18,27,36,45,54,63,11,22,33,44,55,66,77
''king
data 1 , 11 , 10 , 9 , -1 , -11 , -10 , -9
end sub
function index( a , b )
i = a + 10 * b
if i < 0 or i > 100 then
i = 100
end if
index = i
end function
[quit]
close #m
end