ChesSkelet /tseske'let/

; ----------------------------------------------------------------------------- ; CHESSKELET /tseske'let/ ; Alex Garcia (reeagbo), Boria Labs 2018-2019 ; Thanks, @MstrBlinky and @johan_koelman, for your contribution ; Developed with ZXSpin, Notepad++ ; ----------------------------------------------------------------------------- ; Compilation with ZXSpin (all versions) and SpectNetIde (not all versions) ; Run with RANDOMIZE USR 30000 ; ----------------------------------------------------------------------------- ; debug mode: 0 = no, 1 = yes debmod equ 0 ; gramod: 0 = minimal interface, 1 = basic interface, 2 = full interface gramod equ 0 ; feamod: 0 = no features (if fails at legadd 'ret'), 1 = all features feamod equ 0 ; ROM memory addresses clescr equ 3503 laskey equ 23560 ; memory micro-pages (256B, typically H register) used for simple memory access auxsth equ $7D piearh equ $7E movlih equ $7F boasth equ $80 boaath equ $81 boaoph equ $82 canlih equ $83 org 30000 ; code is not directly portable ;------------------------------------------------------------------------------ ; Common code before turns ;------------------------------------------------------------------------------ ; legal moves generation (3B) ----------------------------------------- befmov call genlis ; candidate move list, used for both sides ; switch sides on every loop (6B+1B) ---------------------------------- whomov ld l, h ; (H)L: $7F7F = movlih + gamsta, ++ ld a, (hl) ; load state xor h ; (@johan_koelman) switch turn: bla=0, whi=1 ld (hl), a ; save state back in memory if feamod>0 jp z, blamov else jr z, blamov ; if 0, jump to black moves, jp maybe endif ; clear screen (3B) whimov call clescr ; ROM routine set screen mode ; print board ----------------------------------------------------------------- priboa ; A, B = 0 at this point ; initialization (4B) ld h, boasth ; H(L)= $80, L always 0, load board ++ ld d, piearh ; D(E): piece array pointer, E o/w later priloo ; print colored squares (8B) if gramod>0 ; opt: print colored squares ld a, 19 ; set bright ASCII code rst 16 ; print value ld a, c ; (@MstrBlinky) C is always $21 inc c ; change C parity and %00000001 ; keep Ab0, alternatively 0/1 rst 16 ; print value endif ; print piece (10B) ld a, (hl) ; load piece and %00100000 ; keep color, pih ld b, a ; Bb5: isolate piece color ld e, (hl) ; load piece res 5, e ; uncolor, pih ld a, (de) ; load piece character sub b ; capitalize (-32) only for white pieces rst 16 ; print piece ; next square, end of rank/board detection (15B+1B) inc l ; next square jp m, pricoo ; (@johan_koelman) end of 16x8 board, A=128? ld a, l ; (@MstrBlinky) and $08 ; 8 if end of rank, 0 other cases jr z, priski ; skip if not end of the rank add a, l ; ld l, a ; return result to L ld a, 13 ; A= rst 16 ; print char if gramod>0 ; opt: print colored squares, end of the rank inc c ; change C parity endif priski jr priloo ; loop through all squares ; print coords (28B+6B)-------------------------------------------------------- pricoo ; (@MstrBlinky simplified it) if gramod>0 ; opt: print board coords ld bc, $0709 ; B: loop count, C: fixed rank/col nextce ld a, $16 ; ASCII control code for AT rst 16 ; print it ld a, b ; set rank rst 16 ; print it ld a, c ; set column rst 16 ; print it ld a, '8' ; base rank sub b ; decrease rank character (8..1) rst 16 ; print rank value ld a, $16 ; ASCII control code for AT rst 16 ; print it ld a, c ; set rank rst 16 ; print it ld a, b ; sets column rst 16 ; print it ld a, 'a' ; base column character add a, b ; increase rank character (a..h) rst 16 ; print rank value dec b ; loop 8 times jp p, nextce ; endif if gramod>0 ; opt: + "?" for input prompt ld a, 13 ; A: set ASCII code rst 16 ; prints it to go to the next line for input ld a, '?' ; set "?" ASCII code rst 16 ; print it endif ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; WHITE MOVES ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; read chars from keyboard and stores them (16B(+4B+4B))----------------------- ; 4 times loop for coord input (3B) ld b, 4 ; loop count dec d ; D(E)= $7D =auxsth, E always 0 ++ ; read key from keyboard loop (8B) realoo ld hl, laskey ; LASTKEY system variable ++ xor a ; A=0 ld (hl), a ; reset LASTKEY, two birds with 1 stone wailoo add a, (hl) ; load latest value of LASTKEY. jr z, wailoo ; loop until a key is pressed. ; skip move/switch sides (4B) if feamod>0 ; opt: special move, switch sides to play black cp 's' ; if "s" pressed at any time jp z, aftmov ; skip white's move, ### jr maybe endif ; save pressed key and print it (5B) inc de ; (@MstrBlinky) next char, E = 1 to 5 ld (de), a ; save char in string rst 16 ; print it djnz realoo ; loop for 4 input chars ; border reset (4B) if gramod>1 ; opt: border reset after first white move ld a, 7 ; set back to white out (254), a ; set border back to white endif ; translate coords to square (17B) -------------------------------------------- movchk ex de, hl ; (@MstrBlinky routine) DE=end of input string movloo ld a, 56 ; rank calc = 8-(rank input-48) = 56-(HL) sub (hl) ; A= 56 - (HL) rla ; move it to high nibble (x16) rla ; rla ; rla ; dec hl ; (@MstrBlinky) run backwards through string add a, (hl) ; rank + column (not 0-7 column) sub 'a' ; make it a 0-7 column ld c, b ; slide results through B and C ld b, a ; at end of 2nd loop everything is in place dec l ; (@MstrBlinky) beginning of input string? jr nz, movloo ; if not, loop again ; search white move in legal move list (24B) ---------------------------------- if feamod>0 ; opt: validate white move seamov ld hl, canlis ; canli pointer ++ ld a, (hl) ; number of candidates ;inc hl ; skip to first candidate (+2 bytes) ;inc hl ; removed v0.808, no move in those two bytes sealoo ld d, (hl) ; origin candidate move inc hl ; next byte ld e, (hl) ; target candidate move inc hl ; next byte, for next loop ex de, hl ; candidate pair, DE: HL-canli pointer or a ; reset carry sbc hl, bc ; compare input move with cand. move (Z) ex de, hl ; revert back, canli pointer jr z, aftsid ; move match: jump out. ready to move ; B (origin sq), C (target sq) ready here dec a ; count down jr nz, sealoo ; loop until canli covered jp whimov ; if not found, back to move input, jp maybe else ; opt: skip validate white move jr aftsid ; Outputs: B: origin square, C: target square endif ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; BLACK MOVES ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- blamov chomov ; preparations (7B)---------------------------------------------------- ld hl, canlis ; candidate list. No H reuse ++ ld b, (hl) ; number of candidates at position 0 ld c, l ; C=0, maximum valuation reset inc hl ; skip 2 bytes to first candidate in list inc hl ; choloo ; loop through candidates (6B) ---------------------------------------- ld d, (hl) ; D: origin candidate square inc hl ; next candidate byte ld e, (hl) ; E: target candidate square inc hl ; next candidate byte push bc ; BC released push hl ; HL is different from here ; pieces valuation ---------------------------------------------------- ; pieces collection (8B) evatap ld h, boasth ; board base ++ ld l, e ; target square ld b, (hl) ; black piece value ld l, d ; origin square ld c, (hl) ; white piece value res 5, c ; uncolor white piece; pih ; origin attacked square (7B) evaato ld a, b ; target piece always counts ld h, boaoph ; H(L): attacked board base, L: unchanged ++ bit 7, (hl) ; target square attacked? jr z, evaatt ; not attacked, skip counting origin piece if feamod=1 ; opt: rows 2 do not move even if attacked ld a, d ; 0rrr0ccc, add origin square and $70 ; filter ranks cp $60 ; is rank 6? ld a, b ; target piece always counts jr z, evaexi ; skip this move endif ; count origin piece (1B) if attacked, general case evaatc add a, c ; A: 00pppppp, count white ; target attacked square (6B) evaatt ld l, e ; H(L): point at target square bit 7, (hl) ; target square attacked? jr z, skiato ; if target not attacked, skip sub c ; if target attacked, count white out ; compensate + prioritize piece valuation(6B) skiato ld h, $20 ; prepare H for later rotation and use for A add a, h ; A: 00pppppp, compensate=K+1, pih rlca ; leave space for square weight rlca ; A: pppppp00, piece addition is 5 bits ld b, a ; B: piece addition value evacol ld a, e ; A: 0rrr0ccc ; these two values below can be tuned for different opening schemes if feamod>0 add a, 2 ; A: 0rrr0ccc and 5 ; A: 00000ccc else inc a ; A: 0rrr0ccc and 4 ; A: 00000cc0 (weight: 0,0,0,4,4,4,4,0) endif ; ranks weight (ranks weight is 8..1, aiming for board's end) evarnk add hl, hl ; HL: 00100000 0rrr0ccc (before) add hl, hl ; add hl, hl ; HL: 000000rr r0ccc000 (after) sub h ; A: 00000cww (w=r+c) add a, b ; total value: pieces + weight ; maximum value comparison (12B) evaexi pop hl ; recover canli pop bc ; recover previous maximum value cp c ; compare with current maximum jr c, chonoc ; if current eval (A) <= max eval (C), skip ld c, a ; update best evaluation pop af ; remove old maximum to avoid cascades in stack ; ### initial push to compensate? push de ; push best candidates so far chonoc dec b ; decrease loop counter 2 by 2. djnz choloo ; loop through all candidates (canto) pop bc ; recover saved values (B: origin, C: target) ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; AFTER SIDES ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; move piece (8B) ------------------------------------------------------------- ; inputs here: B: origin square, C: target square ; write origin square and read piece in it (4B) aftsid ld h, boasth ; point at board (canlih=$83 before) ++ ld l, b ; point at origin square ; castling, rook moves, v0.800 (26B) ; very innacurate as it may cause false moves if feamod>0 ; opt: castling, rook move casroo ld a, (hl) ; origin piece add a, b ; + origin square sub c ; - target square caslon cp $38 ; $36(king) + $74(ori) - $72(tar)= $38, pih jr nz, cassho ; no long castling ld l, $70 ; long castling rook square (a1) ld (hl), d ; erase rook (D=0 here) ld l, $73 ; rook destination (d1) ld (hl), $25 ; move rook, pih cassho cp $34 ; $36(king) + $74(ori) - $76(tar)= $34, pih jr nz, casend ; no short castling ld l, $77 ; short castling rook square (h1) ld (hl), d ; erase rook (D=0 here) ld l, $75 ; rook destination (f1) ld (hl), $25 ; move rook, pih casend endif if feamod>0 ; opt: special move: prom, no under-prom (12B) ld a, c ; A: 0rrr0ccc and %01110000 ; A: 0rrr0000 add a, (hl) ; A: 0rrxpppp cp $22 ; white pawn ($22) on rank 8 ($00), pih ld l, b ; restore origin square ld d, (hl) ; original piece ld (hl), 0 ; write origin piece jr nz, aftdes ; if not a pawn, skip ld d, $27 ; make piece a queen, pih else ; opt: write origin piece, no promotion (3B) ld d, (hl) ; D: get origin piece ld (hl), 0 ; write origin piece endif ; write target square with origin piece (5B) aftdes ld l, c ; (H)L: target square ; checkmate with exit (3B), board is not updated in screen chkmat bit 4, (hl) ; captured piece is king ($16)?, pih ret nz ; (@johan_koelman) return prompt at check mate aftnok ld (hl), d ; write target square call genlis ; update attacked matrix after move aftmov ; reverse board (22B)---------------------------------------------------------- revboa ; push full board to stack (7B) inc h ; H = $80 = boasth ++ ld l, h ; (H)L: end of board. trick: start from $8080 revlo1 dec l ; countdown squares ld a, (hl) ; read piece push af ; copy piece to to stack jr nz, revlo1 ; loop down to beginning of the board ; collect board back ir reverse order + switch color (15B) ld l, $78 ; (H)L: end of board again revlo2 pop af ; collect piece from stack or a ; is it an empty square? jr z, revski ; if yes, skip xor %00100000 ; otherwise, reverse color (b5), pih revski dec l ; countdown squares ld (hl), a ; piece back into board jr nz, revlo2 ; loop until beginning of board jp befmov ; back to white move, too far for jr ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; AUXILIARY ROUTINES ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; genlis: generates list of legal moves (92B + 9B) ---------------------------- ; it was not possible to use it in two different places, only procedure in code genlis bacata ; backup attack board in reverse order, used in evaluation (13B) ld l, $FF ; (H)L = $80FF (boaata-1), H always $80 ld de, boaopo + $78 ; DE: same thing, 1B passed end of board bacloo inc hl ; HL: increase 16b counter to hop to next page dec e ; E: decrease 8b counter to hit Z flag ld a, (hl) ; load attack status ld (hl), 0 ; clear attack status, no alternative! ld (de), a ; backup attack status jr nz, bacloo ; loop down to square $00 ; exit values: DE=$8200, HL=$8177 ; prepare environment (4B) inc d ; D= $83= canlih xor a ; reset ld (de), a ; cantot= 0 ld b, l ; B= L = 77, SQUARE COUNT ; read piece from board (4B) squloo ld h, boasth ; H: board base ++ ld l, b ; point at current loop square ld a, (hl) ; read piece from board ; king castling, v0.800 (15B) ; only basic rule: no unmoved pieces or attacked squares check if feamod>0 kincas ld l, a ; save A (can't use push AF, flags lost) add a, b ; A: 0rrr0xxx + 000ppppp (uncolored white p.) cp $AA ; king($36) at E1($74)= $AA, pih ld a, l ; recover A jr nz, kinend ; if no match, skip adding legal move ld c, $72 ; E1-C1 move, rook's move missing call legadd ; add king's move ld c, $76 ; E1-G1 move, rook's move missing call legadd ; add king's move and go on with king's moves kinend endif ; get move type and pointer to move list (6B) squgon dec h ; H(L)= movlih, moves vector base ++ add a, a ; x4, each piece vector is 4B long add a, a ; ld l, a ; (H)L points at the move vector now ld d, 2 ; 2 submoves per piece subloo ; byte 1 - move type (5B) ld a, (hl) ; move type loaded or a ; =cp 0, 2nd move type not used case ; black/empty: move type=0 leads here jr z, squexi ; ---v exit: square is done ld e, a ; E: MOVE TYPE (B,C,D used here) ; pawn 2 squares forward - move type modified (8B) if feamod>0 ; opt: special move, pawn 2 sq. forward genpw2 add a, b ; piece square + move type and %11111000 ; masked with relevant bits cp $88 ; $28(str.pawn)+$60(rnk 6) ### univocal jr nz, skppw2 ; if not, skip inc e ; increase radius: 1 -> 2 skppw2 endif ; byte 2 - movlis delta (3B) inc hl ; next piece sub-entry push hl ; Save HL for 2nd loop ld l, (hl) ; pointer to move delta vecloo ; vector read (8B) ld c, b ; TARGET SQUARE init ld a, (hl) ; vector delta or a ; =cp 0 jr z, vecexi ; ---v exit: vectors end with 0, next sq. push hl ; save current delta push de ; save move type + radius ; E: variable radius within loop ld d, a ; D: store delta within loop celloo ; prepare x88 check (7B) ld a, d ; delta loaded add a, c ; current target (sq. + delta) ld c, a ; current target and $88 ; 0x88, famous OOB trick jr nz, vecnex ; ---v exit: OOB, next vector ; read target square (3B) inc h ; H(L)= $80 = boasth ++ ld l, c ; point at target square ld a, (hl) ; read target square content ; mark attacked ### str. pawn marked attacked inc h ; H(L)= $81 = boaath ++ ld (hl), h ; mark attacked ($81) dec h ; H(L)= $80 = boasth ++ dec h ; H(L)= $79= movlih ++ ; target is white (4B) bit 5, a ; is it white?, pih jr nz, vecnex ; ---v exit: WHITE b4=1, next vector ; target not white (3B) or a ; =cp 0, is it empty?, pih jr z, taremp ; if not 0, it's black: legal, no go on tarbla ; target is black (7B) bit 5, e ; special move: pawn straight check jr nz, vecnex ; ---v exit: no straight capture, next vector ld e, a ; make radius=0 (=<8 in code, canonical: ld e, 0) jr legadj ; taremp ; target is empty (14B) bit 4, e ; special move: pawn on capture check jr nz, vecnex ; ---v exit: no diagonal without capture, next vector dec e ; decrease radius legadj if feamod=0 ; opt: legadd for basic model ; add candidate (B: current square, C: target square) (9B) push hl ld hl, canlis ; HL: start of candidate list. No H reuse ++ inc (hl) ; +2 to candidate counter to move to next inc (hl) ; first free position in list ld l, (hl) ; point at free position ld (hl), b ; 1) save origin square inc hl ; move to next byte ld (hl), c ; 2) save dest square legend pop hl ; recover HL=pointer to vector list else ; opt: legadd call for full model call legadd endif bit 3, e ; if radius < 8 (Cb3=0), radius limit jr nz, celloo ; ---^ cell loop vecnex ; next vector preparation (5B) pop de ; DE: recover move type + radius pop hl ; HL: recover current vector inc hl ; HL: next vector jr vecloo ; ---^ vector loop vecexi ; next square preparation (5B) pop hl ; HL: recover pointer to sub-move list inc hl ; HL: next byte, point at 2nd sub-move dec d ; 2 sub-move iterations loop control jr nz, subloo ; if not 2nd iteration, repeat loop ; end of loop (2B) squexi djnz squloo ; ---^ squares loop ret ; legadd: add legal move ------------------------------------------------------- if feamod>0 ; legadd for king castling legadd ; (B: current square, C: target square) push hl ld hl, canlis ; HL: start of candidate list. No H reuse ++ inc (hl) ; +2 to candidate counter to move to next inc (hl) ; first free position in list ld l, (hl) ; point at free position ld (hl), b ; 1) save origin square inc hl ; move to next byte ld (hl), c ; 2) save dest square pop hl ; recover HL=pointer to vector list ;ret ; <===== not removed with feamod=0 endif ; ----------------------------------------------------------------------------- ; DATA ------------------------------------------------------------------------ ; ----------------------------------------------------------------------------- ; Memory page: 7700h ---------------------------------------------------------- org $7700 auxstr ; input string stored here ; Memory page: 7E00h ---------------------------------------------------------- ; used to convert values to pieces org $7E00 if gramod=0 ; opt: space or dot depending on the size piearr defb '.' ; $2B else piearr defb ' ' endif org $7E02 defm "pnbr" ; change this array to any language, pih org $7E07 defb 'q' ; change this array to any language, pih org $7E16 defb 'k' ; change this array to any language, pih ; Memory page: 7F00h ---------------------------------------------------------- ; sub-moves and vectors org $7F00 ; leave empty $00-$04-...-$24 for black pieces/empty square pointers org $7F88 ; pawn: $22x4=$84 ; piece, move type, vector list delta address (18B) ; move type / 0 / 0 / pawn straight / pawn diagonal / DDDD (real radius + 7) movlis pawgen defb $28, $E3 ; pawn straight defb $18, $E7 ; pawn capture org $7F8C knigen defb $08, $EA ; org $7F90 bisgen defb $0E, $E5 ; bishop org $7F94 roogen defb $0E, $E0 ; rook org $7F9C quegen defb $0E, $E0 ; queen defb $0E, $E5 ; org $7FD8 kingen defb $08, $E0 ; king: $($16+$20)x4=$D8 defb $08, $E5 ; org $7FE0 ; vectors start at: $7FE0 (arbitrary) ; (y, x) move delta pairs (16B) veclis strvec defb $FF, $01 ; +0, straight vectors defb $10, $F0 ; +3, straight pawn, last half line org $7FE5 diavec defb $0F, $11 ; +5, diagonal vectors defb $EF, $F1 ; +7, diagonal pawn org $7FEA knivec defb $E1, $F2 ; +10, knight vectors defb $12, $21 ; knight moves listed clockwise defb $1F, $0E ; defb $EE, $DF ; ; board status: 0000000 / turn (B=0, W=1) org $7F7F gamsta ; Memory page: 8000h ---------------------------------------------------------- ; board squares format: 00cppppp ; pppp (value) : pawn=2, knight=3, bishop=4, rook=5, queen=7, king=$16 ; c (color): white=1, black=0 ; initial board setup if debmod=1 ;opt: fill board for debugging org $8000 boasta defb $00, $00, $00, $00, $00, $00, $00, $00 ; <--8 defb $00, $00, $00, $00, $00, $00, $00, $00 defb $00, $00, $00, $00, $02, $00, $00, $00 ; <--7 defb $00, $00, $00, $00, $00, $00, $00, $00 defb $00, $00, $00, $23, $00, $00, $00, $00 ; <--6 defb $00, $00, $00, $00, $00, $00, $00, $00 defb $00, $00, $00, $00, $00, $00, $00, $00 ; <--5 defb $00, $00, $00, $00, $00, $00, $00, $00 defb $00, $00, $00, $00, $00, $00, $00, $00 ; <--4 defb $00, $00, $00, $00, $00, $00, $00, $00 defb $00, $00, $00, $00, $00, $00, $00, $00 ; <--3 defb $00, $00, $00, $00, $00, $00, $00, $00 defb $00, $00, $00, $00, $00, $00, $00, $00 ; <--2 defb $00, $00, $00, $00, $00, $00, $00, $00 defb $00, $00, $00, $00, $00, $00, $00, $00 ; <--1 else ; opt: reduces board size for gameplay org $8000 boasta defb $05, $03, $04, $07, $16, $04, $03, $05 org $8010 defb $02, $02, $02, $02, $02, $02, $02, $02 org $8060 defb $22, $22, $22, $22, $22, $22, $22, $22 org $8070 defb $25, $23, $24, $27, $36, $24, $23, $25 endif ; Memory page: 8100h ---------------------------------------------------------- org $8100 boaata ; attacked squares board ; Memory page: 8200h ---------------------------------------------------------- org $8200 boaopo ; reversed attacked squares board ; Memory page: 8300h ---------------------------------------------------------- ; candidate move list at the very end of the program org $8300 canlis equ $