This is an Arkanoid clone, you must destruct all bricks:
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