Thursday 4 October 2012

Break-It!

TGD Consulting is a software house that use a lo Rebol, they made the following game in pure Rebol.
This is an Arkanoid clone, you must destruct all bricks:
This is the source code, the first part is just compressed images:
REBOL [
    Title: "Break-It!"
    Name: "Break-It!"
    File: %BreakIt.r
    Type: 'view-app
    Version: 1.4.0
    Date: 29-Jan-2006
    Author: "Dirk Weyand"
    Owner: "Dirk Weyand"
    Copyright: "TGD-Consulting"
    Home: http://www.TGD-Consulting.DE/Download.html
    Purpose: "a breakout style game"
    Description: {
Break-It! is a game using REBOL/View.
The purpose of Break-It! is to remove
all coloured bricks on the playfield.
Use the right & left cursor-keys or
the left mouse-button (drag & slide)
to controll the slider.
Have fun and enjoy playing Break-It!}
    History: [
        {0.1.0   ^-28-Nov-2002 ^-"initial release"^/}
        {0.1.1   ^-29-Nov-2002 ^-"removed keyboard control"^/}
        {0.1.2   ^-29-Nov-2002 ^-"control slider with mouse"^/}
        {0.1.3   ^-30-Nov-2002 ^-"changed status button"^/}
        {0.2.0   ^-02-Dec-2002 ^-"added first levels"^/}
        {0.3.0   ^-03-Dec-2002 ^-"changed ball movement"^/}
        {0.3.1   ^-10-Dec-2002 ^-"changed brick detection"^/}
        {0.3.2   ^-11-Dec-2002 ^-"fixed brick detection"^/}
        {0.4.0   ^-13-Dec-2002 ^-"added score-logic"^/}
        {0.4.1   ^-13-Dec-2002 ^-"added keyboard control"^/}
        {0.5.0   ^-14-Dec-2002 ^-"changed highscore layout"^/}
        {0.6.0   ^-15-Dec-2002 ^-"added ball init-movement"^/}
        {0.6.1   ^-15-Dec-2002 ^-"added slider init-move"^/}
        {0.7.0   ^-16-Dec-2002 ^-"enhanced slider collision"^/}
        {0.7.1   ^-17-Dec-2002 ^-"changed ball acceleration"^/}
        {0.8.0   ^-17-Dec-2002 ^-"added heart-bonuspoints"^/}
        {0.9.0   ^-17-Dec-2002 ^-"added new levels"^/}
        {1.0.0   ^-18-Dec-2002 ^-"first public release"^/}
        {1.0.1   ^-19-Dec-2002 ^-"removed some bugs"^/}
        {1.1.0   ^-28-Dec-2002 ^-"enhanced license check"^/}
        {1.2.0   ^-30-Dec-2002 ^-"added ball deviation"^/}
        {1.2.1   ^-31-Dec-2002 ^-"enhanced brick detection"^/}
        {1.2.2   ^-09-Jan-2003 ^-"changed ball deviation"^/}
        {1.3.0   ^-09-Jan-2003 ^-"added 8 new levels"^/}
        {1.3.1   ^-10-Jan-2003 ^-"fixed angel check"^/}
        {1.3.2   ^-11-Jan-2003 ^-"fixed level restart"^/}
        {1.3.3   ^-12-Jan-2003 ^-"changed level load"^/}
        {1.3.4   ^-07-Feb-2003 ^-"changed credit scrolltext"^/}
        {1.3.5   ^-26-Feb-2003 ^-"changed heart face/effect"^/}
        {1.3.6   ^-21-Nov-2003 ^-"changed copyright-note"^/}
        {1.3.7   ^-13-Dec-2003 ^-"orthographical fixes"^/}
        {1.3.8   ^-13-May-2005 ^-"fixed marquees"^/}
        {1.4.0   ^-29-Jan-2006 ^-"added ESC-key control"^/}
    ]
    License: {(C) TGD-Consulting
End User License Agreement
IMPORTANT. READ CAREFULLY.
This Lisense Agreement (AGREEMENT) is a legal contract between you and TGD-Consulting (TGD) for the limited use of this TGD software product (SOFTWARE), which includes computer software, and, as applicable, associated media, printed materials, and electronic documentation.
This SOFTWARE is licensed, not sold, to you. TGD retains all right, title and interest in and to the SOFTWARE including, without limitation, all intellectual property rights relating to or embodied in the SOFTWARE.
TGD grants you an non-exclusice license to use the SOFTWARE for personal use only. Commercial use requires seperate licensing from TGD. This AGREEMENT is not assignable or transferable without prior written approval of TGD.
The copyright, trademark, and other proprietary rights notices contained in the SOFTWARE may not be removed, altered, or added to in any way. You may not reverse engineer, decompress, decompile, or disassemble the SOFTWARE. You may not redistribute the SOFTWARE without prior written approval of TGD.
The SOFTWARE key that unlocks additional features and components may not be distributed, published, or transferred. Only the registered licensee of the SOFTWARE key may enable or use the additional features and components of this SOFTWARE.
THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, WITHOUT ANY EXPRESS OR IMPLIED WARRANTY OF ANY KIND. IN NO EVENT WILL TGD OR THE AUTHOR OF THE SOFTWARE BE HELD LIABLE FOR ANY DAMAGES ARISING FROM THE USE OF THIS SOFTWARE.
You agree to use the SOFTWARE in compliance with all applicable laws and regulations including all laws governing the export or re-export of the SOFTWARE. You agree to indemnify TGD from and against your violation of any such laws or regulations.
This AGREEMENT contains the entire agreement between the parties with respect to the license of the SOFTWARE. This AGREEMENT supercedes any prior license agreement of the SOFTWARE.
By installing or using the SOFTWARE, you are consenting to be bound by and are becoming a party to this AGREEMENT. IF YOU DO NOT AGREE TO ALL OF THE TERMS OF THIS AGGREEMENT, DO NOT INSTALL OR USE THE SOFTWARE.}
]
if not all [value? 'view? view?] [
    until [
        print "^L^/Break-It! requires REBOL/View !!!^/"
        wait 0.15
        print "^L^/^/"
        not none? wait [system/ports/input 0.15]
    ]
    quit
]
img-ball: make image! [13x14 64#{
AAAAAAAAAAAAAAAAAAAAICAgCAgIICAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ODg4iIiIuLi4yMjIuLi4iIiIODg4AAAAAAAAAAAAAAAAAAAAODg4kJCQyMjI4ODg
4ODg4ODgyMjIkJCQODg4AAAAAAAAAAAAICAgYGBgiIiIqKiouLi4uLi4uLi4qKio
iIiIYGBgICAgAAAAAAAASEhIYGBgcHBwgICAiIiIiIiIiIiIgICAcHBwYGBgSEhI
AAAAKCgoWFhYaGhoeHh4gICAkJCQkJCQkJCQgICAeHh4cHBwWFhYKCgoICAgcHBw
gICAkJCQmJiYoKCgoKCgoKCgmJiYkJCQgICAcHBwICAgICAggICAkJCQoKCgqKio
uLi4uLi4uLi4sLCwoKCgkJCQgICAICAgKCgogICAoKCgsLCwuLi4yMjI2NjYyMjI
wMDAsLCwoKCggICAKCgoAAAAaGhoqKiouLi42NjY2NjY2NjY2NjY2NjYwMDAqKio
aGhoAAAAAAAAKCgooKCgwMDA2NjY4ODg4ODg4ODg2NjYyMjIqKioKCgoAAAAAAAA
AAAAQEBAsLCw2NjY4ODg6Ojo4ODg2NjYuLi4QEBAAAAAAAAAAAAAAAAAAAAAODg4
gICAqKiowMDAqKiogICAODg4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAgCAgI
ICAgAAAAAAAAAAAAAAAAAAAA
}
]
img-smallheart: make image! [15x13 64#{
AAAAAAAAAAAAAAAADw8PDg4OAAAAAAAAAAAADg4ODw8PAAAAAAAAAAAAAAAAAAAA
AAAAgoKCrKysubm5s7OzbGxsAAAAbGxss7Ozubm5rKysgYGBAAAAAAAAAAAAf39/
u7u7vb29vb29vb29vb29ioqKvb29vb29vb29vb29u7u7fn5+AAAADQ0NnJycvb29
vb29vb29vb29vb29uLi4vb29vb29vb29vb29vb29nZ2dDw8PDQ0Np6envb29vb29
vb29vb29vb29vb29vb29vb29vb29vb29vb29p6enDQ0NDQ0No6Ojvb29vb29vb29
vb29vb29vb29vb29vb29vb29vb29vb29o6OjDQ0NDQ0NioqKvb29vb29vb29vb29
vb29vb29vb29vb29vb29vb29vb29ioqKDQ0NDQ0NYWFhuLi4vb29vb29vb29vb29
vb29vb29vb29vb29vb29uLi4YmJiDw8PAAAAQUFBhoaGvb29vb29vb29vb29vb29
vb29vb29vb29vb29hoaGREREAAAAAAAAAAAATExMnJycvb29vb29vb29vb29vb29
vb29vb29nJycS0tLAAAAAAAAAAAAAAAAAAAAT09PmZmZvb29vb29vb29vb29vb29
mZmZTU1NAAAAAAAAAAAAAAAAAAAAAAAAAAAAPz8/gYGBvb29vb29vb29gICAQUFB
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAampqiYmJampqAAAAAAAAAAAA
AAAAAAAAAAAA
}
]
img-brick: make image! [30x14 64#{
hYWFhISEh4eHhYWFh4eHh4eHiIiIg4ODhoaGgoKChYWFg4ODhYWFg4ODh4eHg4OD
h4eHhISEh4eHg4ODh4eHhISEhISEgYGBhYWFgYGBhISEgYGBhISEf39/i4uLkJCQ
jIyMk5OTj4+PlZWVj4+PkZGRi4uLkJCQjY2NkpKSioqKj4+PioqKkZGRjo6Ok5OT
kJCQk5OTj4+PlJSUj4+PkZGRjo6OkZGRjIyMkJCQiIiIjY2NiIiIh4eHioqKiYmJ
jIyMh4eHiYmJiIiIioqKiIiIiIiIg4ODhoaGgICAg4ODgICAgoKCgoKChoaGg4OD
hISEgICAgYGBgICAg4ODgYGBhYWFgICAg4ODgoKCgoKCiYmJhoaGi4uLiIiIjo6O
ioqKkZGRioqKkZGRioqKkZGRjY2Nk5OTj4+PlJSUj4+PlJSUkJCQlZWVkZGRlpaW
kJCQk5OTjY2NlJSUj4+PlJSUjY2NlJSUiYmJhYWFiYmJiIiIi4uLiIiIi4uLhoaG
hoaGg4ODhISEgICAgoKCf39/goKCgICAhISEg4ODhoaGg4ODh4eHg4ODh4eHhISE
hoaGgoKChoaGgoKChYWFg4ODgoKCh4eHgYGBhISEfn5+goKCf39/g4ODf39/goKC
f39/hYWFgYGBiIiIgoKChoaGfn5+g4ODgYGBhoaGgoKChYWFf39/hYWFgYGBh4eH
goKCiYmJg4ODiYmJiIiIg4ODiIiIhYWFh4eHg4ODhYWFhISEh4eHgoKChYWFgYGB
hYWFgoKChoaGg4ODhYWFgICAhYWFf39/goKCfn5+gICAfX19gICAfn5+gYGBfn5+
gYGBfn5+enp6f39/e3t7gICAfn5+hISEgICAg4ODgICAhYWFfX19goKCenp6goKC
fX19goKCf39/hISEgYGBhYWFgYGBhoaGgoKCiYmJhoaGiYmJgYGBhYWFgICAhISE
fHx8dnZ2d3d3dHR0dnZ2c3NzdnZ2cnJydXV1cXFxd3d3dHR0dXV1dHR0eXl5eXl5
fX19fHx8f39/fHx8fn5+fn5+f39/enp6fX19eXl5fHx8enp6fHx8enp6f39/goKC
fHx8g4ODfn5+hISEf39/g4ODe3t7gICAenp6fHx8dnZ2e3t7dXV1eHh4c3Nze3t7
dnZ2fHx8dnZ2fHx8dHR0enp6dHR0eXl5cnJydnZ2cHBwc3NzfX19e3t7fHx8eXl5
fn5+fHx8f39/fX19fX19fHx8gYGBfn5+hISEgYGBhISEgYGBh4eHhISEh4eHhISE
iIiIh4eHi4uLhoaGiYmJhoaGiIiIiIiIioqKiYmJgoKCiYmJg4ODiIiIgYGBhISE
fX19gICAe3t7gYGBfX19g4ODfHx8gICAenp6fX19eXl5fn5+eHh4fX19eXl5fn5+
dnZ2eHh4dXV1eXl5dHR0d3d3cnJyeHh4enp6dnZ2eHh4dnZ2enp6d3d3e3t7eHh4
eXl5eHh4e3t7eHh4enp6eXl5fHx8dnZ2eHh4dXV1eXl5c3NzdnZ2cXFxcnJycXFx
dXV1dHR0dHR0b29vcnJycXFxampqb29vampqcHBwaWlpbm5uampqc3NzbGxsbW1t
ampqbm5uampqbW1taWlpb29vampqcnJyb29vdHR0bm5uc3NzcHBwc3NzcHBwd3d3
cnJyeHh4c3Nzenp6
}
]
img-pause: make image! [32x34 64#{
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5OTk4+Pj4uLi4ODg3t7e3Nzc29vb29vb
29vb3Nzc3t7e4ODg4uLi4+Pj5OTk5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm4uLi4eHh3t7e29vb1tbW0dHRzc3NycnJxsbGxsbG
xsbGycnJzc3N0dHR1tbW29vb3t7e4eHh4uLi5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm4ODg3t7e2dnZ09PTysrKwMDAuLi4sbGxrKysqKiop6en
qKiorKyssbGxuLi4wMDAysrK09PT2dnZ3t7e4ODg5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm3t7e3t7e2tra1NTUy8vLvr6+sbGxp6ennp6emJiYlZWVkpKSkpKS
kpKSlZWVmJiYnp6ep6ensbGxvr6+y8vL1NTU2tra3t7e5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm3Nzc2NjY0NDQxcXFtbW1pqammpqaoaGhubm539/f+Pj4////////
////+fn539/fubm5oaGhmpqapqamtbW1xcXF0NDQ2NjY3Nzc5ubm5ubm5ubm5ubm
5ubm5ubm2tra1tbWz8/PwcHBsLCwn5+foaGhvr6+6enp/v7+/v7+/v7+/f39/f39
/f39/v7+/v7+/v7+7Ozsv7+/oKCgn5+fsLCwwcHBz8/P1tbW2tra5ubm5ubm5ubm
5ubm5ubm1tbWzs7OwcHBrq6um5ubq6urwMDA3d3d7e3t7u7u7e3t6urq6urq6urq
6urq7Ozs7e3t7+/v7+/v4eHhxMTEq6urm5ubrq6uwcHBzs7O1tbW5ubm5ubm5ubm
5ubm5ubmz8/PwsLCr6+vnJycpqamtra2ycnJ0tLS19fX2dnZ3d3d3t7e39/f4ODg
39/f3t7e3d3d2tra19fX1dXVzc3NuLi4pqamnZ2dr6+vwsLCz8/P5ubm5ubm5ubm
5ubm0NDQx8fHtbW1oKCgqKiorq6uwMDAy8vL09PT2dnZ3t7e5OTk5+fn6enp6urq
6enp5+fn5OTk3t7e2dnZ09PTzc3NwcHBsLCwp6enoKCgtbW1x8fH0NDQ5ubm5ubm
5ubmy8vLvb29p6enoqKira2tvLy8ysrK1NTU3d3d4+Pj6Ojo6+vr7u7u8PDw8PDw
8PDw7e3t6+vr6Ojo4+Pj3d3d1tbWy8vLu7u7rq6uoqKip6envb29y8vL5ubm5ubm
5ubmxMTEsrKyoKCgrKyst7e3yMjI1dXV3t7e5eXl6enp7e3t8PDw8fHx8/Pz8/Pz
8/Pz8fHx8PDw7e3t6urq5eXl4ODg1tbWx8fHuLi4ra2tn5+fsrKyxMTE5ubm5ubm
5ubmvr6+qamppKSksLCwxMTE09PT3t7e6+vrpqamsbGxs7Ozs7OzrKys8/Pz8/Pz
8/PzrKyss7Ozs7OzsbGxp6en5+fn39/f09PTxsbGsrKyoqKiqampvr6+5ubm5ubm
5ubmubm5oqKisbGxvb290NDQ3d3d5OTk8vLyQkJCQkJCQkJCQkJCQkJC9PT09fX1
9PT0QkJCQkJCQkJCQkJCQkJC7Ozs5ubm3t7e0dHRv7+/sbGxoqKiubm55ubm5ubm
5ubmtLS0n5+ftbW1ycnJ2tra5OTk6enp8vLyQkJCQkJCQkJCQkJCQkJC9fX19vb2
9fX1QkJCQkJCQkJCQkJCQkJC8PDw7e3t5eXl29vbysrKt7e3n5+ftLS05ubm5ubm
5ubmsbGxpaWlvb291NTU4eHh6enp7Ozs8vLyQkJCQkJCQkJCQkJCQkJC8/Pz9fX1
8/PzQkJCQkJCQkJCQkJCQkJC8vLy8fHx6+vr4+Pj1dXVwMDApKSksbGx5ubm5ubm
5ubmr6+vqampxcXF29vb6Ojo7u7u7+/v8vLyQkJCQkJCQkJCQkJCQkJC8/Pz9vb2
8/PzQkJCQkJCQkJCQkJCQkJC8vLy8vLy8vLy6urq3d3dyMjIqampr6+v5ubm5ubm
5ubmsLCwq6urzc3N4uLi7u7u8/Pz8/Pz8vLyQkJCQkJCQkJCQkJCQkJC9fX1+Pj4
9fX1QkJCQkJCQkJCQkJCQkJC8vLy8vLy9PT07u7u4uLiz8/Pra2tsLCw5ubm5ubm
5ubmr6+vqamp09PT6Ojo9fX1+vr69fX18vLyQkJCQkJCQkJCQkJCQkJC9fX1+Pj4
9fX1QkJCQkJCQkJCQkJCQkJC8PDw9fX19/f39PT06enp1dXVqampr6+v5ubm5ubm
5ubmsbGxpKSk1dXV7u7u+vr6/Pz89fX18vLyQkJCQkJCQkJCQkJCQkJC9fX1+Pj4
9fX1QkJCQkJCQkJCQkJCQkJC7e3t8/Pz+Pj4+fn57e3t2NjYpaWlsbGx5ubm5ubm
5ubmtLS0n5+fzs7O8fHx/f39/Pz89fX18vLyQkJCQkJCQkJCQkJCQkJC9fX1+Pj4
9fX1QkJCQkJCQkJCQkJCQkJC8vLy9vb2+/v7/Pz88vLy09PTn5+ftLS05ubm5ubm
5ubmubm5oqKivb298PDw/////Pz89vb28vLyQkJCQkJCQkJCQkJCQkJC9fX1+Pj4
9fX1QkJCQkJCQkJCQkJCQkJC+Pj4+/v7/f39/v7+8/PzwMDAoqKiubm55ubm5ubm
5ubmvr6+qamppqam4ODg/////Pz8+Pj49PT0QkJCQkJCQkJCQkJCQkJC9fX1+Pj4
9fX1QkJCQkJCQkJCQkJCQkJC/f39/v7+/v7+////5eXlqampqampvr6+5ubm5ubm
5ubmxMTEsrKyn5+fxcXF9/f3/v7++/v7+fn5+Pj4+fn5+/v7/f39/v7+/f39+/v7
+fn5+Pj4+fn5+/v7/f39/v7+////////////+fn5ycnJoKCgsrKyxMTE5ubm5ubm
5ubmy8vLvb29p6enpqam39/f+/v7/f39/f39/f39/f39/v7+/////////////f39
/f39/f39/f39/v7+/////////////////Pz84uLip6enp6envb29y8vL5ubm5ubm
5ubm0NDQx8fHtbW1oKCgsrKy39/f+/v7////////////////////////////////
/////////////////////////////Pz84ODgs7OzoKCgtbW1x8fH0NDQ5ubm5ubm
5ubm5ubmz8/PwsLCr6+vnZ2ds7Oz5+fn6urq////////////////////////////
////////////////////////6+vr6enptbW1nZ2dr6+vwsLCz8/P5ubm5ubm5ubm
5ubm5ubm1tbWzs7OwcHBrq6unJycsbGx2NjY4+Pj7u7u////////////////////
////////////////7u7u5OTk2dnZsrKynJycrq6uwcHBzs7O1tbW5ubm5ubm5ubm
5ubm5ubm2tra1tbWz8/PwcHBsLCwn5+foqKiwMDA5eXl5OTk4ODg6urq9vb2/f39
9vb26urq4ODg5OTk5eXlwsLCo6Ojn5+fsLCwwcHBz8/P1tbW2tra5ubm5ubm5ubm
5ubm5ubm5ubm3Nzc2NjY0NDQxcXFtbW1pqammpqaoaGhs7Ozzs7O5eXl9fX1/f39
9fX15eXlz8/Ps7OzoaGhmpqapqamtbW1xcXF0NDQ2NjY3Nzc5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm3t7e2tra1NTUy8vLvr6+sbGxp6ennp6emJiYlZWVkpKSkpKS
kpKSlZWVmJiYnp6ep6ensbGxvr6+y8vL1NTU2tra3t7e3t7e5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm4ODg3t7e2dnZ09PTysrKwMDAuLi4sbGxrKysqKiop6en
qKiorKyssbGxuLi4wMDAysrK09PT2dnZ3t7e4ODg5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm4uLi4eHh3t7e29vb1tbW0dHRzc3NycnJxsbGxsbG
xsbGycnJzc3N0dHR1tbW29vb3t7e4eHh4uLi5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5OTk4+Pj4uLi4ODg3t7e3Nzc29vb29vb
29vb3Nzc3t7e4ODg4uLi4+Pj5OTk5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
}
]
img-heart: make image! [32x34 64#{
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5OTk4+Pj4uLi4ODg3t7e3Nzc29vb29vb
29vb3Nzc3t7e4ODg4uLi4+Pj5OTk5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm4uLi4eHh3t7e29vb1tbW0dHRzc3NycnJxsbGxsbG
xsbGycnJzc3N0dHR1tbW29vb3t7e4eHh4uLi5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm4ODg3t7e2dnZ09PTysrKwMDAuLi4sbGxrKysqKiop6en
qKiorKyssbGxuLi4wMDAysrK09PT2dnZ3t7e4ODg5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm3t7e3t7e2tra1NTUy8vLvr6+sbGxp6ennp6emJiYlZWVkpKSkpKS
kpKSlZWVmJiYnp6ep6ensbGxvr6+y8vL1NTU2tra3t7e5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm3Nzc2NjY0NDQxcXFtbW1pqammpqaoaGhubm539/f+Pj4////////
////+fn539/fubm5oaGhmpqapqamtbW1xcXF0NDQ2NjY3Nzc5ubm5ubm5ubm5ubm
5ubm5ubm2tra1tbWz8/PwcHBsLCwn5+foaGhvr6+6enp/v7+/v7+/v7+/f39/f39
/f39/v7+/v7+/v7+7Ozsv7+/oKCgn5+fsLCwwcHBz8/P1tbW2tra5ubm5ubm5ubm
5ubm5ubm1tbWzs7OwcHBrq6um5ubq6urwMDA3d3d7e3t7u7u7e3t6urq6urq6urq
6urq7Ozs7e3t7+/v7+/v4eHhxMTEq6urm5ubrq6uwcHBzs7O1tbW5ubm5ubm5ubm
5ubm5ubmz8/PwsLCr6+vnJycpqamtra2ycnJ0tLS19fX2dnZ3d3d3t7e39/f4ODg
39/f3t7e3d3d2tra19fX1dXVzc3NuLi4pqamnZ2dr6+vwsLCz8/P5ubm5ubm5ubm
5ubm0NDQx8fHtbW1oKCgqKiorq6uwMDAy8vL09PT2dnZ3t7e5OTk5+fn6enp6urq
6enp5+fn5OTk3t7e2dnZ09PTzc3NwcHBsLCwp6enoKCgtbW1x8fH0NDQ5ubm5ubm
5ubmy8vLvb29p6enoqKira2tvLy8ysrK1NTU3d3d4+Pj6Ojo6+vr7u7u8PDw8PDw
8PDw7e3t6+vr6Ojo4+Pj3d3d1tbWy8vLu7u7rq6uoqKip6envb29y8vL5ubm5ubm
5ubmxMTEsrKyoKCgrKyst7e3yMjI1dXV3t7e5eXl6enp7e3t8PDw8fHx8/Pz8/Pz
8/Pz8fHx8PDw7e3t6urq5eXl4ODg1tbWx8fHuLi4ra2tn5+fsrKyxMTE5ubm5ubm
5ubmvr6+qamppKSksLCwxMTE09PT3t7e6+vr////fX19U1NTRkZGTExMk5OT////
k5OTTExMRkZGU1NTfn5+////5+fn39/f09PTxsbGsrKyoqKiqampvr6+5ubm5ubm
5ubmubm5oqKisbGxvb290NDQ3d3d5OTk8vLygICAREREQkJCQkJCQkJCQkJCdXV1
QkJCQkJCQkJCQkJCREREgYGB7Ozs5ubm3t7e0dHRv7+/sbGxoqKiubm55ubm5ubm
5ubmtLS0n5+ftbW1ycnJ2tra5OTk6enp8vLyY2NjQkJCQkJCQkJCQkJCQkJCR0dH
QkJCQkJCQkJCQkJCQkJCYmJi8PDw7e3t5eXl29vbysrKt7e3n5+ftLS05ubm5ubm
5ubmsbGxpaWlvb291NTU4eHh6enp7Ozs8vLyWFhYQkJCQkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJCQkJCWFhY8vLy8fHx6+vr4+Pj1dXVwMDApKSksbGx5ubm5ubm
5ubmr6+vqampxcXF29vb6Ojo7u7u7+/v8vLyXFxcQkJCQkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJCQkJCXFxc8vLy8vLy8vLy6urq3d3dyMjIqampr6+v5ubm5ubm
5ubmsLCwq6urzc3N4uLi7u7u8/Pz8/Pz8vLydXV1QkJCQkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJCQkJCdXV18vLy8vLy9PT07u7u4uLiz8/Pra2tsLCw5ubm5ubm
5ubmr6+vqamp09PT6Ojo9fX1+vr69fX18vLynp6eR0dHQkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJCR0dHnZ2d8PDw9fX19/f39PT06enp1dXVqampr6+v5ubm5ubm
5ubmsbGxpKSk1dXV7u7u+vr6/Pz89fX18vLyvr6+eXl5QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJCeXl5u7u77e3t8/Pz+Pj4+fn57e3t2NjYpaWlsbGx5ubm5ubm
5ubmtLS0n5+fzs7O8fHx/f39/Pz89fX18vLy////s7OzY2NjQkJCQkJCQkJCQkJC
QkJCQkJCQkJCY2NjtLS0////8vLy9vb2+/v7/Pz88vLy09PTn5+ftLS05ubm5ubm
5ubmubm5oqKivb298PDw/////Pz89vb28vLy////////sLCwZmZmQkJCQkJCQkJC
QkJCQkJCZmZmsrKy////////+Pj4+/v7/f39/v7+8/PzwMDAoqKiubm55ubm5ubm
5ubmvr6+qamppqam4ODg/////Pz8+Pj49PT0////////////wMDAfn5+QkJCQkJC
QkJCf39/vr6+/////////////f39/v7+/v7+////5eXlqampqampvr6+5ubm5ubm
5ubmxMTEsrKyn5+fxcXF9/f3/v7++/v7+fn5////////////////////lZWVdnZ2
lZWV////////////////////////////////+fn5ycnJoKCgsrKyxMTE5ubm5ubm
5ubmy8vLvb29p6enpqam39/f+/v7/f39/f39/f39/f39/v7+/////////////f39
/f39/f39/f39/v7+/////////////////Pz84uLip6enp6envb29y8vL5ubm5ubm
5ubm0NDQx8fHtbW1oKCgsrKy39/f+/v7////////////////////////////////
/////////////////////////////Pz84ODgs7OzoKCgtbW1x8fH0NDQ5ubm5ubm
5ubm5ubmz8/PwsLCr6+vnZ2ds7Oz5+fn6urq////////////////////////////
////////////////////////6+vr6enptbW1nZ2dr6+vwsLCz8/P5ubm5ubm5ubm
5ubm5ubm1tbWzs7OwcHBrq6unJycsbGx2NjY4+Pj7u7u////////////////////
////////////////7u7u5OTk2dnZsrKynJycrq6uwcHBzs7O1tbW5ubm5ubm5ubm
5ubm5ubm2tra1tbWz8/PwcHBsLCwn5+foqKiwMDA5eXl5OTk4ODg6urq9vb2/f39
9vb26urq4ODg5OTk5eXlwsLCo6Ojn5+fsLCwwcHBz8/P1tbW2tra5ubm5ubm5ubm
5ubm5ubm5ubm3Nzc2NjY0NDQxcXFtbW1pqammpqaoaGhs7Ozzs7O5eXl9fX1/f39
9fX15eXlz8/Ps7OzoaGhmpqapqamtbW1xcXF0NDQ2NjY3Nzc5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm3t7e2tra1NTUy8vLvr6+sbGxp6ennp6emJiYlZWVkpKSkpKS
kpKSlZWVmJiYnp6ep6ensbGxvr6+y8vL1NTU2tra3t7e3t7e5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm4ODg3t7e2dnZ09PTysrKwMDAuLi4sbGxrKysqKiop6en
qKiorKyssbGxuLi4wMDAysrK09PT2dnZ3t7e4ODg5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm4uLi4eHh3t7e29vb1tbW0dHRzc3NycnJxsbGxsbG
xsbGycnJzc3N0dHR1tbW29vb3t7e4eHh4uLi5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5OTk4+Pj4uLi4ODg3t7e3Nzc29vb29vb
29vb3Nzc3t7e4ODg4uLi4+Pj5OTk5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
}
]
img-stop: make image! [32x34 64#{
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5OTk4+Pj4uLi4ODg3t7e3Nzc29vb29vb
29vb3Nzc3t7e4ODg4uLi4+Pj5OTk5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm4uLi4eHh3t7e29vb1tbW0dHRzc3NycnJxsbGxsbG
xsbGycnJzc3N0dHR1tbW29vb3t7e4eHh4uLi5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm4ODg3t7e2dnZ09PTysrKwMDAuLi4sbGxrKysqKiop6en
qKiorKyssbGxuLi4wMDAysrK09PT2dnZ3t7e4ODg5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm3t7e3t7e2tra1NTUy8vLvr6+sbGxp6ennp6emJiYlZWVkpKSkpKS
kpKSlZWVmJiYnp6ep6ensbGxvr6+y8vL1NTU2tra3t7e5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm3Nzc2NjY0NDQxcXFtbW1pqammpqaoaGhubm539/f+Pj4////////
////+fn539/fubm5oaGhmpqapqamtbW1xcXF0NDQ2NjY3Nzc5ubm5ubm5ubm5ubm
5ubm5ubm2tra1tbWz8/PwcHBsLCwn5+foaGhvr6+6enp/v7+/v7+/v7+/f39/f39
/f39/v7+/v7+/v7+7Ozsv7+/oKCgn5+fsLCwwcHBz8/P1tbW2tra5ubm5ubm5ubm
5ubm5ubm1tbWzs7OwcHBrq6um5ubq6urwMDA3d3d7e3t7u7u7e3t6urq6urq6urq
6urq7Ozs7e3t7+/v7+/v4eHhxMTEq6urm5ubrq6uwcHBzs7O1tbW5ubm5ubm5ubm
5ubm5ubmz8/PwsLCr6+vnJycpqamtra2ycnJ0tLS19fX2dnZ3d3d3t7e39/f4ODg
39/f3t7e3d3d2tra19fX1dXVzc3NuLi4pqamnZ2dr6+vwsLCz8/P5ubm5ubm5ubm
5ubm0NDQx8fHtbW1oKCgqKiorq6uwMDAy8vL09PT2dnZ3t7e5OTk5+fn6enp6urq
6enp5+fn5OTk3t7e2dnZ09PTzc3NwcHBsLCwp6enoKCgtbW1x8fH0NDQ5ubm5ubm
5ubmy8vLvb29p6enoqKira2tvLy8ysrK1NTU3d3d4+Pj6Ojo6+vr7u7u8PDw8PDw
8PDw7e3t6+vr6Ojo4+Pj3d3d1tbWy8vLu7u7rq6uoqKip6envb29y8vL5ubm5ubm
5ubmxMTEsrKyoKCgrKyst7e3yMjI1dXV3t7e5eXl6enp7e3t8PDw8fHx8/Pz8/Pz
8/Pz8fHx8PDw7e3t6urq5eXl4ODg1tbWx8fHuLi4ra2tn5+fsrKyxMTE5ubm5ubm
5ubmvr6+qamppKSksLCwxMTE09PT3t7e6+vr////////////////////////////
////////////////////////5+fn39/f09PTxsbGsrKyoqKiqampvr6+5ubm5ubm
5ubmubm5oqKisbGxvb290NDQ3d3d5OTk8vLy////////pqamsbGxs7Ozs7Ozs7Oz
s7Ozs7OzsbGxp6en////////7Ozs5ubm3t7e0dHRv7+/sbGxoqKiubm55ubm5ubm
5ubmtLS0n5+ftbW1ycnJ2tra5OTk6enp8vLy////////QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJC////////8PDw7e3t5eXl29vbysrKt7e3n5+ftLS05ubm5ubm
5ubmsbGxpaWlvb291NTU4eHh6enp7Ozs8vLy////////QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJC////////8vLy8fHx6+vr4+Pj1dXVwMDApKSksbGx5ubm5ubm
5ubmr6+vqampxcXF29vb6Ojo7u7u7+/v8vLy////////QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJC////////8vLy8vLy8vLy6urq3d3dyMjIqampr6+v5ubm5ubm
5ubmsLCwq6urzc3N4uLi7u7u8/Pz8/Pz8vLy////////QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJC////////8vLy8vLy9PT07u7u4uLiz8/Pra2tsLCw5ubm5ubm
5ubmr6+vqamp09PT6Ojo9fX1+vr69fX18vLy////////QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJC////////8PDw9fX19/f39PT06enp1dXVqampr6+v5ubm5ubm
5ubmsbGxpKSk1dXV7u7u+vr6/Pz89fX18vLy////////QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJC////////7e3t8/Pz+Pj4+fn57e3t2NjYpaWlsbGx5ubm5ubm
5ubmtLS0n5+fzs7O8fHx/f39/Pz89fX18vLy////////QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJC////////8vLy9vb2+/v7/Pz88vLy09PTn5+ftLS05ubm5ubm
5ubmubm5oqKivb298PDw/////Pz89vb28vLy////////QkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJC////////+Pj4+/v7/f39/v7+8/PzwMDAoqKiubm55ubm5ubm
5ubmvr6+qamppqam4ODg/////Pz8+Pj49PT0////////////////////////////
/////////////////////////f39/v7+/v7+////5eXlqampqampvr6+5ubm5ubm
5ubmxMTEsrKyn5+fxcXF9/f3/v7++/v7+fn5+Pj4+fn5+/v7/f39/v7+/f39+/v7
+fn5+Pj4+fn5+/v7/f39/v7+////////////+fn5ycnJoKCgsrKyxMTE5ubm5ubm
5ubmy8vLvb29p6enpqam39/f+/v7/f39/f39/f39/f39/v7+/////////////f39
/f39/f39/f39/v7+/////////////////Pz84uLip6enp6envb29y8vL5ubm5ubm
5ubm0NDQx8fHtbW1oKCgsrKy39/f+/v7////////////////////////////////
/////////////////////////////Pz84ODgs7OzoKCgtbW1x8fH0NDQ5ubm5ubm
5ubm5ubmz8/PwsLCr6+vnZ2ds7Oz5+fn6urq////////////////////////////
////////////////////////6+vr6enptbW1nZ2dr6+vwsLCz8/P5ubm5ubm5ubm
5ubm5ubm1tbWzs7OwcHBrq6unJycsbGx2NjY4+Pj7u7u////////////////////
////////////////7u7u5OTk2dnZsrKynJycrq6uwcHBzs7O1tbW5ubm5ubm5ubm
5ubm5ubm2tra1tbWz8/PwcHBsLCwn5+foqKiwMDA5eXl5OTk4ODg6urq9vb2/f39
9vb26urq4ODg5OTk5eXlwsLCo6Ojn5+fsLCwwcHBz8/P1tbW2tra5ubm5ubm5ubm
5ubm5ubm5ubm3Nzc2NjY0NDQxcXFtbW1pqammpqaoaGhs7Ozzs7O5eXl9fX1/f39
9fX15eXlz8/Ps7OzoaGhmpqapqamtbW1xcXF0NDQ2NjY3Nzc5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm3t7e2tra1NTUy8vLvr6+sbGxp6ennp6emJiYlZWVkpKSkpKS
kpKSlZWVmJiYnp6ep6ensbGxvr6+y8vL1NTU2tra3t7e3t7e5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm4ODg3t7e2dnZ09PTysrKwMDAuLi4sbGxrKysqKiop6en
qKiorKyssbGxuLi4wMDAysrK09PT2dnZ3t7e4ODg5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm4uLi4eHh3t7e29vb1tbW0dHRzc3NycnJxsbGxsbG
xsbGycnJzc3N0dHR1tbW29vb3t7e4eHh4uLi5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5OTk4+Pj4uLi4ODg3t7e3Nzc29vb29vb
29vb3Nzc3t7e4ODg4uLi4+Pj5OTk5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm
}
]
lic-read: started: init-pf: unlimited: game-over: false
saved-score: true
last-time: now/time
old-time: new-time: now/time/precise
box2d: delta: score: old-score: tb: 0
oldlevel: level: 1
current-level: ""
x-min: y-min: 0
x-max: 295
y-max: 152
slider-min: 0
slider-max: 268
bricks: []
lowboxes: []
zerolist: []
max-velocity: 60
min-velocity: 21
boxgrid: 20x9
boxfield: []
for i 1 (boxgrid/x * boxgrid/y) 1 [
    append boxfield to word! join 'b i
    if lesser-or-equal? i boxgrid/x [append zerolist 0]
]
copydate: copy find/tail second system/script/Header/History "^-"
clear find copydate " "
copydate: to date! copydate
either greater? now/year copydate/year [copydate: join form copydate/year ["-" now/year]] [copydate: form copydate/year]
blau: 122.154.198
hellblau: 200.200.220
blaugrau: 80.80.100
wallcol: blaugrau - 20
btn-styles: stylize [
    sky-btn: button no-wrap center middle edge [color: blau] effects compose/deep [[gradient 0x1 (blau + 30) (blau - 30)] [gradient 0x-1 (blau + 30) (blau - 30)]] font [colors: [255.255.240 28.52.86]]
]
message: func [
    "Display a message window"
    str [string! block! object!] "Message to display"
    /offset xy [pair!] "Offset of window"
    /color colors [tuple! block!] "Used colors"
    /timeout time
    /local lay result hdl msg c1 c2 c3 f x-hdl x-txt x-p
] [
    lay: either all [object? str in str 'type str/type = 'face]
    [str] [
        c1: green c2: c3: black + 10
        hdl: "N O T E :"
        if color [either block? colors [set [c1 c2 c3] colors] [c1: colors]]
        either block? str [
            str: reduce str
            set [hdl msg] str
            str: reform next next str
            foreach n [hdl msg str] [
                if all [found? get n not string? get n] [set n form get n]
            ]
        ] [
            msg: str
            str: ""
        ]
        f: layout [h1 copy hdl c1 center middle edge [color: blau size: 1x1 effect: 'bevel]]
        x-hdl: 20 - 44 + first f/size
        either empty? str
        [f: layout [across text bold copy msg c2 middle]]
        [f: layout [across text bold copy msg c2 middle text copy str c3 middle]]
        x-txt: subtract first f/size 44
        either greater? x-txt x-hdl [x-p: to integer! (x-txt - x-hdl / 2)] [x-p: 0]
        result: copy [
            styles btn-styles
            backdrop effect compose [gradient 0x1 (blau + 10) (blau - 20)]
            across
            pad x-p
            sky-btn x-hdl copy hdl font [size: 20 colors: compose [(c1) (c1 - 40)]] edge [size: 1x1] [result: true hide-popup] [result: true hide-popup] return
            text bold copy msg c2 middle with [feel: none]
        ]
        if not empty? str [append result [text copy str c3 middle with [feel: none]]]
        layout result
    ]
    result: none
    either offset [inform/offset/timeout lay xy time] [inform/timeout lay time]
    result
]
either found? suffix: find/last system/script/Header/File "." [filename: copy/part system/script/Header/File subtract length? system/script/Header/File length? suffix ] [filename: copy system/script/Header/File ]
scroll-slider-text: func [tf sf /local tmp size sms] [
    if none? tf/para [exit]
    size: size-text tf
    sms: subtract sf/size 2 * sf/edge/size
    tmp: min 0x0 tf/size - size - 0x8
    either sf/size/x > sf/size/y [
        tf/para/scroll/x: sf/data * first tmp
        either any [system/version > 1.3.0 equal? system/product 'Link] [sf/pane/1/size/x: max 10 to integer! divide sms/x max 1 (first size) / tf/size/x ] [sf/pane/size/x: max 10 to integer! divide sms/x max 1 (first size) / tf/size/x ]
    ] [
        tf/para/scroll/y: sf/data * second tmp
        either any [system/version > 1.3.0 equal? system/product 'Link] [sf/pane/1/size/y: max 10 to integer! divide sms/y max 1 (second size) / tf/size/y ] [sf/pane/size/y: max 10 to integer! divide sms/y max 1 (second size) / tf/size/y ]
    ]
    sf/state: -1
    show [tf sf]
]
scroll-smooth: func [dx tf sf /init /local d] [
    d: divide 2 max sf/size/x sf/size/y
    either positive? dx [
        while [all [lesser? sf/data 1 positive? dx]] [
            sf/data: min 1 sf/data + d
            dx: subtract dx d
            scroll-slider-text tf sf
        ]
    ] [
        while [all [positive? sf/data 1 negative? dx]] [
            sf/data: max 0 sf/data - d
            dx: add dx d
            scroll-slider-text tf sf
        ]
    ]
    if init [tf/para/scroll: 0x0]
]
license-agreement: layout [
    styles btn-styles
    backdrop blau effect reduce ['grid 8x8 (blau - 10)]
    across
    banner join system/script/header/Name "   -   E U L A" 416 with [feel: none]
    return
    space 0
    f-txt: text 400x150 blau / 3 ivory edge [color: blau size: 2x2 effect: 'ibevel] with [feel: none]
    f-sld: slider f-txt/size/y * 0x1 + 16x0 blau / 2 blau - 15 edge [color: blau] [scroll-slider-text f-txt f-sld f-txt/para/scroll: 0x0 if greater? face/data 0.97 [lic-read: true]] return
    pad 1x10 return
    sky-btn 80 "ACCEPT" "ACCEPTED" keycode [#"^M"] [either lic-read [unview license-agreement] [message/timeout {Read the complete EULA before you accept the agreement !!!} 0:00:06 hide-popup]] [either lic-read [unview license-agreement] [message/timeout {Read the complete EULA, before you accept the agreement!!!} 0:00:06 hide-popup]]
    pad 256
    sky-btn 80 "Cancel" "Canceld" keycode [#"^["] [unview/all quit] [unview/all quit]
    key keycode [up page-up] [scroll-smooth/init -0.1 f-txt f-sld]
    key keycode [down page-down] [scroll-smooth/init 0.1 f-txt f-sld if greater? f-sld/data 0.97 [lic-read: true]]
]
insert find/tail system/script/header/license "(C)" join " " copydate
f-txt/text: copy system/script/header/license
either any [system/version > 1.3.0 equal? system/product 'Link] [f-sld/pane/1/edge/color: blau ] [f-sld/pane/edge/color: blau ]
if not exists? highscore-path: join filename "-highscores.r" [
    scroll-slider-text f-txt f-sld
    view center-face license-agreement
]
level-path: join filename "-levels.r"
levels: either exists? level-path [load level-path] [
    either found? foo: read-net join http://www.TGD-Consulting.de/REBOL/ level-path [
        write/direct/binary level-path foo
        load to string! foo
    ] [
        message/color/timeout reduce ["E R R O R :" reform ["Level-file" level-path "not found !!!"] reform ["Please contact" system/script/Header/Copyright "to get all levels."]] red 0:00:06
        hide-popup
        quit
    ]
]
if binary? levels [
    if error? try [levels: to block! decompress levels] [
        message/color/timeout reduce ["E R R O R :" reform ["Corrupt level-file" level-path "!!!"] reform ["Please contact" system/script/Header/Copyright "to receive a new one."]] red 0:00:06
        hide-popup
        quit
    ]
]
either all [exists? join filename ".license" exists? system/script/Header/File] [
    either all [not error? try [do load join filename ".license"] value? 'expiry value? 'license-key value? 'licensee] [
        either date? expiry [
            either greater? now/date expiry [
                message/color reduce ["A T T E N T I O N :" reform ["Your" system/script/Header/Name "license-key is expired !!!"] reform ["Please contact" system/script/Header/Copyright "to get a new license-file."]] yellow
            ] [
                either equal? license-key checksum/key read system/script/Header/File join system/script/Header/Name [user-prefs/name expiry licensee] [unlimited: true ] [
                    message/color reduce ["A T T E N T I O N :" reform ["Your" system/script/Header/Name "license-key is not valid !!!"] reform ["Please contact" system/script/Header/Copyright "to get a new license-file."]] yellow
                ]
            ]
        ] [
            either equal? license-key checksum/key read system/script/Header/File join system/script/Header/Name [user-prefs/name licensee] [unlimited: true ] [
                message/color reduce ["A T T E N T I O N :" reform ["Your" system/script/Header/Name "license-key is not valid !!!"] reform ["Please contact" system/script/Header/Copyright "to get a new license-file."]] yellow
            ]
        ]
    ] [
        message/color reduce ["A T T E N T I O N :" reform ["Your" system/script/Header/Name "license-key is not valid !!!"] reform ["Please contact" system/script/Header/Copyright "to get a new license-file."]] yellow
    ]
] [
    message/color reduce ["A T T E N T I O N :" reform [system/script/Header/Name "license-file not found !!!"] reform ["Please contact" system/script/Header/Copyright "for registration."]] yellow
]
highscores: either exists? highscore-path [load highscore-path] [
    [[score "     1" name "T G D         " level " 1" date "14-Dec-2002"]]
]
update-file: func [data] [
    set [path file] split-path highscore-path
    if not exists? path [make-dir/deep path]
    write highscore-path data
]
save-file: has [buf] [
    buf: reform ["REBOL [Title:" mold join system/script/Header/Name " Highscore" "Date:" now "]^/[^/"]
    foreach n highscores [repend buf [mold n newline]]
    update-file append buf "]"
]
init-highscore: has [element i date rank score level] [
    clear scorelist/text
    i: 1
    rank: " "
    append scorelist/text {TOP-20
    Score         Name       Level       Date    
-------------------------------------------------}

    foreach element highscores [
        append scorelist/text newline
        clear rank
        if i < 10 [append rank 0]
        append rank i
        append rank ". "
        score: select element 'score
        while [5 > length? score] [insert score " "]
        level: select element 'level
        while [2 > length? level] [insert level " "]
        date: select element 'date
        while [11 > length? date] [insert date " "]
        append scorelist/text reform [rank score " " select element 'name " " level " (" date ")"]
        i: i + 1
    ]
    date: to string! now/date
    while [11 > length? date] [insert date " "]
    for i (1 + length? highscores) 20 1 [
        clear rank
        if i < 10 [append rank 0]
        append rank i
        append rank ". "
        append scorelist/text newline
        append scorelist/text reform [rank "-----" " " "---           " " " "--" " (" date ")"]
    ]
    append scorelist/text newline
    append scorelist/text "-------------------------------------------------"
    show scorelist
]
update-highscore: func [
    "Update highscore"
    myscore [integer!] "The score in the game"
    myname [string!] "The name of the player"
    mylevel [integer!] "The current-level"
    /local element index
] [
    while [14 < length? myname] [remove at myname length? myname]
    while [14 > length? myname] [append myname " "]
    index: 1
    foreach element highscores [
        if myscore > to integer! trim select element 'score [
            insert at highscores index to block! mold reduce ['score form myscore 'name myname 'level form mylevel 'date form now/date]
            break
        ]
        index: index + 1
    ]
    while [20 < length? highscores] [remove at highscores length? highscores]
    init-highscore
]
highscore: layout [
    styles btn-styles
    backdrop effect [gradient 0x1 164.200.255 80.108.142]
    across
    pad 40 h1 underline "Highscores" 28.52.86 with [feel: none]
    pad 100 sky-btn "Close" "Closed" 90 keycode [#"^["] [unview/only highscore] [message/timeout "Press left mouse-button to close window !!!" 0:00:06 hide-popup]
    return
    space 0
    box 380x3 edge [size: 1x1 color: sky effect: 'bevel] return
    scorelist: code 28.52.86 center bold 380x100 " " no-wrap rate 25 para [origin: 0x20]
    feel [engage: func [face action event] [
            if action = 'time [face/para/origin: face/para/origin - 0x1
                if lesser? second face/para/origin negate second size-text scorelist [face/para/origin: 0x99]
                show face]
        ]
    ] return
    space 8
    box 380x3 edge [size: 1x1 color: sky effect: 'bevel] return
]
init-highscore
history: layout [
    styles btn-styles
    backdrop effect compose [gradient 0x1 (blau + 20) (blau - 20)]
    across
    pad 30
    banner "History" 90 with [feel: none]
    pad 70
    sky-btn "Close" "Closed" 90 keycode [#"^["] [unview/only history] [message/timeout "Press left mouse-button to close window !!!" 0:00:06 hide-popup]
    return
    h-txt: text 274x80 blau / 3 ivory no-wrap edge [color: blau size: 2x2 effect: 'ibevel] with [feel: none]
    pad -8x0 h-sld: slider h-txt/size/y * 0x1 + 16x0 blau / 2 blau - 15 edge [color: blau] [scroll-slider-text h-txt h-sld]
    at 0x0
    key keycode [up page-up] [scroll-smooth -0.15 h-txt h-sld]
    key keycode [down page-down] [scroll-smooth 0.15 h-txt h-sld]
]
h-txt/text: system/script/header/History
either any [system/version > 1.3.0 equal? system/product 'Link] [h-sld/pane/1/edge/color: blau] [h-sld/pane/edge/color: blau]
scroll-slider-text h-txt h-sld
sendmail: layout [
    styles btn-styles
    backdrop blau effect reduce ['grid 8x8 blau - 10]
    h2 28.52.86 reform ["Send email to" system/script/header/Name "author:"] with [feel: none]
    msg: area "Type your message here ..." 250x50 wrap
    across return
    sky-btn 80 "Send" "Send ..." [
        sending: flash "Sending ..."
        either error? try [
            hdr: make system/standard/email [subject: reform [system/script/header/Name system/script/header/Version "(" user-prefs/name ")"]]
            send/header D.Weyand@TGD-Consulting.de msg/text hdr
        ] [
            unview/only sending
            message/color ["E R R O R :" "Error sending email !!!" "Check your REBOL network setup."] red
        ] [
            unview/only sending
            message/color/timeout ["O K A Y" "Your email has been sent!" "Thanx 4 Your message."] green 0:00:06
            hide-popup
            unview/only sendmail
        ]
    ]
    pad 80 sky-btn 80 "Cancel" "Canceled" keycode [#"^["] [unview/only sendmail]
]
about: layout [
    styles btn-styles
    backdrop effect [gradient 0x1 164.200.255 80.108.142]
    style link text bold font [colors: [0.0.0 28.52.86]]
    across
    hd1: h1 underline form system/script/header/Name 28.52.86 with [feel: none]
    hd2: h1 reform ["Version:" system/script/header/Version] 28.52.86 with [feel: none] return
    space 0
    box 250x3 edge [size: 1x1 color: sky effect: 'bevel] return
    credits: text 28.52.86 center bold 250x80 no-wrap rate 25 para [origin: 0x10]
    feel [engage: func [face action event] [
            if action = 'time [face/para/origin: face/para/origin - 0x1
                if lesser? second face/para/origin negate second size-text credits [face/para/origin: 0x70]
                show face]
        ]
    ] return
    space 8
    box 250x3 edge [size: 1x1 color: sky effect: 'bevel] return
    space 0
    pad 20 text bold "written by" with [feel: none]
    link 28.30.50 system/script/header/Author [sendmail/offset: about/offset + 145x165 view/new/options sendmail [no-title]] return
    pad 20 text bold reform ["Copyright" copydate ","] with [feel: none]
    space 8 link 28.30.50 system/script/header/Copyright [
        if request ["Connect to homepage of TGD-Consulting ?" "Browse" "Cancel"] [
            error? try [browse system/script/header/Home]
        ]
    ] return
    pad 20 text bold reform ["Updated: " modified? system/options/script] with [feel: none] return
    sky-btn 80 "Close" "Closed" keycode [#"^["] [unview/only about] [message/timeout "Press left mouse-button to close window !!!" 0:00:06 hide-popup]
    pad 80
    sky-btn 80 "History" "Show me" [view/new/options center-face history [no-title]] [message/timeout "Press left mouse-button to view history !!!" 0:00:06 hide-popup]
]
credits/text: {
\|/
@ @
----------oOO-(_)-OOo----------
-= T G D =-
is proud to
present
}

append credits/text reform [">>> " system/script/Header/Name " <<<" newline]
append credits/text form system/script/header/Description
append credits/text {
- - - - - -
}

either unlimited [
    append credits/text reform ["This software is registered to" newline licensee "."]
    if date? expiry [
        append credits/text reform [newline "Your license will expire at" newline expiry "!"]
    ]
] [
    either all [value? 'expiry date? expiry] [
        append credits/text reform ["This software has been registered to" newline licensee "," newline "but your license expired !" newline]
    ] [
        append credits/text {This software is not registered yet,
it runs in D E M O - mode only!
}

    ]
    append credits/text reform ["^/If you want to use" system/script/Header/Name {
without limitations,
contact TGD-Consulting by below
links or send an e-mail to:
info@TGD-Consulting.de}
]
]
append credits/text "^/^/- - - - - -"
restart: layout [
    styles btn-styles
    style txt-bevel text 100x20 center middle edge [color: blau size: 1x1 effect: 'ibevel] with [feel: none]
    backdrop blau effect reduce ['grid 8x8 blau - 10]
    across
    space 0
    text 230 28.52.86 bold underline center font [size: 16] "Restart level :" with [feel: none] return
    space 8
    r-txt: text 230 28.52.86 center reform ["( blank level-code => restart level" oldlevel ")"] with [feel: none] return
    box 230x3 edge [size: 1x1 color: blau - 10 effect: 'bevel] return
    pad 10 txt-bevel 80 "level-code"
    level-code: field 120x20 ivory middle center "" edge [color: blau size: 1x1] return
    box 230x3 edge [size: 1x1 color: blau - 10 effect: 'bevel] return
    sky-btn 80 "Start" "..." [
        if not saved-score [
            update-highscore score copy spielername/text level
            if unlimited [save-file]
            saved-score: true
        ]
        either empty? level-code/text [
            level: oldlevel
            init-level level
            unview/only restart
        ] [
            either check-code uppercase level-code/text [
                init-level level
                unview/only restart
            ] [
                message/color ["W R O N G   C O D E :" "Your level-code is not correct!" "Try again ..."] orange
                focus level-code
            ]
        ]
    ]
    pad 60 sky-btn 80 "Cancel" "Canceled" keycode [#"^["] [unview/only restart] return
]
main: layout [
    styles btn-styles
    style bx box 15x10 img-brick edge [size: 1x1 effect: 'bevel] [
        if not init-pf [init-level level]
        if all [init-pf not started] [
            active/image: img-heart
            started: active/data: active/state: true
            show active
        ]
    ] with [hot: false]
    backdrop blau effect reduce ['grid 8x8 blau - 10]
    across
    vh1 374x30 (sky + 35) system/script/header/Name with [feel: none] return
    space 0
    box 374x3 edge [size: 1x1 color: blau - 10 effect: 'bevel] return
    pad 60 panel 70x45 [
        origin 0x0 space 0x0 across
        text 70 center middle underline 0.30.0 "Score:" with [feel: none] return
        score-txt: text 70x24 right middle bold edge [color: blau size: 2x2 effect: 'ibevel] orange 0.0.30 font [color: orange size: 16] with [feel: none] form score return
    ]
    pad 37 panel 44x54 [
        origin 0x0 space 0x0 across
        box 1x1 keycode [left] with [color: edge: none] [
            new-time: now/time/precise
            if zero? delta: to decimal! (new-time - old-time) [delta: 0.05]
            delta: to integer! 0.5 / delta
            old-time: new-time
            if greater? delta 8 [delta: 8]
            if lesser? delta 1 [delta: 1]
            slider/offset/x: slider/offset/x - delta
            if lesser? slider/offset/x slider-min [slider/offset/x: slider-min]
            slider/left: true
            slider/time: now/time + 1
            slider/idle: false
            if not init-pf [init-level level]
            if all [init-pf not started] [
                active/image: img-heart
                started: active/data: active/state: true
                show active
            ]
            show slider
        ]
        pad 4x9 active: toggle blau img-stop 34x36 edge [color: blau] [
            either not init-pf [
                init-level level
            ] [
                started: face/data
                either face/data [face/image: img-heart]
                [face/image: img-pause]
                show face
            ]
        ]
        box 1x1 keycode [right] with [color: edge: none] [
            new-time: now/time/precise
            if zero? delta: to decimal! (new-time - old-time) [delta: 0.05]
            delta: to integer! 0.5 / delta
            old-time: new-time
            if greater? delta 8 [delta: 8]
            if lesser? delta 1 [delta: 1]
            slider/offset/x: slider/offset/x + delta
            if greater? slider/offset/x slider-max [slider/offset/x: slider-max]
            slider/left: false
            slider/time: now/time + 1
            slider/idle: false
            if not init-pf [init-level level]
            if all [init-pf not started] [
                active/image: img-heart
                started: active/data: active/state: true
                show active
            ]
            show slider
        ] return
    ]
    pad 38 panel 70x45 [
        origin 0x0 space 0x0 across
        text 70 center middle underline 0.30.0 "Time:" with [feel: none] return
        time: text 70x24 right middle bold edge [color: blau size: 2x2 effect: 'ibevel] orange 0.0.30 font [color: orange size: 16] "0:00:00" with [
            feel: make feel [
                engage: func [face action event /local i] [
                    if started = false [exit]
                    if last-time <> now/time [
                        last-time: now/time
                        i: 1 + (to integer! to time! face/text)
                        face/text: to time! i
                        if greater? last-time slider/time [slider/idle: true]
                        show face
                    ]
                ]
            ]
            after: none
            rate: 1
        ] return
    ] return
    space 8 box 374x3 edge [size: 1x1 color: blau - 10 effect: 'bevel] return
    pad 12 panel 351x217 (sky - 10) edge [color: blau size: 2x2 effect: 'bevel] [
        origin 0x0 space 0x0 across
        level-txt: text 350 center bold "Level" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [
            r-txt/text: reform ["( blank level-code => restart level" oldlevel ")"]
            show r-txt
            restart/offset: main/offset + 205x165 view/new/options restart [no-title]] return
        pad 18 pfp: panel 310x164 black edge [color: blau - 10 size: 1x1] [
            d-ball: box img-ball red with [
                feel: make feel [
                    engage: func [face action event /local row column foo n nphi not-changed] [
                        if started [
                            nphi: face/phi
                            face/collision: none
                            if lesser-or-equal? face/offset/y y-min [
                                if not found? face/collision [
                                    either face/left [
                                        either face/up [
                                            n: get-box (face/offset + 0x9)
                                        ] [n: get-box (face/offset + 0x4) ]
                                        if all [lesser? n 181 greater? n 0] [
                                            foo: do to-path reduce [to word! join 'b n 'color]
                                            if found? foo [
                                                remove-brick n foo
                                                face/collision: "links"
                                            ]
                                        ]
                                    ] [
                                        either face/up [
                                            n: get-box (face/offset + 12x9)
                                        ] [n: get-box (face/offset + 12x4) ]
                                        if all [lesser? n 181 greater? n 0] [
                                            foo: do to-path reduce [to word! join 'b n 'color]
                                            if found? foo [
                                                remove-brick n foo
                                                face/collision: "rechts"
                                            ]
                                        ]
                                    ]
                                ]
                                if not found? face/collision [
                                    either face/up [
                                        either face/left [
                                            n: get-box (face/offset + 4x0)
                                        ] [n: get-box (face/offset + 8x0) ]
                                        if all [lesser? n 181 greater? n 0] [
                                            foo: do to-path reduce [to word! join 'b n 'color]
                                            if found? foo [
                                                remove-brick n foo
                                                face/collision: "oben"
                                            ]
                                        ]
                                    ] [
                                        either face/left [
                                            n: get-box (face/offset + 4x13)
                                        ] [n: get-box (face/offset + 8x13) ]
                                        if all [lesser? n 181 greater? n 0] [
                                            foo: do to-path reduce [to word! join 'b n 'color]
                                            if found? foo [
                                                remove-brick n foo
                                                face/collision: "unten"
                                            ]
                                        ]
                                    ]
                                ]
                            ]
                            if not found? face/collision [
                                if all [face/up lesser-or-equal? face/offset/y -1] [
                                    face/hits: face/hits + 1
                                    face/collision: "oben"
                                ]
                            ]
                            if not found? face/collision [
                                either face/left [
                                    if lesser-or-equal? face/offset/x x-min [
                                        face/hits: face/hits + 1
                                        face/collision: "links"
                                    ]
                                ] [
                                    if greater-or-equal? face/offset/x x-max [
                                        face/hits: face/hits + 1
                                        face/collision: "rechts"
                                    ]
                                ]
                            ]
                            if all [not found? face/collision not face/up greater-or-equal? face/offset/y (slider/offset/y - face/size/y)] [
                                either any [lesser? face/offset/x (slider/offset/x - face/size/x) greater? face/offset/x (slider/offset/x + slider/size/x)] [
                                    game-over: true
                                    y-max: slider/offset/y
                                ] [
                                    game-over: false
                                    y-max: slider/offset/y - face/size/y
                                    face/collision: "unten"
                                    face/hits: 0
                                    not-changed: true
                                    if all [not-changed lesser? face/offset/x (slider/offset/x - 7)] [
                                        either face/left [
                                            if lesser? face/phi 161 [face/phi: to integer! ((180 + face/phi) / 2)]
                                            face/rate: max-velocity
                                        ] [
                                            face/phi: 180 - face/phi
                                            face/left: true
                                            face/rate: max-velocity
                                        ]
                                        not-changed: false
                                    ]
                                    if all [not-changed not slider/idle lesser? face/offset/x (slider/offset/x - 7 + 15)] [
                                        either equal? face/left slider/left [
                                            if lesser? face/rate max-velocity [face/rate: face/rate + 5]
                                            either face/left [
                                                if lesser? face/phi 160 [face/phi: face/phi + 5]
                                            ] [
                                                if greater? face/phi 20 [face/phi: face/phi - 5]
                                            ]
                                        ] [
                                            if greater? face/rate min-velocity [face/rate: face/rate - 5]
                                            either face/left [
                                                if greater? face/phi 100 [face/phi: face/phi - 5]
                                            ] [
                                                if lesser? face/phi 80 [face/phi: face/phi + 5]
                                            ]
                                        ]
                                        not-changed: false
                                    ]
                                    if all [not-changed greater? face/offset/x (slider/offset/x + slider/size/x - 7)] [
                                        either face/left [
                                            face/phi: 180 - face/phi
                                            face/left: false
                                            face/rate: max-velocity
                                        ] [
                                            if greater? face/phi 19 [face/phi: to integer! (face/phi / 2)]
                                            face/rate: max-velocity
                                        ]
                                        not-changed: false
                                    ]
                                    if all [not-changed not slider/idle greater? face/offset/x (slider/offset/x - 7 + 25)] [
                                        either equal? face/left slider/left [
                                            if lesser? face/rate max-velocity [face/rate: face/rate + 5]
                                            either face/left [
                                                if lesser? face/phi 160 [face/phi: face/phi + 5]
                                            ] [
                                                if greater? face/phi 20 [face/phi: face/phi - 5]
                                            ]
                                        ] [
                                            if greater? face/rate min-velocity [face/rate: face/rate - 5]
                                            either face/left [
                                                if greater? face/phi 100 [face/phi: face/phi - 5]
                                            ] [
                                                if lesser? face/phi 80 [face/phi: face/phi + 5]
                                            ]
                                        ]
                                        not-changed: false
                                    ]
                                ]
                            ]
                            switch face/collision [
                                "links" [
                                    nphi: 180 - face/phi
                                    if greater? face/phi 180 [nphi: 360 + nphi]
                                    face/left: false
                                ]
                                "rechts" [
                                    nphi: 180 - face/phi
                                    if greater? face/phi 180 [nphi: 360 + nphi]
                                    face/left: true
                                ]
                                "oben" [
                                    nphi: 360 - face/phi
                                    face/up: false
                                ]
                                "unten" [
                                    nphi: 360 - face/phi
                                    face/up: true
                                ]
                            ]
                            face/phi: nphi
                            face/x: face/x + (face/r * cosine face/phi)
                            face/y: face/y + (face/r * sine face/phi)
                            face/offset/x: to integer! (face/x + 0.5)
                            face/offset/y: to integer! (face/y + 0.5)
                            show face
                            if lesser? box2d 1 [
                                init-pf: started: active/data: active/state: false
                                active/image: img-pause
                                show active
                                clear level-code/text
                                either lesser? level length? levels [
                                    level-code/text: make-code to integer! time/text level
                                    focus level-code
                                    tb: to integer! (30000 / to integer! time/text)
                                    score: tb + score
                                    score-txt/text: form score
                                    show score-txt
                                    message/color reduce [reform ["L E V E L " level " c o m p l e t e d :"] reform [tb "time-bonus-points !"] reform ["(level-code:" level-code/text ")"]] green
                                ] [
                                    score: 500 + score
                                    score-txt/text: form score
                                    show score-txt
                                    message/color ["C O N G R A T U L A T I O N :" reform ["You´ve finished the last" system/script/Header/Name "level !!!"] "Start all over again ..."] green
                                    if not saved-score [
                                        update-highscore score copy spielername/text level
                                        if unlimited [save-file]
                                        saved-score: true
                                    ]
                                    score: level: 0
                                ]
                                old-score: score
                                level: level + 1
                                init-level level
                            ]
                            if game-over [
                                if greater-or-equal? face/offset/y y-max [
                                    init-pf: started: active/data: active/state: false
                                    active/image: img-stop
                                    show active
                                    message/color ["G A M E - O V E R:" reform ["You missed the ball," box2d "bricks left !!!"] "Try it again ..."] orange
                                    if not saved-score [
                                        update-highscore score copy spielername/text level
                                        if unlimited [save-file]
                                        saved-score: true
                                    ]
                                    face/rate: min-velocity
                                    old-score: 0
                                ]
                            ]
                        ]
                    ]
                ]
                r: 3
                phi: 300
                x: to decimal! 0
                y: to decimal! 0
                left: false
                up: false
                collision: none
                hits: 0
                rate: min-velocity
                init-offset: 0x0
            ]
            heart: box img-smallheart with [
                hcolor: none
                feel: make feel [
                    engage: func [face action event /local hbp] [
                        if all [face/hit started] [
                            either greater? face/offset/y face/parent-face/size/y [
                                face/hit: false
                            ] [
                                if greater-or-equal? face/offset/y (slider/offset/y - face/size/y) [
                                    if all [greater? face/offset/x (slider/offset/x - face/size/x) lesser? face/offset/x (slider/offset/x + slider/size/x)] [
                                        switch/default face/hcolor [
                                            245.222.129 [hbp: 50]
                                            160.82.45 [hbp: 50]
                                            255.0.0 [hbp: -100]
                                            255.255.0 [hbp: 60]
                                            255.150.10 [hbp: 70]
                                            255.0.255 [hbp: 80]
                                            0.255.255 [hbp: 90]
                                            0.255.0 [hbp: 90]
                                            80.80.255 [hbp: 90]
                                        ] [hbp: 0]
                                        if not zero? hbp [
                                            score: score + hbp
                                            score-txt/text: form score
                                            show score-txt
                                        ]
                                        face/offset/y: face/parent-face/size/y
                                    ]
                                ]
                            ]
                            face/offset/y: face/offset/y + 2
                            show face
                        ]
                    ]
                ]
                hit: false
                rate: 1
            ]
            slider: box 40x8 coal edge [color: coal + 40 size: 2x2 effect: 'bevel] with [
                feel: make feel [
                    engage: func [face action event /local coord] [
                        if find [over away] action [
                            face/old-offset: face/offset
                            coord: to pair! reduce [event/offset/x 0]
                            face/offset: confine face/offset + coord - face/data face/size 0x0 face/parent-face/size - 2
                            either greater? face/offset/x face/old-offset/x [face/left: false] [face/left: true]
                            face/time: now/time + 1
                            face/idle: false
                            show face
                        ]
                        if action = 'down [
                            coord: to pair! reduce [event/offset/x 0]
                            face/data: coord
                            if not init-pf [init-level level ]
                            if all [init-pf not started] [
                                active/image: img-heart
                                started: active/data: active/state: true
                                show active
                            ]
                        ]
                    ]
                ]
                left: false
                idle: true
                time: last-time + 1
                init-offset: 0x0
                old-offset: 0x0
            ]
            origin 0x0 space 0x0 across
            pad 4x4
            b1: bx b2: bx b3: bx b4: bx b5: bx b6: bx b7: bx b8: bx b9: bx b10: bx
            b11: bx b12: bx b13: bx b14: bx b15: bx b16: bx b17: bx b18: bx b19: bx b20: bx return pad 4
            b21: bx b22: bx b23: bx b24: bx b25: bx b26: bx b27: bx b28: bx b29: bx b30: bx
            b31: bx b32: bx b33: bx b34: bx b35: bx b36: bx b37: bx b38: bx b39: bx b40: bx return pad 4
            b41: bx b42: bx b43: bx b44: bx b45: bx b46: bx b47: bx b48: bx b49: bx b50: bx
            b51: bx b52: bx b53: bx b54: bx b55: bx b56: bx b57: bx b58: bx b59: bx b60: bx return pad 4
            b61: bx b62: bx b63: bx b64: bx b65: bx b66: bx b67: bx b68: bx b69: bx b70: bx
            b71: bx b72: bx b73: bx b74: bx b75: bx b76: bx b77: bx b78: bx b79: bx b80: bx return pad 4
            b81: bx b82: bx b83: bx b84: bx b85: bx b86: bx b87: bx b88: bx b89: bx b90: bx
            b91: bx b92: bx b93: bx b94: bx b95: bx b96: bx b97: bx b98: bx b99: bx b100: bx return pad 4
            b101: bx b102: bx b103: bx b104: bx b105: bx b106: bx b107: bx b108: bx b109: bx b110: bx
            b111: bx b112: bx b113: bx b114: bx b115: bx b116: bx b117: bx b118: bx b119: bx b120: bx return pad 4
            b121: bx b122: bx b123: bx b124: bx b125: bx b126: bx b127: bx b128: bx b129: bx b130: bx
            b131: bx b132: bx b133: bx b134: bx b135: bx b136: bx b137: bx b138: bx b139: bx b140: bx return pad 4
            b141: bx b142: bx b143: bx b144: bx b145: bx b146: bx b147: bx b148: bx b149: bx b150: bx
            b151: bx b152: bx b153: bx b154: bx b155: bx b156: bx b157: bx b158: bx b159: bx b160: bx return pad 4
            b161: bx b162: bx b163: bx b164: bx b165: bx b166: bx b167: bx b168: bx b169: bx b170: bx
            b171: bx b172: bx b173: bx b174: bx b175: bx b176: bx b177: bx b178: bx b179: bx b180: bx return pad 4
        ] return
        pad 124x6 spielername: field 100x16 ivory middle center "Your name" edge [color: blau size: 1x1] return
    ] return
    pad 52 sky-btn 80 "Highscore" ":-)" [view/new/options center-face highscore [no-title]]
    pad 19 sky-btn 60 "Quit" "Bye !" keycode [#"^["] [if confirm reform ["Do you really want to quit" system/script/header/Name "?"] [
            if not saved-score [
                update-highscore score copy spielername/text level
                if unlimited [save-file]
                saved-score: true
            ]
            unview/all
        ]]
    pad 19 sky-btn 80 "About" "Show Me" [
        xsize: to integer! ((first about/size - (first hd2/offset + first hd2/size - first hd1/offset)) / 2)
        hd2/offset: to pair! join xsize + first hd2/offset - first hd1/offset ["x" second hd2/offset]
        hd1/offset: to pair! join xsize ["x" second hd1/offset]
        show [hd1 hd2]
        view/new/options center-face about [no-title]] return
]
init-level: func [
    "Initialize playfield with level"
    levelnumber [integer!] "level to display in playfield"
    /local i n r x y foo boxcolor row column flashing
] [
    rc: none
    either all [not unlimited greater? levelnumber 3] [
        message/color reduce [reform [system/script/Header/Name "D E M O - V E R S I O N !"] reform ["If You want to play the next" (length? levels) - levelnumber + 1 "levels:"] reform ["Contact" system/script/Header/Copyright " & request a license-key."]] orange
        init-pf: false
    ] [
        flashing: flash join "loading level " [levelnumber " ..."]
        current-level: copy pick levels levelnumber
        box2d: 0
        lowboxes: copy zerolist
        heart/hit: false
        while [any [not equal? slider/offset slider/init-offset not equal? d-ball/offset d-ball/init-offset lesser? heart/offset/y pfp/size/y]] [
            if lesser? heart/offset/y pfp/size/y [
                heart/offset/y: heart/offset/y + 3
                show heart
            ]
            either greater? abs (slider/offset/x - slider/init-offset/x) 20 [r: 3] [r: 1]
            if greater? slider/offset/x slider/init-offset/x [
                slider/offset/x: slider/offset/x - r
                show slider
            ]
            if lesser? slider/offset/x slider/init-offset/x [
                slider/offset/x: slider/offset/x + r
                show slider
            ]
            if not equal? d-ball/offset d-ball/init-offset [
                x: d-ball/init-offset/x - d-ball/offset/x
                y: d-ball/init-offset/y - d-ball/offset/y
                either greater? square-root ((y * y) + (x * x)) 20 [r: 3] [r: 1]
                either zero? x [
                    if positive? y [d-ball/phi: 90]
                    if negative? y [d-ball/phi: 270]
                ] [
                    either positive? x [
                        either positive? y [
                            d-ball/phi: arctangent abs (y / x)
                        ] [d-ball/phi: 360 - arctangent abs (y / x) ]
                    ] [
                        either positive? y [
                            d-ball/phi: 180 - arctangent abs (y / x)
                        ] [d-ball/phi: 180 + arctangent abs (y / x) ]
                    ]
                ]
                d-ball/x: d-ball/x + (r * cosine d-ball/phi)
                d-ball/y: d-ball/y + (r * sine d-ball/phi)
                d-ball/offset/x: to integer! (d-ball/x + 0.5)
                d-ball/offset/y: to integer! (d-ball/y + 0.5)
                show d-ball
            ]
        ]
        clear bricks
        i: 1
        foreach n boxfield [
            do reduce [to-set-path reduce [n 'hot] false]
            boxcolor: get-color i current-level
            either found? boxcolor [
                do reduce [to-set-path reduce [n 'color] boxcolor]
                either equal? boxcolor wallcol [
                    do reduce [to-set-path reduce [n 'effect] reduce ['fit 'grid 5x5 wallcol + 30]]
                    do reduce [to-set-path reduce [n 'image] none]
                    do reduce [to-set-path reduce [n 'edge] none]
                ] [
                    append bricks n
                    do reduce [to-set-path reduce [n 'effect] reduce ['fit 'colorize boxcolor]]
                    foo: make object! [
                        color: boxcolor
                        image: none
                        effect: 'bevel
                        size: 1x1
                    ]
                    do reduce [to-set-path reduce [n 'edge] foo]
                    do reduce [to-set-path reduce [n 'image] img-brick]
                    box2d: box2d + 1
                ]
                if zero? column: i // boxgrid/x [column: boxgrid/x]
                row: to integer! (i - 1) / boxgrid/x + 1
                poke lowboxes column row
            ] [
                do reduce [to-set-path reduce [n 'effect] [fit]]
                do reduce [to-set-path reduce [n 'image] none]
                do reduce [to-set-path reduce [n 'color] none]
                do reduce [to-set-path reduce [n 'edge] none]
            ]
            i: i + 1
        ]
        show boxfield
        y-min: (10 * first maximum-of lowboxes) + 3
        i: 0
        r: (length? bricks) / 8
        while [lesser? i r] [
            n: random/only bricks
            foo: do to-path reduce [n 'hot]
            if not foo [
                do reduce [to-set-path reduce [n 'hot] true]
                i: i + 1
            ]
        ]
        either random/only [true false] [
            d-ball/phi: 270 - 20 - (5 * random 5)
            d-ball/left: true
        ] [
            d-ball/phi: 270 + 20 + (5 * random 5)
            d-ball/left: false
        ]
        d-ball/up: true
        d-ball/x: to decimal! d-ball/offset/x
        d-ball/y: to decimal! d-ball/offset/y
        slider/old-offset: slider/offset
        oldlevel: levelnumber
        level-txt/text: join "Level " levelnumber
        show level-txt
        while [14 < length? spielername/text] [remove at spielername/text length? spielername/text]
        show spielername
        score: old-score
        score-txt/text: form score
        show score-txt
        time/text: "0:00:00"
        show time
        game-over: false
        unview/only flashing
        init-pf: true
    ]
    return rc
]
get-box: func [
    "returns the boxindex for the specified coordinates"
    mycoord [pair!] "current position"
    /local rc mycolumn myrow
] [
    if greater? mycolumn: (mycoord/x - 3) / b1/size/x to integer! mycolumn [mycolumn: 1 + mycolumn]
    mycolumn: to integer! mycolumn
    if mycolumn < 1 [mycolumn: 1]
    if mycolumn > boxgrid/x [mycolumn: boxgrid/x]
    myrow: to integer! (mycoord/y - 4) / b1/size/y
    rc: (myrow * boxgrid/x) + mycolumn
    return rc
]
get-color: func [
    "get the color of the boxfield"
    myindex [integer!] "current position"
    mylevel [series!] "current level"
    /local rc
] [
    switch pick mylevel myindex [
        #"#" [rc: wallcol]
        #"B" [rc: blue + 80]
        #"C" [rc: cyan]
        #"G" [rc: green]
        #"M" [rc: magenta]
        #"O" [rc: orange]
        #"R" [rc: red]
        #"S" [rc: sienna]
        #"W" [rc: wheat]
        #"Y" [rc: yellow]
        /default [rc: none]
    ]
    return rc
]
remove-brick: func [
    "remove the brick and update score"
    myindex [integer!] "current position"
    mycolor [tuple!] "current color"
    /local deviation dphi rc myrow mycolumn myfoo newcolor
] [
    rc: none
    d-ball/hits: d-ball/hits + 1
    either equal? mycolor wallcol [
        if greater? d-ball/hits 15 [
            deviation: [-2 -1 1 2]
            dphi: d-ball/phi // 90
            if greater? dphi 74 [deviation: [-2 -1]]
            if lesser? dphi 16 [deviation: [2 1]]
            d-ball/phi: d-ball/phi + random/only deviation
        ]
    ] [
        myfoo: do to-path reduce [to word! join 'b myindex 'hot]
        if all [myfoo not heart/hit] [
            do reduce [to-set-path reduce [to word! join 'b myindex 'hot] false]
            myfoo: do to-path reduce [to word! join 'b myindex 'color]
            heart/hcolor: myfoo
            myfoo: do to-path reduce [to word! join 'b myindex 'effect]
            append myfoo [key 0.0.0]
            heart/effect: myfoo
            myfoo: do to-path reduce [to word! join 'b myindex 'offset]
            heart/offset: myfoo
            heart/rate: d-ball/rate
            heart/hit: true
            show heart
        ]
        either any [equal? mycolor sienna equal? mycolor wheat] [
            newcolor: none
            if equal? mycolor sienna [newcolor: green]
            if equal? mycolor wheat [newcolor: yellow]
            do reduce [to-set-path reduce [to word! join 'b myindex 'color] newcolor]
            do reduce [to-set-path reduce [to word! join 'b myindex 'effect] reduce ['fit 'colorize newcolor]]
            myfoo: make object! [
                color: newcolor
                image: none
                effect: 'bevel
                size: 1x1
            ]
            do reduce [to-set-path reduce [to word! join 'b myindex 'edge] myfoo]
            show reduce [to word! join 'b myindex]
        ] [
            do reduce [to-set-path reduce [to word! join 'b myindex 'effect] [fit]]
            do reduce [to-set-path reduce [to word! join 'b myindex 'image] none]
            do reduce [to-set-path reduce [to word! join 'b myindex 'color] none]
            do reduce [to-set-path reduce [to word! join 'b myindex 'edge] none]
            show reduce [to word! join 'b myindex]
            box2d: box2d - 1
            if zero? mycolumn: myindex // boxgrid/x [mycolumn: boxgrid/x]
            if equal? myrow: myindex / boxgrid/x to integer! myrow [myrow: myrow - 1]
            myrow: 1 + to integer! myrow
            if equal? myrow pick lowboxes mycolumn [
                poke lowboxes mycolumn (myrow - 1)
                y-min: (10 * first maximum-of lowboxes) + 3
            ]
        ]
        d-ball/hits: 0
        if lesser? d-ball/rate max-velocity [d-ball/rate: d-ball/rate + 1]
        score: score + 5
        score-txt/text: form score
        show score-txt
        saved-score: false
    ]
    return rc
]
encode: func [
    "encode strings"
    str [string!] "string 2 encode"
    /local rc element
] [
    rc: ""
    for i 1 length? str 1 [
        element: pick str i
        rc: join rc to string! to char! ((to integer! element) + 17 + (1.8 * to integer! to string! element))
    ]
    return rc
]
decode: func [
    "decode strings"
    str [string!] "string 2 decode"
    /local rc element
] [
    rc: ""
    for i 1 length? str 1 [
        element: pick str i
        switch element [
            #"A" [rc: join rc "0"]
            #"C" [rc: join rc "1"]
            #"F" [rc: join rc "2"]
            #"I" [rc: join rc "3"]
            #"L" [rc: join rc "4"]
            #"O" [rc: join rc "5"]
            #"Q" [rc: join rc "6"]
            #"T" [rc: join rc "7"]
            #"W" [rc: join rc "8"]
            #"Z" [rc: join rc "9"]
        ]
    ]
    return rc
]
check-code: func [
    "returns true if code is correct"
    mycode [string!] "code 2 check"
    /local hashkey element i l p mylevel mytime rc
] [
    rc: false
    mylevel: ""
    mytime: ""
    hashkey: ""
    p: l: 0
    for i 1 length? mycode 1 [
        if all [lesser? element: pick mycode i to char! 58 greater? element to char! 47] [
            either zero? p [p: l: i]
            [l: i]
            hashkey: join hashkey element
        ]
    ]
    if equal? length? hashkey (l - p) + 1 [
        for i 1 p - 1 1 [
            mytime: join mytime pick mycode i
        ]
        for i l + 1 length? mycode 1 [mylevel: join mylevel pick mycode i ]
        mytime: decode mytime
        mylevel: decode mylevel
        if equal? to integer! hashkey checksum/hash join mytime encode mylevel 64 [
            level: 1 + to integer! mylevel
            d-ball/rate: min-velocity
            old-score: 0
            rc: true
        ]
    ]
    return rc
]
make-code: func [
    "returns the level-code"
    mytime [integer!] "current time"
    mylevel [integer!] "current level"
    /local str-level hashkey
] [
    str-level: form mylevel
    while [lesser? length? str-level 2] [insert str-level 0]
    hashkey: checksum/hash join mytime encode str-level 64
    return join encode form mytime [hashkey encode str-level]
]
random/seed to-integer now/time
heart/offset/y: pfp/size/y + 1
slider/offset/x: slider/init-offset/x: to integer! (pfp/size/x - 40) / 2 + 0.5
slider/offset/y: slider/init-offset/y: pfp/size/y - 12
slider/old-offset: slider/offset
d-ball/offset/x: d-ball/init-offset/x: to integer! (pfp/size/x - 13) / 2 + 0.5
d-ball/offset/y: d-ball/init-offset/y: pfp/size/y - 26
d-ball/x: to decimal! d-ball/offset/x
d-ball/y: to decimal! d-ball/offset/y
view center-face main

No comments:

Post a Comment