computer_player.asm (21105B)
1 ;;; Copyright 2021 Gerd Beuster (gerd@frombelow.net). This is free 2 ;;; software under the GNU GPL v3 license or any later version. See 3 ;;; COPYING in the root directory for details. 4 5 ;;; ************************************************ 6 ;;; 7 ;;; Random Computer Player 8 ;;; 9 ;;; ************************************************ 10 computer_random_init: 11 rts 12 computer_random_ply: 13 pha ; Remember who we are 14 jsr print_board 15 pla 16 computer_random_ply_no_printing: 17 ;; Second entry point in case we just want 18 ;; to make a random move without printing 19 ;; the board first 20 .block 21 pha 22 ;; We need a random number 23 ;; in the range 0..8. For 24 ;; this, we update the lfsr 25 ;; and take the lowest 26 ;; nibble until it is <= 8. 27 ;; BUG: Looks like we never get 0. 28 get_random: 29 jsr lfsr.step 30 lda lfsr.state 31 and #$0f 32 cmp #$09 33 bcs get_random 34 ;; Check if field is occupied 35 sta tmp 36 tax 37 jsr get_field 38 cmp #piece_none 39 bne get_random 40 ;; Occupy field 41 ldx tmp 42 pla 43 jsr set_field 44 clc 45 rts 46 .bend 47 48 ;;; ************************************************ 49 ;;; 50 ;;; Perfect Computer Player 51 ;;; 52 ;;; ************************************************ 53 54 ;;; See http://csjarchive.cogsci.rpi.edu/1993v17/i04/p0531p0561/MAIN.PDF 55 computer_perfect_init: 56 rts 57 computer_perfect_ply: 58 .block 59 pha 60 jsr print_board 61 pla 62 pha 63 ;; Random First 64 ;; Added by gb: Start with a random move on an empty field in 65 ;; order to create different games 66 jsr random_first 67 pla 68 bcc done 69 ;; Win 70 ;; If there is a row, column, or diagonal with two of my pieces 71 ;; and a blank space, 72 ;; Then play the blank space (thus winning the game). 73 pha 74 jsr win 75 pla 76 bcc execute_ply 77 ;; Block 78 ;; If there Is a row, column, or diagonal with two of my 79 ;; opponent's pieces and a blank space, 80 ;; Then play the blank space (thus blocking a potential win for 81 ;; my opponent). 82 pha 83 jsr block 84 pla 85 bcc execute_ply 86 ;; Fork 87 ;; If there are two intersecting rows, columns, or diagonals 88 ;; with one of my pieces and two blanks, and 89 ;; If the intersecting space Is empty, 90 ;; Then move to the intersecting space (thus creating two 91 ;; ways to win on my next turn). 92 pha 93 jsr fork 94 pla 95 bcc execute_ply 96 ;; Block Fork 97 ;; If there are two intersecting rows, columns, or diagonals 98 ;; with one of my opponent’s pieces ond two blanks, and 99 ;; If the intersecting space is empty, 100 ;; Then 101 ;; If there is an empty location that creates a 102 ;; two-in-a-row for me (thus forcing my opponent to 103 ;; block rather than fork), 104 ;; Then move to the location. 105 ;; Else move to the Intersection space (thus occupying 106 ;; the location that my opponent could use to fork). 107 pha 108 jsr block_fork 109 pla 110 bcc execute_ply 111 ;; Play Center 112 ;; If the center is blank, 113 ;; Then play the center. 114 pha 115 jsr play_center 116 pla 117 bcc execute_ply 118 ;; Play Opposite Corner 119 ;; If my opponent is in a corner, and 120 ;; If the opposite corner is empty, 121 ;; Then play the opposite corner. 122 pha 123 jsr play_opposite_corner 124 pla 125 bcc execute_ply 126 ;; Play Empty Corner 127 ;; If there is an empty corner, 128 ;; Then move to an empty corner. 129 pha 130 jsr play_empty_corner 131 pla 132 bcc execute_ply 133 ;; Play Empty Side 134 ;; If there is an empty side, 135 ;; Then move to an empty side. 136 pha 137 jsr play_empty_side 138 pla 139 bcc execute_ply 140 ;; No rule left; this should not happen. 141 #io.PRINTSNL 'Error' 142 error: 143 jmp error 144 execute_ply: 145 jsr set_field_x_y 146 done: 147 rts 148 .bend 149 150 random_first: 151 .block 152 sta tmp ; Remember who I am 153 cmp #piece_x ; If we are x 154 bne not_first ; 155 ldy #$00 156 row_loop: 157 lda main_board,y ; Check if 158 bne not_first ; all 159 iny ; rows 160 cpy #$03 ; are 161 bne row_loop ; empty 162 lda tmp 163 jmp computer_random_ply_no_printing 164 not_first: 165 sec 166 rts 167 .bend 168 169 win: 170 .block 171 pha 172 jsr win_row 173 pla 174 bcc done 175 pha 176 jsr win_column 177 pla 178 bcc done 179 pha 180 jsr win_first_diagonal 181 pla 182 bcc done 183 pha 184 jsr win_second_diagonal 185 pla 186 done: 187 rts 188 .bend 189 190 win_row: 191 .block 192 ;; Load complete winning row 193 cmp #piece_x 194 bne this_is_o 195 lda #piece_x_row 196 jmp win_row_set 197 this_is_o: 198 lda #piece_o_row 199 win_row_set: 200 sta tmp ; Store win row 201 ldy #$00 ; Row counter 202 row_loop: 203 ldx #$00 ; Column counter 204 lda tmp 205 and #%00111100 206 cmp (board_ptr),y 207 beq win_ply 208 inx 209 lda tmp 210 and #%00110011 211 cmp (board_ptr),y 212 beq win_ply 213 inx 214 lda tmp 215 and #%00001111 216 cmp (board_ptr),y 217 beq win_ply 218 ;; No win here. Try next row 219 iny 220 cpy #$03 221 bne row_loop 222 ;; No win row 223 ;; Carry set indicates failure 224 sec 225 rts 226 win_ply: 227 ;; Found a winning move 228 ;; return piece in A, 229 ;; and position in X/Y. 230 ;; Clear carry to indicate success. 231 lda tmp 232 and #%00000011 233 clc 234 rts 235 .bend 236 237 win_column: 238 .block 239 sta tmp ; Remember who I am 240 ;; We mirror the board in order to use 241 ;; win_column to check for a winning 242 ;; position. 243 #mem.STORE_WORD board_mirrored,other_board_ptr 244 jsr mirror_board 245 #mem.STORE_WORD board_mirrored,board_ptr 246 lda tmp ; Who am I? 247 jsr win_row 248 #mem.STORE_WORD main_board,board_ptr 249 bcs no_win 250 ;; We found a winning position 251 ;; since we found the winning 252 ;; position on the mirrored board, 253 ;; we have to mirror it back. 254 phx 255 tya 256 tax 257 ply 258 clc 259 no_win: 260 rts 261 .bend 262 263 win_first_diagonal: 264 .block 265 sta tmp ; Remember who I am 266 lda #$ff ; No empty field 267 sta empty_field ; found so far 268 lda #$00 ; Upper left field 269 jsr check_if_occupied_and_update_empty_field 270 bcs no_win 271 lda #$04 ; Middle field 272 jsr check_if_occupied_and_update_empty_field 273 bcs no_win 274 lda #$08 ; Lower right field 275 jsr check_if_occupied_and_update_empty_field 276 bcs no_win 277 ;; We can win! 278 clc 279 lda tmp 280 ldx empty_field 281 jsr pos_to_column_row 282 rts 283 no_win: 284 sec 285 rts 286 .bend 287 win_second_diagonal: 288 .block 289 sta tmp ; Remember who I am 290 lda #$ff ; No empty field 291 sta empty_field ; found so far 292 lda #$02 ; Upper right field 293 jsr check_if_occupied_and_update_empty_field 294 bcs no_win 295 lda #$04 ; Middle field 296 jsr check_if_occupied_and_update_empty_field 297 bcs no_win 298 lda #$06 ; Lower left field 299 jsr check_if_occupied_and_update_empty_field 300 bcs no_win 301 ;; We can win! 302 clc 303 lda tmp 304 ldx empty_field 305 jsr pos_to_column_row 306 rts 307 no_win: 308 sec 309 rts 310 .bend 311 312 ;; We can complete the first diagonal if 313 ;; we occupy two of the field already, 314 ;; and the third field is empty. 315 ;; This subroutine checks if a field 316 ;; is occupied by us or if it is empty. 317 ;; In the latter case, empty_field is 318 ;; updated unless it was set already 319 ;; (i.e. this is the second empty field, 320 ;; thus no win ply available (yet)). 321 check_if_occupied_and_update_empty_field: 322 .block 323 pha ; Field number 324 tax ; stored in X, 325 jsr get_field ; field piece 326 plx ; stored in A. 327 cmp tmp ; Field occupied 328 beq cont ; by me? 329 cmp #$00 ; Field not occupied? 330 bne no_win ; Occupied by opponent. No win. 331 lda empty_field ; Have we seen an empty 332 cmp #$ff ; field before? 333 bne no_win ; Then we have too many empty fields. 334 stx empty_field ; Otherwise this is the empty field. 335 cont: 336 clc 337 rts 338 no_win: 339 sec 340 rts 341 .bend 342 343 ;; We use subroutine win to check 344 ;; if the other player could win 345 block: 346 .block 347 cmp #piece_o 348 beq we_are_o 349 lda #piece_o 350 jmp win 351 we_are_o: 352 lda #piece_x 353 jmp win 354 .bend 355 356 fork: 357 .block 358 ;; Forks require two intersecting rows, columns, or diagonals 359 ;; which both contain only one piece of the player and no 360 ;; other pieces. If the intersection is empty, then this 361 ;; is the fork field. 362 ;; To find these points, we create three additional boards: 363 ;; On the first board, all rows satisfying the critera 364 ;; are maintained, while all other rows are filled with $ff. 365 ;; On the second board, we do the same for columns, 366 ;; on the third board for the diagonals. 367 ;; Then we OR the boards pairwise. If there is 368 ;; an empty field after pairing, then this is the 369 ;; fork field. 370 pha ; Remember who I am 371 #mem.STORE_WORD fork_board_rows, other_board_ptr 372 pla ; Store my piece 373 pha ; in A 374 jsr find_rows_for_fork 375 ;; Generate second board (potential fork columns) 376 ;; For this, we mirror the board and use 377 ;; find_rows_for_fork again. 378 ;; We use board_mirrored as an auxillary variable 379 ;; here. 380 #mem.STORE_WORD main_board, board_ptr 381 #mem.STORE_WORD fork_board_columns, other_board_ptr 382 jsr mirror_board 383 ;; Check for fork points on mirrored 384 ;; board and store the result in 385 ;; fork_board_columns 386 #mem.STORE_WORD fork_board_columns, board_ptr 387 #mem.STORE_WORD board_mirrored, other_board_ptr 388 pla ; Store my piece 389 pha ; in A 390 jsr find_rows_for_fork 391 ;; Reverse mirroring 392 #mem.STORE_WORD board_mirrored, board_ptr 393 #mem.STORE_WORD fork_board_columns, other_board_ptr 394 jsr mirror_board 395 pla 396 pha 397 #mem.STORE_WORD fork_board_rows, board_ptr 398 #mem.STORE_WORD fork_board_columns, other_board_ptr 399 jsr check_fork 400 bcs cont 401 jmp done 402 cont: 403 ;; We have generated the fork_boards 404 ;; for row and column, but there was 405 ;; no fork on rows and columns. 406 ;; Now we create the fork board for 407 ;; diagonals. 408 ;; In order to use our subroutine 409 ;; find_rows_for_fork 410 ;; again, we map the first diagonal 411 ;; to the first row of a new board, 412 ;; and the second diagonal to the 413 ;; second row. 414 ;; We use board_mirrored as 415 ;; temporary storage. 416 ;; First diagonal to first row 417 lda #$00 418 sta fork_board_diagonals 419 sta fork_board_diagonals+1 420 sta fork_board_diagonals+2 421 #mem.STORE_WORD main_board, board_ptr 422 #mem.STORE_WORD fork_board_diagonals, other_board_ptr 423 #COPY_FIELD 0, 0 424 #COPY_FIELD 4, 1 425 #COPY_FIELD 8, 2 426 ;; Second diagonal to second row 427 #COPY_FIELD 2, 3 428 #COPY_FIELD 4, 4 429 #COPY_FIELD 6, 5 430 #mem.STORE_WORD fork_board_diagonals, board_ptr 431 #mem.STORE_WORD board_mirrored, other_board_ptr 432 pla ; Store my piece 433 pha ; in A 434 jsr find_rows_for_fork 435 ;; Store result in fork_board_diagonals 436 ;; Invalidate all non-diagonal fields 437 lda #%00001100 438 sta fork_board_diagonals 439 sta fork_board_diagonals+2 440 lda #%00110011 441 sta fork_board_diagonals+1 442 ;; First diagonal 443 #mem.STORE_WORD board_mirrored, board_ptr 444 #mem.STORE_WORD fork_board_diagonals, other_board_ptr 445 #COPY_FIELD 0, 0 446 #COPY_FIELD 1, 4 447 #COPY_FIELD 2, 8 448 ;; Second diagonal 449 #COPY_FIELD 3, 2 450 #COPY_FIELD 5, 6 451 ;; Middle field can be used in either diagonal 452 ;; therefore we have to treat it seperately 453 #GET_FIELD board_mirrored, 4 454 cmp #$00 455 bne middle_field_not_part_of_potential_fork 456 #mem.STORE_WORD fork_board_diagonals, board_ptr 457 #SET_FIELD $00, 4 458 middle_field_not_part_of_potential_fork: 459 ;; No check if there is a fork between 460 ;; rows and diagonals ... 461 #mem.STORE_WORD fork_board_diagonals, board_ptr 462 #mem.STORE_WORD fork_board_rows, other_board_ptr 463 jsr check_fork 464 bcc done 465 ;; ... and columns and diagonals. 466 #mem.STORE_WORD fork_board_columns, other_board_ptr 467 jsr check_fork 468 done: 469 ;; Some restore operatons 470 #mem.STORE_WORD main_board, board_ptr 471 pla 472 rts 473 .bend 474 475 ;;; Check if we can create a fork with a 476 ;;; suitable row and column. If this is 477 ;;; the case, we set the carry flag 478 ;;; and return the fork position. 479 check_fork: 480 .block 481 ;; Since empty fields in 482 ;; fork_boards_rows and 483 ;; fork roads_columns indicate potential 484 ;; fork fields, we OR these two 485 ;; boards and check if there are 486 ;; empty fields. 487 ;; We store the ORed boards in 488 ;; board_mirrored, because this 489 ;; board is not used here. 490 clc 491 ldy #$00 492 copy_and_or_boards_loop: 493 lda (board_ptr),y 494 ora (other_board_ptr),y 495 sta board_mirrored,y 496 iny 497 cpy #$03 498 bne copy_and_or_boards_loop 499 ;; No check for empty fields 500 ldy #$00 ; Row counter 501 row_loop: 502 lda #%00000011 ; Field pattern 503 sta tmp 504 ldx #$00 ; Column counter 505 pattern_loop: 506 lda board_mirrored,y 507 and tmp 508 beq found_empty_field 509 lda tmp ; Move 510 asl a ; to 511 asl a ; next 512 sta tmp ; pattern 513 inx 514 cpx #$03 515 bne pattern_loop 516 iny 517 cpy #$03 518 bne row_loop 519 sec 520 found_empty_field: 521 rts 522 .bend 523 524 525 ;;; Check for all rows if they may be part 526 ;;; of a fork. This is the case when the 527 ;;; row contains one of our pieces and 528 ;;; no other piece. In this case, the row 529 ;;; stays intact. In all other cases, 530 ;;; we overwrite the row with $ff. 531 ;;; board_ptr points to the input board, 532 ;;; other_board_ptr_to_the output board 533 find_rows_for_fork: 534 .block 535 pha 536 ldy #$00 ; Row counter 537 row_loop: 538 pla ; Get pattern we are looking for 539 pha 540 sta tmp 541 ldx #$00 ; Pattern counter 542 pattern_loop: 543 lda (board_ptr),y ; Load row 544 cmp tmp ; Compare row to pattern 545 beq potential_fork_row 546 inx ; Is there 547 cpx #$03 ; a next pattern? 548 beq no_potential_fork_row 549 lda tmp ; Generate next pattern 550 asl a 551 asl a 552 sta tmp 553 jmp pattern_loop ; Test for this pattern 554 no_potential_fork_row: 555 lda #$ff 556 potential_fork_row: 557 sta (other_board_ptr),y 558 iny 559 cpy #$03 560 bne row_loop 561 pla ; Clean stack 562 rts 563 .bend 564 565 block_fork: 566 .block 567 pha ; Remember who I am 568 cmp #piece_o 569 beq we_are_o 570 lda #piece_o 571 jmp check_for_fork 572 we_are_o: 573 lda #piece_x 574 check_for_fork: 575 jsr fork 576 bcs done 577 ;; We found a potential fork for the opponent. 578 ;; Before occupying it, we check if we could 579 ;; create a two-in-a-row 580 ;; situation for me. 581 pla 582 pha 583 jsr two_in_a_row 584 done: 585 pla ;Clean up stack 586 rts 587 .bend 588 two_in_a_row: 589 .block 590 pha ; Remember who I am 591 ldy #$00 ; Row counter 592 row_loop: 593 pla ; Set 594 pha ; start 595 sta tmp ; pattern. 596 ldx #$00 ; Pattern counter 597 pattern_loop: 598 lda (board_ptr),y 599 cmp tmp 600 beq found_row 601 lda tmp ; Next pattern 602 asl a 603 asl a 604 sta tmp 605 inx 606 cpx #$03 ; All patterns 607 bne pattern_loop ; checked for row 608 iny 609 cpy #$03 610 bne row_loop 611 done: 612 pla ; Clean-up stack 613 sec 614 rts 615 found_row: 616 ;; Found empty spot in row 617 ;; It is important to place the next piece 618 ;; on the empty corner field, not the middle field. 619 pla ; Clean-up stack 620 clc 621 lda (board_ptr),y 622 and #%00000011 623 beq first_spot_empty 624 ;; Since first spot is occupied, 625 ;; third spot must be empty 626 ldx #$02 627 rts 628 first_spot_empty: 629 ldx #$00 630 rts 631 .bend 632 633 634 635 play_center: 636 .block 637 #GET_FIELD main_board, 4 638 sec 639 cmp #piece_none 640 bne done 641 ldx #$01 642 ldy #$01 643 clc 644 done: 645 rts 646 .bend 647 648 play_opposite_corner: 649 .block 650 pha ; Remember who I am 651 ldx #$00 652 ldy #$08 653 pla 654 pha 655 jsr check_if_occupied_and_empty 656 bcc done 657 ldx #$02 658 ldy #$06 659 pla 660 pha 661 jsr check_if_occupied_and_empty 662 bcc done 663 ldx #$06 664 ldy #$02 665 pla 666 pha 667 jsr check_if_occupied_and_empty 668 bcc done 669 ldx #$08 670 ldy #$00 671 pla 672 pha 673 jsr check_if_occupied_and_empty 674 sec 675 done: 676 pla 677 rts 678 .bend 679 ;; Check if field in X is 680 ;; occupied by opponent and 681 ;; field in Y is empty. 682 ;; In this case, return 683 ;; coordinates of empty 684 ;; field in X/Y 685 check_if_occupied_and_empty: 686 .block 687 phy 688 sta tmp ; This me 689 jsr get_field 690 cmp tmp ; Occupied 691 beq not_applicable ; by me 692 cmp #$00 693 beq not_applicable ; Field emtpy 694 ;; Check field (originally) in Y 695 plx 696 phx 697 jsr get_field 698 cmp #$00 699 bne not_applicable ; Not empty 700 ;; Field is empty. Occupy it 701 plx 702 jsr pos_to_column_row 703 clc 704 rts 705 not_applicable: 706 pla ; Clear stack 707 sec 708 rts 709 .bend 710 711 play_empty_corner: 712 .block 713 sta tmp 714 ldx #$00 715 jsr occupy_if_empty 716 bcc done 717 ldx #$02 718 jsr occupy_if_empty 719 bcc done 720 ldx #$06 721 jsr occupy_if_empty 722 bcc done 723 ldx #$08 724 jsr occupy_if_empty 725 bcc done 726 done: 727 rts 728 .bend 729 730 occupy_if_empty: 731 .block 732 phx 733 jsr get_field 734 cmp #$00 735 bne already_occupied 736 plx 737 jsr pos_to_column_row 738 clc 739 rts 740 already_occupied: 741 plx ; Clear stack 742 sec 743 rts 744 .bend 745 746 play_empty_side: 747 .block 748 sta tmp 749 ldx #$01 750 jsr occupy_if_empty 751 bcc done 752 ldx #$03 753 jsr occupy_if_empty 754 bcc done 755 ldx #$05 756 jsr occupy_if_empty 757 bcc done 758 ldx #$07 759 jsr occupy_if_empty 760 bcc done 761 done: 762 rts 763 .bend 764