summaryrefslogtreecommitdiffstats
path: root/net/ricketyspace
diff options
context:
space:
mode:
authorrsiddharth <s@ricketyspace.net>2020-07-03 15:47:02 -0400
committerrsiddharth <s@ricketyspace.net>2020-07-03 15:47:02 -0400
commit0f072be231d0bd875d1c87ff127834e60979263a (patch)
tree19010b72474c14a04891abbe3da0fb5d58067db9 /net/ricketyspace
parent4f731f11be9d5bbfcd921671852e514e577a0c00 (diff)
net/ricketyspace/ror -> ./
Diffstat (limited to 'net/ricketyspace')
-rw-r--r--net/ricketyspace/ror/eight/graphics/README.txt3
-rw-r--r--net/ricketyspace/ror/eight/graphics/brigand.bmpbin6960 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/eight/graphics/hydra.pngbin11948 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/eight/graphics/hydrar.pngbin11654 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/eight/graphics/orc.gifbin1980 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/eight/graphics/orc.pngbin10504 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/eight/graphics/orcSprite.pngbin7949 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/eight/graphics/player.bmpbin92856 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/eight/graphics/slime.bmpbin21056 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/eight/orc.rkt943
-rw-r--r--net/ricketyspace/ror/eleven/lazy.rkt23
-rw-r--r--net/ricketyspace/ror/five/guess.rkt75
-rw-r--r--net/ricketyspace/ror/five/loco.rkt59
-rw-r--r--net/ricketyspace/ror/five/resources/caroille.pngbin886 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/five/resources/caroille.svg125
-rw-r--r--net/ricketyspace/ror/five/resources/ufo-fart.pngbin868 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/five/resources/ufo-fart.svg188
-rw-r--r--net/ricketyspace/ror/five/resources/zarking-ufo.pngbin1337 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/five/resources/zarking-ufo.svg128
-rw-r--r--net/ricketyspace/ror/five/ufo.rkt86
-rw-r--r--net/ricketyspace/ror/fourteen/client.rkt611
-rw-r--r--net/ricketyspace/ror/fourteen/graphics/cupcake.gifbin1796 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/fourteen/graphics/hungry-henry.gifbin1132 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/fourteen/readme.txt29
-rw-r--r--net/ricketyspace/ror/fourteen/run.rkt59
-rw-r--r--net/ricketyspace/ror/fourteen/server.rkt1065
-rw-r--r--net/ricketyspace/ror/fourteen/shared.rkt156
-rw-r--r--net/ricketyspace/ror/one/hw.rkt3
-rw-r--r--net/ricketyspace/ror/six/resources/body.gifbin1079 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/six/resources/goo-red.gifbin681 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/six/resources/goo.gifbin878 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/six/resources/head.gifbin776 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/six/resources/obstacle.gifbin667 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/six/resources/tail.gifbin1079 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/six/snake.rkt295
-rw-r--r--net/ricketyspace/ror/six/snakes.rkt362
-rw-r--r--net/ricketyspace/ror/ten/graphics/dice1.pngbin869 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/ten/graphics/dice2.pngbin887 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/ten/graphics/dice3.pngbin812 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/ten/graphics/dice4.pngbin968 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/ten/source.rkt1218
-rw-r--r--net/ricketyspace/ror/thirteen/client.rkt189
-rw-r--r--net/ricketyspace/ror/thirteen/run.rkt13
-rw-r--r--net/ricketyspace/ror/thirteen/server.rkt149
-rw-r--r--net/ricketyspace/ror/thirteen/shared.rkt28
-rw-r--r--net/ricketyspace/ror/twelve/graphics/dice1.pngbin869 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/twelve/graphics/dice2.pngbin887 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/twelve/graphics/dice3.pngbin812 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/twelve/graphics/dice4.pngbin968 -> 0 bytes
-rw-r--r--net/ricketyspace/ror/twelve/source.rkt1240
-rw-r--r--net/ricketyspace/ror/two/guess.rkt21
51 files changed, 0 insertions, 7068 deletions
diff --git a/net/ricketyspace/ror/eight/graphics/README.txt b/net/ricketyspace/ror/eight/graphics/README.txt
deleted file mode 100644
index 5895c77..0000000
--- a/net/ricketyspace/ror/eight/graphics/README.txt
+++ /dev/null
@@ -1,3 +0,0 @@
-Graphics from github.com/racket/realm
-
-Commit: 973041cb6a5c696b99b79a
diff --git a/net/ricketyspace/ror/eight/graphics/brigand.bmp b/net/ricketyspace/ror/eight/graphics/brigand.bmp
deleted file mode 100644
index 7bbd3c0..0000000
--- a/net/ricketyspace/ror/eight/graphics/brigand.bmp
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/eight/graphics/hydra.png b/net/ricketyspace/ror/eight/graphics/hydra.png
deleted file mode 100644
index b495920..0000000
--- a/net/ricketyspace/ror/eight/graphics/hydra.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/eight/graphics/hydrar.png b/net/ricketyspace/ror/eight/graphics/hydrar.png
deleted file mode 100644
index e555bfe..0000000
--- a/net/ricketyspace/ror/eight/graphics/hydrar.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/eight/graphics/orc.gif b/net/ricketyspace/ror/eight/graphics/orc.gif
deleted file mode 100644
index 5553322..0000000
--- a/net/ricketyspace/ror/eight/graphics/orc.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/eight/graphics/orc.png b/net/ricketyspace/ror/eight/graphics/orc.png
deleted file mode 100644
index d269b6a..0000000
--- a/net/ricketyspace/ror/eight/graphics/orc.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/eight/graphics/orcSprite.png b/net/ricketyspace/ror/eight/graphics/orcSprite.png
deleted file mode 100644
index cdc223c..0000000
--- a/net/ricketyspace/ror/eight/graphics/orcSprite.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/eight/graphics/player.bmp b/net/ricketyspace/ror/eight/graphics/player.bmp
deleted file mode 100644
index c6a04a0..0000000
--- a/net/ricketyspace/ror/eight/graphics/player.bmp
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/eight/graphics/slime.bmp b/net/ricketyspace/ror/eight/graphics/slime.bmp
deleted file mode 100644
index 208c188..0000000
--- a/net/ricketyspace/ror/eight/graphics/slime.bmp
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/eight/orc.rkt b/net/ricketyspace/ror/eight/orc.rkt
deleted file mode 100644
index f00d587..0000000
--- a/net/ricketyspace/ror/eight/orc.rkt
+++ /dev/null
@@ -1,943 +0,0 @@
-#lang racket
-
-#|
-
- From github.com/racket/realm
-
- With some trivial changes.
-
- Commit: 973041cb6a5c696b99b79a
-|#
-
-#|
- The Orc game
- -------------
-
- The Orc game is a turn-based battle game between monsters and the player.
-
- The player encounters a room full of monsters of all kinds, including
- orcs, hydras, hydrars, slimes, and brigands. They are ready to attack. It is
- the player's task to get rid of the monsters.
-
- When the game starts up, it is the player's turn, meaning she is given
- permission to attack a (randomly chosen number) of times. The player uses
- nine keys to play
- -- With the four arrow keys the player navigates among the twelve monsters.
- -- With "s", "f", "h", and "m"
- -- the player can 's'tab a specific monster,
- -- the player may 'f'lail at several monsters;
- -- the player may 'h'eal herself.
- -- the player may 'm'asturbate for a change.
- -- the player may 'b'lock to gain armor.
- When the player runs out of attacks, all live monsters attack the player.
- After that, it is the player's turn again.
-
- Just in case, the player can end a turn prematurely with "e".
-
- Play
- ----
-
- Run and evaluate
- (start-game)
- This will pop up a window that displays the player's vitals, the orcs and
- their basic state, and the game instructions.
-|#
-
-
-(require 2htdp/image 2htdp/universe)
-
-;
-;
-;
-; ;;; ;;; ;;; ;; ;;
-; ; ; ; ; ; ;
-; ; ; ;; ;;; ;;; ; ; ; ;;;; ;; ;;; ; ;;; ;
-; ; ; ;; ;; ;; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;
-; ;;; ;;;;; ;;;; ; ; ;;;; ;;;;; ;;;;; ;;; ;;
-;
-;
-;
-;
-
-;; The OrcWorld as Data:
-(struct orc-world (player lom attack# target) #:transparent #:mutable)
-;; A OrcWorld is a (orc-world Player [listof Monster] Nat Nat)
-;; The third field of the world refers to the number of attacks left.
-;; The fourth field refers to the position of the next attack target.
-
-(struct player (health agility strength armor) #:transparent #:mutable)
-;; A Player is a (player Nat Nat Nat Nat)
-;; The player's fields correspond to hit points, strength, agility, armor.
-
-(struct monster (image [health #:mutable]) #:transparent)
-(struct orc monster (club) #:transparent)
-(struct hydra monster () #:transparent)
-(struct hydrar monster () #:transparent)
-(struct slime monster (sliminess) #:transparent)
-(struct brigand monster () #:transparent)
-;; A Monster is a (monster Image Nat)
-;; (moster i h) is a monster at position i in the list with health h
-;; Each monster is equipped with the index number,
-;; which is used to identify the current target.
-;;
-;; An Orc is an (orc Nat Nat Nat)
-;; A Slime is a (slime Nat Nat Nat)
-;; A Brigrand is a (brigand Nat Nat)
-;; A Hydra is a (hydra Nat Nat)
-;; A Hydrar is a (hydrar Nat Nat)
-;;
-;; The four monster types all inherit the id and health fields from monster.
-;; Two have additional attributes:
-;; -- (orc i h c) means the orc's club has strength c
-;; -- (slime i h a) means the slime can reduce the player's agility by a
-
-;; -----------------------------------------------------------------------------
-;; THE CONSTANTS IN THE WORLD
-
-;; player attributes
-(define MAX-HEALTH 35)
-(define MAX-AGILITY 35)
-(define MAX-STRENGTH 35)
-(define MAX-ARMOR 35)
-
-;; depending on other player attributes,
-;; the game picks the number of attacks, flailing and stabbing damage
-(define ATTACKS# 4)
-(define STAB-DAMAGE 2)
-(define FLAIL-DAMAGE 3)
-(define MASTURBATE-DAMAGE 5)
-(define HEALING 8)
-(define BLOCK 8)
-
-;; monster attributes
-(define MONSTER# 12)
-(define PER-ROW 4)
-(unless (zero? (remainder MONSTER# PER-ROW))
- (error 'constraint "PER-ROW must divide MONSTER# evenly into rows"))
-
-(define MONSTER-HEALTH0 9)
-(define CLUB-STRENGTH 8)
-(define SLIMINESS 5)
-
-(define HEALTH-DAMAGE -2)
-(define AGILITY-DAMAGE -3)
-(define STRENGTH-DAMAGE -4)
-
-;; string constants
-(define STRENGTH "strength")
-(define AGILITY "agility")
-(define HEALTH "health")
-(define ARMOR "armor")
-(define LOSE "YOU LOSE")
-(define WIN "YOU WIN")
-(define DEAD "DEAD")
-(define REMAINING "Remaining attacks ")
-(define INSTRUCTIONS-2 "Select a monster using the arrow keys")
-(define INSTRUCTIONS-1
- (string-append "Press S to stab a monster | Press F to Flail wildly "
- "| Press H to Heal | Press M to Masturbate"))
-
-;; graphical constants
-(define HEALTH-BAR-HEIGHT 12)
-(define HEALTH-BAR-WIDTH 50)
-
-;; compute constants for image frames
-(define ORC (bitmap "graphics/orc.png"))
-(define HYDRA (bitmap "graphics/hydra.png"))
-(define HYDRAR (bitmap "graphics/hydrar.png"))
-(define SLIME (bitmap "graphics/slime.bmp"))
-(define BRIGAND (bitmap "graphics/brigand.bmp"))
-
-(define PIC-LIST (list ORC HYDRA HYDRAR SLIME BRIGAND))
-(define w (apply max (map image-width PIC-LIST)))
-(define h (apply max (map image-height PIC-LIST)))
-
-;; images: player, monsters, constant texts
-(define PLAYER-IMAGE (bitmap "graphics/player.bmp"))
-
-(define FRAME (rectangle w h 'outline 'white))
-(define TARGET (circle (- (/ w 2) 2) 'outline 'blue))
-
-(define ORC-IMAGE (overlay ORC FRAME))
-(define HYDRA-IMAGE (overlay HYDRA FRAME))
-(define HYDRAR-IMAGE (overlay HYDRAR FRAME))
-(define SLIME-IMAGE (overlay SLIME FRAME))
-(define BRIGAND-IMAGE (overlay BRIGAND FRAME))
-
-(define V-SPACER (rectangle 0 10 "solid" "white"))
-(define H-SPACER (rectangle 10 0 "solid" "white"))
-
-;; fonts & texts & colors
-(define AGILITY-COLOR "blue")
-(define HEALTH-COLOR "crimson")
-(define STRENGTH-COLOR "forest green")
-(define ARMOR-COLOR "goldenrod")
-(define MONSTER-COLOR "crimson")
-(define MESSAGE-COLOR "black")
-(define ATTACK-COLOR "crimson")
-
-(define HEALTH-SIZE (- HEALTH-BAR-HEIGHT 4))
-(define DEAD-TEXT-SIZE (- HEALTH-BAR-HEIGHT 2))
-(define INSTRUCTION-TEXT-SIZE 16)
-(define MESSAGES-SIZE 40)
-
-(define INSTRUCTION-TEXT
- (above
- (text INSTRUCTIONS-2 (- INSTRUCTION-TEXT-SIZE 2) "blue")
- (text INSTRUCTIONS-1 (- INSTRUCTION-TEXT-SIZE 4) "blue")))
-
-(define DEAD-TEXT (text DEAD DEAD-TEXT-SIZE "crimson"))
-
-;
-;
-;
-; ;;; ;;; ;
-; ;; ;;
-; ;; ;; ;;;; ;;; ;; ;;
-; ; ; ; ; ; ; ;; ;
-; ; ; ; ;;;;; ; ; ;
-; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ;
-; ;;; ;;; ;;; ;; ;;;;; ;;; ;;;
-;
-;
-;
-;
-
-;; Start the game
-(define (start-game)
- (big-bang (initialize-orc-world)
- (on-key player-acts-on-monsters)
- (to-draw render-orc-battle)
- (stop-when end-of-orc-battle? render-the-end)))
-
-;; -> OrcWorld
-;; creates an orc-world ready for battling orcs
-(define (initialize-orc-world)
- (define player0 (initialize-player))
- (define lom0 (initialize-monsters))
- (orc-world player0 lom0 (random-number-of-attacks player0) 0))
-
-;; OrcWorld Key-Event -> OrcWorld
-;; act on key events by the player, if the player has attacks left
-(define (player-acts-on-monsters w k)
- (cond
- [(zero? (orc-world-attack# w)) w]
-
- [(key=? "s" k) (stab w)]
- [(key=? "h" k) (heal w)]
- [(key=? "f" k) (flail w)]
- [(key=? "m" k) (masturbate w)]
- [(key=? "b" k) (block w)]
-
- [(key=? "right" k) (move-target w +1)]
- [(key=? "left" k) (move-target w -1)]
- [(key=? "down" k) (move-target w (+ PER-ROW))]
- [(key=? "up" k) (move-target w (- PER-ROW))]
-
- [(key=? "e" k) (end-turn w)]
-;; [(key=? "n" k) (initialize-orc-world)]
-
- [else w])
- (give-monster-turn-if-attack#=0 w)
- w)
-
-;; OrcWorld -> Image
-;; renders the orc world
-(define (render-orc-battle w)
- (render-orc-world w (orc-world-target w) (instructions w)))
-
-;; OrcWorld -> Boolean
-;; is the battle over? i.e., the player lost or all monsters are dead
-(define (end-of-orc-battle? w)
- (or (win? w) (lose? w)))
-
-;; OrcWorld -> Image
-;; render the final orc world
-(define (render-the-end w)
- (render-orc-world w #f (message (if (lose? w) LOSE WIN))))
-
-;; -----------------------------------------------------------------------------
-
-;; WORLD MANAGEMENT
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;
-;
-;
-; ;;;;; ;
-; ; ;
-; ; ;; ;; ;;; ;;;;;
-; ; ;; ; ; ;
-; ; ; ; ; ;
-; ; ; ; ; ;
-; ; ; ; ; ; ;
-; ;;;;; ;;; ;;; ;;;;; ;;;
-;
-;
-;
-;
-
-;; -> Player
-;; create a player with maximal capabilities
-(define (initialize-player)
- (player MAX-HEALTH MAX-AGILITY MAX-STRENGTH 0))
-
-;; -> [Listof Monster]
-;; create a list of random monsters of length MONSTER-NUM,
-(define (initialize-monsters)
- ;; Nat -> Monster
- ;; makes a random monster
- (define (create-monster _)
- (define health (random+ MONSTER-HEALTH0))
- (case (random 4)
- [(0) (orc ORC-IMAGE health (random+ CLUB-STRENGTH))]
- [(1) (hydra HYDRA-IMAGE health)]
- [(2) (hydrar HYDRAR-IMAGE health)]
- [(3) (slime SLIME-IMAGE health (random+ SLIMINESS))]
- [(4) (brigand BRIGAND-IMAGE health)]
- [else (error "can't happen")]))
- (build-list MONSTER# create-monster))
-
-;; Player -> Nat
-;; compute a feasible number of attacks the player may execute
-(define (random-number-of-attacks p)
- (random-quotient (player-agility p)
- ATTACKS#))
-
-;
-;
-;
-; ;;; ;;; ;;;;;;
-; ; ; ; ; ;
-; ; ; ;;;; ;;; ;;; ; ; ;;; ;;; ;;;; ;; ;; ;;;;; ;;;;;
-; ; ; ; ; ; ; ;;; ; ; ; ; ;; ; ; ; ;
-; ;;; ;;;;;; ; ; ; ; ; ; ;;;;;; ; ; ; ;;;;
-; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;
-; ;;; ;; ;;;;; ; ;;;;;; ;; ;;;;; ;;; ;;; ;;; ;;;;;
-; ;
-; ;;;
-;
-;
-
-;; -----------------------------------------------------------------------------
-;; player actions
-
-;; OrcWorld Nat -> Void
-;; Effect: reduces the target by a given amount
-;; > (move-target
-;; (orc-world (player 5 5 5) (list (monster 0 2) (monster 1 3)) 1 0)
-;; 1)
-;; (orc-world (player 5 5 5) (list (monster 0 2) (monster 1 3)) 1 1)
-(define (move-target w n)
- (set-orc-world-target! w (modulo (+ n (orc-world-target w)) MONSTER#)))
-
-;; OrcWorld -> Void
-;; Effect: ends the player's turn by setting the number of attacks to 0
-(define (end-turn w)
- (set-orc-world-attack#! w 0))
-
-;; OrcWorld -> Void
-;; Effect: reduces the number of remaining attacks for this turn
-;; and increases the player's health level
-(define (heal w)
- (decrease-attack# w)
- (player-health+ (orc-world-player w) HEALING))
-
-;; OrcWorld -> Void
-(define (block w)
- (decrease-attack# w)
- (player-armor+ (orc-world-player w) BLOCK))
-
-;; OrcWorld -> Void
-;; Effect: reduces a targeted monster's health
-(define (stab w)
- (decrease-attack# w)
- (define target (current-target w))
- (define damage
- (random-quotient (player-strength (orc-world-player w))
- STAB-DAMAGE))
- (damage-monster target damage))
-
-;; OrcWorld -> Void
-;; Effect: damages a random number of live monsters,
-;; determined by strength of the player
-;; starting with the currently targeted monster
-(define (flail w)
- (decrease-attack# w)
- (define target (current-target w))
- (define alive (filter monster-alive? (orc-world-lom w)))
- (define pick#
- (min
- (random-quotient (player-strength (orc-world-player w))
- FLAIL-DAMAGE)
- (length alive)))
- (define getem (cons target (take alive pick#)))
- (for-each (lambda (m) (damage-monster m 1)) getem))
-
-;; OrcWorld -> Void
-
-;; Effect: reduces player agility by x and 2x damages a random number
-;; of live monsters
-(define (masturbate w)
- (decrease-attack# w)
- (define alive (filter monster-alive? (orc-world-lom w)))
- (define x (random-quotient (player-strength (orc-world-player w))
- MASTURBATE-DAMAGE))
- (define pick# (min x (length alive)))
- (define getem (take alive pick#))
- (player-agility+ (orc-world-player w) (- x))
- (for-each (lambda (m) (damage-monster m (* 2 x))) getem))
-
-;; OrcWorld -> Void
-;; Effect: decrease number of remaining attacks
-(define (decrease-attack# w)
- (set-orc-world-attack#! w (sub1 (orc-world-attack# w))))
-
-;; Monster Nat -> Void
-;; Effect: reduces the hit-strength of a monster
-(define (damage-monster m delta)
- (set-monster-health! m (interval- (monster-health m) delta)))
-
-;; World -> Monster
-(define (current-target w)
- (list-ref (orc-world-lom w) (orc-world-target w)))
-
-;; -----------------------------------------------------------------------------
-;; monster action
-
-;; OrcWorld -> Void
-;; if it is the monsters turn, they attack
-;; > (orc-world (player 4 4 4) empty 3 3)
-;; (orc-world (player 4 4 4) empty 3 3)
-(define (give-monster-turn-if-attack#=0 w)
- (when (zero? (orc-world-attack# w))
- (define player (orc-world-player w))
- (all-monsters-attack-player player (orc-world-lom w))
- (set-orc-world-attack#! w (random-number-of-attacks player))))
-
-;; Player [Listof Monster] -> Void
-;; Each monster attacks the player
-(define (all-monsters-attack-player player lom)
- ;; Monster -> Void
- (define (one-monster-attacks-player monster)
- (define armor (player-armor player))
- (define block (cond
- [(zero? armor) 0]
- [else (random+ armor)]))
- ;; block buffers the damage
- (define (damage d)
- (+ d block))
- ;; reduce player's armor by block
- (player-armor+ player (* -1 block))
- (cond
- [(orc? monster)
- (player-health+ player (damage (random- (orc-club monster))))]
- [(hydra? monster)
- (player-health+ player (damage (random- (monster-health monster))))]
- [(hydrar? monster)
- (player-health+ player (random- (monster-health monster)))]
- [(slime? monster)
- (player-health+ player (damage -1))
- (player-agility+ player (damage (random- (slime-sliminess monster))))]
- [(brigand? monster)
- (case (random 3)
- [(0) (player-health+ player (damage HEALTH-DAMAGE))]
- [(1) (player-agility+ player (damage AGILITY-DAMAGE))]
- [(2) (player-strength+ player (damage STRENGTH-DAMAGE))])]))
- ;; -- IN --
- (for-each one-monster-attacks-player (filter monster-alive? lom)))
-
-;; -----------------------------------------------------------------------------
-;; actions on player
-
-;; [Player -> Nat] [Player Nat -> Void] Nat -> Player Nat -> Void
-;; effect: change player's selector attribute by adding delta, but max out
-(define (player-update! setter selector max-value)
- (lambda (player delta)
- (setter player
- (interval+ (selector player) delta max-value))))
-
-;; Player Nat -> Void
-(define player-health+
- (player-update! set-player-health! player-health MAX-HEALTH))
-
-;; Player Nat -> Void
-(define player-agility+
- (player-update! set-player-agility! player-agility MAX-AGILITY))
-
-;; Player Nat -> Void
-(define player-strength+
- (player-update! set-player-strength! player-strength MAX-STRENGTH))
-
-;; Player Nat -> Void
-(define player-armor+
- (player-update! set-player-armor! player-armor MAX-ARMOR))
-
-;
-;
-;
-; ;;;;; ;; ;
-; ; ; ;
-; ; ; ;;;; ;; ;; ;;; ; ;;;; ;; ;;; ;;; ;; ;; ;;; ;;
-; ; ; ; ; ;; ; ; ;; ; ; ;; ; ;; ; ; ;;
-; ;;;; ;;;;;; ; ; ; ; ;;;;;; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;;
-; ;;; ; ;;;;; ;;; ;;; ;;; ;; ;;;;; ;;;;; ;;;;; ;;; ;;; ;;; ;
-; ;
-; ;;;;
-;
-;
-
-;; OrcWorld Boolean Image -> Image
-;; draws all the monsters and the player, then adds message
-(define (render-orc-world w with-target additional-text)
- (define i-player (render-player (orc-world-player w)))
- (define i-monster (render-monsters (orc-world-lom w) with-target))
- (above V-SPACER
- (beside H-SPACER
- i-player
- H-SPACER H-SPACER H-SPACER
- (above i-monster
- V-SPACER V-SPACER V-SPACER
- additional-text)
- H-SPACER)
- V-SPACER))
-
-;; Player -> Image
-;; render player with three status bars
-(define (render-player p)
- (above/align
- "left"
- (status-bar (player-strength p) MAX-STRENGTH STRENGTH-COLOR STRENGTH)
- V-SPACER
- (status-bar (player-agility p) MAX-AGILITY AGILITY-COLOR AGILITY)
- V-SPACER
- (status-bar (player-health p) MAX-HEALTH HEALTH-COLOR HEALTH)
- V-SPACER
- (status-bar (player-armor p) MAX-ARMOR ARMOR-COLOR ARMOR)
- V-SPACER V-SPACER V-SPACER
- PLAYER-IMAGE))
-
-;; Nat Nat Color String -> Image
-;; creates a labeled rectangle of width/max proportions
-;; assume: (<= width max)
-(define (status-bar v-current v-max color label)
- (define w (* (/ v-current v-max) HEALTH-BAR-WIDTH))
- (define f (rectangle w HEALTH-BAR-HEIGHT 'solid color))
- (define b (rectangle HEALTH-BAR-WIDTH HEALTH-BAR-HEIGHT 'outline color))
- (define bar (overlay/align 'left 'top f b))
- (beside bar H-SPACER (text label HEALTH-SIZE color)))
-
-;; String -> Image
-(define (message str)
- (text str MESSAGES-SIZE MESSAGE-COLOR))
-
-;; OrcWorld -> Image
-(define (instructions w)
- (define na (number->string (orc-world-attack# w)))
- (define ra (string-append REMAINING na))
- (above (text ra INSTRUCTION-TEXT-SIZE ATTACK-COLOR) INSTRUCTION-TEXT))
-
-;; [Listof Monster] [Opt Nat] -> Image
-;; add all monsters on lom, including status bar
-;; label the target unless it isn't called for
-(define (render-monsters lom with-target)
- ;; the currently targeted monster (if needed)
- (define target
- (if (number? with-target)
- (list-ref lom with-target)
- 'a-silly-symbol-that-cannot-be-eq-to-an-orc))
-
- ;; Monster -> Image
- (define (render-one-monster m)
- (define image
- (if (eq? m target)
- (overlay TARGET (monster-image m))
- (monster-image m)))
- (define health (monster-health m))
- (define health-bar
- (if (= health 0)
- (overlay DEAD-TEXT (status-bar 0 1 'white ""))
- (status-bar health MONSTER-HEALTH0 MONSTER-COLOR "")))
- (above health-bar image))
-
- (arrange (map render-one-monster lom)))
-
-;; [Listof Image] -> Image
-;; break a list of images into rows of PER-ROW
-(define (arrange lom)
- (cond
- [(empty? lom) empty-image]
- [else (define row-image (apply beside (take lom PER-ROW)))
- (above row-image (arrange (drop lom PER-ROW)))]))
-
-
-;
-;
-;
-; ;;;;;; ;; ;;;
-; ; ; ; ; ;
-; ; ; ;; ;; ;;; ; ;
-; ;;; ;; ; ; ;; ;
-; ; ; ; ; ; ; ;
-; ; ; ; ; ; ;
-; ; ; ; ; ; ;;
-; ;;;;;; ;;; ;;; ;;; ;; ;;
-;
-;
-;
-;
-
-;; OrcWorld -> Boolean
-;; Has the player won?
-;; > (orc-world (player 1 1 1) (list (monster 0 0)) 0 0)
-;; #t
-(define (win? w)
- (all-dead? (orc-world-lom w)))
-
-;; OrcWorld -> Boolean
-;; Has the player lost?
-;; > (lose? (orc-world (player 0 2 2) empty 0 0))
-;; #t
-(define (lose? w)
- (player-dead? (orc-world-player w)))
-
-;; Player -> Boolean
-;; Is the player dead?
-;; > (orc-world (player 1 0 1) empty 0 0)
-;; #t
-(define (player-dead? p)
- (or (= (player-health p) 0)
- (= (player-agility p) 0)
- (= (player-strength p) 0)))
-
-;; [Listof Monster] -> Boolean
-;; Are all the monsters in the list dead?s
-;; > (all-dead? (orc-world (player 5 5 5) (list (monster 1 0)) 0 1))
-;; #t
-(define (all-dead? lom)
- (not (ormap monster-alive? lom)))
-
-;; Monster -> Boolean
-;; Is the monster alive?
-(define (monster-alive? m)
- (> (monster-health m) 0))
-
-
-;
-;
-;
-; ;;
-; ;
-; ; ; ;; ;; ;; ;; ;;;;;
-; ; ; ; ; ; ; ; ;
-; ; ; ; ; ;; ;;;;
-; ;;; ; ; ;; ;
-; ; ; ; ;; ; ; ; ;
-; ;;; ;;; ;; ;; ;; ;; ;;;;;
-;
-;
-;
-;
-
-;; Nat Nat -> Nat
-;; a random number between 1 and the (quotient x y)
-(define (random-quotient x y)
- (define div (quotient x y))
- (if (> 0 div) 0 (random+ (add1 div))))
-
-;; Nat -> Nat
-;; (random+ n) creates a random number in [1,n]
-(define (random+ n)
- (add1 (random n)))
-
-;; Nat -> Nat
-;; (random+ n) creates a random number in [-n,-1]
-(define (random- n)
- (- (add1 (random n))))
-
-;; Nat Nat [Nat] -> Nat
-;; subtract n from m but stay in [0,max-value]
-(define (interval- n m (max-value 100))
- (min (max 0 (- n m)) max-value))
-
-;; Nat Nat [Nat] -> Nat
-;; subtract n from m but stay in [0,max-value]
-(define (interval+ n m (max-value 100))
- (interval- n (- m) max-value))
-
-;
-;
-;
-; ;;;;;;
-; ; ; ;
-; ; ;;;; ;;;;; ;;;;; ;;;;;
-; ; ; ; ; ; ; ; ;
-; ; ;;;;;; ;;;; ; ;;;;
-; ; ; ; ; ;
-; ; ; ; ; ; ; ; ;
-; ;;; ;;;;; ;;;;; ;;; ;;;;;
-;
-;
-;
-;
-
-(module+ test
-
- (require rackunit rackunit/text-ui)
-
- ;; Test structs
- (define WORLD0 (orc-world (initialize-player) empty 0 0))
- (define WORLD1 (struct-copy orc-world (initialize-orc-world) [attack# 5]))
- (define (WORLD2) (struct-copy orc-world (initialize-orc-world) [attack# 0]))
- ;; these are random worlds
- (define AN-ORC (orc 'image 0 5))
- (define A-SLIME (slime 'image 1 6))
- (define A-HYDRA (hydra 'image 2))
- (define A-BRIGAND (brigand 'image 3))
-
- ;; testing move-target
-
- (check-equal? (let ([w (orc-world 'dummy 'dummy 'dummy 0)])
- (move-target w +1)
- w)
- (orc-world 'dummy 'dummy 'dummy 1))
- (check-equal? (let ([w (orc-world 'dummy 'dummy 'dummy 0)])
- (move-target w -1)
- w)
- (orc-world 'dummy 'dummy 'dummy (- MONSTER# 1)))
- (check-equal? (let ([w (orc-world 'dummy 'dummy 'dummy 0)])
- (move-target w (- PER-ROW))
- w)
- (orc-world 'dummy 'dummy 'dummy (- MONSTER# PER-ROW)))
- (check-equal? (let ([w (orc-world 'dummy 'dummy 'dummy 1)])
- (move-target w (+ PER-ROW))
- w)
- (orc-world 'dummy 'dummy 'dummy (+ PER-ROW 1)))
- (check-equal? (begin
- (move-target WORLD1 0)
- WORLD1)
- WORLD1)
- (check-equal? (let ()
- (define w (struct-copy orc-world WORLD1))
- (move-target w 4)
- w)
- (struct-copy orc-world WORLD1 [target (+ 4 (orc-world-target WORLD1))]))
- (check-equal? (current-target WORLD1)
- (first (orc-world-lom WORLD1)))
-
- ;; testing basic player manipulations
-
- (check-equal? (let ([p (player 1 0 0 0)])
- (player-health+ p 5)
- p)
- (player 6 0 0 0))
- (check-equal? (let ([p (player 0 1 0 0)])
- (player-agility+ p 5)
- p)
- (player 0 6 0 0))
-
- (check-equal? (let ([p (player 0 0 1 0)])
- (player-strength+ p 5)
- p)
- (player 0 0 6 0))
-
- (check-equal? (let ([p (player 5 5 5 0)])
- (all-monsters-attack-player p (list (orc 'image 1 1)))
- p)
- (player 4 5 5 0))
-
- (check-equal? (let ([p (player 5 5 5 0)])
- (all-monsters-attack-player p (list (hydra 'image 1)))
- p)
- (player 4 5 5 0))
-
- (check-equal? (let ([p (player 5 5 5 0)])
- (all-monsters-attack-player p (list (slime 'image 1 1)))
- p)
- (player 4 4 5 0))
-
- (check member
- (let ([p (player 5 5 5 0)])
- (all-monsters-attack-player p (list (brigand 'image 1)))
- p)
- (list (player 3 5 5 0)
- (player 5 2 5 0)
- (player 5 5 1 0)))
-
- ;; Properties
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; Property:
- ;; the output will always be in [1, (/ X Y)]
- (define (prop:rand-frac-range i)
- (test-begin
- (for ([i (in-range i)])
- (define x (random 4294967087))
- (define y (random 4294967087))
- (check-true (<= 1 (random-quotient x y) (add1 (/ x y)))))))
-
- ;; Property:
- ;; The number of the monsters in the list is equal to
- ;; MONSTER-NUM
- (define (prop:monster-init-length i)
- (test-begin
- (for ([i (in-range i)])
- (check-true (= MONSTER#
- (length (initialize-monsters)))))))
-
- ;; Property:
- ;; the player will have less points in at least one of its
- ;; fields
- (define (prop:monster-attack-player-dec i)
- (test-begin
- (for ([i (in-range i)])
- (define pl (player MAX-HEALTH MAX-AGILITY MAX-STRENGTH 0))
- (define mon (first (initialize-monsters)))
- (begin
- (all-monsters-attack-player pl (list mon))
- (check-true (or (< (player-health pl) MAX-HEALTH)
- (< (player-agility pl) MAX-AGILITY)
- (< (player-strength pl) MAX-STRENGTH)))))))
-
- ;; Property:
- ;; If there are monster, then the player will
- ;; have less points in at least one of its fields
- (define (prop:monsters-attack-player-dec i)
- (test-begin
- (for ([i (in-range i)])
- (define pl (player MAX-HEALTH MAX-AGILITY MAX-STRENGTH 0))
- (define monsters (initialize-monsters))
- (define wor (orc-world pl monsters 0 0))
- (begin
- (all-monsters-attack-player pl monsters)
- (check-true (or (< (player-health pl) MAX-HEALTH)
- (< (player-agility pl) MAX-AGILITY)
- (< (player-strength pl) MAX-STRENGTH)))))))
-
- ;; Property: The health of the targeted monster, m,
- ;; is less than what it was. and
- ;; [(sub1 (monster-health m)),
- ;; (- (monster-health m)
- ;; (/ (player-strength (orc-world-player w)) 2))]
- (define (prop:stab!-health i)
- (test-begin
- (for ([i (in-range i)])
- (begin (define mon (first(initialize-monsters)))
- (define ht (monster-health mon))
- (define pl (random-player))
- (define w (orc-world pl (list mon) 2 0))
- (stab w)
- (check-true (> ht (monster-health (first (orc-world-lom w)))))))))
-
- ;; random-player: -> Player
- ;; creates a random player
- (define (random-player)
- (player (add1 (random MAX-HEALTH))
- (add1 (random MAX-AGILITY))
- (add1 (random MAX-STRENGTH))
- 0))
-
- ;; testing initializers
- (prop:monster-init-length 1000)
- (check-true (monster? (first (initialize-monsters))))
- (check-true (> 10 (monster-health (first (initialize-monsters)))))
- (check-equal? (length (initialize-monsters)) MONSTER#)
- (check-equal? (length (orc-world-lom WORLD1)) MONSTER#)
- (check-true (>= (let ([p (initialize-player)])
- (player-health p))
- (let ([p (initialize-player)])
- (all-monsters-attack-player p (list AN-ORC))
- (player-health p))))
- (check-true (> (player-health (initialize-player))
- (let ([p (initialize-player)])
- (all-monsters-attack-player p (list A-HYDRA))
- (player-health p))))
- (check-true (< (let ([p (initialize-player)])
- (all-monsters-attack-player p (list A-SLIME))
- (player-agility p))
- (let ([p (initialize-player)])
- (player-agility p))))
- (check-true (let ([p (initialize-player)])
- (all-monsters-attack-player p (list A-BRIGAND))
- (or (= (player-health p)
- (- (player-health (initialize-player)) 2))
- (= (player-agility p)
- (- (player-agility (initialize-player)) 3))
- (= (player-strength p)
- (- (player-strength (initialize-player)) 4)))))
- (check-equal? (length (orc-world-lom WORLD1)) MONSTER#)
- (check-equal? (orc-world-player WORLD1) (orc-world-player WORLD1))
-
- ;; testing the-monster's attacks
-
- (prop:monster-attack-player-dec 1000)
- (prop:monsters-attack-player-dec 1000)
- (check-true (or (> (player-health (orc-world-player (WORLD2)))
- (player-health (orc-world-player
- (let ([w (WORLD2)])
- (all-monsters-attack-player (orc-world-player w) (orc-world-lom w))
- w))))
- (> (player-strength (orc-world-player (WORLD2)))
- (player-strength (orc-world-player
- (let ([w (WORLD2)])
- (all-monsters-attack-player (orc-world-player w) (orc-world-lom w))
- w))))
- (> (player-agility (orc-world-player (WORLD2)))
- (player-agility (orc-world-player
- (let ([w (WORLD2)])
- (all-monsters-attack-player (orc-world-player w) (orc-world-lom w))
- w))))))
-
- ;; testing the player's actions
-
- (prop:stab!-health 1000)
- (test-begin (define o (orc 'image 0 5))
- (damage-monster o 5)
- (check-equal? o (orc 'image 0 5)))
- (test-begin (define o (orc 'image 0 5))
- (damage-monster o 0)
- (check-equal? o (orc 'image 0 5)))
- (check-equal? (player-health (orc-world-player
- (let ()
- (define w (struct-copy orc-world WORLD1))
- (heal w)
- w)))
- (min MAX-HEALTH
- (+ 8 (player-health (orc-world-player WORLD1)))))
-
- (check-equal? (length (orc-world-lom
- (let ()
- (define w (struct-copy orc-world WORLD1))
- (stab w)
- w)))
- MONSTER#)
-
- ;; testing game predicates
-
- (check-false (lose? WORLD0))
- (check-true (lose? (orc-world (player 0 30 30 0) empty 0 0)))
- (check-true (all-dead? (list (orc 'image 0 0) (hydra 'image 0))))
- (check-true (all-dead? (list AN-ORC)))
- (check-true (win? (orc-world (initialize-player) (list (orc 'image 0 0)) 0 0)))
- (check-true (win? (orc-world (initialize-player) (list AN-ORC) 0 0)))
- (check-true (end-of-orc-battle? (orc-world (initialize-player) (list (orc 'image 0 0)) 0 0)))
- (check-true (end-of-orc-battle? (orc-world (initialize-player) (list AN-ORC) 0 0)))
- (check-true (end-of-orc-battle? (orc-world (player 0 30 30 0) empty 0 0)))
- (check-true (player-dead? (player 0 2 5 0)))
- (check-false (player-dead? (initialize-player)))
- (check-false (not (monster-alive? A-HYDRA)))
- (check-true (monster-alive? (monster 'image 1)))
- (check-false (monster-alive? (orc 'image 0 0)))
-
- ;; testing utilities
-
- (prop:rand-frac-range 1000)
-
- "all tests run")
diff --git a/net/ricketyspace/ror/eleven/lazy.rkt b/net/ricketyspace/ror/eleven/lazy.rkt
deleted file mode 100644
index 6f54719..0000000
--- a/net/ricketyspace/ror/eleven/lazy.rkt
+++ /dev/null
@@ -1,23 +0,0 @@
-#lang racket
-
-(define (make-lazy+ i)
- (lambda ()
- (apply + (build-list (* 500 i) values))))
-
-
-(define long-big-list (build-list 5000 make-lazy+))
-
-
-(define (compute-every-1000th l)
- (for/list ([thunk l]
- [i (in-naturals)]
- #:when (zero? (remainder i 1000)))
- (thunk)))
-
-
-(define (memoize.v2 suspended-c)
- (define (hidden)
- (define the-value (suspended-c))
- (set! hidden (lambda () the-value))
- the-value)
- (lambda () (hidden)))
diff --git a/net/ricketyspace/ror/five/guess.rkt b/net/ricketyspace/ror/five/guess.rkt
deleted file mode 100644
index f7a117a..0000000
--- a/net/ricketyspace/ror/five/guess.rkt
+++ /dev/null
@@ -1,75 +0,0 @@
-#lang racket
-(require 2htdp/universe 2htdp/image)
-
-(struct interval (small big guesses))
-
-;;; constants
-(define TEXT-SIZE 12)
-(define HELP-TEXT
- (text "↑ for larger numbers, ↓ for smaller ones"
- TEXT-SIZE
- "blue"))
-(define HELP-TEXT2
- (text "Press = when your number is guessed; q to quit."
- TEXT-SIZE
- "blue"))
-(define COLOR "red")
-(define WIDTH (+ (image-width HELP-TEXT2) 10))
-(define HEIGHT 150)
-(define SIZE 72)
-(define TEXT-X 3)
-(define TEXT-UPPER-Y 10)
-(define TEXT-LOWER-Y 135)
-(define GUESSES-SIZE 12)
-(define GUESSES-COLOR "green")
-(define MT-SC
- (place-image/align
- HELP-TEXT TEXT-X TEXT-UPPER-Y "left" "top"
- (place-image/align
- HELP-TEXT2 TEXT-X TEXT-LOWER-Y "left" "bottom"
- (empty-scene WIDTH HEIGHT))))
-
-;; main
-(define (start lower upper)
- (big-bang (interval lower upper 0)
- (on-key deal-with-guess)
- (to-draw render)
- (stop-when single? render-last-scene)))
-
-;; key events
-(define (deal-with-guess w key)
- (cond [(key=? key "up") (bigger w)]
- [(key=? key "down") (smaller w)]
- [(key=? key "q") (stop-with w)]
- [(key=? key "=") (stop-with w)]
- [else w]))
-
-(define (smaller w)
- (interval (interval-small w)
- (max (interval-small w) (sub1 (guess w)))
- (+ 1 (interval-guesses w))))
-
-(define (bigger w)
- (interval (min (interval-big w) (add1 (guess w)))
- (interval-big w)
- (+ 1 (interval-guesses w))))
-
-(define (guess w)
- (quotient (+ (interval-small w) (interval-big w)) 2))
-
-(define (render w)
- (overlay (overlay/offset
- (text (number->string (guess w)) SIZE COLOR) 0 40
- (text (number->string (interval-guesses w))
- GUESSES-SIZE GUESSES-COLOR))
- MT-SC))
-
-(define (render-last-scene w)
- (overlay (overlay/offset
- (text "End" SIZE COLOR) 0 40
- (text (number->string (interval-guesses w))
- GUESSES-SIZE GUESSES-COLOR))
- MT-SC))
-
-(define (single? w)
- (= (interval-small w) (interval-big w)))
diff --git a/net/ricketyspace/ror/five/loco.rkt b/net/ricketyspace/ror/five/loco.rkt
deleted file mode 100644
index 977c976..0000000
--- a/net/ricketyspace/ror/five/loco.rkt
+++ /dev/null
@@ -1,59 +0,0 @@
-#lang racket
-(require 2htdp/universe 2htdp/image)
-
-(define WIDTH 300)
-(define HEIGHT 300)
-(define CAROILLE (bitmap/file "resources/caroille.png"))
-(define CAROILLE-WIDTH (image-width CAROILLE))
-
-;;;
-;;; If the car is placed at X = 1/2 its width, its back will be
-;;; touching the left edge of the World.
-;;;
-;;; If the car is place at X = - 1/2 its width, its front will be touching
-;;; the left edge of the World.
-;;;
-(define CAROILLE-WIDTH-HALF (/ CAROILLE-WIDTH 2.0))
-
-;;; Structure to represent the X position of two cars in animation.
-(struct cars (one two))
-
-(define (caroille-past-right-edge? pos)
- (> pos (- WIDTH CAROILLE-WIDTH-HALF)))
-
-(define (caroille-fully-past-right-edge? pos)
- (>= pos (+ WIDTH CAROILLE-WIDTH-HALF)))
-
-(define (caroille-fully-past-left-edge? pos)
- (>= pos CAROILLE-WIDTH-HALF))
-
-(define (caroille-fully-inside? pos)
- (and (caroille-fully-past-left-edge? pos)
- (not (caroille-past-right-edge? pos))))
-
-(define (move caroilles)
- (let ((caroille-one (cars-one caroilles))
- (caroille-two (cars-two caroilles)))
- (cond
- ;; Case set I - one of the cars is fully inside.
- ((caroille-fully-inside? caroille-one)
- (cars (+ 1 caroille-one) caroille-two))
- ((caroille-fully-inside? caroille-two)
- (cars caroille-one (+ 1 caroille-two)))
- ;; Case set II - one of the cars disappeared into the right edge.
- ((caroille-fully-past-right-edge? caroille-one)
- (cars (- CAROILLE-WIDTH-HALF) (+ 1 caroille-two)))
- ((caroille-fully-past-right-edge? caroille-two)
- (cars (+ 1 caroille-one) (- CAROILLE-WIDTH-HALF)))
- ;; Case else - Both cars are partially out.
- (else (cars (+ 1 caroille-one) (+ 1 caroille-two))))))
-
-(define (draw-cars caroilles)
- (place-image CAROILLE (cars-one caroilles) (/ HEIGHT 2)
- (place-image CAROILLE (cars-two caroilles) (/ HEIGHT 2)
- (empty-scene WIDTH HEIGHT))))
-
-(define (start)
- (big-bang (cars CAROILLE-WIDTH-HALF (- CAROILLE-WIDTH-HALF))
- (on-tick move)
- (to-draw draw-cars)))
diff --git a/net/ricketyspace/ror/five/resources/caroille.png b/net/ricketyspace/ror/five/resources/caroille.png
deleted file mode 100644
index 052cc58..0000000
--- a/net/ricketyspace/ror/five/resources/caroille.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/five/resources/caroille.svg b/net/ricketyspace/ror/five/resources/caroille.svg
deleted file mode 100644
index eb4db63..0000000
--- a/net/ricketyspace/ror/five/resources/caroille.svg
+++ /dev/null
@@ -1,125 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<!-- Created with Inkscape (http://www.inkscape.org/) -->
-
-<svg
- xmlns:dc="http://purl.org/dc/elements/1.1/"
- xmlns:cc="http://creativecommons.org/ns#"
- xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- xmlns:svg="http://www.w3.org/2000/svg"
- xmlns="http://www.w3.org/2000/svg"
- xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
- xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
- width="80"
- height="80"
- viewBox="0 0 21.166666 21.166667"
- version="1.1"
- id="svg8"
- inkscape:version="0.92.3 (2405546, 2018-03-11)"
- sodipodi:docname="caroille.svg">
- <title
- id="title3715">caroille</title>
- <defs
- id="defs2">
- <inkscape:perspective
- sodipodi:type="inkscape:persp3d"
- inkscape:vp_x="1.8428503 : 18.575596 : 1"
- inkscape:vp_y="0 : 999.99999 : 0"
- inkscape:vp_z="28.301183 : 18.575596 : 1"
- inkscape:persp3d-origin="15.072016 : 14.165874 : 1"
- id="perspective3723" />
- </defs>
- <sodipodi:namedview
- id="base"
- pagecolor="#ffffff"
- bordercolor="#666666"
- borderopacity="1.0"
- inkscape:pageopacity="0.0"
- inkscape:pageshadow="2"
- inkscape:zoom="3.959798"
- inkscape:cx="72.620745"
- inkscape:cy="61.452165"
- inkscape:document-units="mm"
- inkscape:current-layer="layer1"
- showgrid="false"
- units="px"
- showguides="false"
- inkscape:window-width="1280"
- inkscape:window-height="800"
- inkscape:window-x="0"
- inkscape:window-y="0"
- inkscape:window-maximized="0" />
- <metadata
- id="metadata5">
- <rdf:RDF>
- <cc:Work
- rdf:about="">
- <dc:format>image/svg+xml</dc:format>
- <dc:type
- rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
- <dc:title>caroille</dc:title>
- <cc:license
- rdf:resource="http://creativecommons.org/publicdomain/zero/1.0/" />
- <dc:date>2018-04-02</dc:date>
- <dc:creator>
- <cc:Agent>
- <dc:title>rsiddharth &lt;s@ricketyspace.net&gt;</dc:title>
- </cc:Agent>
- </dc:creator>
- <dc:subject>
- <rdf:Bag>
- <rdf:li>car</rdf:li>
- </rdf:Bag>
- </dc:subject>
- </cc:Work>
- <cc:License
- rdf:about="http://creativecommons.org/publicdomain/zero/1.0/">
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#Reproduction" />
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#Distribution" />
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#DerivativeWorks" />
- </cc:License>
- </rdf:RDF>
- </metadata>
- <g
- inkscape:label="Layer 1"
- inkscape:groupmode="layer"
- id="layer1"
- transform="translate(0,-275.83332)">
- <g
- id="g3759"
- transform="matrix(1.6602564,0,0,1.6602564,-10.597836,-177.21015)"
- inkscape:export-xdpi="96"
- inkscape:export-ydpi="96">
- <rect
- ry="0.8018086"
- style="stroke-width:0.26458332"
- y="277.95703"
- x="7.550364"
- height="3.4745038"
- width="10.423512"
- id="rect3717" />
- <circle
- style="stroke-width:0.26458332"
- r="1.1692964"
- cy="281.3313"
- cx="9.254199"
- id="path3719" />
- <circle
- id="circle3721"
- cx="15.969346"
- cy="281.49835"
- r="1.1692964"
- style="stroke-width:0.26458332" />
- <rect
- ry="1.1693041"
- style="stroke-width:0.24171647"
- y="275.9859"
- x="9.7219286"
- height="2.7395124"
- width="5.9133382"
- id="rect3753" />
- </g>
- </g>
-</svg>
diff --git a/net/ricketyspace/ror/five/resources/ufo-fart.png b/net/ricketyspace/ror/five/resources/ufo-fart.png
deleted file mode 100644
index 13d1c4a..0000000
--- a/net/ricketyspace/ror/five/resources/ufo-fart.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/five/resources/ufo-fart.svg b/net/ricketyspace/ror/five/resources/ufo-fart.svg
deleted file mode 100644
index cf86021..0000000
--- a/net/ricketyspace/ror/five/resources/ufo-fart.svg
+++ /dev/null
@@ -1,188 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<!-- Created with Inkscape (http://www.inkscape.org/) -->
-
-<svg
- xmlns:dc="http://purl.org/dc/elements/1.1/"
- xmlns:cc="http://creativecommons.org/ns#"
- xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- xmlns:svg="http://www.w3.org/2000/svg"
- xmlns="http://www.w3.org/2000/svg"
- xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
- xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
- width="50"
- height="50"
- viewBox="0 0 13.229166 13.229167"
- version="1.1"
- id="svg8"
- inkscape:version="0.92.3 (2405546, 2018-03-11)"
- sodipodi:docname="ufo-gas.svg">
- <title
- id="title10">UFO Fart</title>
- <defs
- id="defs2" />
- <sodipodi:namedview
- id="base"
- pagecolor="#ffffff"
- bordercolor="#666666"
- borderopacity="1.0"
- inkscape:pageopacity="0.0"
- inkscape:pageshadow="2"
- inkscape:zoom="7.9195959"
- inkscape:cx="19.4951"
- inkscape:cy="22.795424"
- inkscape:document-units="mm"
- inkscape:current-layer="layer1"
- showgrid="false"
- units="px"
- inkscape:window-width="1280"
- inkscape:window-height="800"
- inkscape:window-x="0"
- inkscape:window-y="0"
- inkscape:window-maximized="0" />
- <metadata
- id="metadata5">
- <rdf:RDF>
- <cc:Work
- rdf:about="">
- <dc:format>image/svg+xml</dc:format>
- <dc:type
- rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
- <dc:title>UFO Fart</dc:title>
- <cc:license
- rdf:resource="http://creativecommons.org/publicdomain/zero/1.0/" />
- <dc:date>2018-04-17</dc:date>
- <dc:creator>
- <cc:Agent>
- <dc:title>rsiddharth &lt;s@ricketyspace.net&gt;</dc:title>
- </cc:Agent>
- </dc:creator>
- </cc:Work>
- <cc:License
- rdf:about="http://creativecommons.org/publicdomain/zero/1.0/">
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#Reproduction" />
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#Distribution" />
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#DerivativeWorks" />
- </cc:License>
- </rdf:RDF>
- </metadata>
- <g
- inkscape:label="Layer 1"
- inkscape:groupmode="layer"
- id="layer1"
- transform="translate(0,-283.77082)">
- <g
- id="g160">
- <circle
- style="fill:#ffffff;stroke-width:0.09590441"
- r="0.071714237"
- cy="288.4332"
- cx="4.474267"
- id="circle38" />
- </g>
- <g
- id="g202"
- inkscape:export-xdpi="76.796082"
- inkscape:export-ydpi="76.796082">
- <g
- id="g180">
- <circle
- style="stroke-width:0.20158729"
- r="0.53453904"
- cy="285.58438"
- cx="6.4067097"
- id="circle20" />
- <circle
- style="fill:#ffffff;stroke-width:0.06017532"
- r="0.044997171"
- cy="285.91135"
- cx="6.4122667"
- id="circle22" />
- </g>
- <g
- id="g132">
- <circle
- style="stroke-width:0.42837298"
- r="1.1358955"
- cy="294.70496"
- cx="2.898797"
- id="circle42" />
- <circle
- style="fill:#ffffff;stroke-width:0.12787254"
- r="0.095618986"
- cy="295.48981"
- cx="2.5584671"
- id="circle44" />
- </g>
- <circle
- id="circle36"
- cx="4.920023"
- cy="287.93967"
- r="0.85192156"
- style="stroke-width:0.32127973"
- transform="translate(0,9.1666667e-6)" />
- <g
- id="g176">
- <circle
- style="stroke-width:0.32127973"
- r="0.85192156"
- cy="287.83945"
- cx="8.294301"
- id="circle48" />
- <circle
- style="fill:#ffffff;stroke-width:0.09590441"
- r="0.071714237"
- cy="288.35379"
- cx="8.6660032"
- id="circle50" />
- </g>
- <g
- id="g136">
- <circle
- id="path12"
- cx="3.9511709"
- cy="291.24713"
- r="1.2528259"
- style="stroke-width:0.47247022" />
- <circle
- id="path14"
- cx="3.5711958"
- cy="292.09247"
- r="0.10546212"
- style="fill:#ffffff;stroke-width:0.1410359" />
- </g>
- <g
- id="g152">
- <circle
- style="stroke-width:0.47247022"
- r="1.2528259"
- cy="291.31396"
- cx="9.7308741"
- id="circle54" />
- <circle
- style="fill:#ffffff;stroke-width:0.1410359"
- r="0.10546212"
- cy="292.10916"
- cx="10.269638"
- id="circle56" />
- </g>
- <g
- id="g156">
- <circle
- id="circle66"
- cx="10.549387"
- cy="294.57132"
- r="1.1358955"
- style="stroke-width:0.42837298" />
- <circle
- id="circle68"
- cx="10.976822"
- cy="295.35028"
- r="0.095618986"
- style="fill:#ffffff;stroke-width:0.12787254" />
- </g>
- </g>
- </g>
-</svg>
diff --git a/net/ricketyspace/ror/five/resources/zarking-ufo.png b/net/ricketyspace/ror/five/resources/zarking-ufo.png
deleted file mode 100644
index bd5eb43..0000000
--- a/net/ricketyspace/ror/five/resources/zarking-ufo.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/five/resources/zarking-ufo.svg b/net/ricketyspace/ror/five/resources/zarking-ufo.svg
deleted file mode 100644
index 84b8844..0000000
--- a/net/ricketyspace/ror/five/resources/zarking-ufo.svg
+++ /dev/null
@@ -1,128 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-<!-- Created with Inkscape (http://www.inkscape.org/) -->
-
-<svg
- xmlns:dc="http://purl.org/dc/elements/1.1/"
- xmlns:cc="http://creativecommons.org/ns#"
- xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- xmlns:svg="http://www.w3.org/2000/svg"
- xmlns="http://www.w3.org/2000/svg"
- xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
- xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
- width="100"
- height="100"
- viewBox="0 0 26.458333 26.458334"
- version="1.1"
- id="svg8"
- inkscape:version="0.92.3pre0 (0ab9bec, 2018-03-03)"
- sodipodi:docname="zarking-ufo.svg">
- <title
- id="title4518">Zarking UFO</title>
- <defs
- id="defs2" />
- <sodipodi:namedview
- id="base"
- pagecolor="#ffffff"
- bordercolor="#666666"
- borderopacity="1.0"
- inkscape:pageopacity="0.0"
- inkscape:pageshadow="2"
- inkscape:zoom="0.98994949"
- inkscape:cx="52.159535"
- inkscape:cy="240.12864"
- inkscape:document-units="mm"
- inkscape:current-layer="layer1"
- showgrid="false"
- units="px"
- inkscape:window-width="1280"
- inkscape:window-height="800"
- inkscape:window-x="0"
- inkscape:window-y="0"
- inkscape:window-maximized="0" />
- <metadata
- id="metadata5">
- <rdf:RDF>
- <cc:Work
- rdf:about="">
- <dc:format>image/svg+xml</dc:format>
- <dc:type
- rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
- <dc:title>Zarking UFO</dc:title>
- <cc:license
- rdf:resource="http://creativecommons.org/publicdomain/zero/1.0/" />
- <dc:date>2018-03-09</dc:date>
- <dc:creator>
- <cc:Agent>
- <dc:title>rsiddharth &lt;s@ricketyspace.net&gt;</dc:title>
- </cc:Agent>
- </dc:creator>
- </cc:Work>
- <cc:License
- rdf:about="http://creativecommons.org/publicdomain/zero/1.0/">
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#Reproduction" />
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#Distribution" />
- <cc:permits
- rdf:resource="http://creativecommons.org/ns#DerivativeWorks" />
- </cc:License>
- </rdf:RDF>
- </metadata>
- <g
- inkscape:label="Layer 1"
- inkscape:groupmode="layer"
- id="layer1"
- transform="translate(0,-270.54165)">
- <path
- style="opacity:1;fill:#000000;fill-opacity:1;stroke:#000000;stroke-width:0;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
- id="path4602"
- sodipodi:type="arc"
- sodipodi:cx="16.591591"
- sodipodi:cy="284.83923"
- sodipodi:rx="0.04593695"
- sodipodi:ry="0.0083521726"
- sodipodi:start="0"
- sodipodi:end="3.1415927"
- sodipodi:open="true"
- d="m 16.637528,284.83923 a 0.04593695,0.00835217 0 0 1 -0.02297,0.007 0.04593695,0.00835217 0 0 1 -0.04594,0 0.04593695,0.00835217 0 0 1 -0.02297,-0.007" />
- <g
- id="g4627"
- transform="matrix(5.4364839,0,0,5.4364839,-58.979175,-1255.7408)">
- <path
- transform="scale(1,-1)"
- d="m 14.843864,-283.24774 a 1.4941016,1.4941016 0 0 1 -0.747051,1.29393 1.4941016,1.4941016 0 0 1 -1.494102,0 1.4941016,1.4941016 0 0 1 -0.747051,-1.29393"
- sodipodi:open="true"
- sodipodi:end="3.1415927"
- sodipodi:start="0"
- sodipodi:ry="1.4941016"
- sodipodi:rx="1.4941016"
- sodipodi:cy="-283.24774"
- sodipodi:cx="13.349762"
- sodipodi:type="arc"
- id="path4593"
- style="opacity:1;fill:#000000;fill-opacity:1;stroke:#000000;stroke-width:0;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
- <path
- inkscape:connector-curvature="0"
- id="rect4600"
- d="m 11.32607,283.91839 c 1.383215,-10e-6 2.766429,0 4.149644,0 -0.187618,-0.20965 -0.375238,-0.4193 -0.562857,-0.62894 -1.014054,-0.009 -2.028106,-0.0197 -3.04216,-0.0296 -0.181543,0.21952 -0.363085,0.43904 -0.544627,0.65857 z"
- style="opacity:1;fill:#000000;fill-opacity:1;stroke:#000000;stroke-width:0;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
- <path
- d="m 14.445777,283.94208 a 1.0925874,0.37207031 0 0 1 -0.546294,0.32222 1.0925874,0.37207031 0 0 1 -1.092587,0 1.0925874,0.37207031 0 0 1 -0.546294,-0.32222"
- sodipodi:open="true"
- sodipodi:end="3.1415927"
- sodipodi:start="0"
- sodipodi:ry="0.37207031"
- sodipodi:rx="1.0925874"
- sodipodi:cy="283.94208"
- sodipodi:cx="13.353189"
- sodipodi:type="arc"
- id="path4607"
- style="opacity:1;fill:#000000;fill-opacity:1;stroke:#000000;stroke-width:0;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
- <path
- inkscape:connector-curvature="0"
- id="path4609"
- d="m 12.522043,282.31051 c -0.03576,0.11467 -0.06681,0.23061 -0.09375,0.34765 0.02456,0.0134 0.01871,0.058 0.05273,0.0566 0.03764,-0.0375 0.0043,-0.11891 0.06641,-0.13672 l -0.002,-0.0176 c 0.01392,-0.0139 0.03466,0.003 0.04883,0.006 0.01317,-0.006 0.01975,-0.0378 -0.002,-0.0352 -0.01323,-0.0163 0.03655,-0.0357 -0.0039,-0.041 -0.02263,-0.0213 -0.0046,-0.0742 0.0293,-0.0625 0.01962,-0.008 0.0409,-0.0326 0.0078,-0.0449 -0.01308,-0.0169 -0.0161,-0.0415 -0.0059,-0.0605 l -0.04297,-0.0156 -0.04687,-0.006 z"
- style="opacity:1;fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:0;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
- </g>
- </g>
-</svg>
diff --git a/net/ricketyspace/ror/five/ufo.rkt b/net/ricketyspace/ror/five/ufo.rkt
deleted file mode 100644
index 6f8136c..0000000
--- a/net/ricketyspace/ror/five/ufo.rkt
+++ /dev/null
@@ -1,86 +0,0 @@
-#lang racket
-(require 2htdp/universe 2htdp/image)
-
-;;; world structure
-(struct ufo (x y fart))
-
-;;; constants
-(define WORLD-WIDTH 300)
-(define WORLD-HEIGHT 325)
-(define MOVE-LEN 3)
-(define UFO (bitmap/file "resources/zarking-ufo.png"))
-(define UFO-FART (bitmap/file "resources/ufo-fart.png"))
-(define UFO-WIDTH (image-width UFO))
-(define UFO-HEIGHT (image-height UFO))
-(define UFO-FART-HEIGHT (image-height UFO-FART))
-
-;;; ufo movement functions
-(define (ufo-move-up current-state)
- (let ((x (ufo-x current-state))
- (y-up (- (ufo-y current-state) MOVE-LEN))
- (fart #t))
- (cond [(>= y-up (+ (/ UFO-HEIGHT 2) (/ UFO-FART-HEIGHT 2)))
- (ufo x y-up fart)]
- [else current-state])))
-
-(define (ufo-move-down current-state)
- (let ((x (ufo-x current-state))
- (y-down (+ (ufo-y current-state) MOVE-LEN)))
- (cond [(<= y-down (- (+ WORLD-HEIGHT (/ UFO-FART-HEIGHT 2))
- (/ UFO-HEIGHT 2)))
- (ufo x y-down #t)]
- [else current-state])))
-
-
-(define (ufo-move-left current-state)
- (let ((x-left (- (ufo-x current-state) MOVE-LEN))
- (y (ufo-y current-state))
- (fart #t))
- (cond [(>= x-left (/ UFO-WIDTH 2))
- (ufo x-left y fart)]
- [else current-state])))
-
-(define (ufo-move-right current-state)
- (let ((x-right (+ (ufo-x current-state) MOVE-LEN))
- (y (ufo-y current-state))
- (fart #t))
- (cond [(<= x-right (- WORLD-WIDTH (/ UFO-WIDTH 2)))
- (ufo x-right y fart)]
- [else current-state])))
-
-
-;;; big bang functions
-(define (draw-a-ufo current-state)
- (place-image (overlay/align/offset
- "middle" "bottom" UFO 0 35
- (if (ufo-fart current-state)
- UFO-FART
- (circle 0 "outline" "white")))
- (ufo-x current-state)
- (ufo-y current-state)
- (empty-scene WORLD-WIDTH WORLD-HEIGHT)))
-
-(define (add-3-to-posy current-state)
- (ufo (ufo-x current-state)
- (+ (ufo-y current-state) 3)))
-
-(define (posy-is-300 current-state)
- (>= (ufo-y current-state) 300))
-
-(define (move-ufo current-state key)
- (cond [(key=? key "up") (ufo-move-up current-state)]
- [(key=? key "down") (ufo-move-down current-state)]
- [(key=? key "left") (ufo-move-left current-state)]
- [(key=? key "right") (ufo-move-right current-state)]
- [else current-state]))
-
-(define (ufo-stopped current-state key)
- (let ((fart #f))
- (ufo (ufo-x current-state) (ufo-y current-state) fart)))
-
-;;; the big bang
-(big-bang (ufo (/ WORLD-WIDTH 2) (/ WORLD-HEIGHT 2) #f)
- (to-draw draw-a-ufo)
- (on-key move-ufo)
- (on-release ufo-stopped))
-
diff --git a/net/ricketyspace/ror/fourteen/client.rkt b/net/ricketyspace/ror/fourteen/client.rkt
deleted file mode 100644
index 52305a1..0000000
--- a/net/ricketyspace/ror/fourteen/client.rkt
+++ /dev/null
@@ -1,611 +0,0 @@
-#lang racket
-
-;; This module implements the client for the Hungry Henry game
-
-(provide
- lets-eat ;; String String[IP Address] -> Meal
- ;; launch single client and register at specified host
- )
-
-(require "shared.rkt" 2htdp/universe 2htdp/image)
-
-;
-;
-;
-; ; ;
-; ; ;
-; ; ; ;;; ; ;; ; ;;; ; ;
-; ; ; ; ; ;; ; ;; ; ; ;
-; ;;;;; ; ; ; ; ; ; ;
-; ; ; ;;;;; ; ; ; ; ;
-; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ;
-; ; ; ;;;; ; ; ; ;
-; ;
-; ;;
-;
-
-
-;; Image Constants
-(define FOOD-IMG (bitmap "graphics/cupcake.gif"))
-(define PLAYER-IMG (bitmap "graphics/hungry-henry.gif"))
-(define BASE (empty-scene WIDTH HEIGHT))
-(define WAYPOINT-NODE (circle 3 'solid 'black))
-;; Color Constants
-(define PLAYER-COLOR "red")
-(define MY-COLOR "blue")
-(define WAYPOINT-COLOR "green")
-;; Text Constants
-(define LOADING... "Waiting For Server")
-(define TEXT-SIZE 20)
-(define SCORE-SIZE 20)
-(define TEXT-COLOR "black")
-(define END-OPEN-TEXT "your score was: ")
-(define END-CLOSE-TEXT ", the winner was player ")
-(define LOADING-OPEN-TEXT "\nYou are ")
-(define SEPERATOR ": ")
-;; PBAR constants
-(define PBAR-HEIGHT 35)
-(define PBAR-LOC (- HEIGHT PBAR-HEIGHT))
-(define PBAR-COLOR "red")
-(define PBAR-TEXT (text "loading..." 20 "black"))
-;; Message ID Constants
-(define UPDATE-LENGTH 3)
-(define SPLAYER-LENGTH 3)
-(define SBODY-LENGTH 2)
-(define END-LENGTH 2)
-(define SCORE-LIST-LENGTH 2)
-;; Init Constants
-(define ZERO% 0)
-(define LOADING (text LOADING... 20 "black"))
-
-;; -----------------------------------------------------------------------------
-;; State of Client
-
-(struct app (id img countdown) #:transparent)
-(struct entree (id players food) #:transparent)
-
-;; Meal is one of
-;; - Appetizer
-;; - Entree
-;; Appetizer = (app [or Id #f] Image Number∈[0,1])
-;; interpretation:
-;; -- the first field is this players id, #f if it hasnt been sent yet
-;; -- the second is the loading image
-;; -- the third is the %%% of loading time passed, represents the loading state
-;; Entree = (entree Id [Listof Feaster] [Listof Food])
-;; interpretation:
-;; -- the first field is this player's id
-;; -- the second field represents complete information about all players
-;; -- the third field specifies the location of the cupcakes
-
-(define INITIAL (app #f LOADING ZERO%))
-
-;
-;
-;
-; ;
-; ;
-; ;;; ;;;
-; ;; ;;
-; ; ; ; ; ;;;; ;;; ;; ;;;
-; ; ; ; ; ; ; ; ;; ;
-; ; ; ; ; ; ; ; ;
-; ; ;; ; ;;;;;; ; ; ;
-; ; ;; ; ; ; ; ; ;
-; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ;
-; ;;; ;;; ;;;; ;; ;;;;;;; ;;; ;;;
-;
-;
-;
-;
-;
-
-(define (lets-eat label server)
- (big-bang INITIAL
- (to-draw render-the-meal)
- (on-mouse set-waypoint)
- (on-receive handle-server-messages)
- (register server)
- (name label)))
-
-;; Meal Message -> Meal
-;; handles incomming messages
-(define (handle-server-messages meal msg)
- (cond [(app? meal) (handle-appetizer-message meal msg)]
- [(entree? meal) (handle-entree-message meal msg)]))
-
-;; Meal Number Number MouseEvent -> Meal
-;; handles what happends on a click
-(define (set-waypoint meal x y event)
- (if (and (entree? meal) (string=? event "button-down"))
- (make-package meal (list GOTO x y))
- meal))
-
-;; Meal -> Image
-;; deals with draw some kind of meal
-(define (render-the-meal meal)
- (cond [(app? meal) (render-appetizer meal)]
- [(entree? meal) (render-entree meal)]))
-
-;
-;
-;
-; ;;;; ;
-; ; ;
-; ; ; ;;; ;;;; ;;; ;;; ; ; ;;;
-; ; ; ; ; ; ; ; ; ; ; ; ;
-; ;;;; ; ; ; ; ; ; ; ; ; ;
-; ; ; ;;;;; ; ;;;;; ; ;; ;; ;;;;;
-; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ;
-; ; ; ;;;; ;;;; ;;;; ; ; ;;;;
-;
-;
-;
-
-;; -----------------------------------------------------------------------------
-;; Appetizer
-
-;; Appetizer Message -> Meal
-;; starts the game if the message is valid
-(define (handle-appetizer-message s msg)
- (cond [(id? msg) (app msg (app-img s) (app-countdown s))]
- [(time? msg) (app (app-id s) (app-img s) msg)]
- [(state? msg) (switch-to-entree s msg)]
- ;; fault tolerant
- [else s]))
-
-;; Appetizer State -> Meal
-(define (switch-to-entree s m)
- (apply entree (app-id s) (rest m)))
-
-;; -----------------------------------------------------------------------------
-;; Appetizer
-
-;; Entree Message -> Meal
-;; either updates the world or ends the game
-(define (handle-entree-message s msg)
- (cond [(state? msg) (update-entree s msg)]
- [(score? msg) (restart s msg)]
- [else s]))
-
-;; Entree State -> Entree
-;; creates a new entree based on the update mesg
-(define (update-entree s state-msg)
- (apply entree (entree-id s) (rest state-msg)))
-
-;; Entree EndMessage -> Appetizer
-;; Tranistion to start state
-(define (restart s end-msg)
- (define score-image (render-scores end-msg))
- (app (entree-id s) (above LOADING score-image) ZERO%))
-
-;; -----------------------------------------------------------------------------
-;; predicates for recognizing network messages
-
-;; Message -> Boolean
-;; checks if message is a valid update message
-(define (state? msg)
- (and (list? msg)
- (= UPDATE-LENGTH (length msg))
- (symbol? (first msg))
- (list? (second msg))
- (list? (third msg))
- (symbol=? SERIALIZE (first msg))
- (andmap player? (second msg))
- (andmap body? (third msg))))
-
-;; Message -> Boolean
-;; checks if message is a valid time message
-(define (time? msg)
- (and (real? msg) (<= 0 msg 1)))
-
-;; Message -> Boolean
-;; checks if is end game message
-(define (score? msg)
- (and (list? msg)
- (= END-LENGTH (length msg))
- (symbol? (first msg))
- (list? (second msg))
- (symbol=? SCORE (first msg))
- (score-list? (second msg))))
-
-;; List -> Boolean
-;; is this a list binding names to scores?
-(define (score-list? l)
- (for/and ([s l])
- (and (list? s)
- (= SCORE-LIST-LENGTH (length s))
- (id? (first s))
- (number? (second s)))))
-
-;
-;
-;
-; ;
-; ;
-; ;;;;;;
-; ; ;
-; ; ; ;; ;; ;;;; ;;; ;; ;;; ;; ;;; ;;; ;;
-; ; ; ;;; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ;;;;;; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ;; ; ; ; ; ; ; ; ; ;;
-; ;;;;;; ;;;;;; ;;;; ;; ; ; ;;;;;;; ;;; ;;; ;;; ;
-; ;
-; ;;
-; ;;;;
-;
-;
-
-;; -----------------------------------------------------------------------------
-;; Appetizer Drawing
-
-;; Appetizer -> Image
-;; tells the player that we're waiting for the server. shows id
-(define (render-appetizer app)
- (add-progress-bar (render-id+image app) (app-countdown app)))
-
-;; Image Number∈[0,1] -> Image
-;; draws the progress bar
-(define (add-progress-bar base count)
- (place-image (render-progress count) (/ WIDTH 2) PBAR-LOC base))
-
-;; Number∈[0,1] -> Image
-;; draw a progress bar that is count percent complete
-(define (render-progress count)
- (overlay PBAR-TEXT (rectangle (* count WIDTH) PBAR-HEIGHT "solid" PBAR-COLOR)))
-
-;; Appetizer -> Image
-;; gets the text to display on the loading screen
-(define (render-id+image app)
- (define id (app-id app))
- (define base-image (app-img app))
- (overlay
- (cond
- [(boolean? id) base-image]
- [else (define s (string-append LOADING-OPEN-TEXT id))
- (above base-image (text s TEXT-SIZE TEXT-COLOR))])
- BASE))
-
-;; -----------------------------------------------------------------------------
-;; Entree Drawing
-
-;; Entree -> Image
-;; draws a Entree
-(define (render-entree entree)
- (define id (entree-id entree))
- (define pl (entree-players entree))
- (define fd (entree-food entree))
- (add-path id pl (add-players id pl (add-food fd BASE))))
-
-;; [Listof Food] Image -> Image
-;; draws all the food
-(define (add-food foods base-scene)
- (for/fold ([scn base-scene]) ([f foods])
- (place-image FOOD-IMG (body-x f) (body-y f) scn)))
-
-;; Id [Listof Feaster] Image -> Image
-;; draws all players
-(define (add-players id lof base-scene)
- (for/fold ([scn base-scene]) ([feaster lof])
- (place-image (render-avatar id feaster)
- (feaster-x feaster) (feaster-y feaster)
- scn)))
-
-;; Id Feaster -> Image
-;; gets an image for the player
-(define (render-avatar id player)
- (define size (body-size (player-body player)))
- (define color
- (if (id=? id (player-id player)) MY-COLOR PLAYER-COLOR))
- (above
- (render-text (player-id player))
- (overlay (render-player-score player)
- PLAYER-IMG
- (circle size 'outline color))))
-
-;; Feaster -> Image
-;; Draw the players score
-(define (render-player-score player)
- (render-text (number->string (get-score (body-size (player-body player))))))
-
-;; Id [Listof Feaster] Image -> Image
-;; draws the path of the player whose id is passed in
-(define (add-path id players base-scene)
- (define player
- (findf (lambda (x) (id=? id (player-id x))) players))
- (if (boolean? player)
- base-scene
- (add-waypoint* player base-scene)))
-
-;; Feaster Image -> Image
-;; draws the list of way points to the scene
-(define (add-waypoint* player base-scene)
- (define loc (body-loc (player-body player)))
- (define ways (player-waypoints player))
- (define-values (resulting-scene _)
- (for/fold ([scn base-scene][from loc]) ([to ways])
- (values (add-waypoint from to scn) to)))
- resulting-scene)
-
-;; Complex Complex Image -> Image
-;; Add a waypoint to the scene at those coordinates
-(define (add-waypoint from to s)
- (define x-from (real-part from))
- (define y-from (imag-part from))
- (define x-to (real-part to))
- (define y-to (imag-part to))
- (define with-line (add-line s x-to y-to x-from y-from WAYPOINT-COLOR))
- (place-image WAYPOINT-NODE x-to y-to with-line))
-
-;; -----------------------------------------------------------------------------
-;; render the end
-
-;; Score -> Image
-;; draws the end of the game
-(define (render-scores msg)
- (define scores (sort (second msg) < #:key second))
- (for/fold ([img empty-image]) ([name-score scores])
- (define txt (get-text name-score))
- (above (render-text txt) img)))
-
-;; (list ID Natural) -> string
-;; builds a string for that winning pair
-(define (get-text name-score)
- (define-values (name score) (apply values name-score))
- (string-append name SEPERATOR (number->string score)))
-
-
-;
-;
-;
-;
-;
-; ;;;;;
-; ;;
-; ; ; ;; ;; ;;; ;;;
-; ; ; ; ; ; ;
-; ; ; ; ; ; ;
-; ; ; ; ; ;;
-; ;;;;;; ; ; ;;
-; ; ; ; ; ; ;
-; ; ; ; ;; ; ;
-; ;;; ;;; ;;; ;; ;;; ;;;
-;
-;
-;
-;
-;
-
-;; String -> Image
-;; draws the text
-(define (render-text txt)
- (text txt TEXT-SIZE TEXT-COLOR))
-
-;; player -> Number
-;; Gets the X coord of a entrees
-(define (feaster-x feaster)
- (body-x (player-body feaster)))
-
-;; player -> Number
-;; Gets the Y coord of a entrees
-(define (feaster-y feaster)
- (body-y (player-body feaster)))
-
-;; body -> Number
-;; gets the X coord of a body
-(define (body-x body)
- (real-part (body-loc body)))
-
-;; body -> Number
-;; gets the Y coord of a body
-(define (body-y body)
- (imag-part (body-loc body)))
-
-;
-;
-;
-;
-;
-; ;;;;;;;;; ;
-; ; ; ; ;
-; ; ; ; ;;;; ;;;; ; ;;;;;;; ;;;; ;
-; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ; ;
-; ; ;;;;;;;; ;;;;; ; ;;;;;
-; ; ; ; ; ;
-; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ;
-; ;;;;; ;;;;; ;;;;;; ;;;; ;;;;;;
-;
-;
-;
-;
-;
-
-(module+ test
-
- (require rackunit rackunit/text-ui)
-
- ;; testing main client
- (check-equal? (switch-to-entree (app "foo" 'blah 1) '(STATE () ()))
- (entree "foo" '()'()))
- (check-equal? (handle-server-messages (app #f 'ksajfhsdkjhfr 1) .5)
- (handle-appetizer-message (app #f 'ksajfhsdkjhfr 1) .5))
- ;;dispatch-mouse
- (check-equal? (set-waypoint (app 1 LOADING 0) 1 1 "button-down")
- (app 1 LOADING 0))
- (check-equal? (set-waypoint (app 1 LOADING 0) 1 1 "button-up")
- (app 1 LOADING 0))
- (check-equal? (set-waypoint (app #f LOADING 0) 1 1 "button-down")
- (app #f LOADING 0))
- (check-equal? (set-waypoint (app #f LOADING 0) 1 1 "button-up")
- (app #f LOADING 0))
- (check-equal? (set-waypoint (entree "player1" (list (player "player1" (body 1 1+1i) empty)) empty) 1 1 "button-up")
- (entree "player1" (list (player "player1" (body 1 1+1i) empty)) empty))
- (check-equal? (set-waypoint (entree "player1" (list (player "player1" (body 1 1+1i) empty)) empty)
- 1 1 "button-down")
- (make-package (entree "player1" (list (player "player1" (body 1 1+1i) empty)) empty)
- (list 'goto 1 1)))
- ;;render-the-meal
-
- ;; testing message receipt
- ;; app-may-start
- ;; entree-msg
- ;; update-msg?
-
- (check-true (state? `(,SERIALIZE (,(player "player1" (body 1+4i 234) `()) ,(player "player1" (body 3 3) `()))
- (,(body 1+i 2) ,(body 2 2)))))
- (check-true (state? `(,SERIALIZE (,(player "player1" (body 1+4i 234) `()))
- (,(body 1+i 2) ,(body 2 2)))))
- (check-true (state? `(,SERIALIZE ()
- (,(body 1+i 2) ,(body 2 2)))))
- (check-true (state? `(,SERIALIZE (,(player "player1" (body 1+4i 234) `()) ,(player "player1" (body 3 3) `()))
- ())))
-
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()) ("player1" (3 3) ()))
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()))
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE ()
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()) ("player1" (3 3) ()))
- ())))
- (check-true (state? `(,SERIALIZE ()
- ())))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()) ("player1" (3 3) ()))
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()))
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE ()
- ((1+i 2) (2 2)))))
- (check-false (state? `(,SERIALIZE (("player1" (1+4i 234) ()) ("player1" (3 3) ()))
- ())))
-
- (check-false (state? '(u ((1 1+4i 234))
- ((1+i 2) (2 2)))))
- (check-false (state? '(((1 1+4i 234))
- ((1+i 2) (2 2)))))
- (check-false (state? '(u ((1 1+4i))
- ((1+i 2) (2 2)))))
- (check-false (state? '(u ((1 1+4i 234))
- ((1+i 2) (2 b)))))
- (check-false (state? '(u ((1 1+4i 234)))))
- (check-false (state? '(u ((1+i 2) (2 2)))))
- (check-false (state? '(((1+i 2) (2 2)))))
- (check-false (state? 4))
- (check-false (state? 'f))
- ;; score-list?
- (check-true (score-list? '(("s" 0) ("l" 0) ("sdf" 0))))
- (check-true (score-list? empty))
- (check-true (score-list? '(("s" 0) ("l" 0))))
- (check-false (score-list? '(('s 0) ('l 0) ('sdf 0))))
- (check-false (score-list? '((s 0) (l 0))))
- (check-false (score-list? '((s) (l))))
- (check-false (score-list? '((s 0) (l 0))))
- ;; update-entree
- (check-equal? (update-entree (entree "player10" '() '())
- `(s (,(player "player1" (body 10 10) `(3 4+9i))
- ,(player "player10" (body 103 10+4i) `(3 5+78i)))
- (,(body 5 10) ,(body 30 30))))
- (entree "player10" (list (player "player1" (body 10 10) (list 3 4+9i))
- (player "player10" (body 103 10+4i) (list 3 5+78i)))
- (list (body 5 10) (body 30 30))))
-
-
- ;; testing rendering the client
-
- ;; draw-app
- (check-equal? (render-appetizer (app #f LOADING 0))
- (add-progress-bar (overlay LOADING
- BASE)
- 0))
- ;; draw-entree
-
-
- ;; draw-players
-
- (check-equal? (add-players "player0"
- (list (player "player1" (body 40 23+34i) empty)
- (player "player0" (body 50 1+3i) empty))
- BASE)
- (place-image (render-avatar "player0" (player "player0" (body 50 1+3i) empty))
- 1 3
- (place-image (render-avatar "player0" (player "player1" (body 40 23+34i) empty))
- 23 34
- BASE)))
- (check-equal? (add-players "player0"
- (list (player "player1" (body 40 23+34i) empty))
- BASE)
- (place-image (render-avatar "player0" (player "player1" (body 40 23+34i) empty))
- 23 34
- BASE))
-
- ;; draw-player
-
- ;; get-player-image
- (check-equal? (render-avatar "player0" (player "player0" (body 30 1+3i) empty))
- (above (render-text "player0")
- (overlay (text (number->string (get-score 30)) 20 'black)
- PLAYER-IMG (circle 30 "outline" MY-COLOR))))
- (check-equal? (render-avatar "player0" (player "player1" (body 30 1+3i) empty))
- (above (render-text "player1")
- (overlay (text (number->string (get-score 30)) 20 'black)
- PLAYER-IMG (circle 30 "outline" PLAYER-COLOR))))
-
- ;; draw-food
- (check-equal? (add-food (list (body 34 54+3i)
- (body 9 45+23i))
- BASE)
- (place-image FOOD-IMG
- 45 23
- (place-image
- FOOD-IMG
- 54 3
- BASE)))
- (check-equal? (add-food (list (body 34 54+3i))
- BASE)
- (place-image
- FOOD-IMG
- 54 3
- BASE))
-
-
- ;; testing auxiliary functions
- ;; player-x
- (check-equal? (feaster-x (player 20 (body 3 1+3i) empty))
- 1)
- (check-equal? (feaster-x (player 20 (body 3 4+3i) empty))
- 4)
- (check-equal? (feaster-x (player 20 (body 3 4+67i) empty))
- 4)
- ;; player-y
- (check-equal? (feaster-y (player 20 (body 3 1+3i) empty))
- 3)
- (check-equal? (feaster-y (player 20 (body 3 4+3i) empty))
- 3)
- (check-equal? (feaster-y (player 20 (body 3 4+67i) empty))
- 67)
-
- ;; body-x
- (check-equal? (body-x (body 20 1+2i))
- 1)
- (check-equal? (body-x (body 20 4+2i))
- 4)
- (check-equal? (body-x (body 20 3+2i))
- 3)
- ;; body-y
- (check-equal? (body-y (body 20 4+1i))
- 1)
- (check-equal? (body-y (body 20 1+4i))
- 4)
- (check-equal? (body-y (body 20 3))
- 0)
-
- "client: all tests run")
-
diff --git a/net/ricketyspace/ror/fourteen/graphics/cupcake.gif b/net/ricketyspace/ror/fourteen/graphics/cupcake.gif
deleted file mode 100644
index 20b1bef..0000000
--- a/net/ricketyspace/ror/fourteen/graphics/cupcake.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/fourteen/graphics/hungry-henry.gif b/net/ricketyspace/ror/fourteen/graphics/hungry-henry.gif
deleted file mode 100644
index cce6948..0000000
--- a/net/ricketyspace/ror/fourteen/graphics/hungry-henry.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/fourteen/readme.txt b/net/ricketyspace/ror/fourteen/readme.txt
deleted file mode 100644
index 042b0f4..0000000
--- a/net/ricketyspace/ror/fourteen/readme.txt
+++ /dev/null
@@ -1,29 +0,0 @@
-This chapter implements a distributed game, dubbed "Hungry Henry."
-
-TO PLAY, open the file
-
- run.rkt
-
-in DrRacket. The instructions for playing are at the top of the file.
-
-TO EXPERIMENT, open the files
-
- -- run.rkt
- -- server.rkt
- -- client.rkt
- -- shared.rkt
-
-in four different tabs or windows in DrRacket. Switch to the 'run.rkt'
-tab and select
-
- View | Show Module browser
-
-to see how these files are related. To switch to one of these four files,
-you may click the boxes in the module browsers. Alternatively click the
-tab you wish to work on. It is also possible to select tabs via key
-strokes.
-
-Each file except for 'run.rkt' comes with test submodules at the bottom of
-the file.
-
-
diff --git a/net/ricketyspace/ror/fourteen/run.rkt b/net/ricketyspace/ror/fourteen/run.rkt
deleted file mode 100644
index 4a244b7..0000000
--- a/net/ricketyspace/ror/fourteen/run.rkt
+++ /dev/null
@@ -1,59 +0,0 @@
-#lang racket
-
-#|
- Hungry Henry, a multi-player, distributed game
- -----------------------------------------------
-
- This game is a multi-player competition for cupcakes. Each player owns an
- avatar, called a "Henry", and competes for a limited number of cupcakes,
- distributed over a rectangular space. A player launches her Henry via
- a series of mouse clicks, so-called waypoints. Her Henry moves from waypoint
- to waypoint. If it gets close enough to a cupcake, he eats the cupcake and
- fattens up. As a Henry fattens up, he slows down. When all cupcakes are
- consumed, the fattest Henry wins.
-
- Notes:
- 1. The cupcakes remain in place until they are eaten.
- 2. Once a waypoiny is recorded, it cannot be removed.
- 3. Waypoints are visited in a first-come, first-serve order.
-
- Play
- ----
-
- Click Run. Evaluate
-
- (serve-dinner)
-
- in the Interactions Panel. This will pop up three windows:
- -- Matthias, a game window
- -- David, another game window
- -- Universe, the game server's console
-
- Play. You can play the part of both participants. Alternatively, click
- the David or Matthias window (to obtain focus) and click again to choose
- a way point for David's or Matthias's "hungry henry". Watch the hungry
- henries go for the cup cake and eat them up. You can make either one of them
- win or you can force a tie.
-
- To run the game on two distinct computers:
-
- -- copy this folder to another computer, determine its IP number "12.345.67.98"
- -- open run.rkt
- -- evaluate
- (bon-appetit)
-
- -- on your own computer, open run.rkt and run
- -- evaluate
- (lets-eat SomeNameAsAString "12.345.67.98")
-|#
-
-(require (only-in "server.rkt" bon-appetit)
- (only-in "client.rkt" lets-eat)
- 2htdp/universe)
-
-;; launch server worlds for playtesting
-(define (serve-dinner)
- (launch-many-worlds
- (bon-appetit)
- (lets-eat "Matthias" LOCALHOST)
- (lets-eat "David" LOCALHOST)))
diff --git a/net/ricketyspace/ror/fourteen/server.rkt b/net/ricketyspace/ror/fourteen/server.rkt
deleted file mode 100644
index 078533b..0000000
--- a/net/ricketyspace/ror/fourteen/server.rkt
+++ /dev/null
@@ -1,1065 +0,0 @@
-#lang racket
-
-;; This module implements the server for the Hungry Henry game
-
-(provide
- bon-appetit ;; -> Void
- ;; launch the server for Hungry Henry
- )
-
-(require "shared.rkt" 2htdp/universe)
-
-#| -----------------------------------------------------------------------------
-The server is responsible for:
--- starting the game
--- moving Henrys
--- have Henrys eat, remove food on collision
--- collecting and broadcasting information about the movement of players
--- ending games
-|#
-
-;
-;
-;
-; ; ; ; ;
-; ; ; ; ;
-; ; ; ; ; ; ;; ;; ; ; ;;; ; ; ; ; ;;; ; ;; ; ;;; ; ;
-; ; ; ; ; ;; ; ; ;; ;; ; ; ; ; ; ; ; ;; ; ;; ; ; ;
-; ;;;;; ; ; ; ; ; ; ; ; ; ;;;;; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;;; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ; ;; ; ; ; ; ; ; ; ; ;
-; ; ; ;; ; ; ; ;; ; ; ; ; ; ;;;; ; ; ; ;
-; ; ; ;
-; ;;; ;; ;;
-;
-
-
-;; Init Constants
-(define TICK .1)
-(define PLAYER-LIMIT 2)
-(define START-TIME 0)
-(define WAIT-TIME 250)
-
-(define FOOD*PLAYERS 5)
-
-(define WEIGHT-FACTOR 2.1)
-(define BASE-SPEED (/ (expt PLAYER-SIZE 2) WEIGHT-FACTOR))
-
-;; Data Definitions
-(struct join (clients [time #:mutable]) #:transparent)
-(struct play (players food spectators) #:transparent #:mutable)
-
-;; plus some update primitives:
-
-;; JoinUniverse Player -> JoinUniverse
-(define (join-add-player j new-p)
- (join (cons new-p (join-clients j)) (join-time j)))
-
-;; PlayUniverse IP -> PlayUniverse
-(define (play-add-spectator pu new-s)
- (define players (play-players pu))
- (define spectators (play-spectators pu))
- (play players (play-food pu) (cons new-s spectators)))
-
-;; PlayUniverse IWorld -> PlayUniverse
-;; removes player that uses iworld
-(define (play-remove p iw)
- (define players (play-players p))
- (define spectators (play-spectators p))
- (play (rip iw players) (play-food p) (rip iw spectators)))
-
-;; JoinUniverse IWorld -> JoinUniverse
-;; removes players and spectators that use iw from this world
-(define (join-remove j iw)
- (join (rip iw (join-clients j)) (join-time j)))
-
-;; IWorld [Listof Player] -> [Listof Player]
-;; remove player that contains the given IWorld
-(define (rip iw players)
- (remove iw players (lambda (iw p) (iworld=? iw (ip-iw p)))))
-
-;; LIKE:
-;; (struct ip ip? ip-id ip-iw ip-body ip-waypoints ip-player)
-(define-values
- (ip ip? ip-id ip-iw ip-body ip-waypoints ip-player)
- (let ()
- (struct ip (id iw body waypoints player) #:transparent)
- (define (create iw id body waypoints)
- (ip id iw body waypoints (player id body waypoints)))
- (values
- create ip? ip-id ip-iw ip-body ip-waypoints ip-player)))
-
-;; ServerState is one of
-;; -- JoinUniverse
-;; -- PlayUniverse
-;; JoinUniververse = (join [Listof IPs] Nat)
-;; interpretation:
-;; -- the first field lists the currently connected client-player
-;; -- the second field is the number of ticks since the server started
-;; PlayUniverse = (play [Listof IPs] [Listof Food] [Listof IP])
-;; interpretation:
-;; -- the first field lists all participating players
-;; -- the second field lists the cupcakes
-;; --- the third field enumerates the spectating players
-;; IP = (ip Id IWorld Body [Listof Complex] Feaster)
-;; interpretation:
-;; the struct represents the Universe's perspective of a connected player
-;; -- the first field is the assigned unique Id
-;; -- the second field is the IWorld representing the remote connection to the client
-;; -- the third field is the Body of the player
-;; -- the fourth field is the list of player-chosen Waypoints,
-;; ordered from oldest click to most-recent
-;; meaning the first one has to be visited first by the Henry
-;; -- the fifth field is the serialized representation of the first four fields
-
-(define JOIN0 (join empty START-TIME))
-
-;
-;
-;
-;
-; ;;; ;;; ;
-; ;; ;;
-; ;; ;; ;;;; ;;; ;; ;;
-; ; ; ; ; ; ; ;; ;
-; ; ; ; ;;;;; ; ; ;
-; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ;
-; ;;; ;;; ;;; ;; ;;;;; ;;; ;;;
-;
-;
-;
-;
-
-(define (bon-appetit)
- (universe JOIN0
- (on-new connect)
- (on-msg handle-goto-message)
- (on-tick tick-tock TICK)
- (on-disconnect disconnect)))
-
-;; ServerState IWorld -> Bundle
-;; adds a new connection to a JoinUniverse and ticks. Ignores otherwise
-(define (connect s iw)
- (cond [(join? s) (add-player s iw)]
- [(play? s) (add-spectator s iw)]))
-
-;; ServerState IWorld Sexpr -> Bundle
-;; accepts goto messages from clients
-(define (handle-goto-message s iw msg)
- (cond [(and (play? s) (goto? msg)) (goto s iw msg)]
- [else (empty-bundle s)]))
-
-;; ServerState -> Bundle
-;; handle a tick event
-(define (tick-tock s)
- (cond [(join? s) (wait-or-play s)]
- [(play? s) (move-and-eat s)]))
-
-;; ServerState IWorld -> Bundle
-;; handles loss of a client
-(define (disconnect s iw)
- (cond [(join? s) (drop-client s iw)]
- [(play? s) (drop-player s iw)]))
-
-;
-;
-;
-; ; ; ; ;
-; ; ; ;
-; ; ; ;;;; ;;; ;;;;; ;;; ; ;; ;; ;
-; ; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ; ; ; ; ; ; ;
-; ;; ;; ;;;; ; ; ; ; ; ; ;
-; ;; ;; ; ; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ; ; ; ; ;;
-; ; ; ;; ; ; ;;; ; ; ; ;; ;
-; ;
-; ;;;
-;
-
-;; JoinUniverse -> Bundle
-;; count down and might transition
-(define (wait-or-play j)
- (cond [(keep-waiting? j) (keep-waiting j)]
- [else (start-game j)]))
-
-;; JoinUniverse -> Boolean
-;; is it time to start?
-(define (keep-waiting? j)
- (or (> PLAYER-LIMIT (length (join-clients j)))
- (> WAIT-TIME (join-time j))))
-
-;; JoinUniverse -> [Bundle JoinUniverse]
-(define (keep-waiting j)
- (set-join-time! j (+ (join-time j) 1))
- (time-broadcast j))
-
-;; JoinUniverse -> [Bundle JoinUniverse]
-;; broadcasts the new load time fraction to the players
-(define (time-broadcast j)
- (define iworlds (map ip-iw (join-clients j)))
- (define load% (min 1 (/ (join-time j) WAIT-TIME)))
- (make-bundle j (broadcast iworlds load%) empty))
-
-;; JoinUniverse -> [Bundle PlayUniverse]
-;; starts the game
-(define (start-game j)
- (define clients (join-clients j))
- (define cupcakes (bake-cupcakes (length clients)))
- (broadcast-universe (play clients cupcakes empty)))
-
-;; Number -> [Listof Food]
-;; creates the amount of food for that number of players
-(define (bake-cupcakes player#)
- (for/list ([i (in-range (* player# FOOD*PLAYERS))])
- (create-a-body CUPCAKE)))
-
-;
-;
-; ;;;
-; ;;;; ; ;
-; ; ; ;
-; ; ; ; ;;;; ; ; ;;; ; ;; ;; ;
-; ; ; ; ; ; ; ; ;; ; ; ;;
-; ;;; ; ; ; ; ; ; ; ; ;
-; ; ; ;;;; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ; ; ; ;;
-; ; ; ;; ; ; ; ; ; ;; ;
-; ; ;
-; ;; ;;;
-;
-
-;; PlayUniverse -> Bundle
-;; moves everything. eats. may end game
-(define (move-and-eat pu)
- (define nplayers (move-player* (play-players pu)))
- (define nfood (feed-em-all nplayers (play-food pu)))
- (progress nplayers nfood (play-spectators pu)))
-
-;; [Listof IP] -> [Listof IP]
-;; moves all players
-(define (move-player* players)
- (for/list ([p players])
- (define waypoints (ip-waypoints p))
- (cond [(empty? waypoints) p]
- [else (define body (ip-body p))
- (define nwpts
- (move-toward-waypoint body waypoints))
- (ip (ip-iw p) (ip-id p) body nwpts)])))
-
-;; Body [Listof Complex] -> [Listof Complex]
-;; effect: set body's location
-;; determine new waypoints for player
-;; pre: (cons? waypoints)
-(define (move-toward-waypoint body waypoints)
- (define goal (first waypoints))
- (define bloc (body-loc body))
- (define line (- goal bloc))
- (define dist (magnitude line))
- (define speed (/ BASE-SPEED (body-size body)))
- (cond
- [(<= dist speed)
- (set-body-loc! body goal)
- (rest waypoints)]
- [else ; (> distance speed 0)
- (set-body-loc! body (+ bloc (* (/ line dist) speed)))
- waypoints]))
-
-;; [Listof Player] [Listof Food] -> [Listof Food]
-;; feeds all players and removes food
-(define (feed-em-all players foods)
- (for/fold ([foods foods]) ([p players])
- (eat-all-the-things p foods)))
-
-;; IP [Listof Food] -> [Listof Food]
-;; effect: fatten player as he eats
-;; determine left-over foods
-(define (eat-all-the-things player foods)
- (define b (ip-body player))
- (define (new-cupcakes)
- (cond [(> (length foods) 10) '()]
- [else
- (for/list ([i (in-range (random 1 3))])
- (create-a-body CUPCAKE))]))
- (for/fold ([foods '()]) ([f foods])
- (cond
- [(body-collide? f b)
- (set-body-size! b (+ PLAYER-FATTEN-DELTA (body-size b)))
- (append foods (new-cupcakes))]
- [else (cons f foods)])))
-
-;; body body -> Boolean
-;; Have two bodys collided?
-(define (body-collide? s1 s2)
- (<= (magnitude (- (body-loc s1) (body-loc s2)))
- (+ (body-size s1) (body-size s2))))
-
-;; [Listof Ip] [Listof Food] [Listof IP] -> Bundle
-;; moves all objects. may end game
-(define (progress pls foods spectators)
- (define p (play pls foods spectators))
- (define (max-score)
- (foldl (λ (pl max)
- (let ([pl-score (cadr pl)])
- (if (> pl-score max) pl-score max)))
- 0 (score pls)))
- (define (end-game?)
- (or (empty? foods) (> (max-score) 30)))
- (cond [(end-game?) (end-game-broadcast p)]
- [else (broadcast-universe p)]))
-
-;; PlayUniverse -> [Bundle JoinUniverse]
-;; ends the game, and restarts it
-(define (end-game-broadcast p)
- (define iws (get-iws p))
- (define msg (list SCORE (score (play-players p))))
- (define mls (broadcast iws msg))
- (make-bundle (remake-join p) mls empty))
-
-;; Play-Universe -> JoinUniverse
-;; Readies the ServerState for a new game
-(define (remake-join p)
- (define players (refresh (play-players p)))
- (define spectators (play-spectators p))
- (join (append players spectators) START-TIME))
-
-;; [Listof Players] -> [Listof Players]
-;; creates new players for new game
-(define (refresh players)
- (for/list ([p players])
- (create-player (ip-iw p) (ip-id p))))
-
-;; [Listof IP] -> [Listof (list Id Score)]
-;; makes the endgame message informing clients of all the size
-(define (score ps)
- (for/list ([p ps])
- (list (ip-id p) (get-score (body-size (ip-body p))))))
-
-;
-;
-;
-;
-; ;;; ;;;
-; ;; ;;
-; ;; ;; ;;;; ;;;;; ;;;;; ;;;; ;;; ;; ;;;; ;;;;;
-; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ;
-; ; ; ; ;;;;;; ;;;; ;;;; ;;;;; ; ; ;;;;;; ;;;;
-; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ;; ; ;; ; ; ;
-; ;;; ;;; ;;;;; ;;;;; ;;;;; ;;; ;; ;;; ; ;;;;; ;;;;;
-; ;
-; ;;;;
-;
-;
-
-;; -----------------------------------------------------------------------------
-;; Play Universe
-
-;; Message -> Boolean
-;; checks if message is a drag
-(define (goto? msg)
- (and (list? msg)
- (= GOTO-LENGTH (length msg))
- (symbol? (first msg))
- (number? (second msg))
- (number? (third msg))
- (symbol=? GOTO (first msg))
- (<= 0 (second msg) WIDTH)
- (<= 0 (third msg) HEIGHT)))
-
-;; PlayUniverse IWorld GotoMessage -> PlayUniverse
-;; handles a player clicking. checks for collisions, updates score, removes food
-;; Effect: changes a player's waypoints
-(define (goto p iw msg)
- (define c (make-rectangular (second msg) (third msg)))
- (set-play-players! p (add-waypoint (play-players p) c iw))
- (broadcast-universe p))
-
-;; [Listof IPs] Complex IWorld -> [Listof IPs]
-;; adds that complex to the waypoints of the given players
-(define (add-waypoint ps c iw)
- (for/list ([p ps])
- (cond [(iworld=? (ip-iw p) iw)
- (ip (ip-iw p)
- (ip-id p)
- (ip-body p)
- (append (ip-waypoints p) (list c)))]
- [else p])))
-
-;
-;
-;
-;
-; ;;;; ;
-; ; ; ;
-; ; ;;;; ;; ;; ;; ;; ;;;; ;;; ; ;;;;; ;;; ;;;; ;; ;;
-; ; ; ; ;; ; ;; ; ; ; ; ;; ; ; ; ; ;; ;
-; ; ; ; ; ; ; ; ;;;;;; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ;;; ;;;; ;;; ;;; ;;; ;;; ;;;;; ;;;; ;;; ;;;;; ;;;; ;;; ;;;
-;
-;
-;
-;
-
-
-;; -----------------------------------------------------------------------------
-;; Join Universe
-
-;; [Universe Player -> Universe] -> [Universe IWorld -> [Bundle Universe]]
-;; creates a function that deals with a new connection during join or play phase
-(define (make-connection adder)
- (lambda (u iw)
- (define player (named-player iw))
- (define mails (list (make-mail iw (ip-id player))))
- (make-bundle (adder u player) mails empty)))
-
-;; JoinUniverse IWorld ID -> [Bundle JoinUniverse]
-;; creates an internal player for the IWorld, adds it to Universe as waiting player
-(define add-player (make-connection join-add-player))
-
-;; PlayUniverse IWorld -> [Bundle PlayUniverse]
-;; creates an internal player for the IWorld, adds it to Universe as spectator
-(define add-spectator (make-connection play-add-spectator))
-
-;; [Listof IP] IWorld ->* Player
-(define (named-player iw)
- (create-player iw (symbol->string (gensym (iworld-name iw)))))
-
-;
-;
-;
-;
-; ;;; ; ; ;; ;
-; ; ;; ;
-; ; ;;;; ;; ;;; ;;; ;;;; ; ;;; ;;;;; ;;;;
-; ;;;; ; ; ;; ; ; ; ; ; ; ; ; ;
-; ; ;;;;;; ; ; ;;;;; ; ; ; ;;;;;;
-; ; ; ; ; ; ; ; ; ; ;
-; ;; ; ; ; ; ; ;; ; ; ; ; ;
-; ; ;;; ;;;;; ;;;;; ;;;;; ;;; ;; ;;;;; ;;;;; ;;;;; ;;;;;
-;
-;
-;
-;
-
-;; PlayUniverse -> [Bundle PlayUniverse [Listof [Mail StateMessage]]]
-;; bundle this universe, serialize it, broadcast it, and drop noone
-(define (broadcast-universe p)
- (define mails (broadcast-for (get-ips p) p))
- (make-bundle p mails empty))
-
-;; [Listof IWorlds] Message -> [Listof Mail]
-;; sends mail to all clients
-(define (broadcast iws msgs)
- (map (lambda (iw) (make-mail iw msgs)) iws))
-
-;; PlayUniverse -> (list s [Listof SerializedPlayer] [Listof SerializedFood])
-;; prepairs a message for an update world/ServerState state
-(define (serialize-universe p)
- (define serialized-players (map ip-player (play-players p)))
- (list SERIALIZE serialized-players (play-food p)))
-
-;; [Listof IPs] PlayUniverse -> [Listof Mail]
-;; generates mails for all clients
-(define (broadcast-for ips p)
- (define (mk-mail-for pl)
- (make-mail (ip-iw pl) (serialize-universe-for pl p)))
- (foldl (lambda (pl mails) (cons (mk-mail-for pl) mails)) '() ips))
-
-;; IP PlayUniverse -> (list s [Listof SerializedPlayer] [ListOf SerializedFood])
-;; prepares message for an update world/ServerState state for a player
-(define (serialize-universe-for pl p)
- (list SERIALIZE
- (serialize-players-for pl (play-players p))
- (play-food p)))
-
-;; IP IPs -> [ListOf SerializedPlayer]
-;; prepares serialized list of players for the SERIALIZE message for a
-;; player.
-(define (serialize-players-for pl pls)
- (define (filter-out waypoints)
- (if (empty? waypoints)
- waypoints
- (list (first waypoints))))
- (define (mk-pl plyr)
- (cond [(id=? (ip-id plyr) (ip-id pl)) (ip-player plyr)]
- [else (player (ip-id plyr)
- (ip-body plyr)
- (filter-out (ip-waypoints plyr)))]))
- (foldr (lambda (plyr srlzd-pls) (cons (mk-pl plyr) srlzd-pls)) '() pls))
-
-;
-;
-;
-;
-; ;;;; ;
-; ; ; ;
-; ; ; ;;; ;;;;; ;;; ; ;;;; ;; ;; ;; ;; ;;;; ;;; ; ;;;;;
-; ; ; ; ; ; ; ;; ; ; ;; ; ;; ; ; ; ; ;; ;
-; ; ; ; ;;;; ; ; ; ; ; ; ; ;;;;;; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ;;;; ;;;;; ;;;;; ;;;; ;;;; ;;; ;;; ;;; ;;; ;;;;; ;;;; ;;;
-;
-;
-;
-;
-
-;; JoinUniverse IWorld -> Bundle
-;; remove that iworld from list of clients
-(define (drop-client j iw)
- (empty-bundle (join-remove j iw)))
-
-;; PlayUniverse IWorld -> Bundle
-;; removes a player from the ServerState and tells the players
-(define (drop-player p iw)
- (broadcast-universe (play-remove p iw)))
-
-;
-;
-;
-;
-; ;;
-; ;
-; ; ; ;; ;; ;; ;;
-; ; ; ; ; ; ;
-; ; ; ; ; ;;
-; ;;; ; ; ;;
-; ; ; ; ;; ; ;
-; ;;; ;;; ;; ;; ;; ;;
-;
-;
-;
-;
-
-;; Number -> Body
-;; creates a random body, that does not touch the edge
-(define (create-a-body size)
- (define x (+ size (random (- WIDTH size))))
- (define y (+ size (random (- HEIGHT size))))
- (body size (make-rectangular x y)))
-
-;; PlayUniverse -> [Listof IWorlds]
-;; gets the iworlds of all players
-(define (get-iws p)
- (map ip-iw (append (play-players p) (play-spectators p))))
-
-;; PlayUnivers -> [Listof IP]
-(define (get-ips p)
- (append (play-players p) (play-spectators p)))
-
-;; ServerState -> Bundle
-;; makes a bundle that sends no messages and disconnects noone
-(define (empty-bundle s)
- (make-bundle s empty empty))
-
-;; IWorld Id -> IP
-;; creates a player with that idnumber
-(define (create-player iw n)
- (ip iw n (create-a-body PLAYER-SIZE) empty))
-
-;
-;
-;
-;
-; ;;;;;;;
-; ; ; ; ;
-; ; ;;;; ;;;;; ;;;;; ;;;;;
-; ; ; ; ; ; ; ; ;
-; ; ;;;;;; ;;;; ; ;;;;
-; ; ; ; ; ;
-; ; ; ; ; ; ; ; ;
-; ;;; ;;;;; ;;;;; ;;; ;;;;;
-;
-;
-;
-;
-
-(module+ test
- (require rackunit rackunit/text-ui)
-
- (define PROP-NUM 500)
- (define do-prop (make-parameter #t))
- (do-prop #f)
-
- ;; thunk -> void
- ;; runs the thunk PROP-NUM times
- (define (check-property t)
- (when (do-prop) (test-begin (doo PROP-NUM t))))
-
- ;; doo : number thunk ->
- ;; does the thunk n times
- (define (doo n l)
- (l)
- (unless (zero? n)
- (doo (sub1 n) l)))
-
- ;; testing main server
-
- ;; new-connection
-
- ;; drop-client
- (check-equal? (drop-client (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
- (ip iworld2 "player2" (body 10 1+10i) empty)
- (ip iworld3 "player3" (body 10 1+10i) empty)) 100)
- iworld1)
- (empty-bundle (join (list (ip iworld2 "player2" (body 10 1+10i) empty)
- (ip iworld3 "player3" (body 10 1+10i) empty))
- 100)))
- (check-equal? (drop-client (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
- (ip iworld2 "player2" (body 10 1+10i) empty)
- (ip iworld3 "player3" (body 10 1+10i) empty)) 100)
- iworld2)
- (empty-bundle (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
- (ip iworld3 "player3" (body 10 1+10i) empty)) 100)))
- (check-equal? (drop-client (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
- (ip iworld2 "player2" (body 10 1+10i) empty)
- (ip iworld3 "player3" (body 10 1+10i) empty)) 100)
- iworld3)
- (empty-bundle (join (list (ip iworld1 "player1" (body 10 1+10i) empty)
- (ip iworld2 "player2" (body 10 1+10i) empty)) 100)))
-
- ;; remove-player
- (check-equal? (drop-player
- (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- iworld1)
- (let ([remd (play-remove
- (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- iworld1)])
- (broadcast-universe remd)
- #;
- (make-bundle remd (serial/broadcast-univ remd) empty)))
-
- (check-equal? (drop-player
- (play (list (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- (list (ip iworld1 "player10" (body 10 1+10i) empty)))
- iworld1)
- (let ([remd (play-remove
- (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- iworld1)])
- (broadcast-universe remd)
- #;
- (make-bundle remd (serial/broadcast-univ remd) empty)))
-
- ;; ready-to-go
- (check-false (keep-waiting? (join (list (create-player iworld1 "player")
- (create-player iworld2 "player"))
- 250)))
- (check-false (keep-waiting? (join (list (create-player iworld1 "player")
- (create-player iworld1 "player")
- (create-player iworld2 "player"))
- 456345132135213)))
- (check-true (keep-waiting? (join (list (create-player iworld2 "player")) -234)))
- (check-true (keep-waiting? (join (list (create-player iworld2 "player")) 10)))
-
-
-
- ;; handle-join
- ;; name
- ;; update-player
-
- ;; remove-player-by-iworld
- (check-equal? (play-remove
- (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player324" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- iworld1)
- (play (list (ip iworld2 "player324" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- empty)
- (check-equal? (play-remove
- (play (list (ip iworld2 "player324" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- iworld2)
- (play (list)
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty))
-
- ;; testing messaging
-
- ;; goto?
-
- (check-true (goto? '(goto 3 2)))
- (check-true (goto? '(goto 3 2)))
- (check-true (goto? '(goto 0 2)))
- (check-true (goto? '(goto 6 2)))
- (check-false (goto? `(goto ,(add1 WIDTH) 0)))
- (check-false (goto? `(goto 0 ,(add1 HEIGHT))))
- (check-false (goto? '(goto -1 0)))
- (check-false (goto? '(goto 0 -1)))
- (check-false (goto? '(goto 1)))
- (check-false (goto? '(drag 6+2i)))
- (check-false (goto? '(drag 1)))
- (check-false (goto? '(6+1i)))
- (check-false (goto? '(1 2)))
- (check-false (goto? '(goto 6+2i)))
- (check-false (goto? '(drag 1 2)))
- (check-false (goto? 'click))
- (check-false (goto? "click"))
- (check-false (goto? #t))
-
- ;;add-waypoint
-
- (check-equal? (add-waypoint `(,(ip iworld1 "player10" (body 10 1+10i) empty)) 8+9i iworld1)
- (list (ip iworld1 "player10" (body 10 1+10i) '(8+9i))))
- (check-equal? (add-waypoint `(,(ip iworld1 "player10" (body 10 1+10i) '(23+45i))) 8+9i iworld1)
- (list (ip iworld1 "player10" (body 10 1+10i) '(23+45i 8+9i))))
-
- ;; goto
-
- (check-equal? (goto (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- iworld1 '(goto 1 1))
- (let ([state (play (list (ip iworld1 "player10" (body 10 1+10i)'(1+1i))
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)])
- (broadcast-universe state)
- #;
- (make-bundle state (serial/broadcast-univ state) empty)))
-
- (check-equal? (goto (play (list (ip iworld1 "player10" (body 10 1+10i) '(1+4i))
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- iworld1 '(goto 1 1))
- (let ([state (play (list (ip iworld1 "player10" (body 10 1+10i) '(1+4i 1+1i))
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)])
- (broadcast-universe state)
- #;
- (make-bundle state (serial/broadcast-univ state) empty)))
-
- ;; eat-all-the-things
- (check-pred >= (length (eat-all-the-things (ip iworld1 "player10" (body 11 0) '(1+10i)) (list (body 10 0))))
- 1)
- (check-equal? (eat-all-the-things (ip iworld1 "player10" (body 10 0) '(1+10i)) (list (body 10 40+5i)))
- (list (body 10 40+5i)))
-
- ;; testing initialization
-
- ;; property of no motion to same point in move-body
- ;; also checks for divide by zero error in move-player*
- (define (property:no-same-point)
- (define (random-near n)
- (define ε 1/1000000)
- (+ n (* (random 10) ε (sub1 (* 2 (random 2))))))
-
- (define test-body (create-a-body 1))
-
- (define waypoints
- (for/list ([r (in-range (add1 (random 100)))])
- (define x (real-part (body-loc test-body)))
- (define y (imag-part (body-loc test-body)))
- (make-rectangular (random-near x) (random-near y))))
-
- (define random-p (ip iworld1 "nope" test-body waypoints))
-
- (define (test p)
- (cond [(empty? (ip-waypoints p))
- #t]
- [(= (first (ip-waypoints p))
- (body-loc (ip-body p)))
- #f]
- [else (test (move-player* (list p)))]))
-
- (check-true (test random-p)))
-
- ;; does spawn food create the nessecary amount of food?
- (define (property:player/food-number-correct)
- (define players (random 50))
- (check-equal? (length (bake-cupcakes players))
- (* FOOD*PLAYERS players)))
-
- ;; is random-body on the board?
- (define (test-body-in-bounds)
- (define size 10)
- (define body (create-a-body size))
- (check-true (and (< size (real-part (body-loc body)) (- WIDTH size))
- (< size (imag-part (body-loc body)) (- HEIGHT size)))
- "body out of bounds"))
-
-
-
-
- ;;create-name
- ;; (check-equal? (create-name empty "john") "john")
- ;; (check-equal? (create-name (list (ip iworld1 "player10" (body 10 0) '(1+10i))) "player10") "player10*")
- #;
- (check-equal? (create-name (list (ip iworld1 "player10" (body 10 0) '(1+10i))
- (ip iworld1 "player10*" (body 10 0) '(1+10i)))
- "player10")
- "player10**")
- #;
- (check-property property:unique-name)
-
- ;; spawn-food
- (check-property property:player/food-number-correct)
-
- ;; random-body
- (check-property test-body-in-bounds)
-
- ;; testing clock tick handling
-
- (define tbody1 (body 100 1+3i))
- (define tbody2 (body 100 1))
- (define tbody3 (body 100 0+3i))
- (define tbody4 (body 100 101))
-
- (define waypoints1 '(1+3i 1 0+3i 10+10i))
- (define waypoints2 '(100))
-
- ;; move-player*
- (check-equal? (move-player*
- (list (ip iworld1 "player10" (body 10 1+10i) '(1+10.01i))))
- (list (ip iworld1 "player10" (body 10 1+10.01i) empty)))
- (check-property property:no-same-point)
- ;; move-twards-waypoint
-
-
- (test-begin
- (check-equal? (move-toward-waypoint tbody1 waypoints1)
- (rest waypoints1)
- "waypoint removal failed")
- (check-equal? tbody1 (body 100 1+3i) "movement failed")
- (set! tbody1 (body 100 1+3i)))
-
- (test-begin
- ;; test dependent on (< BASE-SPEED 100)
- (check-equal? (move-toward-waypoint tbody2 waypoints2)
- waypoints2
- "waypoint removal failed")
- (check-equal? tbody2 (body 100 (+ 1 (make-rectangular (/ BASE-SPEED 100) 0)))
- "movement failed")
- (set! tbody2 (body 100 1)))
-
- (test-begin
- (check-equal? (move-toward-waypoint tbody4 waypoints2)
- '())
- (check-equal? tbody4 (body 100 100))
- (set! tbody4 (body 100 101)))
-
- ;; countdown
- (check-equal? (wait-or-play (join (list (ip iworld1 "player10" (body 10 1+10i) empty)) 0))
- (make-bundle
- (join (list (ip iworld1 "player10" (body 10 1+10i) empty)) 1)
- (broadcast (list iworld1) (/ 1 WAIT-TIME))
- empty))
- (check-equal? (wait-or-play (join empty 0))
- (empty-bundle (join empty 1)))
-
- ;;countdown
- (check-equal? (wait-or-play (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld1 "player345" (body 56 3+45i) empty))
- 100))
- (make-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld1 "player345" (body 56 3+45i) empty))
- 101)
- (broadcast (list iworld1 iworld1) (/ 101 WAIT-TIME))
- empty))
- (check-equal? (wait-or-play (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld1 "player345" (body 56 3+45i) empty))
- 1))
- (make-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld1 "player345" (body 56 3+45i) empty))
- 2)
- (broadcast (list iworld1 iworld1) (/ 2 WAIT-TIME))
- empty))
- ;; progress
- (check-equal? (progress
- (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld1 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- (broadcast-universe
- (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld1 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty))
- #;
- (make-bundle
- (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld1 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)
- (serial/broadcast-univ (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld1 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty))
- empty))
-
- ;; body-collide?
- (check-true (body-collide? (body 10 10+10i) (body 10 10+10i)))
- (check-true (body-collide? (body 10 10+10i) (body 10 0+10i)))
- (check-true (body-collide? (body 10 10+10i) (body 10 10)))
- (check-true (body-collide? (body 10 10+10i) (body 10 20)))
- (check-true (body-collide? (body 10 10+10i) (body 10 0+20i)))
-
- (check-false (body-collide? (body 1 10+10i) (body 1 10+13i)))
- (check-false (body-collide? (body 1 10+10i) (body 1 0+10i)))
- (check-false (body-collide? (body 1 10+10i) (body 1 10)))
- (check-false (body-collide? (body 1 10+10i) (body 1 20)))
- (check-false (body-collide? (body 1 10+10i) (body 1 0+20i)))
-
- ;; serial/broadcast-univ
- #;
- (check-equal? (serial/broadcast-univ
- (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty))
- (let ([serialized (serialize-universe (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty))])
- (list (make-mail iworld1 serialized)
- (make-mail iworld2 serialized))))
-
- ;; time-broadcast
- (let ([j (join '() 100)])
- (check-equal? (time-broadcast j)
- (make-bundle j '() '())))
- (let ([j (join `(,(ip iworld1 "sallyjoe" (body 0 0+0i) '())) 100)])
- (check-equal? (time-broadcast j)
- (make-bundle j `(,(make-mail iworld1 (/ 100 WAIT-TIME))) '())))
-
- ;; testing auxiliary functions
- (check-equal? (score `(,(ip iworld1 "foo" (body 1000 +inf.0) '())
- ,(ip iworld1 "bar" (body 0 +inf.0) '())))
- `(("foo" ,(get-score 1000))
- ("bar" ,(get-score 0))))
- ;; get-iws
- ;; empty-bundle
- (check-equal? (empty-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty)) 132))
- (make-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty)) 132) empty empty))
- (check-equal? (empty-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty)) 345))
- (make-bundle (join (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty)) 345) empty empty))
- (check-equal? (empty-bundle (play (list (ip iworld1 "player1" (body 87 67+23i) empty))
- (list (body 87 67+23i)
- (body 89 32+345i))
- empty))
- (make-bundle
- (play (list (ip iworld1 "player1" (body 87 67+23i) empty))
- (list (body 87 67+23i)
- (body 89 32+345i))
- empty)
- empty
- empty))
-
- ;; get-iws
- (check-equal? (get-iws (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty))
- (list iworld1 iworld2))
- (check-equal? (get-iws (play (list (ip iworld1 "player10" (body 10 1+10i) empty))
- empty
- empty))
- (list iworld1))
-
- ;; get-ips
- (let ([players (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))]
- [spectators (list (ip iworld1 "player10" (body 15 2+65i) empty))])
- (check-equal? (get-ips (play players
- (list (body 87 67+23i)
- (body 5 3+4i))
- spectators))
- (append players spectators))
- (check-equal? (get-ips (play (list (first players))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty))
- (append (list (first players)) empty)))
-
- ;; broadcast
- (check-equal? (broadcast (list iworld1 iworld3 iworld2)
- '(testing testing 1 2 3))
- (let ([message '(testing testing 1 2 3)])
- (list (make-mail iworld1
- message)
- (make-mail iworld3
- message)
- (make-mail iworld2
- message))))
- (check-equal? (broadcast (list iworld1)
- '(testing testing 1 2 3))
- (let ([message '(testing testing 1 2 3)])
- (list (make-mail iworld1
- message))))
- (check-equal? (broadcast (list iworld1 iworld3)
- 9)
- (let ([message 9])
- (list (make-mail iworld1
- message)
- (make-mail iworld3
- message))))
-
- ;; broadcast-state
- (let ([state (play (list (ip iworld1 "player10" (body 10 1+10i) empty)
- (ip iworld2 "player345" (body 56 3+45i) empty))
- (list (body 87 67+23i)
- (body 5 3+4i))
- empty)])
- (check-equal? (broadcast-universe state)
- (broadcast-universe state)))
-
- ;; serialize-players-for
- (let* ([waypoints1 (list (make-rectangular 383 212)
- (make-rectangular 282 192))]
- [waypoints2 (list (make-rectangular 918 319)
- (make-rectangular 481 119)
- (make-rectangular 129 321))]
- [pls (list (ip iworld1 "player10" (body 10 1+10i) waypoints1)
- (ip iworld2 "player345" (body 56 3+45i) waypoints2))]
- [pl (first pls)])
- (check-equal? (player-waypoints (first (serialize-players-for pl pls)))
- waypoints1)
- (check-equal? (player-waypoints (second (serialize-players-for pl pls)))
- (list (make-rectangular 918 319))))
-
- "server: all tests run")
diff --git a/net/ricketyspace/ror/fourteen/shared.rkt b/net/ricketyspace/ror/fourteen/shared.rkt
deleted file mode 100644
index 7f3a549..0000000
--- a/net/ricketyspace/ror/fourteen/shared.rkt
+++ /dev/null
@@ -1,156 +0,0 @@
-#lang racket
-
-;; This module describes the shared vocabulary and knowledge for the server
-;; and client modules of the Hungry Henry game.
-
-(provide ;; type Id
- id? ;; Any -> Boolean : Id
- id=? ;; Id Id -> Boolean
- ;; type GOTO
- ;; type SOTO = Time | Ackn | State | Score
- ;; type Food
- ;; type Feaster
- ;; type Body
- (struct-out player) ;;
- (struct-out body) ;;
- get-score ;; Nat -> Nat
- PLAYER-FATTEN-DELTA
- WIDTH HEIGHT CUPCAKE PLAYER-SIZE
- SCORE GOTO SERIALIZE
- GOTO-LENGTH)
-
-#| -----------------------------------------------------------------------------
-
-;; --- Tasks --------------------------------------------------------------------
-
-The game server keeps track of the entire game state [to avoid cheating by
-lients]. It collects waypoints, moves the avatars on behalf of the clients,
-detects collisions with cupcakes, has avatars eat and grow, and discovers the
-end of the game. As events occur, it informs all clients about all actions and,
-at the end of the game, tallies the scores.
-
-Each client displays the current state of the game as broadcast by the server.
-It also records and sends all mouse clicks to the server.
-
-;; --- Messages and Protocol ---------------------------------------------------
-
-The server and the client exchange messages to inform each other about
-the events in the game.
-
-Client To Server Message:
-------------------------
-
- GOTO = (list GOTO PositiveNumber PositiveNumber)
- represents the coordinates of player's latest waypoint,
- obtained via a mouse click.
- Constraint: in (list GOTO x y), (and (<= 0 x WIDTH) (<= 0 y HEIGHT))
-
-Server to Client Message:
--------------------------
-
- SOTO is one of:
- -- Number ∈ [0,1]
- called a Time message
- repreents the percentage of loading time left
- -- ID
- called an Ackn message
- represents the unique id that the server assigns to the client,
- based on the client's name
- -- (list SERIALIZE [Listof Feaster] [Listof Food])
- called a State message
- represents the complete current state of the game
- -- (list SCORE [Listof (list Id Natural)])
- called a Score message
- informs clients that the game is over and the sizes of each player.
-|#
-;; Shared Data Definitions for Messages
-
-(struct player (id body waypoints) #:prefab)
-(struct body (size loc) #:prefab #:mutable)
-;; Food = Body
-;; Feaster = (player Id Body [Listof Complex])
-;; interpretation:
-;; -- id is the player's id
-;; -- body is the player's size and location
-;; -- loc are the player's waypoints, ordered from first to last
-;; Body = (body PositiveNumber Complex)
-;; interpretation: any 'body' on the playing field, both players and cupcakes
-;; -- the postive number specifies the body's size
-;; -- the complex number represents the body's location
-;; PlayerId = String
-(define id? string?)
-(define id=? string=?)
-
-;; Message ID Constants
-(define SCORE 'score)
-(define SERIALIZE 'state)
-(define GOTO 'goto)
-(define GOTO-LENGTH 3)
-
-#| --- Protocol ----------------------------------------------------------------
-
- Client1 Client2 Server
- | | |
- | register(name1) | [universe protocol]
- |----------------------------->|
- | | |
- | | ID | an identifier message
- |<-----------------------------|
- | | t | percentage of wait time
- |<-----------------------------|
- |<-----------------------------|
- |<-----------------------------|
- | | |
- | | register(name2)
- | |------------->|
- | | |
- | | ID |
- | |<-------------|
- | | t | percentage of wait time
- |<-----------------------------|
- | |<-------------|
- |<-----------------------------|
- | |<-------------|
- | | | <==== end of wait time [clock, players]
- | state msg |
- |<-----------------------------| `(state (,feaster1 ,feaster2) ,foods)
- | |<-------------|
- | | |
- click | GOTO | | `(goto ,x ,y)
- ====> |----------------------------->| new state
- | | |
- | state msg |
- |<-----------------------------| `(state (,feaster1 ,feaster2) ,foods)
- | |<-------------|
- | | |
- | | | move, eat:
- |<-----------------------------| `(state (,feaster1 ,feaster2) ,foods)
- | |<-------------|
- | | |
- | click | GOTO | `(goto ,x ,y)
- | ====> |------------->|
- | | |
- | state msg |
- |<-----------------------------| `(state (,feaster1 ,feaster2) ,foods)
- | |<-------------|
- | | |
- | score msg | all food is eaten:
- |<-----------------------------| `(score ((,id ,score) ...))
- | |<-------------|
- | | |
- --- --- ---
-
-|#
-
-;; Shared Logical Constants
-(define WIDTH 1000)
-(define HEIGHT 700)
-(define CUPCAKE 15)
-(define PLAYER-SIZE (* 3 CUPCAKE))
-(define PLAYER-FATTEN-DELTA 5)
-
-;; Number -> Number ;; move to serer
-;; gets aplayers score given its fatness
-(define (get-score f)
- (/ (- f PLAYER-SIZE) PLAYER-FATTEN-DELTA))
-
diff --git a/net/ricketyspace/ror/one/hw.rkt b/net/ricketyspace/ror/one/hw.rkt
deleted file mode 100644
index fec7e25..0000000
--- a/net/ricketyspace/ror/one/hw.rkt
+++ /dev/null
@@ -1,3 +0,0 @@
-#lang racket
-
-'(hello-world)
diff --git a/net/ricketyspace/ror/six/resources/body.gif b/net/ricketyspace/ror/six/resources/body.gif
deleted file mode 100644
index 94a0956..0000000
--- a/net/ricketyspace/ror/six/resources/body.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/six/resources/goo-red.gif b/net/ricketyspace/ror/six/resources/goo-red.gif
deleted file mode 100644
index bf767b1..0000000
--- a/net/ricketyspace/ror/six/resources/goo-red.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/six/resources/goo.gif b/net/ricketyspace/ror/six/resources/goo.gif
deleted file mode 100644
index cb0d98b..0000000
--- a/net/ricketyspace/ror/six/resources/goo.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/six/resources/head.gif b/net/ricketyspace/ror/six/resources/head.gif
deleted file mode 100644
index 664f679..0000000
--- a/net/ricketyspace/ror/six/resources/head.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/six/resources/obstacle.gif b/net/ricketyspace/ror/six/resources/obstacle.gif
deleted file mode 100644
index 6ff288e..0000000
--- a/net/ricketyspace/ror/six/resources/obstacle.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/six/resources/tail.gif b/net/ricketyspace/ror/six/resources/tail.gif
deleted file mode 100644
index 6fbd317..0000000
--- a/net/ricketyspace/ror/six/resources/tail.gif
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/six/snake.rkt b/net/ricketyspace/ror/six/snake.rkt
deleted file mode 100644
index c57b01c..0000000
--- a/net/ricketyspace/ror/six/snake.rkt
+++ /dev/null
@@ -1,295 +0,0 @@
-#lang racket
-(require 2htdp/universe 2htdp/image)
-
-;; data
-(struct pit (snake goos obstacles dinged))
-(struct snake (dir segs))
-(struct goo (loc expire type))
-(struct obstacle (loc expire))
-(struct posn (x y))
-
-;; constants
-(define TICK-RATE 1/10)
-
-(define SIZE 30)
-
-(define SEG-SIZE 15)
-
-(define EXPIRATION-TIME 150)
-(define OBSTACLE-EXPIRATION-TIME 250)
-
-(define WIDTH-PX (* SEG-SIZE 30))
-(define HEIGHT-PX (* SEG-SIZE 30))
-
-(define MT-SCENE (empty-scene WIDTH-PX HEIGHT-PX))
-(define GOO-IMG (bitmap "resources/goo.gif"))
-(define GOO-RED-IMG (bitmap "resources/goo-red.gif"))
-(define OBSTACLE-IMG (bitmap "resources/obstacle.gif"))
-(define SEG-IMG (bitmap "resources/body.gif"))
-(define HEAD-IMG (bitmap "resources/head.gif"))
-
-(define HEAD-LEFT-IMG HEAD-IMG)
-(define HEAD-DOWN-IMG (rotate 90 HEAD-LEFT-IMG))
-(define HEAD-RIGHT-IMG (flip-horizontal HEAD-LEFT-IMG))
-(define HEAD-UP-IMG (flip-vertical HEAD-DOWN-IMG))
-
-(define ENDGAME-TEXT-SIZE 15)
-
-;; main
-(define (start-snake)
- (big-bang (pit (snake "right" (list (posn 1 1)))
- (list (fresh-goo)
- (fresh-goo)
- (fresh-goo)
- (fresh-goo)
- (fresh-goo)
- (fresh-goo))
- (list (fresh-obstacle)
- (fresh-obstacle))
- 0)
- (on-tick next-pit TICK-RATE)
- (on-key direct-snake)
- (to-draw render-pit)
- (stop-when dead? render-end)))
-
-(define (next-pit w)
- (define snake (pit-snake w))
- (define goos (pit-goos w))
- (define obstacles (pit-obstacles w))
- (define dinged (pit-dinged w))
- (define goo-to-eat (can-eat snake goos))
- (if goo-to-eat
- (pit (grow-size snake (goo-type goo-to-eat))
- (age-goo (eat goos goo-to-eat))
- (age-obstacle obstacles) (+ 1 dinged))
- (pit (slither snake)
- (age-goo goos)
- (age-obstacle obstacles) dinged)))
-
-(define (direct-snake w ke)
- (cond [(dir? ke) (world-change-dir w ke)]
- [else w]))
-
-(define (render-pit w)
- (snake+scene (pit-snake w)
- (goo-list+scene (pit-goos w)
- (obstacle-list+scene
- (pit-obstacles w) MT-SCENE))))
-
-(define (dead? w)
- (define snake (pit-snake w))
- (or (self-colliding? snake)
- (wall-colliding? snake)
- (obstacle-colliding? snake (pit-obstacles w))))
-
-(define (render-end w)
- (overlay (above (text "Game Over" ENDGAME-TEXT-SIZE "black")
- (text (string-append "You dinged "
- (number->string (pit-dinged w))
- " goos.")
- ENDGAME-TEXT-SIZE "black"))
- (render-pit w)))
-
-
-;; clock
-(define (can-eat snake goos)
- (cond [(empty? goos) #f]
- [else (if (close? (snake-head snake) (first goos))
- (first goos)
- (can-eat snake (rest goos)))]))
-
-(define (eat goos goo-to-eat)
- (append (list (fresh-goo)) (remove goo-to-eat goos)))
-
-(define (close? s g)
- (posn=? s (goo-loc g)))
-
-(define (grow-size sn size)
- (cond [(= size 0) sn]
- [else (grow-size (grow sn) (- size 1))]))
-
-(define (grow sn)
- (snake (snake-dir sn)
- (cons (next-head sn) (snake-segs sn))))
-
-(define (slither sn)
- (snake (snake-dir sn)
- (cons (next-head sn) (all-but-last (snake-segs sn)))))
-
-(define (next-head sn)
- (define head (snake-head sn))
- (define dir (snake-dir sn))
- (cond [(string=? dir "up") (posn-move head 0 -1)]
- [(string=? dir "down") (posn-move head 0 1)]
- [(string=? dir "left") (posn-move head -1 0)]
- [(string=? dir "right") (posn-move head 1 0)]))
-
-(define (posn-move p dx dy)
- (posn (+ (posn-x p) dx)
- (+ (posn-y p) dy)))
-
-(define (all-but-last segs)
- (cond [(empty? (rest segs)) empty]
- [else (cons (first segs) (all-but-last (rest segs)))]))
-
-(define (age-goo goos)
- (rot (renew goos)))
-
-(define (renew goos)
- (cond [(empty? goos) empty]
- [(rotten? (first goos))
- (append (fresh-goos) (renew (rest goos)))]
- [else
- (append (list (first goos)) (renew (rest goos)))]))
-
-(define (rot goos)
- (cond [(empty? goos) empty]
- [else (cons (decay (first goos)) (rot (rest goos)))]))
-
-(define (rotten? g)
- (zero? (goo-expire g)))
-
-(define (decay g)
- (goo (goo-loc g) (sub1 (goo-expire g)) (goo-type g)))
-
-(define (fresh-goo)
- (goo (posn (add1 (random (sub1 SIZE)))
- (add1 (random (sub1 SIZE))))
- EXPIRATION-TIME
- (random 1 3)))
-
-(define (fresh-goos)
- (define (gen-goos n)
- (cond [(= n 0) empty]
- [else (cons (fresh-goo) (gen-goos (- n 1)))]))
- (let ((n (random 3)))
- (gen-goos n)))
-
-(define (age-obstacle obstacles)
- (rot-obstacles (renew-obstacles obstacles)))
-
-(define (renew-obstacles obstacles)
- (cond [(empty? obstacles) empty]
- [(obstacle-expired? (first obstacles))
- (cons (fresh-obstacle) (renew-obstacles (rest obstacles)))]
- [else
- (cons (first obstacles) (renew-obstacles (rest obstacles)))]))
-
-(define (rot-obstacles obstacles)
- (cond [(empty? obstacles) empty]
- [else (cons (decay-obstacle (first obstacles))
- (rot-obstacles (rest obstacles)))]))
-
-(define (obstacle-expired? obs)
- (zero? (obstacle-expire obs)))
-
-(define (decay-obstacle obs)
- (obstacle (obstacle-loc obs) (sub1 (obstacle-expire obs))))
-
-(define (fresh-obstacle)
- (obstacle (posn (add1 (random (sub1 SIZE)))
- (add1 (random (sub1 SIZE))))
- OBSTACLE-EXPIRATION-TIME))
-
-;; keys
-(define (dir? x)
- (or (key=? x "up")
- (key=? x "down")
- (key=? x "left")
- (key=? x "right")))
-
-(define (world-change-dir w d)
- (define the-snake (pit-snake w))
- (cond [(and (opposite-dir? (snake-dir the-snake) d)
- (cons? (rest (snake-segs the-snake))))
- (stop-with w)]
- [else
- (pit (snake-change-dir the-snake d)
- (pit-goos w)
- (pit-obstacles w)
- (pit-dinged w))]))
-
-(define (opposite-dir? d1 d2)
- (cond [(string=? d1 "up") (string=? d2 "down")]
- [(string=? d1 "down") (string=? d2 "up")]
- [(string=? d1 "left") (string=? d2 "right")]
- [(string=? d1 "right") (string=? d2 "left")]))
-
-
-;; render
-(define (snake+scene snake scene)
- (define snake-body-scene
- (img-list+scene (snake-body snake) SEG-IMG scene))
- (define dir (snake-dir snake))
- (img+scene (snake-head snake)
- (cond [(string=? "up" dir) HEAD-UP-IMG]
- [(string=? "down" dir) HEAD-DOWN-IMG]
- [(string=? "left" dir) HEAD-LEFT-IMG]
- [(string=? "right" dir) HEAD-RIGHT-IMG])
- snake-body-scene))
-
-(define (goo-list+scene goos scene)
- (define (get-posns-from-goo goos type)
- (cond [(empty? goos) empty]
- [(= (goo-type (first goos)) type)
- (cons (goo-loc (first goos))
- (get-posns-from-goo (rest goos) type))]
- [else (get-posns-from-goo (rest goos) type)]))
- (img-list+scene (get-posns-from-goo goos 1) GOO-IMG
- (img-list+scene (get-posns-from-goo goos 2)
- GOO-RED-IMG scene)))
-
-(define (obstacle-list+scene obstacles scene)
- (define (get-posns-from-obstacle obstacles)
- (cond [(empty? obstacles) empty]
- [else (cons (obstacle-loc (first obstacles))
- (get-posns-from-obstacle (rest obstacles)))]))
- (img-list+scene (get-posns-from-obstacle obstacles)
- OBSTACLE-IMG scene))
-
-(define (img-list+scene posns img scene)
- (cond [(empty? posns) scene]
- [else (img+scene
- (first posns)
- img
- (img-list+scene (rest posns) img scene))]))
-
-(define (img+scene posn img scene)
- (place-image img
- (* (posn-x posn) SEG-SIZE)
- (* (posn-y posn) SEG-SIZE)
- scene))
-
-
-;; end game
-(define (self-colliding? snake)
- (cons? (member (snake-head snake) (snake-body snake))))
-
-(define (wall-colliding? snake)
- (define x (posn-x (snake-head snake)))
- (define y (posn-y (snake-head snake)))
- (or (= 0 x) (= x SIZE)
- (= 0 y) (= y SIZE)))
-
-(define (obstacle-colliding? snake obstacles)
- (cond [(empty? obstacles) #f]
- [(posn=? (snake-head snake)
- (obstacle-loc (first obstacles))) #t]
- [else (obstacle-colliding? snake (rest obstacles))]))
-
-;; aux
-(define (posn=? p1 p2)
- (and (= (posn-x p1) (posn-x p2))
- (= (posn-y p1) (posn-y p2))))
-
-(define (snake-head sn)
- (first (snake-segs sn)))
-
-(define (snake-body sn)
- (rest (snake-segs sn)))
-
-(define (snake-tail sn)
- (last (snake-segs sn)))
-
-(define (snake-change-dir sn d)
- (snake d (snake-segs sn)))
diff --git a/net/ricketyspace/ror/six/snakes.rkt b/net/ricketyspace/ror/six/snakes.rkt
deleted file mode 100644
index dae3468..0000000
--- a/net/ricketyspace/ror/six/snakes.rkt
+++ /dev/null
@@ -1,362 +0,0 @@
-#lang racket
-(require 2htdp/universe 2htdp/image)
-
-;; data
-(struct pit (snake-1 snake-2 goos obstacles dinged))
-(struct snake (dir segs))
-(struct goo (loc expire type))
-(struct obstacle (loc expire))
-(struct posn (x y))
-
-;; constants
-(define TICK-RATE 1/10)
-
-(define SIZE 30)
-
-(define SEG-SIZE 15)
-
-(define EXPIRATION-TIME 150)
-(define OBSTACLE-EXPIRATION-TIME 250)
-
-(define WIDTH-PX (* SEG-SIZE 30))
-(define HEIGHT-PX (* SEG-SIZE 30))
-
-(define MT-SCENE (empty-scene WIDTH-PX HEIGHT-PX))
-(define GOO-IMG (bitmap "resources/goo.gif"))
-(define GOO-RED-IMG (bitmap "resources/goo-red.gif"))
-(define OBSTACLE-IMG (bitmap "resources/obstacle.gif"))
-(define SEG-IMG (bitmap "resources/body.gif"))
-(define HEAD-IMG (bitmap "resources/head.gif"))
-
-(define HEAD-LEFT-IMG HEAD-IMG)
-(define HEAD-DOWN-IMG (rotate 90 HEAD-LEFT-IMG))
-(define HEAD-RIGHT-IMG (flip-horizontal HEAD-LEFT-IMG))
-(define HEAD-UP-IMG (flip-vertical HEAD-DOWN-IMG))
-
-(define ENDGAME-TEXT-SIZE 15)
-
-;; main
-(define (start-snakes)
- (big-bang (pit (snake "right" (list (posn 1 1)))
- (snake "d" (list (posn 1 10)))
- (list (fresh-goo)
- (fresh-goo)
- (fresh-goo)
- (fresh-goo)
- (fresh-goo)
- (fresh-goo))
- (list (fresh-obstacle)
- (fresh-obstacle))
- 0)
- (on-tick next-pit TICK-RATE)
- (on-pad direct-snakes)
- (to-draw render-pit)
- (stop-when dead? render-end)))
-
-(define (next-pit w)
- (define snake-1 (pit-snake-1 w))
- (define snake-2 (pit-snake-2 w))
- (define goos (pit-goos w))
- (define obstacles (pit-obstacles w))
- (define dinged (pit-dinged w))
- (define goo-to-eat-sn1 (can-eat snake-1 goos))
- (define goo-to-eat-sn2 (can-eat snake-2 goos))
- (cond [(and goo-to-eat-sn1 goo-to-eat-sn2) ; sn1 and sn2 dinged.
- (pit (grow-size snake-1 (goo-type goo-to-eat-sn1))
- (grow-size snake-2 (goo-type goo-to-eat-sn2))
- (age-goo (eat (eat goos goo-to-eat-sn1) goo-to-eat-sn2))
- (age-obstacle obstacles) (+ 2 dinged))]
- [(and goo-to-eat-sn1 (not goo-to-eat-sn2)) ; sn1 dinged.
- (pit (grow-size snake-1 (goo-type goo-to-eat-sn1))
- (slither snake-2)
- (age-goo (eat goos goo-to-eat-sn1))
- (age-obstacle obstacles) (+ 1 dinged))]
- [(and (not goo-to-eat-sn1) goo-to-eat-sn2) ; sn2 dinged.
- (pit (slither snake-1)
- (grow-size snake-2 (goo-type goo-to-eat-sn2))
- (age-goo (eat goos goo-to-eat-sn2))
- (age-obstacle obstacles) (+ 1 dinged))]
- [else ; none dinged.
- (pit (slither snake-1)
- (slither snake-2)
- (age-goo goos)
- (age-obstacle obstacles) dinged)]))
-
-
-(define (direct-snakes w ke)
- (cond [(arrow-key? ke) (direct-snake-1 w ke)]
- [(wasd-key? ke) (direct-snake-2 w ke)]
- [else w]))
-
-(define (direct-snake-1 w ke)
- (world-change-dir 1 w ke))
-
-(define (direct-snake-2 w ke)
- (world-change-dir 2 w ke))
-
-(define (render-pit w)
- (snake+scene (pit-snake-1 w)
- (snake+scene (pit-snake-2 w)
- (goo-list+scene (pit-goos w)
- (obstacle-list+scene
- (pit-obstacles w) MT-SCENE)))))
-
-(define (dead? w)
- (define snake-1 (pit-snake-1 w))
- (define snake-2 (pit-snake-2 w))
- (define (colliding? sn sn-other)
- (or (self-colliding? sn)
- (wall-colliding? sn)
- (obstacle-colliding? sn (pit-obstacles w))
- (snake-colliding? sn sn-other)))
- (or (colliding? snake-1 snake-2) (colliding? snake-2 snake-1)))
-
-(define (render-end w)
- (overlay (above (text "Game Over" ENDGAME-TEXT-SIZE "black")
- (text (string-append "Dinged "
- (number->string (pit-dinged w))
- " goos.")
- ENDGAME-TEXT-SIZE "black"))
- (render-pit w)))
-
-
-;; clock
-(define (can-eat snake goos)
- (cond [(empty? goos) #f]
- [else (if (close? (snake-head snake) (first goos))
- (first goos)
- (can-eat snake (rest goos)))]))
-
-(define (eat goos goo-to-eat)
- (append (list (fresh-goo)) (remove goo-to-eat goos)))
-
-(define (close? s g)
- (posn=? s (goo-loc g)))
-
-(define (grow-size sn size)
- (cond [(= size 0) sn]
- [else (grow-size (grow sn) (- size 1))]))
-
-(define (grow sn)
- (snake (snake-dir sn)
- (cons (next-head sn) (snake-segs sn))))
-
-(define (slither sn)
- (snake (snake-dir sn)
- (cons (next-head sn) (all-but-last (snake-segs sn)))))
-
-(define (next-head sn)
- (define head (snake-head sn))
- (define dir (snake-dir sn))
- (cond [(or (string=? dir "up") (string=? dir "w")) (posn-move head 0 -1)]
- [(or (string=? dir "down") (string=? dir "s")) (posn-move head 0 1)]
- [(or (string=? dir "left") (string=? dir "a")) (posn-move head -1 0)]
- [(or (string=? dir "right") (string=? dir "d")) (posn-move head 1 0)]))
-
-(define (posn-move p dx dy)
- (posn (+ (posn-x p) dx)
- (+ (posn-y p) dy)))
-
-(define (all-but-last segs)
- (cond [(empty? (rest segs)) empty]
- [else (cons (first segs) (all-but-last (rest segs)))]))
-
-(define (age-goo goos)
- (rot (renew goos)))
-
-(define (renew goos)
- (cond [(empty? goos) empty]
- [(rotten? (first goos))
- (append (fresh-goos) (renew (rest goos)))]
- [else
- (append (list (first goos)) (renew (rest goos)))]))
-
-(define (rot goos)
- (cond [(empty? goos) empty]
- [else (cons (decay (first goos)) (rot (rest goos)))]))
-
-(define (rotten? g)
- (zero? (goo-expire g)))
-
-(define (decay g)
- (goo (goo-loc g) (sub1 (goo-expire g)) (goo-type g)))
-
-(define (fresh-goo)
- (goo (posn (add1 (random (sub1 SIZE)))
- (add1 (random (sub1 SIZE))))
- EXPIRATION-TIME
- (random 1 3)))
-
-(define (fresh-goos)
- (define (gen-goos n)
- (cond [(= n 0) empty]
- [else (cons (fresh-goo) (gen-goos (- n 1)))]))
- (let ((n (random 3)))
- (gen-goos n)))
-
-(define (age-obstacle obstacles)
- (rot-obstacles (renew-obstacles obstacles)))
-
-(define (renew-obstacles obstacles)
- (cond [(empty? obstacles) empty]
- [(obstacle-expired? (first obstacles))
- (cons (fresh-obstacle) (renew-obstacles (rest obstacles)))]
- [else
- (cons (first obstacles) (renew-obstacles (rest obstacles)))]))
-
-(define (rot-obstacles obstacles)
- (cond [(empty? obstacles) empty]
- [else (cons (decay-obstacle (first obstacles))
- (rot-obstacles (rest obstacles)))]))
-
-(define (obstacle-expired? obs)
- (zero? (obstacle-expire obs)))
-
-(define (decay-obstacle obs)
- (obstacle (obstacle-loc obs) (sub1 (obstacle-expire obs))))
-
-(define (fresh-obstacle)
- (obstacle (posn (add1 (random (sub1 SIZE)))
- (add1 (random (sub1 SIZE))))
- OBSTACLE-EXPIRATION-TIME))
-
-;; keys
-(define (dir? x)
- (or (arrow-key? x)
- (wasd-key? x)))
-
-(define (arrow-key? x)
- (or (key=? x "up")
- (key=? x "down")
- (key=? x "left")
- (key=? x "right")))
-
-(define (wasd-key? x)
- (or (key=? x "w")
- (key=? x "s")
- (key=? x "a")
- (key=? x "d")))
-
-(define (world-change-dir sn-number w d)
- (define snake-1 (pit-snake-1 w))
- (define snake-2 (pit-snake-2 w))
- (cond [(and (= sn-number 1) ;snake-1
- (opposite-dir? (snake-dir snake-1) d)
- (cons? (rest (snake-segs snake-1))))
- (stop-with w)]
- [(and (= sn-number 2) ;snake-2
- (opposite-dir? (snake-dir snake-2) d)
- (cons? (rest (snake-segs snake-2))))
- (stop-with w)]
- [(= sn-number 1) ;snake-1 change dir.
- (pit (snake-change-dir snake-1 d)
- (pit-snake-2 w)
- (pit-goos w)
- (pit-obstacles w)
- (pit-dinged w))]
- [else ;snake-2 change dir.
- (pit (pit-snake-1 w)
- (snake-change-dir snake-2 d)
- (pit-goos w)
- (pit-obstacles w)
- (pit-dinged w))]))
-
-(define (opposite-dir? d1 d2)
- (cond [(string=? d1 "up") (string=? d2 "down")]
- [(string=? d1 "down") (string=? d2 "up")]
- [(string=? d1 "left") (string=? d2 "right")]
- [(string=? d1 "right") (string=? d2 "left")]
- [(string=? d1 "w") (string=? d2 "s")]
- [(string=? d1 "s") (string=? d2 "w")]
- [(string=? d1 "a") (string=? d2 "d")]
- [(string=? d1 "d") (string=? d2 "a")]))
-
-
-;; render
-(define (snake+scene snake scene)
- (define snake-body-scene
- (img-list+scene (snake-body snake) SEG-IMG scene))
- (define dir (snake-dir snake))
- (img+scene (snake-head snake)
- (cond [(or (string=? "up" dir) (string=? "w" dir))
- HEAD-UP-IMG]
- [(or (string=? "down" dir) (string=? "s" dir))
- HEAD-DOWN-IMG]
- [(or (string=? "left" dir) (string=? "a" dir))
- HEAD-LEFT-IMG]
- [(or (string=? "right" dir) (string=? "d" dir))
- HEAD-RIGHT-IMG])
- snake-body-scene))
-
-(define (goo-list+scene goos scene)
- (define (get-posns-from-goo goos type)
- (cond [(empty? goos) empty]
- [(= (goo-type (first goos)) type)
- (cons (goo-loc (first goos))
- (get-posns-from-goo (rest goos) type))]
- [else (get-posns-from-goo (rest goos) type)]))
- (img-list+scene (get-posns-from-goo goos 1) GOO-IMG
- (img-list+scene (get-posns-from-goo goos 2)
- GOO-RED-IMG scene)))
-
-(define (obstacle-list+scene obstacles scene)
- (define (get-posns-from-obstacle obstacles)
- (cond [(empty? obstacles) empty]
- [else (cons (obstacle-loc (first obstacles))
- (get-posns-from-obstacle (rest obstacles)))]))
- (img-list+scene (get-posns-from-obstacle obstacles)
- OBSTACLE-IMG scene))
-
-(define (img-list+scene posns img scene)
- (cond [(empty? posns) scene]
- [else (img+scene
- (first posns)
- img
- (img-list+scene (rest posns) img scene))]))
-
-(define (img+scene posn img scene)
- (place-image img
- (* (posn-x posn) SEG-SIZE)
- (* (posn-y posn) SEG-SIZE)
- scene))
-
-
-;; end game
-(define (self-colliding? snake)
- (cons? (member (snake-head snake) (snake-body snake))))
-
-(define (wall-colliding? snake)
- (define x (posn-x (snake-head snake)))
- (define y (posn-y (snake-head snake)))
- (or (= 0 x) (= x SIZE)
- (= 0 y) (= y SIZE)))
-
-(define (obstacle-colliding? snake obstacles)
- (cond [(empty? obstacles) #f]
- [(posn=? (snake-head snake)
- (obstacle-loc (first obstacles))) #t]
- [else (obstacle-colliding? snake (rest obstacles))]))
-
-(define (snake-colliding? snake snake-other)
- (define (head-in-other sn other)
- (cond [(empty? other) #f]
- [(posn=? sn (first other)) #t]
- [else (head-in-other sn (rest other))]))
- (head-in-other (snake-head snake) (snake-segs snake-other)))
-
-;; aux
-(define (posn=? p1 p2)
- (and (= (posn-x p1) (posn-x p2))
- (= (posn-y p1) (posn-y p2))))
-
-(define (snake-head sn)
- (first (snake-segs sn)))
-
-(define (snake-body sn)
- (rest (snake-segs sn)))
-
-(define (snake-tail sn)
- (last (snake-segs sn)))
-
-(define (snake-change-dir sn d)
- (snake d (snake-segs sn)))
diff --git a/net/ricketyspace/ror/ten/graphics/dice1.png b/net/ricketyspace/ror/ten/graphics/dice1.png
deleted file mode 100644
index 3f4899c..0000000
--- a/net/ricketyspace/ror/ten/graphics/dice1.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/ten/graphics/dice2.png b/net/ricketyspace/ror/ten/graphics/dice2.png
deleted file mode 100644
index 2fa32ea..0000000
--- a/net/ricketyspace/ror/ten/graphics/dice2.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/ten/graphics/dice3.png b/net/ricketyspace/ror/ten/graphics/dice3.png
deleted file mode 100644
index 005ee75..0000000
--- a/net/ricketyspace/ror/ten/graphics/dice3.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/ten/graphics/dice4.png b/net/ricketyspace/ror/ten/graphics/dice4.png
deleted file mode 100644
index 47bb291..0000000
--- a/net/ricketyspace/ror/ten/graphics/dice4.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/ten/source.rkt b/net/ricketyspace/ror/ten/source.rkt
deleted file mode 100644
index a2b6a96..0000000
--- a/net/ricketyspace/ror/ten/source.rkt
+++ /dev/null
@@ -1,1218 +0,0 @@
-#lang racket
-
-#|
- The Dice of Doom game, the eager version
- ----------------------------------------
-
- The Dice of Doom game is a turn-based game for two players sharing one keyboard.
- Since this implementation employs an eager strategy to build the complete game
- tree of all possible moves, it is only a step in the right direction.
-
- Each player owns hexagonal territories, which are arranged into a planar game
- board. A territory comes with a number of dice. When it is a player's turn,
- she marks one of her territories as a launching pad for an attack at a
- neigboring territory of the other player. Such an attack is enabled only if
- her chosen territory has more dice than the territory of the other player.
- The effect of the attack is that the territory changes ownership and that all
- but one of the attack dice are moved to the newly conquered territory. A
- player may continue her turn as long as she can launch attacks. Optionally,
- she may choose to pass after her first attack is executed, meaning she ends
- her turn. At the end of a turn, a number of dices are distributed across the
- players' territories. The game is over when a player whose turn it is cannot
- attack on her first move.
-
- A player can use the following five keys to play the game:
- -- with ← and → (arrow keys), the player changes the territory focus
- -- with enter, the player marks a territory the launching pad for an attack
- -- with the "d" key, the player unmarks a territory
- -- with the "p" key the player passes.
- Once a player passes, the game announces whose turn it is next.
-
- Play
- ----
-
- Run and evaluate
- (roll-the-dice)
- This will pop up a window that the game board, and instructions.
-|#
-
-(require 2htdp/image (except-in 2htdp/universe left right))
-
-;
-;
-;
-;
-; ;;;; ; ;;; ;;; ;; ;;
-; ; ; ; ; ; ;
-; ; ; ;;; ;;; ; ;;;; ; ; ;;;; ;; ;;; ; ;;; ;
-; ; ; ; ; ;; ; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ;;;;;; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;
-; ;;;; ;;;;; ;;;; ;;;;; ; ; ;;;; ;;;;; ;;;;; ;;; ;;
-;
-;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-;; Data
-
-(struct dice-world (src board gt) #:transparent)
-;; DiceWorld = (dice-world (U #false Natural) Board GameTree)
-;; in (dice-world i b gt)
-;; -- if i is a Natural, it is an index for the territory that the player has marked for an attack
-;; -- if i is #f, no territory has been marked yet
-;; b is the current board
-;; gt is the game-tree for the given i and b
-
-(struct game (board player moves) #:transparent)
-;; GameTree = (game Board Player [Listof Move])
-;; in (game-tree b p lm)
-;; -- b is the current board
-;; -- p is the current player
-;; -- lm is the list of moves that that player may execute
-
-;; Board = [List-of Territory]
-;; the first field in the list is the currently marked territory
-
-;; Player ∈ [0, PLAYER#) | Natural
-
-(struct move (action gt) #:transparent)
-;; Move = (move Action GameTree)
-;; in (move a gt)
-;; -- a represents the actione to be takem
-;; -- gt is the game-tree resulting from that action
-
-;; Action is one of:
-;; -- '() a passing move
-;; -- (list Natural Natural) the move where the first attacks the second
-
-(struct territory (index player dice x y) #:transparent)
-;; Territory = (territory Natural Player Dice Integer Integer)
-;; in (territory i p d x y)
-;; -- i is a unique identifier for the territory; it also determines its initial location
-;; -- p is the player who owns this territory
-;; -- d is the number of dice on this board
-;; -- x is the x coordiate of this territory in pixels
-;; -- y is the y coordiate of this territory in pixels
-
-;; Territory Natural -> Territory
-;; updates number of dice on territory
-(define (territory-set-dice t d)
- (territory (territory-index t) (territory-player t) d (territory-x t) (territory-y t)))
-
-;; Territory Player -> Territory
-;; updates owner of territory
-(define (territory-set-player t p)
- (territory (territory-index t) p (territory-dice t) (territory-x t) (territory-y t)))
-
-;; ---------------------------------------------------------------------------------------------------
-;; sample game tree for BOOK
-
-(define b1
- (list (territory 1 0 1 'a 'b)
- (territory 0 0 1 'x 'y)))
-
-(define b1-alternative
- (list (territory 0 0 1 'x 'y)
- (territory 1 0 1 'a 'b)))
-
-(define b3
- (list (territory 0 0 2 'x 'y)
- (territory 1 1 1 'a 'b)))
-
-(define gt1 (game b1 1 '()))
-
-(define mv2 (move '() gt1))
-
-(define gt2 (game b1-alternative 0 (list mv2)))
-
-(define mv3 (move '(0 1) gt2))
-
-(define gt3 (game b3 0 (list mv3)))
-
-;; ---------------------------------------------------------------------------------------------------
-;; Constants
-
-; initalization constants
-(define PLAYER# 2)
-(define DICE# 3)
-(define BOARD 2)
-(define GRID (* BOARD BOARD))
-(define INIT-PLAYER 0)
-(define INIT-SPARE-DICE 10)
-; The depth at which to limit the gametree
-(define AI-DEPTH 4)
-(define AI 1)
-
-; graphical constants: territories
-(define DICE-OFFSET 6)
-(define SIDE 75)
-(define OFFSET0 (* 2 SIDE))
-(define ROTATION 30)
-(define HEX 6)
-(define (hexagon color)
- (rotate ROTATION (regular-polygon SIDE HEX "solid" color)))
-(define X-OFFSET (image-width (hexagon "black")))
-(define Y-OFFSET (* (image-height (hexagon "black")) 3/4))
-
-; graphical constants
-(define COLORS
- (list (make-color 255 0 0 100)
- (make-color 0 255 0 100)
- (make-color 0 0 255 100)))
-(define FOCUS (rotate ROTATION (regular-polygon SIDE 6 "outline" "black")))
-(define D1 (bitmap "graphics/dice1.png"))
-(define D2 (bitmap "graphics/dice2.png"))
-(define D3 (bitmap "graphics/dice3.png"))
-(define D4 (bitmap "graphics/dice4.png"))
-(define IMG-LIST (list D1 D2 D3 D4))
-
-(define TEXT-SIZE 25)
-(define TEXT-COLOR "black")
-(define INSTRUCT
- "← and → to move among territories, <enter> to mark, <d> to unmark, and <p> to pass")
-(define AI-TURN "It's the Mighty AI's turn")
-(define YOUR-TURN "It's your turn")
-(define INFO-X-OFFSET 100)
-(define INFO-Y-OFFSET 50)
-
-(define INSTRUCTIONS (text INSTRUCT TEXT-SIZE TEXT-COLOR))
-(define WIDTH (+ (image-width INSTRUCTIONS) 50))
-(define HEIGHT 600)
-(define (PLAIN)
- (define iw (image-width INSTRUCTIONS))
- (define bw (* SIDE 2 BOARD))
- (set! WIDTH (+ (max iw bw) 50))
- (set! HEIGHT (+ (* SIDE 2 BOARD) 50))
- (empty-scene WIDTH HEIGHT))
-(define (ISCENE)
- (define mt (PLAIN))
- (when (or (> (image-width mt) 1280) (> (image-height mt) 800))
- (error 'scene "it is impossible to draw a ~s x ~s game scene for a 1280 x 800 laptop screen" (image-width mt) (image-height mt)))
- (place-image INSTRUCTIONS (* .5 WIDTH) (* .9 HEIGHT) mt))
-
-;
-;
-;
-;
-; ;;; ;;; ;
-; ;; ;;
-; ;; ;; ;;;; ;;; ;; ;;
-; ; ; ; ; ; ; ;; ;
-; ; ; ; ;;;;; ; ; ;
-; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ;
-; ;;; ;;; ;;; ;; ;;;;; ;;; ;;;
-;
-;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-
-;; start the game
-(define (roll-the-dice)
- (big-bang (create-world-of-dice-and-doom)
- (on-key interact-with-board)
- (to-draw draw-dice-world)
- (stop-when no-more-moves-in-world?
- draw-end-of-dice-world)))
-
-;; -> DiceWorld
-;; Returns a randomly generated world. If the world that
-;; has been generated starts as a tie, the world is regenerated.
-;; property: world is not in endgame state (no-more-moves? returns false)
-(define (create-world-of-dice-and-doom)
- (define board (territory-build))
- (define gamet (game-tree board INIT-PLAYER INIT-SPARE-DICE))
- (define new-world (dice-world #f board gamet))
- (if (no-more-moves-in-world? new-world)
- (create-world-of-dice-and-doom)
- new-world))
-
-;; DiceWorld Key -> DiceWorld
-;; Handles key events from a player
-(define (interact-with-board w k)
- (cond [(key=? "left" k)
- (refocus-board w left)]
- [(key=? "right" k)
- (refocus-board w right)]
- [(key=? "p" k)
- (pass w)]
- [(key=? "\r" k)
- (mark w)]
- [(key=? "d" k)
- (unmark w)]
- [else w]))
-
-;; Diceworld -> Scene
-;; draws the world
-(define (draw-dice-world w)
- (add-player-info
- (game-player (dice-world-gt w))
- (add-winning-probability w (add-board-to-scene w (ISCENE)))))
-
-;; DiceWorld -> Boolean
-;; is it possible to play any moves from this world state?
-(define (no-more-moves-in-world? w)
- (define tree (dice-world-gt w))
- (define board (dice-world-board w))
- (define player (game-player tree))
- (or (no-more-moves? tree)
- (for/and ((t board)) (= (territory-player t) player))))
-
-;; DiceWorld -> Image
-;; render the endgame screen
-(define (draw-end-of-dice-world w)
- (define board (dice-world-board w))
- (define message (text (won board) TEXT-SIZE TEXT-COLOR))
- (define background (add-board-to-scene w (PLAIN)))
- (overlay message background))
-
-;; Board -> String
-;; Which player has won the game -- eager is for N human players
-(define (won board)
- (define-values (best-score w) (winners board))
- (if (cons? (rest w)) "It's a tie." "You won."))
-
-;
-;
-;
-;
-; ;;;;; ;
-; ; ;
-; ; ;; ;; ;;; ;;;;;
-; ; ;; ; ; ;
-; ; ; ; ; ;
-; ; ; ; ; ;
-; ; ; ; ; ; ;
-; ;;;;; ;;; ;;; ;;;;; ;;;
-;
-;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-;; Making A Board
-
-;; -> Board
-;; Creates a list of territories the size of GRID with given x and y coordinates
-;; properties: dice is (0,MAX-DICE]
-;; returns list of size GRID
-(define (territory-build)
- (for/list ([n (in-range GRID)])
- (territory n (modulo n PLAYER#) (dice) (get-x n) (get-y n))))
-
-;; -> Natural
-;; the number of initial die on a territory
-(define (dice)
- (add1 (random DICE#)))
-
-;; Natural -> Number
-;; the x coordinate for territory n of a board
-(define (get-x n)
- (+ OFFSET0
- (if (odd? (get-row n)) 0 (/ X-OFFSET 2))
- (* X-OFFSET (modulo n BOARD))))
-
-;; Natural -> Number
-;; the y coordinate for territory n of a board
-(define (get-y n)
- (+ OFFSET0 (* Y-OFFSET (get-row n))))
-
-;; ---------------------------------------------------------------------------------------------------
-;; Making a Game Tree
-
-;; Board Player Natural -> GameTree
-;; creates a complete game-tree from the given board, player, and spare dice
-(define (game-tree board player dice)
- ;; create tree of attacks from this position; add passing move
- (define (attacks board)
- (for*/list ([src board]
- [dst (neighbors (territory-index src))]
- #:when (attackable? board player src dst))
- (define from (territory-index src))
- (define dice (territory-dice src))
- (define newb (execute board player from dst dice))
- (define attacks-from-newb
- (game newb player (cons (passes newb) (attacks newb))))
- (move (list from dst) attacks-from-newb)))
- ;; create a passing move , distribute dice, continue
- (define (passes board)
- (define-values (new-dice newb) (distribute board player dice))
- (move '() (game-tree newb (switch player) new-dice)))
- ;; -- START: --
- (game board player (attacks board)))
-
-;; Player -> Player
-;; switches from one player to the next
-(define (switch player)
- (modulo (+ player 1) PLAYER#))
-
-;; Board Player Natural -> Natural Board
-;; adds reinforcements to the game board
-;; > (add-new-dice (list (territory 0 2 2 9 0)) 2 2))
-;; (list (territory 0 2 2 9 0))
-(define (distribute board player spare-dice)
- (for/fold ([dice spare-dice] [new-board '()]) ([t board])
- (if (and (= (territory-player t) player)
- (< (territory-dice t) DICE#)
- (not (zero? dice)))
- (values (- dice 1) (cons (add-dice-to t) new-board))
- (values dice (cons t new-board)))))
-
-;; Territory -> Territory
-;; adds one dice to the given territory
-(define (add-dice-to t)
- (territory-set-dice t (add1 (territory-dice t))))
-
-;; Board Player Territory Natural -> Boolean
-;; can player attack dst from src?
-(define (attackable? board player src dst)
- (define dst-t
- (findf (lambda (t) (= (territory-index t) dst)) board))
- (and dst-t
- (= (territory-player src) player)
- (not (= (territory-player dst-t) player))
- (> (territory-dice src) (territory-dice dst-t))))
-
-;; Board Natural Natural Natural Natural -> Board
-;; Creates a new board after an attack
-;; updates only src and dst
-(define (execute board player src dst dice)
- (for/list ([t board])
- (define idx (territory-index t))
- (cond [(= idx src) (territory-set-dice t 1)]
- [(= idx dst)
- (define s (territory-set-dice t (- dice 1)))
- (territory-set-player s player)]
- [else t])))
-
-;; ---------------------------------------------------------------------------------------------------
-;; Getting Neigbors
-
-;; Natural -> [List-of Natural]
-;; returns the neighbors of the current spot
-;; > (neighbors 0)
-;; '(1 2 3)
-(define (neighbors pos)
- (define top? (< pos BOARD))
- (define bottom? (= (get-row pos) (sub1 BOARD)))
- (define even-row? (zero? (modulo (get-row pos) 2)))
- (define right? (zero? (modulo (add1 pos) BOARD)))
- (define left? (zero? (modulo pos BOARD)))
- (if even-row?
- (even-row pos top? bottom? right? left?)
- (odd-row pos top? bottom? right? left?)))
-
-;; Natural Boolean Boolean Boolean Boolean -> [Listof Naturals]
-;; gets the neighbors for a territory on an even row
-(define (even-row pos top? bottom? right? left?)
- (append (add (or top? right?) (add1 (- pos BOARD)))
- (add (or bottom? right?) (add1 (+ pos BOARD)))
- (add top? (- pos BOARD))
- (add bottom? (+ pos BOARD))
- (add right? (add1 pos))
- (add left? (sub1 pos))))
-
-;; Natural Boolean Boolean Boolean Boolean -> [Listof Naturals]
-;; gets the neighbors for a territory on an odd row
-(define (odd-row pos top? bottom? right? left?)
- (append (add top? (- pos BOARD))
- (add bottom? (+ pos BOARD))
- (add (or top? left?) (sub1 (- pos BOARD)))
- (add (or bottom? left?) (sub1 (+ pos BOARD)))
- (add right? (add1 pos))
- (add left? (sub1 pos))))
-
-;; Boolean X -> [Listof X]
-;; returns (list x) if (not b) else empty
-(define (add b x)
- (if b '() (list x)))
-
-;
-;
-;
-;
-; ;;; ;;; ;;;;;;
-; ; ; ; ; ;
-; ; ; ;;;; ;;; ;;; ; ; ;;; ;;; ;;;; ;; ;; ;;;;; ;;;;;
-; ; ; ; ; ; ; ;;; ; ; ; ; ;; ; ; ; ;
-; ;;; ;;;;;; ; ; ; ; ; ; ;;;;;; ; ; ; ;;;;
-; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;
-; ;;; ;; ;;;;; ; ;;;;;; ;; ;;;;; ;;; ;;; ;;; ;;;;;
-; ;
-; ;;;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-;; Territory Focusing and Marking
-
-;; DiceWorld [Board -> Board] -> World
-;; Creates a new World that has a rotated territory list
-;; > (define lterritory (territory 0 0 1 9 2))
-;; > (define rterritory (territory 0 0 1 9 0))
-;; > (refocus-board-action (dice-world -1 (list rterritory lterritory ...) GT) left)
-;; (dice-world -1 (list lterritory ... rterritory) GT)
-;; > (refocus-board-action (dice-world -1 (list lterritory ... rterritory) GT) left)
-;; (dice-world -1 (list rterritory lterritory ...) GT)
-(define (refocus-board w direction)
- (define source (dice-world-src w))
- (define board (dice-world-board w))
- (define tree (dice-world-gt w))
- (define player (game-player tree))
- (define (owner? tid)
- (if source (not (= tid player)) (= tid player)))
- (define new-board (rotate-until owner? board direction))
- (dice-world source new-board tree))
-
-;; [Player -> Boolean] Board (Board -> Board) -> Board
-;; rotate until the first element of the list satisfies owned-by
-(define (rotate-until owned-by board rotate)
- (define next-list (rotate board))
- (if (owned-by (territory-player (first next-list)))
- next-list
- (rotate-until owned-by next-list rotate)))
-
-;; Board -> Board
-;; rotate a list to the left
-(define (left l)
- (append (rest l) (list (first l))))
-
-;; Board -> Board
-;; rotate a list to the right
-(define (right l)
- (reverse (left (reverse l))))
-
-;; ---------------------------------------------------------------------------------------------------
-;; Handling Moves
-
-;; DiceWorld -> DiceWorld
-;; executes a passing move on the world state
-;; THIS DEFINITION IS NOT USED FOR THE ABSTRACT VERSION OF THE MODULE.
-(define (pass.10 w)
- (define m (find-move (game-moves (dice-world-gt w)) '()))
- (cond [(not m) w]
- [else ;; (no-more-moves? m)
- (dice-world #f (game-board m) m)]))
-
-;; DiceWorld -> DiceWorld
-;; unmarks a marked territory
-(define (unmark w)
- (dice-world #f (dice-world-board w) (dice-world-gt w)))
-
-;; DiceWorld -> DiceWorld
-;; marks a territory as the launching pad for an attack or launches the attack
-(define (mark w)
- (define tree (dice-world-gt w))
- (define board (dice-world-board w))
- (define source (dice-world-src w))
- (define focus (territory-index (first board)))
- (if source
- (attacking w source focus)
- (dice-world focus board tree)))
-
-;; DiceWorld Natural Natural -> DiceWorld
-(define (attacking w source target)
- (define feasible (game-moves (dice-world-gt w)))
- (define attack (list source target))
- (define next (find-move feasible attack))
- (define src-t (findf (lambda (t) (= (territory-index t) source))
- (dice-world-board w)))
- (define dst-t (findf (lambda (t) (= (territory-index t) target))
- (dice-world-board w)))
- (define win? (dice-attack-win src-t dst-t))
- (cond [(not next) w]
- [win? (dice-world #f (game-board next) next)]
- [else (dice-world-attack-lost w src-t)]))
-
-;; [List-of Moves] [or '() [List Natural Natural]] -> [or #f Game-tree]
-;; find the move from the current list of moves
-(define (find-move moves a)
- (define m (findf (lambda (m) (equal? (move-action m) a)) moves))
- (and m (move-gt m)))
-
-;; Game -> Boolean
-;; are there any moves in this game record?
-(define (no-more-moves? g)
- (empty? (game-moves g)))
-
-;; Territory Territory -> Boolean
-;; attack from src territory to destination territory
-;; and see who wins
-(define (dice-attack-win src-t dst-t)
- (define (roll-dice n)
- (for/list ([i n])
- (random 1 7)))
- (define (sum l)
- (foldl + 0 l))
- (define src-attack (sum (roll-dice (territory-dice src-t))))
- (define dst-defend (sum (roll-dice (territory-dice dst-t))))
- (if (> src-attack dst-defend) #t #f))
-
-
-(define (probability-of-winning st dt)
- "Find the probability of source territory defeating destination territory.
-
- `st` is the source territory.
- `dt` is the destination territory."
-
- ; Given the number of dice, returns a list all dice combinations.
- (define (dice-all-combination dice-num)
- (cond [(= dice-num 1)
- (for/list ([i (in-range 1 7)])
- (list i))]
- [else
- (for*/list ([i (in-range 1 7)]
- [r (dice-all-combination
- (- dice-num 1))])
- (cons i r))]))
-
-
- ; Given a list of dice combinations, returns a hashmap where the key
- ; is the 'dice sum' and the value is the number of combinations
- ; whose sum is the 'dice sum'.
- (define (dice-sum-hash dice-combinations)
- (for/foldr
- ([h (make-hash)]) ([c dice-combinations])
- (let ((sum (for/sum ([n c]) n)))
- (hash-set! h sum (+ (hash-ref h sum 0) 1))
- h)))
-
-
- ; sh: -> hashmap
- ; key: dice sum,
- ; value: number of ways we can arrive at sum
- (define sh (dice-sum-hash
- (dice-all-combination (territory-dice st))))
-
- ; dh: -> hashmap
- ; key: dice sum,
- ; value: number of ways we can arrive at sum
- (define dh (dice-sum-hash
- (dice-all-combination (territory-dice dt))))
-
- ; Generic probability function.
- (define (probability f t)
- (/ (* 1.0 f) t))
-
- ; Computes the total number of favorable outcomes for the source
- ; territory when its dice sum is `s-ds` against the
- ; destination's territory.
- ;
- ; s-ds -> source dice sum.
- ; n -> number of we can arrive at sum `s-ds`.
- (define (favorable-outcomes s-ds n)
- (* (for/sum [(d-ds (hash-keys dh))]
- (if (< d-ds s-ds)
- (hash-ref dh d-ds)
- 0))
- n))
-
- ; Computes the total number of favorable outcomes for the source
- ; territory against the destination's territory.
- (define (all-favorable-outcomes)
- (foldr + 0
- (for/list [(s-ds (hash-keys sh))]
- (favorable-outcomes
- s-ds
- (hash-ref sh s-ds)))))
-
- (define (all-outcomes)
- (let ((sd (territory-dice st))
- (dd (territory-dice dt)))
- (* (expt 6 sd) (expt 6 dd))))
-
- (probability (all-favorable-outcomes) (all-outcomes)))
-
-
-;; DiceWorld Territory -> DiceWorld
-;; generate dice world for the case where player
-;; loses the dice attack
-(define (dice-world-attack-lost w src-t)
- (define src (territory-index src-t))
- (define player (territory-player src-t))
- (define newb (for/list ([t (dice-world-board w)])
- (define idx (territory-index t))
- (cond [(= idx src) (territory-set-dice t 1)]
- [else t])))
- (define new-gt (game-tree newb player 0))
- (dice-world #f newb new-gt))
-
-;
-;
-;
-;
-; ;;;;; ;; ;
-; ; ; ;
-; ; ; ;;;; ;; ;; ;;; ; ;;;; ;; ;;; ;;; ;; ;; ;;; ;;
-; ; ; ; ; ;; ; ; ;; ; ; ;; ; ;; ; ; ;;
-; ;;;; ;;;;;; ; ; ; ; ;;;;;; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;;
-; ;;; ; ;;;;; ;;; ;;; ;;; ;; ;;;;; ;;;;; ;;;;; ;;; ;;; ;;; ;
-; ;
-; ;;;;
-;
-;
-
-;; Player Scene-> Scene
-;; Draws the world
-(define (add-player-info player s)
- (define str (whose-turn player))
- (define txt (text str TEXT-SIZE TEXT-COLOR))
- (place-image txt (- WIDTH INFO-X-OFFSET) INFO-Y-OFFSET s))
-
-(define (add-winning-probability w s)
- (define board (dice-world-board w))
- (define source (dice-world-src w))
- (define target (territory-index (first board)))
- (define feasible (game-moves (dice-world-gt w)))
- (define attack (list source target))
- (define next (find-move feasible attack))
-
- (define (find-territory index)
- (findf (lambda (t) (= (territory-index t) index))
- (dice-world-board w)))
-
- (if (and source next)
- (place-image
- (text (string-append
- "Winning Probability "
- (~r
- (probability-of-winning (find-territory source)
- (find-territory target))
- #:precision 2))
- TEXT-SIZE TEXT-COLOR)
- (- WIDTH 150) 100 s)
- s))
-
-;; DiceWorld Scene -> Scene
-;; folds through the board and creates an image representation of it
-(define (add-board-to-scene w s)
- (define board (dice-world-board w))
- (define player (game-player (dice-world-gt w)))
- (define focus? (dice-world-src w))
- (define trtry1 (first board))
- (define p-focus (territory-player trtry1))
- (define t-image (draw-territory trtry1))
- (define image (draw-focus focus? p-focus player t-image))
- (define base-s (add-territory trtry1 image s))
- (for/fold ([s base-s]) ([t (rest board)])
- (add-territory t (draw-territory t) s)))
-
-;; Nat Player Player Image -> Image
-;; add focus marker to territory if needed
-(define (draw-focus marked? p-in-focus p t-image)
- (if (or (and (not marked?) (= p-in-focus p))
- (and marked? (not (= p-in-focus p))))
- (overlay FOCUS t-image)
- t-image))
-
-;; Image Territory Image -> Image
-(define (add-territory t image scene)
- (place-image image (territory-x t) (territory-y t) scene))
-
-;; Territory -> Image
-;; renders a single territory
-(define (draw-territory t)
- (define color (color-chooser (territory-player t)))
- (overlay (hexagon color) (draw-dice (territory-dice t))))
-
-;; Natural -> Image
-;; renders all n >= 1 dice as a stack of dice
-(define (draw-dice n)
- (define first-die (get-dice-image 0))
- (define height-die (image-height first-die))
- (for/fold ([s first-die]) ([i (- n 1)])
- (define dice-image (get-dice-image (+ i 1)))
- (define y-offset (* height-die (+ .5 (* i .25))))
- (overlay/offset s 0 y-offset dice-image)))
-
-;; Player -> Color
-;; Determines a color for each player
-(define (color-chooser p)
- (list-ref COLORS p))
-
-;; -> Image
-;; returns an image from the list of dice images
-(define (get-dice-image i)
- (list-ref IMG-LIST (modulo i (length IMG-LIST))))
-
-;
-;
-;
-;
-; ;;;;;; ;; ;
-; ; ; ;
-; ; ; ;; ;; ;;; ; ;;; ;; ;; ;;; ;;
-; ;;; ;; ; ; ;; ; ;; ; ; ;;
-; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ;; ; ; ; ; ;;
-; ;;;;;; ;;; ;;; ;;; ;; ;;;;; ;;; ;;; ;;; ;
-; ;
-; ;;;;
-;
-;
-
-;; Board ->* Natural [non-empty-listof Player]
-;; gives the number of winning territories and the players(s) who have them
-;; > (winners (list (territory 0 0 1 9 0) (territory 0 0 1 9 1)))
-;; (values 2 '(0))
-;; > (winners (list (territory 0 1 1 9 0) (territory 0 0 1 9 1)))
-;; (values 1 '(0 1))
-(define (winners board)
- (for/fold ([best 0][winners '()]) ([p PLAYER#])
- (define p-score (sum-territory board p))
- (cond [(> p-score best) (values p-score (list p))]
- [(< p-score best) (values best winners)]
- [(= p-score best) (values best (cons p winners))])))
-
-;; Board Player -> Natural
-;; counts the number of territorys the player owns
-;; > (sum-territory (list (territory 0 1 1 9 0) (territory 0 1 1 9 1)) 1)
-;; 2
-(define (sum-territory board player)
- (for/fold ([result 0]) ([t board])
- (if (= (territory-player t) player) (+ result 1) result)))
-
-
-;
-;
-;
-;
-;
-; ;;; ;;;;;;;
-; ;; ;
-; ; ; ;
-; ; ; ;
-; ; ; ;
-; ;;;;;; ;
-; ; ; ;
-; ; ; ;
-; ;;; ;;; ;;;;;;;
-;
-;
-;
-;
-
-;; Player -> {AI-TURN, YOUR-TURN}
-;; THIS REQUIRES A DIFFERENT DEFINITION FOR PLAIN CHAPTER 10.
-(define (whose-turn player)
- (if (= player AI) AI-TURN YOUR-TURN))
-
-;; DiceWorld -> DiceWorld
-;; executes a passing move on the world state
-;; THIS REQUIRES A DIFFERENT DEFINITION FOR PLAIN CHAPTER 10.
-(define (pass w)
- (define m (find-move (game-moves (dice-world-gt w)) '()))
- (cond [(not m) w]
- [(or (no-more-moves? m) (not (= (game-player m) AI)))
- (dice-world #f (game-board m) m)]
- [else
- (define ai (the-ai-plays m))
- (dice-world #f (game-board ai) ai)]))
-
-;; GameTree -> GameTree
-;; Computer calls this function until it is no longer the player
-(define (the-ai-plays tree)
- (define ratings (rate-moves tree AI-DEPTH))
- (define the-move (first (argmax second ratings)))
- (define new-tree (move-gt the-move))
- (if (= (game-player new-tree) AI)
- (the-ai-plays new-tree)
- new-tree))
-
-;; GameTree Natural -> [List-of (List Move Number)]
-;; assigns a value to each move that is being considered
-;; and return those values in a list
-(define (rate-moves tree depth)
- (for/list ((move (game-moves tree)))
- (list move (rate-position (move-gt move) (- depth 1)))))
-
-;; GameTree Natural -> Number
-;; Returns a number that is the best move for the given player.
-(define (rate-position tree depth)
- (cond [(or (= depth 0) (no-more-moves? tree))
- (define-values (best w) (winners (game-board tree)))
- (if (member AI w) (/ 1 (length w)) 0)]
- [else
- (define ratings (rate-moves tree depth))
- (apply (if (= (game-player tree) AI) max min)
- (map second ratings))]))
-
-;
-;
-;
-;
-; ;;
-; ;
-; ; ; ;; ;; ;; ;; ;;;;;
-; ; ; ; ; ; ; ; ;
-; ; ; ; ; ;; ;;;;
-; ;;; ; ; ;; ;
-; ; ; ; ;; ; ; ; ;
-; ;;; ;;; ;; ;; ;; ;; ;;;;;
-;
-;
-;
-;
-
-;; Natural -> Natural
-;; gets the row that territory is on, indexed from 0
-;; [test vary on current board-size]
-(define (get-row pos)
- (quotient pos BOARD))
-
-
-;
-;
-;
-;
-;
-; ;;;;;;; ;
-; ; ; ; ;
-; ; ; ; ;;; ;;;; ; ;;;;;; ;;;; ;
-; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ; ;
-; ; ;;;;;;; ;;;;; ; ;;;;;
-; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ;
-; ;;;;; ;;;; ;;;;;; ;;;; ;;;;;;
-;
-;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-
-;; Natural -> Void
-;; make the board larger
-(define (set-grid n)
- (set! BOARD n)
- (set! GRID (* n n)))
-
-(module+ test
-
- (require rackunit rackunit/text-ui)
-
- ;; (-> any) -> void
- ;; runs the thunk PROP-NUM times
- (define (check-property t)
- (test-begin (for ((i 50)) (t))))
-
- ;; Properties
- (define (property:starting-world-playable)
- (unless (and (= BOARD 2) (= PLAYER# 2))
- (error 'starting-world-playable "BOARD-SIZE != 2 or PLAYERS# != 2"))
- (check-false (no-more-moves-in-world? (create-world-of-dice-and-doom))))
-
- (define (property:dice-in-range)
- (check-true (andmap (λ (b) (>= DICE# (territory-dice b) 1)) (territory-build))
- "dice out of range"))
-
- (define (property:board-correct-size)
- (check-equal? (length (territory-build)) GRID
- "board incorrect-size"))
-
- (define (property:no-pass-on-first-move)
- (define (move-action? m) (equal? (move-action m) '()))
- (check-true (not (memf move-action? (game-moves (game-tree (territory-build) 0 0))))
- "no pass on first move"))
-
- ;; ---------------------------------------------------------------------------------------------------
-
-
- ;; testing game initialization
-
- (check-equal? (territory-index (first (territory-build))) 0)
- (check-equal? (territory-player (first (territory-build))) 0)
- (check-equal? (territory-index (second (territory-build))) 1)
- (check-equal? (territory-player (second (territory-build))) 1)
- (check-equal? (territory-index (third (territory-build))) 2)
- (check-equal? (territory-player (third (territory-build))) 0)
- (check-equal? (territory-index (fourth (territory-build))) 3)
- (check-equal? (territory-player (fourth (territory-build))) 1)
-
- (check-property property:starting-world-playable)
- (check-property property:board-correct-size)
- (check-property property:dice-in-range)
- (check-property property:no-pass-on-first-move)
-
- ;; ---------------------------------------------------------------------------------------------------
- ;; testing territory manipulation
-
- ;; legal?
- (check-true
- (and (attackable? (list (territory 0 0 2 9 0) (territory 3 1 1 9 0)) 0 (territory 0 0 2 9 0) 3) #t))
- (check-false
- (attackable? (list (territory 0 0 2 9 0) (territory 3 1 1 9 0)) 0 (territory 0 0 2 9 0) 0))
- (check-false
- (attackable? (list (territory 0 0 2 9 0) (territory 5 1 1 9 0)) 1 (territory 0 0 2 9 0) 5))
-
- ;; get-row
- (check-equal? (get-row 0) 0)
- (check-equal? (get-row 1) 0)
- (check-equal? (get-row 2) 1)
- (check-equal? (get-row 3) 1)
- (check-equal? (get-row 12) 6) ;; checks math. actually invalid on board of size 2
- (check-equal? (get-row 11) 5) ;; checks math. actually invalid on board of size 2
- (check-equal? (get-row 13) 6) ;; checks math. actually invalid on board of size 2
- (check-equal? (get-row 14) 7) ;; checks math. actually invalid on board of size 2
-
- ;; ---------------------------------------------------------------------------------------------------
- (define board3
- (list (territory 0 1 1 9 0) (territory 1 1 1 8 0) (territory 2 1 3 43.5 5) (territory 3 1 1 6 5)))
- (define b1+0+3
- (list (territory 0 0 2 9 0) (territory 1 1 1 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
- (define b2+1+2
- (list (territory 0 0 1 9 0) (territory 1 1 3 8 0) (territory 2 0 2 43.5 5) (territory 3 1 2 6 5)))
- (define board6
- (list (territory 0 0 1 9 0) (territory 1 1 2 8 0) (territory 2 0 3 43.5 5) (territory 3 1 2 6 5)))
- (define bard6+
- (list (territory 0 0 1 9 0) (territory 1 1 2 8 0) (territory 2 0 3 43.5 5) (territory 3 1 2 6 5)))
-
- (define (distribute/list a b c)
- (define-values (x y) (distribute a b c))
- (list x y))
-
- (define board0
- (list (territory 0 0 1 9 0) (territory 1 1 2 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
- (define board1
- (list (territory 0 0 1 9 0) (territory 1 1 1 8 0) (territory 2 0 1 43.5 5) (territory 3 1 1 6 5)))
- (define b1+1+2
- (list (territory 0 0 1 9 0) (territory 1 1 2 8 0) (territory 2 0 1 43.5 5) (territory 3 1 2 6 5)))
- (define board2
- (list (territory 0 0 1 9 0) (territory 1 1 1 8 0) (territory 2 0 3 43.5 5) (territory 3 1 1 6 5)))
-
- (define g-tree1 (game board1 0 '()))
- (define g-tree2 (game-tree board0 0 0))
-
- ; (define world31 (dice-world #f board1 g-tree1))
- (define world2 (dice-world #f board2 g-tree2))
-
- ;; testing book tree
-
- (check-equal? (game-tree (list (territory 0 0 2 'x 'y)
- (territory 1 1 1 'a 'b))
- 0
- 0)
- gt3)
-
-
- ;; testing tree generation
-
- (define (property:attack-location-valid)
- (define moves (game-moves (game-tree (territory-build) 0 0)))
- (check-true (and (for/and ([m moves])
- (define m1 (move-action m))
- (member (second m1) (neighbors (first m1))))
- #t)
- "invalid attack location"))
-
- (define (property:add-to-territory-always-up-one)
- (define r (random 10000))
- (check-equal? (add-dice-to (territory 0 0 r 0 0))
- (territory 0 0 (add1 r) 0 0)
- "add to territory always up one"))
-
- (define (property:attackable?-does-not-need-neighbores-check)
- (define (check-attackable? gt)
- (for/and ([move (game-moves gt)]
- #:when (not (empty? (move-action move))))
- (define action (move-action move))
- (define gt (move-gt move))
- (and (member (second action) (neighbors (first action)))
- (check-attackable? gt))))
-
- ;;start
- (define old-size BOARD)
- (set-grid 2)
- (define testing-gt (dice-world-gt (create-world-of-dice-and-doom)))
- (check-true (check-attackable? testing-gt) "An attack move between non-neighbores was created")
- (set-grid old-size))
-
-
- ;; game-tree
- (check-equal? (game-tree board1 0 0) g-tree1)
- (check-equal? (game-tree board3 1 0) (game board3 1 '()))
- (check-equal? (game-tree board3 0 0) (game board3 0 '()))
- (check-property property:attackable?-does-not-need-neighbores-check)
-
- ;; find-move
- (check-false (find-move '() '()))
- (check-equal? (find-move (list (move '() (game '() 0 '()))) '()) (game '() 0 '()))
- ;; Attacking-Moves
- (check-property property:attack-location-valid)
-
- ;; switch-players
- (check-equal? (switch 0) 1)
- (check-equal? (switch 1) 0)
-
- ;; Add-New-Dice
- (check-equal? (distribute/list (game-board g-tree1) 0 3) (list 1 (reverse b1+0+3)))
- (check-equal? (distribute/list (game-board g-tree1) 1 2) (list 0 (reverse b1+1+2)))
- (check-equal? (distribute/list (game-board g-tree2) 1 2) (list 0 (reverse b2+1+2)))
- (check-equal? (distribute/list board6 0 0) (list 0 (reverse bard6+)))
-
- ;; add-to-territory
- (check-equal? (add-dice-to (territory 0 1 2 9 0)) (territory 0 1 3 9 0))
- (check-equal? (add-dice-to (territory 0 1 1 9 0)) (territory 0 1 2 9 0))
- (check-equal? (add-dice-to (territory 0 1 5 9 0)) (territory 0 1 6 9 0))
- (check-property property:add-to-territory-always-up-one)
-
- ;; ---------------------------------------------------------------------------------------------------
- (define board7
- (list (territory 0 0 1 9 0) (territory 1 1 1 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
- (define board8
- (list (territory 0 1 1 9 0) (territory 1 1 1 8 0) (territory 2 0 3 43.5 5) (territory 3 1 1 6 5)))
- (define board9
- (list (territory 0 0 1 9 0) (territory 1 1 1 8 0) (territory 2 0 2 43.5 5) (territory 3 0 1 6 5)))
- (define board10
- (list (territory 0 0 1 9 0) (territory 1 1 3 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
-
- ;; testing attacks
-
- (check-equal?
- (execute board7 0 2 1 2)
- (list (territory 0 0 1 9 0) (territory 1 0 1 8 0) (territory 2 0 1 43.5 5) (territory 3 1 1 6 5)))
-
- (check-equal?
- (execute board8 0 2 1 3)
- (list (territory 0 1 1 9 0) (territory 1 0 2 8 0) (territory 2 0 1 43.5 5) (territory 3 1 1 6 5)))
-
- (check-equal?
- (execute board9 0 2 1 2)
- (list (territory 0 0 1 9 0) (territory 1 0 1 8 0) (territory 2 0 1 43.5 5) (territory 3 0 1 6 5)))
-
- (check-equal?
- (execute board10 1 1 0 3)
- (list(territory 0 1 2 9 0) (territory 1 1 1 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
-
- ;; Neighbors
- (check-equal? (neighbors 2) '(0 3))
- (check-equal? (neighbors 0) '(3 2 1))
- (check-equal? (neighbors 1) '(3 0))
- (check-equal? (neighbors 3) '(1 0 2))
-
- ;; ---------------------------------------------------------------------------------------------------
- (define board20
- (list (territory 0 0 1 9 2) (territory 1 0 1 9 0) (territory 2 2 1 9 0)))
- (define board21
- (list (territory 0 1 1 9 0) (territory 1 1 1 8 0) (territory 2 1 1 43.5 5) (territory 3 1 1 6 5)))
-
- ;; testing focus manipulation
- ;; interact-with-board
- (check-equal?
- (interact-with-board world2 "\r")
- (dice-world (territory-index (car (dice-world-board world2))) (dice-world-board world2) g-tree2))
-
- (check-equal? (interact-with-board world2 "p") world2)
-
- ;; refocus-board-action
- (check-equal?
- (refocus-board (dice-world #f (list (territory 0 0 1 9 0) (territory 0 0 1 9 2)) g-tree1) left)
- (dice-world #f (list (territory 0 0 1 9 2) (territory 0 0 1 9 0)) g-tree1))
-
- (check-equal?
- (refocus-board (dice-world #f (list (territory 0 0 1 9 2) (territory 0 1 1 9 0)) g-tree1) right)
- (dice-world #f (list (territory 0 0 1 9 2) (territory 0 1 1 9 0)) g-tree1))
-
- (check-equal?
- (refocus-board (dice-world 0 board20 g-tree1) left)
- (dice-world 0 (list (territory 2 2 1 9 0) (territory 0 0 1 9 2) (territory 1 0 1 9 0)) g-tree1))
-
- (check-equal?
- (refocus-board (dice-world 0 (list (territory 0 0 1 9 2) (territory 0 1 1 9 0)) g-tree1) left)
- (dice-world 0 (list (territory 0 1 1 9 0) (territory 0 0 1 9 2)) g-tree1))
-
- (check-equal?
- (refocus-board (dice-world 0 (list(territory 0 0 1 9 2) (territory 0 1 1 9 0)) g-tree1) right)
- (dice-world 0 (list (territory 0 1 1 9 0) (territory 0 0 1 9 2)) g-tree1))
-
- ;;unmark
- (check-equal? (unmark (dice-world 1 board21 g-tree1)) (dice-world #f board21 g-tree1))
-
- (check-equal? (unmark (dice-world 1 (list (territory 0 1 1 9 0) (territory 1 1 1 8 0)) g-tree1))
- (dice-world #f (list (territory 0 1 1 9 0) (territory 1 1 1 8 0)) g-tree1))
- (check-equal? (unmark (dice-world 0 (list (territory 0 1 1 9 0)) g-tree1))
- (dice-world #f (list (territory 0 1 1 9 0)) g-tree1))
- (check-equal? (unmark (dice-world #f (list (territory 0 1 1 9 0)) g-tree1))
- (dice-world #f (list (territory 0 1 1 9 0)) g-tree1))
-
- ;; ---------------------------------------------------------------------------------------------------
- (define (winners/list w)
- (define-values (a b) (winners w))
- (cons a b))
-
- ;; testing functions that determine 'winning' and declare the winner
-
- ;; winners
- (check-equal? (winners/list (list (territory 0 0 1 9 0) (territory 0 0 1 9 1))) (list 2 0))
- (check-equal? (winners/list (list (territory 0 1 1 9 0) (territory 0 0 1 9 1))) (list 1 1 0))
-
- ;; sum-territory
- (check-equal? (sum-territory (list (territory 0 0 1 9 0) (territory 0 0 1 9 1)) 0) 2)
- (check-equal? (sum-territory (list (territory 0 0 1 9 0) (territory 0 0 1 9 1)) 1) 0)
- (check-equal? (sum-territory (list (territory 0 0 1 9 0) (territory 0 0 1 9 1)) 2) 0)
- (check-equal? (sum-territory (list (territory 0 1 1 9 0) (territory 0 0 1 9 1)) 1) 1)
- (check-equal? (sum-territory (list (territory 0 1 1 9 0) (territory 0 0 1 9 1)) 0) 1)
-
- ;; ---------------------------------------------------------------------------------------------------
- ;; testing the AI
-
- (define tree0
- (game-tree (list (territory 0 1 3 0 0)
- (territory 1 0 2 0 0)
- (territory 2 0 2 0 0)
- (territory 3 0 2 0 0))
- 1 15))
-
- (define territory1 (territory 3 0 3 280 262.5))
-
- (define board31
- (list territory1
- (territory 2 0 3 150 262.5)
- (territory 1 1 2 345 150)
- (territory 0 0 2 215 150)))
-
- (define world1
- (dice-world #f board31 (game board31 1 '())))
-
- ;; testing the AI functions
-
- ;; MF: one of these two tests should fail!
- (check-true (and (attackable? board31 0 territory1 1) #t))
- (check-true (no-more-moves-in-world? world1))
-
- (check-equal? (interact-with-board (dice-world 3 '() '()) "d")
- (dice-world #f '() '()))
-
- (check-equal? (game-board (the-ai-plays tree0))
- (list (territory 3 1 3 0 0)
- (territory 2 0 2 0 0)
- (territory 1 0 2 0 0)
- (territory 0 1 2 0 0)))
-
- (check-equal? (game-player (the-ai-plays tree0))
- 0)
-
- (check-equal? (game-board (move-gt (first (game-moves tree0))))
- (list (territory 0 1 1 0 0)
- (territory 1 0 2 0 0)
- (territory 2 0 2 0 0)
- (territory 3 1 2 0 0)))
-
- (check-equal? (game-player (move-gt (first (game-moves tree0))))
- 1)
-
- (check-equal? (rate-position tree0 AI-DEPTH) 1/2)
- (check-equal? (rate-position (move-gt (first (game-moves tree0))) AI-DEPTH)
- 1/2)
-
- "all tests run")
diff --git a/net/ricketyspace/ror/thirteen/client.rkt b/net/ricketyspace/ror/thirteen/client.rkt
deleted file mode 100644
index dc3b184..0000000
--- a/net/ricketyspace/ror/thirteen/client.rkt
+++ /dev/null
@@ -1,189 +0,0 @@
-#lang racket
-
-(require 2htdp/image 2htdp/universe "shared.rkt")
-
-(provide launch-guess-client)
-
-(struct client-state (type clue guess action done))
-
-(define ClientState0 (client-state -1 "" #f "" #f))
-
-(define SCENE-WIDTH 300)
-(define SCENE-HEIGHT 200)
-
-(define (launch-guess-client n host)
- (big-bang ClientState0
- (on-draw draw-guess)
- (on-key handle-keys)
- (name n)
- (register host)
- (on-receive handle-msg)))
-
-(define (handle-keys w key)
- (cond [(= (client-state-type w) PLAYER) (handle-keys-player w key)]
- [(= (client-state-type w) GUESSER) (handle-keys-guesser w key)]
- [else w]))
-
-(define (handle-keys-player w key)
- (define (action)
- (client-state-action w))
- (define (guess)
- (client-state-guess w))
- (define (set-clue clue)
- (client-state PLAYER clue (guess) (action) #f))
- (cond [(and (string=? (action) "c") (key=? key "c"))
- (make-package w (server-msg PLAYER "c" ""))]
- [(and (string=? (action) "a") (key=? key "up"))
- (make-package (set-clue "up") (server-msg PLAYER "a" "up"))]
- [(and (string=? (action) "a") (key=? key "down"))
- (make-package (set-clue "down") (server-msg PLAYER "a" "down"))]
- [(and (string=? (action) "a") (key=? key "="))
- (make-package (set-clue "=") (server-msg PLAYER "a" "="))]
- [else w]))
-
-(define (handle-keys-guesser w key)
- (define (action)
- (client-state-action w))
- (cond [(and (string=? (action) "c") (key=? key "c")
- (make-package w (server-msg GUESSER "c" "")))]
- [(and (string=? (action) "g") (key=? key "g")
- (make-package w (server-msg GUESSER "g" "")))]
- [else w]))
-
-(define (handle-msg c c-msg)
- (cond [(not (client-msg? c-msg)) c]
- [(= (client-msg-type c-msg) PLAYER)
- (handle-msg-player c c-msg)]
- [(= (client-msg-type c-msg) GUESSER)
- (handle-msg-guesser c c-msg)]
- [else c]))
-
-(define (handle-msg-player c c-msg)
- (define (is-done)
- (client-msg-done c-msg))
- (define (action)
- (client-msg-action c-msg))
- (define (set-done)
- (let ([guess (client-msg-guess c-msg)])
- (client-state PLAYER "" guess "" #t)))
- (define (set-check)
- (let ([clue (client-state-clue c)])
- (client-state PLAYER clue #f "c" #f)))
- (define (set-act)
- (let ([guess (client-msg-guess c-msg)])
- (client-state PLAYER "" guess "a" #f)))
- (cond [(is-done) (set-done)]
- [(string=? (action) "c") (set-check)]
- [(string=? (action) "a") (set-act)]
- [else c]))
-
-(define (handle-msg-guesser c c-msg)
- (define (is-done)
- (client-msg-done c-msg))
- (define (action)
- (client-msg-action c-msg))
- (define (set-done)
- (let ([guess (client-msg-guess c-msg)])
- (client-state GUESSER "" guess "" #t)))
- (define (set-check)
- (let ([clue (client-msg-clue c-msg)]
- [guess (client-msg-guess c-msg)])
- (client-state GUESSER clue guess "c" #f)))
- (define (set-guess)
- (let ([clue (client-msg-clue c-msg)]
- [guess (client-msg-guess c-msg)])
- (client-state GUESSER clue guess "g" #f)))
- (cond [(is-done) (set-done)]
- [(string=? (action) "c") (set-check)]
- [(string=? (action) "g") (set-guess)]
- [else c]))
-
-(define (draw-guess c)
- (define (render type result desc help)
- (place-image/align
- type 5 5 "left" "top"
- (overlay (above result desc help)
- (empty-scene SCENE-WIDTH SCENE-HEIGHT))))
- (let ([type (draw-type c)]
- [result (draw-result c)]
- [desc (draw-desc c)]
- [help (draw-help c)])
- (render type result desc help)))
-
-(define (draw-type c)
- (text (cond [(= (client-state-type c) PLAYER) "Player"]
- [(= (client-state-type c) GUESSER) "Guesser"]
- [else "..."])
- 14 "black"))
-
-(define (draw-result c)
- (text (cond [(= (client-state-type c) PLAYER)
- (draw-result-player c)]
- [else (draw-result-guesser c)])
- 14 "black"))
-
-(define (draw-result-player c)
- (define (done)
- (client-state-done c))
- (define (action)
- (client-state-action c))
- (define (guess)
- (number->string (client-state-guess c)))
- (cond [(and (not (done)) (string=? (action) "")) "..."]
- [(done) (string-append (guess) " it is!")]
- [(string=? (action) "a") (string-append "Guess: " (guess))]
- [else ""]))
-
-(define (draw-result-guesser c)
- (define (done)
- (client-state-done c))
- (define (action)
- (client-state-action c))
- (define (guess)
- (let ([g (client-state-guess c)])
- (cond [(number? g) (number->string g)]
- [else ""])))
- (define (clue)
- (cond [(string=? (client-state-clue c) "up") ">"]
- [else "<"]))
- (cond [(and (not (done)) (string=? (action) "") "...")]
- [(done) (string-append (guess) " it is!")]
- [(and (string=? (action) "g") (> (string-length (guess)) 0))
- (string-append "Number " (clue) " " (guess))]
- [(string=? (action) "c") (string-append "Guess: " (guess))]
- [else ""]))
-
-(define (draw-desc c)
- (text (cond [(= (client-state-type c) PLAYER) ""]
- [else (draw-desc-guesser c)])
- 10 "black"))
-
-(define (draw-desc-guesser c)
- (define (action)
- (client-state-action c))
- (cond [(string=? (action) "c") "Waiting for player to act on guess"]
- [else ""]))
-
-(define (draw-help c)
- (define (type)
- (client-state-type c))
- (text (cond [(= (type) PLAYER) (draw-help-player c)]
- [else (draw-help-guesser c)])
- 10 "black"))
-
-(define (draw-help-player c)
- (define (action)
- (client-state-action c))
- (cond [(string=? (action) "c") "Press 'c' to check"]
- [(string=? (action) "a") "Press ↑, ↓, or = "]
- [else ""]))
-
-(define (draw-help-guesser c)
- (define (action)
- (client-state-action c))
- (define (done)
- (client-state-done c))
- (cond [(string=? (action) "g") "Press 'g' to guess"]
- [(string=? (action) "c") "Press 'c' to check"]
- [(done) "Good Job!"]
- [else ""]))
diff --git a/net/ricketyspace/ror/thirteen/run.rkt b/net/ricketyspace/ror/thirteen/run.rkt
deleted file mode 100644
index b8726ac..0000000
--- a/net/ricketyspace/ror/thirteen/run.rkt
+++ /dev/null
@@ -1,13 +0,0 @@
-#lang racket
-
-(require 2htdp/universe "client.rkt" "server.rkt")
-
-(define (run)
- (launch-many-worlds (launch-guess-client "Adam" LOCALHOST)
- (launch-guess-server)
- (launch-guess-client "Eve" LOCALHOST)))
-
-(define (bad)
- (launch-many-worlds (launch-guess-client "Adam" LOCALHOST)
- (launch-guess-server)
- (launch-guess-client "Beatrice" LOCALHOST)))
diff --git a/net/ricketyspace/ror/thirteen/server.rkt b/net/ricketyspace/ror/thirteen/server.rkt
deleted file mode 100644
index 12ff10a..0000000
--- a/net/ricketyspace/ror/thirteen/server.rkt
+++ /dev/null
@@ -1,149 +0,0 @@
-#lang racket
-
-(provide launch-guess-server)
-
-(require 2htdp/image 2htdp/universe "shared.rkt")
-
-(struct interval (small big) #:transparent)
-
-;; paction -> 'c' or 'a'
-;; gaction -> 'c' or 'g'
-(struct server-state (interval clue guess paction gaction clients done))
-
-(define u0 (server-state (interval LOWER UPPER) "" #f "c" "" 1 #f))
-
-(define (launch-guess-server)
- (universe #f
- (state #t)
- (on-new connect)
- (on-msg handle-msg)))
-
-(define (connect u client)
- (cond [(false? u)
- (make-bundle
- u0
- (list (make-mail client (client-msg PLAYER "" #f "c" #f)))
- '())]
- [(= (server-state-clients u) 1)
- (make-bundle
- (server-state
- (server-state-interval u) (server-state-clue u)
- (server-state-guess u) (server-state-paction u)
- "g" 2 #f)
- (list (make-mail client (client-msg GUESSER "" #f "g" #f)))
- '())]
- [else (make-bundle u empty (list client))]))
-
-(define (handle-msg u client s-msg)
- (cond [(not (server-msg? s-msg)) (make-bundle u empty (list client))]
- [(= (server-msg-type s-msg) PLAYER)
- (handle-msg-player u client s-msg)]
- [(= (server-msg-type s-msg) GUESSER)
- (handle-msg-guesser u client s-msg)]
- [else (make-bundle u empty (list client))]))
-
-(define (handle-msg-player u client s-msg)
- (define (set-paction paction)
- (let ([interval (server-state-interval u)]
- [clue (server-state-clue u)]
- [guess (server-state-guess u)]
- [gaction (server-state-gaction u)]
- [clients (server-state-clients u)])
- (server-state interval clue guess paction gaction clients #f)))
- (define (set-clue clue)
- (let ([interval (server-state-interval u)]
- [guess (server-state-guess u)]
- [gaction (server-state-gaction u)]
- [clients (server-state-clients u)]
- [done (server-state-done u)])
- (server-state interval clue guess "c" gaction clients done)))
- (define (set-done)
- (let ([interval (server-state-interval u)]
- [guess (server-state-guess u)]
- [gaction (server-state-gaction u)]
- [clients (server-state-clients u)])
- (server-state interval "" guess "" gaction clients #t)))
- (define (mail clue guess action done)
- (list (make-mail client (client-msg PLAYER clue guess action done))))
- (let* ([clue (server-state-clue u)]
- [guess (server-state-guess u)]
- [action (server-msg-action s-msg)]
- [done (server-state-done u)]
- [action-ok (string=? (server-state-paction u) action)]
- [has-guess (number? guess)]
- [data (server-msg-data s-msg)])
- (cond [(not action-ok)
- (make-bundle u empty (list client))]
- [(and (string=? action "c") (not has-guess))
- (make-bundle u (mail clue guess action done) empty)]
- [(and (string=? action "c") has-guess)
- (make-bundle (set-paction "a") (mail clue guess "a" done) empty)]
- [(and (string=? action "a") (member data '("up" "down")))
- (make-bundle (set-clue data) (mail data #f "c" done) empty)]
- [(and (string=? action "a") (string=? data "="))
- (make-bundle (set-done) (mail "" guess "" #t) empty)]
- [else (make-bundle u empty (list client))])))
-
-(define (handle-msg-guesser u client s-msg)
- (define (set-guess interval clue guess)
- (let ([paction (server-state-paction u)]
- [clients (server-state-clients u)]
- [done (server-state-done u)])
- (server-state interval clue guess paction "c" clients done)))
- (define (set-gaction gaction)
- (let ([interval (server-state-interval u)]
- [clue (server-state-clue u)]
- [guess (server-state-guess u)]
- [paction (server-state-paction u)]
- [clients (server-state-clients u)]
- [done (server-state-done u)])
- (server-state interval clue guess paction gaction clients done)))
- (define (has-clue)
- (> (string-length (server-state-clue u)) 0))
- (define (is-done)
- (server-state-done u))
- (define (mail clue guess action done)
- (list (make-mail client
- (client-msg GUESSER clue guess action done))))
- (let* ([action (server-msg-action s-msg)]
- [interval (server-state-interval u)]
- [clue (server-state-clue u)]
- [current-guess (server-state-guess u)]
- [done (server-state-done u)]
- [action-ok (string=? (server-state-gaction u) action)])
- (cond [(not action-ok) (make-bundle u empty (list client))]
- [(is-done)
- (make-bundle (set-gaction "")
- (mail "" current-guess "" #t) empty)]
- [(and (string=? action "g") (not (has-clue)))
- (let ([guess (guess interval)])
- (make-bundle (set-guess interval "" guess)
- (mail "" guess "c" done) empty))]
- [(and (string=? action "g") (has-clue))
- (let* ([n-interval (next-interval interval clue)]
- [guess (guess n-interval)])
- (make-bundle (set-guess n-interval "" guess)
- (mail "" guess "c" done) empty))]
- [(and (string=? action "c") (has-clue))
- (make-bundle (set-gaction "g")
- (mail clue current-guess "g" done) empty)]
- [else (make-bundle u (mail clue current-guess action done)
- empty)])))
-
-(define (next-interval interval clue)
- (cond [(not (string? clue)) interval]
- [(string=? "up" clue) (bigger interval)]
- [(string=? "down" clue) (smaller interval)]
- [else interval]))
-
-(define (single? w)
- (= (interval-small w) (interval-big w)))
-
-(define (guess w)
- (quotient (+ (interval-small w) (interval-big w)) 2))
-
-(define (smaller w)
- (interval (interval-small w) (max (interval-small w) (sub1 (guess w)))))
-
-(define (bigger w)
- (interval (min (interval-big w) (add1 (guess w))) (interval-big w)))
diff --git a/net/ricketyspace/ror/thirteen/shared.rkt b/net/ricketyspace/ror/thirteen/shared.rkt
deleted file mode 100644
index 176c429..0000000
--- a/net/ricketyspace/ror/thirteen/shared.rkt
+++ /dev/null
@@ -1,28 +0,0 @@
-#lang racket
-
-(provide
- UPPER
- LOWER
- PLAYER
- GUESSER
- client-msg
- client-msg?
- client-msg-type
- client-msg-clue
- client-msg-guess
- client-msg-action
- client-msg-done
- server-msg
- server-msg?
- server-msg-type
- server-msg-action
- server-msg-data)
-
-(define UPPER 100)
-(define LOWER 0)
-
-(define PLAYER 0)
-(define GUESSER 1)
-
-(struct client-msg (type clue guess action done) #:prefab)
-(struct server-msg (type action data) #:prefab)
diff --git a/net/ricketyspace/ror/twelve/graphics/dice1.png b/net/ricketyspace/ror/twelve/graphics/dice1.png
deleted file mode 100644
index 3f4899c..0000000
--- a/net/ricketyspace/ror/twelve/graphics/dice1.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/twelve/graphics/dice2.png b/net/ricketyspace/ror/twelve/graphics/dice2.png
deleted file mode 100644
index 2fa32ea..0000000
--- a/net/ricketyspace/ror/twelve/graphics/dice2.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/twelve/graphics/dice3.png b/net/ricketyspace/ror/twelve/graphics/dice3.png
deleted file mode 100644
index 005ee75..0000000
--- a/net/ricketyspace/ror/twelve/graphics/dice3.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/twelve/graphics/dice4.png b/net/ricketyspace/ror/twelve/graphics/dice4.png
deleted file mode 100644
index 47bb291..0000000
--- a/net/ricketyspace/ror/twelve/graphics/dice4.png
+++ /dev/null
Binary files differ
diff --git a/net/ricketyspace/ror/twelve/source.rkt b/net/ricketyspace/ror/twelve/source.rkt
deleted file mode 100644
index dc37e87..0000000
--- a/net/ricketyspace/ror/twelve/source.rkt
+++ /dev/null
@@ -1,1240 +0,0 @@
-#lang racket
-
-#|
- The Dice of Doom game, the eager version
- ----------------------------------------
-
- The Dice of Doom game is a turn-based game for two players sharing one keyboard.
- Since this implementation employs an eager strategy to build the complete game
- tree of all possible moves, it is only a step in the right direction.
-
- Each player owns hexagonal territories, which are arranged into a planar game
- board. A territory comes with a number of dice. When it is a player's turn,
- she marks one of her territories as a launching pad for an attack at a
- neigboring territory of the other player. Such an attack is enabled only if
- her chosen territory has more dice than the territory of the other player.
- The effect of the attack is that the territory changes ownership and that all
- but one of the attack dice are moved to the newly conquered territory. A
- player may continue her turn as long as she can launch attacks. Optionally,
- she may choose to pass after her first attack is executed, meaning she ends
- her turn. At the end of a turn, a number of dices are distributed across the
- players' territories. The game is over when a player whose turn it is cannot
- attack on her first move.
-
- A player can use the following five keys to play the game:
- -- with ← and → (arrow keys), the player changes the territory focus
- -- with enter, the player marks a territory the launching pad for an attack
- -- with the "d" key, the player unmarks a territory
- -- with the "p" key the player passes.
- Once a player passes, the game announces whose turn it is next.
-
- Play
- ----
-
- Run and evaluate
- (roll-the-dice)
- This will pop up a window that the game board, and instructions.
-|#
-
-(require 2htdp/image (except-in 2htdp/universe left right))
-
-;
-;
-;
-;
-; ;;;; ; ;;; ;;; ;; ;;
-; ; ; ; ; ; ;
-; ; ; ;;; ;;; ; ;;;; ; ; ;;;; ;; ;;; ; ;;; ;
-; ; ; ; ; ;; ; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ;;;;;; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;
-; ;;;; ;;;;; ;;;; ;;;;; ; ; ;;;; ;;;;; ;;;;; ;;; ;;
-;
-;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-;; Data
-
-(struct dice-world (src board gt) #:transparent)
-;; DiceWorld = (dice-world (U #false Natural) Board GameTree)
-;; in (dice-world i b gt)
-;; -- if i is a Natural, it is an index for the territory that the player has marked for an attack
-;; -- if i is #f, no territory has been marked yet
-;; b is the current board
-;; gt is the game-tree for the given i and b
-
-(define-values (game game? game-board game-player game-moves)
- (let ()
- (struct game (board player delayed-moves))
- (values game
- game?
- game-board
- game-player
- (lambda (g) (force (game-delayed-moves g))))))
-;; GameTree = (game Board Player [Listof Move])
-;; in (game-tree b p lm)
-;; -- b is the current board
-;; -- p is the current player
-;; -- lm is the list of moves that that player may execute
-
-;; Board = [List-of Territory]
-;; the first field in the list is the currently marked territory
-
-;; Player ∈ [0, PLAYER#) | Natural
-
-(struct move (action gt) #:transparent)
-;; Move = (move Action GameTree)
-;; in (move a gt)
-;; -- a represents the actione to be takem
-;; -- gt is the game-tree resulting from that action
-
-;; Action is one of:
-;; -- '() a passing move
-;; -- (list Natural Natural) the move where the first attacks the second
-
-(struct territory (index player dice x y) #:transparent)
-;; Territory = (territory Natural Player Dice Integer Integer)
-;; in (territory i p d x y)
-;; -- i is a unique identifier for the territory; it also determines its initial location
-;; -- p is the player who owns this territory
-;; -- d is the number of dice on this board
-;; -- x is the x coordiate of this territory in pixels
-;; -- y is the y coordiate of this territory in pixels
-
-;; Territory Natural -> Territory
-;; updates number of dice on territory
-(define (territory-set-dice t d)
- (territory (territory-index t) (territory-player t) d (territory-x t) (territory-y t)))
-
-;; Territory Player -> Territory
-;; updates owner of territory
-(define (territory-set-player t p)
- (territory (territory-index t) p (territory-dice t) (territory-x t) (territory-y t)))
-
-;; ---------------------------------------------------------------------------------------------------
-;; sample game tree for BOOK
-
-(define b1
- (list (territory 1 0 1 'a 'b)
- (territory 0 0 1 'x 'y)))
-
-(define b1-alternative
- (list (territory 0 0 1 'x 'y)
- (territory 1 0 1 'a 'b)))
-
-(define b3
- (list (territory 0 0 2 'x 'y)
- (territory 1 1 1 'a 'b)))
-
-(define gt1 (game b1 1 '()))
-
-(define mv2 (move '() gt1))
-
-(define gt2 (game b1-alternative 0 (list mv2)))
-
-(define mv3 (move '(0 1) gt2))
-
-(define gt3 (game b3 0 (list mv3)))
-
-;; ---------------------------------------------------------------------------------------------------
-;; Constants
-
-; initalization constants
-(define PLAYER# 2)
-(define DICE# 3)
-(define BOARD 3)
-(define GRID (* BOARD BOARD))
-(define INIT-PLAYER 0)
-(define INIT-SPARE-DICE 10)
-; The depth at which to limit the gametree
-(define AI-DEPTH 4)
-(define AI 1)
-
-; graphical constants: territories
-(define DICE-OFFSET 6)
-(define SIDE 75)
-(define OFFSET0 (* 2 SIDE))
-(define ROTATION 30)
-(define HEX 6)
-(define (hexagon color)
- (rotate ROTATION (regular-polygon SIDE HEX "solid" color)))
-(define X-OFFSET (image-width (hexagon "black")))
-(define Y-OFFSET (* (image-height (hexagon "black")) 3/4))
-
-; graphical constants
-(define COLORS
- (list (make-color 255 0 0 100)
- (make-color 0 255 0 100)
- (make-color 0 0 255 100)))
-(define FOCUS (rotate ROTATION (regular-polygon SIDE 6 "outline" "black")))
-(define D1 (bitmap "graphics/dice1.png"))
-(define D2 (bitmap "graphics/dice2.png"))
-(define D3 (bitmap "graphics/dice3.png"))
-(define D4 (bitmap "graphics/dice4.png"))
-(define IMG-LIST (list D1 D2 D3 D4))
-
-(define TEXT-SIZE 25)
-(define TEXT-COLOR "black")
-(define INSTRUCT
- "← and → to move among territories, <enter> to mark, <d> to unmark, and <p> to pass")
-(define AI-INSTRUCT
- "press any key to let the AI play")
-(define AI-TURN "It's the Mighty AI's turn")
-(define YOUR-TURN "It's your turn")
-(define INFO-X-OFFSET 180)
-(define INFO-Y-OFFSET 50)
-
-(define INSTRUCTIONS (text INSTRUCT TEXT-SIZE TEXT-COLOR))
-(define AI-INSTRUCTIONS (text AI-INSTRUCT TEXT-SIZE TEXT-COLOR))
-(define WIDTH (+ (image-width INSTRUCTIONS) 50))
-(define HEIGHT 600)
-(define (PLAIN)
- (define iw (image-width INSTRUCTIONS))
- (define bw (* SIDE 2 BOARD))
- (set! WIDTH (+ (max iw bw) 50))
- (set! HEIGHT (+ (* SIDE 2 BOARD) 50))
- (empty-scene WIDTH HEIGHT))
-(define (ISCENE w)
- (define mt (PLAIN))
- (when (or (> (image-width mt) 1280) (> (image-height mt) 800))
- (error 'scene "it is impossible to draw a ~s x ~s game scene for a 1280 x 800 laptop screen" (image-width mt) (image-height mt)))
- (place-image
- (if (= (game-player (dice-world-gt w)) AI)
- AI-INSTRUCTIONS
- INSTRUCTIONS)
- (* .5 WIDTH) (* .9 HEIGHT) mt))
-
-;
-;
-;
-;
-; ;;; ;;; ;
-; ;; ;;
-; ;; ;; ;;;; ;;; ;; ;;
-; ; ; ; ; ; ; ;; ;
-; ; ; ; ;;;;; ; ; ;
-; ; ; ; ; ; ; ;
-; ; ; ; ;; ; ; ;
-; ;;; ;;; ;;; ;; ;;;;; ;;; ;;;
-;
-;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-
-;; start the game
-(define (roll-the-dice)
- (big-bang (create-world-of-dice-and-doom)
- (on-key interact-with-board)
- (to-draw draw-dice-world)
- (stop-when no-more-moves-in-world?
- draw-end-of-dice-world)))
-
-;; -> DiceWorld
-;; Returns a randomly generated world. If the world that
-;; has been generated starts as a tie, the world is regenerated.
-;; property: world is not in endgame state (no-more-moves? returns false)
-(define (create-world-of-dice-and-doom)
- (define board (territory-build))
- (define gamet (game-tree board INIT-PLAYER INIT-SPARE-DICE))
- (define new-world (dice-world #f board gamet))
- (if (no-more-moves-in-world? new-world)
- (create-world-of-dice-and-doom)
- new-world))
-
-;; DiceWorld Key -> DiceWorld
-;; Handles key events from a player
-(define (interact-with-board w k)
- (cond [(= (game-player (dice-world-gt w)) AI)
- (ai-step-through w)]
- [(key=? "left" k)
- (refocus-board w left)]
- [(key=? "right" k)
- (refocus-board w right)]
- [(key=? "p" k)
- (pass w)]
- [(key=? "\r" k)
- (mark w)]
- [(key=? "d" k)
- (unmark w)]
- [else w]))
-
-;; Diceworld -> Scene
-;; draws the world
-(define (draw-dice-world w)
- (add-player-info
- (game-player (dice-world-gt w))
- (add-winning-probability w (add-board-to-scene w (ISCENE w)))))
-
-;; DiceWorld -> Boolean
-;; is it possible to play any moves from this world state?
-(define (no-more-moves-in-world? w)
- (define tree (dice-world-gt w))
- (define board (dice-world-board w))
- (define player (game-player tree))
- (or (no-more-moves? tree)
- (for/and ((t board)) (= (territory-player t) player))))
-
-;; DiceWorld -> Image
-;; render the endgame screen
-(define (draw-end-of-dice-world w)
- (define board (dice-world-board w))
- (define message (text (won board) TEXT-SIZE TEXT-COLOR))
- (define background (add-board-to-scene w (PLAIN)))
- (overlay message background))
-
-;; Board -> String
-;; Which player has won the game -- eager is for N human players
-(define (won board)
- (define-values (best-score w) (winners board))
- (cond [(cons? (rest w)) "It's a tie."]
- [(= (car w) AI) "AI won."]
- [else "You won."]))
-
-;
-;
-;
-;
-; ;;;;; ;
-; ; ;
-; ; ;; ;; ;;; ;;;;;
-; ; ;; ; ; ;
-; ; ; ; ; ;
-; ; ; ; ; ;
-; ; ; ; ; ; ;
-; ;;;;; ;;; ;;; ;;;;; ;;;
-;
-;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-;; Making A Board
-
-;; -> Board
-;; Creates a list of territories the size of GRID with given x and y coordinates
-;; properties: dice is (0,MAX-DICE]
-;; returns list of size GRID
-(define (territory-build)
- (for/list ([n (in-range GRID)])
- (territory n (modulo n PLAYER#) (dice) (get-x n) (get-y n))))
-
-;; -> Natural
-;; the number of initial die on a territory
-(define (dice)
- (add1 (random DICE#)))
-
-;; Natural -> Number
-;; the x coordinate for territory n of a board
-(define (get-x n)
- (+ OFFSET0
- (if (odd? (get-row n)) 0 (/ X-OFFSET 2))
- (* X-OFFSET (modulo n BOARD))))
-
-;; Natural -> Number
-;; the y coordinate for territory n of a board
-(define (get-y n)
- (+ OFFSET0 (* Y-OFFSET (get-row n))))
-
-;; ---------------------------------------------------------------------------------------------------
-;; Making a Game Tree
-
-;; Board Player Natural -> GameTree
-;; creates a complete game-tree from the given board, player, and spare dice
-(define (game-tree board player dice)
- ;; create tree of attacks from this position; add passing move
- (define (attacks board)
- (for*/list ([src board]
- [dst (neighbors (territory-index src))]
- #:when (attackable? board player src dst))
- (define from (territory-index src))
- (define dice (territory-dice src))
- (define newb (execute board player from dst dice))
- (define attacks-from-newb
- (game newb player (delay (cons (passes newb) (attacks newb)))))
- (move (list from dst) attacks-from-newb)))
- ;; create a passing move , distribute dice, continue
- (define (passes board)
- (define-values (new-dice newb) (distribute board player dice))
- (move '() (game-tree newb (switch player) new-dice)))
- ;; -- START: --
- (game board player (delay (attacks board))))
-
-;; Player -> Player
-;; switches from one player to the next
-(define (switch player)
- (modulo (+ player 1) PLAYER#))
-
-;; Board Player Natural -> Natural Board
-;; adds reinforcements to the game board
-;; > (add-new-dice (list (territory 0 2 2 9 0)) 2 2))
-;; (list (territory 0 2 2 9 0))
-(define (distribute board player spare-dice)
- (for/fold ([dice spare-dice] [new-board '()]) ([t board])
- (if (and (= (territory-player t) player)
- (< (territory-dice t) DICE#)
- (not (zero? dice)))
- (values (- dice 1) (cons (add-dice-to t) new-board))
- (values dice (cons t new-board)))))
-
-;; Territory -> Territory
-;; adds one dice to the given territory
-(define (add-dice-to t)
- (territory-set-dice t (add1 (territory-dice t))))
-
-;; Board Player Territory Natural -> Boolean
-;; can player attack dst from src?
-(define (attackable? board player src dst)
- (define dst-t
- (findf (lambda (t) (= (territory-index t) dst)) board))
- (and dst-t
- (= (territory-player src) player)
- (not (= (territory-player dst-t) player))
- (> (territory-dice src) (territory-dice dst-t))))
-
-;; Board Natural Natural Natural Natural -> Board
-;; Creates a new board after an attack
-;; updates only src and dst
-(define (execute board player src dst dice)
- (for/list ([t board])
- (define idx (territory-index t))
- (cond [(= idx src) (territory-set-dice t 1)]
- [(= idx dst)
- (define s (territory-set-dice t (- dice 1)))
- (territory-set-player s player)]
- [else t])))
-
-;; ---------------------------------------------------------------------------------------------------
-;; Getting Neigbors
-
-;; Natural -> [List-of Natural]
-;; returns the neighbors of the current spot
-;; > (neighbors 0)
-;; '(1 2 3)
-(define (neighbors pos)
- (define top? (< pos BOARD))
- (define bottom? (= (get-row pos) (sub1 BOARD)))
- (define even-row? (zero? (modulo (get-row pos) 2)))
- (define right? (zero? (modulo (add1 pos) BOARD)))
- (define left? (zero? (modulo pos BOARD)))
- (if even-row?
- (even-row pos top? bottom? right? left?)
- (odd-row pos top? bottom? right? left?)))
-
-;; Natural Boolean Boolean Boolean Boolean -> [Listof Naturals]
-;; gets the neighbors for a territory on an even row
-(define (even-row pos top? bottom? right? left?)
- (append (add (or top? right?) (add1 (- pos BOARD)))
- (add (or bottom? right?) (add1 (+ pos BOARD)))
- (add top? (- pos BOARD))
- (add bottom? (+ pos BOARD))
- (add right? (add1 pos))
- (add left? (sub1 pos))))
-
-;; Natural Boolean Boolean Boolean Boolean -> [Listof Naturals]
-;; gets the neighbors for a territory on an odd row
-(define (odd-row pos top? bottom? right? left?)
- (append (add top? (- pos BOARD))
- (add bottom? (+ pos BOARD))
- (add (or top? left?) (sub1 (- pos BOARD)))
- (add (or bottom? left?) (sub1 (+ pos BOARD)))
- (add right? (add1 pos))
- (add left? (sub1 pos))))
-
-;; Boolean X -> [Listof X]
-;; returns (list x) if (not b) else empty
-(define (add b x)
- (if b '() (list x)))
-
-;
-;
-;
-;
-; ;;; ;;; ;;;;;;
-; ; ; ; ; ;
-; ; ; ;;;; ;;; ;;; ; ; ;;; ;;; ;;;; ;; ;; ;;;;; ;;;;;
-; ; ; ; ; ; ; ;;; ; ; ; ; ;; ; ; ; ;
-; ;;; ;;;;;; ; ; ; ; ; ; ;;;;;; ; ; ; ;;;;
-; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;
-; ;;; ;; ;;;;; ; ;;;;;; ;; ;;;;; ;;; ;;; ;;; ;;;;;
-; ;
-; ;;;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-;; Territory Focusing and Marking
-
-;; DiceWorld [Board -> Board] -> World
-;; Creates a new World that has a rotated territory list
-;; > (define lterritory (territory 0 0 1 9 2))
-;; > (define rterritory (territory 0 0 1 9 0))
-;; > (refocus-board-action (dice-world -1 (list rterritory lterritory ...) GT) left)
-;; (dice-world -1 (list lterritory ... rterritory) GT)
-;; > (refocus-board-action (dice-world -1 (list lterritory ... rterritory) GT) left)
-;; (dice-world -1 (list rterritory lterritory ...) GT)
-(define (refocus-board w direction)
- (define source (dice-world-src w))
- (define board (dice-world-board w))
- (define tree (dice-world-gt w))
- (define player (game-player tree))
- (define (owner? tid)
- (if source (not (= tid player)) (= tid player)))
- (define new-board (rotate-until owner? board direction))
- (dice-world source new-board tree))
-
-;; [Player -> Boolean] Board (Board -> Board) -> Board
-;; rotate until the first element of the list satisfies owned-by
-(define (rotate-until owned-by board rotate)
- (define next-list (rotate board))
- (if (owned-by (territory-player (first next-list)))
- next-list
- (rotate-until owned-by next-list rotate)))
-
-;; Board -> Board
-;; rotate a list to the left
-(define (left l)
- (append (rest l) (list (first l))))
-
-;; Board -> Board
-;; rotate a list to the right
-(define (right l)
- (reverse (left (reverse l))))
-
-;; ---------------------------------------------------------------------------------------------------
-;; Handling Moves
-
-;; DiceWorld -> DiceWorld
-;; executes a passing move on the world state
-;; THIS DEFINITION IS NOT USED FOR THE ABSTRACT VERSION OF THE MODULE.
-(define (pass.10 w)
- (define m (find-move (game-moves (dice-world-gt w)) '()))
- (cond [(not m) w]
- [else ;; (no-more-moves? m)
- (dice-world #f (game-board m) m)]))
-
-;; DiceWorld -> DiceWorld
-;; unmarks a marked territory
-(define (unmark w)
- (dice-world #f (dice-world-board w) (dice-world-gt w)))
-
-;; DiceWorld -> DiceWorld
-;; marks a territory as the launching pad for an attack or launches the attack
-(define (mark w)
- (define tree (dice-world-gt w))
- (define board (dice-world-board w))
- (define source (dice-world-src w))
- (define focus (territory-index (first board)))
- (if source
- (attacking w source focus)
- (dice-world focus board tree)))
-
-;; DiceWorld Natural Natural -> DiceWorld
-(define (attacking w source target)
- (define feasible (game-moves (dice-world-gt w)))
- (define attack (list source target))
- (define next (find-move feasible attack))
- (define src-t (findf (lambda (t) (= (territory-index t) source))
- (dice-world-board w)))
- (define dst-t (findf (lambda (t) (= (territory-index t) target))
- (dice-world-board w)))
- (define win? (dice-attack-win src-t dst-t))
- (cond [(not next) w]
- [win? (dice-world #f (game-board next) next)]
- [else (dice-world-attack-lost w src-t)]))
-
-;; [List-of Moves] [or '() [List Natural Natural]] -> [or #f Game-tree]
-;; find the move from the current list of moves
-(define (find-move moves a)
- (define m (findf (lambda (m) (equal? (move-action m) a)) moves))
- (and m (move-gt m)))
-
-;; Game -> Boolean
-;; are there any moves in this game record?
-(define (no-more-moves? g)
- (empty? (game-moves g)))
-
-;; Territory Territory -> Boolean
-;; attack from src territory to destination territory
-;; and see who wins
-(define (dice-attack-win src-t dst-t)
- (define (roll-dice n)
- (for/list ([i n])
- (random 1 7)))
- (define (sum l)
- (foldl + 0 l))
- (define src-attack (sum (roll-dice (territory-dice src-t))))
- (define dst-defend (sum (roll-dice (territory-dice dst-t))))
- (if (> src-attack dst-defend) #t #f))
-
-
-(define (probability-of-winning st dt)
- "Find the probability of source territory defeating destination territory.
-
- `st` is the source territory.
- `dt` is the destination territory."
-
- ; Given the number of dice, returns a list all dice combinations.
- (define (dice-all-combination dice-num)
- (cond [(= dice-num 1)
- (for/list ([i (in-range 1 7)])
- (list i))]
- [else
- (for*/list ([i (in-range 1 7)]
- [r (dice-all-combination
- (- dice-num 1))])
- (cons i r))]))
-
-
- ; Given a list of dice combinations, returns a hashmap where the key
- ; is the 'dice sum' and the value is the number of combinations
- ; whose sum is the 'dice sum'.
- (define (dice-sum-hash dice-combinations)
- (for/foldr
- ([h (make-hash)]) ([c dice-combinations])
- (let ((sum (for/sum ([n c]) n)))
- (hash-set! h sum (+ (hash-ref h sum 0) 1))
- h)))
-
-
- ; sh: -> hashmap
- ; key: dice sum,
- ; value: number of ways we can arrive at sum
- (define sh (dice-sum-hash
- (dice-all-combination (territory-dice st))))
-
- ; dh: -> hashmap
- ; key: dice sum,
- ; value: number of ways we can arrive at sum
- (define dh (dice-sum-hash
- (dice-all-combination (territory-dice dt))))
-
- ; Generic probability function.
- (define (probability f t)
- (/ (* 1.0 f) t))
-
- ; Computes the total number of favorable outcomes for the source
- ; territory when its dice sum is `s-ds` against the
- ; destination's territory.
- ;
- ; s-ds -> source dice sum.
- ; n -> number of we can arrive at sum `s-ds`.
- (define (favorable-outcomes s-ds n)
- (* (for/sum [(d-ds (hash-keys dh))]
- (if (< d-ds s-ds)
- (hash-ref dh d-ds)
- 0))
- n))
-
- ; Computes the total number of favorable outcomes for the source
- ; territory against the destination's territory.
- (define (all-favorable-outcomes)
- (foldr + 0
- (for/list [(s-ds (hash-keys sh))]
- (favorable-outcomes
- s-ds
- (hash-ref sh s-ds)))))
-
- (define (all-outcomes)
- (let ((sd (territory-dice st))
- (dd (territory-dice dt)))
- (* (expt 6 sd) (expt 6 dd))))
-
- (probability (all-favorable-outcomes) (all-outcomes)))
-
-
-;; DiceWorld Territory -> DiceWorld
-;; generate dice world for the case where player
-;; loses the dice attack
-(define (dice-world-attack-lost w src-t)
- (define src (territory-index src-t))
- (define player (territory-player src-t))
- (define newb (for/list ([t (dice-world-board w)])
- (define idx (territory-index t))
- (cond [(= idx src) (territory-set-dice t 1)]
- [else t])))
- (define new-gt (game-tree newb player 0))
- (dice-world #f newb new-gt))
-
-;
-;
-;
-;
-; ;;;;; ;; ;
-; ; ; ;
-; ; ; ;;;; ;; ;; ;;; ; ;;;; ;; ;;; ;;; ;; ;; ;;; ;;
-; ; ; ; ; ;; ; ; ;; ; ; ;; ; ;; ; ; ;;
-; ;;;; ;;;;;; ; ; ; ; ;;;;;; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;;
-; ;;; ; ;;;;; ;;; ;;; ;;; ;; ;;;;; ;;;;; ;;;;; ;;; ;;; ;;; ;
-; ;
-; ;;;;
-;
-;
-
-;; Player Scene-> Scene
-;; Draws the world
-(define (add-player-info player s)
- (define str (whose-turn player))
- (define txt (text str TEXT-SIZE TEXT-COLOR))
- (place-image txt (- WIDTH INFO-X-OFFSET) INFO-Y-OFFSET s))
-
-(define (add-winning-probability w s)
- (define board (dice-world-board w))
- (define source (dice-world-src w))
- (define target (territory-index (first board)))
- (define feasible (game-moves (dice-world-gt w)))
- (define attack (list source target))
- (define next (find-move feasible attack))
-
- (define (find-territory index)
- (findf (lambda (t) (= (territory-index t) index))
- (dice-world-board w)))
-
- (if (and source next)
- (place-image
- (text (string-append
- "Winning Probability "
- (~r
- (probability-of-winning (find-territory source)
- (find-territory target))
- #:precision 2))
- TEXT-SIZE TEXT-COLOR)
- (- WIDTH 170) 100 s)
- s))
-
-;; DiceWorld Scene -> Scene
-;; folds through the board and creates an image representation of it
-(define (add-board-to-scene w s)
- (define board (dice-world-board w))
- (define player (game-player (dice-world-gt w)))
- (define focus? (dice-world-src w))
- (define trtry1 (first board))
- (define p-focus (territory-player trtry1))
- (define t-image (draw-territory trtry1))
- (define image (draw-focus focus? p-focus player t-image))
- (define base-s (add-territory trtry1 image s))
- (for/fold ([s base-s]) ([t (rest board)])
- (add-territory t (draw-territory t) s)))
-
-;; Nat Player Player Image -> Image
-;; add focus marker to territory if needed
-(define (draw-focus marked? p-in-focus p t-image)
- (if (or (and (not marked?) (= p-in-focus p))
- (and marked? (not (= p-in-focus p))))
- (overlay FOCUS t-image)
- t-image))
-
-;; Image Territory Image -> Image
-(define (add-territory t image scene)
- (place-image image (territory-x t) (territory-y t) scene))
-
-;; Territory -> Image
-;; renders a single territory
-(define (draw-territory t)
- (define color (color-chooser (territory-player t)))
- (overlay (hexagon color) (draw-dice (territory-dice t))))
-
-;; Natural -> Image
-;; renders all n >= 1 dice as a stack of dice
-(define (draw-dice n)
- (define first-die (get-dice-image 0))
- (define height-die (image-height first-die))
- (for/fold ([s first-die]) ([i (- n 1)])
- (define dice-image (get-dice-image (+ i 1)))
- (define y-offset (* height-die (+ .5 (* i .25))))
- (overlay/offset s 0 y-offset dice-image)))
-
-;; Player -> Color
-;; Determines a color for each player
-(define (color-chooser p)
- (list-ref COLORS p))
-
-;; -> Image
-;; returns an image from the list of dice images
-(define (get-dice-image i)
- (list-ref IMG-LIST (modulo i (length IMG-LIST))))
-
-;
-;
-;
-;
-; ;;;;;; ;; ;
-; ; ; ;
-; ; ; ;; ;; ;;; ; ;;; ;; ;; ;;; ;;
-; ;;; ;; ; ; ;; ; ;; ; ; ;;
-; ; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ; ;
-; ; ; ; ; ; ;; ; ; ; ; ;;
-; ;;;;;; ;;; ;;; ;;; ;; ;;;;; ;;; ;;; ;;; ;
-; ;
-; ;;;;
-;
-;
-
-;; Board ->* Natural [non-empty-listof Player]
-;; gives the number of winning territories and the players(s) who have them
-;; > (winners (list (territory 0 0 1 9 0) (territory 0 0 1 9 1)))
-;; (values 2 '(0))
-;; > (winners (list (territory 0 1 1 9 0) (territory 0 0 1 9 1)))
-;; (values 1 '(0 1))
-(define (winners board)
- (for/fold ([best 0][winners '()]) ([p PLAYER#])
- (define p-score (sum-territory board p))
- (cond [(> p-score best) (values p-score (list p))]
- [(< p-score best) (values best winners)]
- [(= p-score best) (values best (cons p winners))])))
-
-;; Board Player -> Natural
-;; counts the number of territorys the player owns
-;; > (sum-territory (list (territory 0 1 1 9 0) (territory 0 1 1 9 1)) 1)
-;; 2
-(define (sum-territory board player)
- (for/fold ([result 0]) ([t board])
- (if (= (territory-player t) player) (+ result 1) result)))
-
-
-;
-;
-;
-;
-;
-; ;;; ;;;;;;;
-; ;; ;
-; ; ; ;
-; ; ; ;
-; ; ; ;
-; ;;;;;; ;
-; ; ; ;
-; ; ; ;
-; ;;; ;;; ;;;;;;;
-;
-;
-;
-;
-
-;; Player -> {AI-TURN, YOUR-TURN}
-;; THIS REQUIRES A DIFFERENT DEFINITION FOR PLAIN CHAPTER 10.
-(define (whose-turn player)
- (if (= player AI) AI-TURN YOUR-TURN))
-
-;; DiceWorld -> DiceWorld
-;; executes a passing move on the world state
-;; THIS REQUIRES A DIFFERENT DEFINITION FOR PLAIN CHAPTER 10.
-(define (pass w)
- (define m (find-move (game-moves (dice-world-gt w)) '()))
- (cond [(not m) w]
- [(or (no-more-moves? m) (not (= (game-player m) AI)))
- (dice-world #f (game-board m) m)]
- [else
- (define ai (the-ai-plays m))
- (dice-world #f (game-board ai) ai)]))
-
-;; GameTree -> GameTree
-;; Computer calls this function until it is no longer the player
-(define (the-ai-plays tree)
- (define ratings (rate-moves tree AI-DEPTH))
- (define the-move (first (argmax second ratings)))
- (define new-tree (move-gt the-move))
- new-tree)
-
-;; DiceWold -> DiceWorld
-;; Executes AI's turn.
-(define (ai-step-through w)
- (define new-gt (the-ai-plays (dice-world-gt w)))
- (dice-world #f (game-board new-gt) new-gt))
-
-;; GameTree Natural -> [List-of (List Move Number)]
-;; assigns a value to each move that is being considered
-;; and return those values in a list
-(define (rate-moves tree depth)
- (for/list ((move (game-moves tree)))
- (list move (rate-position (move-gt move) (- depth 1)))))
-
-;; GameTree Natural -> Number
-;; Returns a number that is the best move for the given player.
-(define (rate-position tree depth)
- (cond [(or (= depth 0) (no-more-moves? tree))
- (define-values (best w) (winners (game-board tree)))
- (if (member AI w) (/ 1 (length w)) 0)]
- [else
- (define ratings (rate-moves tree depth))
- (apply (if (= (game-player tree) AI) max min)
- (map second ratings))]))
-
-;
-;
-;
-;
-; ;;
-; ;
-; ; ; ;; ;; ;; ;; ;;;;;
-; ; ; ; ; ; ; ; ;
-; ; ; ; ; ;; ;;;;
-; ;;; ; ; ;; ;
-; ; ; ; ;; ; ; ; ;
-; ;;; ;;; ;; ;; ;; ;; ;;;;;
-;
-;
-;
-;
-
-;; Natural -> Natural
-;; gets the row that territory is on, indexed from 0
-;; [test vary on current board-size]
-(define (get-row pos)
- (quotient pos BOARD))
-
-
-;
-;
-;
-;
-;
-; ;;;;;;; ;
-; ; ; ; ;
-; ; ; ; ;;; ;;;; ; ;;;;;; ;;;; ;
-; ; ; ; ; ; ; ;; ; ; ;;
-; ; ; ; ; ; ;
-; ; ;;;;;;; ;;;;; ; ;;;;;
-; ; ; ; ; ;
-; ; ; ; ; ; ; ; ; ;
-; ;;;;; ;;;; ;;;;;; ;;;; ;;;;;;
-;
-;
-;
-;
-
-;; ---------------------------------------------------------------------------------------------------
-
-;; Natural -> Void
-;; make the board larger
-(define (set-grid n)
- (set! BOARD n)
- (set! GRID (* n n)))
-
-(module+ test
-
- (require rackunit rackunit/text-ui)
-
- ;; (-> any) -> void
- ;; runs the thunk PROP-NUM times
- (define (check-property t)
- (test-begin (for ((i 50)) (t))))
-
- ;; Properties
- (define (property:starting-world-playable)
- (unless (and (= BOARD 2) (= PLAYER# 2))
- (error 'starting-world-playable "BOARD-SIZE != 2 or PLAYERS# != 2"))
- (check-false (no-more-moves-in-world? (create-world-of-dice-and-doom))))
-
- (define (property:dice-in-range)
- (check-true (andmap (λ (b) (>= DICE# (territory-dice b) 1)) (territory-build))
- "dice out of range"))
-
- (define (property:board-correct-size)
- (check-equal? (length (territory-build)) GRID
- "board incorrect-size"))
-
- (define (property:no-pass-on-first-move)
- (define (move-action? m) (equal? (move-action m) '()))
- (check-true (not (memf move-action? (game-moves (game-tree (territory-build) 0 0))))
- "no pass on first move"))
-
- ;; ---------------------------------------------------------------------------------------------------
-
-
- ;; testing game initialization
-
- (check-equal? (territory-index (first (territory-build))) 0)
- (check-equal? (territory-player (first (territory-build))) 0)
- (check-equal? (territory-index (second (territory-build))) 1)
- (check-equal? (territory-player (second (territory-build))) 1)
- (check-equal? (territory-index (third (territory-build))) 2)
- (check-equal? (territory-player (third (territory-build))) 0)
- (check-equal? (territory-index (fourth (territory-build))) 3)
- (check-equal? (territory-player (fourth (territory-build))) 1)
-
- (check-property property:starting-world-playable)
- (check-property property:board-correct-size)
- (check-property property:dice-in-range)
- (check-property property:no-pass-on-first-move)
-
- ;; ---------------------------------------------------------------------------------------------------
- ;; testing territory manipulation
-
- ;; legal?
- (check-true
- (and (attackable? (list (territory 0 0 2 9 0) (territory 3 1 1 9 0)) 0 (territory 0 0 2 9 0) 3) #t))
- (check-false
- (attackable? (list (territory 0 0 2 9 0) (territory 3 1 1 9 0)) 0 (territory 0 0 2 9 0) 0))
- (check-false
- (attackable? (list (territory 0 0 2 9 0) (territory 5 1 1 9 0)) 1 (territory 0 0 2 9 0) 5))
-
- ;; get-row
- (check-equal? (get-row 0) 0)
- (check-equal? (get-row 1) 0)
- (check-equal? (get-row 2) 1)
- (check-equal? (get-row 3) 1)
- (check-equal? (get-row 12) 6) ;; checks math. actually invalid on board of size 2
- (check-equal? (get-row 11) 5) ;; checks math. actually invalid on board of size 2
- (check-equal? (get-row 13) 6) ;; checks math. actually invalid on board of size 2
- (check-equal? (get-row 14) 7) ;; checks math. actually invalid on board of size 2
-
- ;; ---------------------------------------------------------------------------------------------------
- (define board3
- (list (territory 0 1 1 9 0) (territory 1 1 1 8 0) (territory 2 1 3 43.5 5) (territory 3 1 1 6 5)))
- (define b1+0+3
- (list (territory 0 0 2 9 0) (territory 1 1 1 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
- (define b2+1+2
- (list (territory 0 0 1 9 0) (territory 1 1 3 8 0) (territory 2 0 2 43.5 5) (territory 3 1 2 6 5)))
- (define board6
- (list (territory 0 0 1 9 0) (territory 1 1 2 8 0) (territory 2 0 3 43.5 5) (territory 3 1 2 6 5)))
- (define bard6+
- (list (territory 0 0 1 9 0) (territory 1 1 2 8 0) (territory 2 0 3 43.5 5) (territory 3 1 2 6 5)))
-
- (define (distribute/list a b c)
- (define-values (x y) (distribute a b c))
- (list x y))
-
- (define board0
- (list (territory 0 0 1 9 0) (territory 1 1 2 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
- (define board1
- (list (territory 0 0 1 9 0) (territory 1 1 1 8 0) (territory 2 0 1 43.5 5) (territory 3 1 1 6 5)))
- (define b1+1+2
- (list (territory 0 0 1 9 0) (territory 1 1 2 8 0) (territory 2 0 1 43.5 5) (territory 3 1 2 6 5)))
- (define board2
- (list (territory 0 0 1 9 0) (territory 1 1 1 8 0) (territory 2 0 3 43.5 5) (territory 3 1 1 6 5)))
-
- (define g-tree1 (game board1 0 '()))
- (define g-tree2 (game-tree board0 0 0))
-
- ; (define world31 (dice-world #f board1 g-tree1))
- (define world2 (dice-world #f board2 g-tree2))
-
- ;; testing book tree
-
- (check-equal? (game-tree (list (territory 0 0 2 'x 'y)
- (territory 1 1 1 'a 'b))
- 0
- 0)
- gt3)
-
-
- ;; testing tree generation
-
- (define (property:attack-location-valid)
- (define moves (game-moves (game-tree (territory-build) 0 0)))
- (check-true (and (for/and ([m moves])
- (define m1 (move-action m))
- (member (second m1) (neighbors (first m1))))
- #t)
- "invalid attack location"))
-
- (define (property:add-to-territory-always-up-one)
- (define r (random 10000))
- (check-equal? (add-dice-to (territory 0 0 r 0 0))
- (territory 0 0 (add1 r) 0 0)
- "add to territory always up one"))
-
- (define (property:attackable?-does-not-need-neighbores-check)
- (define (check-attackable? gt)
- (for/and ([move (game-moves gt)]
- #:when (not (empty? (move-action move))))
- (define action (move-action move))
- (define gt (move-gt move))
- (and (member (second action) (neighbors (first action)))
- (check-attackable? gt))))
-
- ;;start
- (define old-size BOARD)
- (set-grid 2)
- (define testing-gt (dice-world-gt (create-world-of-dice-and-doom)))
- (check-true (check-attackable? testing-gt) "An attack move between non-neighbores was created")
- (set-grid old-size))
-
-
- ;; game-tree
- (check-equal? (game-tree board1 0 0) g-tree1)
- (check-equal? (game-tree board3 1 0) (game board3 1 '()))
- (check-equal? (game-tree board3 0 0) (game board3 0 '()))
- (check-property property:attackable?-does-not-need-neighbores-check)
-
- ;; find-move
- (check-false (find-move '() '()))
- (check-equal? (find-move (list (move '() (game '() 0 '()))) '()) (game '() 0 '()))
- ;; Attacking-Moves
- (check-property property:attack-location-valid)
-
- ;; switch-players
- (check-equal? (switch 0) 1)
- (check-equal? (switch 1) 0)
-
- ;; Add-New-Dice
- (check-equal? (distribute/list (game-board g-tree1) 0 3) (list 1 (reverse b1+0+3)))
- (check-equal? (distribute/list (game-board g-tree1) 1 2) (list 0 (reverse b1+1+2)))
- (check-equal? (distribute/list (game-board g-tree2) 1 2) (list 0 (reverse b2+1+2)))
- (check-equal? (distribute/list board6 0 0) (list 0 (reverse bard6+)))
-
- ;; add-to-territory
- (check-equal? (add-dice-to (territory 0 1 2 9 0)) (territory 0 1 3 9 0))
- (check-equal? (add-dice-to (territory 0 1 1 9 0)) (territory 0 1 2 9 0))
- (check-equal? (add-dice-to (territory 0 1 5 9 0)) (territory 0 1 6 9 0))
- (check-property property:add-to-territory-always-up-one)
-
- ;; ---------------------------------------------------------------------------------------------------
- (define board7
- (list (territory 0 0 1 9 0) (territory 1 1 1 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
- (define board8
- (list (territory 0 1 1 9 0) (territory 1 1 1 8 0) (territory 2 0 3 43.5 5) (territory 3 1 1 6 5)))
- (define board9
- (list (territory 0 0 1 9 0) (territory 1 1 1 8 0) (territory 2 0 2 43.5 5) (territory 3 0 1 6 5)))
- (define board10
- (list (territory 0 0 1 9 0) (territory 1 1 3 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
-
- ;; testing attacks
-
- (check-equal?
- (execute board7 0 2 1 2)
- (list (territory 0 0 1 9 0) (territory 1 0 1 8 0) (territory 2 0 1 43.5 5) (territory 3 1 1 6 5)))
-
- (check-equal?
- (execute board8 0 2 1 3)
- (list (territory 0 1 1 9 0) (territory 1 0 2 8 0) (territory 2 0 1 43.5 5) (territory 3 1 1 6 5)))
-
- (check-equal?
- (execute board9 0 2 1 2)
- (list (territory 0 0 1 9 0) (territory 1 0 1 8 0) (territory 2 0 1 43.5 5) (territory 3 0 1 6 5)))
-
- (check-equal?
- (execute board10 1 1 0 3)
- (list(territory 0 1 2 9 0) (territory 1 1 1 8 0) (territory 2 0 2 43.5 5) (territory 3 1 1 6 5)))
-
- ;; Neighbors
- (check-equal? (neighbors 2) '(0 3))
- (check-equal? (neighbors 0) '(3 2 1))
- (check-equal? (neighbors 1) '(3 0))
- (check-equal? (neighbors 3) '(1 0 2))
-
- ;; ---------------------------------------------------------------------------------------------------
- (define board20
- (list (territory 0 0 1 9 2) (territory 1 0 1 9 0) (territory 2 2 1 9 0)))
- (define board21
- (list (territory 0 1 1 9 0) (territory 1 1 1 8 0) (territory 2 1 1 43.5 5) (territory 3 1 1 6 5)))
-
- ;; testing focus manipulation
- ;; interact-with-board
- (check-equal?
- (interact-with-board world2 "\r")
- (dice-world (territory-index (car (dice-world-board world2))) (dice-world-board world2) g-tree2))
-
- (check-equal? (interact-with-board world2 "p") world2)
-
- ;; refocus-board-action
- (check-equal?
- (refocus-board (dice-world #f (list (territory 0 0 1 9 0) (territory 0 0 1 9 2)) g-tree1) left)
- (dice-world #f (list (territory 0 0 1 9 2) (territory 0 0 1 9 0)) g-tree1))
-
- (check-equal?
- (refocus-board (dice-world #f (list (territory 0 0 1 9 2) (territory 0 1 1 9 0)) g-tree1) right)
- (dice-world #f (list (territory 0 0 1 9 2) (territory 0 1 1 9 0)) g-tree1))
-
- (check-equal?
- (refocus-board (dice-world 0 board20 g-tree1) left)
- (dice-world 0 (list (territory 2 2 1 9 0) (territory 0 0 1 9 2) (territory 1 0 1 9 0)) g-tree1))
-
- (check-equal?
- (refocus-board (dice-world 0 (list (territory 0 0 1 9 2) (territory 0 1 1 9 0)) g-tree1) left)
- (dice-world 0 (list (territory 0 1 1 9 0) (territory 0 0 1 9 2)) g-tree1))
-
- (check-equal?
- (refocus-board (dice-world 0 (list(territory 0 0 1 9 2) (territory 0 1 1 9 0)) g-tree1) right)
- (dice-world 0 (list (territory 0 1 1 9 0) (territory 0 0 1 9 2)) g-tree1))
-
- ;;unmark
- (check-equal? (unmark (dice-world 1 board21 g-tree1)) (dice-world #f board21 g-tree1))
-
- (check-equal? (unmark (dice-world 1 (list (territory 0 1 1 9 0) (territory 1 1 1 8 0)) g-tree1))
- (dice-world #f (list (territory 0 1 1 9 0) (territory 1 1 1 8 0)) g-tree1))
- (check-equal? (unmark (dice-world 0 (list (territory 0 1 1 9 0)) g-tree1))
- (dice-world #f (list (territory 0 1 1 9 0)) g-tree1))
- (check-equal? (unmark (dice-world #f (list (territory 0 1 1 9 0)) g-tree1))
- (dice-world #f (list (territory 0 1 1 9 0)) g-tree1))
-
- ;; ---------------------------------------------------------------------------------------------------
- (define (winners/list w)
- (define-values (a b) (winners w))
- (cons a b))
-
- ;; testing functions that determine 'winning' and declare the winner
-
- ;; winners
- (check-equal? (winners/list (list (territory 0 0 1 9 0) (territory 0 0 1 9 1))) (list 2 0))
- (check-equal? (winners/list (list (territory 0 1 1 9 0) (territory 0 0 1 9 1))) (list 1 1 0))
-
- ;; sum-territory
- (check-equal? (sum-territory (list (territory 0 0 1 9 0) (territory 0 0 1 9 1)) 0) 2)
- (check-equal? (sum-territory (list (territory 0 0 1 9 0) (territory 0 0 1 9 1)) 1) 0)
- (check-equal? (sum-territory (list (territory 0 0 1 9 0) (territory 0 0 1 9 1)) 2) 0)
- (check-equal? (sum-territory (list (territory 0 1 1 9 0) (territory 0 0 1 9 1)) 1) 1)
- (check-equal? (sum-territory (list (territory 0 1 1 9 0) (territory 0 0 1 9 1)) 0) 1)
-
- ;; ---------------------------------------------------------------------------------------------------
- ;; testing the AI
-
- (define tree0
- (game-tree (list (territory 0 1 3 0 0)
- (territory 1 0 2 0 0)
- (territory 2 0 2 0 0)
- (territory 3 0 2 0 0))
- 1 15))
-
- (define territory1 (territory 3 0 3 280 262.5))
-
- (define board31
- (list territory1
- (territory 2 0 3 150 262.5)
- (territory 1 1 2 345 150)
- (territory 0 0 2 215 150)))
-
- (define world1
- (dice-world #f board31 (game board31 1 '())))
-
- ;; testing the AI functions
-
- ;; MF: one of these two tests should fail!
- (check-true (and (attackable? board31 0 territory1 1) #t))
- (check-true (no-more-moves-in-world? world1))
-
- (check-equal? (interact-with-board (dice-world 3 '() '()) "d")
- (dice-world #f '() '()))
-
- (check-equal? (game-board (the-ai-plays tree0))
- (list (territory 3 1 3 0 0)
- (territory 2 0 2 0 0)
- (territory 1 0 2 0 0)
- (territory 0 1 2 0 0)))
-
- (check-equal? (game-player (the-ai-plays tree0))
- 0)
-
- (check-equal? (game-board (move-gt (first (game-moves tree0))))
- (list (territory 0 1 1 0 0)
- (territory 1 0 2 0 0)
- (territory 2 0 2 0 0)
- (territory 3 1 2 0 0)))
-
- (check-equal? (game-player (move-gt (first (game-moves tree0))))
- 1)
-
- (check-equal? (rate-position tree0 AI-DEPTH) 1/2)
- (check-equal? (rate-position (move-gt (first (game-moves tree0))) AI-DEPTH)
- 1/2)
-
- "all tests run")
diff --git a/net/ricketyspace/ror/two/guess.rkt b/net/ricketyspace/ror/two/guess.rkt
deleted file mode 100644
index ab05056..0000000
--- a/net/ricketyspace/ror/two/guess.rkt
+++ /dev/null
@@ -1,21 +0,0 @@
-#lang racket
-
-(define lower 1)
-
-(define upper 100)
-
-(define (start n m)
- (set! lower (min n m))
- (set! upper (max n m))
- (guess))
-
-(define (guess)
- (quotient (+ lower upper) 2))
-
-(define (smaller)
- (set! upper (max lower (sub1 (guess))))
- (guess))
-
-(define (bigger)
- (set! lower (min upper (add1 (guess))))
- (guess))