「魂のために」プログラミング

SPLUTゲームのアイデアとデザインは著作権で保護されています。 デザイナーのTommy De Coninckの書面による許可なしに、この出版物のアイデアやコンテンツを商業目的に使用することはできません。

: one-step ( 'dir -- ) EXECUTE verify \   empty? verify \ ? from \    here \  move \  add-move \   ; 

 : drag ( 'dir 'opposite -- ) EXECUTE verify \   is-stone? verify \  ? piece-type \   SWAP here SWAP \   DUP EXECUTE DROP EXECUTE verify \     empty? verify \ ? from \    here \  move \   capture-at \    ,   from create-piece-type-at \    ,    add-move \  ! ; : drag-to-north ( -- ) ['] north ['] south drag ; : drag-to-south ( -- ) ['] south ['] north drag ; : drag-to-east ( -- ) ['] east ['] west drag ; : drag-to-west ( -- ) ['] west ['] east drag ; 

 DEFER SSTONE DEFER NSTONE DEFER WSTONE DEFER ESTONE : is-stone? ( -- ? ) piece-type SSTONE = piece-type NSTONE = OR piece-type WSTONE = OR piece-type ESTONE = OR ; ... {pieces {piece} lock {moves} pass-moves {piece} sstone {drops} stone-drops {piece} nstone {drops} stone-drops {piece} wstone {drops} stone-drops {piece} estone {drops} stone-drops {piece} wizard {moves} wizard-moves {piece} dwarf {moves} dwarf-moves {piece} troll {moves} troll-moves pieces} ' sstone IS SSTONE ' nstone IS NSTONE ' wstone IS WSTONE ' estone IS ESTONE 

 DEFER CONTINUE-TYPE : one-step ( 'dir -- ) check-continue? IF EXECUTE verify empty? verify from here move add-move ELSE DROP ENDIF ; : step-to-north ( -- ) ['] north one-step ; : step-to-south ( -- ) ['] south one-step ; : step-to-east ( -- ) ['] east one-step ; : step-to-west ( -- ) ['] west one-step ; : drag ( 'dir 'opposite -- ) check-continue? IF EXECUTE verify is-stone? verify piece-type SWAP here SWAP DUP EXECUTE DROP EXECUTE verify empty? verify from here move capture-at DUP lock-stone from create-piece-type-at add-move ELSE DROP DROP ENDIF ; : drag-to-north ( -- ) ['] north ['] south drag ; : drag-to-south ( -- ) ['] south ['] north drag ; : drag-to-east ( -- ) ['] east ['] west drag ; : drag-to-west ( -- ) ['] west ['] east drag ; : take-stone ( 'dir -- ) check-continue? IF EXECUTE verify is-stone? verify CONTINUE-TYPE partial-move-type from here move add-move ELSE DROP ENDIF ; : take-to-north ( -- ) ['] north take-stone ; : take-to-south ( -- ) ['] south take-stone ; : take-to-east ( -- ) ['] east take-stone ; : take-to-west ( -- ) ['] west take-stone ; : drop-stone ( 'opposite 'dir -- ) check-edge? check-wizard? OR on-board? AND IF check-troll? piece-is-not-present? AND IF player piece-type drop WIZARD = IF drop-team ELSE DROP ENDIF lock-continue current-piece-type lock-stone add-move ENDIF ENDIF ; : drop-to-north ( -- ) ['] north ['] south drop-stone ; : drop-to-south ( -- ) ['] south ['] north drop-stone ; : drop-to-east ( -- ) ['] east ['] west drop-stone ; : drop-to-west ( -- ) ['] west ['] east drop-stone ; {moves troll-moves {move} step-to-north {move-type} normal-type {move} step-to-south {move-type} normal-type {move} step-to-east {move-type} normal-type {move} step-to-west {move-type} normal-type {move} drag-to-north {move-type} normal-type {move} drag-to-south {move-type} normal-type {move} drag-to-east {move-type} normal-type {move} drag-to-west {move-type} normal-type {move} take-to-north {move-type} normal-type {move} take-to-south {move-type} normal-type {move} take-to-east {move-type} normal-type {move} take-to-west {move-type} normal-type moves} {moves stone-drops {move} drop-to-north {move-type} continue-type {move} drop-to-south {move-type} continue-type {move} drop-to-east {move-type} continue-type {move} drop-to-west {move-type} continue-type moves} ' continue-type IS CONTINUE-TYPE 

 VARIABLE forward VARIABLE backward VARIABLE step-count VARIABLE here-pos : push-step ( 'opposite 'dir -- ) check-continue? IF 0 step-count ! forward ! backward ! forward @ EXECUTE verify not-empty? verify step-count ++ player piece-type here here-pos ! BEGIN forward @ EXECUTE IF empty? IF TRUE ELSE step-count ++ player piece-type FALSE ENDIF ELSE BEGIN step-count @ 0> IF step-count -- DROP DROP FALSE ELSE TRUE ENDIF UNTIL TRUE ENDIF UNTIL step-count @ 0> verify from here-pos @ move BEGIN step-count @ 0> IF step-count -- DUP is-stone-type? IF DUP lock-stone ENDIF create-player-piece-type backward @ EXECUTE DROP FALSE ELSE TRUE ENDIF UNTIL add-move ELSE DROP DROP ENDIF ; 

 : fly-stone ( 'dir -- ) check-continue? IF DUP EXECUTE empty? AND IF a5 to BEGIN is-stone? not-locked? AND IF here here-pos ! DUP piece-type SWAP EXECUTE SWAP can-fly? AND IF from to DUP EXECUTE DROP from here move here-pos @ to DUP piece-type SWAP capture EXECUTE DROP DUP lock-stone DUP begin-fly create-piece-type add-move ENDIF here-pos @ to ENDIF DUP next NOT UNTIL ENDIF DROP ELSE DROP ENDIF ; 

 : push-stone ( 'dir -- ) check-continue? IF DUP EXECUTE is-stone? not-locked? AND AND IF piece-type can-fly-lock? IF here SWAP piece-type SWAP EXECUTE empty? AND IF SWAP from SWAP move DUP lock-stone DUP begin-fly create-piece-type add-move ELSE DROP DROP DROP ENDIF ELSE DROP ENDIF ENDIF ELSE DROP ENDIF ; 

 int AlphaBeta(int color, int Depth, int alpha, int beta) { if (Depth == 0) return Evaluate(color); int score = -INFINITY; PMove move = GenerateAllMoves(color); while (move) { MakeMove(move); int tmp = -AlphaBeta(color==WHITE?BLACK:WHITE, Depth - 1, -beta, -alpha); UnMakeMove(move); if (tmp > score) score = tmp; if (score > alpha) alpha = score; if (alpha >= beta) return alpha; move = move -> next; } return score; } 

 VARIABLE Depth MaxDepth [] CurrMove[] MaxDepth [] CurrTurn[] MaxDepth [] CurrScore[] : Score ( alpha beta turn -- score ) Depth -- Depth @ 0< IF EvalCount ++ SWAP DROP SWAP DROP Eval SWAP turn-offset-to-player current-player <> IF NEGATE ENDIF ELSE DUP turn-offset-to-player FALSE 0 $GenerateMoves Depth @ CurrTurn[] ! $FirstMove Depth @ CurrMove[] ! -10000 Depth @ CurrScore[] ! BEGIN $CloneBoard Depth @ CurrMove[] @ .moveCFA EXECUTE 2DUP Depth @ CurrTurn[] @ next-turn-offset RECURSE $DeallocateBoard $Yield DUP Depth @ CurrScore[] @ > IF Depth @ CurrScore[] ! ELSE DROP ENDIF Depth @ CurrTurn[] @ turn-offset-to-player current-player <> IF NEGATE SWAP NEGATE ENDIF OVER Depth @ CurrScore[] @ < IF SWAP DROP Depth @ CurrScore[] @ SWAP ENDIF 2DUP >= IF OVER Depth @ CurrScore[] ! TRUE ELSE Depth @ CurrTurn[] @ turn-offset-to-player current-player <> IF NEGATE SWAP NEGATE ENDIF Depth @ CurrMove[] @ $NextMove DUP Depth @ CurrMove[] ! NOT ENDIF UNTIL $DeallocateMoves DROP DROP Depth @ CurrScore[] @ Depth @ CurrTurn[] @ turn-offset-to-player current-player <> IF NEGATE ENDIF ENDIF Depth ++ ; 

 3 CONSTANT MaxDepth VARIABLE BestScore VARIABLE Nodes : Custom-Engine ( -- ) -10000 BestScore ! 0 Nodes ! $FirstMove BEGIN $CloneBoard DUP $MoveString CurrentMove! DUP .moveCFA EXECUTE MaxDepth Depth ! 0 EvalCount ! BestScore @ 10000 turn-offset next-turn-offset Score 0 5 $RAND-WITHIN + BestScore @ OVER < IF DUP BestScore ! Score! 0 Depth! DUP $MoveString BestMove! ELSE DROP ENDIF $DeallocateBoard Nodes ++ Nodes @ Nodes! $Yield $NextMove DUP NOT UNTIL DROP ; 

 LOAD Splut.4th ( Load the base Splut game ) {players {player} South {search-engine} Custom-Engine {neutral} West {player} North {search-engine} Custom-Engine {neutral} East {player} ?Cleaner {random} players} {turn-order {turn} South {turn} North {turn} North {repeat} {turn} ?Cleaner {of-type} clear-type {turn} South {turn} South {turn} South {turn} North {turn} North {turn} North turn-order} {board-setup {setup} South sstone e1 {setup} South wizard d2 {setup} South dwarf e2 {setup} South troll f2 {setup} South lock f1 {setup} West wstone a5 {setup} North nstone e9 {setup} North wizard f8 {setup} North dwarf e8 {setup} North troll d8 {setup} North lock h1 {setup} East estone i5 board-setup} 

 LOAD Splut.4th ( Load the base Splut game ) {players {player} South {random} {neutral} West {player} North {random} {neutral} East {player} ?Cleaner {random} players} {turn-order {turn} South {turn} North {turn} North {repeat} {turn} ?Cleaner {of-type} clear-type {turn} South {turn} South {turn} South {turn} North {turn} North {turn} North turn-order} {board-setup {setup} South sstone e1 {setup} South wizard d2 {setup} South dwarf e2 {setup} South troll f2 {setup} South lock f1 {setup} West wstone a5 {setup} North nstone e9 {setup} North wizard f8 {setup} North dwarf e8 {setup} North troll d8 {setup} North lock h1 {setup} East estone i5 board-setup} 

 $gameLog ON VARIABLE EvalCount : Score ( alpha beta turn -- score ) Depth -- Depth @ 0< IF EvalCount ++ ... ELSE ... ; : Custom-Engine ( -- ) ... BEGIN ... 0 EvalCount ! BestScore @ 10000 turn-offset next-turn-offset Score 0 5 $RAND-WITHIN + EvalCount @ . CR ... UNTIL DROP CR ;