diff --git a/collects/games/same/same.rkt b/collects/games/same/same.rkt
index 226cc93ac3..241ec5b4e2 100644
--- a/collects/games/same/same.rkt
+++ b/collects/games/same/same.rkt
@@ -1,388 +1,426 @@
-(module same mzscheme
-  (require mzlib/etc
-           mzlib/class
-           mzlib/unit
-           mred
-           mzlib/list
-           "../show-scribbling.ss")
-  
-  (provide game@)
-  
-  (define game@
-    (unit
-      (import)
-      (export)
-      
-      (define board-width 20)
-      (define board-height 10)
-      (define cell-size 30)
-      (define colors (map (lambda (x) (make-object color% x)) (list "blue" "red" "magenta" "yellow" "cyan")))
-      (define pens (map (lambda (x) (make-object pen% x 1 'solid)) colors))
-      (define brushes (map (lambda (x) (make-object brush% x 'solid)) colors))
-      (define white-pen (make-object pen% "white" 1 'solid))
-      (define white-brush (make-object brush% "white" 'solid))
-      
-      ;; build-board : (-> (vectorof (vectorof (vector (union num #f) boolean))))
-      ;   this represents the board. Each entry is the color index of
-      ;   the piece and a node to mark for the depth-first traversal.
-      ;   #f for the color index indicates an eliminated piece.
-      (define (build-board)
-        (build-vector
-         board-width
-         (lambda (i)
-           (build-vector
-            board-height
-            (lambda (j)
-              (vector
-               (begin
-                 (if (= j (- board-height 1))
-                     (- (length colors) 1)
-                     (modulo i (- (length colors) 1)))
-                 (random (length colors)))
-               #f))))))
-      
-      (define board (build-board))
-      
-      (define game-over? #f)
-      
-      (define score 0)
-      (define (calc-score n)
-        (cond
-          [(= n 2) 2]
-          [else (- (* (- n 1) (- n 1)) (- n 3))]))
-      
-      (define same-canvas%
-        (class canvas%
-          (inherit get-dc get-client-size)
-          (define/private (get-width) (let-values ([(w h) (get-client-size)]) w))
-          (define/private (get-height) (let-values ([(w h) (get-client-size)]) h))
-          (define/private (get-x-step) (/ (get-width) board-width))
-          (define/private (get-y-step) (/ (get-height) board-height))
-          [define/public draw-cell
-            (lambda (dc highlight? i j)
-              (let ([index (vector-ref (vector-ref (vector-ref board i) j) 0)]
-                    [x (* i (get-x-step))]
-                    [y (* j (get-y-step))])
-		(send dc set-brush white-brush)
-		(send dc set-pen white-pen)
-		(send dc draw-rectangle x y (get-x-step) (get-y-step))
-		(when index
-		  (send dc set-brush (list-ref brushes index))
-		  (send dc set-pen (list-ref pens index))
-		  (cond
-		   [highlight?
-		    (send dc draw-ellipse 
-			  (floor (+ x (/ (get-x-step) 4)))
-			  (floor (+ y (/ (get-y-step) 4)))
-			  (floor (/ (get-x-step) 2))
-			  (floor (/ (get-y-step) 2)))]
-		   [else
-		    (send dc draw-ellipse x y (get-x-step) (get-y-step))]))))]
-          
-          [define/public  draw-line
-            (lambda (dc i)
-              (let ([show-turned? (> (length turned) 1)])
-                (let loop ([j board-height])
-                  (cond
-                    [(zero? j) (void)]
-                    [else
-                     (draw-cell dc (and show-turned? (member (list i (- j 1)) turned)) i (- j 1))
-                     (loop (- j 1))]))))]
-          
-          [define/public find-same-colors
-            (lambda (i j)
-              (let* ([index (vector-ref (vector-ref (vector-ref board i) j) 0)]
-                     [ans
-                      (let loop ([i i]
-                                 [j j]
-                                 [ps null])
-                        (cond
-                          [(not (and (<= 0 i) (< i board-width)
-                                     (<= 0 j) (< j board-height)))
-                           ps]
-                          [(vector-ref (vector-ref (vector-ref board i) j) 1) ps]
-                          [(not (vector-ref (vector-ref (vector-ref board i) j) 0)) ps]
-                          [(= index (vector-ref (vector-ref (vector-ref board i) j) 0))
-                           (let ([v (vector-ref (vector-ref board i) j)])
-                             (vector-set! v 1 #t)
-                             (loop (+ i 1)
-                                   j
-                                   (loop (- i 1)
-                                         j
-                                         (loop i
-                                               (- j 1)
-                                               (loop i
-                                                     (+ j 1)
-                                                     (cons (list v i j) ps))))))]
-                          [else ps]))])
-                (for-each (lambda (p) (vector-set! (first p) 1 #f)) ans)
-                ans))]
-          
-          [define/public get-game-over-size
-            (lambda (dc)
-              (let ([border 5])
-                (let-values ([(text-width text-height d l) (send dc get-text-extent game-over)])
-                  (let ([x (- (/ (get-width) 2) (/ text-width 2))]
-                        [y (- (/ (get-height) 2) (/ text-height 2))])
-                    (values x y text-width text-height border)))))]
-          
-          [define/public paint-game-over
-            (lambda (dc)
-              (send dc set-font font)
-              (let-values ([(x y text-width text-height border) (get-game-over-size dc)])
-                (send dc set-pen white-pen)
-                (send dc set-brush white-brush)
-                (send dc draw-rectangle
-                      (- x border) (- y border)
-                      (+ text-width border border)
-                      (+ text-height border border))
-                (send dc draw-text game-over x y)))]
-          
-          
-          (field
-           [game-over "Game Over"]
-           [font (make-object font% 24 'decorative 'normal 'normal #f)]
-           [turned null])
+#lang racket/base
+(require racket/class
+         racket/unit
+         racket/list
+         racket/gui/base
+         "../show-scribbling.ss")
 
-          [define/public (call-with-dc proc)
-            ;; Since we're not in `on-paint', need to manually
-            ;; suspend and resume flushing, so that intermediate
-            ;; states are not flushed to the screen.
-            (let ([dc (get-dc)])
-              (send dc suspend-flush)
-              (proc dc)
-              (send dc resume-flush))]
-          
-          [define/private recalc/draw-turned
-            (lambda (i j)
-              (set! turned (map (lambda (xx) (list (second xx) (third xx))) (find-same-colors i j)))
-              (cond
-                [(> (length turned) 1)
-                 (send this-message set-label (number->string (calc-score (length turned))))
-		 (call-with-dc
-		  (lambda (dc)
-		    (for-each (lambda (p) (draw-cell dc #t (first p) (second p))) turned)))]
-                [else
-                 (send this-message set-label "")]))]
-          
-          [define/override on-event
-            (lambda (evt)
-              (let+ ([val x (send evt get-x)]
-                     [val y (send evt get-y)]
-                     [val i (inexact->exact (floor (* (/ x (get-width)) board-width)))]
-                     [val j (inexact->exact (floor (* (/ y (get-height)) board-height)))])
-                    (cond
-                      [(or (send evt moving?)
-                           (send evt entering?)
-                           (send evt leaving?))
-                       (cond
-                         [(and (<= 0 i) (< i board-width)
-                               (<= 0 j) (< j board-height))
-                          (unless (member (list i j) turned)
-                            (when (> (length turned) 1)
-			      (call-with-dc
-                               (lambda (dc)
-                                 (for-each (lambda (p) (draw-cell dc #f (first p) (second p))) turned))))
-                            (recalc/draw-turned i j))]
-                         [else
-                          (when (> (length turned) 1)
-                            (call-with-dc
-                             (lambda (dc)
-                               (for-each (lambda (p) (draw-cell dc #f (first p) (second p))) turned))))
-                          (set! turned null)
-                          (send this-message set-label "")])]
-                      [(send evt button-up?)
-                       (when (and (<= 0 i) (< i board-width)
-                                  (<= 0 j) (< j board-height))
-                         (when (> (length turned) 1)
-                           (call-with-dc
-                            (lambda (dc)
-                              (for-each (lambda (p) (draw-cell dc #f (first p) (second p))) turned))))
-                         (set! turned null)
-                         (send this-message set-label "")
-                         (let ([same-colors (find-same-colors i j)])
-                           
-                           ;; reset back the marks for the next depth-first traversal
-                           
-                           (when (>= (length same-colors) 2)
-                             
-                             ;; update score
-                             (set! score (+ score (calc-score (length same-colors))))
-                             (send message set-label (number->string score)) 
-                             
-                             ;; slide down empty pieces
-                             (let ([is null])
-                               (for-each
-                                (lambda (p)
-                                  (let ([i (second p)]
-                                        [j (third p)])
-                                    (unless (member i is)
-                                      (set! is (cons i is)))
-                                    (let loop ([x j])
-                                      (cond
-                                        [(<= 1 x)
-                                         (let ([next (vector-ref (vector-ref board i) (- x 1))]
-                                               [this (vector-ref (vector-ref board i) x)])
-                                           (vector-set! this 0 (vector-ref next 0))
-                                           (loop (- x 1)))]
-                                        [else
-                                         (vector-set! (vector-ref (vector-ref board i) x) 0 #f)]))))
-                                (sort same-colors
-                                      (lambda (x y) (<= (third x) (third y)))))
+(provide game@)
 
-                               ;; slide empty over empty rows
-                               (set! is (sort is >))
-                               (let ([empty-is (filter (lambda (i)
-                                                         (not (vector-ref (vector-ref (vector-ref board i) (- board-height 1)) 0)))
-                                                       is)])
-                                 (let ([is (if (null? empty-is)
-                                               is
-                                               (filter (lambda (x) (< x (car empty-is)))
-                                                       is))])
-                                   (for-each (lambda (empty-i)
-                                               (let loop ([i empty-i])
-                                                 (cond
-                                                   [(<= i (- board-width 2))
-                                                    (vector-set! board i (vector-ref board (+ i 1)))
-                                                    (loop (+ i 1))]
-                                                   [(= i (- board-width 1))
-                                                    (vector-set! board i (build-vector board-height
-                                                                                       (lambda (i) (vector #f #f))))])))
-                                             empty-is)
-                                   
-                                   ;; draw changed lines
-                                   (call-with-dc
-                                    (lambda (dc)
-                                      (for-each (lambda (i) (draw-line dc i)) is)
-                                      (unless (null? empty-is)
-                                        (let loop ([i (car (last-pair empty-is))])
-                                          (cond
-                                           [(= i board-width) (void)]
-                                           [else (draw-line dc i)
-                                                 (loop (+ i 1))])))))
-                                   
-                                   ;; update `small' balls
-                                   (recalc/draw-turned i j)
-                                   )))
-                             
-                             (set! game-over?
-                                   (not
-                                    (let loop ([i board-width]
-                                               [continue? #f])
-                                      (cond
-                                        [(zero? i) continue?]
-                                        [else
-                                         (or continue?
-                                             (loop
-                                              (sub1 i)
-                                              (let loop ([j board-height]
-                                                         [continue? continue?])
-                                                (cond
-                                                  [(zero? j) continue?]
-                                                  [else
-                                                   (or continue?
-                                                       (loop
-                                                        (sub1 j)
-                                                        (> (length (find-same-colors (sub1 i) (sub1 j))) 1)))]))))])))) 
-                             (when game-over?
-                               (call-with-dc (lambda (dc) (paint-game-over dc)))))))]
-                      
-                      [else (void)])))]
-          
-          [define/override on-paint
-            (lambda ()
-              (let ([dc (get-dc)])
-                (send dc set-pen white-pen)
-                (send dc set-brush white-brush)
-                (let loop ([i board-width])
-                  (cond
-                    [(zero? i) (void)]
-                    [else (draw-line dc (- i 1))
-                          (loop (- i 1))]))
-                (when game-over?
-                  (paint-game-over dc))))]
-          
-          (super-new)
-
-	  (send (get-dc) set-smoothing 'aligned)))
-      
-      (define semaphore (make-semaphore 0))
-      (define same-frame%
-        (class frame%
-          [define/augment on-close
-            (lambda ()
-	      (semaphore-post semaphore)
-              (inner (void) on-close))]
-          (super-new [style '(metal)])))
-      
-      (define find-largest-connected-region
-        (let ([biggest-so-far 0]
-              [tests 0])
-          (lambda ()
-            (let ([answer 0])
-              (let loop ([i 20])
-                (cond
-                  [(zero? i) (void)]
-                  [else
-                   (let loop ([j 10])
-                     (cond
-                       [(zero? j) (void)]
-                       [else (set! answer
-                                   (max
-                                    answer
-                                    (length
-                                     (send canvas find-same-colors
-                                           (- i 1) (- j 1)))))
-                             (loop (- j 1))]))
-                   (loop (- i 1))]))
-              (set! biggest-so-far (max biggest-so-far (calc-score answer)))
-              (set! tests (+ tests 1))
-              (printf "tests: ~a sofar: ~a largest connected region: ~a score ~a\n"
-                      tests
-                      biggest-so-far
-                      answer
-                      (calc-score answer))))))
-      
-      (define (new-game-callback redraw?)
-        (set! game-over? #f)
-        (set! board (build-board))
-        (unless (= score 0)
-          (set! score 0)
-          (send message set-label "0"))
-        (send this-message set-label "")
-        (when redraw?
-          (send canvas on-paint)))
-      
-      (define frame (make-object same-frame% "Same"))
-      (define panel (make-object vertical-panel% frame))
-      (define canvas (make-object same-canvas% panel))
-      (define hp (make-object horizontal-panel% panel))
-      (make-object message% "Total Score: " hp)
-      (define message (make-object message% "0" hp))
-      (make-object message% "This Score: " hp)
-      (define this-message (make-object message% "0" hp))
-      (define button (make-object button% "New Game" hp (lambda x (new-game-callback #t))))
-      '(make-object button% "Run Scores" hp (lambda x
-                                              (let loop ()
-                                                (new-game-callback #f)
-                                                (find-largest-connected-region)
-                                                (loop))))
-      
-      (define help-button (make-object button% "Help"
-                            hp
-                            (let ([show-help
-                                   (show-scribbling
-                                    '(lib "games/scribblings/games.scrbl")
-                                    "same")])
-                              (lambda (_1 _2)
-                                (show-help)))))
-      
-      (send message stretchable-width #t)
-      (send this-message stretchable-width #t)
-      (send hp stretchable-height #f)
-      (send canvas min-width (* board-width cell-size))
-      (send canvas min-height (* board-height cell-size))
-      
-      (send frame show #t)
-      (yield semaphore))))
+(define game@
+  (unit
+    (import)
+    (export)
     
+    (define board-width 20)
+    (define board-height 10)
+    (define colors (map (lambda (x) (make-object color% x))
+                        (list "blue" "red" "brown" "forestgreen" "darkviolet")))
+    (define pale-colors (map (λ (x) 
+                               (define (paleize x) (- 255 (floor (/ (- 255 x) 2))))
+                               (make-object color%
+                                 (paleize (send x red))
+                                 (paleize (send x green))
+                                 (paleize (send x blue))))
+                             colors))
+    
+    ;; these are the sizes that the on-paint callback draws at;
+    ;; a scaling factor is applied to make the board fit the window
+    (define cell-w 11)
+    (define cell-h 11)
+    (define pen-size 10)
+    
+    (define (blob-sel-x b) (vector-ref b 1))
+    (define (blob-sel-y b) (vector-ref b 2))
+    
+    ;; build-board : (-> (vectorof (vectorof (vector (union num #f) boolean))))
+    ;   this represents the board. Each entry is the color index of
+    ;   the piece and a node to mark for the depth-first traversal.
+    ;   #f for the color index indicates an eliminated piece.
+    (define (build-board)
+      (build-vector
+       board-width
+       (lambda (i)
+         (build-vector
+          board-height
+          (lambda (j)
+            (vector
+             (begin
+               (if (zero? (modulo (+ j i) 4))
+                   0
+                   1)
+               #;
+               (if (zero? (modulo (+ j i) 2))
+                   0
+                   1)
+               #;
+               (if (= j (- board-height 1))
+                   (- (length colors) 1)
+                   (modulo i (- (length colors) 1)))
+               ;0
+               #;(random (length colors)))
+             #f))))))
+    
+    (define board (build-board))
+    
+    (define game-over? #f)
+    
+    ;; adds up as the user clicks
+    (define clicked-score 0)
+    (define (calc-score n) (* n n))
+    (define (reset-score)
+      (set! clicked-score 0)
+      (set-score-label))
+    (define (update-score balls-going-away)
+      (set! clicked-score (+ clicked-score (* balls-going-away balls-going-away)))
+      (set-score-label))
+    (define (set-score-label)
+      (define penalty 0)
+      (for ([v (in-vector board)])
+        (for ([v (in-vector v)])
+          (when (vector-ref v 0)
+            (set! penalty (+ penalty 10)))))
+      (send score-message set-label 
+            (format "~a - ~a = ~a"
+                    clicked-score
+                    penalty
+                    (- clicked-score penalty))))
+                    
+    
+    (define same-canvas%
+      (class canvas%
+        (inherit get-dc get-client-size)
+        (define/private (get-width) (let-values ([(w h) (get-client-size)]) w))
+        (define/private (get-height) (let-values ([(w h) (get-client-size)]) h))
+        (define/private (get-x-step) (/ (get-width) board-width))
+        (define/private (get-y-step) (/ (get-height) board-height))
+        
+        (define mouse-current-x #f)
+        (define mouse-current-y #f)
+        (define mouse-clicked-x #f)
+        (define mouse-clicked-y #f)
+        (define mouse-over-chosen? #t)
+        
+        (define/override (on-paint)
+          (define dc (get-dc))
+          (send dc erase)
+          (define-values (cw ch) (get-client-size))
+          (define pen-size (- (floor (min cell-w cell-h)) 2))
+          (send dc set-brush "black" 'transparent)
+          (send dc set-smoothing 'smoothed)
+          (send dc set-scale 
+                (/ cw (* board-width cell-w)) 
+                (/ ch (* board-height cell-h)))
+          (define painted (make-hash))
+          (for* ([i (in-range 0 board-width)]
+                 [j (in-range 0 board-height)])
+            (unless (hash-ref painted (xy->key i j) #f)
+              (define color (vector-ref (vector-ref (vector-ref board i) j) 0))
+              (when color
+                (define blob (find-same-colors i j))
+                (for ([x (in-list blob)])
+                  (hash-set! painted (xy->key (blob-sel-x x) (blob-sel-y x)) #t))
+                (update-pen/draw-blob blob dc color cell-w cell-h i j))))
+          (when game-over?
+            (paint-game-over)))
+        
+        (define/private (update-pen/draw-blob blob dc color cell-w cell-h i j)
+          (define mouse-over? #f)
+          (define mouse-clicked-over? #f)
+          (define multiple-cells? #f)
+          
+          (when (or (number? mouse-current-x)
+                    (number? mouse-clicked-x))
+            (for ([obj (in-list blob)])
+              (define x (blob-sel-x obj))
+              (define y (blob-sel-y obj))
+              (when (or (not (equal? x i))
+                        (not (equal? y j)))
+                (set! multiple-cells? #t))
+              (when (and (equal? x mouse-current-x)
+                         (equal? y mouse-current-y))
+                (set! mouse-over? #t))
+              (when (and (equal? x mouse-clicked-x)
+                         (equal? y mouse-clicked-y))
+                (set! mouse-clicked-over? #t))))
+          
+          (cond
+            [mouse-clicked-x ;; has the mouse been clicked in a clickable place?
+             (cond 
+               [(and mouse-over? mouse-clicked-over? multiple-cells?)
+                (send dc set-pen
+                      (list-ref colors color)
+                      (* pen-size 2/3)
+                      'solid)
+                (draw-blob blob i j)
+                (send dc set-pen
+                      (list-ref pale-colors color)
+                      (* pen-size 2/3 1/2)
+                      'solid)
+                (draw-blob blob i j)]
+               [(and mouse-over? mouse-clicked-over?)
+                (send dc set-pen
+                      (list-ref colors color)
+                      pen-size
+                      'solid)
+                (draw-blob blob i j)]
+               [else
+                (send dc set-pen
+                   (list-ref colors color)
+                   pen-size
+                   'solid)
+                (draw-blob blob i j)])]
+            [else
+             (send dc set-pen (list-ref colors color) pen-size 'solid)
+             (draw-blob blob i j)
+             (when mouse-over?
+               (send dc set-pen
+                     (list-ref pale-colors color)
+                     (* pen-size 2/3)
+                     'solid)
+               (draw-blob blob i j))]))
+        
+        (define (draw-blob blob i j)
+          (define dc (get-dc))
+          (define (connect x1 y1 x2 y2)
+            (send dc draw-line 
+                  (+ (/ cell-w 2) (* x1 cell-w))
+                  (+ (/ cell-h 2) (* y1 cell-h))
+                  (+ (/ cell-w 2) (* x2 cell-w))
+                  (+ (/ cell-h 2) (* y2 cell-h))))
+          (cond
+            [(null? (cdr blob))
+             (define pt (car blob))
+             (connect (blob-sel-x pt) (blob-sel-y pt) (blob-sel-x pt) (blob-sel-y pt))]
+            [else
+             (for* ([b1 (in-list blob)]
+                    [b2 (in-list blob)])
+               (when (= (+ (abs (- (blob-sel-x b1) (blob-sel-x b2)))
+                           (abs (- (blob-sel-y b1) (blob-sel-y b2))))
+                        1)
+                 (connect (blob-sel-x b1) (blob-sel-y b1) (blob-sel-x b2) (blob-sel-y b2))))]))
+        
+        (define/private (xy->key x y) (+ (* board-width y) x))
+        
+        (define/public (find-same-colors i j)
+          (let* ([index (vector-ref (vector-ref (vector-ref board i) j) 0)]
+                 [ans
+                  (let loop ([i i]
+                             [j j]
+                             [ps null])
+                    (cond
+                      [(not (and (<= 0 i) (< i board-width)
+                                 (<= 0 j) (< j board-height)))
+                       ps]
+                      [(vector-ref (vector-ref (vector-ref board i) j) 1) ps]
+                      [(not (vector-ref (vector-ref (vector-ref board i) j) 0)) ps]
+                      [(= index (vector-ref (vector-ref (vector-ref board i) j) 0))
+                       (let ([v (vector-ref (vector-ref board i) j)])
+                         (vector-set! v 1 #t)
+                         (loop (+ i 1)
+                               j
+                               (loop (- i 1)
+                                     j
+                                     (loop i
+                                           (- j 1)
+                                           (loop i
+                                                 (+ j 1)
+                                                 (cons (vector v i j)
+                                                       ps))))))]
+                      [else ps]))])
+            (for-each (lambda (p) (vector-set! (vector-ref p 0) 1 #f)) ans)
+            ans))
+        
+        (define/public (paint-game-over)
+          (define dc (get-dc))
+          (send dc set-font font)
+          (define border 5)
+          (define-values (text-width text-height d l)
+            (send dc get-text-extent game-over))
+          (define x (- (/ (* cell-w board-width) 2) (/ text-width 2)))
+          (define y (- (/ (* cell-h board-height) 2) (/ text-height 2)))
+          (send dc set-pen "white" 1' transparent)
+          (send dc set-brush "white" 'solid)
+          (send dc set-alpha .8)
+          (send dc draw-rectangle
+                (- x border border) (- y border)
+                (+ text-width border border border border)
+                (+ text-height border border))
+          (send dc set-alpha 1)
+          (send dc draw-text game-over x y))
+        
+        
+        [define game-over "Game Over"]
+        [define font (make-object font% 24 'decorative 'normal 'normal #f)]
+        [define turned null]
+        
+        [define/public (call-with-dc proc)
+          ;; Since we're not in `on-paint', need to manually
+          ;; suspend and resume flushing, so that intermediate
+          ;; states are not flushed to the screen.
+          (let ([dc (get-dc)])
+            (send dc suspend-flush)
+            (proc dc)
+            (send dc resume-flush))]
+        
+        (inherit refresh) 
+        (define/override (on-event evt)
+          (define x (send evt get-x))
+          (define y (send evt get-y))
+          (define-values (cw ch) (get-client-size))
+          (define bx (floor (* (/ x cw) board-width)))
+          (define by (floor (* (/ y ch) board-height)))
+          (unless (<= 0 bx (- board-width 1)) (set! bx #f))
+          (unless (<= 0 by (- board-height 1)) (set! by #f))
+          (when (send evt leaving?)
+            (set! bx #f)
+            (set! by #f))
+          
+          (when (send evt button-up?)
+            (when (and (equal? mouse-clicked-x bx)
+                       (equal? mouse-clicked-y by))
+              (make-a-move)
+              (update-game-over)
+              (refresh)))
+          
+          (define-values (new-mouse-clicked-x new-mouse-clicked-y)
+            (cond
+              [(send evt button-down?) (values bx by)]
+              [(send evt button-up?) (values #f #f)]
+              [else (values mouse-clicked-x mouse-clicked-y)]))
+          (unless (and (equal? mouse-clicked-x new-mouse-clicked-x)
+                       (equal? mouse-clicked-y new-mouse-clicked-y))
+            (set! mouse-clicked-x new-mouse-clicked-x)
+            (set! mouse-clicked-y new-mouse-clicked-y)
+            (refresh))
+          
+          (unless (and (equal? bx mouse-current-x)
+                       (equal? by mouse-current-y))
+            (set! mouse-current-x bx)
+            (set! mouse-current-y by)
+            (refresh)))
+          
+        (define/private (make-a-move)
+          (define i mouse-clicked-x)
+          (define j mouse-clicked-y)
+          (let ([same-colors (find-same-colors i j)])
+            
+            (when (>= (length same-colors) 2)
+              
+              ;; slide down empty pieces
+              (let ([is null])
+                (for-each
+                 (lambda (p)
+                   (let ([i (blob-sel-x p)]
+                         [j (blob-sel-y p)])
+                     (unless (member i is)
+                       (set! is (cons i is)))
+                     (let loop ([x j])
+                       (cond
+                         [(<= 1 x)
+                          (let ([next (vector-ref (vector-ref board i) (- x 1))]
+                                [this (vector-ref (vector-ref board i) x)])
+                            (vector-set! this 0 (vector-ref next 0))
+                            (loop (- x 1)))]
+                         [else
+                          (vector-set! (vector-ref (vector-ref board i) x) 0 #f)]))))
+                 (sort same-colors
+                       (lambda (x y) (<= (blob-sel-y x) (blob-sel-y y)))))
+                
+                ;; slide empty over empty rows
+                (set! is (sort is >))
+                (let ([empty-is 
+                       (filter (lambda (i)
+                                 (not (vector-ref 
+                                       (vector-ref (vector-ref board i) (- board-height 1))
+                                       0)))
+                               is)])
+                  (let ([is (if (null? empty-is)
+                              is
+                              (filter (lambda (x) (< x (car empty-is)))
+                                      is))])
+                    (for-each (lambda (empty-i)
+                                (let loop ([i empty-i])
+                                  (cond
+                                    [(<= i (- board-width 2))
+                                     (vector-set! board i (vector-ref board (+ i 1)))
+                                     (loop (+ i 1))]
+                                    [(= i (- board-width 1))
+                                     (vector-set! 
+                                      board
+                                      i
+                                      (build-vector board-height
+                                                    (λ (i) (vector #f #f))))])))
+                              empty-is))))
+              
+              
+              ;; tally disappearing balls
+              (update-score (length same-colors)))))
+        
+        (define/public-final (update-game-over)
+          (set! game-over?
+                (not
+                 (let loop ([i board-width]
+                            [continue? #f])
+                   (cond
+                     [(zero? i) continue?]
+                     [else
+                      (or continue?
+                          (loop
+                           (sub1 i)
+                           (let loop ([j board-height]
+                                      [continue? continue?])
+                             (cond
+                               [(zero? j) continue?]
+                               [else
+                                (or continue?
+                                    (loop
+                                     (sub1 j)
+                                     (> (length (find-same-colors (sub1 i) (sub1 j))) 1)))]))))])))))
+        
+        
+        
+        (super-new)))
+    
+    (define semaphore (make-semaphore 0))
+    (define same-frame%
+      (class frame%
+        [define/augment on-close
+          (lambda ()
+            (semaphore-post semaphore)
+            (inner (void) on-close))]
+        (super-new [style '(metal)])))
+    
+    (define (new-game-callback redraw?)
+      (set! game-over? #f)
+      (set! board (build-board))
+      (reset-score)
+      (send canvas update-game-over)
+      (when redraw?
+        (send canvas refresh)))
+    
+    (define frame (make-object same-frame% "Same"))
+    (define panel (make-object vertical-panel% frame))
+    (define canvas (make-object same-canvas% panel))
+    (define hp (new horizontal-panel% [parent panel] [stretchable-height #f]))
+    (new message% [label "Total Score: "] [parent hp])
+    (define score-message (new message% [label ""] [parent hp] [stretchable-width #t]))
+    (define button (make-object button% "New Game" hp (lambda x (new-game-callback #t))))
+    
+    (define help-button (make-object button% "Help"
+                          hp
+                          (let ([show-help
+                                 (show-scribbling
+                                  '(lib "games/scribblings/games.scrbl")
+                                  "same")])
+                            (lambda (_1 _2)
+                              (show-help)))))
+    
+    (send canvas update-game-over)
+    (reset-score)
+    (send canvas min-width (* board-width cell-w 2))
+    (send canvas min-height (* board-height cell-h 2))
+    (send frame show #t)
+    (yield semaphore)))
+
+(invoke-unit game@)
diff --git a/collects/games/scribblings/same.scrbl b/collects/games/scribblings/same.scrbl
index 5026ac5489..6ea1beb19d 100644
--- a/collects/games/scribblings/same.scrbl
+++ b/collects/games/scribblings/same.scrbl
@@ -3,19 +3,18 @@
 
 @gametitle["Same" "same" "Dot-Removing Game"]
 
-The object of @game{Same} is to score points by removing dots from the
-board.  To remove a dot, click on it.  As long as there is another dot
-of the same color next to the clicked dot, it will disappear along
-with all adjacent dots of the same color.  After the dots disappear,
-dots in the rows above the deleted dots will fall into the vacated
-spaces.  If an entire column is wiped out, all of the dots from the
+The object of @game{Same} is to score points by removing blobs from the
+board.  To remove a blob, click on it.  As long the blob is not just
+a simple circle, it will disappear.  After the blob disappears,
+the remaining pieces of the board shift around, breaking up blobs into
+new blobs as pieces of the old blobs fall down to fill in the empty space.
+If an entire column is wiped out, all of the blobs from the
 right will slide left to take up the empty column's space.
 
-Your score increases for each ball removed from the board.  The score
-for each click is a function of the number of balls that disappeared.
-The @onscreen{This Click} label shows how many points you would score
-for clicking the dots underneath the mouse pointer.  The score varies
-quadratically with the number of balls, so eliminating many balls with
-one click is advantageous.
+Your score increases for each ball removed from the board. In general,
+when you remove a blob, you get as many points as the square of the number
+of cells the blob occupied, so removing bigger blobs is better. Also,
+there is a penalty of 10 points for each colored cell left behind on the board,
+so try to clear out the entire board.
 
 Click the @onscreen{New Game} button to play again.