ChesSkelet /tseske'let/

; ----------------------------------------------------------------------------- ; CHESSKELET /tseske'let/ ; Alex Garcia (reeagbo), Boria Labs 2018-2019 ; Developed with ZXSpin, Notepad++ ; Thanks to J. Koelman for his coding optimization ; ----------------------------------------------------------------------------- ; Compilation with ZXSpin (all versions) and SpectNetIde (not all versions) ; Run with PRINT USR 30000 (J. Koelman) ; ----------------------------------------------------------------------------- ; debug mode: 0 = no, 1 = yes debmod equ 0 ; size mode: ; gramod: 0 = minimal interface, 1 = basic interface, 2 = full interface ; plamod: 0 = no attacked check, 1 = +attacked check, 2 = +square weight ; feamod: 0 = no features, 1 = all features gramod equ 2 plamod equ 2 feamod equ 1 ; ROM memory addresses clescr equ 3503 chaope equ 5633 laskey equ 23560 ; memory micro-pages (256B, typically H register) used for simple memory access auxsth equ $77 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 ; (J. Koelman) switch turn: black=0, white=1 ld (hl), a ; save state back in memory if gramod>1 jp z, blamov else jr z, blamov ; if 0, jump to black moves, jp maybe endif ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; WHITE MOVES ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- whimov call clescr ; board refresh before white move ; print board ----------------------------------------------------------------- priboa ; A, B = 0 at this point ; prints board pieces from memory board (32B+12B) --------------------- pripie if gramod>0 ; opt: print colored squares ld c, a ; C=0, paper color control endif ld h, boasth ; H(L)= $80, L always 0 here, load board ++ ld d, piearh ; D(E): piece array pointer, E o/w later priloo if gramod>0 ; opt: print colored squares ld a, 19 ; set paper ASCII code rst 16 ; print value ld a, c ; set paper color xor %00000001 ; reverse bit 0 to reverse color ld c, a ; reversed paper rst 16 ; print value endif ; print piece (8B) ld e, (hl) ; read piece value from board bit 4, e ; is it white? res 4, e ; uncolor the piece, b4=0 ld a, (de) ; load figure from figure array jr z, pricon ; if black, skip (empty square covered) sub 32 ; white: subtract 32 to capitalize white pieces pricon rst 16 ; print piece inc l ; next square jp m, pricoo ; (J. Koelman) end of 16x8 board? bit 3, l ; end of rank? jr z, priski ; skip if not end of the rank ld a, l ; skip to next rank (next 2 lines) add a, 8 ; end of the rank, skip 8 empty bytes (16x10) 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 ld a, c ; load paper color xor %00000001 ; reverse color (b0) ld c, a ; save reversed paper color endif priski jr priloo ; loop through all squares ; print coords (34B)--------------------------------------------------- pricoo if gramod>1 ; opt: print board coords ld bc, $0809 ; B: loop count, ranks/cols, C: fixed rank/col ld d, 22 ; "PRINT AT" ASCII code ld hl, $6831 ; H="h", L= "1", sliding characters ++ nextce dec b ; decrease col/rank ld a, d ; 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, l ; load char in register rst 16 ; print rank value ld a, d ; 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, h ; load char in register rst 16 ; print rank value dec h ; decrements letters inc l ; increments numbers ld a, b ; check if B=0, can't do djnz (0 needed) or a ; =cp 0 jr nz, nextce ; if col=8, it's over endif if gramod>1 ; 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 ; read chars from keyboard and stores them (18B(+4B+4B))----------------------- ; 4 times loop for coord input (4B) ld b, 4 ; loop count ld d, auxsth ; D(E)= auxstr, E is always 0. ; read key from keyboard loop (8B) realoo ld hl, laskey ; LASTKEY system variable ++ xor a ; A=0 ld (hl), a ; reset LASTKEY content, 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, jp maybe endif ; save pressed key and print it (5B) ld (de), a ; save char in string rst 16 ; print it inc de ; move to next char in string 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 (21B) -------------------------------------------- movchk push de ; (J. Koelman's idea) pop hl ; recover end of input string movloo dec hl ; run backwards through string (1/2) ld a, 56 ; rank calc = 8-(A-48) = 56-(HL) sub (hl) ; rla ; move it to high nibble (x16) rla ; rla ; rla ; dec hl ; run backwards (2/2) add a, (hl) ; rank + column (not 0-7 col) sub 'a' ; make it a 0-7 col ld c, b ; slide results through B and C ld b, a ; at end of 2nd loop everything is in place ld a, l ; check beginning of input string or a ; L=0? 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 ; 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 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 ; ld e, (hl) ; E: target candidate square inc hl ; push bc ; BC released push hl ; HL is different from here ; pieces valuation ---------------------------------------------------- ; pieces collection (10B) evatap ld h, boasth ; board base ++ if plamod>0 ; opt: attacked square valuation ld l, e ; target square ld b, (hl) ; black piece value ld l, d ; origin square ld c, (hl) ; white piece value res 4, c ; uncolor white piece ld a, $06 ; low nibble: +6 to avoid negative piece values ; ### worst case (att. K cap. Q) overflows ; attacked squares valuation ------------------------------------------ ; ORIGIN attacked square (7B), basic king check escape evaato ld h, boaoph ; H(L): attacked board base, L: unchanged ++ bit 0, (hl) ; origin square attacked? jr z, evaatt ; if origin not attacked, skip add a, c ; if origin attacked, count white in ; TARGET attacked square (6B) evaatt ld l, e ; H(L): point at target square bit 0, (hl) ; target square attacked? jr z, skiato ; if target not attacked, skip sub c ; if target attacked, count white out ; sum origin and target pieces (attacked state) + prioritize (6B) skiato add a, b ; white piece (+/-) + B: black piece (capture) rlca ; piece value x16, space for square weight rlca ; worst case: K captures attacked K, not real rlca ; rlca ; ld b, a ; B: PIECES value else ; opt: basic (crazy) piece valuation (4B) ld l, e ; point at target square ld a, (hl) ; A: load target piece ld l, d ; point at source square sub (hl) ; target - origin piece endif if plamod>1 ; opt: weighted square value. ### Uncomment RRAs ; TARGET square weight (13B) evacol ld a, e ; A: target square ;add a, $03 ; prioritize center columns !!!! move this ;and %00000110 ; prioritize center columns, keep b1, b2. ;add a, $08 ; compensate negative from rank add a, $0B ; lines equivalent to: +3, AND %08, +8. and $0E ; evarnk sra l ; L not used in this iteration anymore sra l ; shift right x4 to get column value sra l ; ;sra l ; commented in v0.701 to enforce rank promotion sub l ; discount column, value is reverse to priority ; A: SQUARE WEIGHT value add a, b ; total value: pieces + weight endif ; ** 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) ; end of the candidates loop ------------------------------------------ pop bc ; recover saved values (B: origin, C: target) ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; AFTER SIDES ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; Inputs here: B: origin square, C: target square ; move piece (8B) ------------------------------------------------------------- ; write origin square and read piece in it (3B) aftsid ld h, boasth ; point at board ++ ld l, b ; point at origin square if feamod>0 ; opt: special move: prom, no under-prom (13B) ld a, c ; target square and %01110000 ; target square rank add a, (hl) ; target square rank + origin piece cp $11 ; white pawn on rank 8 ld d, (hl) ; original piece ld (hl), 0 ; write origin piece jr nz, aftdes ; if not a pawn, skip ld d, $15 ; make piece a queen else ; opt: write origin piece, no promotion ld d, (hl) ; D: get origin piece ld (hl), 0 ; write origin piece endif ; write target square with origin piece (9B) aftdes ld l, c ; (H)L: target square if feamod>1 ; opt: special move, checkmate + re-game (10B) ld a, (hl) ; A: target piece cp $06 ; is it a king? (it's always black) jr nz, aftnok ; if not, skip mate out (254), a ; set border color to 6 (yellow) jr iniboa ; reinitialize game ; ### board reconstruction missing else ; opt: special move, checkmate with exit (4B) ld a, (hl) ; A: target piece cp $06 ; capture is it a black king? (always black) ;jr nz, aftnok ; skip if not ;ret ; returns prompt, failing due to stack issues ret z ; (J. Koelman) return prompt at check mate endif aftnok ld (hl), d ; write target square call genlis ; update attacked after move and reverse board aftmov ; reverse board (22B)---------------------------------------------------------- if plamod>0 ; opt: reverse board 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 until beginning of board reached ; 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 %00010000 ; otherwise, reverse color revski dec l ; countdown squares ld (hl), a ; piece back into board jr nz, revlo2 ; loop until beginning of board endif 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 if plamod>0 ; opt: clear and reverse attack board bacata ; ** backup attack board in reverse order, used in evaluation (13B) ld l, $FF ; (H)L = $80FF (boaata-1), H is 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 endif ; ** prepare environment (6B) xor a ; A=0, ### only with plamo>0 ld (canlis), a ; cantot= E = 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 ; ** get move type and pointer to move list (6B) 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 too jr z, squexi ; ---v exit: square is done ld e, a ; E: MOVE TYPE (B,C,D used at this point) ; ** pawn 2 squares forward - move type modified (9B) if feamod>0 ; opt: special move, pawn 2 squares forward genpw2 ld a, e ; move type loaded add a, b ; piece square + move type and %11100000 ; masked with relevant bits cp $80 ; $20 (straight pawn) + $60 (rank 6) ### univocal jr nz, skppw2 ; if not, skip inc e ; increase reach: 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: all vectors end up with 0, next square push hl ; save current delta push de ; save move type + reach ; E: variable reach 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 ; using the 0x88 famous OOB trick jr nz, vecnex ; ---v exit: OOB (bits 7/3 <> 0), 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 ; ### not totally accurate as straight pawn move is marked attacked if plamod>0 ; opt: mark attacked squares inc h ; H(L)= $81 = boaath ++ ld (hl), h ; mark as attacked, Hb0=1 (originally ld(hl),1) dec h ; H(L)= $80 = boasth ++ endif dec h ; H(L)= $79= movlih ++ ; ** target is white (4B) bit 4, a ; is it white? jr nz, vecnex ; ---v exit: it's WHITE: b4=1=white, next vector ; ** target not white (3B) or a ; =cp 0, is it empty? 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 reach=0 (=<8 in code, canonical: ld e, 0) jr legadd 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 reach legadd ; ** 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 bit 3, e ; if reach < 8 (Cb3=0), reach limit jr nz, celloo ; ---^ cell loop vecnex ; ** next vector preparation (5B) pop de ; DE: recover move type + reach 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 (3B) squexi djnz squloo ; ---^ squares loop ret ; ----------------------------------------------------------------------------- ; variables ------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; misc ------------------------------------------------------------------------ org $7700 auxstr ; used to convert values to pieces -------------------------------------------- org $7E00 ; Values: 0123456 if gramod<1 ; opt: space or dot depending on the size piearr defb '.' ;$2B else piearr defb ' ' endif defm "pnbrqk" ; change this array to any language ; board status: 0000000 / turn (B=0, W=1) ;gamsta ; sub-moves and vectors ------------------------------------------------------- org $7F00 ; leave empty $00-$04-...-$24 for black pieces/empty square pointers org $7F44 ; pawn: 17x4= 68B displacement ; piece, move type, vector list delta address (18B) ; move type / 0 / 0 / pawn straight / pawn diagonal / DDDD (real reach + 7) movlis pawgen defb $28, 103 ; pawn straight defb $18, 107 ; pawn capture knigen defb $08, 110 ;defb $00, 0 org $7F4C bisgen defb $0E, 105 ;defb $00, 0 ; empty org $7F50 roogen defb $0E, 100 ;defb $00, 0 ; empty org $7F54 quegen defb $0E, 100 defb $0E, 105 kingen defb $08, 100 defb $08, 105 org $7F64 ; vectors: $7F + 100 (arbitrary) ; (y, x) pairs (16B) veclis strvec defb $FF, $01 ; +0, straight vectors defb $10, $F0 ; +3, straight pawn, last half line org $7F69 diavec defb $0F, $11 ; +5, diagonal vectors defb $EF, $F1 ; +7, diagonal pawn org $7F6E knivec defb $E1, $F2 ; +10, knight vectors defb $12, $21 ; knight listed clockwise defb $1F, $0E defb $EE, $DF org $7F7F gamsta ; board squares format: 000 / Co / VVVV ; VVVV (value) : pawn=1, knight=2, bishop=3, rook=4, queen=5, king=6 ; Co (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, $00, $00, $00, $01 ; <--7 defb $00, $00, $00, $00, $00, $00, $00, $00 defb $00, $00, $00, $00, $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, $01, $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 $11, $00, $00, $00, $00, $11, $11, $11 ; <--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 $04, $02, $03, $05, $06, $03, $02, $04 org $8010 defb $01, $01, $01, $01, $01, $01, $01, $01 org $8060 defb $11, $11, $11, $11, $11, $11, $11, $11 org $8070 defb $14, $12, $13, $15, $16, $13, $12, $14 endif org $8100 boaata org $8200 boaopo ; candidate move list at the very end of the program -------------------------- org $8300 canlis equ $