100 ! *** MATER Version 1.0 - (c) Valentin Albillo, 2004 ***
105 ! 
110 ! Initialization
115 ! 
120 DESTROY ALL @ OPTION BASE 0 @ RESTORE @ DELAY 2,0 @ STD @ INTEGER B(119)
125 DIM F(6,8),I,J,P,Q,C,G,H,T,M,N,K,D,A$,P$[6],F$[96] @ MAT B=(7)
130 FOR I=21 TO 91 STEP 10 @ FOR J=0 TO 7 @ B(I+J)=0 @ NEXT J @ NEXT I
135 DISP "MATER 1.0 - (c) V. Albillo" @ READ F,P$ @ Q=1 @ ON ERROR GOTO 155
140 ! 
145 ! Read problem from file
150 ! 
155 INPUT "Read from ";F$ @ IF F$="" THEN 180 ELSE ASSIGN #1 TO F$
160 READ #1;B,M,N,Q @ ASSIGN #1 TO * @ OFF ERROR @ GOSUB 320 @ GOTO 200
165 ! 
170 ! Enter problem from keyboard 
175 ! 
180 DISP "Ent: +-/"&P$&"/A-H/1-8"
185 ON ERROR GOTO 185 @ INPUT "Piece=";A$@ IF A$="" THEN GOSUB 320 @ GOTO 200
190 A$=UPRC$(A$) @ IF NOT FNL(A$) THEN BEEP @ DISP "Illegal entry" @ GOTO 180
195 GOSUB 290 @ GOTO 185
200 ON ERROR GOTO 200 @ INPUT "Mate in [-=up to]: ",STR$(Q);Q @ Q=INT(Q)
205 IF NOT Q THEN 270
210 ! 
215 ! Save problem to file
220 ! 
225 ON ERROR GOTO 225 @ INPUT "Save in ",F$;F$ @ IF F$="" THEN 250
230 ASSIGN #1 TO F$ @ PRINT #1;B,M,N,Q @ ASSIGN #1 TO *
235 ! 
240 ! Solve problem and display result & statistics
245 ! 
250 OFF ERROR @ FOR I=MAX(1,Q) TO ABS(Q) @ P=1 @ J=0 @ DELAY 0 @ T=TIME
255 CALL FINDMATE(P,J,G,H,B,I,F,M,N,K,98,98,21,21) @ T=INT(TIME-T)
260 BEEP @ IF J THEN DELAY INF,1 @ DISP "Mate in";I;"w/ ";FNP$ @ GOTO 270
265 DELAY 2,0 @ DISP "No mate in";I;"[";STR$(T);'"]' @ NEXT I
270 DISP "Bye" @ DELAY 0,0 @ END 
275 ! 
280 ! Enter piece info into board
285 ! 
290 P=POS(P$,A$[2,2]) @ IF A$[1,1]="-" THEN P=-P
295 C=FNN(A$) @ B(C)=P @ IF P=6 THEN M=C ELSE IF P=-6 THEN N=C
300 RETURN 
305 ! 
310 ! Optionally display board position
315 ! 
320 ON ERROR GOTO 320 @ INPUT "Display board ? ","Y";A$
325 IF UPRC$(A$[1,1])#"Y" THEN RETURN ELSE DELAY 0,0
330 A$="      A  B  C  D  E  F  G  H" @ DISP USING "/,K,/,4X,25'-'";A$
335 FOR I=91 TO 21 STEP -10 @ DISP (I-11)/10;"[ "; @ FOR J=0 TO 7
340 P=B(I+J)*2+13 @ DISP "-k-q-r-b-n-p .+P+N+B+R+Q+K"[P,P+1]&" "; @ NEXT J
345 DISP "]";(I-11)/10 @ NEXT I @ DISP USING "4X,25'-',/,K,/";A$ @ RETURN 
350 ! 
355 ! Ancillary user-defined functions
360 ! 
365 DEF FNM$(N)=CHR$(MOD(N,10)+96)&STR$(N DIV 10-1)
370 DEF FNN(A$)=10*VAL(A$[4])+NUM(A$[3])-54
375 DEF FNP$=P$[B(G),B(G)*(B(G)#1)]&FNM$(G)&FNT$&' ['&STR$(T)&'"]'
380 DEF FNR$="  =N=B=R=Q"[2*K-1,2*K]
385 DEF FNT$="x-"[1+NOT B(H),1+NOT B(H)]&FNM$(H)&FNR$&"++"[1,(Q=1)*2]
390 ! 
395 ! Check legality of input piece data
400 ! 
405 DEF FNL(A$) @ FNL=0 @ IF LEN(A$)#4 THEN END 
410 IF NOT POS("+-",A$[1,1]) OR NOT POS(P$,A$[2,2]) THEN END 
415 IF NOT POS("ABCDEFGH",A$[3,3]) OR NOT POS("12345678",A$[4,4]) THEN END 
420 FNL=1 @ END DEF 
425 ! 
430 ! Data for the moves array and piece representation
435 ! 
440 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8,12,21,19,8,-12,-21
445 DATA -19,-8,4,11,9,-11,-9,0,0,0,0,4,1,10,-1,-10,0,0,0,0,8,1,11
450 DATA 10,9,-1,-11,-10,-9,8,1,11,10,9,-1,-11,-10,-9,"PNBRQK"
455 ! 
460 ! Subprogram to search for mates recursively up to a given depth
465 ! 
470 SUB FINDMATE(P,J,G,H,B(),Q,F(,),M,N,T5,C1,D1,A1,B1) @ INTEGER B2(119)
475 DIM C,T,S,I,L,D,U,A,E,K,W,X,Y,Z,R,R0,J8,W1,W2,H1,F1,N5 @ INTEGER B3(119)
480 IF P#1 THEN H1=A1 @ F1=B1 @ GOTO 505 ELSE N5=0
485 FOR C=21 TO C1 @ T=B(C) @ IF T>=1 AND T<=6 THEN H1=C @ GOTO 495
490 NEXT C
495 FOR A=21 TO D1 @ E=B(A) @ IF E<0 THEN F1=A @ GOTO 505
500 NEXT A
505 MAT B2=B @ J=0 @ W1=0 @ T5=1 @ FOR C=C1 TO H1 STEP -1
510 T=B(C) @ IF T<1 OR T>6 THEN 560
515 IF NOT W1 THEN W1=C
520 IF T=1 THEN 540
525 S=T#6 AND T#2 @ FOR I=1 TO F(T,0) @ L=F(T,I) @ D=C
530 D=D+L @ U=B(D) @ IF U>0 THEN 535 ELSE GOSUB 685 @ IF NOT U AND S THEN 530
535 NEXT I @ GOTO 560
540 D=C+9 @ IF B(D)<0 THEN GOSUB 675
545 D=C+11 @ IF B(D)<0 THEN GOSUB 675
550 D=C+10 @ IF NOT B(D) THEN GOSUB 675 ELSE 560
555 IF C<31 OR C>38 THEN 560 ELSE D=C+20 @ IF NOT B(D) THEN GOSUB 675
560 NEXT C @ END 
565 ! 
570 ! Test if the king is under check
575 ! 
580 DEF FNJ(C,H,K,E,X,V) @ FNJ=1 @ FOR K=1 TO 4 @ E=F(3,K) @ X=H
585 X=X+E @ V=B(X)*C @ IF V=3 OR V=5 THEN END ELSE IF NOT V THEN 585
590 NEXT K @ FOR K=1 TO 4 @ E=F(4,K) @ X=H
595 X=X+E @ V=B(X)*C @ IF V=4 OR V=5 THEN END ELSE IF NOT V THEN 595
600 NEXT K @ IF B(H-9*C)=C THEN END ELSE IF B(H-11*C)=C THEN END ELSE X=2*C
605 IF B(H-12)=X OR B(H-21)=X OR B(H-19)=X OR B(H-8)=X THEN END 
610 IF B(H+12)=X OR B(H+21)=X OR B(H+19)=X OR B(H+8)=X THEN END 
615 IF ABS(M-N)>11 THEN 630 ELSE X=6*C
620 IF B(H-1)=X OR B(H-11)=X OR B(H-10)=X OR B(H-9)=X THEN END 
625 IF B(H+1)=X OR B(H+11)=X OR B(H+10)=X OR B(H+9)=X THEN END 
630 FNJ=0 @ END DEF 
635 ! 
640 ! Local user-defined functions
645 ! 
650 DEF FNP$=FNS$&FNT$&"=N=B=R=Q"[2*T5-3,2*T5-2]&"+"[1,Q=1]
655 DEF FNS$="PNBRQK"[B2(C),B2(C)*(B2(C)#1)]&FNM$(C)
660 DEF FNT$="x-"[1+NOT B2(D),1+NOT B2(D)]&FNM$(D)
665 DEF FNM$(N)=CHR$(MOD(N,10)+96)&STR$(N DIV 10-1)
670 ! 
675 IF D<91 OR D>98 THEN 685
680 FOR T5=5 TO 2 STEP -1 @ T=T5 @ GOSUB 685 @ NEXT T5 @ T5=1 @ RETURN 
685 B(C)=0 @ B(D)=T @ IF T=6 THEN R=M @ M=D
690 IF P=1 THEN G=C @ H=D
695 IF P#Q THEN 700 ELSE IF NOT FNJ(1,N,0,0,0,0) THEN 800
700 IF FNJ(-1,M,0,0,0,0) THEN 800 ELSE N5=N5+1
705 IF P=1 THEN DISP "Try ";STR$(Q);".";STR$(N5);": ";FNP$
710 W1=MAX(W1,D) @ H1=MIN(H1,D) @ MAT B3=B @ J=1 @ J8=1 @ IF P#Q THEN 730
715 A=N @ E=-6 @ W2=A @ FOR W=1 TO 8 @ Y=A+F(6,W) @ Z=B(Y)
720 IF Z#7 AND Z>=0 THEN GOSUB 820
725 NEXT W
730 W2=0 @ FOR A=D1 TO F1 STEP -1 @ E=B(A) @ IF E>-1 THEN 795
735 IF P=Q AND E=-6 THEN 795
740 IF NOT W2 THEN W2=A
745 IF E=-1 THEN 770
750 K=E#-6 AND E#-2 @ FOR W=1 TO F(-E,0) @ X=F(-E,W) @ Y=A
755 Y=Y+X @ Z=B(Y) @ IF Z=7 OR Z<0 THEN 765
760 GOSUB 820 @ IF NOT Z AND K THEN 755
765 NEXT W @ GOTO 795
770 Y=A-9 @ Z=B(Y) @ IF Z>0 AND Z#7 THEN GOSUB 810
775 Y=A-11 @ Z=B(Y) @ IF Z>0 AND Z#7 THEN GOSUB 810
780 Y=A-10 @ IF NOT B(Y) THEN GOSUB 810 ELSE 795
785 IF A<81 OR A>88 THEN 795
790 Y=A-20 @ IF NOT B(Y) THEN GOSUB 810
795 NEXT A @ IF J8 THEN J=FNJ(1,N,0,0,0,0)
800 MAT B=B2 @ IF T=6 THEN M=R
805 IF NOT J THEN RETURN ELSE END 
810 IF Y<21 OR Y>28 THEN 820
815 FOR E5=-5 TO -2 @ E=E5 @ GOSUB 820 @ NEXT E5 @ RETURN 
820 B(A)=0 @ B(Y)=E @ IF E=-6 THEN R0=N @ N=Y
825 IF FNJ(1,N,0,0,0,0) THEN 850
830 W2=MAX(W2,Y) @ F1=MIN(F1,Y) @ J=0 @ J8=0 @ IF P=Q THEN 840
835 CALL FINDMATE(P+1,J,0,0,B,Q,F,M,N,O,W1,W2,H1,F1) @ IF J THEN 850
840 POP @ MAT B=B2 @ IF T=6 THEN M=R
845 IF E=-6 THEN N=R0 @ RETURN ELSE RETURN 
850 MAT B=B3 @ GOTO 845
