StPendl Apr 2, 2010
[[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]]
StPendl
Apr 2, 2010
StPendl
Apr 2, 2010