StPendl
Apr 2, 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
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 , n2 ) ) = plek( index( q1 , n1 ) )
plek( index( q1 , 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 draw
#m "font Courier_new 48 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$( "12345678" , x , 1 )
#m "up"
#m "goto " ; 9 * winx / 10 ; " " ; ( x + 1 ) * winy / 12
#m "down"
#m "\" ; mid$( "12345678" , 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 green"
#m "backcolor green"
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
[data]
data "@@@@@@@@@@"
data "@thbqkbht@"
data "@pppppppp@"
data "@........@"
data "@........@"
data "@........@"
data "@........@"
data "@PPPPPPPP@"
data "@THBQKBHT@"
data "@@@@@@@@@@"
data "="
end sub
function index( a , b )
index = a + 10 * b
end function
[quit]
close #m
end
[[code]]