Club Amiga de Montreal

home *** CD-ROM | disk | FTP | other *** search

/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 187.lha / chess.bas < prev next >

Wrap

BASIC Source File | 1988-04-28 | 20.5 KB | 1,171 lines

10 Print "Chess c.4 from "Creative Computing", Dec. 1981, page 276 Print "Rewritten for the Amiga by Douglas Bullard, 6-7-86 print "Compiled using the AC-Basic Compiler" DEFINT a-z DIM c(64),move(6,22),cols(8,8),pairs(6),length(6),strength(6) a=0 b=0 x=0 y=0 s=0 a0=0 t=0 a8=0 a1=0 a2=0 a3=0 a4=0 b1=0 b6!=0 h=0 m=0 n=0 p=0 w=0 a5=0 i=1 for cunt=1 to 10000:next cunt CLS print "Do you want instructions? " 1101 in$=inkey$:if in$="" goto 1101 in$=UCASE$(in$) print in$ IF in$="Y" THEN GOSUB 3170 cl$="N" CLS Input "What is your name";b$ IF b$="" THEN b$="Gomer " ELSE b$=LEFT$(b$,9) CLS input "Level of play (1-24)"; b8! IF b8!=0 THEN b8!=1 b7!=1+RND/2 ELSE b7!=(b8!+1+RND)/2 END IF CLS print "Do you want white?" 1011 c$=inkey$:if c$="" goto 1011 c$=UCASE$(c$) GOSUB 2590 flag1=1 IF c$<> "Y" THEN flag1=0:GOSUB 3430 CLS print "Do you want to recall a previous game?" 1111 prev$=inkey$:if prev$="" goto 1111 prev$=UCASE$(prev$) SCREEN 1,640,400,4,4 WINDOW 2, "AmigaChess",,15,1 PALETTE 0,0,.1,.03 PALETTE 1,.9,0,0 PALETTE 2,.8,0,0 PALETTE 3,.714,0,0 PALETTE 4,.571,0,0 PALETTE 5,.429,0,0 PALETTE 6,.228,0,0 PALETTE 7,.143,0,0 PALETTE 8,.1,.1,.1 PALETTE 9,0,0,.143 PALETTE 10,0,0,.228 PALETTE 11,0,0,.429 PALETTE 12,0,0,.571 PALETTE 13,0,0,.714 PALETTE 14,0,0,.8 PALETTE 15,0,0,.9 IF prev$<>"Y" THEN GOSUB 2840:GOTO 740 CLS Input "What is the game name"; gamename$ gamename$="chess."+gamename$ PRINT "OK, saving ";gamename$; OPEN "I",#1,gamename$ FOR al=1 TO 8 FOR be=1 TO 8 IF NOT EOF(1) THEN INPUT #1,a(be,al) ELSE GOSUB 2840 GOTO 740 END IF NEXT be,al GOSUB 2840 GOTO 740 300 IF UCASE$(cl$)="Y" THEN LOCATE 5,64 COLOR 4,8 PRINT "Start ";TIME$; LOCATE 6,64 PRINT STRING$(14," "); END IF 440 f!=-99 a0=0 FOR j=1 TO 8 FOR k=1 TO 8 IF a(j,k)=99 THEN a6=j:a7=k NEXT k NEXT j FOR x=1 TO 8 FOR y=1 TO 8 IF a(x,y)<0 THEN GOSUB 910 IF f!>=b7! THEN 580 END IF NEXT y NEXT x IF f!>=-9 THEN 580 ELSE GOSUB 2840 LOCATE 4,64 PRINT "I concede" GOTO 4230 580 a(r,u)=a(e,q) a(e,q)=1 IF a(r,u)=-2 AND u=1 THEN a(r,u)=-9 x=r y=u a0=4 GOSUB 910 LINE (e*55-55,(190-q*24)*2)-STEP(54,24*2),1,b LINE (r*55-55,(190-u*24)*2)-STEP(54,24*2),1,b LOCATE 4,64 PRINT "is my move "; LOCATE 3,64 PRINT CHR$(e+64);q;"- ";CHR$(r+64);u; IF UCASE$(cl$)="Y" THEN LOCATE 6,64:PRINT "Stop ";TIME$; x=e y=q GOSUB 2840 x=r y=u IF c=1 THEN LOCATE 4,64 PRINT "Check";b$; c=0 END IF 740 IF x$="S" THEN GOSUB 3790 b7!=3*RND LOCATE 1,64 PRINT "Self Playing"; GOSUB 4430 GOTO 440 ELSE LOCATE 2,64 PRINT "Move ";b$; GOSUB 3500 d=0 b4=a b9=b b5=0 IF a(x,y)=2 AND y=5 AND b=6 AND a(a,b)=1 AND ABS(a-x)=1 THEN b5=1 GOTO 770 END IF END IF IF x$="K" OR x$="Q" THEN GOSUB 2840 LOCATE 2,65 PRINT STRING$(14," "); GOTO 440 END IF IF x$="S" THEN cl$="N" GOTO 740 ELSE a0=3 GOSUB 900 IF d=0 THEN LOCATE 3,64 PRINT "Illegal"; GOTO 740 END IF END IF 770 LOCATE 2,64: PRINT "OK "; a=b4 b=b9 a(a,b)=a(x,y) a(x,y)=1 GOSUB 2840 x=a y=b IF n$="N" THEN GOSUB 2840: n$=" " IF a(a,b)=2 AND b=8 THEN LOCATE 2,64 PRINT "What piece"; GOSUB 4350 x=a: y=b GOSUB 2840 LOCATE 2,64 PRINT STRING$(14," "); LOCATE 3,64 PRINT STRING$(14," "); END IF IF b5=1 THEN a(a,b)=1 x=a y=b-1 GOSUB 2840 END IF 890 GOTO 440 900 REM ON a(x,y) GOTO 10,1520,10,1270,1070,10,920,10,1070: GOTO 1460 910 ON (-a(x,y)) GOTO 10,1640,10,1270,1070,10,920,10,1070: GOTO 1460 920 b=y a=x+1 ender=8 940 GOSUB 2040 IF s=0 THEN a=a+1 IF a<=ender THEN 940 END IF a=x-1 ender=1 970 GOSUB 2040 IF s=0 THEN a=a-1 IF a>=ender THEN 970 END IF a=x b=y+1 ender=8 1010 GOSUB 2040 IF s=0 THEN b=b+1 IF b<=ender THEN 1010 END IF b=y-1 ender=1 1040 GOSUB 2040 IF s=0 THEN b=b-1 IF b>=ender THEN 1040 END IF RETURN 1070 b=y a=x+1 ender=8 1090 b=b+1 GOSUB 2040 IF s=0 THEN a=a+1 IF a<=ender THEN 1090 END IF b=y a=x-1 ender=1 1140 b=b-1 GOSUB 2040 IF s=0 THEN a=a-1 IF a>=ender THEN 1140 END IF b=y a=x-1 ender=1 1190 b=b+1 GOSUB 2040 IF s=0 THEN a=a-1 IF a>=ender THEN 1190 END IF b=y a=x+1 ender=8 1231 b=b-1 GOSUB 2040 IF s=0 THEN a=a+1 IF a<=ender THEN 1231 END IF IF ABS(a(x,y))=9 THEN 920 ELSE RETURN 1270 a=x+2 b=y+1 IF a<9 AND b<9 THEN GOSUB 2060 b=b-2 IF b>0 AND a<9 THEN GOSUB 2060 a=a-4 IF a>0 AND b>0 THEN GOSUB 2060 b=b+2 IF b<9 AND a>0 THEN GOSUB 2060 a=a+1 b=b+1 IF a>0 AND a<9 AND b<9 THEN GOSUB 2060 b=b-4 IF b>0 AND a>0 AND a<9 THEN GOSUB 2060 a=a+2 IF a>0 AND a<9 AND b>0 THEN GOSUB 2060 b=b+4 IF b<9 AND a>0 AND a<9 THEN GOSUB 2060 RETURN 1460 FOR a=x-1 TO x+1 FOR b=y-1 TO y+1 IF a(a,b)<>0 THEN GOSUB 2060 NEXT NEXT RETURN 1520 a=x IF y>2 THEN 1560 b=y+1 IF a(a,b)=1 THEN GOSUB 2070 b=b+1 IF a(a,b)=1 THEN GOSUB 2070 GOTO 1580 ELSE GOTO 1580 END IF ELSE GOTO 1580 END IF 1560 b=y+1 IF a(a,b)=1 THEN GOSUB 2070 1580 a=x+1 b=y+1 IF a(a,b)<0 THEN GOSUB 2070 a=a-2 IF a(a,b)<0 THEN GOSUB 2070 RETURN 1640 a=x IF y<7 THEN 1680 b=y-1 IF a(a,b)=1 THEN GOSUB 2070 b=b-1 IF a(a,b)=1 THEN GOSUB 2070 GOTO 1700 ELSE GOTO 1700 END IF ELSE GOTO 1700 END IF 1680 b=y-1 IF a(a,b)=1 THEN GOSUB 2070 1700 a=x-1 b=y-1 IF a(a,b)>1 THEN GOSUB 2070 a=a+2 IF a(a,b)>1 THEN GOSUB 2070 RETURN 1760 t=a(a,b) IF t=-99 THEN b1=t: RETURN a5=s IF ABS(t)<=a(x,y) THEN a(a,b)=a(x,y) a(x,y)=1 GOTO 1820 END IF 1800 IF t<b1 THEN b1=t s=a5 RETURN 1820 a1=x a2=y a3=a a4=b a8=t a0=2 FOR x=1 TO 8 FOR y= 1 TO 8 IF a(x,y)<0 THEN GOSUB 910 IF t=0 THEN 1930 END IF NEXT NEXT 1930 x=a1 y=a2 a=a3 b=a4 a0=5 a(x,y)=a(a,b) a(a,b)=a8 GOTO 1800 '************************************************* '* This subroutine checks the legality of a move * '************************************************* 2040 s=0 IF a(a,b)=1 THEN GOTO 2070 ELSEIF a(a,b)=0 THEN s=1 RETURN ELSEIF SGN(a(a,b))=SGN(a(x,y)) THEN s=1 RETURN ELSE s=1 GOTO 2070 END IF 2060 IF a(a,b)=1 THEN GOTO 2070 ELSEIF SGN(a(a,b))=SGN(a(x,y)) THEN RETURN END IF 2070 REM ON a0 GOTO 2090,2110,2130,2150,2170 GOTO 2180 2090 IF a6=a AND a7=b THEN b1=b1+1 RETURN 2110 IF a3=a AND a4=b THEN t=0 RETURN 2130 IF b4=a AND b9=b THEN d=1 RETURN 2150 IF a6=a AND a7=b THEN c=1 RETURN 2170 IF a(a,b)<0 THEN 1760 ELSE RETURN 2180 b3=s w=x m=y n=a h=b p=a(a,b) a(a,b)=a(x,y) a(x,y)=1 b1=0 a0=5 FOR x=1 TO 8 FOR y=1 TO 8 IF a(x,y)>1 THEN GOSUB 900 NEXT y NEXT x x=n y=h a0=1 GOSUB 910 a0=0 s=b3 x=w y=m a=n b=h a(x,y)=a(a,b) a(a,b)=p b6!=1/(ABS(4.5-a)+ABS(4.5-b)+1) IF a(x,y)<-2 AND a(x,y)>-9 THEN b6!=b6!+1/(ABS(a6-a)+ABS(a7-b)+5)+RND/15 g!=p+b1+b6! IF p=99 THEN GOSUB 2840 LOCATE 4,64 PRINT "Mate ";b$; GOTO 4230 END IF IF g!<=f! THEN RETURN f!=g! e=x q=y r=a u=b RETURN '********************************* '* Initialize positions on board * '********************************* 2590 CLS restore positionsdata FOR y=1 TO 8 FOR x=1 TO 8 READ a(x,y) NEXT x NEXT y Positionsdata: DATA 7,4,5,9,99,5,4,7 DATA 2,2,2,2,2,2,2,2 DATA 1,1,1,1,1,1,1,1 DATA 1,1,1,1,1,1,1,1 DATA 1,1,1,1,1,1,1,1 DATA 1,1,1,1,1,1,1,1 DATA -2,-2,-2,-2,-2,-2,-2,-2 DATA -7,-4,-5,-9,-99,-5,-4,-7 movesdata: ' knight DATA 8, 1,2, -1,-2, 2,1, 2,-1, -1,2, 1,-2, -2,-1, -2,1, 0,2 ' castle DATA 4, 8,0, -8,0, 0,8, 0,-8, 8,1 ' Bishop DATA 1, 8,8, 8,1 ' Queen DATA 5, 8,8, 8,0, 0,8, 0,-8, -8,0, 8,3 ' King DATA 8, 1,1, 1,-1, -1,1, -1,-1, 0,1, -1,0, 1,0, 0,-1, 0,1 ' Pawn DATA 4, 1,1, -1,1, 0,1, 0,2, 0,1 restore movesdata FOR i=1 TO 6 READ pairs(i) FOR j= 1 TO 2*pairs(i) READ move(i,j) NEXT j READ length(i),strength(i) NEXT i RETURN '************************** '* Draws board and pieces * '************************** 2840 FOR i=1 TO 8 FOR j=1 TO 8 cols(i,j)=0 NEXT NEXT FOR i=1 TO 8 FOR j=1 TO 8 IF a(i,j)=1 THEN GOTO 2737 pi=6 IF ABS(a(i,j))=4 THEN pi=1 IF ABS(a(i,j))=7 THEN pi=2 IF ABS(a(i,j))=5 THEN pi=3 IF ABS(a(i,j))=9 THEN pi=4 IF ABS(a(i,j))=99 THEN pi=5 cols(i,j)=cols(i,j)+strength(pi)*SGN(a(i,j)) FOR pair=1 TO pairs(pi)*2 STEP 2 x=move(pi,pair)+i y=move(pi,pair+1)+j IF a(i,j)=-2 THEN x=i-move(pi,pair) y=j-move(pi,pair+1) END IF stepx=1 IF x<i THEN stepx=-1 stepy=1 IF y<j THEN stepy=-1 IF x=i AND y=j THEN 2735 ' pawn, king, or knight IF length(pi)=0 THEN IF pair>=6 THEN IF a(i,j)=-2 AND j<>7 THEN 2735 IF a(i,j)=2 AND j<>2 THEN 2735 END IF IF x<1 OR x>8 OR y<1 OR y>8 THEN 2735 cols(x,y)=cols(x,y)+strength(pi)*SGN(a(i,j)) ELSEIF move(pi,pair)=0 OR move(pi,pair+1)=0 THEN FOR L=i TO x STEP stepx FOR m=j TO y STEP stepy IF L<1 OR L>8 OR m<1 OR m>8 THEN 2736 IF L=i AND m=j THEN GOTO 2736 ELSE cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j)) END IF IF a(L,m)<>1 THEN GOTO 2735 2736 NEXT m NEXT L ELSE ' Diagonals FOR ll=1 TO 8 L=i+ll m=j+ll IF L<9 AND m<9 THEN cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j)) IF a(L,m)<>1 THEN 2731 NEXT ll 2731 FOR ll=1 TO 8 L=i+ll m=j-ll IF L<9 AND m>0 THEN cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j)) IF a(L,m)<>1 THEN 2732 NEXT ll 2732 FOR ll=1 TO 8 L=i-ll m=j+ll IF L>0 AND m<9 THEN cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j)) IF a(L,m)<>1 THEN 2734 NEXT ll 2734 FOR ll=1 TO 8 L=i-ll m=j-ll IF L>0 AND m>0 THEN cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j)) IF a(L,m)<>1 THEN 2735 NEXT ll END IF 2735 NEXT pair 2737 NEXT j NEXT i FOR x=1 TO 8 FOR y=1 TO 8 GOSUB 2845 NEXT y NEXT x COLOR 5,0 RETURN '**************************************************** '* Subroutine to draw a square and the piece on it. * '* Square is identified by the coordinates x,y * '**************************************************** 2845 yc=y*24 xc=x*55 colors=(cols(x,y)+8) IF colors >15 THEN colors=15 IF colors <1 THEN colors=1 LINE (xc-55,(190-yc)*2)-STEP(54,23*2),colors,bf LINE (x*55-55,(190-y*24)*2)-STEP(54,24*2),0,b IF SGN(a(x,y))=-1 THEN COLOR 11,colors Ccolor=11 ELSE COLOR 5,colors Ccolor=5 END IF piece=ABS(a(x,y)) IF piece=7 THEN GOSUB rook IF piece=4 THEN GOSUB knight IF piece=5 THEN GOSUB bishop IF piece=9 THEN GOSUB queen IF piece=99 THEN GOSUB king IF piece=2 THEN GOSUB pawn COLOR 0,colors RETURN '**************** '* Instructions * '**************** 3170 CLS Print " Welcome to the game of Amiga Chess." Print Print Print Print " There are a few differences between Amiga Chess and normal chess." Print " These differences have to do with the way the board is displayed," Print " and the way the pieces are moved." Print Print " The board is a mosaic of different colors, all shades of red, " Print " shades of blue, or completely black. The intensity of the shade indicates" Print " which side dominates it the most, and to what degree. A bright red square" Print " is heavily dominated by the red player," Print " while a dim red square may be only mildly dominated by red. " Print " A square that appears black is equally dominated by both sides." Print Print Print " To make a move, indicate the piece with a click of the left mouse " Print " button, then indicate the square you want to move it to." Print " Let the Amiga do the rest." print PRINT " Hit any key to continue" WHILE INKEY$="":WEND CLS Print " 1. Special commands during player's move are:" Print " 'K' - to castle king side." Print " 'Q' - to castle queen side." Print " 'X' - to exhange pieces and let the computer play." Print " 'S' - to let the computer play by itself." Print " 'M' - to modify the board and enter the square followed by 'C', 'P'" Print " or 'E' for computer, player or empty and 'S', 'P', 'N', 'B'," Print " 'R', 'Q', or 'K' for square, pawn," Print " knight, bishop, rook, queen, or king." Print " 'Z' - to escape from modify and let the computer move." Print " 'I' - to get instructions again." Print " 'L' - to look at or change level of play." Print " 2. To promote to P, N, B, R, or Q, enter the letter when prompted." Print " 3. To capture 'en passant' specify the 'from' - 'to' squares." Print " 4. Levels of play are from one to twenty four." Print " 5. Computer assumes mate if king is left in check, so be sure to watch for" Print " the check message." Print " 6. If a move is illegal or an entry error is made," Print " simply type in a new move." Print " A move may be started over by forcing an error. (i. e., '9')" Print " 7. To record a game on disk for future playing, type an 'R'." PRINT " Hit any key to continue and return to the game." WHILE INKEY$="":WEND RETURN 3430 i=-1 a(4,1)=99 a(5,1)=9 a(4,8)=-99 a(5,8)=-9 IF flag1=1 THEN GOSUB 2840 RETURN 3500 LOCATE 1,64: PRINT STRING$(14," "); mou=MOUSE(0) 3510 x$="" WHILE x$="" AND MOUSE(0)=0 x$=UCASE$(INKEY$) WEND FOR dgb=1 TO 2000 NEXT dgb IF x$<>"" GOTO 3570 FOR ex=1 TO 8 IF MOUSE(1)>ex*55-55 AND MOUSE(1)<ex*55-1 THEN x$=CHR$(ex+64) x=ex GOTO 3520 END IF NEXT ex 3520 FOR why=1 TO 8 IF MOUSE(2)>(190-why*24)*2 AND MOUSE(2)<(214-why*24)*2 THEN y=why GOTO 3530 END IF NEXT why 3530 LINE (x*55-55,(190-y*24)*2)-STEP(54,24*2),15,b mou=MOUSE(0) GOTO 3660 3570 IF x$="N" THEN n$=x$ IF x$="R" THEN LOCATE 1,64 INPUT "What name";gamename$ gamename$="chess."+gamename$ PRINT gamename$; OPEN gamename$ FOR OUTPUT AS #1 FOR al=1 TO 8 FOR be=1 TO 8 WRITE #1,a(be,al) NEXT be,al CLOSE #1 WINDOW CLOSE 2 CLS END END IF IF x$="N" THEN 440 IF x$="K" AND a(5,1)=99 AND a(8,1)=7 THEN a(5,1)=1 a(8,1)=1 a(7,1)=99 a(6,1)=7 GOTO 3750 END IF IF x$="Q" AND a(5,1)=99 AND a(1,1)=7 THEN a(5,1)=1 a(1,1)=1 a(3,1)=99 a(4,1)=7 GOTO 3750 END IF IF x$="K" AND a(4,1)=99 AND a(1,1)=7 THEN a(4,1)=1 a(1,1)=1 a(2,1)=99 a(3,1)=7 GOTO 3750 END IF IF x$="Q" AND a(4,1)=99 AND a(8,1)=7 THEN a(4,1)=1 a(8,1)=1 a(6,1)=99 a(5,1)=7 GOTO 3750 END IF IF x$="X" THEN GOSUB 3790 LOCATE 1,64 PRINT "Exchanging "; GOSUB 4430 IF cl$="Y" THEN LOCATE 5,60 PRINT "Start ";TIME$; GOTO 440 ELSE GOTO 440 END IF END IF IF x$="S" THEN 3780 IF x$="M" THEN GOSUB 3830 IF x$="I" THEN GOSUB 3170 CLS GOSUB 2840 LOCATE 1,64 PRINT "Move ";b$; END IF IF x$="L" THEN GOSUB 4140 GOTO 3510 3660 LOCATE 1,65: PRINT x$; 3670 LOCATE 1,66: PRINT y; LOCATE 1,69: PRINT "-"; IF a(x,y)<2 OR a(x,y)>99 THEN LOCATE 4,64 PRINT "Entry error "; GOTO 3500 END IF 3710 WHILE MOUSE(0)=0:WEND FOR ex=1 TO 8 IF MOUSE(1)>ex*55-55 AND MOUSE(1)<ex*55-1 THEN a$=CHR$(ex+64) a=ex GOTO 3540 END IF NEXT ex 3540 FOR why=1 TO 8 IF MOUSE(2)>(190-why*24)*2 AND MOUSE(2)<(214-why*24)*2 THEN b=why GOTO 3550 END IF NEXT why 3550 LINE (a*55-55,(190-b*24)*2)-STEP(54,24*2),15,b LOCATE 1,71:PRINT a$ LOCATE 1,72: PRINT b; 3750 IF x$="K" OR x$="Q" THEN LOCATE 1,64 PRINT "Cstl. ";x$;"-side"; END IF GOSUB 3790 IF cl$="Y" THEN LOCATE 5,64 PRINT "Start ";TIME$; END IF 3780 RETURN 3790 FOR j=2 TO 7 LOCATE j,64 PRINT STRING$(16," "); NEXT j RETURN 3830 GOSUB 3790 LOCATE 1,64: PRINT "Modifying "; 3850 GOSUB 4060 IF m$<"A" OR m$>"H" THEN 3850 x=VAL(CHR$(ASC(m$)-16)) LOCATE 2,64: PRINT m$; 3890 m$=INKEY$: IF m$<"1" OR m$>"8" THEN 3890 y=VAL(m$) LOCATE 2,66: PRINT m$;" = "; 3920 m$=UCASE$(INKEY$) IF m$="C" OR m$="P" OR m$="E" THEN s1$=m$ LOCATE 2,70 PRINT m$; ELSE GOTO 3920 END IF 3930 m$=UCASE$(INKEY$): IF m$="S" OR m$="P" OR m$="N" OR m$="B" OR m$="R" OR m$="Q" OR m$="K" THEN v$=m$ LOCATE 2,72 PRINT m$; ELSE GOTO 3930 END IF IF v$="P" THEN v1=2 IF v$="N" THEN v1=4 IF v$="B" THEN v1=5 IF v$="R" THEN v1=7 IF v$="Q" THEN v1=9 IF v$="K" THEN v1=99 IF v$="S" THEN v1=1 IF s1$="C" AND v1<>1 THEN v1=-v1 a(x,y)=v1 IF s1$="E" THEN a(x,y)=1 GOSUB 2840 GOTO 3830 4060 m$=UCASE$(INKEY$) IF m$="N" THEN GOTO 4060 ELSEIF m$="Z" THEN GOSUB 3790 LOCATE 1,64 PRINT STRING$(14," "); GOSUB 2840 ELSE RETURN END IF IF cl$="Y" THEN LOCATE 5,60: PRINT "Start ";TIME$; GOTO 440 4140 GOSUB 3790 LOCATE 1,64: PRINT "Level=";b8!;" "; LOCATE 2,64: PRINT"Change levels?"; 4170 c$=UCASE$(INKEY$) IF c$="N" THEN GOTO 4225 ELSEIF c$="Y" THEN LOCATE 1,71 PRINT STRING$(7," "); GOSUB 3790 ELSE GOTO 4170 END IF 4180 l1$=INKEY$ IF l1$="" THEN GOTO 4180 ELSEIF l1$>="0" AND l1$<"9" THEN LOCATE 1,71 PRINT l1$ ELSE GOTO 4180 END IF 4190 l2$=INKEY$ IF l2$="" THEN GOTO 4190 ELSEIF l2$<"0" OR l2$>"9" THEN l2$=l1$ l1$="0" END IF b8!=VAL(l1$)*10+VAL(l2$) b7!=b8!/2 LOCATE 1,71: PRINT l1$;l2$; 4225 GOSUB 3790 LOCATE 1,64 PRINT STRING$(14," "); LOCATE 2,64 PRINT "Move ";b$; RETURN 4230 IF cl$="Y" THEN LOCATE 6,64: PRINT "Stop ";TIME$; LOCATE 9,62: PRINT "Hit 'P' to play"; LOCATE 10,62: PRINT "or 'B' for basic"; 4260 a$=UCASE$(INKEY$) IF a$="" THEN GOTO 4260 ELSEIF a$="B" THEN CLS END ELSEIF a$="P" THEN GOTO 10 ELSE GOTO 4260 END IF GOSUB 3790 LOCATE 1,64: PRINT STRING$(14," "); LOCATE 2,64: PRINT "Move ";b$; RETURN '********************* '* Promotion routine * '********************* 4350 LOCATE 3,64: PRINT "P, N, B, R, Q"; 4360 z$=UCASE$(INKEY$) IF z$="P" THEN a(a,b)=2: GOTO 4420 IF z$="N" THEN a(a,b)=4: GOTO 4420 IF z$="B" THEN a(a,b)=5: GOTO 4420 IF z$="R" THEN a(a,b)=7: GOTO 4420 IF z$="Q" THEN a(a,b)=9: GOTO 4420 GOTO 4360 4420 RETURN 4430 i=-1 GOSUB 4470 GOSUB 2840 RETURN 4470 L=0 FOR j=1 TO 8 FOR k=1 TO 8 L=L+1 IF a(j,k)<>1 THEN c(L)=-a(j,k) ELSE c(L)=a(j,k) NEXT k NEXT j L=65 FOR j=1 TO 8 FOR k=1 TO 8 L=L-1 a(j,k)=c(L) NEXT k NEXT j RETURN END pawn: LINE ((x-1)*55+15,(183-(y-1)*2)*24)-STEP(25,5*2),,bf LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8*2),,bf CIRCLE ((x-1)*55+28,(172-(y-1)*24)*2),8 'PAINT ((x-1)*55+28,172-(y-1)*24),4 'CIRCLE ((x-1)*55+28,172-(y-1)*24),8,0 RETURN rook: LINE ((x-1)*55+15,(183-(y-1)*24)*2)-STEP(25,5*2),,bf LINE ((x-1)*55+22,(183-(y-1)*24)*2)-STEP(12,-8*2),,bf LINE ((x-1)*55+26,(174-(y-1)*24)*2)-STEP(4,-3*2),,bf LINE ((x-1)*55+16,(174-(y-1)*24)*2)-STEP(4,-3*2),,bf LINE ((x-1)*55+37,(174-(y-1)*24)*2)-STEP(4,-3*2),,bf RETURN bishop: LINE ((x-1)*55+15,(183-(y-1)*2)*24)-STEP(25,5*2),,bf LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8*2),,bf 'CIRCLE ((x-1)*55+28,173-(y-1)*24),8,,,,.7 'PAINT ((x-1)*55+28,172-(y-1)*24) CIRCLE ((x-1)*55+28,(173-(y-1)*24)*2),8,,,,.7 RETURN queen: LINE ((x-1)*55+15,(183-(y-1)*24)*2)-STEP(25,5),,bf LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8),,bf LINE ((x-1)*55+20,(175-(y-1)*24)*2)-STEP(16,-3),,bf CIRCLE ((x-1)*55+18,(170-(y-1)*24)*2),3 'PAINT ((x-1)*55+18,170-(y-1)*24) CIRCLE ((x-1)*55+29,(168-(y-1)*24)*2),3 'PAINT ((x-1)*55+29,168-(y-1)*24) CIRCLE ((x-1)*55+39,(170-(y-1)*24)*2),3 'PAINT ((x-1)*55+39,170-(y-1)*24) RETURN king: LINE ((x-1)*55+15,(183-(y-1)*24)*2)-STEP(25,5),,bf LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8),,bf LINE ((x-1)*55+20,(175-(y-1)*24)*2)-STEP(16,-3),,bf CIRCLE ((x-1)*55+18,(168-(y-1)*24)*2),3 'PAINT ((x-1)*55+18,168-(y-1)*24) CIRCLE ((x-1)*55+29,(168-(y-1)*24)*2),3 'PAINT ((x-1)*55+29,168-(y-1)*24) CIRCLE ((x-1)*55+39,(168-(y-1)*24)*2),3 'PAINT ((x-1)*55+39,168-(y-1)*24) CIRCLE ((x-1)*55+24,(168-(y-1)*24)*2),7,,3.1415,6.283 CIRCLE ((x-1)*55+34,(168-(y-1)*24)*2),7,,3.1415,6.283 RETURN knight: LINE ((x-1)*55+15,(183-(y-1)*24)*2)-STEP(25,5*2),,bf LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8*2),,bf LINE ((x-1)*55+26,(168-(y-1)*24)*2)-STEP(-16,8*2) LINE STEP(0,0)-STEP(0,2*2) LINE STEP(0,0)-STEP(3,0) LINE STEP(0,0)-STEP(7,-1*2) LINE STEP(0,0)-STEP(15,0) LINE STEP(0,0)-STEP(0,-9*2) LINE STEP(0,0)-STEP(-8,0) 'PAINT ((x-1)*55+28,169-(y-1)*24) CIRCLE ((x-1)*55+26,(172-(y-1)*24)*2),1,0 RETURN