Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/187.lha/chess.bas

BASIC Source File | 1988-04-28 | 21KB | 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