From 9c63710b14217dc6904c27e664db4dd6a94c1636 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 14 Jan 2011 17:00:21 -0600
Subject: [PATCH] same: refactor drawing of the board to have a bitmap
 background   (speeds up redraws on my win7 machine from about 200msec to
 about 15msec)   also use that refactoring to draw a bitmap for the icon using
 the   same, new style

---
 collects/games/same/same.png | Bin 389 -> 1014 bytes
 collects/games/same/same.rkt | 421 +++++++++++++++++++++--------------
 2 files changed, 258 insertions(+), 163 deletions(-)

diff --git a/collects/games/same/same.png b/collects/games/same/same.png
index 96480a55e97c922064cb0b0a2fc0eee7c94e53e6..b763da119020a19c78b82c16356a5fafdcb4841c 100644
GIT binary patch
delta 975
zcmV;=12FuB1NH}yHGc!ENkl<ZScR>ZPiP!v7{-6^x0~(S)HGQtqR?b_DF`+;{yAti
z4Fvo{qqizT0$Ql`4}_i?474J9Flr1QL_A2^#(1gNq8DvzPl0u94~?J}St8k*w5GHP
ziBZyx$?m)!W|G?MxI2^10|WEtdEe*xK4zZzKH)ZK3g`kJ0e?bx!z6GH<ha|z=Aq_$
z3-g6nfmTA~ffEylCVp6bE{<>%I0JNe6m`Qaum@yp^+xi;WS?5vFUW0!5oC1x;`Ywb
z^yrdt?w!6vae!?=26Qt(Vj%GX7VobY2T-)*%9bmqZ8P??XYWw_zxWE|`Q%`70jR4)
z6eDd0=nhaE;D3pDI$mE*96(jO4Uh=fz}9eWxZMj;Ra*>jK41fXSYfNi6H^EqU<fD%
zXyBM1vH`gcycLl6C6Et%8UT<1;6-3zgTh5%7~~<ph2dMLauPTRS`R!0L_PMn2$J(F
zTxLLFGcW>@!VVRwP$$??Ep{n4fgXX84H-~)49Ea?`G0NTn5YFlQ+Q3F%}=pW`#m_b
zLGkrSDeUuQ0K4Fx0K`}EiC+VI0u%@PUGilha73)gB~L_U$^d5r*4Nyj+_)fB(^V`v
zYp_3^nE(wG0aWz!iY#R&|7L!~2v|TTPzcC?1(5H}zk=|KyS5f0Cen#u832JX?C?1S
zOasfnihs-D3;EvsE>Y=27)MxCblPA}#p+_)a=p1R*P`LLMvo@un-nceLWP2YRyoRM
zQbFEHC7RM5@v?Yd6FHWcZwaaS7}ZvUFz}bciDhH;y`GOPtQw&DKVnIoP)k3)qb?lL
z0aUuNS4c%g&nuyWZ+}1j)0%<d#Gg-#@(mDiaep|uQj|vzT-`e7$G||_19z{O(vK)R
zTsX@jviC^lw{OjtJ8x_e<*1vuGwP;r$oi;?Xc>x99Q+?~fQYI!^xp2q2D7-hX*bYV
zv71QOr}s~LPB;Zoq^mMZ?z1HFoDp=Fhn}J6rrKt&2KrNpM!c+wkrtyWSG_bXm2?)E
z^M62{D@OD>-qx8jrev%v_IF<adTswyeIB^rq3MP6=<iD)Rk;Q$YYtp)m;~vsL=>gR
zIem%BiCJ(sh!lIMFfc{FIGmZt8i1yF-MgX;qGi)|Q$!B#n{4<RK<uSgJN8C&J!XM+
zhr^M~<)1}lFX%Nl@tSDq4X5WV9B=&lK}ZQ%Pl}RM(O*MiefM%cHswA7_5;s2m*)gr
xx992Bow1tmKhIjq!y<CSU}X<yCf4?%{{r6#L|PFuP>28k002ovPDHLkV1m76$`Swo

delta 345
zcmV-f0jB=;2ZaNWHGcpJa7bBm000XS000XS0e@s)kpKVy2XskIMF-Ri0uUWD#5kjQ
z0003JNkl<Zc%1E5%Mt@22qRAa|Ci}uec=NYW~V*Kp`B?Hh`5p!%uICvG>ry22!&j-
zNJbLS6xK?i7b3_iw}pY3>*C8bW+10znY_&{B&Ja3JV-!*z<(ccYkbi5d_#tZOhh0=
zF{dlY!R%W>SYzIeE8q$U>+$+#ltE-VOK}=n&moB77WlegB|p6U43ycvNf-FjX;kp&
z?D+YZE=v^(5V6*hUg$>@&bWCBjQ*|-MePN;{eJ9ttF#PGrC_k*%0TRPOb$B+Dmy-6
zc8T2F)B)33ic(Lo>m2@e6a#<Y1y{fo5Wj794EXKX=fuvp8J0JrGdq^}(=POO++@%%
rr`<1x%W0}Rd>@#^`gXq2h^F2bI&onojCH0;00000NkvXXu0mjf!DyIp

diff --git a/collects/games/same/same.rkt b/collects/games/same/same.rkt
index 78150f8c63..14891087e7 100644
--- a/collects/games/same/same.rkt
+++ b/collects/games/same/same.rkt
@@ -15,24 +15,6 @@
     
     (define board-width 20)
     (define board-height 16)
-    (define colors (map (lambda (x) (make-object color% x))
-                        (list "blue" "red" "brown" "forestgreen" "purple")))
-    (define pale-colors 
-      (for/list ([x (in-list colors)])
-        (define (paleize x) (- 255 (floor (* (- 255 x) 2/3))))
-        (make-object color%
-          (paleize (send x red))
-          (paleize (send x green))
-          (paleize (send x blue)))))
-    
-    ;; 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
@@ -56,8 +38,8 @@
             (if (zero? (random 2))
                 (values x (- y 1))
                 (values (- x 1) y)))
-          (define this-vector (vector-ref (vector-ref board x) y))
-          (define prev-vector (vector-ref (vector-ref board prev-x) prev-y))
+          (define this-vector (board-ref board x y))
+          (define prev-vector (board-ref board prev-x prev-y))
           (vector-set! this-vector 0 (vector-ref prev-vector 0))))
       board)
     
@@ -103,132 +85,88 @@
         (define mouse-current-y #f)
         (define mouse-clicked-x #f)
         (define mouse-clicked-y #f)
-        (define mouse-over-chosen? #t)
+        
+        (define background-valid? #f)
+        (define background #f)
+        
+        (define/public (invalidate-board-bitmap)
+          (set! background-valid? #f))
+          
+        (define/override (on-size w h)
+          (define-values (cw ch) (get-client-size))
+          (when background
+            (unless (and (= cw (send background get-width))
+                         (= ch (send background get-height)))
+              (set! background #f)
+              (set! background-valid? #f))))
         
         (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)
+          (define dc (get-dc))
           (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))))
+          (build-background)
+          (send dc set-scale 1 1)
+          (send dc draw-bitmap background 0 0)
           
+          (define current-blob 
+            (and mouse-current-x 
+                 (find-same-colors board board-width board-height 
+                                   mouse-current-x
+                                   mouse-current-y)))
           (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 pale-colors color) (* pen-size 2/3) '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
-             (cond
-               [mouse-over?
-                (send dc set-pen (list-ref pale-colors color) (* pen-size 2/3) 'solid)
-                (draw-blob blob i j)]
-               [else
-                (send dc set-pen (list-ref colors color) pen-size 'solid)
-                (draw-blob blob i j)])]))
+            [(and mouse-clicked-x
+                  mouse-current-x
+                  (equal? mouse-clicked-x mouse-current-x)
+                  (equal? mouse-clicked-y mouse-current-y))
+             
+             ;; don't know what to do here
+             
+             (define blob
+               (find-same-colors board board-width board-height 
+                                 mouse-current-x
+                                 mouse-current-y))
+             (unless (null? blob)
+               (define color
+                 (vector-ref (board-ref board mouse-current-x mouse-current-y)
+                             0))
+               (define-values (cw ch) (get-client-size))
+               (update-dc-scale dc cw ch board-width board-height)
+               (update-pen/draw-blob
+                blob dc color
+                mouse-current-x mouse-current-y
+                mouse-clicked-x mouse-clicked-y))]
+            [mouse-current-x
+             (define blob
+               (find-same-colors board board-width board-height 
+                                 mouse-current-x
+                                 mouse-current-y))
+             (unless (null? blob)
+               (define color
+                 (vector-ref (board-ref board mouse-current-x mouse-current-y)
+                             0))
+               (define-values (cw ch) (get-client-size))
+               (update-dc-scale dc cw ch board-width board-height)
+               (update-pen/draw-blob
+                blob dc color
+                mouse-current-x mouse-current-y
+                mouse-clicked-x mouse-clicked-y))]))
         
-        (define (draw-blob blob i j)
+        (define/private (build-background)
+          (unless background-valid?
+            (define-values (cw ch) (get-client-size))
+            (unless background
+              (set! background (make-bitmap cw ch)))
+            (define bdc (make-object bitmap-dc% background))
+            (draw-board bdc board-width board-height board cw ch #f #f #f #f)
+            (send bdc set-bitmap #f)
+            (set! background-valid? #t)))
+        
+        (define/private (paint-game-over)
           (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 game-over "Game Over")
+          (send dc set-font 
+                (send the-font-list find-or-create-font
+                      24 'decorative 'normal 'normal #f))
           (define border 5)
           (define-values (text-width text-height d l)
             (send dc get-text-extent game-over))
@@ -244,20 +182,6 @@
           (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))
@@ -312,7 +236,10 @@
           (send this-score-message set-label 
                 (cond
                   [(and x y)
-                   (define num (length (find-same-colors x y)))
+                   (define num (length (find-same-colors board
+                                                         board-width
+                                                         board-height
+                                                         x y)))
                    (if (= num 1)
                        ""
                        (format "~a" (calc-score num)))]
@@ -321,7 +248,8 @@
         (define/private (make-a-move)
           (define i mouse-clicked-x)
           (define j mouse-clicked-y)
-          (let ([same-colors (find-same-colors i j)])
+          (invalidate-board-bitmap)
+          (let ([same-colors (find-same-colors board board-width board-height i j)])
             
             (when (>= (length same-colors) 2)
               
@@ -336,12 +264,12 @@
                      (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)])
+                          (let ([next (board-ref board i (- x 1))]
+                                [this (board-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)]))))
+                          (vector-set! (board-ref board i x) 0 #f)]))))
                  (sort same-colors
                        (lambda (x y) (<= (blob-sel-y x) (blob-sel-y y)))))
                 
@@ -350,7 +278,7 @@
                 (let ([empty-is 
                        (filter (lambda (i)
                                  (not (vector-ref 
-                                       (vector-ref (vector-ref board i) (- board-height 1))
+                                       (board-ref board i (- board-height 1))
                                        0)))
                                is)])
                   (let ([is (if (null? empty-is)
@@ -394,7 +322,12 @@
                                 (or continue?
                                     (loop
                                      (sub1 j)
-                                     (> (length (find-same-colors (sub1 i) (sub1 j))) 1)))]))))])))))
+                                     (> (length (find-same-colors board 
+                                                                  board-width
+                                                                  board-height
+                                                                  (sub1 i)
+                                                                  (sub1 j)))
+                                        1)))]))))])))))
         
         
         
@@ -413,6 +346,7 @@
       (set! game-over? #f)
       (set! board (build-board))
       (reset-score)
+      (send canvas invalidate-board-bitmap)
       (send canvas update-game-over)
       (when redraw?
         (send canvas refresh)))
@@ -422,9 +356,14 @@
     (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 score-message (new message% 
+                               [label "1000 + 1000 = 2000"] ;; get a reasonable min size
+                               [parent hp] [stretchable-width #t]))
     (new message% [label "This Score: "] [parent hp])
-    (define this-score-message (new message% [label ""] [parent hp] [stretchable-width #t]))
+    (define this-score-message (new message% 
+                                    [label "100"] ;; get a reasonable min size
+                                    [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"
@@ -438,7 +377,163 @@
     
     (send canvas update-game-over)
     (reset-score)
-    (send canvas min-width (* board-width cell-w 3))
-    (send canvas min-height (* board-height cell-h 3))
+    (send canvas min-width (ceiling (* board-width cell-w #e2.5)))
+    (send canvas min-height (ceiling (* board-height cell-h #e2.5)))
     (send frame show #t)
     (void (yield semaphore))))
+
+;; 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 colors (map (lambda (x) (make-object color% x))
+                    (list "blue" "red" "brown" "forestgreen" "purple")))
+(define pale-colors 
+  (for/list ([x (in-list colors)])
+    (define (paleize x) (- 255 (floor (* (- 255 x) 2/3))))
+    (make-object color%
+      (paleize (send x red))
+      (paleize (send x green))
+      (paleize (send x blue)))))
+
+(define (draw-board dc board-width board-height board cw ch
+                    mouse-current-x mouse-current-y mouse-clicked-x mouse-clicked-y)
+  (send dc erase) 
+  (send dc set-smoothing 'smoothed)
+  (update-dc-scale dc cw ch board-width board-height)
+  (define painted (make-hash))
+  (for* ([i (in-range 0 board-width)]
+         [j (in-range 0 board-height)])
+    (unless (hash-ref painted (xy->key board-width i j) #f)
+      (define color (vector-ref (board-ref board i j) 0))
+      (when color
+        (define blob (find-same-colors board board-width board-height i j))
+        (for ([x (in-list blob)])
+          (hash-set! painted (xy->key board-width (blob-sel-x x) (blob-sel-y x)) #t))
+        (update-pen/draw-blob
+         blob dc color
+         mouse-current-x mouse-current-y mouse-clicked-x mouse-clicked-y)))))
+
+(define (update-dc-scale dc cw ch board-width board-height)
+  (send dc set-scale 
+        (/ cw (* board-width cell-w)) 
+        (/ ch (* board-height cell-h))))
+
+(define (update-pen/draw-blob
+         blob dc color
+         mouse-current-x mouse-current-y mouse-clicked-x mouse-clicked-y)
+  (define mouse-over? #f)
+  (define mouse-clicked-over? #f)
+  (define multiple-cells? (not (or (null? blob) (null? (cdr blob)))))
+  
+  (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 (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 pale-colors color) (* pen-size 2/3) 'solid)
+        (draw-blob dc blob)]
+       [else
+        (send dc set-pen
+              (list-ref colors color)
+              pen-size
+              'solid)
+        (draw-blob dc blob)])]
+    [else
+     (cond
+       [mouse-over?
+        (send dc set-pen (list-ref pale-colors color) pen-size 'solid)
+        (draw-blob dc blob)]
+       [else
+        (send dc set-pen (list-ref colors color) pen-size 'solid)
+        (draw-blob dc blob)])]))
+
+(define (draw-blob dc blob)
+  (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 (xy->key board-width x y) (+ (* board-width y) x))
+
+(define (find-same-colors board board-width board-height i j)
+  (let* ([index (vector-ref (board-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]
+              [else
+               (let ([v (board-ref board i j)])
+                 (cond 
+                   [(vector-ref v 1) ps]
+                   [(not (vector-ref v 0)) ps]
+                   [(= index (vector-ref v 0))
+                    (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 (blob-sel-x b) (vector-ref b 1))
+(define (blob-sel-y b) (vector-ref b 2))
+
+(define (board-ref b x y) (vector-ref (vector-ref b x) y))
+
+(define (make-same-bitmap pth)
+  (define bw 32)
+  (define bh 32)
+  (define bitmap (make-bitmap bw bh))
+  (define bdc (make-object bitmap-dc% bitmap))
+  (define board-width 3)
+  (define board-height 3)
+  (define board 
+    (vector (vector (vector 0 #f) (vector 1 #f) (vector 4 #f))
+            (vector (vector 0 #f) (vector 1 #f) (vector 1 #f))
+            (vector (vector 3 #f) (vector 3 #f) (vector 2 #f))))
+  (draw-board bdc board-width board-height board bw bh
+              #f #f #f #f)
+  (send bdc set-bitmap #f)
+  (send bitmap save-file pth 'png))
+  
+; (make-same-bitmap "same.png")
+
+(invoke-unit game@)
\ No newline at end of file