diff options
Diffstat (limited to 'tests/examplefiles/reversi.lsp')
| -rw-r--r-- | tests/examplefiles/reversi.lsp | 427 |
1 files changed, 0 insertions, 427 deletions
diff --git a/tests/examplefiles/reversi.lsp b/tests/examplefiles/reversi.lsp deleted file mode 100644 index fa9a333c..00000000 --- a/tests/examplefiles/reversi.lsp +++ /dev/null @@ -1,427 +0,0 @@ -#!/usr/bin/env newlisp -;; @module reversi.lsp -;; @description a simple version of Reversi: you as white against newLISP as black -;; @version 0.1 alpha August 2007 -;; @author cormullion -;; -;; 2008-10-08 21:46:54 -;; updated for newLISP version 10. (changed nth-set to setf) -;; this now does not work with newLISP version 9! -;; -;; This is my first attempt at writing a simple application using newLISP-GS. -;; The game algorithms are basically by -;; Peter Norvig http://norvig.com/paip/othello.lisp -;; and all I've done is translate to newLISP and add the interface... -;; -;; To-Do: work out how to handle the end of the game properly... -;; To-Do: complete newlispdoc for the functions - -(constant 'empty 0) -(constant 'black 1) -(constant 'white 2) -(constant 'outer 3) ; squares outside the 8x8 board - -(set '*board* '()) ; the master board is a 100 element list -(set '*moves* '()) ; list of moves made - -; these are the 8 different directions from a square on the board - -(set 'all-directions '(-11 -10 -9 -1 1 9 10 11)) - -; return a list of all the playable squares (the 8 by 8 grid inside the 10by10 - -(define (all-squares) - (local (result) - (for (square 11 88) - (if (<= 1 (mod square 10) 8) - (push square result -1))) -result)) - -; make a board - -(define (make-board) - (set '*board* (dup outer 100)) - (dolist (s (all-squares)) - (setf (*board* s) empty))) - -; for testing and working at a terminal - -(define (print-board) - (print { }) - (for (c 1 8) - (print c)) - (set 'c 0) - (for (i 0 99) - (cond - ((= (*board* i) 0) (print {.})) - ((= (*board* i) 1) (print {b})) - ((= (*board* i) 2) (print {w}))) - (if (and (<= i 88) (= (mod (+ i 1) 10) 0)) ; newline - (print "\n" (inc c)))) - (println "\n")) - -; the initial starting pattern - -(define (initial-board) - (make-board) - (setf (*board* 44) white) - (setf (*board* 55) white) - (setf (*board* 45) black) - (setf (*board* 54) black)) - -(define (opponent player) - (if (= player black) white black)) - -(define (player-name player) - (if (= player white) "white" "black")) - -(define (valid-move? move) - (and - (integer? move) - (<= 11 move 88) - (<= 1 (mod move 10) 8))) - -(define (empty-square? square) - (and - (valid-move? square) - (= (*board* square) empty))) - -; test whether a move is legal. The square must be empty -; and it must flip at least one of the opponent's piece - -(define (legal-move? move player) - (and - (empty-square? move) - (exists (fn (dir) (would-flip? move player dir)) all-directions))) - -; would this move by player result in any flips in the given direction? -; if so, return the number of the 'opposite' (bracketing) piece's square - -(define (would-flip? move player dir) - (let - ((c (+ move dir))) - (and - (= (*board* c) (opponent player)) - (find-bracketing-piece (+ c dir) player dir)))) - -(define (find-bracketing-piece square player dir) - ; return the square of the bracketing piece, if any - (cond - ((= (*board* square) player) square) - ((= (*board* square) (opponent player)) - (find-bracketing-piece (+ square dir) player dir)) - (true nil))) - -(define (make-flips move player dir) - (let - ((bracketer (would-flip? move player dir)) - (c (+ move dir))) - (if bracketer - (do-until (= c bracketer) - (setf (*board* c) player) - (push c *flips* -1) - (inc c dir))))) - -; make the move on the master game board, not yet visually - -(define (make-move move player) - (setf (*board* move) player) - (push move *moves* -1) - (set '*flips* '()) ; we're going to keep a record of the flips made - (dolist (dir all-directions) - (make-flips move player dir))) - -(define (next-to-play previous-player) - (let ((opp (opponent previous-player))) - (cond - ((any-legal-move? opp) opp) - ((any-legal-move? previous-player) - (println (player-name opp) " has no moves") - previous-player) - (true nil)))) - -; are there any legal moves (returns first) for this player? -(define (any-legal-move? player) - (exists (fn (move) (legal-move? move player)) - (all-squares))) - -; a list of all legal moves might be useful -(define (legal-moves player) - (let ((result '())) - (dolist (move (all-squares)) - (if (legal-move? move player) - (push move result))) - (unique result))) - -; define any number of strategies that can be called on to calculate -; the next computer move. This is the only one I've done... - make -; any legal move at random! - -(define (random-strategy player) - (seed (date-value)) - (apply amb (legal-moves player))) - -; get the next move using a particular strategy - -(define (get-move strategy player) - (let ((move (apply strategy (list player)))) - (cond - ((and - (valid-move? move) - (legal-move? move player)) - (make-move move player)) - (true - (println "no valid or legal move for " (player-name player) ) - nil)) - move)) - -; that's about all the game algorithms for now -; now for the interface - -(if (= ostype "Win32") - (load (string (env "PROGRAMFILES") "/newlisp/guiserver.lsp")) - (load "/usr/share/newlisp/guiserver.lsp") -) - -(gs:init) -(map set '(screen-width screen-height) (gs:get-screen)) -(set 'board-width 540) -; center on screen -(gs:frame 'Reversi (- (/ screen-width 2) (/ board-width 2)) 60 board-width 660 "Reversi") -(gs:set-border-layout 'Reversi) - -(gs:canvas 'MyCanvas 'Reversi) - (gs:set-background 'MyCanvas '(.8 .9 .7 .8)) - (gs:mouse-released 'MyCanvas 'mouse-released-action true) - -(gs:panel 'Controls) - (gs:button 'Start 'start-game "Start") - -(gs:panel 'Lower) - (gs:label 'WhiteScore "") - (gs:label 'BlackScore "") - -(gs:add-to 'Controls 'Start ) -(gs:add-to 'Lower 'WhiteScore 'BlackScore) -(gs:add-to 'Reversi 'MyCanvas "center" 'Controls "north" 'Lower "south") - -(gs:set-anti-aliasing true) -(gs:set-visible 'Reversi true) - -; size of board square, and radius/width of counter -(set 'size 60 'width 30) - -; initialize the master board - -(define (initial-board) - (make-board) - (setf (*board* 44) white) - (setf (*board* 55) white) - (setf (*board* 45) black) - (setf (*board* 54) black) -) - -; draw a graphical repesentation of the board - -(define (draw-board) - (local (x y) - (dolist (i (all-squares)) - (map set '(x y) (square-to-xy i)) - (gs:draw-rect - (string x y) - (- (* y size) width ) ; !!!!!! - (- (* x size) width ) - (* width 2) - (* width 2) - gs:white)))) - -(define (draw-first-four-pieces) - (draw-piece 44 "white") - (draw-piece 55 "white") - (draw-piece 45 "black") - (draw-piece 54 "black")) - -; this next function can mark the legal moves available to a player - -(define (show-legal-moves player) - (local (legal-move-list x y) - (set 'legal-move-list (legal-moves player)) - (dolist (m (all-squares)) - (map set '(x y) (square-to-xy m)) - (gs:draw-rect - (string x y) - (- (* y size) width ) ; !!!!!! - (- (* x size) width ) - (* width 2) - (* width 2) - (if (find m legal-move-list) gs:blue gs:white) - ) - ) - ) -) - -; convert the number of a square on the master board to coordinates - -(define (square-to-xy square) - (list (/ square 10) (mod square 10))) - -; draw one of the pieces - -(define (draw-piece square colour) - (local (x y) - (map set '(x y) (square-to-xy square)) - (cond - ((= colour "white") - (gs:fill-circle - (string x y) - (* y size) ; !!!!!!! y first, cos y is x ;-) - (* x size) - width - gs:white)) - - ((= colour "black") - (gs:fill-circle - (string x y) - (* y size) - (* x size) - width - gs:black)) - - ((= colour "empty") - (gs:draw-rect - (string x y) - (- (* y size) width ) - (- (* x size) width ) - (* width 2) - (* width 2) - gs:white)) - ))) - -; animate the pieces flipping - -(define (flip-piece square player) -; flip by drawing thinner and fatter ellipses -; go from full disk in opposite colour to invisible -; then from invisible to full disk in true colour - (local (x y colour) - (map set '(x y) (square-to-xy square)) - ; delete original piece - (gs:delete-tag (string x y)) - (set 'colour (if (= player 2) gs:black gs:white )) - (for (i width 1 -3) - (gs:fill-ellipse - (string x y {flip} i) - (* y size) ; y first :-) !!! - (* x size) - i - width - colour) - (sleep 20) ; this might need adjusting... - (gs:delete-tag (string x y {flip} i)) - ) - (set 'colour (if (= player 2) gs:white gs:black)) - (for (i 1 width 3) - (gs:fill-ellipse - (string x y {flip} i) - (* y size) ; :-) !!! - (* x size) - i - width - colour) - (sleep 20) - (gs:delete-tag (string x y {flip} i)) - ) - ; draw the piece again - (gs:fill-circle - (string x y) - (* y size) - (* x size) - width - colour) - ) -) - -(define (do-move move player) - (cond - ; check if the move is good ... - ((and (!= player nil) - (valid-move? move) - (legal-move? move player)) - - ; ... play it - ; make move on board - (make-move move player) - ; and on screen - (draw-piece move (player-name player)) - (gs:update) - ; do flipping stuff - - ; wait for a while - (sleep 1000) - - ; then do flipping - (dolist (f *flips*) - (flip-piece f player)) - - (inc *move-number*) - (draw-piece move (player-name player)) - (gs:update) - - ; update scores - (gs:set-text 'WhiteScore - (string "White: " (first (count (list white) *board*)))) - (gs:set-text 'BlackScore - (string "Black: " (first (count (list black) *board*)))) - ) - ; or return nil - (true - nil))) - -; the game is driven by the mouse clicks of the user -; in reply, the computer plays a black piece -; premature clicking is possible and possibly a bad thing... - -(define (mouse-released-action x y button modifiers tags) - ; extract the tag of the clicked square - (set 'move (int (string (first tags)) 0 10)) - (if (do-move move player) - (begin - (set 'player (next-to-play player)) - ; there is a training mode - legal squares are highlighted - ; you can uncomment the next line... - ; (show-legal-moves player) - (gs:update) - - ; wait for black's reply - (gs:set-cursor 'Reversi "wait") - (gs:set-text 'Start "black's move - thinking...") - ; give the illusion of Deep Thought... - (sleep 2000) - ; black's reply - ; currently only the random strategy has been defined... - (set 'strategy random-strategy) - (set 'move (apply strategy (list player))) - (do-move move player) - (set 'player (next-to-play player)) - ; (show-legal-moves player) ; to see black's moves - (gs:set-text 'Start "your move") - (gs:set-cursor 'Reversi "default") - (gs:update)))) - -(define (start-game) - (gs:set-text 'Start "Click a square to place a piece!") - (gs:disable 'Start) - (set 'player white)) - -(define (start) - (gs:set-text 'Start "Start") - (gs:enable 'Start) - (set '*move-number* 1 - '*flips* '()) - (initial-board) - (draw-board) - (draw-first-four-pieces)) - -(start) - -(gs:listen)
\ No newline at end of file |