improved same game
- new drawing algorithm (makes the connected regions easier to see) - different scoring mechanism (give points for having few pieces left) - make the window resizable - general cleanup of the code
This commit is contained in:
Robby Findler
parent
f1e13a7921
commit
2553553f09
|
|
@ -1,9 +1,8 @@
|
|||
(module same mzscheme
|
||||
(require mzlib/etc
|
||||
mzlib/class
|
||||
mzlib/unit
|
||||
mred
|
||||
mzlib/list
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
racket/unit
|
||||
racket/list
|
||||
racket/gui/base
|
||||
"../show-scribbling.ss")
|
||||
|
||||
(provide game@)
|
||||
|
|
@ -15,12 +14,24 @@
|
|||
|
||||
(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))
|
||||
(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
|
||||
|
|
@ -35,21 +46,46 @@
|
|||
(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)))
|
||||
(random (length colors)))
|
||||
;0
|
||||
#;(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))]))
|
||||
;; 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%
|
||||
|
|
@ -58,39 +94,115 @@
|
|||
(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 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/public find-same-colors
|
||||
(lambda (i j)
|
||||
(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]
|
||||
|
|
@ -113,36 +225,34 @@
|
|||
(- j 1)
|
||||
(loop i
|
||||
(+ j 1)
|
||||
(cons (list v i j) ps))))))]
|
||||
(cons (vector v i j)
|
||||
ps))))))]
|
||||
[else ps]))])
|
||||
(for-each (lambda (p) (vector-set! (first p) 1 #f)) ans)
|
||||
ans))]
|
||||
(for-each (lambda (p) (vector-set! (vector-ref p 0) 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)
|
||||
(define/public (paint-game-over)
|
||||
(define dc (get-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)
|
||||
(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) (- y border)
|
||||
(+ text-width border border)
|
||||
(- x border border) (- y border)
|
||||
(+ text-width border border border border)
|
||||
(+ text-height border border))
|
||||
(send dc draw-text game-over x y)))]
|
||||
(send dc set-alpha 1)
|
||||
(send dc draw-text game-over x y))
|
||||
|
||||
|
||||
(field
|
||||
[game-over "Game Over"]
|
||||
[font (make-object font% 24 'decorative 'normal 'normal #f)]
|
||||
[turned null])
|
||||
[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
|
||||
|
|
@ -153,69 +263,56 @@
|
|||
(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 "")]))]
|
||||
(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))
|
||||
|
||||
[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)))])
|
||||
(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
|
||||
[(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 "")
|
||||
[(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)])
|
||||
|
||||
;; 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)])
|
||||
(let ([i (blob-sel-x p)]
|
||||
[j (blob-sel-y p)])
|
||||
(unless (member i is)
|
||||
(set! is (cons i is)))
|
||||
(let loop ([x j])
|
||||
|
|
@ -228,12 +325,15 @@
|
|||
[else
|
||||
(vector-set! (vector-ref (vector-ref board i) x) 0 #f)]))))
|
||||
(sort same-colors
|
||||
(lambda (x y) (<= (third x) (third y)))))
|
||||
(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)))
|
||||
(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
|
||||
|
|
@ -246,25 +346,18 @@
|
|||
(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)
|
||||
(vector-set!
|
||||
board
|
||||
i
|
||||
(build-vector board-height
|
||||
(λ (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)
|
||||
)))
|
||||
;; tally disappearing balls
|
||||
(update-score (length same-colors)))))
|
||||
|
||||
(define/public-final (update-game-over)
|
||||
(set! game-over?
|
||||
(not
|
||||
(let loop ([i board-width]
|
||||
|
|
@ -283,28 +376,11 @@
|
|||
(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)))))))]
|
||||
(> (length (find-same-colors (sub1 i) (sub1 j))) 1)))]))))])))))
|
||||
|
||||
[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)))
|
||||
(super-new)))
|
||||
|
||||
(define semaphore (make-semaphore 0))
|
||||
(define same-frame%
|
||||
|
|
@ -315,58 +391,21 @@
|
|||
(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 "")
|
||||
(reset-score)
|
||||
(send canvas update-game-over)
|
||||
(when redraw?
|
||||
(send canvas on-paint)))
|
||||
(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 (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 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))))
|
||||
'(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
|
||||
|
|
@ -377,12 +416,11 @@
|
|||
(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 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))))
|
||||
(yield semaphore)))
|
||||
|
||||
(invoke-unit game@)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user