From 7282958dcc54ab495e08ec29b1a7022e76bbba37 Mon Sep 17 00:00:00 2001 From: nihilazo Date: Thu, 7 Apr 2022 22:20:59 +0100 Subject: [PATCH] a day's hacking with a whole bunch of stuff going on --- arena.rkt | 9 +++++ gui.rkt | 2 +- main.rkt | 101 ++++++++++++++++++++++++++++++---------------------- players.rkt | 31 ++++++++++++++++ 4 files changed, 99 insertions(+), 44 deletions(-) create mode 100644 arena.rkt create mode 100644 players.rkt diff --git a/arena.rkt b/arena.rkt new file mode 100644 index 0000000..e893879 --- /dev/null +++ b/arena.rkt @@ -0,0 +1,9 @@ +#lang racket + +; runs all the players against each other as both first and second player. + +(require "main.rkt" "players.rkt") + +(define all-players '(player-random player-first player-last)) + +(define matchups (append (combinations all-players 2) (map reverse (combinations all-players 2)))) \ No newline at end of file diff --git a/gui.rkt b/gui.rkt index b14be1e..caf2e34 100644 --- a/gui.rkt +++ b/gui.rkt @@ -50,7 +50,7 @@ [label "&Load"] [parent file-menu] [callback (lambda (m event) - (let ([f (get-file "Load Game")]) ;#f #f #f ".dbn" '() '(("*.dbn" "Dots and Boxes Notation")))]) + (let ([f (get-file "Load Game" #f #f #f ".dbn" '() '(("Dots and Boxes Notation" "*.dbn")))]) (if (eq? #f f) 0 (load-game-gui! (load-game! f))) (send grid-canvas refresh) (send log set (map line->string g)) diff --git a/main.rkt b/main.rkt index df107cb..3a42a23 100644 --- a/main.rkt +++ b/main.rkt @@ -2,7 +2,7 @@ (provide (all-defined-out)) ; for testing module -(require racket/draw racket/random) +(require racket/draw racket/random file/gif) ; a Grid contains: ; -- a list of lines. All lines in a grid must be specified as moving left to right, top to bottom ("to" coordinate higher than "from" coordinate") @@ -122,15 +122,6 @@ (not (out-of-bounds? (line-from line) grid)) (not (out-of-bounds? (line-to line) grid))))) -; a Player that plays random moves -(define random-player - (player - "Random" - (lambda (g n) - (let ([m (car (random-sample (valid-moves g) 1))]) - (line (line-from m) (line-to m) n))))) - - ; Grid Line -> Grid ; adds line to grid, if it is a valid move. Otherwise skips the move. (define (append-move g l) @@ -209,10 +200,46 @@ (define (start-game p1 p2 grid1 grid2) (play-game (GameState (grid '() grid1 grid2) 0 '(0 0) (list p1 p2)))) +; GameState path ! +; saves a game into the .dbn file format that I just made up. +; don't worry, it's sexpy. +(define (save-game! s filename) + (let ([g (GameState-grid s)] + [f (open-output-file filename)]) + (pretty-write + `((player0 ,(player-name (first (GameState-players s)))) + (player1 ,(player-name (second (GameState-players s)))) + (grid ,(grid-width g) ,(grid-height g)) + (score ,(first (GameState-scores s)) ,(second (GameState-scores s))) + (lines + ,(for/list ([l (grid-lines g)]) + (list (point-x (line-from l)) (point-y (line-from l)) (point-x (line-to l)) (point-y (line-to l)) (line-player l))))) f) + (close-output-port f))) + +; path -> GameState +; loads a game from a .dbn file into a GameState structure +(define (load-game! p) + (let* ([f (open-input-file p)] + [data (read f)]) + (close-input-port f) + (GameState + (grid + (for/list ([i (last (assoc 'lines data))]) + (line (point (first i) (second i)) (point (third i) (fourth i)) (fifth i))) + (second (assoc 'grid data)) (last (assoc 'grid data))) + 0 ; assumed, the game is over + (list (second (assoc 'score data)) (last (assoc 'score data))) + `( + ,(player (last (assoc 'player0 data)) 0) + ,(player (last (assoc 'player1 data)) 0) + )))) + + + ; Grid -> Image ; renders grid to an image for showing humans the game. (define (render-grid-bitmap g) - (let* ([bitmap (make-bitmap (+ 10 (* (grid-width g) GRID-SCALE) (+ 10 (* (grid-width g) GRID-SCALE))))] ; add border for printing + (let* ([bitmap (make-bitmap (+ 10 (* (grid-width g) GRID-SCALE)) (+ 10 (* (grid-width g) GRID-SCALE)))] ; add border for printing [dc (new bitmap-dc% [bitmap bitmap])]) (render-grid g dc) bitmap)) @@ -241,36 +268,24 @@ 0)))) (send dc draw-bitmap (grid-dots (grid-width g) (grid-height g)) 0 0)) ; overlay dot grid -; GameState path ! -; saves a game into the .dbn file format that I just made up. -; don't worry, it's sexpy. -(define (save-game! s filename) - (let ([g (GameState-grid s)] - [f (open-output-file filename)]) - (pretty-write - `((player0 ,(player-name (first (GameState-players s)))) - (player1 ,(player-name (second (GameState-players s)))) - (grid ,(grid-width g) ,(grid-height g)) - (score ,(first (GameState-scores s)) ,(second (GameState-scores s))) - (lines - ,((for/list ([l (grid-lines g)]) - (list (point-x (line-from l)) (point-y (line-from l)) (point-x (line-to l)) (point-y (line-to l)) (line-player l)))))) f) - (close-output-port f))) +; GameState filepath ! +; saves a game's history as images into /tmp/ +; TODO learn file/gif and make the gif properly +(define (game->images game) + (let* ([g (GameState-grid game)] + [frames (grid-frames (grid '() (grid-width g) (grid-height g)) g '())]) + + (for ([frame (in-range (length frames))]) + (send (list-ref frames frame) save-file (format "/tmp/dotsandboxes~a.png" frame) 'png) + ))) + -; path -> GameState -; loads a game from a .dbn file into a GameState structure -(define (load-game! p) - (let* ([f (open-input-file p)] - [data (read f)]) - (close-input-port f) - (GameState - (grid - (for/list ([i (last (assoc 'lines data))]) - (line (point (first i) (second i)) (point (third i) (fourth i)) (fifth i))) - (second (assoc 'grid data)) (last (assoc 'grid data))) - 0 ; assumed, the game is over - (list (second (assoc 'score data)) (last (assoc 'score data))) - `( - ,(player (last (assoc 'player0 data)) 0) - ,(player (last (assoc 'player1 data)) 0) - )))) +; Used internally for rendering all the frames from a grid's history +(define (grid-frames g grid-in frames) + (cond + [(empty? (grid-lines grid-in)) frames] + [(grid-frames + (grid (append (grid-lines g) (list (car (grid-lines grid-in)))) (grid-width g) (grid-height g)) + (grid (cdr (grid-lines grid-in)) (grid-width grid-in) (grid-height grid-in)) + (append frames (list (render-grid-bitmap g))))] + )) diff --git a/players.rkt b/players.rkt new file mode 100644 index 0000000..9e89d9c --- /dev/null +++ b/players.rkt @@ -0,0 +1,31 @@ +#lang racket + +; dots and boxes players! + +(require "main.rkt" racket/random) + +(provide player-random player-first player-last) + +; a Player that plays random moves +(define player-random + (player + "Random" + (lambda (g n) + (let ([m (car (random-sample (valid-moves g) 1))]) + (line (line-from m) (line-to m) n))))) + +; plays the first valid move found +(define player-first + (player + "First Move" + (lambda (g n) + (let ([m (first (valid-moves g))]) + (line (line-from m) (line-to m) n))))) + +; plays the last valid move found +(define player-last + (player + "Last Move" + (lambda (g n) + (let ([m (last (valid-moves g))]) + (line (line-from m) (line-to m) n)))))