bluatigro
Apr 4, 2010
[[user:bluatigro|1270230827]] [[code format="vbnet"]]dim[[code]] dim plek( 150 ) , piece( 10 , 100 ) , move( 1000 )globalglobal black , white , human , comp , zet$globalglobal king0 , king , queen , bishop , horseglobalglobal pawn0 , pawn , tower0 , towerglobalglobal empty , wall , winx , winy , play1 , play2blackblack = 0 - 1 : white = 1king0king0 = 1 : king = 2 : queen = 3 : bishop = 4horsehorse = 5 : pawn0 = 6 : pawn = 7 : tower0 = 8 : tower = 9emptyempty = 0 : wall = 10WindowWidthWindowWidth = DisplayWidthWindowHeightWindowHeight = DisplayHeightwinxwinx = WindowWidthwinywiny = WindowHeightnomainwin confirmnomainwin confirm "You take white ?" ; whiteJN$ifif whiteJN$ = "yes" thenhumanhuman = whitecompcomp = blackelse humanelse human = blackcompcomp = whiteendend ifcallcall setuptextboxtextbox #m.move , winx / 2 - 100 , 10 * winy / 12 , 100 , 40buttonbutton #m.ok , "ok" , [ok] , UL , winx / 2 , 10 * winy / 12 , 40 , 40openopen "SCHAAK" for graphics as #m#m#m "trapclose [quit]"#m.move#m.move "!font Courier_New 24 bold"#m.move#m.move "!setfocus"callcall drawwaitwhile 1 call computermove 1 call draw call computermove 0 - 1 call draw wend wait [ok]#m.move#m.move "!contents? zet$"ifif len( zet$ ) <> 4 thennoticenotice "Move must be 4 long !!"wait endwait end ifl1$l1$ = upper$( left$( zet$ , 1 ) )ifif instr( "ABCDEFGH" , l1$ ) = 0 thennoticenotice "First char unkown !!"wait endwait end ifn1n1 = val( mid$( zet$ , 2 , 1 ) )ifif n1 < 1 or n1 > 8 thennoticenotice "First digit unkown !!"wait endwait end ifl2$l2$ = upper$( mid$( zet$ , 3 , 1 ) )ifif instr( "ABCDEFGH" , l2$ ) = 0 thennoticenotice "Second char unkown !!"wait endwait end ifn2n2 = val( mid$( zet$ , 4 , 1 ) )ifif n2 < 1 or n2 > 8 thennoticenotice "Second digit unkown !!"wait endwait end ifq1q1 = instr( "ABCDEFGH" , l1$ )ifif plek( index( q1 , n1 ) ) = empty thennoticenotice "Take a peace !!"wait endwait end ififif sign( plek( index( q1 , n1 ) ) ) = comp thennoticenotice "Take Yours please !!"wait endwait end ifq2q2 = instr( "ABCDEFGH" , l2$ )plek(plek( index( q2 , 9 - n2 ) ) = plek( index( q1 , 9 - n1 ) )plek(plek( index( q1 , 9 - n1 ) ) = emptycallcall drawwaitwait function sign( x )ifif x < 0 then sign = 0 - 1ifif x > 0 then sign = 1signsign = 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#m "font Courier_new4840 bold"forfor x = 1 to 8#m#m "backcolor white"#m#m "color black"#m#m "goto " ; ( x + 0.5 ) * winx / 10 - 24 ; " 50"#m#m "down"#m#m "\" ; mid$( "ABCDEFGH" , x , 1 )#m#m "up"#m#m "goto " ; ( x + 0.5 ) * winx / 10 - 24 ; " " _;; 10 * winy / 12#m#m "down"#m#m "\" ; mid$( "ABCDEFGH" , x , 1 )#m#m "up"#m#m "goto " ; winx / 10 - 48 ; " " ; ( x + 1 ) * winy / 12#m#m "down"#m#m "\" ; mid$("12345678""87654321" , x , 1 )#m#m "up"#m#m "goto " ; 9 * winx / 10 ; " " ; ( x + 1 ) * winy / 12#m#m "down"#m#m "\" ; mid$("12345678""87654321" , x , 1 )#m#m "up"forfor y = 1 to 8ifif ( x + y ) and 1 then#m#m "color white"#m#m "backcolor blue"else #melse #m "color white"#m#m "backcolor red"endend if#m#m "goto " ; x * winx / 10 ; " " ; y * winy / 12#m#m "down"#m#m "boxfilled " ; ( x + 1 ) * winx / 10 ; " " _;; ( y + 1 ) * winy / 12#m#m "up"ifif plek( index( x , y ) ) < 0 then#m#m "color cyan"#m#m "backcolor cyan"else #melse #m "color yellow"#m#m "backcolor yellow"endend ifplekisplekis = abs( plek( index( x , y ) ) )selectselect case plekiscasecase tower0 , towercallcall box x , y , 0.1 , 0.2 , 0.3 , 0.4callcall box x , y , 0.2 , 0.4 , 0.8 , 0.9callcall box x , y , 0.4 , 0.2 , 0.6 , 0.4callcall box x , y , 0.7 , 0.2 , 0.9 , 0.4casecase pawn0 , pawncallcall box x , y , 0.4 , 0.5 , 0.6 , 0.9callcall circle x , y , 0.5 , 0.3 , 0.2casecase king0 , kingcallcall box x , y , 0.1 , 0.4 , 0.9 , 0.6callcall box x , y , 0.4 , 0.1 , 0.6 , 0.9casecase bishopcallcall circle x , y , 0.5 , 0.5 , 0.8#m#m "colorgreen" #mdarkgreen" #m "backcolorgreen" calldarkgreen" call box x , y , 0.4 , 0.3 , 0.6 , 0.8callcall box x , y , 0.3 , 0.4 , 0.7 , 0.5casecase horsecallcall box x , y , 0.4 , 0.4 , 0.6 , 0.9callcall box x , y , 0.2 , 0.1 , 0.6 , 0.4casecase queencallcall circle x , y , 0.3 , 0.3 , 0.3callcall circle x , y , 0.5 , 0.3 , 0.3callcall circle x , y , 0.7 , 0.3 , 0.3callcall circle x , y , 0.5 , 0.6 , 0.5casecase else''empty''empty fieltendend selectnextnext ynextnext x#m#m "flush" end sub sub box x , y , x1 , y1 , x2 , y2#m#m "goto " ; ( x + x1 ) * winx / 10 ; " " _;; ( y + y1 ) * winy / 12#m#m "down"#m#m "boxfilled " ; ( x + x2 ) * winx / 10 _;; " " ; ( y + y2 ) * winy / 12#m#m "up" end sub sub circle x , y , mx , my , d#m#m "goto " ; ( x + mx ) * winx / 10 ; " " _;; ( y + my ) * winy / 12#m#m "down"#m#m "ellipsefilled " ; d * winx / 10 _;; " " ; d * winy / 12#m#m "up" end sub sub setuprestorerestore [data]tt = 0whilewhile a$ <> "="readread a$forfor i = 1 to len( a$ )plek(plek( index( i , t ) ) = wallselectselect case mid$( a$ , i , 1 )casecase "k" : plek( index( i - 1 , t ) ) = king0 * blackcasecase "q" : plek( index( i - 1 , t ) ) = queen * blackcasecase "b" : plek( index( i - 1 , t ) ) = bishop * blackcasecase "h" : plek( index( i - 1 , t ) ) = horse * blackcasecase "t" : plek( index( i - 1 , t ) ) = tower0 * blackcasecase "p" : plek( index( i - 1 , t ) ) = pawn0 * blackcasecase "K" : plek( index( i - 1 , t ) ) = king0 * whitecasecase "Q" : plek( index( i - 1 , t ) ) = queen * whitecasecase "B" : plek( index( i - 1 , t ) ) = bishop * whitecasecase "H" : plek( index( i - 1 , t ) ) = horse * whitecasecase "P" : plek( index( i - 1 , t ) ) = pawn0 * whitecasecase "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 ) = 10case "@" : plek( index( i - 1 , t ) ) = wall case else : plek( index( i - 1 , t ) ) = empty end select next i t = t + 1 wend[data]datadata "@@@@@@@@@@"datadata "@thbqkbht@"datadata "@pppppppp@"datadata "@........@"datadata "@........@"datadata "@........@"datadata "@........@"datadata "@PPPPPPPP@"datadata "@THBQKBHT@"datadata "@@@@@@@@@@"datadata "=" ''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 )indexi = a + 10 * b if i < 0 or i > 100 then i = 100 end if index = i end function [quit]closeclose #mend [[code]]end