The pieces fall straight down, occupying the next available space within the column. The object of the game is to connect four of one's own discs of the same color next to each other vertically, horizontally, or diagonally before your PC.
REBOL [
Title: "Join-It!"
Name: "Join-It!"
File: %JoinIt.r
Type: 'view-app
Version: 1.1.3
Date: 13-May-2005
Author: "Dirk Weyand"
Owner: "Dirk Weyand"
Copyright: "TGD-Consulting"
Home: http://www.TGD-Consulting.DE/Download.html
Purpose: "a 4wins style game"
Description: {
Join-It! is a game using REBOL/View.
The purpose of Join-It! is to join
your star-coins in a row, column
or diagonal.
Use the left mouse-button or
the keys (1-8) to drop your coins.
If you line up 4 or more star-coins
you win the game.
Have fun and enjoy playing Join-It!}
History: ["Dummy-Entry"
{0.1.0 ^-14-Jan-2003 ^-"initial release"}
{0.2.0 ^-17-Jan-2003 ^-"added keyboard control"}
{0.3.0 ^-18-Jan-2003 ^-"added game logic"}
{0.4.0 ^-19-Jan-2003 ^-"added computer logic"}
{0.4.1 ^-20-Jan-2003 ^-"changed highscore layout"}
{0.5.0 ^-20-Jan-2003 ^-"added multi-player"}
{0.5.1 ^-20-Jan-2003 ^-"changed coin layout"}
{0.5.2 ^-21-Jan-2003 ^-"removed some bugs"}
{1.0.0 ^-21-Jan-2003 ^-"first public release"}
{1.0.1 ^-07-Feb-2003 ^-"changed credit scrolltext"}
{1.1.0 ^-08-Feb-2003 ^-"added time-bonus points"}
{1.1.1 ^-21-Nov-2003 ^-"changed copyright-note"}
{1.1.2 ^-13-Dec-2003 ^-"orthographical fixes"}
{1.1.3 ^-13-May-2005 ^-"fixed marquees"}
]
]
img-coin: make image! [40x40 64#{
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQEBAwMDCgoKExMT
IyMjMjIyRERETk5OU1NTUVFRRkZGMzMzIiIiEBAQBwcHAQEBAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAQEBAwMDCgoKExMTIyMjNzc3UlJScHBwiYmJnJycqampr6+vra2toKCgi4uL
b29vTExMLi4uGBgYCgoKAwMDAQEBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAQECwsLHh4eNDQ0UlJScXFxjY2Nqqqq
w8PD1tbW4+Pj6urq7e3t6+vr5eXl2traw8PDpqamgYGBW1tbODg4Hh4eCwsLBAQE
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQUF
FhYWMzMzXFxchISEpqamxMTE19fX6Ojo8fHx+fn5/Pz8/f39/f39/f39/Pz8+fn5
8/Pz5ubm0NDQsLCwiIiIXFxcMzMzFhYWBQUFAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAABAQEGxsbQkJCeXl5qqqqzs7O5eXl8fHx+Pj4/Pz8
/f39/v7+/////////////////////v7+/v7+/Pz89vb26Ojo0tLSq6ureXl5QkJC
GxsbBAQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQEBGBgYSUlJ
h4eHwcHB4+Pj9PT0+vr6/f39/v7+/v7+////////////////////////////////
/////////v7+/Pz89vb25eXlwcHBh4eHSUlJGBgYAQEBAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAERERQkJCh4eHxcXF6urq+vr6/f39/v7+////////////
/////////////////////////////////////////////v7+/f39+vr66urqxcXF
h4eHQkJCERERAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgoKNTU1fX19wcHB
7Ozs+/v7/v7+////////////////////////////////////////////////////
/////////////////////v7++/v77OzswcHBfX19NTU1CgoKAAAAAAAAAAAAAAAA
AAAAAAAAAAAABQUFJCQkaWlpt7e36Ojo+/v7/v7+////////////////////////
/////////////////////////////////////////////////////////v7++/v7
6Ojot7e3aWlpJCQkBQUFAAAAAAAAAAAAAAAAAAAAAQEBFhYWVFRUoqKi4eHh+fn5
/v7+////////////////////////////////////////////////////////////
/////////////////////////////v7++fn54eHhoqKiVFRUFhYWAQEBAAAAAAAA
AAAAAAAACAgINzc3h4eH0tLS9fX1/f39////////////////////////////////
////////////////////////////////////////////////////////////////
/f399fX10tLSh4eHNzc3CAgIAAAAAAAAAAAAAQEBGxsbY2Njtra27Ozs/Pz8////
////////////////////////////////////////////d3d3/v7+////////////
/////////////////////////////////////Pz87Ozstra2Y2NjGxsbAQEBAAAA
AAAACAgIODg4kJCQ2tra+fn5/v7+////////////////////////////////////
////////xsbGYGBgxsbG////////////////////////////////////////////
/////v7++fn52trakJCQODg4CAgIAAAAAQEBFhYWXFxct7e37+/v/f39////////
////////////////////////////////////////c3NzYGBgc3Nz////////////
/////////////////////////////////////////f397+/vt7e3XFxcFhYWAQEB
BAQEKSkpf39/09PT+Pj4/v7+////////////////////////////////////////
////////YGBgYGBgYGBg////////////////////////////////////////////
/////////v7++Pj409PTf39/KSkpBAQECQkJPj4+nJyc5eXl/Pz8////////////
////////////////////////////////////zMzMYGBgYGBgYGBgzMzM////////
/////////////////////////////////////////////Pz85eXlnJycPj4+CQkJ
Dw8PUVFRs7Oz7+/v/v7+////////////////////////////////////////////
////eXl5YGBgYGBgYGBgeXl5////////////////////////////////////////
/////////////v7+7+/vs7OzUVFRDw8PFBQUYWFhwcHB9fX1/v7+////////////
////////////YGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBg
YGBgYGBgYGBgYGBg/////////////////////////////v7+9fX1wcHBYWFhFBQU
FxcXaWlpysrK9/f3/v7+////////////////////////ysrKYGBgYGBgYGBgYGBg
YGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgysrK////////////////
/////////////v7+9/f3ysrKaWlpFxcXGBgYbm5u0NDQ+Pj4/v7+////////////
/////////////////v7+ioqKYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBg
YGBgioqK8vLy/////////////////////////////////v7++Pj40NDQbm5uGBgY
GBgYc3Nz09PT+vr6/v7+////////////////////////////////////oaGhYGBg
YGBgYGBgYGBgYGBgYGBgYGBgYGBgYGBgoaGh////////////////////////////
/////////////v7++vr609PTc3NzGBgYGRkZdXV109PT+vr6////////////////
////////////////////////////oaGhYGBgYGBgYGBgYGBgYGBgYGBgYGBgoaGh
////////////////////////////////////////////////+vr609PTdXV1GRkZ
GhoadHR009PT+fn5////////////////////////////////////////////xsbG
YGBgYGBgYGBgYGBgYGBgYGBgYGBgxsbG////////////////////////////////
////////////////+fn509PTdHR0GhoaGRkZb29vzs7O+fn5////////////////
////////////////////////////jIyMYGBgYGBgYGBgYGBgYGBgYGBgYGBgjIyM
////////////////////////////////////////////////+fn5zs7Ob29vGRkZ
FRUVYmJixcXF9vb2/v7+////////////////////////////////////////YGBg
YGBgYGBgcXFx39/fcXFxYGBgYGBgYGBg39/f////////////////////////////
/////////////v7+9vb2xcXFYmJiFRUVDg4OUVFRsrKy8fHx/v7+////////////
////////////////////////cnJyYGBgYGBgh4eH/v7+////////h4eHYGBgYGBg
cnJy/////////////////////////////////////////v7+8fHxsrKyUVFRDg4O
BwcHOzs7l5eX4uLi/Pz8////////////////////////////////////YGBgYGBg
ycnJ////////////////////ycnJYGBgYGBg////////////////////////////
/////////////Pz84uLil5eXOzs7BwcHAgICICAgdXV1zc3N9/f3/v7+////////
////////////////////////cnJy8fHx/////////////////////////////v7+
cnJy6enp/////////////////////////////////v7+9/f3zc3NdXV1ICAgAgIC
AAAADg4OTU1NqKio6Ojo/Pz8////////////////////////////////////////
////////////////////////////////////////////////////////////////
/////////Pz86OjoqKioTU1NDg4OAAAAAAAAAgICJSUlfHx8zMzM9fX1/f39////
////////////////////////////////////////////////////////////////
/////////////////////////////////////f399fX1zMzMfHx8JSUlAgICAAAA
AAAAAAAADg4OSkpKnZ2d4ODg+vr6/v7+////////////////////////////////
////////////////////////////////////////////////////////////////
/v7++vr64ODgnZ2dSkpKDg4OAAAAAAAAAAAAAAAAAgICICAgZ2dntbW16Ojo+vr6
/v7+////////////////////////////////////////////////////////////
/////////////////////////////v7++vr66OjotbW1Z2dnICAgAgICAAAAAAAA
AAAAAAAAAAAACQkJMTExeXl5vr6+6urq+vr6/v7+/v7+////////////////////
/////////////////////////////////////////////////////v7+/v7++vr6
6urqvr6+eXl5MTExCQkJAAAAAAAAAAAAAAAAAAAAAAAAAAAADw8PPDw8fX19urq6
5eXl9/f3/f39/v7+////////////////////////////////////////////////
/////////////////v7+/f399/f35eXlurq6fX19PDw8Dw8PAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAEhISOzs7dnZ2sLCw29vb8fHx+vr6/v7+////////////
/////////////////////////////////////////////v7++vr68fHx29vbsLCw
dnZ2Ozs7EhISAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADw8PMTEx
ZGRknJycyMjI5ubm9PT0+/v7/f39/v7+/v7+/v7+/v7+/v7+/f39/f39/v7+/v7+
/f39/Pz8+/v79PT05ubmyMjInJycZGRkMTExDw8PAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAACgoKJCQkUFBQfn5+q6urzc3N4uLi7u7u8/Pz
9fX19vb29vb29fX18/Pz8/Pz9PT08/Pz8fHx6+vr4eHhzc3Nq6urfn5+UFBQJCQk
CgoKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
BQUFFxcXNTU1WlpagICAoaGht7e3xsbGzs7O0dHR0dHRzs7OzMzMy8vLysrKx8fH
wMDAs7Ozn5+fgICAWlpaNTU1FxcXBQUFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQEBCwsLGBgYMTExSUlJYGBgcnJy
fn5+goKChYWFgYGBf39/fHx8eXl5dXV1a2trXV1dSUlJMTExGBgYCwsLAQEBAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAgICBgYGDw8PGBgYJCQkLS0tMjIyNTU1NTU1MzMzMDAwKioqJycn
ISEhGBgYDw8PBgYGAgICAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
}]
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-star: 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+vnJycpqamtra2ycnJ0tLS19fX2dnZ3d3d////////d3d3
/v7+////3d3d2tra19fX1dXVzc3NuLi4pqamnZ2dr6+vwsLCz8/P5ubm5ubm5ubm
5ubm0NDQx8fHtbW1oKCgqKiorq6uwMDAy8vL09PT2dnZ3t7e5OTk////xsbGQkJC
xsbG////5OTk3t7e2dnZ09PTzc3NwcHBsLCwp6enoKCgtbW1x8fH0NDQ5ubm5ubm
5ubmy8vLvb29p6enoqKira2tvLy8ysrK1NTU3d3d4+Pj6Ojo6+vr////c3NzQkJC
c3Nz////6+vr6Ojo4+Pj3d3d1tbWy8vLu7u7rq6uoqKip6envb29y8vL5ubm5ubm
5ubmxMTEsrKyoKCgrKyst7e3yMjI1dXV3t7e5eXl6enp7e3t8PDw////QkJCQkJC
QkJC////8PDw7e3t6urq5eXl4ODg1tbWx8fHuLi4ra2tn5+fsrKyxMTE5ubm5ubm
5ubmvr6+qamppKSksLCwxMTE09PT3t7e6+vr////////////////zMzMQkJCQkJC
QkJCzMzM////////////////5+fn39/f09PTxsbGsrKyoqKiqampvr6+5ubm5ubm
5ubmubm5oqKisbGxvb290NDQ3d3d////////////////////////eXl5QkJCQkJC
QkJCeXl5////////////////////////3t7e0dHRv7+/sbGxoqKiubm55ubm5ubm
5ubmtLS0n5+ftbW1ycnJ2tra5OTkTk5OSUlJSUlJSUlJSUlJSUlJQkJCQkJCQkJC
QkJCQkJCSUlJSUlJSUlJSUlJSUlJTk5O5eXl29vbysrKt7e3n5+ftLS05ubm5ubm
5ubmsbGxpaWlvb291NTU4eHh6enpysrKRkZGQkJCQkJCQkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJCQkJCQkJCQkJCysrK6+vr4+Pj1dXVwMDApKSksbGx5ubm5ubm
5ubmr6+vqampxcXF29vb6Ojo7u7u/////v7+W1tbQkJCQkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJCQkJCW1tb8vLy////8vLy6urq3d3dyMjIqampr6+v5ubm5ubm
5ubmsLCwq6urzc3N4uLi7u7u8/Pz////////////ysrKQkJCQkJCQkJCQkJCQkJC
QkJCQkJCQkJCQkJCoaGh////////////9PT07u7u4uLiz8/Pra2tsLCw5ubm5ubm
5ubmr6+vqamp09PT6Ojo9fX1+vr6////////////////oaGhQkJCQkJCQkJCQkJC
QkJCQkJCQkJCoaGh////////////////9/f39PT06enp1dXVqampr6+v5ubm5ubm
5ubmsbGxpKSk1dXV7u7u+vr6/Pz8////////////////xsbGQkJCQkJCQkJCQkJC
QkJCQkJCQkJCxsbG////////////////+Pj4+fn57e3t2NjYpaWlsbGx5ubm5ubm
5ubmtLS0n5+fzs7O8fHx/f39/Pz8////////////////cnJyQkJCQkJCQkJCQkJC
QkJCQkJCQkJCcnJy////////////////+/v7/Pz88vLy09PTn5+ftLS05ubm5ubm
5ubmubm5oqKivb298PDw/////Pz8////////////////QkJCQkJCQkJCcXFx39/f
cXFxQkJCQkJCQkJC39/f/////////////f39/v7+8/PzwMDAoqKiubm55ubm5ubm
5ubmvr6+qamppqam4ODg/////Pz8////////////jIyMQkJCQkJCh4eH/v7+////
////h4eHQkJCQkJCjIyM/////////////v7+////5eXlqampqampvr6+5ubm5ubm
5ubmxMTEsrKyn5+fxcXF9/f3/v7+////////////OTk5QkJCycnJ////////////
////////ycnJREREOTk5////////////////+fn5ycnJoKCgsrKyxMTE5ubm5ubm
5ubmy8vLvb29p6enpqam39/f+/v7////////////f39/8fHx////////////////
/////////////v7+ioqK6enp/////////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
}]
falling: started: unlimited: hidereq: false
saved-score: true
delta-time: old-time: to time! 0
last-time: now/time
score: 0
max-spieler: 2
spieleranzahl: spieler: 1
spielstand: [[name "Your name" score 0]]
grid: make object! [
size: 8x6
init: false
finished: false
action: []
pf: []
]
cc: 0
coinspercol: []
cmax: grid/size/x * grid/size/y
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
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
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: rebolor 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 [
backdrop rebolor
across
pad x-p
button keycode [#"^M"] x-hdl copy hdl rebolor center middle font [size: 20 colors: compose [(c1) (c1 - 40)]] edge [color: rebolor size: 1x1 effect: 'bevel] [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 ]
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] [
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] [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 [
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
]
highscore-path: join filename "-highscores.r"
highscores: either exists? highscore-path [load highscore-path] [
[[score " 1" name "T G D " time "0:00:01" date "20-Jan-2003"]]
]
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 time] [
clear scorelist/text
i: 1
rank: " "
append scorelist/text {TOP-20
Score Name Time 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 " "]
time: select element 'time
while [7 > length? time] [append time " "]
date: select element 'date
while [11 > length? date] [insert date " "]
append scorelist/text reform [rank score " " select element 'name " " time " (" 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"
mytime [string!] "The playingt-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 'time mytime 'date form now/date]
break
]
index: index + 1
]
while [20 < length? highscores] [remove at highscores length? highscores]
init-highscore
]
highscore: layout [
style sky-btn button edge [color: blau] effects [[gradient 0x1 164.200.255 90.118.152] [gradient 0x-1 160.200.240 80.108.142]] font [colors: [255.255.255 28.52.86]]
backdrop effect [gradient 0x1 164.200.255 80.108.142]
across
pad 40 h1 underline "Highscores" 28.52.86 with [feel: none]
pad 110 sky-btn "Close" "Closed" 90 [unview/only highscore] [message/timeout "Press left mouse-button to close window !!!" 0:00:06 hide-popup]
return
space 0
box 390x3 edge [size: 1x1 color: sky effect: 'bevel] return
scorelist: code 28.52.86 center bold 390x100 " " 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 390x3 edge [size: 1x1 color: sky effect: 'bevel] return
]
init-highscore
history: layout [
style reb-btn button edge [color: gray] effects [[gradient 0x1 132.118.100 102.88.70] [gradient 0x-1 132.118.100 102.88.70]]
backdrop rebolor
across
pad 30
banner "History" 90 with [feel: none]
pad 70
reb-btn "Close" "Closed" 90 [unview/only history] [message/timeout "Press left mouse-button to close window !!!" 0:00:06 hide-popup]
return
text-list 290x80 black ivory no-wrap data system/script/header/History
]
remove system/script/header/History
option: layout [
style reb-btn button edge [color: gray] effects [[gradient 0x1 132.118.100 102.88.70] [gradient 0x-1 132.118.100 102.88.70]]
style txt-bevel text 100x20 center middle edge [color: rebolor size: 1x1 effect: 'ibevel] with [feel: none]
backdrop rebolor
across
banner "Options" 120 with [feel: none]
space 2
reb-btn "?" 28 [ohelp/offset: option/offset + 170x45 view/new/options ohelp [no-title]] [message/timeout "Press left mouse-button to view help !!!" 0:00:06 hide-popup]
reb-btn "Close" "Closed" 70 [unview/only option] [message/timeout "Press left mouse-button to close window !!!" 0:00:06 hide-popup]
return
space 18
box 230x3 edge [size: 1x1 color: rebolor effect: 'bevel] return
space 8
pad 20 txt-bevel "max. players"
space 0
arrow left keycode [left down] [
if greater? spieleranzahl 1 [spieleranzahl: spieleranzahl - 1]
txt-sa/text: form spieleranzahl
show txt-sa]
txt-sa: txt-bevel form spieleranzahl 20x20 black ivory
space 8
arrow right keycode [right up] [
if lesser? spieleranzahl max-spieler [spieleranzahl: spieleranzahl + 1]
if lesser? length? spielstand spieleranzahl [
poke spielstand 1 reduce ['name spielername/text 'score 0]
append spielstand to block! mold reduce ['name join "Player" spieleranzahl 'score 0]
]
txt-sa/text: form spieleranzahl
show txt-sa] return
pad 20 txt-bevel "hide-request"
space 18
check hidereq ivory 20x20 [hidereq: face/data] return
space 8
box 230x3 edge [size: 1x1 color: rebolor effect: 'bevel] return
]
ohelp: layout [
style reb-btn button edge [color: gray] effects [[gradient 0x1 132.118.100 102.88.70] [gradient 0x-1 132.118.100 102.88.70]]
style txt-bevel text 100x20 center middle edge [color: rebolor size: 1x1 effect: 'ibevel] with [feel: none]
style wtxt-bevel text 150 middle edge [color: rebolor size: 1x1 effect: 'ibevel] black ivory with [feel: none]
backdrop rebolor
across
banner "Options-Help" 158 with [feel: none]
pad 40
space 2
reb-btn "Close" "Closed" 70 [unview/only ohelp] [message/timeout "Press left mouse-button to close window !!!" 0:00:06 hide-popup]
return
space 18
box 280x3 edge [size: 1x1 color: rebolor effect: 'bevel] return
space 8
pad 10 txt-bevel "max. players"
wtxt-bevel {Specifies the number of players (Default: 1, you play against the computer).}
return
pad 10 txt-bevel "hide-request"
space 18 wtxt-bevel "If set, no note for a players-change is displayed."
return
space 8
box 280x3 edge [size: 1x1 color: rebolor effect: 'bevel] return
]
sendmail: layout [
style sky-btn button edge [color: blau] effects [[gradient 0x1 164.200.255 90.118.152] [gradient 0x-1 160.200.240 80.108.142]] font [colors: [255.255.255 28.52.86]]
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" [unview/only sendmail]
]
about: layout [
style sky-btn button edge [color: blau] effects [[gradient 0x1 164.200.255 90.118.152] [gradient 0x-1 160.200.240 80.108.142]] font [colors: [255.255.255 28.52.86]]
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
pad 5
sky-btn 75 "Close" "Closed" [unview/only about] [message/timeout "Press left mouse-button to close window !!!" 0:00:06 hide-popup]
sky-btn 75 "Options" "Change" [view/new/options center-face option [no-title]]
sky-btn 75 "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 user-prefs/name "."]
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 user-prefs/name "," 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 "^/^/- - - - - -"
main: layout [
style sky-btn button edge [color: blau] effects [[gradient 0x1 164.200.255 90.118.152] [gradient 0x-1 160.200.240 80.108.142]] font [colors: [255.255.255 28.52.86]]
style bx box 40x40 edge [color: 0.0.100] effect [oval] [drop-coin face/offset ]
style coin box 40x40 img-coin yellow with [
feel: make feel [
engage: func [face action event] [
if all [not face/idle falling] [
either lesser? face/offset/y face/endpos [
face/offset/y: face/offset/y + 5
show face
] [
face/idle: true
alter grid/action face/id
if empty? grid/action [
either grid/finished [
check-drop face/offset
either greater? spieleranzahl 1 [
if grid/init [wechseln]
] [
if all [grid/init equal? spieler 1] [drop-coin find-bestdrop]
]
old-time: to time! time/text
] [
unview/only init-flash
grid/finished: started: true
]
]
]
]
]
]
idle: true
rate: 100
endpos: 0
id: 0
]
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
pad 5x9 active: toggle blau img-stop 34x36 edge [color: blau] [
either grid/init [
falling: started: face/data
] [init-grid ]
either face/data [face/image: img-star]
[face/image: img-pause]
show face
]
]
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 not started [exit]
if last-time <> now/time [
last-time: now/time
i: 1 + (to integer! to time! face/text)
face/text: to time! i
show face
]
if all [not unlimited zero? face/text // to time! 60] [
message/color reduce [reform [system/script/Header/Name "D E M O - V E R S I O N !"] reform ["If you like to play without interruption:"] reform ["Contact" system/script/Header/Copyright " & request a license-key."]] orange
]
]
]
after: none
rate: 1
] return
] return
space 8 box 374x3 edge [size: 1x1 color: blau - 10 effect: 'bevel] return
pad 12 panel 352x300 (sky - 10) edge [color: blau size: 2x2 effect: 'bevel] [
origin 0x0 space 0x0 across
pad 13 text 40 center bold keycode [#"1"] "1" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [drop-coin 1 ]
text 40 center bold keycode [#"2"] "2" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [drop-coin 2 ]
text 40 center bold keycode [#"3"] "3" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [drop-coin 3 ]
text 40 center bold keycode [#"4"] "4" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [drop-coin 4 ]
text 40 center bold keycode [#"5"] "5" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [drop-coin 5 ]
text 40 center bold keycode [#"6"] "6" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [drop-coin 6 ]
text 40 center bold keycode [#"7"] "7" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [drop-coin 7 ]
text 40 center bold keycode [#"8"] "8" 28.52.86 font [colors: [28.52.86 235.255.235] size: 16] [drop-coin 8 ] return
pad 10 pfp: panel 326x246 black edge [color: blau - 10 size: 3x3] [
c1: coin c2: coin c3: coin c4: coin c5: coin c6: coin c7: coin c8: coin return
c9: coin c10: coin c11: coin c12: coin c13: coin c14: coin c15: coin c16: coin return
c17: coin c18: coin c19: coin c20: coin c21: coin c22: coin c23: coin c24: coin return
c25: coin c26: coin c27: coin c28: coin c29: coin c30: coin c31: coin c32: coin return
c33: coin c34: coin c35: coin c36: coin c37: coin c38: coin c39: coin c40: coin return
c41: coin c42: coin c43: coin c44: coin c45: coin c46: coin c47: coin c48: coin return
origin 0x0 space 0x0 across
b1: bx bx bx bx bx bx bx bx return
bx bx bx bx bx bx bx bx return
bx bx bx bx bx bx bx bx return
bx bx bx bx bx bx bx bx return
bx bx bx bx bx bx bx bx return
bx bx bx bx bx bx bx bx return
] 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 !" [if confirm reform ["Do you really want to quit" system/script/header/Name "?"] [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-grid: func [
"Initialize the playfield"
/local i
] [
init-flash: flash join "starting " [system/script/Header/Name " ..."]
falling: true
grid/finished: false
for i 1 cc 1 [
alter grid/action i
cc: cc - 1
do reduce [to-set-path reduce [to word! join 'c i 'endpos] pfp/size/y]
do reduce [to-set-path reduce [to word! join 'c i 'idle] false]
]
clear coinspercol
for i 1 grid/size/x 1 [append coinspercol 0]
clear grid/pf
for i 1 cmax 1 [append grid/pf 0]
while [14 < length? spielername/text] [remove at spielername/text length? spielername/text]
if greater? spieleranzahl 1 [
if equal? spieler 1 [poke spielstand 1 reduce ['name spielername/text 'score 0]]
spielername/text: select pick spielstand 1 'name
poke spielstand 2 reduce [
'name select pick spielstand 2 'name
'score 0]
]
show spielername
score: 0
score-txt/text: form score
show score-txt
time/text: "0:00:00"
show time
old-time: to time! time/text
if empty? grid/action [
unview/only init-flash
if not started [
active/image: img-star
grid/finished: falling: started: active/data: active/state: true
show active
]
]
grid/init: true
]
drop-coin: func [
"drops a coin in the specified column"
myoffset [integer! pair!] "current column"
/local rc foo mycolumn mysize
] [
rc: none
mysize: b1/size
if not grid/init [init-grid]
either grid/finished [
if not started [
active/image: img-star
falling: started: active/data: active/state: true
show active
]
] [
active/image: img-star
falling: active/data: active/state: true
show active
]
if empty? grid/action [
either pair? myoffset [
mycolumn: (1 + to integer! (myoffset/x / mysize/x))
myoffset/y: -40
] [
mycolumn: myoffset
myoffset: to pair! reduce [((mycolumn - 1) * mysize/x) -40]
]
if lesser? foo: pick coinspercol mycolumn grid/size/y [
delta-time: to time! time/text
poke coinspercol mycolumn (foo + 1)
cc: cc + 1
alter grid/action cc
do reduce [to-set-path reduce [to word! join 'c cc 'endpos] ((grid/size/y - (foo + 1)) * mysize/y)]
do reduce [to-set-path reduce [to word! join 'c cc 'offset] myoffset]
either zero? cc // 2 [
spieler: 2
do reduce [to-set-path reduce [to word! join 'c cc 'effect] reduce ['fit 'colorize red]]
do reduce [to-set-path reduce [to word! join 'c cc 'color] red]
] [
spieler: 1
do reduce [to-set-path reduce [to word! join 'c cc 'effect] reduce ['fit 'colorize yellow]]
do reduce [to-set-path reduce [to word! join 'c cc 'color] yellow]
]
do reduce [to-set-path reduce [to word! join 'c cc 'idle] false]
]
]
return rc
]
add-score: func [
"add points to the score"
jc [integer!] "number of joined coins"
] [
if lesser-or-equal? spieler spieleranzahl [
switch jc [
2 [score: score + 5]
3 [score: score + 10]
4 [score: score + 50]
]
score-txt/text: form score
show score-txt
saved-score: false
]
return jc
]
check-neighbour: func [
"check the drop"
index [integer!] "current coin-index"
player [integer!] "current player"
/down "check down"
/left "check left"
/leftup "check left-up"
/leftdown "check left-down"
/right "check right"
/rightup "check right-up"
/rightdown "check right-down"
/local rc
] [
rc: 0
if equal? pick grid/pf index player [
if down [
if lesser-or-equal? index (cmax - grid/size/x) [rc: check-neighbour/down (index + grid/size/x) player]
]
if left [
if not equal? (index // grid/size/x) 1 [rc: check-neighbour/left (index - 1) player]
]
if right [
if not zero? (index // grid/size/x) [rc: check-neighbour/right (index + 1) player]
]
if leftup [
if all [not equal? (index // grid/size/x) 1 greater? index grid/size/x] [rc: check-neighbour/leftup (index - 1 - grid/size/x) player ]
]
if leftdown [
if all [not equal? (index // grid/size/x) 1 lesser-or-equal? index (cmax - grid/size/x)] [rc: check-neighbour/leftdown (index - 1 + grid/size/x) player ]
]
if rightup [
if all [not zero? (index // grid/size/x) greater? index grid/size/x] [rc: check-neighbour/rightup (index + 1 - grid/size/x) player ]
]
if rightdown [
if all [not zero? (index // grid/size/x) lesser-or-equal? index (cmax - grid/size/x)] [rc: check-neighbour/rightdown (index + 1 + grid/size/x) player ]
]
rc: rc + 1
]
return rc
]
check-drop: func [
"checks the drop"
myoffset [pair!] "current coin-offset"
/local rc mycoins myindex mysize won
] [
rc: none
mysize: b1/size
myindex: 1 + to integer! (myoffset/x / mysize/x) + to integer! (grid/size/x * myoffset/y / mysize/y)
poke grid/pf myindex spieler
won: false
mycoins: add-score check-neighbour/down myindex spieler
if greater-or-equal? mycoins 4 [won: true]
mycoins: add-score check-neighbour/left myindex spieler
mycoins: mycoins - 1 + add-score check-neighbour/right myindex spieler
if greater-or-equal? mycoins 4 [won: true]
mycoins: add-score check-neighbour/leftdown myindex spieler
mycoins: mycoins - 1 + add-score check-neighbour/rightup myindex spieler
if greater-or-equal? mycoins 4 [won: true]
mycoins: add-score check-neighbour/leftup myindex spieler
mycoins: mycoins - 1 + add-score check-neighbour/rightdown myindex spieler
if any [equal? spieleranzahl 2 equal? spieler 1] [
score: score + (to integer! ((5 / (1 + ((to integer! (delta-time - old-time)) / 0.6))) + 0.5))
score-txt/text: form score
show score-txt
saved-score: false
]
if greater-or-equal? mycoins 4 [won: true]
either won [
grid/init: falling: started: active/data: active/state: false
active/image: img-stop
show active
either all [equal? spieleranzahl 1 equal? spieler 2] [
message/color ["G A M E - O V E R:" reform [spielername/text "lost the game !!!"] "Try it again ..."] orange
] [
poke spielstand spieler reduce ['name spielername/text 'score score]
message/color ["C O N G R A T U L A T I O N :" reform [spielername/text "won the game !!!"] "Start all over again ..."] green
if not saved-score [
update-highscore score copy spielername/text form time/text
if unlimited [save-file]
saved-score: true
]
]
] [
if equal? cc cmax [
grid/init: falling: started: active/data: active/state: false
active/image: img-stop
show active
message/color ["G A M E - O V E R:" "Tie game !!!" "Try it again ..."] orange
]
]
return rc
]
check-above: func [
"checks the above drop 4 win"
column [integer!] "current coin-offset (column)"
player [integer!] "current player (number)"
/local rc index tmp
] [
rc: true
tmp: []
clear tmp
index: (cmax - grid/size/x) + column - (grid/size/x * (1 + pick coinspercol column))
if greater? index zero [
poke grid/pf index player
append tmp check-neighbour/down index player
append tmp (-1 + (check-neighbour/left index player) + (check-neighbour/right index player))
append tmp (-1 + (check-neighbour/leftdown index player) + (check-neighbour/rightup index player))
append tmp (-1 + (check-neighbour/leftup index player) + (check-neighbour/rightdown index player))
poke grid/pf index 0
either lesser? first maximum-of tmp 4
[rc: true]
[rc: false]
]
return rc
]
find-bestdrop: func [
"finds the best drop and return it"
/local rc i n foo mybest mydrops myrest myresult myindex mymax opbest opdrops opresult opmax
] [
rc: none
mydrops: []
clear mydrops
opdrops: []
clear opdrops
foo: []
for i 1 grid/size/x 1 [
myindex: (cmax - grid/size/x) + i - (grid/size/x * pick coinspercol i)
if greater? myindex zero [
poke grid/pf myindex 2
clear foo
append foo check-neighbour/down myindex 2
append foo (-1 + (check-neighbour/left myindex 2) + (check-neighbour/right myindex 2))
append foo (-1 + (check-neighbour/leftdown myindex 2) + (check-neighbour/rightup myindex 2))
append foo (-1 + (check-neighbour/leftup myindex 2) + (check-neighbour/rightdown myindex 2))
append/only mydrops reduce [first maximum-of foo i myindex]
poke grid/pf myindex 1
clear foo
append foo check-neighbour/down myindex 1
append foo (-1 + (check-neighbour/left myindex 1) + (check-neighbour/right myindex 1))
append foo (-1 + (check-neighbour/leftdown myindex 1) + (check-neighbour/rightup myindex 1))
append foo (-1 + (check-neighbour/leftup myindex 1) + (check-neighbour/rightdown myindex 1))
append/only opdrops reduce [first maximum-of foo i myindex]
poke grid/pf myindex 0
]
]
mymax: first first maximum-of sort/reverse mydrops
mybest: []
clear mybest
myrest: []
clear myrest
clear foo
for i 1 length? mydrops 1 [
either equal? mymax first foo: pick mydrops i [append/only mybest copy foo]
[append/only myrest copy foo]
]
either lesser? mymax 4 [
myresult: []
clear myresult
foreach n mybest [
if check-above second n 1 [append myresult second n]
]
if all [empty? myresult not empty? myrest] [
mymax: first first myrest
foreach n myrest [
if check-above second n 1 [append myresult second n]
]
]
rc: random/only myresult
opmax: first first maximum-of sort/reverse opdrops
opbest: []
clear opbest
clear foo
for i 1 length? opdrops 1 [
if equal? opmax first foo: pick opdrops i [append/only opbest copy foo]
]
either lesser? opmax 4 [
if greater-or-equal? opmax mymax [
opresult: []
clear opresult
foreach n opbest [
if check-above second n 1 [append opresult second n]
]
rc: random/only intersect opresult myresult
if not found? rc [rc: random/only opresult]
]
] [rc: second random/only opbest ]
] [rc: second random/only mybest ]
if not found? rc [
either empty? myresult [
rc: second random/only mybest
] [rc: random/only myresult ]
]
return rc
]
wechseln: func [
"Spielerwechsel durchfuehen"
/local element
]
[
poke spielstand spieler reduce [
'name copy spielername/text
'score score
]
spieler: spieler + 1
if spieler > spieleranzahl [spieler: 1]
element: pick spielstand spieler
spielername/text: select element 'name
score: select element 'score
score-txt/text: form score
show [spielername score-txt]
focus spielername
if not hidereq [
message/color/timeout ["P L A Y E R S - C H A N G E :" reform [spielername/text "," "it´s your turn !!!"] "Drop your coin ..."] yellow 0:00:05
hide-popup
]
]
random/seed to-integer now/time
for i 1 cmax 1 [
do reduce [to-set-path reduce [to word! join 'c i 'offset] pfp/size + 1]
do reduce [to-set-path reduce [to word! join 'c i 'endpos] pfp/size/y]
do reduce [to-set-path reduce [to word! join 'c i 'id] i]
]
view center-face main
No comments:
Post a Comment