(define adjacent-to (or (position-flag? $1 n) (position-flag? $1 s) (position-flag? $1 e) (position-flag? $1 w) ) ) (define set-danger-flag (if (and (enemy? $1) (not-neutral? $1) (not-position-flag? safe $1)) (set-position-flag danger true $1) (set-flag Changed true) ) ) (define stone (name Stone) (image Black "images\Stoical Go\pieces\b$1.bmp" White "images\Stoical Go\pieces\w$1.bmp" ) (attribute makes-capture false) (drops ( (verify empty?) (verify (not-position? end)) (set-flag Capturing false) ; if next to enemy (if (or (and (enemy? n) (not-neutral? n) ) (and (enemy? s) (not-neutral? s) ) (and (enemy? e) (not-neutral? e) ) (and (enemy? w) (not-neutral? w) ) ) mark ; *** Initialize safe ; for each point ; if enemy ; if next to empty ; P[safe] = true a1 (while (not-position? end) (set-position-flag safe empty?) next ) back (set-position-flag safe false) a1 (while (not-position? end) (if (and enemy? not-neutral? (adjacent-to safe) ) (set-position-flag safe true) ) next ) ; *** Initialize danger ; for each adjacent ; if enemy ; P[danger] = true back (set-flag Changed false) (set-danger-flag n) (set-danger-flag s) (set-danger-flag e) (set-danger-flag w) (if (flag? Changed) ; *** Spread danger, safe ; Changed = true ; while Changed ; Changed = false ; for each point ; if enemy ; if !P[safe] ; if any adjacent is enemy with P[safe] ; P[safe] = true ; if !P[safe] and !P[danger] ; if any adjacent is enemy with P[danger] ; P[danger] = true ; Changed = true (while (flag? Changed) (set-flag Changed false) a1 (while (not-position? end) (if (and enemy? not-neutral?) (if (and (not-position-flag? safe) (adjacent-to safe)) (set-position-flag safe true) (set-flag Changed true) ) (if (and (not-position-flag? safe) (not-position-flag? danger) (adjacent-to danger) ) (set-position-flag danger true) (set-flag Changed true) ) ) next ) ) ; *** Add captures for stones ; for each point ; if P[danger] and !P[safe] ; capture a1 (while (not-position? end) (if (and (position-flag? danger) (not-position-flag? safe)) capture (set-flag Capturing true) ) next ) back ) ; if Changed ) ; if next to enemy ;!!!!!!! Find out if suicide ; if no captures (if (and (not-flag? Capturing) (not (or (empty? n) (empty? s) (empty? e) (empty? w) ) ) ) ; *** Initialize safe ; for each point ; P[safe] = empty and not-marked a1 (while (not-position? end) (set-position-flag safe empty?) next ) back (set-position-flag safe false) ; Changed = true ; while Changed and not adjacent to safe ; Changed = false ; for each point ; if friend ; if !P[safe] ; if any adjacent is friend with P[safe] ; P[safe] = true ; Changed = true (set-flag Valid (adjacent-to safe)) (set-flag Changed true) (while (and (not-flag? Valid) (flag? Changed) ) (set-flag Changed false) a1 (while (not-position? end) (if (and friend? (not-position-flag? safe) ) (if (adjacent-to safe) (set-position-flag safe true) (set-flag Changed true) ) ) next ) back (set-flag Valid (adjacent-to safe)) ) ; *** Add if not suicide ; verify next to safe square back (verify (flag? Valid)) ) ; if no captures ; *** Add stone (if (flag? Capturing) (go last-to) (if (piece? CapturingStone) (verify friend?) (change-type Stone) ) was-a-capture (change-type yes) back (add CapturingStone) else was-a-capture (if (piece? yes) (change-type no) (go last-to) (change-type Stone) ) back add ) ) ) ; drops )
20 CONSTANT LS 10 CONSTANT SS LS [] list[] VARIABLE list-size SS [] set[] VARIABLE set-size VARIABLE curr-pos : not-in-list? ( pos - ? ) curr-pos ! TRUE list-size @ BEGIN 1- DUP 0 >= IF DUP list[] @ curr-pos @ = IF 2DROP FALSE 0 ENDIF ENDIF DUP 0> NOT UNTIL DROP ; : not-in-set? ( pos - ? ) curr-pos ! TRUE set-size @ BEGIN 1- DUP 0 >= IF DUP set[] @ curr-pos @ = IF 2DROP FALSE 0 ENDIF ENDIF DUP 0> NOT UNTIL DROP ; : add-position ( -- ) list-size @ LS < IF here not-in-list? IF here list-size @ list[] ! list-size ++ ENDIF ENDIF ; : not-from? ( pos -- ? ) DUP from <> SWAP not-in-set? AND ; : check-dir ( 'dir -- ) EXECUTE here not-from? AND friend? AND IF add-position ENDIF ; : check-coherence ( -- ? ) here 0 list[] @ 0 BEGIN DUP list[] @ DUP to ['] n check-dir DUP to ['] s check-dir DUP to ['] w check-dir DUP to ['] e check-dir DUP to ['] nw check-dir DUP to ['] sw check-dir DUP to ['] ne check-dir to ['] se check-dir 1+ DUP list-size @ >= UNTIL 2DROP to TRUE SIZE BEGIN 1- DUP 0 >= IF DUP not-from? IF DUP from <> OVER friend-at? AND IF DUP not-in-list? IF 2DROP FALSE 0 ENDIF ENDIF ENDIF ENDIF DUP 0> NOT UNTIL DROP 0 list-size ! ;
(define add-piece-neighbors (foreach current-group (all (if (any nsew nw sw ne se) (check is-friend?) (if (not (piece-contains current-group)) (take-piece current-group) ) ) ) ) ) (define check-coherence (if (exists? any-position (check is-friend?) (take-piece current-group) add-piece-neighbors ) (check (not (exists? any-position (check is-friend?) (check (not (piece-contains current-group))) ) ) ) ) )
Source: https://habr.com/ru/post/256701/
All Articles