eris2010

Documentation: http://frombelow.net/projects/eris2010/
Clone: git clone https://git.frombelow.net/eris2010.git
Log | Files | Refs | README | LICENSE

computer_player.asm (20964B)


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