home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / local / bin / bubbles.tcl < prev    next >
Encoding:
Tcl/Tk script  |  2004-09-15  |  44.1 KB  |  1,388 lines
  1. #!/usr/bin/wish
  2.   ###############################
  3.   #
  4.   #   Bubbles
  5.   #
  6.   set version 1.0.2a
  7.   #
  8.   #   Copyright ulis, 2004
  9.   #
  10.   #   Licence NOL
  11.   #
  12.   ###############################
  13.  
  14.   # ===========
  15.   # package
  16.   # ===========
  17.  
  18.   package require Tk
  19.   catch { console hide }
  20.  
  21.   # ===========
  22.   # images
  23.   # ===========
  24.  
  25.   set images(8) \
  26.   {
  27.     00 00 00 52 f7 00 00 00
  28.     00 52 bd c6 c6 c6 52 00
  29.     00 52 8c 94 94 94 8c 00
  30.     52 6b 84 8c 8c 8c 7b 63
  31.     52 84 b5 ce ce c6 a5 52
  32.     00 84 bd e7 e7 d6 a5 00
  33.     00 52 94 c6 ce b5 52 00
  34.     00 00 00 52 84 00 00 00
  35.   }
  36.   set images(16) \
  37.   {
  38.     00 00 00 00 00 00 c0 c0 c0 c0 00 00 00 00 00 00
  39.     00 00 00 c0 c0 ef ff f7 f7 f7 ff a5 c0 00 00 00
  40.     00 00 a5 a2 e7 de de de de de de d6 ce a0 00 00
  41.     00 a0 a0 bd bd bd c6 c6 c6 c6 c6 bd bd a3 9a 00
  42.     00 92 9a a5 a5 a5 a5 ad ad a5 a5 a5 a5 ab 8a 00
  43.     00 92 90 94 9c 94 94 94 94 94 94 8c 8c 83 82 00
  44.     80 a2 8a 8b 84 84 84 8c 8c 8c 84 84 7b 63 8a 80
  45.     80 aa 6b 7b 84 8c 8c 8c 8c 8c 8c 84 7b 73 73 80
  46.     80 c3 73 8c 9c a5 ad ad ad ad ad a5 94 84 7b 80
  47.     80 c3 84 9c b5 c6 ce ce ce ce c6 bd a5 8c 73 80
  48.     00 aa 84 a5 c6 d6 de e7 e7 e7 d6 c6 ad 8c 73 00
  49.     00 94 84 a5 bd d6 e7 e7 e7 e7 d6 bd a5 84 8a 00
  50.     00 a0 8b 94 b5 ce de e7 e7 de ce b5 94 73 90 00
  51.     00 00 a0 73 94 b5 c6 ce ce c6 b5 94 73 ad 00 00
  52.     00 00 00 a0 9c 84 a5 ad ad a5 8c 73 90 00 00 00
  53.     00 00 00 00 00 00 80 80 80 80 00 00 00 00 00 00
  54.   }
  55.   set images(24) \
  56.   {
  57.     00 00 00 00 00 00 00 00 00 7c 46 2e 2d 45 7b 00 00 00 00 00 00 00 00 00
  58.     00 00 00 00 00 00 00 73 56 71 8e 9a 9a 8e 70 55 73 00 00 00 00 00 00 00
  59.     00 00 00 00 00 90 43 8c db fc ff ff ff ff fb dc 8c 43 8f 00 00 00 00 00
  60.     00 00 00 00 6c 45 cc fa ee e8 e6 e6 e6 e7 e7 ee fa cd 45 6c 00 00 00 00
  61.     00 00 00 6f 3a c4 e0 d2 d5 d7 d8 d8 d8 d8 d7 d5 d2 e1 c3 39 70 00 00 00
  62.     00 00 96 2e 86 cc be c3 c4 c5 c5 c5 c6 c5 c5 c5 c4 bf cc 86 2e 96 00 00
  63.     00 00 41 47 95 b1 ae b1 b2 b3 b3 b4 b4 b3 b3 b2 b1 ae b1 94 47 41 00 00
  64.     00 81 3c 4f 88 9f 9d a0 a1 a2 a3 a4 a4 a3 a2 a1 a0 9d 9f 88 50 3d 82 00
  65.     00 55 4a 52 74 8f 8d 91 93 94 94 94 94 94 94 92 91 8e 8e 75 52 4b 4f 00
  66.     8e 4c 52 59 64 7e 83 86 88 8a 8a 8b 8b 8b 8a 89 87 84 7f 65 59 55 43 c1
  67.     63 4e 58 60 68 74 80 84 86 87 88 88 88 88 88 86 84 80 74 68 61 5a 49 8c
  68.     50 52 5e 68 73 7b 83 88 8c 8d 8e 8d 8d 8e 8e 8c 87 82 7a 72 68 5e 51 64
  69.     53 57 64 71 7f 8a 92 99 9e a0 a0 a0 a0 a0 a0 9d 98 91 87 7c 70 64 55 66
  70.     68 59 6a 7a 8a 98 a3 ad b2 b4 b5 b5 b5 b5 b4 b1 ab a0 93 86 77 69 53 8e
  71.     93 5e 6f 82 95 a7 b6 c0 c7 ca cb cc cc cb c9 c5 bd b0 a1 8f 7c 6c 53 c2
  72.     00 69 6e 87 9c b1 c1 ce d5 da dc dd dd dc d9 d3 c9 ba a7 94 7f 69 61 00
  73.     00 91 64 88 9d b2 c5 d4 dd e3 e6 e7 e7 e6 e2 d9 cd bb a7 91 7e 5d 8d 00
  74.     00 00 64 80 97 ad c1 d1 dc e3 e7 e8 e8 e5 e0 d5 c6 b4 9e 89 75 5d 00 00
  75.     00 00 a4 69 8f a4 b9 cb d8 e0 e5 e7 e6 e2 da cd bd aa 93 81 5e a1 00 00
  76.     00 00 00 8e 73 99 ad c0 ce d8 de e0 df da d1 c3 b1 9c 8a 66 88 00 00 00
  77.     00 00 00 00 90 76 99 ae bc c8 ce d1 d0 ca c0 b2 9f 8a 69 89 00 00 00 00
  78.     00 00 00 00 00 ab 7c 8b a3 b3 ba bd bc b6 ac 9a 80 72 a6 00 00 00 00 00
  79.     00 00 00 00 00 00 00 a0 89 8b 96 9b 9a 92 85 83 9d 00 00 00 00 00 00 00
  80.     00 00 00 00 00 00 00 00 00 c7 9d 86 85 9c c6 00 00 00 00 00 00 00 00 00
  81.   }
  82.   set images(32) \
  83.   {
  84.     00 00 00 00 00 00 00 00 00 00 00 00 b0 79 52 41 41 52 79 b0 00 00 00 00 00 00 00 00 00 00 00 00
  85.     00 00 00 00 00 00 00 00 00 d8 8e 58 49 55 61 66 66 61 54 48 57 8e d8 00 00 00 00 00 00 00 00 00
  86.     00 00 00 00 00 00 00 00 84 3e 51 91 c9 e6 f1 f5 f5 f1 e6 c9 91 51 3e 83 00 00 00 00 00 00 00 00
  87.     00 00 00 00 00 00 c0 4c 45 a6 ed fe fc f7 f5 f4 f4 f5 f8 fc fe ed a6 45 4c c0 00 00 00 00 00 00
  88.     00 00 00 00 00 a4 3c 5c d5 f6 e9 e5 e7 e8 e8 e9 e9 e8 e8 e6 e5 e9 f6 d5 5c 3c a4 00 00 00 00 00
  89.     00 00 00 00 a4 3a 5c d0 e4 d7 db dc dd dd de de de dd de dd dd db d7 e4 d0 5c 3a a4 00 00 00 00
  90.     00 00 00 c0 45 4b a9 d8 ca d0 d0 d1 d1 d2 d2 d2 d2 d2 d2 d1 d1 d0 d0 cb d8 a9 4b 45 c1 00 00 00
  91.     00 00 00 53 48 6a c2 bf c2 c3 c4 c5 c5 c6 c7 c6 c6 c6 c6 c5 c5 c4 c3 c2 c0 c2 6b 48 53 00 00 00
  92.     00 00 87 45 50 80 b8 b2 b5 b6 b8 b9 ba ba ba bb bb bb ba ba b8 b8 b7 b5 b2 b8 7f 52 45 87 00 00
  93.     00 d7 4c 54 53 80 ab a6 aa ac ad af af af b0 b0 b0 b0 af af ae ad ac aa a7 ab 81 54 54 4d d8 00
  94.     00 92 44 59 58 78 9d 9c 9e a1 a3 a4 a4 a5 a6 a7 a6 a6 a5 a5 a4 a2 a1 9f 9c 9d 78 59 5a 44 93 00
  95.     00 68 4f 5c 5f 6c 90 94 96 99 9b 9c 9d 9d 9e 9e 9e 9e 9e 9e 9c 9b 99 97 94 91 6e 60 5d 50 64 00
  96.     b0 56 57 5f 65 6a 7f 8e 8f 92 94 96 97 97 98 98 98 98 98 97 96 95 92 8f 8f 80 6b 66 60 59 4d b0
  97.     83 55 5b 63 6a 70 77 87 8c 90 92 94 95 96 96 96 96 95 96 96 94 93 90 8d 87 78 71 6a 64 5f 4b ba
  98.     65 57 5f 68 70 77 7d 83 8d 91 93 95 96 97 97 96 97 97 97 97 95 93 91 8c 83 7e 77 70 68 61 52 88
  99.     58 5a 64 6d 75 7e 86 8d 93 97 9a 9d 9e 9e 9f 9e 9e 9e 9e 9e 9d 9a 97 93 8c 85 7e 76 6d 64 58 6f
  100.     5a 5c 67 71 7c 86 90 98 9f a4 a7 a9 ab ab ab ab ab ac ab ab a9 a6 a2 9d 96 8e 85 7b 71 68 5a 70
  101.     6a 5e 6b 78 83 90 9a a4 ac b2 b6 b8 b9 ba ba bb ba bb ba b9 b8 b5 b0 a9 a1 97 8c 81 76 6b 59 89
  102.     87 61 6e 7c 8a 98 a4 b0 ba c1 c5 c7 c9 ca ca ca ca ca c9 c8 c6 c2 bd b6 ab 9f 93 86 79 6d 56 b9
  103.     b2 66 6f 80 90 a0 ae bb c7 ce d2 d6 d7 d8 d8 d8 d9 d8 d7 d6 d3 d0 c9 c0 b5 a7 99 89 7b 6e 5b b0
  104.     00 77 6c 82 93 a4 b4 c2 d0 d8 dd e0 e2 e3 e4 e5 e5 e4 e2 e1 de d9 d2 c8 ba aa 9b 8a 7c 67 72 00
  105.     00 9b 65 83 94 a6 b7 c7 d5 de e4 e8 ea ec ec ec ec ec ea e8 e4 df d7 cb bc ab 9a 89 7b 60 9a 00
  106.     00 d8 6a 7e 91 a3 b4 c5 d4 e0 e6 eb ee f0 f0 f0 f0 f0 ee eb e7 e0 d6 c8 b8 a7 96 84 75 63 d8 00
  107.     00 00 97 6d 8c 9d af c0 cf dc e6 ec f0 f1 f2 f3 f3 f1 ee eb e5 dd d1 c1 b1 9f 8e 80 65 93 00 00
  108.     00 00 00 72 80 95 a7 b9 c9 d8 e3 eb f0 f1 f3 f3 f2 f1 ed e9 e2 d7 c9 b9 a8 96 87 74 6b 00 00 00
  109.     00 00 00 c8 72 8b 9d b0 c1 cf dc e5 ec ef f2 f2 f1 ef eb e4 da ce bf af 9e 8c 7d 67 c6 00 00 00
  110.     00 00 00 00 b0 71 8f a2 b3 c2 d0 da e2 e8 ea eb eb e7 e2 da cf c2 b2 a1 90 81 65 ac 00 00 00 00
  111.     00 00 00 00 00 b0 78 8e a4 b3 c1 cc d5 db df e0 df db d5 cc c1 b3 a3 94 7f 6d ad 00 00 00 00 00
  112.     00 00 00 00 00 00 c8 82 88 a0 b0 bb c4 cb d0 d1 d0 cd c5 bc b2 a3 93 7b 77 c5 00 00 00 00 00 00
  113.     00 00 00 00 00 00 00 00 a1 85 8e 9f ae b5 b9 bb ba b7 b1 a7 97 85 7d 9c 00 00 00 00 00 00 00 00
  114.     00 00 00 00 00 00 00 00 00 d8 ae 93 8c 92 9b 9d 9c 98 8f 88 8f aa d8 00 00 00 00 00 00 00 00 00
  115.     00 00 00 00 00 00 00 00 00 00 00 00 dc bb 98 8d 8c 97 bb dc 00 00 00 00 00 00 00 00 00 00 00 00
  116.   }
  117.   set images(40) \
  118.   {
  119.     00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ce 9e 7a 5c 52 52 5d 7a 9d ce 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  120.     00 00 00 00 00 00 00 00 00 00 00 00 de a6 6e 4d 42 42 44 44 44 44 41 42 4d 6e a5 de 00 00 00 00 00 00 00 00 00 00 00 00
  121.     00 00 00 00 00 00 00 00 00 00 d9 89 49 34 4e 79 a0 ba c6 cc cc c6 b9 a0 79 4d 35 49 89 d9 00 00 00 00 00 00 00 00 00 00
  122.     00 00 00 00 00 00 00 00 00 9c 49 37 69 b4 e7 fd fe fe fe fe fe fe fe fe fd e7 b4 69 36 48 9c 00 00 00 00 00 00 00 00 00
  123.     00 00 00 00 00 00 00 00 6e 37 53 b0 f1 fd f5 f0 ee ee ef ef ef ef ef ee f0 f5 fd f1 af 53 37 6d 00 00 00 00 00 00 00 00
  124.     00 00 00 00 00 00 cb 57 3a 67 d5 f5 e8 e5 e7 e9 e8 e9 e9 ea e9 ea e9 e9 e8 e7 e5 e8 f6 d5 68 3b 57 cb 00 00 00 00 00 00
  125.     00 00 00 00 00 cd 4e 41 64 d5 e7 da df df df e0 e0 e0 e0 e1 e1 e0 e1 e0 df e0 df df da e7 d5 65 40 4e cd 00 00 00 00 00
  126.     00 00 00 00 00 56 45 54 be dc d0 d5 d6 d6 d6 d7 d7 d7 d7 d8 d8 d7 d7 d7 d6 d7 d5 d5 d5 d0 dc bd 54 45 56 00 00 00 00 00
  127.     00 00 00 00 6d 45 4b 88 d3 c6 ca cb cb cc cd cd cd cd cd cd cd ce cd ce cc ce cc cc cb ca c6 d3 87 4b 45 6c 00 00 00 00
  128.     00 00 00 97 3f 53 53 ad c1 bd c0 c1 c1 c3 c3 c4 c4 c5 c4 c5 c5 c5 c4 c4 c3 c4 c2 c1 c1 c0 bd c1 ad 54 53 3f 97 00 00 00
  129.     00 00 d8 4d 50 50 65 b1 b3 b4 b5 b7 b8 b9 ba ba bb bb bb bc bc bb bb bb ba b9 b9 b9 b7 b6 b5 b3 b2 66 51 50 4d d8 00 00
  130.     00 00 89 43 56 53 6b ab aa ab ad ae af b0 b1 b2 b2 b2 b3 b3 b3 b3 b3 b2 b2 b1 b1 af af ad ac aa ab 6b 53 57 45 89 00 00
  131.     00 d9 52 50 57 57 6a a0 a0 a2 a3 a5 a7 a8 a9 a9 aa aa ab ab aa aa aa aa a9 a9 a8 a7 a6 a4 a2 a0 9f 6a 57 57 50 52 db 00
  132.     00 a0 45 57 59 5c 66 92 99 9a 9b 9e 9f a1 a1 a1 a2 a3 a3 a3 a3 a3 a3 a3 a2 a1 a0 9f 9e 9d 9a 98 93 66 5d 5a 57 45 a3 00
  133.     00 75 4a 59 5c 62 64 82 93 92 96 97 99 9b 9b 9c 9c 9c 9d 9d 9d 9e 9d 9e 9d 9b 9a 99 98 96 92 94 83 65 62 5d 5b 4d 73 00
  134.     ca 5c 52 5c 5f 64 68 74 8b 8e 90 91 93 95 96 97 97 98 98 99 99 98 98 97 97 97 96 93 92 90 8d 8c 74 69 65 60 5c 54 53 00
  135.     9a 55 56 5e 63 68 6e 71 7f 8b 8c 8f 91 93 94 95 96 96 96 96 97 96 96 96 95 94 94 92 90 8d 8b 7f 72 6e 69 63 5e 5a 49 d4
  136.     7c 54 5a 60 66 6c 72 77 7c 85 8d 8f 92 94 94 95 96 96 96 96 96 96 96 95 96 94 93 92 8f 8c 85 7c 78 73 6e 68 62 5d 4c ac
  137.     62 57 5d 64 6b 71 77 7d 82 87 8c 91 93 95 97 98 97 98 99 98 98 98 99 98 98 97 96 93 91 8d 86 82 7e 77 72 6c 64 5e 53 82
  138.     59 58 5f 68 6f 76 7d 83 89 8f 93 97 9a 9c 9e 9f 9f 9f 9f 9f 9e 9f a0 9e 9f 9e 9c 99 97 93 8e 88 83 7c 76 6f 68 61 56 73
  139.     5a 5a 62 6b 73 7b 83 8b 92 98 9d a1 a5 a7 a9 aa aa aa aa ab aa aa ab a9 aa a8 a6 a3 a0 9b 96 90 89 82 7b 73 6b 63 58 73
  140.     65 5c 65 6e 78 81 8a 93 9a a1 a8 ac b0 b2 b4 b5 b6 b5 b6 b6 b6 b6 b6 b5 b4 b3 b2 ae ab a5 9e 97 8f 87 7f 76 6d 65 58 82
  141.     80 5e 67 72 7c 87 91 9a a3 ab b3 b8 bd bf c0 c1 c2 c2 c3 c2 c2 c3 c2 c1 c1 bf bd ba b5 b0 a8 9f 96 8d 83 7a 70 68 54 ac
  142.     9d 61 68 75 80 8b 97 a1 ac b5 be c3 c7 ca cc cd ce ce ce ce ce cf ce cd cc ca c8 c4 bf b8 b0 a6 9c 92 86 7c 71 68 55 d2
  143.     c8 6a 68 77 83 91 9c a8 b4 be c7 cd d1 d5 d7 d8 d9 d9 da da da d9 d9 d8 d7 d5 d2 ce c8 c0 b8 ad a1 95 89 7d 73 66 60 00
  144.     00 81 63 79 85 92 9f ad b9 c4 cf d5 d9 dc de e0 e2 e3 e3 e3 e3 e3 e2 e1 df dd da d5 cf c7 bb af a3 97 8a 7e 74 61 7c 00
  145.     00 a7 60 78 85 93 a2 af bc c8 d2 db e0 e4 e6 e8 e9 ea ea eb ea ea e9 e8 e6 e3 df db d3 cb be b1 a4 97 8a 7c 73 5b a7 00
  146.     00 d9 6b 75 83 92 a1 b0 bd c9 d4 de e3 e7 eb ed ee ee ef ee ee ee ed ec e9 e7 e2 dc d4 ca bd b0 a2 95 87 7a 6d 66 da 00
  147.     00 00 96 69 81 8e 9d ab ba c6 d2 dc e4 e9 ed ef f0 f1 f1 f0 f1 f0 f0 ee ea e7 e3 db d1 c5 b9 ab 9d 8f 81 78 61 93 00 00
  148.     00 00 d8 6c 7a 89 98 a7 b5 c3 cf d9 e3 e9 ec ef f0 f2 f3 f3 f2 f2 f0 ed ea e6 e0 d7 cc c0 b3 a5 97 8a 7d 70 66 d7 00 00
  149.     00 00 00 a1 69 85 91 a0 af bd c9 d5 df e6 ec ef f0 f3 f3 f3 f2 f1 f0 ec e9 e3 db d2 c6 b9 ac 9e 91 83 79 60 9d 00 00 00
  150.     00 00 00 00 87 76 8c 99 a8 b7 c3 cf da e3 e8 ee f0 f1 f3 f3 f2 f1 ef eb e7 e0 d6 cb bf b2 a4 96 89 7e 6a 81 00 00 00 00
  151.     00 00 00 00 00 7a 7c 90 9d ac bb c7 d2 db e2 e8 ec ef f0 f0 f0 ee eb e6 df d7 cd c2 b4 a9 9a 8c 82 6f 71 00 00 00 00 00
  152.     00 00 00 00 00 cf 74 7f 93 9f af bb c7 d0 d8 df e3 e7 e9 e9 e8 e6 e3 de d6 cd c2 b7 aa 9d 8e 84 73 6b cd 00 00 00 00 00
  153.     00 00 00 00 00 00 cd 7e 7f 95 a0 ad ba c5 cd d4 d9 dd de e0 df dc d8 d3 cb c3 b8 ab 9d 90 86 72 74 cb 00 00 00 00 00 00
  154.     00 00 00 00 00 00 00 00 8d 7c 93 a0 ab b6 c0 c7 cd d1 d3 d4 d3 d0 cc c6 bf b6 aa 9d 94 85 70 85 00 00 00 00 00 00 00 00
  155.     00 00 00 00 00 00 00 00 00 aa 80 88 99 a6 ae b6 bc c0 c3 c4 c3 c1 bd b6 af a6 9c 8f 7e 76 a6 00 00 00 00 00 00 00 00 00
  156.     00 00 00 00 00 00 00 00 00 00 d7 a0 86 89 95 a1 a8 ac ae af af ac a9 a3 9b 8f 81 7f 9c d6 00 00 00 00 00 00 00 00 00 00
  157.     00 00 00 00 00 00 00 00 00 00 00 00 db b7 98 89 8a 91 97 97 97 95 8e 87 86 95 b5 db 00 00 00 00 00 00 00 00 00 00 00 00
  158.     00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 cd ad 92 8f 8e 91 ac cd 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  159.   }
  160.   set images(bg) \
  161.   {
  162.     #8ede8e
  163.     #8bbb8b
  164.     #81b181
  165.     #8ccc8c
  166.     #8bdb8b
  167.     #8fcf8f
  168.     #87c787
  169.     #8bcb8b
  170.     #8ddd8d
  171.     #8cbc8c
  172.   }
  173.  
  174.   # ===========
  175.   # procs
  176.   # ===========
  177.  
  178.   # -----------
  179.   # create the bubble images
  180.   # -----------
  181.   proc CreateImages {} \
  182.   {
  183.     #puts "CreateImages"
  184.     for {set d $::Size} {$d > 0} {incr d -8} \
  185.     {
  186.       # create images
  187.       array unset datas
  188.       for {set n 0} {$n < 8} {incr n} \
  189.       { image create photo img$d-$n }
  190.       # compute data
  191.       set data $::images($d)
  192.       set ndx -1
  193.       for {set i 0} {$i < $d} {incr i} \
  194.       {
  195.         array unset rows
  196.         set first 0
  197.         set last 0
  198.         for {set j 0} {$j < $d} {incr j} \
  199.         {
  200.           set c [lindex $data [incr ndx]]
  201.           set cc [scan $c %x]
  202.           set c2 [format %2.2x [expr {round($cc * 0.5)}]]
  203.           set c3 [expr {round($cc * 1.25)}]
  204.           if {$c3 > 255} { set c3 255 }
  205.           set c3 [format %2.2x $c3]
  206.           lappend rows(0) #${c}${c}${c}   ; # white
  207.           lappend rows(1) #${c}0000       ; # red
  208.           lappend rows(2) #00${c}00       ; # green
  209.           lappend rows(3) #${c}${c}00     ; # yellow
  210.           lappend rows(4) #00${c}${c}     ; # indigo
  211.           lappend rows(5) #${c}00${c}     ; # violet
  212.           lappend rows(6) #${c}${c2}00    ; # orange
  213.           lappend rows(7) #${c2}${c2}${c2}; # gray
  214.         }
  215.         for {set n 0} {$n < 8} {incr n} \
  216.         { lappend datas($n) $rows($n) }
  217.       }
  218.       # put images data
  219.       for {set n 0} {$n < 8} {incr n} \
  220.       { img$d-$n put $datas($n) }
  221.       # set transparency
  222.       catch \
  223.       {
  224.         set ndx -1
  225.         for {set i 0} {$i < $d} {incr i} \
  226.         {
  227.           for {set j 0} {$j < $d} {incr j} \
  228.           {
  229.             set c [lindex $data [incr ndx]]
  230.             if {$c == 0} \
  231.             {
  232.               for {set n 0} {$n < 8} {incr n} \
  233.               { img$d-$n transparency set $i $j 1 }
  234.             }
  235.           }
  236.         }
  237.       }
  238.     }
  239.     # create background
  240.     image create photo imgbg -width 1000 -height 1000
  241.     imgbg put $::images(bg) -to 0 0 1000 1000
  242.   }
  243.   # -----------
  244.   # init the game dialog
  245.   # -----------
  246.   proc CreateDialog {} \
  247.   {
  248.     #puts "CreateDialog"
  249.     # create background
  250.     # create digits areas
  251.     catch { destroy .f1}
  252.     frame .f1
  253.     canvas .f1.bg -width 1000 -height 1000 -bd 0 -highlightth 0
  254.     .f1.bg create image 0 0 -anchor nw -image imgbg
  255.     place .f1.bg -in .f1 -relx 0 -rely 0
  256.     CreateDigitsCanvas $::StepDisplay
  257.     CreateDigitsCanvas $::ScoreDisplay
  258.     CreateDigitsCanvas $::GrandScoreDisplay
  259.     CreateDigitsCanvas $::DelayDisplay
  260.     button $::OptionsButton -width 10 -text Options -command Options -relief groove -padx 5 -pady 5
  261.     grid  $::StepDisplay \
  262.           $::ScoreDisplay \
  263.           $::GrandScoreDisplay \
  264.           $::OptionsButton \
  265.       -padx 10 -pady 5
  266.     grid .f1 -row 0 -sticky ew
  267.     # create game area
  268.     CreateBubblesCanvas
  269.     # center
  270.     CenterDialog .
  271.   }
  272.   proc CreateDigitsCanvas {canvas} \
  273.   {
  274.     # create canvas
  275.     set size $::CanvasSize($canvas)
  276.     canvas $canvas -bg gray85 -relief sunken \
  277.       -width [expr {$size * 20 + 10}] -height 32 \
  278.       -bd 1 -highlightth 0 -selectborderwi 0
  279.     # create digits
  280.     set x 10
  281.     set y 5
  282.     for {set i 0} {$i < $size} {incr i} \
  283.     {
  284.       CreateDigit $canvas $i $x $y
  285.       incr x 20
  286.     }
  287.     # init display
  288.     SetNumber $canvas 0
  289.   }
  290.   proc CreateBubblesCanvas {} \
  291.   {
  292.     # create frame
  293.     catch { destroy .f2}
  294.     frame .f2
  295.     canvas .f2.bg -width 1000 -height 1000 -bd 0 -highlightth 0
  296.     .f2.bg create image 0 0 -anchor nw -image imgbg
  297.     place .f2.bg -in .f2 -relx 0 -rely 0
  298.     # create count down canvas
  299.     canvas $::TimeDisplay -relief sunken \
  300.       -width 21 -height $::Height \
  301.       -bd 1 -highlightth 0 -selectborderwi 0
  302.     $::TimeDisplay create rectangle 1 1 20 $::Height \
  303.       -outline "" -fill green -tags used
  304.     $::TimeDisplay create rectangle 1 1 20 0 \
  305.       -outline "" -fill red -tags left
  306.     # create game area
  307.     canvas $::BubblesDisplay -bg gray75 -relief sunken \
  308.       -width [expr {$::Width + 1}] -height $::Height \
  309.       -bd 1 -highlightth 0 -selectborderwi 0
  310.     $::BubblesDisplay config -scrollregion [list 0 0 $::Width $::Height]
  311.     $::BubblesDisplay xview scroll 1 unit
  312.     $::BubblesDisplay yview scroll 1 unit
  313.     # create decoration
  314.     for {set i 0} {$i < 64} {incr i} \
  315.     {
  316.       set x [expr {round(rand() * $::Width)}]
  317.       set y [expr {round(rand() * $::Height)}]
  318.       set d [expr {round(rand() * $::R)}]
  319.       $::BubblesDisplay create oval \
  320.         [expr {$x - $d}] \
  321.         [expr {$y - $d}] \
  322.         [expr {$x + $d}] \
  323.         [expr {$y + $d}] -outline gray65 -width 2
  324.     }
  325.     # Click events
  326.     bind $::BubblesDisplay <Button-1> { Fire %x %y }
  327.     bind $::BubblesDisplay <Button-3> { Dump }
  328.     # display all
  329.     grid $::TimeDisplay $::BubblesDisplay -padx 5 -pady 10
  330.     grid .f2 -row 1 -sticky ew
  331.     update
  332.   }
  333.   # -----------
  334.   # center dialog
  335.   # -----------
  336.   proc CenterDialog {w} \
  337.   {
  338.     # hide dialog
  339.     wm geometry $w -2000-2000
  340.     # compute sizes
  341.     update
  342.     set x [expr {([winfo screenwidth $w] - [winfo width $w]) / 2}]
  343.     set y [expr {([winfo screenheight $w] - [winfo height $w]) / 2}]
  344.     # place dialog
  345.     wm geometry $w +$x+$y
  346.   }
  347.   # -----------
  348.   # options dialog
  349.   # -----------
  350.   proc Options {} \
  351.   {
  352.     # stop count down
  353.     set ::Halted 1
  354.     # inhibite call to options
  355.     $::OptionsButton config -state disabled
  356.     # save parameters value
  357.     set Level $::Level
  358.     set Size $::Size
  359.     set Speed $::Speed
  360.     # create dialog
  361.     if {[winfo exists .o]} { destroy .o }
  362.     toplevel .o
  363.     wm title .o "Bubbles, Options"
  364.     # manage events
  365.     bind .o <<Close>> \
  366.     {
  367.       catch \
  368.       {
  369.         set fn /root/.Bubbles1.Parameters
  370.         set fp [open $fn w]
  371.         puts $fp "set ::Level $::Level"
  372.         puts $fp "set ::Size $::Size"
  373.         puts $fp "set ::Speed $::Speed"
  374.         close $fp
  375.       }
  376.       $::OptionsButton config -state normal
  377.       destroy .o
  378.       set ::Halted 0
  379.       if {$::Status == "newgame"} { NewGame }
  380.     }
  381.     bind . <<Exit>> { exit }
  382.     wm protocol .o WM_DELETE_WINDOW { event generate .o <<Close>> }
  383.     bind .o <Escape> \
  384.     {
  385.       set ::Level $Level
  386.       set ::Size $Size
  387.       set ::Speed $Speed
  388.       event generate .o <<Close>>
  389.     }
  390.     # create buttons area
  391.     frame .o.f
  392.     canvas .o.f.bg -width 1000 -height 1000 -bd 0 -highlightth 0
  393.     .o.f.bg create image 0 0 -anchor nw -image imgbg
  394.     place .o.f.bg -in .o.f -relx 0 -rely 0
  395.     # create buttons
  396.     foreach {w t c} \
  397.     {
  398.       1 "Continue"      { event generate .o <<Close>> }
  399.       2 "New Game"      { set ::Status newgame; event generate .o <<Close>> }
  400.       3 "Quit Game"     { event generate .o <<Close>>; event generate . <<Exit>> }
  401.       4 "Hall of Fame"  { DisplayFame }
  402.     } \
  403.     { button .o.f.b$w -width 20 -text $t -command $c -relief groove }
  404.     # create level area
  405.     frame .o.f0 -relief groove -bd 2 -padx 25 -pady 5
  406.     label .o.f0.lt -fg gray20 -font {-weight bold} -text "bubbles level"
  407.     frame .o.f0.f
  408.     # create buttons
  409.     foreach w {0 1 2} v {novice expert master} t {novice expert master} \
  410.     { radiobutton .o.f0.f.r$w -variable ::Level -value $v -text $t \
  411.         -command { .o.f.b1 config -state disabled }
  412.     }
  413.     # create size area
  414.     frame .o.f1 -relief groove -bd 2 -padx 25 -pady 5
  415.     label .o.f1.lt -fg gray20 -font {-weight bold} -text "bubbles size"
  416.     frame .o.f1.f
  417.     # create buttons
  418.     foreach w {0 1} v {40 24} t {big small} \
  419.     { radiobutton .o.f1.f.r$w -variable ::Size -value $v -text $t \
  420.         -command { .o.f.b1 config -state disabled }
  421.     }
  422.     # create speed area
  423.     frame .o.f2 -relief groove -bd 2 -padx 25 -pady 5
  424.     label .o.f2.lt -fg gray20 -font {-weight bold} -text "bubbles speed"
  425.     frame .o.f2.f
  426.     # create buttons
  427.     foreach w {0 1 2} v {1 3 5} t {slow medium speed} \
  428.     { radiobutton .o.f2.f.r$w -variable ::Speed -value $v -text $t }
  429.     # display all
  430.     grid .o.f -sticky ew
  431.     foreach w {1 2 3 4} \
  432.     { grid .o.f.b$w -padx 40 -pady 5 }
  433.     foreach w {0 1 2} \
  434.     { grid .o.f$w -padx 5 -pady 5 -sticky nsew }
  435.     foreach w {0 1 2} \
  436.     {
  437.       pack .o.f$w.lt -anchor center
  438.       pack .o.f$w.f
  439.     }
  440.     foreach {w1 s} {0 {r0 r1 r2} 1 {r0 r1} 2 {r0 r1 r2}} \
  441.     { foreach w2 $s { pack .o.f$w1.f.$w2 -anchor w } }
  442.     CenterDialog .o
  443.     raise .o
  444.     focus -force .o
  445.     # disable Continue if New Game is mandatory
  446.     if {$::Status == "newgame"} { .o.f.b1 config -state disabled }
  447.   }
  448.   # -----------
  449.   # display hall of fame
  450.   # -----------
  451.   proc DisplayFame {{scores {}} {entry 0}} \
  452.   {
  453.     #puts "DisplayFame $scores"
  454.     # get scores if needed
  455.     if {$scores == {}} { set scores [ReadFame] }
  456.     # create dialog
  457.     if {[winfo exists .h]} { destroy .h }
  458.     toplevel .h
  459.     wm title .h "Bubbles, Hall of Fame"
  460.     canvas .h.bg -width 1000 -height 1000 -bd 0 -highlightth 0
  461.     .h.bg create image 0 0 -anchor nw -image imgbg
  462.     place .h.bg -in .h -relx 0 -rely 0
  463.     focus -force .h
  464.     # manage events
  465.     bind .h <<Close>> { destroy .h }
  466.     bind .h <Escape> { event generate .h <<Close>> }
  467.     # create frame title
  468.       frame .h.ft
  469.       canvas .h.ft.bg -width 1000 -height 1000 -bd 0 -highlightth 0
  470.       .h.ft.bg create image 0 0 -anchor nw -image imgbg
  471.       place .h.ft.bg -in .h.ft -relx 0 -rely 0
  472.       # create user area
  473.       label .h.ft.u -bd 1 -relief sunken -width 10 -font {-weight bold} \
  474.           -bg gray90 -fg DarkOrange -text $::User
  475.       # create level area
  476.       label .h.ft.ll -bd 1 -relief sunken -width 6 -font {-weight bold} \
  477.           -bg gray90 -fg DarkGreen -text $::Level
  478.       # create score area
  479.       label .h.ft.ls -bd 1 -relief sunken -width 8 -font {-weight bold} \
  480.           -bg gray90 -fg red -text [format %7.7i $::GrandScore]
  481.       grid .h.ft.u .h.ft.ll .h.ft.ls -padx 20 -pady 25 -sticky nw
  482.     # create scores frame
  483.     frame .h.fs -bd 0
  484.     canvas .h.fs.bg -width 500 -height 1000 -bd 0 -highlightth 0
  485.     .h.fs.bg create image 0 0 -anchor nw -image imgbg
  486.     place .h.fs.bg -in .h.fs -relx 0 -rely 0
  487.     set ::numScore -1
  488.     set i 1
  489.     foreach score $scores \
  490.     {
  491.       if {$score == ""} { break }
  492.       # get info
  493.       foreach {number level user} [split $score] break
  494.       # create num area
  495.       label .h.fs.ln$i -bd 1 -relief sunken -width 2 -font {-weight bold} \
  496.           -bg gray90 -fg gray20 -text $i
  497.       # create user area
  498.       label .h.fs.u$i -bd 1 -relief sunken -width 10 -font {-weight bold} \
  499.           -bg gray90 -fg DarkOrange -text $user
  500.       if {$user == "" && $entry == -1} \
  501.       {
  502.         # create user entry
  503.         set entry $i
  504.         entry .h.fs.u$i.e -bd 0 -relief flat -width 10 -font {-weight bold} \
  505.           -bg gray90 -fg DarkOrchid -textvariable ::User \
  506.           -insertbackground DarkOrchid -insertwidth 4 -selectforeground DarkOrchid
  507.         place .h.fs.u$i.e -in .h.fs.u$i -anchor center -relx 0.5 -rely 0.5
  508.         focus -force .h.fs.u$i.e
  509.         .h.fs.u$i.e selection range 0 end
  510.         .h.fs.u$i.e icursor end
  511.       }
  512.       # create level area
  513.       label .h.fs.ll$i -bd 1 -relief sunken -width 6 -font {-weight bold} \
  514.           -bg gray90 -fg DarkGreen -text $level
  515.       # create score area
  516.       label .h.fs.ls$i -bd 1 -relief sunken -width 8 -font {-weight bold} \
  517.           -bg gray90 -fg red -text [format %7.7i $number]
  518.       # display row
  519.       grid .h.fs.ln$i .h.fs.u$i .h.fs.ll$i .h.fs.ls$i -padx 10 -pady 5
  520.       incr i
  521.     }
  522.     # place/display frames
  523.     pack .h.ft -padx 20 -pady 20 -fill x
  524.     pack .h.fs -padx 20 -pady 20 -fill x
  525.     # create register button if needed
  526.     if {$entry > 0} \
  527.     {
  528.       # add a Register button
  529.       set ::numScore [incr entry -1]
  530.       bind .h <<Register>> \
  531.       {
  532.         set score "$::GrandScore $::Level $::User"
  533.         set ::Scores [lreplace $::Scores $::numScore $::numScore $score]
  534.         WriteFame $::Scores
  535.         DisplayFame $::Scores
  536.       }
  537.       bind .h <Return> { event generate .h <<Register>> }
  538.       button .h.b -width 20 -text Register -relief groove \
  539.         -command { event generate .h <<Register>> }
  540.       pack .h.b -pady 10
  541.     }
  542.     # place dialog
  543.     CenterDialog .h
  544.     raise .h
  545.   }
  546.   # -----------
  547.   # update hall of fame
  548.   # -----------
  549.   proc UpdateFame {} \
  550.   {
  551.     #puts "UpdateFame"
  552.     # add new score
  553.     set ::Scores [ReadFame]
  554.     lappend ::Scores [list $::GrandScore $::Level]
  555.     set ::Scores [lrange [lsort -dic -dec $::Scores] 0 9]
  556.     # display new Hall of Fame
  557.     DisplayFame $::Scores -1
  558.   }
  559.   # -----------
  560.   # read the Hall of fame
  561.   # -----------
  562.   proc ReadFame {} \
  563.   {
  564.     #puts "ReadFame"
  565.     # read file
  566.     set scores ""
  567.     catch \
  568.     {
  569.       set fn /root/.Bubbles1.HallOfFame
  570.       set fp [open $fn]
  571.       set scores [split [read $fp] \n]
  572.       close $fp
  573.     }
  574.     # fill score if empty
  575.     if {$scores == ""} \
  576.     { for {set i 0} {$i < 10} {incr i} { lappend scores "0 expert anonymous" } }
  577.     return $scores
  578.   }
  579.   # -----------
  580.   # write the Hall of fame
  581.   # -----------
  582.   proc WriteFame {scores} \
  583.   {
  584.     #puts "WriteFame $scores"
  585.     # write file
  586.     catch \
  587.     {
  588.       set fn /root/.Bubbles1.HallOfFame
  589.       set fp [open $fn w]
  590.       puts -nonewline $fp [join $scores \n]
  591.       close $fp
  592.     }
  593.   }
  594.   # -----------
  595.   # create the bubbles for the step
  596.   # -----------
  597.   proc CreateBubbles {} \
  598.   {
  599.     #puts "CreateBubbles"
  600.     # create the slots
  601.     CreateBubblesCanvas
  602.     # create the first bubbles
  603.     set y $::R
  604.     set nrows [expr {int($::N * 0.9)}]
  605.     set ncols $::N
  606.     for {set i 0} {$i < $nrows} {incr i} \
  607.     {
  608.       if {$i % 2 == 0} { set x $::R; set j 0 } \
  609.       else { set x $::Size; set j 1 }
  610.       for {} {$j < $ncols} {incr j} \
  611.       {
  612.         set ndx [CreateBubble $x $y]
  613.         UpdateBubble $ndx $x $y
  614.         incr x $::Size
  615.       }
  616.       incr y $::DY
  617.     }
  618.   }
  619.   # -----------
  620.   # froze the bubbles
  621.   # -----------
  622.   proc FrozeBubbles {{delay ""}} \
  623.   {
  624.     if {$delay == ""} \
  625.     {
  626.       set delay 25
  627.       after 1000 {catch { after cancel $::Froze }}
  628.     }
  629.     set bg [$::BubblesDisplay cget -bg]
  630.     set bg [expr {$bg == "gray75" ? "gray65" : "gray75"}]
  631.     $::BubblesDisplay config -bg $bg
  632.     foreach ndx [array names ::Bubbles] \
  633.     {
  634.       foreach {- x y} $::Bubbles($ndx) break
  635.       set dx [expr {(rand() > 0.5 ? 1 : -1) * int(rand() * 2)}]
  636.       set dy [expr {(rand() > 0.5 ? 1 : -1) * int(rand() * 2)}]
  637.       $::BubblesDisplay coords bubble$ndx [expr {$x + $dx}] [expr {$y + $dy}]
  638.     }
  639.     set ::Froze [after $delay FrozeBubbles $delay]
  640.   }
  641.   # -----------
  642.   # create one digit
  643.   # -----------
  644.   proc CreateDigit {canvas ndx x y} \
  645.   {
  646.     #puts "CreateDigit $canvas $ndx $x $y"
  647.     # create digit segments
  648.     set y0 0
  649.     set size 12
  650.     set xs [expr {$x + $size}]
  651.     set ys [expr {$y + $size}]
  652.     foreach \
  653.     { x1    y1    x2    y2    tag dy}   \
  654.     [list \
  655.       $x    $y    $xs   $y    0   0     \
  656.       $x    $y    $x    $ys   1   0     \
  657.       $xs   $y    $xs   $ys   2   $size \
  658.       $x    $y    $xs   $y    3   0     \
  659.       $x    $y    $x    $ys   4   0     \
  660.       $xs   $y    $xs   $ys   5   $size \
  661.       $x    $y    $xs   $y    6   0     \
  662.     ] \
  663.     {
  664.       $canvas create line $x1 [expr {$y0 + $y1}] $x2 [expr {$y0 + $y2}] \
  665.         -tags dgt$ndx-$tag -fill gray65 -width 3
  666.       incr y0 $dy
  667.     }
  668.   }
  669.   array set ::Segments \
  670.   {
  671.     ""  {}
  672.     0   {0 1 2 4 5 6}
  673.     1   {2 5}
  674.     2   {0 2 3 4 6}
  675.     3   {0 2 3 5 6}
  676.     4   {1 2 3 5}
  677.     5   {0 1 3 5 6}
  678.     6   {0 1 3 4 5 6}
  679.     7   {0 2 5}
  680.     8   {0 1 2 3 4 5 6}
  681.     9   {0 1 2 3 5 6}
  682.   }
  683.   # -----------
  684.   # display a digit
  685.   # -----------
  686.   proc SetDigit {canvas ndx digit {color red}} \
  687.   {
  688.     #puts "SetDigit $canvas $ndx $digit $color"
  689.     # colorize each segment
  690.     set segments $::Segments($digit)
  691.     for {set i 0} {$i < 7} {incr i} \
  692.     {
  693.       if {[lsearch -exact $segments $i] == -1} \
  694.       { set c gray65 } else { set c $color }
  695.       $canvas itemconfig dgt$ndx-$i -fill $c
  696.     }
  697.   }
  698.   # -----------
  699.   # blink a score
  700.   # -----------
  701.   proc BlinkNumber {canvas value {color ""}} \
  702.   {
  703.     #puts "BlinkNumber $canvas $value $color"
  704.     # alternate colors
  705.     if {$color == ""} \
  706.     {
  707.       StopBlink
  708.       set color red
  709.     } \
  710.     elseif {![info exists ::Blink]} { return }
  711.     set color [expr {$color == "red" ? "gray65" : "red"}]
  712.     # display the number
  713.     SetNumber $canvas $value $color
  714.     # repeat
  715.     set ::Blink [after 500 [list BlinkNumber $canvas $value $color]]
  716.   }
  717.   # -----------
  718.   # stop blinking a score
  719.   # -----------
  720.   proc StopBlink {} \
  721.   {
  722.     #puts "StopBlink"
  723.     # stop
  724.     if {[info exists ::Blink]} \
  725.     {
  726.       catch {after cancel $::Blink}
  727.       unset ::Blink
  728.     }
  729.   }
  730.   # -----------
  731.   # display a score
  732.   # -----------
  733.   proc SetNumber {canvas value {color red}} \
  734.   {
  735.     #puts "SetNumber $canvas $value $color"
  736.     # compute display size
  737.     set size $::CanvasSize($canvas)
  738.     # format value
  739.     set value [format %*.*i $size $size $value]
  740.     # display digits
  741.     set i -1
  742.     foreach digit [split $value {}] \
  743.     { SetDigit $canvas [incr i] $digit $color }
  744.   }
  745.   # -----------
  746.   # count down the time
  747.   # -----------
  748.   proc CountDown {{time ""}} \
  749.   {
  750.     #puts "CountDown $time"
  751.     if {$time == ""} \
  752.     {
  753.       # init
  754.       CancelCount
  755.       set time $::StepTime
  756.       set ::Status countdown
  757.       for {set t $::Height} {$t > 0} {incr t -1} \
  758.       {
  759.         puts $::Status
  760.         if {$::Status != "countdown"} { return }
  761.         $::TimeDisplay coords left 1 1 20 $t; update
  762.         after 10
  763.       }
  764.     }
  765.     set ::CurrentTime $time
  766.     set t [expr {round($::Height * ($::StepTime - $time) / double($::StepTime))}]
  767.     $::TimeDisplay coords left 1 1 20 $t; update
  768.     if {$time > 0} \
  769.     {
  770.       # count down
  771.       if {$::Halted} { incr time }
  772.       set ::CountDown [after 1000 [list CountDown [incr time -1]]]
  773.     } \
  774.     else \
  775.     {
  776.       # timed out
  777.       set ::Status timeout
  778.       EndOfStep
  779.     }
  780.   }
  781.   # -----------
  782.   # cancel a count down
  783.   # -----------
  784.   proc CancelCount {} \
  785.   {
  786.     #puts "CancelCount"
  787.     if {[info exists ::CountDown]} \
  788.     {
  789.       after cancel $::CountDown
  790.       unset ::CountDown
  791.     }
  792.   }
  793.   # -----------
  794.   # randomly pick a color
  795.   # -----------
  796.   proc PickColor {} \
  797.   {
  798.     #puts "PickColor"
  799.     # pick a random color from permitted
  800.     set n [expr {int(rand() * 0.999 * $::nbColors) + 1}]
  801.     set color [lindex $::Colors $n]
  802.     return $color
  803.   }
  804.   # -----------
  805.   # the next bubble to engage
  806.   # -----------
  807.   proc PrepareBubble {} \
  808.   {
  809.     #puts "PrepareBubble"
  810.     # prepare the next bubble
  811.     CreateBubble $::R [expr {$::Height - $::R}]
  812.   }
  813.   # -----------
  814.   # engage the prepared bubble
  815.   # -----------
  816.   proc EngageBubble {} \
  817.   {
  818.     #puts "EngageBubble"
  819.     # catch in case of time out occured at the wrong time
  820.     # and bubbles were destroyed
  821.     catch \
  822.     {
  823.       # get the next bubble
  824.       set ndx $::nbBubbles
  825.       set x [expr {$::Width / 2}]
  826.       set y [expr {$::Height - $::R}]
  827.       $::BubblesDisplay coords bubble$ndx $x $y
  828.       # update info
  829.       set bubble $::Bubbles($ndx)
  830.       set ::Bubbles($ndx) [lreplace $bubble 1 2 $x $y]
  831.       # prepare the next bubble
  832.       PrepareBubble
  833.       set ::Bonus 1
  834.       set ::StepValue 0
  835.     }
  836.   }
  837.   # -----------
  838.   # create a bubble
  839.   # -----------
  840.   proc CreateBubble {x y {ndx ""} {d ""} {color ""}} \
  841.   {
  842.     #puts "CreateBubble $x $y $ndx $d $color"
  843.     if {$ndx == ""} \
  844.     {
  845.       # beginning
  846.       # create an index & pick a color
  847.       set ndx [incr ::nbBubbles]
  848.       set color [PickColor]
  849.       # create the bubble
  850.       set d 8
  851.       $::BubblesDisplay create image $x $y \
  852.         -tags [list bubble bubble$ndx] \
  853.         -image img$d-$color
  854.       # register it
  855.       set ::Bubbles($ndx) [list $color $x $y 0 0 0]
  856.       # animate
  857.       after 100 [list CreateBubble 0 0 $ndx $d $color]
  858.       # return the index
  859.       return $ndx
  860.     } \
  861.     elseif {[incr d 8] <= $::Size} \
  862.     {
  863.       # growing
  864.       $::BubblesDisplay itemconfig bubble$ndx -image img$d-$color
  865.       after 100 [list CreateBubble 0 0 $ndx $d $color]
  866.     }
  867.   }
  868.   # -----------
  869.   # destroy a bubble
  870.   # -----------
  871.   proc DestroyBubble {ndx {d ""} {color ""}} \
  872.   {
  873.     #puts "DestroyBubble $ndx $d $color"
  874.     if {$d == ""} \
  875.     {
  876.       # beginning
  877.       set d $::Size
  878.       foreach {color x y row col} $::Bubbles($ndx) break
  879.       #puts "DestroyBubble $ndx ($x:$y){$row:$col}"
  880.       array unset ::Slots $row:$col
  881.       array unset ::Bubbles $ndx
  882.     }
  883.     if {[incr d -8] == 0} \
  884.     {
  885.       # destroy
  886.       $::BubblesDisplay delete bubble$ndx
  887.     } \
  888.     else \
  889.     {
  890.       # resize
  891.       $::BubblesDisplay itemconfig bubble$ndx -image img$d-$color
  892.       after 100 [list DestroyBubble $ndx $d $color]
  893.     }
  894.   }
  895.   # -----------
  896.   # change the bubble info
  897.   # -----------
  898.   proc UpdateBubble {ndx x y} \
  899.   {
  900.     #puts "UpdateBubble $ndx $x $y"
  901.     # move to a bubble slot
  902.     SetSlot $ndx $x $y
  903.     # pick or create a group
  904.     SetGroup $ndx
  905.   }
  906.   # -----------
  907.   # join a color group to another
  908.   # -----------
  909.   proc UpdateGroup {group ngroup} \
  910.   {
  911.     #puts "UpdateGroup $group $ngroup"
  912.     foreach ndx $::Groups($group) \
  913.     {
  914.       set bubble $::Bubbles($ndx)
  915.       set ::Bubbles($ndx) [lreplace $bubble 5 5 $ngroup]
  916.       lappend ::Groups($ngroup) $ndx
  917.     }
  918.     array unset ::Groups $group
  919.     set ::Bonus [expr {$::Bonus * 4}]
  920.   }
  921.   # -----------
  922.   # destroy a color group
  923.   # -----------
  924.   proc DestroyGroup {group} \
  925.   {
  926.     #puts "DestroyGroup $group"
  927.     set n [llength $::Groups($group)]
  928.     incr ::StepValue [expr {$n * $n * $n}]
  929.     foreach ndx $::Groups($group) { DestroyBubble $ndx }
  930.     array unset ::Groups $group
  931.   }
  932.   # -----------
  933.   # compute the color group of a bubble
  934.   # -----------
  935.   proc SetGroup {ndx} \
  936.   {
  937.     #puts "SetGroup $ndx"
  938.     foreach {color - - row col} $::Bubbles($ndx) break
  939.     # check bubbles in the row
  940.     foreach j [list [expr {$col - 1}] [expr {$col + 1}]] \
  941.     {
  942.       if {[info exists ::Slots($row:$j)]} \
  943.       {
  944.         set bubble $::Bubbles($::Slots($row:$j))
  945.         if {$color == [lindex $bubble 0]} \
  946.         {
  947.           set g [lindex $bubble 5]
  948.           if {![info exists group]} { set group $g } \
  949.           elseif {$g != $group} { UpdateGroup $g $group }
  950.         }
  951.       }
  952.     }
  953.     # check in the contiguous rows
  954.     set i1 [expr {$row - 1}]
  955.     set i2 [expr {$row + 1}]
  956.     if {$row % 2 == 0} \
  957.     {
  958.       # largest row
  959.       set j0 [expr {$col - 1}]
  960.       if {$j0 == -1} { incr j0 }
  961.       set j1 $col
  962.       if {$j1 == $::N - 1} { incr j1 -1 }
  963.     } \
  964.     else \
  965.     {
  966.       # smallest row
  967.       set j0 $col
  968.       set j1 [expr {$col + 1}]
  969.     }
  970.     foreach i [list $i1 $i2] \
  971.     {
  972.       foreach j [list $j0 $j1] \
  973.       {
  974.         if { "$i:$j" != "$row:$col" && [info exists ::Slots($i:$j)]} \
  975.         {
  976.           set bubble $::Bubbles($::Slots($i:$j))
  977.           if {$color == [lindex $bubble 0]} \
  978.           {
  979.             set g [lindex $bubble 5]
  980.             if {![info exists group]} { set group $g } \
  981.             elseif {$g != $group} { UpdateGroup $g $group }
  982.           }
  983.         }
  984.       }
  985.     }
  986.     if {![info exists group]} { set group [incr ::nbGroups] }
  987.     lappend ::Groups($group) $ndx
  988.     set bubble $::Bubbles($ndx)
  989.     set ::Bubbles($ndx) [lreplace $bubble 5 5 $group]
  990.   }
  991.   # -----------
  992.   # set the virtual slot of a bubble
  993.   # -----------
  994.   proc SetSlot {ndx x y} \
  995.   {
  996.     #puts "SetSlot $ndx $x $y"
  997.     # compute the nearest slot
  998.     set row [expr {round(($y - $::R) / $::DY)}]
  999.     set offset [expr {$row % 2 == 0 ? 0 : 1}]
  1000.     set col [expr {round(($x - (1 + $offset) * $::R) / $::Size)}]
  1001.     if {$col < 0} { incr col }
  1002.     if {$col > $::N - 1 - $offset} { incr col -1 }
  1003.     # check if already filled
  1004.     if {[info exists ::Slots($row:$col)]} \
  1005.     {
  1006.       incr row
  1007.       incr col [expr {$row % 2}]
  1008.       if {$::dX < 0} { incr col }
  1009.       set offset [expr {$row % 2 == 0 ? $::Size : $::R}]
  1010.     }
  1011.     # update bubble info
  1012.     set y [expr {$row * $::DY + $::R}]
  1013.     set x [expr {$col * $::Size + (1 + $offset) * $::R}]
  1014.     $::BubblesDisplay coords bubble$ndx $x $y
  1015.     # update global info
  1016.     set ::Slots($row:$col) $ndx
  1017.     set bubble $::Bubbles($ndx)
  1018.     set ::Bubbles($ndx) [lreplace $bubble 1 4 $x $y $row $col]
  1019.   }
  1020.   # -----------
  1021.   # move the fired bubble
  1022.   # -----------
  1023.   proc Shot {time x0 y0} \
  1024.   {
  1025.     #puts "Shot $time $x0 $y0"
  1026.     if {$::Status != "shot"} { return }
  1027.     # catch in case of time out occured at the wrong time
  1028.     # and bubbles were destroyed
  1029.     catch \
  1030.     {
  1031.       # move a tic
  1032.       set x1 [expr {$x0 + $::Speed * $::dX}]
  1033.       set y1 [expr {$y0 + $::Speed * $::dY}]
  1034.       $::BubblesDisplay coords bubble$::Index $x1 $y1
  1035.       if {($x1 < $::R && $::dX < 0) || ($x1 > $::Width - $::R && $::dX > 0)} \
  1036.       {
  1037.         # bounce
  1038.         set ::Status bounce
  1039.         set xb [expr {$x1 - $::Speed * $::dX}]
  1040.         set yb [expr {$y1 + $::Speed * $::dY}]
  1041.         Fire $xb $yb
  1042.       } \
  1043.       elseif {$time < $::Speed} \
  1044.       {
  1045.         # end
  1046.         SetResult $x1 $y1
  1047.       } \
  1048.       else \
  1049.       {
  1050.         # collisions
  1051.         foreach ndx $::Collisions \
  1052.         {
  1053.           if {[info exists ::Bubbles($ndx)]} \
  1054.           {
  1055.             foreach {- xc yc} $::Bubbles($ndx) break
  1056.             if {($xc - $x1) * ($xc - $x1) + ($yc - $y1) * ($yc - $y1) <= $::Size * $::Size} \
  1057.             { SetResult $x1 $y1; return }
  1058.           }
  1059.         }
  1060.         # next tic
  1061.         after 1 [list Shot [incr time -$::Speed] $x1 $y1]
  1062.       }
  1063.     }
  1064.   }
  1065.   # -----------
  1066.   # fire the engaged bubble
  1067.   # -----------
  1068.   proc Fire {xm ym} \
  1069.   {
  1070.     #puts "Fire $xm $ym"
  1071.     # throw the bubble
  1072.     if {$::Status == "ready"} \
  1073.     {
  1074.       # shot
  1075.       set ::Shot 1
  1076.       set ::Index [expr {$::nbBubbles - 1}]
  1077.       foreach {color x0 y0} $::Bubbles($::Index) break
  1078.     } \
  1079.     elseif {$::Status == "bounce"} \
  1080.     {
  1081.       # bounce
  1082.       set color [lindex $::Bubbles($::Index) 0]
  1083.       foreach {x0 y0} [$::BubblesDisplay coords bubble$::Index] break
  1084.     } \
  1085.     else { return }
  1086.     # trajectory
  1087.     set dx [expr {$xm - $x0}]
  1088.     set dy [expr {$ym - $y0}]
  1089.     if {$xm == $x0} \
  1090.     {
  1091.       set a 0
  1092.       set b $xm
  1093.       set dc $::R
  1094.     } \
  1095.     else \
  1096.     {
  1097.       set a [expr {$dy / double($dx)}]
  1098.       set b [expr {(($xm * $y0) - ($x0 * $ym)) / ($xm - $x0)}]
  1099.       set dc [expr {abs($::R / sin(atan($a)))}]
  1100.     }
  1101.     # move
  1102.     set ::Collisions {}
  1103.     set y1 $::R
  1104.     if {$a == 0} { set x1 $xm } \
  1105.     else { set x1 [expr {($y1 - $b) / $a}] }
  1106.     # potential collisions
  1107.     set x $x0
  1108.     foreach slot [lsort -dic -dec [array names ::Slots]] \
  1109.     {
  1110.       # check for some collisions
  1111.       set ndx $::Slots($slot)
  1112.       if {[lsearch -exact $::Collisions $ndx] > -1} { continue }
  1113.       foreach {- xc yc} $::Bubbles($ndx) break
  1114.       if {$yc > $::Height - $::Size } { continue }
  1115.       if {$a != 0} { set x [expr {($yc - $b) / $a}] }
  1116.       set xl [expr {$x - 2 * $dc}]
  1117.       set xr [expr {$x + 2 * $dc}]
  1118.       if {$xc >= $xl && $xc <= $xr} { lappend ::Collisions $ndx }
  1119.     }
  1120.     if {$x1 < $::R} \
  1121.     {
  1122.       # left bounce
  1123.       set x1 $::R
  1124.       set y1 [expr {$a * $x1 + $b}]
  1125.     } \
  1126.     elseif {$x1 > $::Width - $::R} \
  1127.     {
  1128.       # right bounce
  1129.       set x1 [expr {$::Width - $::R}]
  1130.       set y1 [expr {$a * $x1 + $b}]
  1131.     }
  1132.     # shot the bubble
  1133.     set dx [expr {$x1 - $x0}]
  1134.     set dy [expr {$y1 - $y0}]
  1135.     set time [expr {int(sqrt(($dx * $dx) + ($dy * $dy)))}]
  1136.     if {$time == 0} { return }
  1137.     set ::dX [expr {$dx / double($time)}]
  1138.     set ::dY [expr {$dy / double($time)}]
  1139.     if {$::Status == "ready" || $::Status == "bounce"} \
  1140.     {
  1141.       set ::Status shot
  1142.       after 1 [list Shot $time $x0 $y0]
  1143.     }
  1144.   }
  1145.   # -----------
  1146.   # set the result of the shot
  1147.   # -----------
  1148.   proc SetResult {x y} \
  1149.   {
  1150.     #puts "SetResult $x $y"
  1151.     if {$::Status != "timeout"} \
  1152.     {
  1153.       # compute new color groups
  1154.       UpdateBubble $::Index $x $y
  1155.       update
  1156.       if {[lindex $::Bubbles($::Index) 2] >= $::Height - $::Size} \
  1157.       {
  1158.         # lost!
  1159.         set ::Status timeout
  1160.       } \
  1161.       else \
  1162.       {
  1163.         set group [lindex $::Bubbles($::Index) 5]
  1164.         if {[llength $::Groups($group)] > 2} \
  1165.         { DestroyGroup $group }
  1166.         array set colors {}
  1167.         foreach group [array names ::Groups] \
  1168.         {
  1169.           set color [lindex $::Bubbles([lindex $::Groups($group) 0]) 0]
  1170.           set colors($color) $color
  1171.         }
  1172.         set names [lsort -dic -uniq [array names colors]]
  1173.         set ::nbColors [llength $names]
  1174.         set ::Colors [concat 0 $names]
  1175.       }
  1176.     }
  1177.     if {$::Status == "timeout" || $::nbColors < 1} \
  1178.     {
  1179.       # end of step
  1180.       EndOfStep
  1181.     } \
  1182.     else \
  1183.     {
  1184.       # continue
  1185.       set ::Score [expr {$::Score + $::StepValue * $::Bonus}]
  1186.       SetNumber $::ScoreDisplay $::Score
  1187.       EngageBubble
  1188.       # ready to shot
  1189.       set ::Status ready
  1190.     }
  1191.   }
  1192.   # -----------
  1193.   # end of step
  1194.   # -----------
  1195.   proc EndOfStep {} \
  1196.   {
  1197.     #puts "EndOfStep"
  1198.     # end of step
  1199.     set ::Status endofstep
  1200.     CancelCount
  1201.     FrozeBubbles
  1202.     after 1000 {catch { after cancel $::Froze }}
  1203.     # next step
  1204.     set bonus 0
  1205.     switch $::Level \
  1206.     {
  1207.       master  { set bonus 5000 }
  1208.       expert  { set bonus 2000 }
  1209.     }
  1210.     incr ::Score [expr {$::CurrentTime * 10 + $bonus}]
  1211.     incr ::GrandScore $::Score
  1212.     set n 7
  1213.     if {$::Level == "novice"} { set n 6 }
  1214.     if {$::nbInitialColors < $n} \
  1215.     {
  1216.       # next step
  1217.       incr ::nbInitialColors
  1218.       SetNumber $::GrandScoreDisplay $::GrandScore
  1219.       after 1000 NextStep
  1220.       after 750
  1221.       foreach ndx [array names ::Bubbles] \
  1222.       { catch { DestroyBubble $ndx } }
  1223.     } \
  1224.     else \
  1225.     {
  1226.       # end of game
  1227.       set ::Status newgame
  1228.       BlinkNumber $::GrandScoreDisplay $::GrandScore
  1229.       DestroyBubble $::nbBubbles
  1230.       Options
  1231.       UpdateFame
  1232.     }
  1233.   }
  1234.   # -----------
  1235.   # prepare for the next step
  1236.   # -----------
  1237.   proc NextStep {} \
  1238.   {
  1239.     #puts "NextStep"
  1240.     # initialize
  1241.     set ::InitialColors [lrange [list 0 0 1 2 3 4 5 6 7] 0 $::nbInitialColors]
  1242.     set ::Colors $::InitialColors
  1243.     set ::nbColors $::nbInitialColors
  1244.     set ::nbBubbles 0
  1245.     set ::nbGroups 0
  1246.     set ::Score 0
  1247.     set ::Bonus 1
  1248.     set ::StepValue 0
  1249.     set ::Halted 0
  1250.     array unset ::Bubbles
  1251.     array unset ::Slots
  1252.     array unset ::Groups
  1253.  
  1254.     # update dialog
  1255.     StopBlink
  1256.     SetNumber $::GrandScoreDisplay 0
  1257.     # create bubbles
  1258.     CreateBubbles
  1259.     # prepare a bubble
  1260.     PrepareBubble
  1261.     # engage the bubble & fire!
  1262.     EngageBubble
  1263.     # display the step
  1264.     SetNumber $::StepDisplay [incr ::Step]
  1265.     # start the timer
  1266.     catch { after cancel $::Timer }
  1267.     CountDown
  1268.     # ready to shot
  1269.     set ::Status ready
  1270.   }
  1271.   # -----------
  1272.   # reset the game
  1273.   # -----------
  1274.   proc NewGame {} \
  1275.   {
  1276.     #puts "NewGame"
  1277.     # in case of
  1278.     CancelCount
  1279.     # globals
  1280.     set ::Status newgame
  1281.     set ::MasterWidth 16
  1282.     set ::ExpertWidth 13
  1283.     set ::NoviceWidth 10
  1284.     set ::MasterTime 300
  1285.     set ::ExpertTime 330
  1286.     set ::NoviceTime 360
  1287.     switch $::Level \
  1288.     {
  1289.       master  { set ::N $::MasterWidth; set ::StepTime $::MasterTime }
  1290.       expert  { set ::N $::ExpertWidth; set ::StepTime $::ExpertTime }
  1291.       default { set ::N $::NoviceWidth; set ::StepTime $::NoviceTime }
  1292.     }
  1293.     set ::DY [expr {int($::Size * 0.866)}]
  1294.     set ::R [expr {$::Size / 2}]
  1295.     set ::Width [expr {$::Size * $::N}]
  1296.     set ::Height [expr {int($::Width * 1.25)}]
  1297.     set n 4
  1298.     if {$::Level == "novice"} { set n 3 }
  1299.     set ::nbInitialColors $n
  1300.     set ::Score 0
  1301.     set ::GrandScore 0
  1302.     # create dialog
  1303.     set ::StepDisplay .f1.s
  1304.     set ::ScoreDisplay .f1.d
  1305.     set ::GrandScoreDisplay .f1.e
  1306.     set ::DelayDisplay .f1.f
  1307.     set ::OptionsButton .f1.b
  1308.     set ::TimeDisplay .f2.t
  1309.     set ::BubblesDisplay .f2.c
  1310.     array set ::CanvasSize \
  1311.     [list \
  1312.       $::StepDisplay        1 \
  1313.       $::ScoreDisplay       5 \
  1314.       $::GrandScoreDisplay  7 \
  1315.       $::DelayDisplay       3 \
  1316.     ]
  1317.     CreateDialog
  1318.     # first step
  1319.     set ::Step 0
  1320.     NextStep
  1321.   }
  1322.   # -----------
  1323.   # dump internal info
  1324.   # -----------
  1325.   proc Dump {} \
  1326.   {
  1327.     puts "internal\n--------"
  1328.     puts "step: [expr {3 - $::nbInitialColors}]"
  1329.     puts "time: $::CurrentTime/$::StepTime"
  1330.     puts "level: $::Level"
  1331.     puts "bubbles\n-------"
  1332.     foreach ndx [lsort -dic [array names ::Bubbles]] \
  1333.     { puts "$ndx: $::Bubbles($ndx)" }
  1334.     puts "slots\n-----"
  1335.     for {set row 0} {$row < 20} {incr row} \
  1336.     {
  1337.       set ndxs [array names ::Slots $row:*]
  1338.       if {[llength $ndxs] == 0} { continue }
  1339.       set line ""
  1340.       for {set col 0} {$col < $::N} {incr col} \
  1341.       {
  1342.         set ndx [array names ::Slots $row:$col]
  1343.         if {$ndx != ""} { append line "{$row:$col}$::Slots($row:$col) " }
  1344.       }
  1345.       if {$line != ""} { puts $line }
  1346.     }
  1347.     puts "groups\n------"
  1348.     foreach group [lsort -dic [array names ::Groups]] \
  1349.     {
  1350.       set ndxs $::Groups($group)
  1351.       set n [lindex $::Bubbles([lindex $ndxs 0]) 0]
  1352.       set color [lindex {gray red green yellow indigo violet} $n]
  1353.       puts "$group: $color $ndxs"
  1354.     }
  1355.   }
  1356.   # -----------
  1357.   # display error info
  1358.   # -----------
  1359.   proc bgerror {args} \
  1360.   {
  1361.     puts "\nbgerror:\n$args\n"
  1362.     set level [info level]
  1363.     for {set l $level} {$l < 1} {incr l -1} \
  1364.     { puts "$l:\t[info level $l]" }
  1365.     Dump
  1366.   }
  1367.  
  1368.   # ===========
  1369.   # start game
  1370.   # ===========
  1371.  
  1372.   # exit event
  1373.   wm protocol . WM_DELETE_WINDOW exit
  1374.   # title
  1375.   wm title . "Bubbles v $version, by ulis"
  1376.   # parameters
  1377. #BK was 40...
  1378.   set ::Size 24
  1379.   set ::Speed 3
  1380.   set ::Level expert
  1381.   catch { source /root/.Bubbles1.Parameters }
  1382.   # global
  1383.   set ::User anonymous
  1384.   # create images
  1385.   CreateImages
  1386.   # initialize
  1387.   NewGame
  1388.