diff --git a/collects/games/aces/aces.scm b/collects/games/aces/aces.rkt similarity index 98% rename from collects/games/aces/aces.scm rename to collects/games/aces/aces.rkt index f5698039b4..fbe5b7cc08 100644 --- a/collects/games/aces/aces.scm +++ b/collects/games/aces/aces.rkt @@ -5,10 +5,10 @@ possible to remap single click (instead of double click)? |# -#lang mzscheme +#lang racket -(require games/cards mred mzlib/class mzlib/list mzlib/unit string-constants - "../show-scribbling.ss") +(require games/cards racket/gui racket/class racket/unit string-constants + "../show-scribbling.rkt") (provide game@) (define game@ (unit (import) (export) @@ -29,7 +29,7 @@ possible to remap single click (instead of double click)? ;; space between cards in the 4 stacks (define card-space 30) -(define-struct stack (x y cards)) +(define-struct stack (x y cards) #:mutable) (define (get-x-offset n) (let* ([table-width (send table table-width)] diff --git a/collects/games/aces/info.rkt b/collects/games/aces/info.rkt index 92b49d4c17..cd412ee74c 100644 --- a/collects/games/aces/info.rkt +++ b/collects/games/aces/info.rkt @@ -1,4 +1,4 @@ #lang setup/infotab -(define game "aces.scm") +(define game "aces.rkt") (define game-set "Card Games") diff --git a/collects/games/blackjack/blackjack.rkt b/collects/games/blackjack/blackjack.rkt index 702cb4be58..ab8cf8da05 100644 --- a/collects/games/blackjack/blackjack.rkt +++ b/collects/games/blackjack/blackjack.rkt @@ -29,9 +29,9 @@ ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#lang mzscheme +#lang racket -(require games/cards mred mzlib/class mzlib/list mzlib/unit) +(require games/cards racket/gui racket/class racket/unit) (provide game@) (define game@ (unit (import) (export) diff --git a/collects/games/cards.rkt b/collects/games/cards.rkt index bcc93e499d..f231212947 100644 --- a/collects/games/cards.rkt +++ b/collects/games/cards.rkt @@ -1,4 +1,4 @@ -#lang mzscheme +#lang racket (require "cards/cards.rkt") -(provide (all-from "cards/cards.rkt")) +(provide (all-from-out "cards/cards.rkt")) diff --git a/collects/games/cards/base.rkt b/collects/games/cards/base.rkt index c8b707a023..211d0a4278 100644 --- a/collects/games/cards/base.rkt +++ b/collects/games/cards/base.rkt @@ -1,5 +1,5 @@ -(module base mzscheme - (require mzlib/class mzlib/etc +(module base racket + (require racket/class "make-cards.rkt" "classes.rkt" "card-class.rkt") (provide make-table make-deck make-card @@ -9,7 +9,7 @@ (define card<%> (class->interface card%)) (define make-table - (opt-lambda ([title "Cards"][w 7][h 3]) + (lambda ([title "Cards"][w 7][h 3]) (make-object table% title w h))) (define (make-deck) diff --git a/collects/games/cards/card-class.rkt b/collects/games/cards/card-class.rkt index a28f224ed2..5372d655b3 100644 --- a/collects/games/cards/card-class.rkt +++ b/collects/games/cards/card-class.rkt @@ -2,7 +2,7 @@ (module card-class racket/base (require racket/class racket/shared - (prefix-in mred: mred) + (prefix-in mred: racket/gui) "snipclass.rkt" "region.rkt") diff --git a/collects/games/cards/cards.rkt b/collects/games/cards/cards.rkt index ccb388913e..b2c4b1594e 100644 --- a/collects/games/cards/cards.rkt +++ b/collects/games/cards/cards.rkt @@ -1,10 +1,10 @@ -(module cards mzscheme +(module cards racket (require "base.rkt" "utils.rkt" "region.rkt") (provide table<%> card<%> - region struct:region + region struct:region make-region region? region-x region-y region-w region-h region-label region-callback region-interactive-callback diff --git a/collects/games/cards/classes.rkt b/collects/games/cards/classes.rkt index 018cdc15d4..ea5090e40e 100644 --- a/collects/games/cards/classes.rkt +++ b/collects/games/cards/classes.rkt @@ -1,7 +1,6 @@ (module classes racket/base (require racket/class - (prefix-in mred: mred) - racket/list + (prefix-in mred: racket/gui) (prefix-in util: "utils.rkt") "constants.rkt" "make-cards.rkt" diff --git a/collects/games/cards/constants.rkt b/collects/games/cards/constants.rkt index 41c63e64cc..ab22fca26b 100644 --- a/collects/games/cards/constants.rkt +++ b/collects/games/cards/constants.rkt @@ -1,7 +1,7 @@ -(module constants mzscheme - (require mzlib/class - mred) +(module constants racket + (require racket/class + racket/gui) (provide ANIMATION-STEPS ANIMATION-TIME diff --git a/collects/games/cards/main.rkt b/collects/games/cards/main.rkt index 5ee1d83120..ee64e21956 100644 --- a/collects/games/cards/main.rkt +++ b/collects/games/cards/main.rkt @@ -1,4 +1,4 @@ -#lang mzscheme +#lang racket (require "cards.rkt") -(provide (all-from "cards.rkt")) +(provide (all-from-out "cards.rkt")) diff --git a/collects/games/cards/make-cards.rkt b/collects/games/cards/make-cards.rkt index c198d18b44..7d5ac2976c 100644 --- a/collects/games/cards/make-cards.rkt +++ b/collects/games/cards/make-cards.rkt @@ -1,7 +1,7 @@ -(module make-cards mzscheme - (require mzlib/class - (prefix mred: mred) - (prefix card-class: "card-class.rkt")) +(module make-cards racket + (require racket/class + (prefix-in mred: racket/gui) + (prefix-in card-class: "card-class.rkt")) (provide back deck-of-cards make-card) @@ -61,7 +61,7 @@ front back (lambda () (make-dim front)) (lambda () dim-back) - (make-hash-table 'equal)) + (make-hash)) (vloop (sub1 value)))))))))) (define (make-card front-bm back-bm suit-id value) @@ -77,4 +77,4 @@ (if back-bm (make-dim back) dim-back)) - (make-hash-table 'equal))))) + (make-hash))))) diff --git a/collects/games/cards/region.rkt b/collects/games/cards/region.rkt index 098f709ec7..d75d34bf85 100644 --- a/collects/games/cards/region.rkt +++ b/collects/games/cards/region.rkt @@ -1,5 +1,5 @@ -(module region mzscheme +(module region racket (provide region struct:region make-region region? region-x region-y region-w region-h diff --git a/collects/games/cards/snipclass.rkt b/collects/games/cards/snipclass.rkt index f66a281170..dd52988f08 100644 --- a/collects/games/cards/snipclass.rkt +++ b/collects/games/cards/snipclass.rkt @@ -1,7 +1,7 @@ -(module snipclass mzscheme - (require mred - mzlib/class) +(module snipclass racket + (require racket/gui + racket/class) (provide sc) (define sc (make-object snip-class%)) diff --git a/collects/games/cards/utils.rkt b/collects/games/cards/utils.rkt index 07ff7b8b09..a00d7e92b1 100644 --- a/collects/games/cards/utils.rkt +++ b/collects/games/cards/utils.rkt @@ -1,5 +1,5 @@ -(module utils mzscheme +(module utils racket (provide shuffle-list) (define shuffle-list diff --git a/collects/games/chat-noir/chat-noir-unit.rkt b/collects/games/chat-noir/chat-noir-unit.rkt index 345be793f0..078eb08446 100644 --- a/collects/games/chat-noir/chat-noir-unit.rkt +++ b/collects/games/chat-noir/chat-noir-unit.rkt @@ -38,7 +38,7 @@ (o-loop (cdr objs))]))])))) ;; a hack. - ;; this adds a help button to the world.ss window + ;; this adds a help button to the world.rkt window (thread (λ () (let loop ([n 0]) @@ -66,6 +66,6 @@ (parameterize ([current-custodian sub-custodian]) (parameterize ([current-namespace (make-base-namespace)]) - (namespace-attach-module orig-namespace 'mred/mred) + (namespace-attach-module orig-namespace 'racket/gui) (namespace-attach-module orig-namespace 'racket/class) ((dynamic-require chat-noir 'main))))) diff --git a/collects/games/chat-noir/hash.rkt b/collects/games/chat-noir/hash.rkt index c072a052aa..f22b6d1dc6 100644 --- a/collects/games/chat-noir/hash.rkt +++ b/collects/games/chat-noir/hash.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (provide make-immutable-hash/list-init hash-set hash-ref hash-map) diff --git a/collects/games/checkers/checkers.rkt b/collects/games/checkers/checkers.rkt index 6b78e3c2dc..ba3003eed8 100644 --- a/collects/games/checkers/checkers.rkt +++ b/collects/games/checkers/checkers.rkt @@ -1,15 +1,12 @@ -#lang mzscheme +#lang racket (require games/gl-board-game/gl-board - mzlib/class - mzlib/math - mred - mzlib/unit + racket/gui + racket/unit sgl/gl-vectors sgl sgl/gl srfi/25/array - mrlib/include-bitmap "honu-bitmaps.rkt") (provide game@) @@ -43,9 +40,10 @@ (make-image (send bmp get-width) (send bmp get-height) (argb->rgba (bitmap->argb bmp)))) -(define light-square-img (bitmap->image (include-bitmap "light.jpg"))) +#;(define light-square-img (bitmap->image (include-bitmap "light.jpg"))) +(define light-square-img (bitmap->image (make-object bitmap% (build-path (collection-file-path "light.jpg" "games" "checkers"))))) (define light-square-color (gl-float-vector .7216 .6471 .5176 1)) -(define dark-square-img (bitmap->image (include-bitmap "dark.jpg"))) +(define dark-square-img (bitmap->image (make-object bitmap% (build-path (collection-file-path "dark.jpg" "games" "checkers"))))) (define dark-square-color (gl-float-vector .4745 .3569 .2627 1)) (define (color-name->vector name darken?) @@ -62,7 +60,7 @@ (define dark-checker-img (bitmap->image honu-bitmap)) (define-struct space-info (x y light?)) -(define-struct piece-info (x y color king?) (make-inspector)) +(define-struct piece-info (x y color king?) #:inspector (make-inspector)) (define-struct moves (list forced-jump?)) (define-signature model^ diff --git a/collects/games/checkers/honu-bitmaps.rkt b/collects/games/checkers/honu-bitmaps.rkt index 30a6974a27..64146a8ae0 100644 --- a/collects/games/checkers/honu-bitmaps.rkt +++ b/collects/games/checkers/honu-bitmaps.rkt @@ -1,8 +1,7 @@ -(module honu-bitmaps mzscheme - (require mzlib/math - mzlib/etc - mred - mzlib/class) +(module honu-bitmaps racket + (require racket/math + racket/gui + racket/class) (provide honu-bitmap honu-down-bitmap honu-rotation honu-down-rotation) @@ -16,7 +15,7 @@ (+ y (* h 1/2) (* h 1/2 se))))) (define weighted-arc - (opt-lambda (path x y w h start end ccw? [dx1 0.0] [dy1 0.2] [dx2 dx1] [dy2 (- dy1)]) + (lambda (path x y w h start end ccw? [dx1 0.0] [dy1 0.2] [dx2 dx1] [dy2 (- dy1)]) (let ([sweep (let loop ([s (if ccw? (- end start) (- start end))]) (if (< s 0) (loop (+ s (* 2 pi))) @@ -273,7 +272,7 @@ (let ([right-hole-path (make-object dc-path%)]) (define arc/end - (opt-lambda (x y w h start end [cc? #t] [dx1 0] [dy1 0.2] [dx2 0] [dy2 -0.2]) + (lambda (x y w h start end [cc? #t] [dx1 0] [dy1 0.2] [dx2 0] [dy2 -0.2]) (weighted-arc right-hole-path x y w h start end cc? dx1 dy1 dx2 dy2) (find-arc-spot x y w h end))) diff --git a/collects/games/crazy8s/crazy8s.rkt b/collects/games/crazy8s/crazy8s.rkt index 35db3be78c..0fc34a95c8 100644 --- a/collects/games/crazy8s/crazy8s.rkt +++ b/collects/games/crazy8s/crazy8s.rkt @@ -1,12 +1,12 @@ -#lang mzscheme +#lang racket -(require games/cards mred mzlib/class mzlib/unit mzlib/etc mzlib/list mzlib/file - mzlib/async-channel) +(require games/cards racket/gui racket/class racket/unit racket/file + racket/async-channel) ;; Player record (define-struct player (r hand-r ; region - hand)) ; cards + hand) #:mutable) ; cards ;; Messages (define YOUR-NAME "You") diff --git a/collects/games/doors/doors.rkt b/collects/games/doors/doors.rkt index 2150deb950..d3d98169e7 100644 --- a/collects/games/doors/doors.rkt +++ b/collects/games/doors/doors.rkt @@ -1,12 +1,10 @@ -(module doors mzscheme +(module doors racket (require games/gl-board-game/gl-board sgl/gl-vectors sgl sgl/bitmap - mred - mzlib/list - mzlib/etc - mzlib/class) + racket/gui + racket/class) (provide door-game% player-data @@ -18,10 +16,10 @@ (define light-blue (gl-float-vector 0.5 0.5 1.0 0.5)) (define light-red (gl-float-vector 1.0 0.5 0.5 0.5)) - (define-struct room (data players things)) - (define-struct wall (drawer)) - (define-struct player (data drawer i j)) - (define-struct thing (data drawer i j heads-up?)) + (define-struct room (data players things) #:mutable) + (define-struct wall (drawer) #:mutable) + (define-struct player (data drawer i j) #:mutable) + (define-struct thing (data drawer i j heads-up?) #:mutable) (define (bitmap->drawer bm game) (let*-values ([(bm mask) @@ -127,13 +125,13 @@ (gl-end-list) list-id))))) - (define cache (make-hash-table 'equal)) + (define cache (make-hash)) (define/private (make-wall-dl/cached dir door?) (let ([key (list dir door?)]) - (hash-table-get cache key + (hash-ref cache key (lambda () (let ([dl (make-wall-dl dir door?)]) - (hash-table-put! cache key dl) + (hash-set! cache key dl) dl))))) (define/private (make-wall-draw dx dy dir door) diff --git a/collects/games/doors/graph.rkt b/collects/games/doors/graph.rkt index af25b80cdb..13a3bc6fa7 100644 --- a/collects/games/doors/graph.rkt +++ b/collects/games/doors/graph.rkt @@ -1,7 +1,8 @@ -(module graph mzscheme - (require mzlib/class - "private/utils.rkt") - (require-for-syntax "private/utils.rkt") +(module graph racket + (require racket/class + "private/utils.rkt" + (for-syntax "private/utils.rkt")) + (provide node% edge% grid-graph) diff --git a/collects/games/doors/private/utils.rkt b/collects/games/doors/private/utils.rkt index 4243ee01ab..1d0245cb4d 100644 --- a/collects/games/doors/private/utils.rkt +++ b/collects/games/doors/private/utils.rkt @@ -1,5 +1,5 @@ -(module utils mzscheme +(module utils racket (provide alternates interleave) diff --git a/collects/games/doors/utils.rkt b/collects/games/doors/utils.rkt index 8c98ef0a76..a4a3420551 100644 --- a/collects/games/doors/utils.rkt +++ b/collects/games/doors/utils.rkt @@ -1,12 +1,9 @@ -(module utils mzscheme +(module utils racket (require sgl/gl-vectors sgl - mzlib/math - mred - mzlib/list - mzlib/etc - mzlib/class - mzlib/kw + racket/math + racket/gui + racket/class "doors.rkt") (provide door-bm @@ -106,7 +103,7 @@ (gl-end-list) list-id)))) - (define/kw (make-i-player-icon game + (define (make-i-player-icon game #:optional [data #f] #:key @@ -183,14 +180,14 @@ (gl-light-model-v 'light-model-ambient (gl-float-vector 1.0 1.0 1.0 0.0)) (gl-disable 'light0))) - (define/kw (make-key-thing-icon game + (define (make-key-thing-icon game #:optional [data #f] #:key [color yellow]) (let ([dl (make-key-dl game color)]) (send game make-thing-icon - (lambda/kw (#:optional [just-shadow? #f]) + (lambda (#:optional [just-shadow? #f]) (with-light just-shadow? (lambda () (gl-scale 0.5 0.5 0.5) (gl-call-list dl)))) diff --git a/collects/games/gcalc/gcalc-examples b/collects/games/gcalc/gcalc-examples index 4e5afe4f57..c333f52ee2 100644 --- a/collects/games/gcalc/gcalc-examples +++ b/collects/games/gcalc/gcalc-examples @@ -6,4 +6,4 @@ #f #f (#f . #f) -(("true" lambda (var green) (lambda (var red) (var green) #f) #f) ("cons" lambda (var green) (lambda (var red) (lambda (var blue) (apply (apply (var blue) (var green)) (var red))))) ("zero" lambda (var green) (lambda (var red) (var red) #f) #f) ("zero?" lambda (var blue) (apply (apply (var blue) (lambda (var red) (lambda (var green) (lambda (var red) (var red))))) (lambda (var green) (lambda (var red) (var green))))) ("sub1" lambda (var dk-green) (apply (apply (apply (var dk-green) (lambda (var magenta) (lambda (var blue) (apply (apply (var blue) (apply (var magenta) (lambda (var green) (lambda (var red) (var red))))) (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (apply (var magenta) (lambda (var green) (lambda (var red) (var red)))) (var green)) (var red))))))))) (lambda (var blue) (apply (apply (var blue) (lambda (var green) (lambda (var red) (var red)))) (lambda (var green) (lambda (var red) (var red)))))) (lambda (var green) (lambda (var red) (var green))))) ("false" lambda (var green) (lambda (var red) (var red) #f) #f) ("car" lambda (var blue) (apply (var blue) (lambda (var green) (lambda (var red) (var green))))) ("one" lambda (var green) (lambda (var red) (apply (var green) (var red)))) ("add1" lambda (var blue) (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (var blue) (var green)) (var red)))))) ("minus" lambda (var green) (lambda (var red) (apply (apply (var red) (lambda (var dk-green) (apply (apply (apply (var dk-green) (lambda (var magenta) (lambda (var blue) (apply (apply (var blue) (apply (var magenta) (lambda (var green) (lambda (var red) (var red))))) (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (apply (var magenta) (lambda (var green) (lambda (var red) (var red)))) (var green)) (var red))))))))) (lambda (var blue) (apply (apply (var blue) (lambda (var green) (lambda (var red) (var red)))) (lambda (var green) (lambda (var red) (var red)))))) (lambda (var green) (lambda (var red) (var green)))))) (var green)))) ("if" lambda (var dk-gray) (lambda (var gray) (lambda (var lt-gray) (apply (apply (var dk-gray) (var gray)) (var lt-gray))))) ("cdr" lambda (var blue) (apply (var blue) (lambda (var green) (lambda (var red) (var red))))) ("two" lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (var red) #f) #f) (var green)) (var red))))) (var green)) (var red))))) ("plus" lambda (var green) (lambda (var red) (apply (apply (var green) (lambda (var blue) (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (var blue) (var green)) (var red))))))) (var red)))) (#f . #f) ("and" lambda (var green) (lambda (var red) (apply (apply (var green) (var red)) (var green) #t) #t) #t) ("null" lambda (var green) (lambda (var green) (lambda (var red) (var green)))) ("three" lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (var red) #f) #f) (var green)) (var red))))) (var green)) (var red))))) (var green)) (var red))))) ("times" lambda (var green) (lambda (var red) (lambda (var blue) (apply (var green) (apply (var red) (var blue)))))) (#f . #f) ("or" lambda (var green) (lambda (var red) (apply (apply (var green) (var green)) (var red)))) ("null?" lambda (var green) (apply (var green) (lambda (var green) (lambda (var red) (lambda (var green) (lambda (var red) (var red))))))) ("Y-comb" lambda (var red) (apply (var red) (apply (lambda (var green) (apply (var red) (apply (var green) (var green)))) (lambda (var green) (apply (var red) (apply (var green) (var green))))) #t) #t) (#f . #f) (#f . #f) ("id" lambda (var white) (var white) #f) ("hole" lambda (var white) transparent #t) ("slicer" \| (\| (\| (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)) (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t))) (\| (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)) (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)))) (\| (\| (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)) (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t))) (\| (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)) (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t))))) (#f . #f) (#f . #f) ("\\x.x1" lambda (var gray) (/ (- (\| red (var gray) #f) (\| (var gray) green #f) #f) (- (\| (var gray) yellow #f) (\| blue (var gray) #f) #f) #f) #f) ("x1" / (- (\| red gray #f) (\| gray green #f) #f) (- (\| gray yellow #f) (\| blue gray #f) #f) #f) ("x2" / (- (\| green red) (\| red green)) (- (\| red green) (\| green red))) ("numtest (\\n.n(\\x.x1)trn)" lambda (var black) (apply (apply (var black) (lambda (var gray) (/ (- (\| red (var gray) #f) (\| (var gray) green #f) #f) (- (\| (var gray) yellow #f) (\| blue (var gray)))))) transparent)) (#f . #f) (#f . #f) (#f . #f) (#f . #f) (#f . #f) (#f . #f)) +((#f . #f) ("cons" lambda (var green) (lambda (var red) (lambda (var blue) (apply (apply (var blue) (var green)) (var red))))) ("zero" lambda (var green) (lambda (var red) (var red) #f) #f) ("zero?" lambda (var blue) (apply (apply (var blue) (lambda (var red) (lambda (var green) (lambda (var red) (var red))))) (lambda (var green) (lambda (var red) (var green))))) ("sub1" lambda (var dk-green) (apply (apply (apply (var dk-green) (lambda (var magenta) (lambda (var blue) (apply (apply (var blue) (apply (var magenta) (lambda (var green) (lambda (var red) (var red))))) (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (apply (var magenta) (lambda (var green) (lambda (var red) (var red)))) (var green)) (var red))))))))) (lambda (var blue) (apply (apply (var blue) (lambda (var green) (lambda (var red) (var red)))) (lambda (var green) (lambda (var red) (var red)))))) (lambda (var green) (lambda (var red) (var green))))) ("false" lambda (var green) (lambda (var red) (var red) #f) #f) ("car" lambda (var blue) (apply (var blue) (lambda (var green) (lambda (var red) (var green))))) ("one" lambda (var green) (lambda (var red) (apply (var green) (var red)))) ("add1" lambda (var blue) (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (var blue) (var green)) (var red)))))) ("minus" lambda (var green) (lambda (var red) (apply (apply (var red) (lambda (var dk-green) (apply (apply (apply (var dk-green) (lambda (var magenta) (lambda (var blue) (apply (apply (var blue) (apply (var magenta) (lambda (var green) (lambda (var red) (var red))))) (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (apply (var magenta) (lambda (var green) (lambda (var red) (var red)))) (var green)) (var red))))))))) (lambda (var blue) (apply (apply (var blue) (lambda (var green) (lambda (var red) (var red)))) (lambda (var green) (lambda (var red) (var red)))))) (lambda (var green) (lambda (var red) (var green)))))) (var green)))) ("if" lambda (var dk-gray) (lambda (var gray) (lambda (var lt-gray) (apply (apply (var dk-gray) (var gray)) (var lt-gray))))) ("cdr" lambda (var blue) (apply (var blue) (lambda (var green) (lambda (var red) (var red))))) ("two" lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (var red) #f) #f) (var green)) (var red))))) (var green)) (var red))))) ("plus" lambda (var green) (lambda (var red) (apply (apply (var green) (lambda (var blue) (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (var blue) (var green)) (var red))))))) (var red)))) (#f . #f) ("and" lambda (var green) (lambda (var red) (apply (apply (var green) (var red)) (var green) #t) #t) #t) ("null" lambda (var green) (lambda (var green) (lambda (var red) (var green)))) ("three" lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (apply (var green) (apply (apply (lambda (var green) (lambda (var red) (var red) #f) #f) (var green)) (var red))))) (var green)) (var red))))) (var green)) (var red))))) ("times" lambda (var green) (lambda (var red) (lambda (var blue) (apply (var green) (apply (var red) (var blue)))))) (#f . #f) ("or" lambda (var green) (lambda (var red) (apply (apply (var green) (var green)) (var red)))) ("null?" lambda (var green) (apply (var green) (lambda (var green) (lambda (var red) (lambda (var green) (lambda (var red) (var red))))))) ("Y-comb" lambda (var red) (apply (var red) (apply (lambda (var green) (apply (var red) (apply (var green) (var green)))) (lambda (var green) (apply (var red) (apply (var green) (var green))))) #t) #t) (#f . #f) (#f . #f) ("id" lambda (var white) (var white) #f) ("hole" lambda (var white) transparent #t) ("slicer" \| (\| (\| (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)) (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t))) (\| (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)) (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)))) (\| (\| (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)) (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t))) (\| (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t)) (\| (lambda (var white) (var white) #f) (lambda (var white) transparent #t))))) (#f . #f) (#f . #f) ("\\x.x1" lambda (var gray) (/ (- (\| red (var gray) #f) (\| (var gray) green #f) #f) (- (\| (var gray) yellow #f) (\| blue (var gray) #f) #f) #f) #f) ("x1" / (- (\| red gray) (\| gray green)) (- (\| gray yellow) (\| blue gray))) ("x2" / (- (\| green red) (\| red green)) (- (\| red green) (\| green red))) ("numtest (\\n.n(\\x.x1)trn)" lambda (var black) (apply (apply (var black) (lambda (var gray) (/ (- (\| red (var gray) #f) (\| (var gray) green #f) #f) (- (\| (var gray) yellow #f) (\| blue (var gray)))))) transparent)) (#f . #f) (#f . #f) (#f . #f) (#f . #f) (#f . #f) (#f . #f)) diff --git a/collects/games/gcalc/gcalc.rkt b/collects/games/gcalc/gcalc.rkt index 3d187da72d..87a4d0557c 100644 --- a/collects/games/gcalc/gcalc.rkt +++ b/collects/games/gcalc/gcalc.rkt @@ -3,9 +3,9 @@ ;;; based on http://www.grame.fr/Research/GCalcul/Graphic_Calculus.html ;;; implemented by Eli Barzilay. -#lang mzscheme +#lang racket -(require mzlib/class mred mzlib/etc "../show-scribbling.rkt" mzlib/unit) +(require racket/gui "../show-scribbling.rkt" racket/unit (only-in mzscheme fluid-let)) (provide game@) (define customs '()) @@ -335,13 +335,13 @@ ;;;============================================================================ ;;; GCalc drawing -(define transparent?-cache (make-hash-table 'weak)) +(define transparent?-cache (make-weak-hash)) (define (expr-contains-transparent? expr) (if (simple-expr? expr) (or (null-expr? expr) (eq? expr 'transparent) (and (var-expr? expr) (eq? (var-val expr) 'transparent))) - (let ([v (hash-table-get transparent?-cache expr 'unknown)]) + (let ([v (hash-ref transparent?-cache expr 'unknown)]) (if (eq? v 'unknown) (let ([v (cond [(abstraction-expr? expr) (expr-contains-transparent? (expr-2nd expr))] @@ -349,7 +349,7 @@ #t] [else (or (expr-contains-transparent? (expr-1st expr)) (expr-contains-transparent? (expr-2nd expr)))])]) - (hash-table-put! transparent?-cache expr v) + (hash-set! transparent?-cache expr v) v) v)))) @@ -555,8 +555,8 @@ gcalc-frame '(ok))))) (save-as))) (define (open-examples) - (open (path->string (build-path (this-expression-source-directory) - "gcalc-examples")))) + (open (path->string (build-path (collection-file-path "gcalc-examples" "games" "gcalc" ))))) + (define (open . file) (maybe-save) (let ([f (if (not (null? file)) diff --git a/collects/games/gl-board-game.rkt b/collects/games/gl-board-game.rkt index e59d0eae6c..3b4fc4e7fc 100644 --- a/collects/games/gl-board-game.rkt +++ b/collects/games/gl-board-game.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require "gl-board-game/gl-board.rkt") (provide (all-from-out "gl-board-game/gl-board.rkt")) diff --git a/collects/games/gl-board-game/gl-board.rkt b/collects/games/gl-board-game/gl-board.rkt index 473352200c..6cfb6e8b7c 100644 --- a/collects/games/gl-board-game/gl-board.rkt +++ b/collects/games/gl-board-game/gl-board.rkt @@ -1,16 +1,16 @@ -(module gl-board mzscheme +(module gl-board racket (require sgl sgl/gl sgl/gl-vectors - mzlib/class - mzlib/list - mred) + racket/class + racket/list + racket/gui) (provide gl-board%) - (define-struct space (draw info)) - (define-struct piece (x y z draw info enabled?)) - (define-struct heads-up (w h draw info)) + (define-struct space (draw info) #:mutable) + (define-struct piece (x y z draw info enabled?) #:mutable) + (define-struct heads-up (w h draw info) #:mutable) (define (get-info x) (cond diff --git a/collects/games/gl-board-game/main.rkt b/collects/games/gl-board-game/main.rkt index 00a08f7f9d..aca4655b06 100644 --- a/collects/games/gl-board-game/main.rkt +++ b/collects/games/gl-board-game/main.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require "gl-board.rkt") (provide (all-from-out "gl-board.rkt")) diff --git a/collects/games/gobblet/check.rkt b/collects/games/gobblet/check.rkt index 19d3e706a8..b0668214a3 100644 --- a/collects/games/gobblet/check.rkt +++ b/collects/games/gobblet/check.rkt @@ -3,10 +3,8 @@ ;; speed up future games (i.e., converts learned strategy to a compact ;; form). -(module check mzscheme +(module check racket (require mzlib/unitsig - mzlib/etc - mzlib/list "sig.rkt" "model.rkt" "explore.rkt" @@ -35,7 +33,7 @@ (let ([search (mk-search)] [cnt 0] - [move-map (make-hash-table 'equal)] + [move-map (make-hash)] [canonicalize (make-canonicalize)]) (let loop ([board empty-board] [depth 0] @@ -54,7 +52,7 @@ [else (let ([key+xform (canonicalize board 'red)]) (list-ref - (hash-table-get + (hash-ref move-map (car key+xform) (lambda () (let ([play (search 300.0 1 2 'red board history)]) @@ -105,10 +103,10 @@ (apply-xform (cdr key+xform) (list-ref play 3) (list-ref play 4)) (add1 max-depth))]) - (hash-table-put! move-map (car key+xform) l) + (hash-set! move-map (car key+xform) l) l)))))) 3))])) - (hash-table-for-each move-map + (hash-for-each move-map (lambda (k v) (when (> (list-ref v 3) 1) (printf "~s\n" (cons k v))))))) diff --git a/collects/games/gobblet/explore.rkt b/collects/games/gobblet/explore.rkt index 321915ea68..4ef29534ac 100644 --- a/collects/games/gobblet/explore.rkt +++ b/collects/games/gobblet/explore.rkt @@ -1,10 +1,8 @@ ;; This is the main search engine for auto-play. ;; See `make-search' for the main entry point. -(module explore mzscheme +(module explore racket (require mzlib/unitsig - mzlib/etc - mzlib/list "sig.rkt" "test.rkt") @@ -42,7 +40,7 @@ ;; with `make-plan', described below. (define (make-search make-rate-board make-canned-moves) ;; Long-term memory (i.e., spans searches) - (define init-memory (make-hash-table 'equal)) + (define init-memory (make-hash)) (define canonicalize (make-canonicalize)) (define rate-board (make-rate-board canonicalize)) (define canned-moves (make-canned-moves canonicalize init-memory)) @@ -60,15 +58,15 @@ [once-sema (make-semaphore)] [result-sema (make-semaphore)] ;; Short-term memory (i.e., discarded after this search) - [memory (make-hash-table 'equal)]) + [memory (make-hash)]) ;; Record game-history boards as loop ties (let loop ([history history][me (other me)]) (unless (null? history) (let ([key+xform (canonicalize (car history) me)]) - (hash-table-put! memory (car key+xform) LOOP-TIE)) + (hash-set! memory (car key+xform) LOOP-TIE)) (loop (cdr history) (other me)))) ;; Copy canned and learned info into short-term memory: - (hash-table-for-each init-memory (lambda (k v) (hash-table-put! memory k v))) + (hash-for-each init-memory (lambda (k v) (hash-set! memory k v))) ;; Search in a background thread: (let ([t (thread (lambda () @@ -119,7 +117,7 @@ ;; the board), the destination position, a xform inidcating how to ;; transform the positions into canonical positions, and a number ;; that estimates how many more steps until the end of game. - (define-struct plan (size from-i from-j to-i to-j xform turns)) + (define-struct plan (size from-i from-j to-i to-j xform turns) #:mutable) ;; apply-play : board play -> board ;; A play is (list piece from-i from-j to-i to-j turns) @@ -254,32 +252,32 @@ (let ([choices (cond ;; Check for known win/loss at arbitrary depth: - [(hash-table-get (config-memory config) board-key (lambda () #f)) + [(hash-ref (config-memory config) board-key (lambda () #f)) => (lambda (x) x)] ;; Check for known result at specific remaining depth: - [(hash-table-get (config-memory config) key (lambda () #f)) + [(hash-ref (config-memory config) key (lambda () #f)) => (lambda (x) x)] ;; Check for immediate loss (only rating matters; plan is never used) [(winner? board (other me)) - (hash-table-put! (config-memory config) board-key '((-inf.0))) + (hash-set! (config-memory config) board-key '((-inf.0))) '((-inf.0))] ;; Check for immediate loss (only rating matters) [(winner? board me) - (hash-table-put! (config-memory config) board-key '((+inf.0))) + (hash-set! (config-memory config) board-key '((+inf.0))) '((+inf.0))] ;; Check for depth [(depth . >= . (config-max-depth config)) (set! depth-count (add1 depth-count)) (let ([l (list (list ((config-rate-board config) board me last-to-i last-to-j)))]) - (hash-table-put! (config-memory config) key l) + (hash-set! (config-memory config) key l) l)] ;; Otherwise, we explore this state... [else (set! depth-count (add1 depth-count)) (set! explore-count (add1 explore-count)) ;; In case we get back here while we're looking, claim an unknown tie: - (hash-table-put! (config-memory config) board-key LOOP-TIE) + (hash-set! (config-memory config) board-key LOOP-TIE) (let* ([choices (map (lambda (g) ;; Make sure each canned move is in our coordinate system: @@ -300,14 +298,14 @@ '((-inf.0)) ;; We have at least one move choices)]) - (hash-table-remove! (config-memory config) board-key) + (hash-remove! (config-memory config) board-key) (let ([key (if (and ((caar choices) . < . +inf.0) ((caar choices) . > . -inf.0)) ;; Result is only valid to current depth limit: key ;; Win or loss: result is valid to any depth: board-key)]) - (hash-table-put! (config-memory config) key choices) + (hash-set! (config-memory config) key choices) choices))])]) (values choices xform)))) @@ -552,7 +550,7 @@ (when (or (found-win? plays) (found-lose? plays)) (let ([board-key+xform ((config-canonicalize config) board me)]) - (hash-table-get init-memory + (hash-ref init-memory (car board-key+xform) (lambda () ;; This is new... @@ -580,7 +578,7 @@ (let ([v (read)]) (unless (eof-object? v) (let ([board-key+xform (canonicalize (cadr v) #f)]) - (hash-table-put! init-memory + (hash-set! init-memory (car board-key+xform) (list (cons (if (eq? 'win (car v)) +inf.0 -inf.0) diff --git a/collects/games/gobblet/gobblet.rkt b/collects/games/gobblet/gobblet.rkt index 883245c024..2441dd9b82 100644 --- a/collects/games/gobblet/gobblet.rkt +++ b/collects/games/gobblet/gobblet.rkt @@ -1,8 +1,8 @@ -#lang mzscheme +#lang racket (require mzlib/unitsig - (only mzlib/unit unit import export) - mzlib/file - mred + (only-in racket/unit unit import export) + racket/file + (except-in racket/gui define-signature provide-signature-elements) "sig.rkt" "model.rkt" "gui.rkt" diff --git a/collects/games/gobblet/gui.rkt b/collects/games/gobblet/gui.rkt index 5611090bc4..58e37c1383 100644 --- a/collects/games/gobblet/gui.rkt +++ b/collects/games/gobblet/gui.rkt @@ -1,8 +1,7 @@ -(module gui mzscheme +(module gui racket (require games/gl-board-game/gl-board - mzlib/class - mred - mzlib/file + racket/class + (except-in racket/gui define-signature provide-signature-elements) sgl/gl-vectors sgl mzlib/unitsig diff --git a/collects/games/gobblet/heuristics.rkt b/collects/games/gobblet/heuristics.rkt index a3361c0358..0e366b6cd4 100644 --- a/collects/games/gobblet/heuristics.rkt +++ b/collects/games/gobblet/heuristics.rkt @@ -1,10 +1,8 @@ ;; Supplies canned moves and board-rating functions for the state ;; explorer. -(module heuristics mzscheme +(module heuristics racket (require mzlib/unitsig - mzlib/etc - mzlib/list "sig.rkt" "plays-3x3.rkt") @@ -19,7 +17,7 @@ ;; a perfect red player. (for-each (lambda (play) (let ([key+xform (canonicalize (list->bytes (vector->list (car play))) #f)]) - (hash-table-put! init-memory + (hash-set! init-memory (car key+xform) (let-values ([(from-i from-j) (if (list-ref play 2) diff --git a/collects/games/gobblet/model.rkt b/collects/games/gobblet/model.rkt index 32ff79717f..8c026002d3 100644 --- a/collects/games/gobblet/model.rkt +++ b/collects/games/gobblet/model.rkt @@ -1,4 +1,4 @@ -(module model mzscheme +(module model racket (require "sig.rkt" mzlib/unitsig) @@ -26,8 +26,8 @@ ;; piece to a stack with this piece on top. (define-struct piece (size color gobble-table)) - (define red-pieces (map (lambda (sz) (make-piece sz 'red (make-hash-table))) SIZES)) - (define yellow-pieces (map (lambda (sz) (make-piece sz 'yellow (make-hash-table))) SIZES)) + (define red-pieces (map (lambda (sz) (make-piece sz 'red (make-hasheq))) SIZES)) + (define yellow-pieces (map (lambda (sz) (make-piece sz 'yellow (make-hasheq))) SIZES)) ;; Fill in stacks for pieces. By building each possible ;; stack once, we avoid allocating redudant stacks, and @@ -48,7 +48,7 @@ (map (lambda (p) (map (lambda (stack) (let ([new-stack (cons p stack)]) - (hash-table-put! (piece-gobble-table p) stack new-stack) + (hash-set! (piece-gobble-table p) stack new-stack) new-stack)) prev-stacks)) (list (car red-pieces) @@ -134,7 +134,7 @@ ;; gobble : piece (listof piece) -> (listof piece) (define (gobble p l) - (hash-table-get (piece-gobble-table p) l)) + (hash-ref (piece-gobble-table p) l)) ;; - - - - - - - - - - - - - - - - - - @@ -377,54 +377,54 @@ (define flatten-board (if (= BOARD-SIZE 3) (lambda (board stack-ids) - (bytes (hash-table-get stack-ids (board-ref board 0 0)) - (hash-table-get stack-ids (board-ref board 1 0)) - (hash-table-get stack-ids (board-ref board 2 0)) - (hash-table-get stack-ids (board-ref board 0 1)) - (hash-table-get stack-ids (board-ref board 1 1)) - (hash-table-get stack-ids (board-ref board 2 1)) - (hash-table-get stack-ids (board-ref board 0 2)) - (hash-table-get stack-ids (board-ref board 1 2)) - (hash-table-get stack-ids (board-ref board 2 2)))) + (bytes (hash-ref stack-ids (board-ref board 0 0)) + (hash-ref stack-ids (board-ref board 1 0)) + (hash-ref stack-ids (board-ref board 2 0)) + (hash-ref stack-ids (board-ref board 0 1)) + (hash-ref stack-ids (board-ref board 1 1)) + (hash-ref stack-ids (board-ref board 2 1)) + (hash-ref stack-ids (board-ref board 0 2)) + (hash-ref stack-ids (board-ref board 1 2)) + (hash-ref stack-ids (board-ref board 2 2)))) (lambda (board stack-ids) - (bytes (hash-table-get stack-ids (board-ref board 0 0)) - (hash-table-get stack-ids (board-ref board 1 0)) - (hash-table-get stack-ids (board-ref board 2 0)) - (hash-table-get stack-ids (board-ref board 3 0)) - (hash-table-get stack-ids (board-ref board 0 1)) - (hash-table-get stack-ids (board-ref board 1 1)) - (hash-table-get stack-ids (board-ref board 2 1)) - (hash-table-get stack-ids (board-ref board 3 1)) - (hash-table-get stack-ids (board-ref board 0 2)) - (hash-table-get stack-ids (board-ref board 1 2)) - (hash-table-get stack-ids (board-ref board 2 2)) - (hash-table-get stack-ids (board-ref board 3 2)) - (hash-table-get stack-ids (board-ref board 0 3)) - (hash-table-get stack-ids (board-ref board 1 3)) - (hash-table-get stack-ids (board-ref board 2 3)) - (hash-table-get stack-ids (board-ref board 3 3)))))) + (bytes (hash-ref stack-ids (board-ref board 0 0)) + (hash-ref stack-ids (board-ref board 1 0)) + (hash-ref stack-ids (board-ref board 2 0)) + (hash-ref stack-ids (board-ref board 3 0)) + (hash-ref stack-ids (board-ref board 0 1)) + (hash-ref stack-ids (board-ref board 1 1)) + (hash-ref stack-ids (board-ref board 2 1)) + (hash-ref stack-ids (board-ref board 3 1)) + (hash-ref stack-ids (board-ref board 0 2)) + (hash-ref stack-ids (board-ref board 1 2)) + (hash-ref stack-ids (board-ref board 2 2)) + (hash-ref stack-ids (board-ref board 3 2)) + (hash-ref stack-ids (board-ref board 0 3)) + (hash-ref stack-ids (board-ref board 1 3)) + (hash-ref stack-ids (board-ref board 2 3)) + (hash-ref stack-ids (board-ref board 3 3)))))) ;; Generate a numerical ID for each stack. This numerical ;; ID must stay constant for all of time, because we ;; record boards in compact form using these numbers. ;; (For example, see "plays-3x3.rkt".) - (define red-stack-ids (make-hash-table)) - (define yellow-stack-ids (make-hash-table)) + (define red-stack-ids (make-hasheq)) + (define yellow-stack-ids (make-hasheq)) (for-each (lambda (s) - (hash-table-put! red-stack-ids s (hash-table-count red-stack-ids))) + (hash-set! red-stack-ids s (hash-count red-stack-ids))) all-stacks) (for-each (lambda (s) (let ([inverse (let loop ([s s]) (if (null? s) null - (hash-table-get (piece-gobble-table + (hash-ref (piece-gobble-table (if (eq? (piece-color (car s)) 'red) (list-ref yellow-pieces (piece-size (car s))) (list-ref red-pieces (piece-size (car s))))) (loop (cdr s)))))]) - (hash-table-put! yellow-stack-ids s (hash-table-get red-stack-ids inverse)))) + (hash-set! yellow-stack-ids s (hash-ref red-stack-ids inverse)))) all-stacks) ;; Applies an appropriate flattener @@ -439,21 +439,21 @@ ;; xform for getting from the given board's locations to ;; locations in the canonical board. (define (make-canonicalize) - (let ([memory (make-hash-table 'equal)]) + (let ([memory (make-hash)]) ;; Convert the board into a byte string, normalizing player: (lambda (board who) (let ([v (if who (compact-board board who) board)]) ;; Find canonical mapping. - (hash-table-get + (hash-ref memory v (lambda () (let* ([pr (cons v (car xforms))]) - (hash-table-put! memory v pr) + (hash-set! memory v pr) ;; Add each equivalent to table: (for-each (lambda (xform xform-proc) - (hash-table-put! memory (xform-proc v) (cons v xform))) + (hash-set! memory (xform-proc v) (cons v xform))) (cdr xforms) (cdr xform-procs)) pr))))))) diff --git a/collects/games/gobblet/plays-3x3.rkt b/collects/games/gobblet/plays-3x3.rkt index b86a6919f5..4026773a3d 100644 --- a/collects/games/gobblet/plays-3x3.rkt +++ b/collects/games/gobblet/plays-3x3.rkt @@ -1,4 +1,4 @@ -(module plays-3x3 mzscheme +(module plays-3x3 racket (provide 3x3-plays) (define 3x3-plays ;; This list is generated by "check.rkt". diff --git a/collects/games/gobblet/robot.rkt b/collects/games/gobblet/robot.rkt index 42a5b66cd7..e8ef0a9e3e 100644 --- a/collects/games/gobblet/robot.rkt +++ b/collects/games/gobblet/robot.rkt @@ -1,9 +1,7 @@ ;; Plays automatic games, often useful when learning is enabled in "explore.rkt" -(module robot mzscheme +(module robot racket (require mzlib/unitsig - mzlib/etc - mzlib/list "sig.rkt" "model.rkt" "explore.rkt" diff --git a/collects/games/gobblet/sig.rkt b/collects/games/gobblet/sig.rkt index 6a8832e15b..5825356e86 100644 --- a/collects/games/gobblet/sig.rkt +++ b/collects/games/gobblet/sig.rkt @@ -1,4 +1,4 @@ -(module sig mzscheme +(module sig racket (require mzlib/unitsig) (provide config^ diff --git a/collects/games/gobblet/test-explore.rkt b/collects/games/gobblet/test-explore.rkt index 2fe390a897..24c7ea91ed 100644 --- a/collects/games/gobblet/test-explore.rkt +++ b/collects/games/gobblet/test-explore.rkt @@ -1,7 +1,5 @@ -(module test-explore mzscheme +(module test-explore racket (require mzlib/unitsig - mzlib/etc - mzlib/list "sig.rkt" "model.rkt" "explore.rkt" diff --git a/collects/games/gobblet/test-model.rkt b/collects/games/gobblet/test-model.rkt index f14fa6b109..0916675c57 100644 --- a/collects/games/gobblet/test-model.rkt +++ b/collects/games/gobblet/test-model.rkt @@ -1,16 +1,14 @@ ;; Some tests for the model -(module test-model mzscheme +(module test-model racket (require mzlib/unitsig - mzlib/etc - mzlib/list "sig.rkt" "model.rkt" "test.rkt") ;; Test basic procs: (define (test-folding n) - (begin-with-definitions + (define BOARD-SIZE n) (define-values/invoke-unit/sig model^ model-unit #f config^) @@ -32,13 +30,12 @@ (lambda (a b) (if (= (car a) (car b)) (< (cdr a) (cdr b)) - (< (car a) (car b)))))))) + (< (car a) (car b))))))) (test-folding 3) (test-folding 4) ;; Test available-off-board for 3x3: (let () - (begin-with-definitions (define BOARD-SIZE 3) (define-values/invoke-unit/sig model^ model-unit #f config^) @@ -53,11 +50,11 @@ (test '((2 2) (1) (0 0)) (available-off-board b3 'yellow)) (let ([b4 (move b3 (list-ref red-pieces 2) #f #f 0 1 values void)]) (test '((1 1) (0 0)) (available-off-board b4 'red)) - (test '((2 2) (1) (0 0)) (available-off-board b4 'yellow))))))) + (test '((2 2) (1) (0 0)) (available-off-board b4 'yellow)))))) ;; Test available-off-board for 4x4: (let () - (begin-with-definitions + (define BOARD-SIZE 4) (define-values/invoke-unit/sig model^ model-unit #f config^) @@ -78,16 +75,16 @@ (let ([b5 (move b4 (list-ref red-pieces 3) #f #f 0 3 values void)]) (test '((3 2 1 0) (2 1 0) (1 0)) (available-off-board b5 'red)) (let ([b6 (move b5 (list-ref red-pieces 2) #f #f 3 3 values void)]) - (test '((3 2 1 0) (1 0) (1 0)) (available-off-board b6 'red))))))))) + (test '((3 2 1 0) (1 0) (1 0)) (available-off-board b6 'red)))))))) - (define x-table (make-hash-table 'equal)) + (define x-table (make-hash)) (define (testx id board) - (test id (hash-table-get x-table board + (test id (hash-ref x-table board (lambda () - (when (hash-table-get x-table id (lambda () #f)) + (when (hash-ref x-table id (lambda () #f)) (error 'testx "id already mapped\n")) - (hash-table-put! x-table id #t) - (hash-table-put! x-table board id) + (hash-set! x-table id #t) + (hash-set! x-table board id) id)))) ;; Given a canonicalize function, a board, the current player, @@ -153,7 +150,7 @@ (car key+xform))) ;; Test canonicalization, 3x3 - (begin-with-definitions +(let () (define BOARD-SIZE 3) (define-values/invoke-unit/sig model^ model-unit #f config^) @@ -185,10 +182,10 @@ (testx 27 (c b5 'red)) (testx 35 (c b5 'yellow))))))))) - (set! x-table (make-hash-table 'equal)) + (set! x-table (make-hash)) ;; Test canonicalization, 4x4 - (begin-with-definitions + (define BOARD-SIZE 4) (define-values/invoke-unit/sig model^ model-unit #f config^) @@ -213,7 +210,7 @@ (testx 13 (c b2 'yellow)) (let ([b3 (move b2 (list-ref yellow-pieces 1) #f #f 1 0 values void)]) (testx 17 (c b3 'red)) - (testx 25 (c b3 'yellow)))))))) + (testx 25 (c b3 'yellow))))))) (define (basic-tests size xform 4x4-finish-pos) ;; When xform is the identity, then we build toward @@ -223,7 +220,7 @@ ;; - - - - ;; The xform changes the cooridnate system so that we ;; test rows and columns in addition to this diagonal. - (begin-with-definitions + (define BOARD-SIZE size) (define-values (i00 j00) (xform 0 0)) @@ -359,7 +356,7 @@ 4x4-finish-pos) ;; 4 x 4 game: now red can cover small yellow, because it's ;; part of 3 in a row - (begin-with-definitions + (test #t (3-in-a-row? b7.2 i20 j20 'yellow)) (test #f (3-in-a-row? b7.2 i20 j20 'red)) @@ -375,7 +372,7 @@ (define b8.2x (move b7.2 med-yellow #f #f (car 4x4-finish-pos) (cdr 4x4-finish-pos) values void)) (test #f (winner? b8.2x 'red)) - (test #t (winner? b8.2x 'yellow)))))) + (test #t (winner? b8.2x 'yellow)))) (define (rotate i j) (case i diff --git a/collects/games/gobblet/test.rkt b/collects/games/gobblet/test.rkt index c9336c4ead..dfacda545f 100644 --- a/collects/games/gobblet/test.rkt +++ b/collects/games/gobblet/test.rkt @@ -1,5 +1,5 @@ -(module test mzscheme +(module test racket (provide test report-test-results) (define failed? #f) diff --git a/collects/games/gofish/gofish.rkt b/collects/games/gofish/gofish.rkt index fbe2c94fc0..034bfb7723 100644 --- a/collects/games/gofish/gofish.rkt +++ b/collects/games/gofish/gofish.rkt @@ -1,5 +1,5 @@ -#lang mzscheme -(require games/cards mred mzlib/class mzlib/unit mzlib/list) +#lang racket +(require games/cards racket/gui racket/class racket/unit) (provide game@) (define game@ (unit (import) (export) @@ -7,7 +7,7 @@ ;; Player record (define-struct player (r hand-r discard-r count-r ; regions hand discarded ; cards - tried)) ; memory for simulating players + tried) #:mutable) ; memory for simulating players ;; Player names (define PLAYER-1-NAME "Opponent 1") diff --git a/collects/games/info.rkt b/collects/games/info.rkt index f6727d7ffc..a11cb45de7 100644 --- a/collects/games/info.rkt +++ b/collects/games/info.rkt @@ -2,5 +2,5 @@ (define scribblings '(("scribblings/games.scrbl" (multi-page) (gui-library)))) -(define mred-launcher-libraries (list "main.rkt")) -(define mred-launcher-names (list "PLT Games")) +(define racket-gui-launcher-libraries (list "main.rkt")) +(define racket-gui-launcher-names (list "PLT Games")) diff --git a/collects/games/jewel/array.scm b/collects/games/jewel/array.rkt similarity index 96% rename from collects/games/jewel/array.scm rename to collects/games/jewel/array.rkt index df64d89150..dd6a956f2d 100644 --- a/collects/games/jewel/array.scm +++ b/collects/games/jewel/array.rkt @@ -1,6 +1,6 @@ ; -*- Scheme -*- -(module array mzscheme +(module array racket (provide array-make array-ref array-set! array-mult array-mult-vector @@ -89,7 +89,7 @@ (do ((i 1 (+ i 1))) ((= i n)) (set! j2 0) (do ((j 0 (+ j 1))) ((= j n)) - (if (not (= j j1)) + (when (not (= j j1)) (begin (array-set! m (- i 1) j2 (array-ref a i j)) (set! j2 (+ j2 1)) @@ -120,11 +120,11 @@ (jj 0) ) (do ((i 0 (+ i 1))) ((= i n)) - (if (not (= i in)) + (when (not (= i in)) (begin (set! jj 0) (do ((j 0 (+ j 1))) ((= j n)) - (if (not (= j jn)) + (when (not (= j jn)) (begin (array-set! m ii jj (array-ref a i j)) (set! jj (+ jj 1)) diff --git a/collects/games/jewel/info.rkt b/collects/games/jewel/info.rkt index 246f32da58..8f42b1cde3 100644 --- a/collects/games/jewel/info.rkt +++ b/collects/games/jewel/info.rkt @@ -1,4 +1,4 @@ #lang setup/infotab -(define game "jewel.scm") +(define game "jewel.rkt") (define game-set "Puzzle Games") diff --git a/collects/games/jewel/jewel.scm b/collects/games/jewel/jewel.rkt similarity index 93% rename from collects/games/jewel/jewel.scm rename to collects/games/jewel/jewel.rkt index ca6dd0d019..d8de976193 100644 --- a/collects/games/jewel/jewel.scm +++ b/collects/games/jewel/jewel.rkt @@ -1,20 +1,19 @@ ; FIXME: ; - object rotation axis could be random per type -(module jewel mzscheme +(module jewel racket - (require mzlib/unit - mzlib/string - mzlib/class - mzlib/file - mred + (require racket/unit + racket/class + racket/file + racket/gui sgl/gl sgl/gl-vectors - (only sgl/sgl get-gl-version-number) - "shapes.scm" - "array.scm" - "text.scm" - "../show-scribbling.ss" + (only-in sgl/sgl get-gl-version-number) + "shapes.rkt" + "array.rkt" + "text.rkt" + "../show-scribbling.rkt" ) (provide game@) @@ -189,7 +188,7 @@ ( (or (eq? c #\h) (eq? c #\H)) (show-jewel-help) ) ( (or (eq? c #\p) (eq? c #\P)) - (if (equal? gamestate 'PLAYING) + (when (equal? gamestate 'PLAYING) (begin (set! freeze (not freeze)) (if freeze @@ -285,7 +284,7 @@ (define/override (on-paint) (with-gl-context (lambda () - (if (and initialised expose) + (when (and initialised expose) (expose) ) (swap-gl-buffers) @@ -296,7 +295,7 @@ (define/override (on-size width height) (with-gl-context (lambda () - (if (not initialised) + (when (not initialised) (begin (realize) (set! initialised #t) @@ -339,49 +338,49 @@ (move (vector-ref move-db (+ iy 2))) (type (random 7)) ) - (hash-table-put! elem 'type type ) - (hash-table-put! elem 'angle (random 360) ) - (hash-table-put! elem 'ax 0.0 ) - (hash-table-put! elem 'ay 1.0 ) - (hash-table-put! elem 'az 0.0 ) - (hash-table-put! elem 'fall 0.0 ) - (hash-table-put! elem 'speed 0.0 ) - (hash-table-put! elem 'vanish 1.0 ) - (hash-table-put! elem 'dx 0.0 ) - (hash-table-put! elem 'dy 0.0 ) - (hash-table-put! elem 'swapping 0 ) + (hash-set! elem 'type type ) + (hash-set! elem 'angle (random 360) ) + (hash-set! elem 'ax 0.0 ) + (hash-set! elem 'ay 1.0 ) + (hash-set! elem 'az 0.0 ) + (hash-set! elem 'fall 0.0 ) + (hash-set! elem 'speed 0.0 ) + (hash-set! elem 'vanish 1.0 ) + (hash-set! elem 'dx 0.0 ) + (hash-set! elem 'dy 0.0 ) + (hash-set! elem 'swapping 0 ) (cond ; one color per type ; one shape for all type ( (= jewel-difficulty 1) - (hash-table-put! elem 'color type) - (hash-table-put! elem 'shape diff-shape) + (hash-set! elem 'color type) + (hash-set! elem 'shape diff-shape) ) ; one color for all type ; one shape per type ( (= jewel-difficulty 2) - (hash-table-put! elem 'color diff-color) - (hash-table-put! elem 'shape type) + (hash-set! elem 'color diff-color) + (hash-set! elem 'shape type) ) ; one color per type ; random shape ( (= jewel-difficulty 3) - (hash-table-put! elem 'color type) - (hash-table-put! elem 'shape (random 7)) + (hash-set! elem 'color type) + (hash-set! elem 'shape (random 7)) ) ; random color ; one shape per type ( (= jewel-difficulty 4) - (hash-table-put! elem 'color (random 7)) - (hash-table-put! elem 'shape type) + (hash-set! elem 'color (random 7)) + (hash-set! elem 'shape type) ) ; default ; one color per type ; one shape per type ( else - (hash-table-put! elem 'color type) - (hash-table-put! elem 'shape type) + (hash-set! elem 'color type) + (hash-set! elem 'shape type) ) ) @@ -406,7 +405,7 @@ (vector-set! element-db iy row) (do ((ix 0 (+ ix 1))) ((= ix ex)) (let* - ( (elem (make-hash-table 'equal)) ) + ( (elem (make-hash)) ) (vector-set! row ix elem) (element-init iy ix) ) @@ -417,7 +416,7 @@ (define (element-get iy ix prop) - (hash-table-get (vector-ref (vector-ref element-db iy) ix) + (hash-ref (vector-ref (vector-ref element-db iy) ix) prop (lambda () #f)) ) @@ -425,7 +424,7 @@ (define (element-set! iy ix prop value) (let* ( (elem (vector-ref (vector-ref element-db iy) ix)) ) - (hash-table-put! elem prop value) + (hash-set! elem prop value) ) ) @@ -455,9 +454,9 @@ ( (elem1 (vector-ref (vector-ref element-db iy) ix)) (elem2 (vector-ref (vector-ref element-db jy) jx)) ) - (hash-table-for-each + (hash-for-each elem1 - (lambda (key val) (hash-table-put! elem2 key val)) + (lambda (key val) (hash-set! elem2 key val)) ) ; move array (array-set! move-db (+ jy 2) (+ jx 2) @@ -470,38 +469,38 @@ ; score number handling functions ; ----------------------------------------------------------------- - (define score-numbers (make-hash-table 'equal)) + (define score-numbers (make-hash)) (define score-key 0) (define score-fade 0.01) (define (score-add x y z fade value) (let* - ( (elem (make-hash-table 'equal)) ) - (hash-table-put! elem 'x x) - (hash-table-put! elem 'y y) - (hash-table-put! elem 'z z) - (hash-table-put! elem 'fade fade) - (hash-table-put! elem 'value value) + ( (elem (make-hash)) ) + (hash-set! elem 'x x) + (hash-set! elem 'y y) + (hash-set! elem 'z z) + (hash-set! elem 'fade fade) + (hash-set! elem 'value value) - (hash-table-put! score-numbers score-key elem) + (hash-set! score-numbers score-key elem) (set! score-key (+ score-key 1)) ) ) (define (score-set! elem prop val) - (hash-table-put! elem prop val) + (hash-set! elem prop val) ) (define (score-del! score-key) - (hash-table-remove! score-numbers score-key) + (hash-remove! score-numbers score-key) ) (define (score-get elem prop) - (hash-table-get elem prop) + (hash-ref elem prop) ) (define (score-for-each proc table) - (hash-table-for-each + (hash-for-each table (lambda (key val) (proc key val)) ) @@ -528,9 +527,9 @@ ) ) (set! idx (- idx 1)) ) - (if (>= idx 0) + (when (>= idx 0) (begin - (if (or empty + (when (or empty (and (not empty) (> (- last idx) 0)) ) (set! slist (cons (substring str idx last) slist)) ) @@ -581,7 +580,7 @@ (do ((i 0 (+ i 1))) ((or exit? (= i (vector-length high-scores)))) (set! score (vector-ref high-scores i)) - (if (> jewel-score (string->number (list-ref score 1))) + (when (> jewel-score (string->number (list-ref score 1))) (begin (do ((j (- (vector-length high-scores) 1) (- j 1))) ((= j i)) @@ -709,7 +708,7 @@ (do ((i 0 (+ i 1))) ((= i (vector-length levels))) (glTranslatef 0.0 -1.8 0.0) (glPushMatrix) - (if (= (remainder i 2) 0) + (when (= (remainder i 2) 0) (string-draw (number->string (/ i 2)) ) ) (glTranslatef highxname 0.0 0.0) @@ -757,7 +756,7 @@ (set! jewel-score 0) (set! jewel-level 0) (set! jewel-nmoves 0) - (set! score-numbers (make-hash-table 'equal)) + (set! score-numbers (make-hash)) (set! gamestate 'GAME-OVER) ;read high scores @@ -895,10 +894,10 @@ (do ((iy (- ey 1) (- iy 1))) ((< iy 0)) (do ((ix 0 (+ ix 1))) ((= ix ex)) - (if (= (element-get iy ix 'vanish) 0.0) + (when (= (element-get iy ix 'vanish) 0.0) (let ( (finished -1) ) (do ((k (- iy 1) (- k 1))) ((or (< k 0) (> finished -1))) - (if (not (= (element-get k ix 'vanish) 0.0)) + (when (not (= (element-get k ix 'vanish) 0.0)) (set! finished k) ) ) @@ -935,7 +934,7 @@ (set! jewel-score (+ jewel-score value)) (set! jewel-stage (+ jewel-stage len)) (set! jewel-life (+ jewel-life (* value credit))) - (if (>= jewel-stage nextlevel) + (when (>= jewel-stage nextlevel) (begin (set! jewel-stage (- jewel-stage nextlevel)) (set! jewel-level (+ jewel-level 1)) @@ -949,7 +948,7 @@ (define (declife) (unless (eq? gamestate 'GAME-OVER) (set! jewel-life (- jewel-life jewel-decay)) - (if (< jewel-life 0.0) + (when (< jewel-life 0.0) (let* ( (score #f) (exit? #f) ) ; set life points to zero (set! jewel-life 0.0) @@ -981,7 +980,7 @@ (if (>= identical 3) (begin (set! hadsome #t) - (if (not checking) + (when (not checking) (let* ( (x (- ix 1 (/ identical 2.0))) (y (+ iy 0.5)) @@ -1017,7 +1016,7 @@ (if (>= identical 3) (begin (set! hadsome #t) - (if (not checking) + (when (not checking) (let* ( (x ix) (y (- iy 0.5 (/ identical 2.0))) @@ -1077,7 +1076,7 @@ ; check for all combination (do ((iy 0 (+ iy 1))) ((= iy ey)) (do ((ix 0 (+ ix 1))) ((= ix ex)) - (if (not (= (element-get iy ix 'type) + (when (not (= (element-get iy ix 'type) (array-ref move-db (+ iy 2) (+ ix 2)))) (begin (display "wrong iy: ")(display iy) @@ -1087,7 +1086,7 @@ ; all 16, possible combinations (do ((k 0 (+ k 1))) ((= k 16)) (set! type (array-ref move-db (+ iy 2) (+ ix 2))) - (if (and (= type (array-ref move-db + (when (and (= type (array-ref move-db (+ iy 2 (array-ref chkpos k 1)) (+ ix 2 (array-ref chkpos k 0)))) (= type (array-ref move-db @@ -1144,7 +1143,7 @@ (case action-mode ( (ACTION-LOOKING) - (if (equal? gamestate 'PLAYING) + (when (equal? gamestate 'PLAYING) (if (findwins #f) (set! action-mode 'ACTION-REMOVING) ; check if any move is possible at all ??? @@ -1167,17 +1166,17 @@ ) ) ( (ACTION-WAITING) - (if (equal? gamestate 'PLAYING) + (when (equal? gamestate 'PLAYING) (begin (declife) - (if tryswap? + (when tryswap? (set! action-mode 'ACTION-SWAPPING) ) ) ) ) ( (ACTION-SWAPPING ACTION-UNSWAPPING) - (if (equal? action-mode 'ACTION-UNSWAPPING) + (when (equal? action-mode 'ACTION-UNSWAPPING) (declife) ) (set! tryswap? #f) @@ -1188,7 +1187,7 @@ (do ((iy 0 (+ iy 1))) ((= iy ey)) (do ((ix 0 (+ ix 1))) ((= ix ex)) (set! swap (element-get iy ix 'swapping)) - (if (not (= swap 0)) + (when (not (= swap 0)) (begin (set! hadsome 1) (set! swap (+ swap 1)) @@ -1210,7 +1209,7 @@ ) ) - (if (= hadsome 2) + (when (= hadsome 2) (cond ( (findwins #f) (set! locked? #f) @@ -1248,7 +1247,7 @@ (do ((iy 0 (+ iy 1))) ((= iy ey)) (do ((ix 0 (+ ix 1))) ((= ix ex)) (set! vanish (element-get iy ix 'vanish)) - (if (< vanish 1.0) + (when (< vanish 1.0) (begin (set! vanish (- vanish vanishrate)) (if (< vanish 0.0) @@ -1262,7 +1261,7 @@ ) ) ) - (if (> hadsome 0) + (when (> hadsome 0) (begin (replace) (set! action-mode 'ACTION-DROPPING) @@ -1281,7 +1280,7 @@ (do ((iy 0 (+ iy 1))) ((= iy ey)) (do ((ix 0 (+ ix 1))) ((= ix ex)) (set! fall (element-get iy ix 'fall)) - (if (> fall 0.0) + (when (> fall 0.0) (begin (set! hadsome (+ hadsome 1)) (set! fall (- fall (element-get iy ix 'speed))) @@ -1298,7 +1297,7 @@ ) ) ) - (if (= hadsome 0) + (when (= hadsome 0) (set! action-mode 'ACTION-LOOKING) ) ); end of let @@ -1411,7 +1410,7 @@ (glLightfv GL_LIGHT1 GL_POSITION (vector->gl-float-vector light1pos)) (glLightfv GL_LIGHT2 GL_POSITION (vector->gl-float-vector light2pos)) - (if (equal? gamestate 'PLAYING) + (when (equal? gamestate 'PLAYING) (show-life) ) @@ -1443,7 +1442,7 @@ (set! nx (+ x shiftx)) (set! ny y) (set! nz (* (- 1.0 (element-get iy ix 'vanish)) 50.0)) - (if (not (= (element-get iy ix 'swapping) 0)) + (when (not (= (element-get iy ix 'swapping) 0)) (begin (set! ang (/ (* (element-get iy ix 'swapping) 3.1415927) 2.0 @@ -1452,7 +1451,7 @@ (set! nx (+ nx (* s (element-get iy ix 'dx)))) (set! ny (+ ny (* s (element-get iy ix 'dy)))) (set! s (* t (sin (* ang 2.0)))) - (if (= (remainder counter 2) 1) + (when (= (remainder counter 2) 1) (set! s (- s)) ) (set! counter (+ counter 1)) @@ -1466,7 +1465,7 @@ (set! yt ny) (set! zt nz) - (if (and (equal? gamestate 'PLAYING) + (when (and (equal? gamestate 'PLAYING) (= cposx ix) (= cposy iy)) (begin (glEnable GL_LIGHT2) @@ -1484,7 +1483,7 @@ (glPopMatrix) - (if (and (equal? gamestate 'PLAYING) + (when (and (equal? gamestate 'PLAYING) (= cposx ix) (= cposy iy)) (glDisable GL_LIGHT2) ) @@ -1589,11 +1588,11 @@ (glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE (vector->gl-float-vector (vector-ref color-map 6))) ; if not playing cover with dim square - (if (equal? gamestate 'GAME-OVER) + (when (equal? gamestate 'GAME-OVER) (high-score-render) ) - (if (equal? gamestate 'DIFFICULTY) + (when (equal? gamestate 'DIFFICULTY) (difficulty-render) ) ) @@ -1729,7 +1728,7 @@ ; we are playing, ; no action is happening ; and mouse is moved, so try to swap - (if (and isdown? + (when (and isdown? (equal? gamestate 'PLAYING) (equal? action-mode 'ACTION-WAITING) (> (+ (* dx dx) (* dy dy)) (* dist dist)) diff --git a/collects/games/jewel/shapes.scm b/collects/games/jewel/shapes.rkt similarity index 99% rename from collects/games/jewel/shapes.scm rename to collects/games/jewel/shapes.rkt index a8c4a57fc0..791d2ab660 100644 --- a/collects/games/jewel/shapes.scm +++ b/collects/games/jewel/shapes.rkt @@ -1,4 +1,4 @@ -(module shapes mzscheme +(module shapes racket (require sgl/gl sgl/gl-vectors @@ -413,7 +413,7 @@ (glBegin GL_QUAD_STRIP) (do ((i 0 (+ i 1))) ((= i (+ csides 1))) (set! cur (if (< i csides) i (- i csides))) - (if (> i 0) + (when (> i 0) (glNormal3f (/ (+ (vector-ref x cur) (vector-ref x prev)) 2.0) 0.0 @@ -463,7 +463,7 @@ (glBegin GL_QUAD_STRIP) (do ((j 0 (+ j 1))) ((= j (+ usides 1))) (set! t (if (< j usides) j (- j usides))) - (if (not (= j 0)) + (when (not (= j 0)) (let* ( (c #f) (s #f) ) (set! a (/ (* (+ i 0.5) 3.1415927) vsides)) @@ -525,10 +525,10 @@ (set! s (/ d h)) (do ((i 0 (+ i 1))) ((= i (+ dsides 1))) (set! j (if (< i dsides) i (- i dsides))) - (if (= t 0) + (when (= t 0) (set! j (- dsides 1 j)) ) - (if (> i 0) + (when (> i 0) (glNormal3f (* (/ (+ (vector-ref x j) (vector-ref x o)) 2.0) s) (* size c) @@ -673,7 +673,7 @@ (do ((i 0 (+ i 1))) ((= i spikes)) (set! j (+ i 1)) - (if (>= j spikes) + (when (>= j spikes) (set! j (- j spikes)) ) @@ -713,7 +713,7 @@ (do ((i 0 (+ i 1))) ((= i spikes)) (set! j (+ i 1)) - (if (>= j spikes) + (when (>= j spikes) (set! j (- j spikes)) ) diff --git a/collects/games/jewel/text.scm b/collects/games/jewel/text.rkt similarity index 95% rename from collects/games/jewel/text.scm rename to collects/games/jewel/text.rkt index fdfdc6ba1e..a6de9d888f 100644 --- a/collects/games/jewel/text.scm +++ b/collects/games/jewel/text.rkt @@ -1,7 +1,7 @@ -(module text mzscheme +(module text racket - (require mred - mzlib/class + (require racket + racket/class sgl/gl sgl/gl-vectors ) @@ -59,7 +59,7 @@ ; font database is a hash table - (define font-db (make-hash-table 'equal)) + (define font-db (make-hash)) (define font-gen #f) (define font-scale #f) @@ -122,7 +122,7 @@ (set! width (interpret-hershey (cadr elem) scale)) (glEndList) - (hash-table-put! font-db (car elem) (cons i width)) + (hash-set! font-db (car elem) (cons i width)) ) ) ) @@ -132,13 +132,13 @@ (let* ( (n (string-length str)) (c #f) (e #f) - (star (hash-table-get font-db #\*)) + (star (hash-ref font-db #\*)) ) (glPushMatrix) (glNormal3f 0.0 0.0 1.0) (do ((i 0 (+ i 1))) ((= i n)) (set! c (string-ref str i)) - (set! e (hash-table-get font-db c (lambda () star) )) + (set! e (hash-ref font-db c (lambda () star) )) (glCallList (+ font-gen (car e))) (glTranslatef (* font-scale (cdr e)) 0.0 0.0) ) diff --git a/collects/games/lights-out/board.rkt b/collects/games/lights-out/board.rkt index a4d69ad0d6..8f6ee8958a 100644 --- a/collects/games/lights-out/board.rkt +++ b/collects/games/lights-out/board.rkt @@ -1,7 +1,6 @@ -(module board mzscheme - (require mred - mzlib/class - mzlib/etc +(module board racket + (require racket/gui + racket/class "boards.rkt") (provide diff --git a/collects/games/lights-out/lights-out.rkt b/collects/games/lights-out/lights-out.rkt index 789e68bfc0..69b6933839 100644 --- a/collects/games/lights-out/lights-out.rkt +++ b/collects/games/lights-out/lights-out.rkt @@ -1,9 +1,9 @@ -#lang mzscheme +#lang racket (require "board.rkt" "../show-scribbling.rkt" - mred - mzlib/class - mzlib/unit) + racket/gui + racket/class + racket/unit) (provide game@ lights-out^) diff --git a/collects/games/main b/collects/games/main new file mode 100755 index 0000000000..209cf89cd5 Binary files /dev/null and b/collects/games/main differ diff --git a/collects/games/main.rkt b/collects/games/main.rkt index 2b33f6bf0f..de8fbbddec 100644 --- a/collects/games/main.rkt +++ b/collects/games/main.rkt @@ -1,6 +1,6 @@ #lang racket/gui -(require setup/getinfo mrlib/bitmap-label "show-help.rkt") +(require setup/getinfo "show-help.rkt") (define-struct game (file name set icon)) diff --git a/collects/games/memory/memory.rkt b/collects/games/memory/memory.rkt index 4054473611..9cedd79602 100644 --- a/collects/games/memory/memory.rkt +++ b/collects/games/memory/memory.rkt @@ -1,5 +1,5 @@ -#lang mzscheme -(require games/cards mred mzlib/class mzlib/unit mzlib/list) +#lang racket +(require games/cards racket/gui racket/class racket/unit) (provide game@) diff --git a/collects/games/mines/gen-tiles.rkt b/collects/games/mines/gen-tiles.rkt index 7cfcfbf3d9..2a77c2d473 100644 --- a/collects/games/mines/gen-tiles.rkt +++ b/collects/games/mines/gen-tiles.rkt @@ -1,8 +1,7 @@ -(module gen-tiles mzscheme - (require mzlib/class - mred - mzlib/math) +(module gen-tiles racket + (require racket/gui + racket/math) (define SIZE 24) diff --git a/collects/games/mines/images/bomb.png b/collects/games/mines/images/bomb.png index 11748f05d7..2aced2a5e4 100644 Binary files a/collects/games/mines/images/bomb.png and b/collects/games/mines/images/bomb.png differ diff --git a/collects/games/mines/images/explode.png b/collects/games/mines/images/explode.png index 97fc60e642..cd6441c051 100644 Binary files a/collects/games/mines/images/explode.png and b/collects/games/mines/images/explode.png differ diff --git a/collects/games/mines/images/flag.png b/collects/games/mines/images/flag.png index fa7aab9535..6c14d2cc1f 100644 Binary files a/collects/games/mines/images/flag.png and b/collects/games/mines/images/flag.png differ diff --git a/collects/games/mines/images/lclick-tile.png b/collects/games/mines/images/lclick-tile.png index e617ee3e89..f74d4ad787 100644 Binary files a/collects/games/mines/images/lclick-tile.png and b/collects/games/mines/images/lclick-tile.png differ diff --git a/collects/games/mines/images/local-tile.png b/collects/games/mines/images/local-tile.png index 9f8c7bbe80..acc2daa565 100644 Binary files a/collects/games/mines/images/local-tile.png and b/collects/games/mines/images/local-tile.png differ diff --git a/collects/games/mines/images/near-tile.png b/collects/games/mines/images/near-tile.png index b0ff06fa82..8b0023e710 100644 Binary files a/collects/games/mines/images/near-tile.png and b/collects/games/mines/images/near-tile.png differ diff --git a/collects/games/mines/images/rclick-tile.png b/collects/games/mines/images/rclick-tile.png index 5447004278..8e940f2396 100644 Binary files a/collects/games/mines/images/rclick-tile.png and b/collects/games/mines/images/rclick-tile.png differ diff --git a/collects/games/mines/images/tile.png b/collects/games/mines/images/tile.png index fd0eb95190..54f92dfad8 100644 Binary files a/collects/games/mines/images/tile.png and b/collects/games/mines/images/tile.png differ diff --git a/collects/games/mines/mines.rkt b/collects/games/mines/mines.rkt index e9dd4063fa..1750c7c814 100644 --- a/collects/games/mines/mines.rkt +++ b/collects/games/mines/mines.rkt @@ -3,12 +3,9 @@ ;;;;;;;;;;;;;;;;; Configuration ;;;;;;;;;;;;;;;;;; -#lang mzscheme +#lang racket -(require mzlib/etc ; defines build-vector - mzlib/class - mzlib/unit - mred +(require racket/gui mrlib/include-bitmap) (provide game@) @@ -207,7 +204,7 @@ [on-close ; stop the timer, in case it's running (lambda () (send board-canvas stop-timer) - (inner () on-close))]) + (inner '() on-close))]) (super-instantiate ())) ("Minesweeper") [style '(no-resize-border metal)])) @@ -264,7 +261,7 @@ (set! start-time (current-seconds)) (set! timer (make-object - (class timer% () + (class timer% '() (override* [notify (lambda () diff --git a/collects/games/paint-by-numbers/all-problems.rkt b/collects/games/paint-by-numbers/all-problems.rkt index ed977fee0d..52885a4a90 100644 --- a/collects/games/paint-by-numbers/all-problems.rkt +++ b/collects/games/paint-by-numbers/all-problems.rkt @@ -1,11 +1,9 @@ -(module all-problems mzscheme - (require mzlib/etc - mzlib/list - mzlib/unitsig +(module all-problems racket + (require mzlib/unitsig mzlib/include "problem.rkt") - (require-for-syntax mzlib/etc) + (define-signature paint-by-numbers:all-problems^ (problemss set-names)) (define-signature paint-by-numbers:problem-set^ (problems set-name)) diff --git a/collects/games/paint-by-numbers/gui.rkt b/collects/games/paint-by-numbers/gui.rkt index c7cbda5dc4..f7ceaafba1 100644 --- a/collects/games/paint-by-numbers/gui.rkt +++ b/collects/games/paint-by-numbers/gui.rkt @@ -36,10 +36,9 @@ paint by numbers. |# - (require mred + (require racket/gui framework - mzlib/etc - mzlib/class) + racket/class) (provide paint-by-numbers-canvas% design-paint-by-numbers-canvas%) diff --git a/collects/games/paint-by-numbers/paint-by-numbers.rkt b/collects/games/paint-by-numbers/paint-by-numbers.rkt index 2dfc1b6fda..4b272b81ad 100644 --- a/collects/games/paint-by-numbers/paint-by-numbers.rkt +++ b/collects/games/paint-by-numbers/paint-by-numbers.rkt @@ -6,11 +6,7 @@ "problem.rkt" "../show-scribbling.rkt" framework - mzlib/class - mzlib/unit - mzlib/pretty - mzlib/list - mred) + racket/gui) (provide game@) diff --git a/collects/games/paint-by-numbers/problem.rkt b/collects/games/paint-by-numbers/problem.rkt index ad22b47078..d6640dc53e 100644 --- a/collects/games/paint-by-numbers/problem.rkt +++ b/collects/games/paint-by-numbers/problem.rkt @@ -1,3 +1,3 @@ -(module problem mzscheme - (provide (struct problem (name rows cols solution))) - (define-struct problem (name rows cols solution))) +(module problem racket + (provide (struct-out problem)) + (define-struct problem (name rows cols solution) #:mutable)) diff --git a/collects/games/paint-by-numbers/raw-problems/build-final.rkt b/collects/games/paint-by-numbers/raw-problems/build-final.rkt index ab7b8abc9e..8729230ac8 100644 --- a/collects/games/paint-by-numbers/raw-problems/build-final.rkt +++ b/collects/games/paint-by-numbers/raw-problems/build-final.rkt @@ -1,4 +1,4 @@ -#lang mzscheme +#lang racket #| @@ -10,8 +10,6 @@ in ... |# -(require mzlib/match) - ;; shrink-file : string -> string (define (shrink-file filename) (printf "shrinking ~a..." filename) diff --git a/collects/games/paint-by-numbers/raw-problems/build-rows-cols.rkt b/collects/games/paint-by-numbers/raw-problems/build-rows-cols.rkt index d5b0594041..39d36e6554 100644 --- a/collects/games/paint-by-numbers/raw-problems/build-rows-cols.rkt +++ b/collects/games/paint-by-numbers/raw-problems/build-rows-cols.rkt @@ -1,6 +1,6 @@ -#lang mzscheme -(require mred - mzlib/class) +#lang racket +(require racket/gui + racket/class) (define argv (current-command-line-arguments)) (when (equal? (vector) argv) diff --git a/collects/games/paint-by-numbers/raw-problems/build-solution-sets.rkt b/collects/games/paint-by-numbers/raw-problems/build-solution-sets.rkt index 475da053bf..116188e45b 100644 --- a/collects/games/paint-by-numbers/raw-problems/build-solution-sets.rkt +++ b/collects/games/paint-by-numbers/raw-problems/build-solution-sets.rkt @@ -1,4 +1,4 @@ -#lang mzscheme +#lang racket #| @@ -18,14 +18,9 @@ The col and row type specs are in sig.rkt and the solution type is: (define argv (current-command-line-arguments)) -(require mzlib/etc - mzlib/list - mzlib/file - mzlib/pretty - mzlib/class - mred +(require racket/gui "raw-hattori.rkt" - (prefix solve: "../solve.rkt")) + (prefix-in solve: "../solve.rkt")) (if (equal? (vector) argv) (printf "pass any command line argument to skip the solver\n\n") diff --git a/collects/games/paint-by-numbers/solve.rkt b/collects/games/paint-by-numbers/solve.rkt index 9395b71652..6bcc612c8d 100644 --- a/collects/games/paint-by-numbers/solve.rkt +++ b/collects/games/paint-by-numbers/solve.rkt @@ -1,9 +1,4 @@ -(module solve mzscheme - - (require mzlib/list - mzlib/etc - mzlib/contract) - +(module solve racket (provide/contract [solve (-> (listof (listof integer?)) ; row-info (listof (listof integer?)) ; col-info (-> number? number? symbol? ; set-entry @@ -146,7 +141,7 @@ ((X) 'off) ((O) 'on) ((*) 'mixed) - ((()) ()) + ((()) '()) (else (error 'condensed->long-form "bad input: ~a" symbol-tree)))])) ;(equal? (condensed->long-form '(((? !) u) (* () X O))) @@ -613,7 +608,7 @@ [(new-board) (reassemble-rows (map rectify board-rows))] [( _ ) - (if row-changed + (when row-changed (animate-changes new-board draw-rows-thunk (board-height new-board) (board-width new-board)))] @@ -624,7 +619,7 @@ [(final-board) (reassemble-cols (map rectify board-cols))] [( _ ) - (if col-changed + (when col-changed (animate-changes final-board draw-cols-thunk (board-width final-board) (board-height final-board)))]) diff --git a/collects/games/parcheesi/admin-gui.rkt b/collects/games/parcheesi/admin-gui.rkt index eb7e6bc5f0..7e9ab9877c 100644 --- a/collects/games/parcheesi/admin-gui.rkt +++ b/collects/games/parcheesi/admin-gui.rkt @@ -5,7 +5,7 @@ corresponds to the unplayed move! that's confusing. |# -(module admin-gui mzscheme +(module admin-gui racket (require "gui.rkt" "die.rkt" "interfaces.rkt" @@ -15,16 +15,14 @@ corresponds to the unplayed move! that's confusing. "rules.rkt" "best-players.rkt" framework - mzlib/class - mzlib/list - mred) + racket/gui) (provide gui-game%) ;; move-candidate = (make-move-candidate coordinate move (listof number)) - (define-struct move-candidate (move dice) (make-inspector)) + (define-struct move-candidate (move dice) #:inspector (make-inspector)) - (define-struct past (board color roll) (make-inspector)) + (define-struct past (board color roll) #:inspector (make-inspector)) (print-struct #t) (define gui-game% @@ -688,20 +686,20 @@ corresponds to the unplayed move! that's confusing. ;; eliminate-duplicates : (listof X) -> (listof X) (define (eliminate-duplicates lst) - (let ([ht (make-hash-table 'equal)]) - (for-each (lambda (x) (hash-table-put! ht x #t)) lst) - (hash-table-map ht (lambda (x y) x)))) + (let ([ht (make-hash)]) + (for-each (lambda (x) (hash-set! ht x #t)) lst) + (hash-map ht (lambda (x y) x)))) ;; collapse-same-coordinates : (listof (cons coordinate (listof move-candidate))) ;; -> (listof (cons coordinate (listof move-candidate))) (define (collapse-same-coordinates l) - (let ([ht (make-hash-table 'equal)]) + (let ([ht (make-hash)]) (for-each (lambda (pr) - (hash-table-put! ht (car pr) + (hash-set! ht (car pr) (append (cdr pr) - (hash-table-get ht (car pr) (lambda () '()))))) + (hash-ref ht (car pr) (lambda () '()))))) l) - (hash-table-map ht cons))) + (hash-map ht cons))) ;; like find-roll-coordinates, but only for the main track of the board (define (find-home-roll-coordinates board roll color) diff --git a/collects/games/parcheesi/admin.rkt b/collects/games/parcheesi/admin.rkt index 8cbcac4ece..84e2b286ae 100644 --- a/collects/games/parcheesi/admin.rkt +++ b/collects/games/parcheesi/admin.rkt @@ -1,9 +1,8 @@ -(module admin mzscheme +(module admin racket (require "board.rkt" "moves.rkt" "interfaces.rkt" - mzlib/class - mzlib/list) + racket/class) (provide game% game-observer<%>) diff --git a/collects/games/parcheesi/best-players.rkt b/collects/games/parcheesi/best-players.rkt index b5a918ed7c..d5bd36b1ae 100644 --- a/collects/games/parcheesi/best-players.rkt +++ b/collects/games/parcheesi/best-players.rkt @@ -10,15 +10,13 @@ careful charlie (random ron) |# -(module best-players mzscheme +(module best-players racket (require "board.rkt" "moves.rkt" "interfaces.rkt" "test.rkt" - mzlib/list - mzlib/etc - mzlib/class - mzlib/pretty) + racket/class + racket/pretty) (provide random-player% agressive-player% @@ -28,7 +26,7 @@ careful charlie reckless-player% search - (struct state (moves dice board))) + (struct-out state)) (define candidates-record '()) (provide average-move-count) @@ -41,7 +39,7 @@ careful charlie ;; moves : (listof move) -- what got us here ;; dice : (listof dice) -- what we have left to use ;; board : board -- the state of the board after taking the moves - (define-struct state (moves dice board) (make-inspector)) + (define-struct state (moves dice board) #:inspector (make-inspector)) (define base-player% (class* object% (player<%>) @@ -140,24 +138,24 @@ careful charlie ;; search : board color (listof number) -> (listof state) (define (search orig-board color dice) - (define candidate-ht (make-hash-table 'equal)) + (define candidate-ht (make-hash)) (define (move-candidate candidate) - (hash-table-put! candidate-ht (state-board candidate) candidate)) - (define (get-candidates) (hash-table-map candidate-ht (lambda (x y) y))) + (hash-set! candidate-ht (state-board candidate) candidate)) + (define (get-candidates) (hash-map candidate-ht (lambda (x y) y))) ;; main : -> void (define (main) ;; ht : board -o> true - (let ([ht (make-hash-table 'equal)]) + (let ([ht (make-hash)]) (let loop ([state (make-state '() dice orig-board)]) (let* ([board (state-board state)] [dice (state-dice state)] [key (cons dice board)]) (cond - [(hash-table-get ht key (lambda () #f)) + [(hash-ref ht key (lambda () #f)) (void)] [else - (hash-table-put! ht key #t) + (hash-set! ht key #t) (let* ([possible-moves (find-moves board dice)] [valid-next-states (find-valid-states state orig-board board possible-moves)]) (cond diff --git a/collects/games/parcheesi/board.rkt b/collects/games/parcheesi/board.rkt index 81e5d9bebc..733d646ae5 100644 --- a/collects/games/parcheesi/board.rkt +++ b/collects/games/parcheesi/board.rkt @@ -1,19 +1,16 @@ -(module board mzscheme - (require mzlib/contract - mzlib/list - mzlib/etc) +(module board racket ;; color = (symbols 'blue 'green 'red 'yellow) ;; color : color ;; id : (union 0 1 2 3) - (define-struct pawn (color id index) (make-inspector)) + (define-struct pawn (color id index) #:inspector (make-inspector)) ;; v : (vectorof loc) length is always 16 - (define-struct board (v) (make-inspector)) + (define-struct board (v) #:inspector (make-inspector)) ;; loc = (union 'start 'home number[main-loc] home-row-loc) - (define-struct home-row-loc (num color) (make-inspector)) + (define-struct home-row-loc (num color) #:inspector (make-inspector)) (define color (symbols 'red 'green 'blue 'yellow)) @@ -23,12 +20,12 @@ (pawn-id (pawn? . -> . (integer-in 0 4))) (pawn-color (pawn? . -> . color))) - (provide (rename build-pawn make-pawn) + (provide (rename-out [build-pawn make-pawn]) pawn? new-board for-each-pawn/loc - (rename make-old-style-board make-board) + (rename-out [make-old-style-board make-board]) board-start @@ -204,15 +201,15 @@ ;; find-blockades : board -> (listof loc) (define (find-blockades board) - (let ([ht (make-hash-table 'equal)] + (let ([ht (make-hash)] [blockades '()]) (for-each-pawn/loc board (lambda (pawn loc) - (when (hash-table-get ht + (when (hash-ref ht loc (lambda () - (hash-table-put! ht loc #t) + (hash-set! ht loc #t) #f)) (set! blockades (cons loc blockades))))) blockades)) @@ -262,11 +259,11 @@ ;; p1 : pawn ;; p2 : pawn ;; (pawn<=? p1 p2) is true - (define-struct blockade (loc p1 p2) (make-inspector)) + (define-struct blockade (loc p1 p2) #:inspector (make-inspector)) ;; find-blockades/color : board color -> (listof blockade) (define (find-blockades/color board color) - (let ([ht (make-hash-table 'equal)] + (let ([ht (make-hash)] [v (board-v board)] [offset (find-pawn-index color 0)]) (let loop ([i 0] @@ -278,8 +275,8 @@ (cond [(eq? loc 'start) (loop (+ i 1) blockades)] [(eq? loc 'home) (loop (+ i 1) blockades)] - [(hash-table-get ht loc (lambda () - (hash-table-put! ht loc i) + [(hash-ref ht loc (lambda () + (hash-set! ht loc i) #f)) => (lambda (old-i) diff --git a/collects/games/parcheesi/die.rkt b/collects/games/parcheesi/die.rkt index db48eabcec..a397c35fa0 100644 --- a/collects/games/parcheesi/die.rkt +++ b/collects/games/parcheesi/die.rkt @@ -1,6 +1,6 @@ -(module die mzscheme - (require mred - mzlib/class) +(module die racket + (require racket/gui + racket/class) (provide die%) diff --git a/collects/games/parcheesi/gui.rkt b/collects/games/parcheesi/gui.rkt index 1b587fb9af..7a39756fc9 100644 --- a/collects/games/parcheesi/gui.rkt +++ b/collects/games/parcheesi/gui.rkt @@ -1,10 +1,7 @@ -(module gui mzscheme +(module gui racket (require "board.rkt" - "moves.rkt" - mred - mzlib/class - mzlib/list - mzlib/etc) + racket/gui + racket/class) (provide show-board board-canvas% @@ -16,10 +13,10 @@ get-piece-size pawn-drawn-color - (struct home-row-c (count color)) - (struct main-c (count)) - (struct start-c (color)) - (struct home-c (color))) + (struct-out home-row-c ) + (struct-out main-c ) + (struct-out start-c) + (struct-out home-c)) ;; a coordinate is either ;; - (make-home-row-c number color) @@ -27,10 +24,10 @@ ;; - (make-start-c color) ;; - (make-home-c color) ;; inspectors are to allow comparison with equal? - (define-struct home-row-c (count color) (make-inspector)) - (define-struct main-c (count) (make-inspector)) - (define-struct start-c (color) (make-inspector)) - (define-struct home-c (color) (make-inspector)) + (define-struct home-row-c (count color) #:inspector (make-inspector)) + (define-struct main-c (count) #:inspector (make-inspector)) + (define-struct start-c (color) #:inspector (make-inspector)) + (define-struct home-c (color) #:inspector (make-inspector)) (define (get-cell-size horizontal? w h) (if horizontal? @@ -63,7 +60,7 @@ (send dc set-brush (send the-brush-list find-or-create-brush (cdr (assq color colors)) 'solid))) (define draw-board - (opt-lambda (board dc w h dx dy draw-pieces?) + (lambda (board dc w h dx dy draw-pieces?) (let ([smoothing (send dc get-smoothing)]) (send dc set-smoothing 'aligned) (set-color dc 'track-background) diff --git a/collects/games/parcheesi/interfaces.rkt b/collects/games/parcheesi/interfaces.rkt index 7f62c43fd5..fd44e807cd 100644 --- a/collects/games/parcheesi/interfaces.rkt +++ b/collects/games/parcheesi/interfaces.rkt @@ -1,5 +1,4 @@ -(module interfaces mzscheme - (require mzlib/class) +(module interfaces racket (provide player<%> game<%>) @@ -18,5 +17,4 @@ (define game<%> (interface () register ;; player<%> -> void - start ;; -> void - ))) + start #| -> void |#))) diff --git a/collects/games/parcheesi/make-bitmap.rkt b/collects/games/parcheesi/make-bitmap.rkt index 475f0b406a..030aa4e840 100644 --- a/collects/games/parcheesi/make-bitmap.rkt +++ b/collects/games/parcheesi/make-bitmap.rkt @@ -1,10 +1,7 @@ -(module make-bitmap mzscheme +(module make-bitmap racket (require "board.rkt" - "moves.rkt" - mred - mzlib/class - mzlib/list - mzlib/etc) + racket/gui + racket/class) (provide show-board board-canvas% @@ -15,10 +12,10 @@ get-cell-size get-piece-size - (struct home-row-c (count color)) - (struct main-c (count)) - (struct start-c (color)) - (struct home-c (color))) + (struct-out home-row-c) + (struct-out main-c) + (struct-out start-c) + (struct-out home-c)) ;; a coordinate is either ;; - (make-home-row-c number color) @@ -26,10 +23,10 @@ ;; - (make-start-c color) ;; - (make-home-c color) ;; inspectors are to allow comparison with equal? - (define-struct home-row-c (count color) (make-inspector)) - (define-struct main-c (count) (make-inspector)) - (define-struct start-c (color) (make-inspector)) - (define-struct home-c (color) (make-inspector)) + (define-struct home-row-c (count color) #:inspector (make-inspector)) + (define-struct main-c (count) #:inspector (make-inspector)) + (define-struct start-c (color) #:inspector (make-inspector)) + (define-struct home-c (color) #:inspector (make-inspector)) (define (get-cell-size horizontal? w h) (if horizontal? @@ -52,7 +49,7 @@ (send dc set-brush (send the-brush-list find-or-create-brush (cdr (assq color colors)) 'solid))) (define draw-board - (opt-lambda (board dc w h dx dy draw-pieces?) + (lambda (board dc w h dx dy draw-pieces?) (set-color dc 'track-background) (send dc draw-rectangle (+ dx 0) (+ dy (* h 1/3)) w (* h 1/3)) (send dc draw-rectangle (+ dx (* w 1/3)) (+ dy 0) (* w 1/3) h) diff --git a/collects/games/parcheesi/moves.rkt b/collects/games/parcheesi/moves.rkt index f88d21e02d..1239beb92f 100644 --- a/collects/games/parcheesi/moves.rkt +++ b/collects/games/parcheesi/moves.rkt @@ -1,16 +1,14 @@ -(module moves mzscheme - (require "board.rkt" - mzlib/contract - mzlib/list) +(module moves racket + (require "board.rkt") ;; a move is either: ;; - (make-enter-piece pawn) ;; - (make-move-piece-main pawn start distance) ;; - (make-move-piece-home pawn start distance) - (define-struct move () (make-inspector)) - (define-struct (enter-piece move) (pawn) (make-inspector)) - (define-struct (move-piece-main move) (pawn start distance) (make-inspector)) - (define-struct (move-piece-home move) (pawn start distance) (make-inspector)) + (define-struct move () #:inspector (make-inspector)) + (define-struct (enter-piece move) (pawn) #:inspector (make-inspector)) + (define-struct (move-piece-main move) (pawn start distance) #:inspector (make-inspector)) + (define-struct (move-piece-home move) (pawn start distance) #:inspector (make-inspector)) (provide/contract (struct enter-piece ((pawn pawn?))) diff --git a/collects/games/parcheesi/parcheesi.rkt b/collects/games/parcheesi/parcheesi.rkt index c53c176ac6..5785e96b24 100644 --- a/collects/games/parcheesi/parcheesi.rkt +++ b/collects/games/parcheesi/parcheesi.rkt @@ -1,6 +1,6 @@ -(module parcheesi mzscheme - (require mzlib/unit - mzlib/class +(module parcheesi racket + (require racket/unit + racket/class "admin-gui.rkt") (provide game@) diff --git a/collects/games/parcheesi/play-game.rkt b/collects/games/parcheesi/play-game.rkt index 5833b60584..b4f96e6061 100644 --- a/collects/games/parcheesi/play-game.rkt +++ b/collects/games/parcheesi/play-game.rkt @@ -1,12 +1,10 @@ -(module play-game mzscheme +(module play-game racket (require "gui.rkt" "admin.rkt" "board.rkt" - "moves.rkt" + #;"moves.rkt" "die.rkt" - mzlib/math - mzlib/class - mred) + racket/gui) (provide play-game) diff --git a/collects/games/parcheesi/rules.rkt b/collects/games/parcheesi/rules.rkt index ca0e7bcb04..f67a0bef28 100644 --- a/collects/games/parcheesi/rules.rkt +++ b/collects/games/parcheesi/rules.rkt @@ -1,14 +1,12 @@ -(module rules mzscheme +(module rules racket (provide show-rules) (require "board.rkt" "moves.rkt" "gui.rkt" - - mzlib/class xml browser/htmltext - mred) + racket/gui) (define board-size 250) @@ -223,7 +221,7 @@ "Parcheesi typically requires a player to enter the board, if possible. That is not required " "here however." ))))) - (define table (make-hash-table 'equal)) + (define table (make-hash)) (define (replace-!!s t) (let loop ([starts (reverse (send t find-string-all "!!"))] @@ -234,7 +232,7 @@ [end (car ends)] [name (send t get-text (+ start 2) end)]) (send t delete start (+ end 2) #f) - (send t insert (new board-snip% (board (hash-table-get table name))) start start #f) + (send t insert (new board-snip% (board (hash-ref table name))) start start #f) (loop (cdr starts) (cdr ends)))]))) (define scroll-step-pixels 12) @@ -267,5 +265,5 @@ (define (moves-make-image/link moves name) (let-values ([(board bonuses) (make-moves (new-board) moves)]) - (hash-table-put! table name board) + (hash-set! table name board) (format " !!~a:: " name)))) diff --git a/collects/games/parcheesi/test.rkt b/collects/games/parcheesi/test.rkt index b3dfb23fd5..e4207d9ad0 100644 --- a/collects/games/parcheesi/test.rkt +++ b/collects/games/parcheesi/test.rkt @@ -1,5 +1,5 @@ -(module test mzscheme - (require mzlib/pretty) +(module test racket + (require racket/pretty) (provide test test-list test-err test-results) (define show-tests? #t) diff --git a/collects/games/pousse/board-size.rkt b/collects/games/pousse/board-size.rkt index de08802c27..6546f82b85 100644 --- a/collects/games/pousse/board-size.rkt +++ b/collects/games/pousse/board-size.rkt @@ -1,3 +1,3 @@ -(module board-size mzscheme +(module board-size racket (define current-board-size (make-parameter 4)) (provide current-board-size)) diff --git a/collects/games/pousse/board.rkt b/collects/games/pousse/board.rkt index 737ea7ff99..1c6d618978 100644 --- a/collects/games/pousse/board.rkt +++ b/collects/games/pousse/board.rkt @@ -1,4 +1,4 @@ -(module board mzscheme +(module board racket (require "board-size.rkt") ; for n (provide x o none ; cell values @@ -29,7 +29,7 @@ (define o #\o) (define none #\space) - (define-struct board (str n rotation)) + (define-struct board (str n rotation) #:mutable) (define (new-board n) (make-board (make-string (add1 (* n n)) #\space) n 0)) diff --git a/collects/games/pousse/counter.rkt b/collects/games/pousse/counter.rkt index 14ed0e08d9..cf9844d8f4 100644 --- a/collects/games/pousse/counter.rkt +++ b/collects/games/pousse/counter.rkt @@ -4,7 +4,7 @@ ;; This code benefits greatly from mzc compilation. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(module counter mzscheme +(module counter racket (require "board.rkt" "utils.rkt" mzlib/unitsig) diff --git a/collects/games/pousse/pousse.rkt b/collects/games/pousse/pousse.rkt index ad55dc900e..5c5fa7f594 100644 --- a/collects/games/pousse/pousse.rkt +++ b/collects/games/pousse/pousse.rkt @@ -3,9 +3,7 @@ "board.rkt" "board-size.rkt" "../show-scribbling.rkt" - racket/class - racket/unit - mred + racket/gui (prefix-in robot: "robot.rkt")) (provide game@) diff --git a/collects/games/pousse/robot.rkt b/collects/games/pousse/robot.rkt index 997b2daf1d..60d606cca9 100644 --- a/collects/games/pousse/robot.rkt +++ b/collects/games/pousse/robot.rkt @@ -1,4 +1,4 @@ -(module robot mzscheme +(module robot racket (require "counter.rkt" "board.rkt" "utils.rkt" diff --git a/collects/games/pousse/robots.txt b/collects/games/pousse/robots.txt index 1d200dce3b..89eff72ac1 100644 --- a/collects/games/pousse/robots.txt +++ b/collects/games/pousse/robots.txt @@ -18,7 +18,7 @@ move. The following example player program always mimics the other player, choosing T1 if it has to go first: - ;; In the file my-robot.scm + ;; In the file my-robot.rkt (module my-robot mzscheme (provide robot) diff --git a/collects/games/pousse/utils.rkt b/collects/games/pousse/utils.rkt index fee7d2080f..5b45e2e76c 100644 --- a/collects/games/pousse/utils.rkt +++ b/collects/games/pousse/utils.rkt @@ -1,4 +1,4 @@ -(module utils mzscheme +(module utils racket ; See boardsig.rkt for the core utilities. (require "board-size.rkt" "board.rkt") diff --git a/collects/games/same/same.rkt b/collects/games/same/same.rkt index f23a9fe6dd..0d5934bc7a 100644 --- a/collects/games/same/same.rkt +++ b/collects/games/same/same.rkt @@ -1,9 +1,7 @@ #lang racket/base (require racket/class racket/unit - racket/list racket/gui/base - racket/math "../show-scribbling.rkt" "same-lib.rkt") diff --git a/collects/games/show-help.rkt b/collects/games/show-help.rkt index 0813a7ec32..3d720c6477 100644 --- a/collects/games/show-help.rkt +++ b/collects/games/show-help.rkt @@ -1,12 +1,10 @@ -(module show-help mzscheme - (require mzlib/class - mred - mzlib/etc) +(module show-help racket + (require racket/gui) (provide show-help) (define show-help - (opt-lambda (collections frame-title [verbatim? #f]) + (lambda (collections frame-title [verbatim? #f]) (let* ([f #f] [f% (class frame% diff --git a/collects/games/show-scribbling.rkt b/collects/games/show-scribbling.rkt index 815b3e53d2..762c3967be 100644 --- a/collects/games/show-scribbling.rkt +++ b/collects/games/show-scribbling.rkt @@ -1,10 +1,8 @@ -#lang scheme/base +#lang racket/base (require setup/xref scribble/xref - scribble/basic scribble/tag - scheme/promise net/url net/sendurl) diff --git a/collects/games/slidey/slidey.rkt b/collects/games/slidey/slidey.rkt index dd77c0f7b5..21e7ae3d0b 100644 --- a/collects/games/slidey/slidey.rkt +++ b/collects/games/slidey/slidey.rkt @@ -1,8 +1,5 @@ -#lang mzscheme -(require mzlib/etc - mzlib/class - mzlib/unit - mred) +#lang racket +(require racket/gui) (provide game@) diff --git a/collects/games/spider/spider.rkt b/collects/games/spider/spider.rkt index 68af771ef2..21cccc939c 100644 --- a/collects/games/spider/spider.rkt +++ b/collects/games/spider/spider.rkt @@ -1,14 +1,12 @@ -#lang mzscheme +#lang racket -(require games/cards mred mzlib/class mzlib/list mzlib/file mzlib/unit +(require games/cards racket/gui racket/class racket/unit "../show-scribbling.rkt") (define (list-first-n l n) (if (zero? n) null (cons (car l) (list-first-n (cdr l) (sub1 n))))) -(define (vector-copy v) - (list->vector (vector->list v))) (provide game@) (define game@ (unit (import) (export)