TGD Consulting is a software house that use a lo Rebol, they made the following game in pure Rebol.
The game will show you some numbers for few seconds, then they disappear and are covered of empty boxes; you have to click the boxes from the lower number to the higher number. It's a memory game, very difficult:
Here the source:
REBOL [
Title: "Brain-It!"
Home: http://www.TGD-Consulting.DE/Download.html
Name: "Brain-It!"
File: %BrainIt.r
Needs: 'View
Date: 29-Jul-2006
Version: 1.0.0
Author: "Dirk Weyand"
Owner: "Dirk Weyand"
Rights: "TGD-Consulting"
Purpose: "A game to train your brain."
Comment: {
Brain-It! is a game using REBOL/View.
It is a braintwister-game inspired by
the theories of Dr. Ryuta Kawashima.
To play this game memories the numbers
appearing on the grid and click on their
position from lowest to highest value.
The numbers will vanish, so you
must remember where they are.
Play Brain-It! everyday to
enhance your mental-fitness.
This game is dedicated to
my wonderful beloved wife.
Have fun & enjoy this game !}
History: [
{0.0.1 ^-21-Jul-2006 ^-"initial release"^/}
{0.1.0 ^-22-Jul-2006 ^-"added timer"^/}
{0.2.0 ^-23-Jul-2006 ^-"added highscore"^/}
{0.2.1 ^-23-Jul-2006 ^-"changed background color"^/}
{0.2.2 ^-23-Jul-2006 ^-"fixed game-play"^/}
{0.3.0 ^-23-Jul-2006 ^-"added count-down"^/}
{0.4.0 ^-27-Jul-2006 ^-"added levels 12-16"^/}
{1.0.0 ^-29-Jul-2006 ^-"first public release"^/}
]
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 AGREEMENT, DO NOT INSTALL OR USE THE SOFTWARE.}
]
if not all [value? 'view? view?] [
until [
print "^L^/Brain-It! requires REBOL/View !!!^/"
wait 0.15
print "^L^/^/"
not none? wait [system/ports/input 0.15]
]
quit
]
view: func do head insert find mold third :view "/new" {/kf "Keeps feel of window face"
} do head replace mold second :view "view-face/feel: window-feel" {if not kf [view-face/feel: system/view/window-feel]}
bg-color: silver - 20
blau: 122.154.198
lic-read: ulf: false
main-offset: none
debug: false
Stufe: [4 5 6 7 8 9 10 12 14 16]
random/seed now
game-over: true
started: count: false
Index: 1
score: 0
time: 0
begin: now
Brainiacs: 0
MaxMist: 3
bg-effect: compose [gradient 0x1 (bg-color) (bg-color - 30.30.10)]
copydate: copy find/tail first 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]
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 ]
config-file: join filename ".config"
highscore-path: join filename "-highscores.r"
highscores: either exists? highscore-path [load highscore-path] [
[[score " 1" name "T G D " time "1:00:01" date "23-Jul-2006"]]
]
btn-styles: stylize [
btn: button no-wrap edge [color: gray size: 1x1] effects compose/deep [[gradient 0x1 (bg-color - 10 + 32) (bg-color - 10 - 32)] [gradient 0x-1 (bg-color - 10 + 32) (bg-color - 10 - 32)]] font [color: ivory - 20 colors/1: color]
small-btn: box 19x19 no-wrap edge [size: 1x1 effect: 'bevel color: gray] font [color: ivory -20 colors/1: color] feel [
redraw: func [face act pos] [
face/edge/effect: pick [ibevel bevel] face/state
]
over: func [face action event] [
if all [face/font face/font/colors] [
face/font/color: pick face/font/colors not action
show face
face/font/color: first face/font/colors
]
]
engage: func [face action event] [
switch action [
down [face/state: on]
alt-down [face/state: on]
up [if face/state [do-face face none] face/state: off]
alt-up [if face/state [do-face-alt face none] face/state: off]
over [face/state: on]
away [face/state: off]
]
show [face]
]
]
]
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: bg-color / 3
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: bg-color 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 effect bg-effect
across
pad x-p
button x-hdl copy hdl middle center font [size: 20 colors: compose [(c1) (c1 - 40)]] edge [color: gray size: 1x1 effect: 'bevel] [result: true hide-popup] [result: true hide-popup] return
text bold copy msg c2 middle with [feel: none]
]
if not empty? str [insert tail result [text copy str c3 middle with [feel: none]]]
layout result
]
lay/pane/2/effects: lay/pane/2/color: none
result: none
either offset [inform/offset/timeout lay xy time] [inform/timeout lay time]
result
]
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]
]
scroll-wheel: func [page n tf sf /init /end] [
either init [
either end [
scroll-smooth/init (n * (either page [tf/size/y] [tf/font/size])) tf sf
] [
scroll-smooth/init divide (n * (either page [tf/size/y] [tf/font/size])) max 1 second size-text tf tf sf
]
if all [not lic-read greater? sf/data 0.97] [lic-read: true]
] [
either end [
scroll-smooth (n * (either page [tf/size/y] [tf/font/size])) tf sf
] [
scroll-smooth divide (n * (either page [tf/size/y] [tf/font/size])) max 1 second size-text tf tf sf
]
]
]
scroll-area: func [page n af /local d size] [
if none? af/para [exit]
size: size-text af
d: (n * (either page [af/size/y] [af/font/size]))
either positive? d [
while [all [positive? add size/y - af/size/y + 8 af/para/scroll/y positive? d]] [
d: subtract d 2
af/para/scroll/y: max subtract af/para/scroll/y 2 negate size/y - af/size/y + 8
show af
]
] [
while [all [negative? af/para/scroll/y negative? d]] [
d: add d 2
af/para/scroll/y: min add af/para/scroll/y 2 0
show af
]
]
]
license-agreement: layout [
styles btn-styles
backdrop bg-color effect reduce ['gradient 0x1 (bg-color) (bg-color - 30.30.10) 'grid 8x8 (bg-color - 10)]
across
banner join system/script/header/Name " - E U L A" 416 with [feel: none]
return
space 0
f-txt: text 400x150 bg-color / 3 bg-color + 40 edge [color: gray size: 2x2 effect: 'ibevel] with [feel: none]
f-sld: slider f-txt/size/y * 0x1 + 16x0 bg-color / 1.5 bg-color - 15 edge [color: gray] [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
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
btn 80 "Cancel" "Canceld" keycode [#"^["] [unview/all quit] [unview/all quit]
key keycode [up page-up] [scroll-wheel/init true -1 f-txt f-sld]
key keycode [down page-down] [scroll-wheel/init true 1 f-txt f-sld]
key keycode [home] [scroll-wheel/init/end true -1 f-txt f-sld]
key keycode [end] [if lic-read [scroll-wheel/init/end true 1 f-txt f-sld]]
]
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: gray ] [f-sld/pane/edge/color: gray ]
license-agreement/feel: make license-agreement/feel [
detect: func [face event /local rc] [
rc: true
switch event/type [
scroll-line [scroll-wheel/init false event/offset/y f-txt f-sld]
scroll-page [scroll-wheel/init true event/offset/y f-txt f-sld]
key [if found? face: find-key-face face event/key [
if get in face 'action [do-face face event/key]
rc: false
]
]
close [quit]
]
if rc [event]
]
]
m: 0
either exists? join filename ".license" [
either all [not error? try [do load join filename ".license" ulf: false] value? 'expiry value? 'license-key value? 'licensee] [
either date? expiry [
either greater? now/date expiry [
m: 3
] [
either equal? license-key checksum/key read system/options/script join system/script/Header/Name [user-prefs/name expiry licensee] [ulf: true ] [m: 2 ]
]
] [
either equal? license-key checksum/key read system/options/script join system/script/Header/Name [user-prefs/name licensee] [ulf: true ] [m: 2 ]
]
] [m: 2 ]
] [m: 1 ]
if any [not ulf not exists? config-file] [
scroll-slider-text f-txt f-sld
view/kf center-face license-agreement
]
switch m [
1 [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/Rights "& purchase a license."]] yellow
]
2 [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/Rights "to get a new license-file."]] yellow
]
3 [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/Rights "to get a new license-file."]] yellow
]
]
if exists? config-file [
if not error? try [set [myoffset] read/direct/lines config-file] [
if found? myoffset [error? try [main-offset: to pair! myoffset]]
]
]
seconds: func [
"Compute difference between dates in seconds."
a [date!] "first date"
b [date!] "second date"
] [((b - a) * to decimal! 86400) + ((to decimal! b/time) - (to decimal! a/time)) + ((a/zone/hour - b/zone/hour) * to decimal! 3600) ]
shutdown: func ["Exits the programm." ] [
if ulf [
write config-file reduce [lay-main/offset newline]
]
unview/all
either debug [halt] [quit]
]
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 [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 [3 > 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 [time!] "The number of cards on the playfield"
/local index
] [
while [14 < length? myname] [remove at myname length? myname]
while [14 > length? myname] [append myname " "]
index: 1
foreach element highscores [
either myscore > to integer! trim select element 'score [
insert at highscores index to block! mold reduce ['score form myscore 'name myname 'time form mytime 'date form now/date]
break
] [
if all [(equal? myscore to integer! trim select element 'score) (mytime < to time! trim select element 'time)] [
insert at highscores index to block! mold reduce ['score form myscore 'name myname 'time form 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 45 h1 underline "Highscores" 28.52.86 with [feel: none]
pad 80 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 370x3 edge [size: 1x1 color: sky effect: 'bevel] return
scorelist: code 28.52.86 center bold no-wrap 370x100 " " 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 370x3 edge [size: 1x1 color: sky effect: 'bevel] return
]
init-highscore
history: layout [
styles btn-styles
backdrop effect reduce ['gradient 0x-1 (bg-color - 20) (bg-color - 10)]
origin 0x0
across
pad 20x10 banner "History" 306 ivory - 20 with [feel: none] return
pad 20 h-txt: text 294x80 bg-color / 3 bg-color + 40 no-wrap edge [color: (bg-color - 25) size: 2x2 effect: 'ibevel] with [feel: none]
pad -8x0 h-sld: slider h-txt/size/y * 0x1 + 16x0 bg-color / 1.5 bg-color - 15 edge [color: (bg-color - 25)] [scroll-slider-text h-txt h-sld] return
key keycode [up page-up] [scroll-wheel true -1 h-txt h-sld]
key keycode [down page-down] [scroll-wheel true 1 h-txt h-sld]
key keycode [home] [scroll-wheel/end true -1 h-txt h-sld]
key keycode [end] [scroll-wheel/end true 1 h-txt h-sld]
at 330x130 box 20x20
at 330x1 small-btn "X" keycode [#"^["] [unview/only history] [unview/only history]
]
h-txt/text: system/script/header/History
either any [system/version > 1.3.0 equal? system/product 'Link] [h-sld/pane/1/edge/color: (bg-color - 25)] [h-sld/pane/edge/color: (bg-color - 25)]
scroll-slider-text h-txt h-sld
history/feel: make history/feel [
detect: func [face event /local rc] [
rc: true
switch event/type [
scroll-line [scroll-wheel false event/offset/y h-txt h-sld]
scroll-page [scroll-wheel true event/offset/y h-txt h-sld]
key [if found? face: find-key-face face event/key [
if get in face 'action [do-face face event/key]
rc: false
]
]
]
if rc [event]
]
]
sendmail: layout [
styles btn-styles
backdrop effect reduce ['gradient 0x-1 (bg-color - 20) (bg-color - 10)]
vh2 ivory - 20 reform ["Send email to" system/script/header/Name "author:"] with [feel: none]
msg: area "Type your message here ..." 250x60 wrap bg-color + 40 edge [color: (bg-color - 25)] font [color: bg-color / 3]
across return
btn 80 "Send" "Send ..." [
unfocus
sending: flash "Sending ..."
either error? try [
hdr: make system/standard/email [subject: reform [system/script/header/Name system/script/header/Version]]
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
]
] [
unfocus
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 82 btn 80 "Cancel" "Canceled" keycode [#"^["] [unfocus unview/only sendmail] [unfocus unview/only sendmail]
]
sendmail/feel: make sendmail/feel [
detect: func [face event /local rc] [
rc: true
switch event/type [
scroll-line [scroll-area false event/offset/y msg]
scroll-page [scroll-area true event/offset/y msg]
key [if found? face: find-key-face face event/key [
if get in face 'action [do-face face event/key]
rc: false
]
]
]
if rc [event]
]
]
about: layout [
styles btn-styles
backdrop effect bg-effect
panel 335x275 bg-color - 25 edge [size: 2x2 color: gray effect: 'bevel] effect reduce ['gradient 0x1 (bg-color - 20) (bg-color - 10)] [
origin 15x15
space 0
banner "About ..." 300 ivory - 20 with [feel: none]
pad 0x5
panel 300x205 edge [size: 1x1 effect: 'ibevel color: bg-color - 25] [
style link text bold font [colors: reduce [0.0.0 (bg-color / 4)]]
backdrop (bg-color + 40) effect reduce ['gradient 0x1 (bg-color + 25) (bg-color + 40)]
origin 23
across
at 23x10
pa-hd1: h2 underline form system/script/header/Name (bg-color / 2.7) with [feel: none]
pa-hd2: h2 reform ["Version:" system/script/header/Version] (bg-color / 2.7) font [colors: reduce [(bg-color / 2.7) (bg-color / 4)]] [unfocus view/kf/new/options center-face history [no-title]] return
space 0
box 250x3 edge [size: 1x1 color: bg-color effect: 'bevel] return
credits: text (bg-color / 2.7) center bold no-wrap 250x80 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: bg-color effect: 'bevel] return
space 0
pad 15 text (bg-color / 2.7) bold "written by" with [feel: none]
link (bg-color / 2.5) system/script/header/Author [unfocus sendmail/offset: about/offset + 200x220 view/kf/new/options sendmail [no-title]] return
pad 15 text (bg-color / 2.7) bold reform ["Copyright" copydate ","] with [feel: none]
space 8 link (bg-color / 2.7) system/script/header/Rights [
unfocus
if request ["Connect to the homepage of TGD-Consulting ?" "Browse" "Cancel"] [
error? try [browse system/script/header/Home]
]
] return
pad 15 text (bg-color / 2.7) bold no-wrap reform ["Updated: " modified? system/options/script] with [feel: none] return
]
at 290x1
small-btn "?" keycode [#"?"] [view/kf/new/options center-face history [no-title]] [view/kf/new/options center-face history [no-title]]
at 311x1
small-btn "X" keycode [#"^["] [unview/only about] [unview/only about]
]
]
xsize: to integer! ((300 - (first pa-hd2/offset + first pa-hd2/size - first pa-hd1/offset)) / 2)
pa-hd2/offset: to pair! join xsize + first pa-hd2/offset - first pa-hd1/offset ["x" second pa-hd2/offset]
pa-hd1/offset: to pair! join xsize ["x" second pa-hd1/offset]
show [pa-hd1 pa-hd2]
credits/text: {
- - - - - -
}
insert credits/text form system/script/header/Comment
insert credits/text reform [">>> " system/script/Header/Name " <<<" newline]
insert credits/text {
\|/
@ @
----------oOO-(_)-OOo----------
-= T G D =-
is proud to
present
}
either ulf [
insert tail credits/text reform ["This software is registered to" newline licensee "."]
if date? expiry [
insert tail credits/text reform [newline "Your license will expire at" newline expiry "!"]
]
] [
either all [value? 'expiry date? expiry] [insert tail credits/text reform ["This software has been registered to" newline licensee "," newline "but your license expired !" newline ]
] [
insert tail credits/text {This software is not registered yet
and runs in D E M O - mode only !
}
]
insert tail credits/text reform ["^/To register and run the full version of"
newline system/script/Header/Name {, contact TGD-Consulting
at the following email address :
info@TGD-Consulting.de}]
]
insert tail credits/text "^/^/- - - - - -"
lay-main: layout [
styles btn-styles
style ld led edge [size: 1x1 color: gray + 30] feel [
redraw: func [f a p] [
either f/data [
f/color: f/colors/1
clear f/effect
f/edge/effect: 'bevel
] [
f/color: f/colors/2
insert f/effect 'cross
f/edge/effect: 'ibevel
]
]
detect: none
over: none
engage: func [f a e] [
if all [game-over found? select [up alt-up] a] [beginne-Spiel]
]
]
backdrop effect bg-effect
across
vh1 224 system/script/header/title ivory - 20 rate 0:01:30 feel [
engage: func [face action event] [
if all [not ulf not game-over equal? action 'time] [
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/Rights " & request a license-key."]] orange
]
]
] return
panel 224x224 edge [size: 2x2 color: gray effect: 'ibevel] feel [
engage: func [f a e] [
if all [game-over found? select [up alt-up] a] [beginne-Spiel]
]
] [
backcolor bg-color + 40
style bx box 40x40 center middle no-wrap edge [size: 1x1 color: gray - 80] font [size: 32 shadow: none color: gray - 80 colors/1: color] feel [
over: func [f a e] [
either a [if empty? f/text [f/edge/color: orange show f f/edge/color: gray - 80]] [show f]
]
engage: func [f a e] [
if all [started empty? f/text found? select [up alt-up] a] [
insert f/text f/data
f/edge/size: 0x0
either equal? f/data pick Spiel index [
index: index + 1
show f
score: score + 1
clear sc-txt/text
insert sc-txt/text score
show sc-txt
if greater? index length? Spiel [
stoppe-Zeit
wait 1
Stufe: next Stufe
beginne-Spiel
]
] [
stoppe-Zeit
f/edge/color: red
f/effect: [cross]
show f
Brainiacs: Brainiacs + 1
switch Brainiacs [
1 [b1/data: false show b1]
2 [b2/data: false show b2]
3 [b3/data: false show b3]
]
started: false
zeige-Spiel
wait 2.5
either greater-or-equal? Brainiacs MaxMist [
game-over: true
message/color ["G A M E - O V E R:" "Train your brain !!!" "Start all over again ..."] orange
update-highscore score copy spielername/text to time! time
if ulf [save-file]
] [
Stufe: back Stufe
beginne-Spiel
]
]
]
]
]
space 0x0
c1: bx "" edge [size: 0x0]
c2: bx "" edge [size: 0x0]
c3: bx "" edge [size: 0x0]
c4: bx "" edge [size: 0x0]
c5: bx "" edge [size: 0x0]
c6: bx "" edge [size: 0x0]
c7: bx "" edge [size: 0x0]
c8: bx "" edge [size: 0x0]
c9: bx "" edge [size: 0x0]
c10: bx "" edge [size: 0x0]
c11: bx "" edge [size: 0x0]
c12: bx "" edge [size: 0x0]
c13: bx "" edge [size: 0x0]
c14: bx "" edge [size: 0x0]
c15: bx "" edge [size: 0x0]
c16: bx "" edge [size: 0x0]
at 90x224 t1: text 40x40 "" gray - 80 center middle no-wrap font [size: 32] rate 3 edge [size: 1x1 color: gray + 30 effect: 'bevel] effect bg-effect feel [
engage: func [f a e /local foo] [
if all [count equal? a 'time] [
if empty? f/text [
insert f/text 3
show f
while [greater? f/offset/y 188] [f/offset/y: f/offset/y - 1 show f wait 0.01]
]
if greater-or-equal? subtract now/time/precise f/data 0:00:01 [
f/data: now/time/precise
foo: subtract to integer! f/text 1
clear f/text
insert f/text foo
show f
if zero? foo [
count: false
while [lesser? f/offset/y 224] [f/offset/y: f/offset/y + 1 show f wait 0.01]
clear f/text
set-Spiel
wait 1
blank-Spiel
begin: now
]
]
]
]
]
] return
spielername: field "Your Name" edge [size: 2x2 color: gray] bg-color / 5 center middle bold 80 font [color: orange size: 14]
pad -2x6 b1: ld true b2: ld true b3: ld true
pad -2x-6 panel 80x24 bg-color / 5 edge [size: 2x2 effect: 'ibevel color: gray] [
origin 0x0
space 0x0
across
pad 1x0 text 42x20 "Score:" center bold middle no-wrap orange bg-color / 5 font [size: 14] [view/new/options center-face highscore [no-title]] [view/new/options center-face highscore [no-title]]
pad -1x0 sc-txt: text 38x20 form score center bold middle no-wrap orange bg-color / 5 font [size: 16] with [feel: none]
] return
pad 0x-6 lnk-home: text 224 center ivory - 20 no-wrap join "(c) " [copydate " " system/script/header/Rights] with [feel: none] [
if request ["Connect to the homepage of TGD-Consulting ?" "Browse" "Cancel"] [
error? try [browse system/script/header/Home]
]
] [
if request ["Connect to the homepage of TGD-Consulting ?" "Browse" "Cancel"] [
error? try [browse system/script/header/Home]
]
] return
at 242x2
lnk-exit: small-btn "X" keycode [#"^["] [
if confirm reform ["Do you really want to quit" system/script/title "?"] [shutdown]
] [
if confirm reform ["Do you really want to quit" system/script/title "?"] [shutdown]
]
pad -48x0
small-btn "?" keycode [#"?"] [view/new/title center-face about join "about " system/script/header/Name] [view/new/title center-face about join "about " system/script/header/Name]
]
lay-main/feel: make lay-main/feel [
detect: func [face event /local rc] [
rc: true
switch event/type [
key [if found? face: find-key-face face event/key [
if get in face 'action [do-face face event/key]
rc: false
]
]
close [rc: false
either confirm reform ["Do you really want to quit" system/script/title "?"] [shutdown] [view/new/kf lay-main]]
]
if rc [event]
]
]
stoppe-Zeit: func [
] [time: time + seconds begin now ]
beginne-Spiel: func [
] [
if game-over [
Stufe: head Stufe
game-over: false
time: score: Brainiacs: 0
clear sc-txt/text
insert sc-txt/text score
show sc-txt
b1/data: b2/data: b3/data: true
show [b1 b2 b3]
]
started: false
init-Spiel
count: true
t1/data: now/time/precise
]
clear-nums: func [/local obj i ] [
i: 0
loop 16 [
i: i + 1
obj: do to word! join 'c i
clear obj/text
]
]
size-edges: func [
val [pair!]
/only obj [object!]
] [
either only [
obj/edge/size: val
] [c1/edge/size: c2/edge/size: c3/edge/size: c4/edge/size: c5/edge/size: c6/edge/size: c7/edge/size: c8/edge/size: c9/edge/size: c10/edge/size: c11/edge/size: c12/edge/size: c13/edge/size: c14/edge/size: c15/edge/size: c16/edge/size: val ]
]
color-edges: func [
col [tuple!]
/only obj [object!]
] [
either only [
obj/edge/color: col
] [c1/edge/color: c2/edge/color: c3/edge/color: c4/edge/color: c5/edge/color: c6/edge/color: c7/edge/color: c8/edge/color: c9/edge/color: c10/edge/color: c11/edge/color: c12/edge/color: c13/edge/color: c14/edge/color: c15/edge/color: c16/edge/color: col ]
]
zeige-Spiel: func [/local obj i lst ] [
size-edges 0x0
lst: copy []
clear lst
i: 0
loop 16 [
i: i + 1
insert lst to word! join 'c i
obj: do first lst
if empty? obj/text [insert obj/text obj/data]
]
show lst
]
init-Spiel: func [
] [
if tail? Stufe [Stufe: back Stufe]
switch/default first Stufe [
12 [Spiel: copy random [1 2 3 4 5 6 7 8 9 10 11 12]]
14 [Spiel: copy random [1 2 3 4 5 6 7 8 9 10 11 12 13 14]]
16 [Spiel: copy random [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]]
] [
Spiel: copy/part random [1 2 3 4 5 6 7 8 9 10] first Stufe
]
c1/effect: c2/effect: c3/effect: c4/effect: c5/effect: c6/effect: c7/effect: c8/effect: c9/effect: c10/effect: c11/effect: c12/effect: c13/effect: c14/effect: c15/effect: c16/effect: [fit]
clear-nums
size-edges 1x1
color-edges 48.48.48
switch length? Spiel [
4 [c1/offset: 65x65
c2/offset: 115x65
c3/offset: 65x115
c4/offset: 115x115
c5/offset: c6/offset: c7/offset: c8/offset: c9/offset: c10/offset: c11/offset: c12/offset: c13/offset: c14/offset: c15/offset: c16/offset: 300x300
]
5 [c1/offset: 35x35
c2/offset: 145x35
c3/offset: 90x90
c4/offset: 35x145
c5/offset: 145x145
c6/offset: c7/offset: c8/offset: c9/offset: c10/offset: c11/offset: c12/offset: c13/offset: c14/offset: c15/offset: c16/offset: 300x300
]
6 [c1/offset: 145x35
c2/offset: 90x90
c3/offset: 145x90
c4/offset: 35x145
c5/offset: 90x145
c6/offset: 145x145
c7/offset: c8/offset: c9/offset: c10/offset: c11/offset: c12/offset: c13/offset: c14/offset: c15/offset: c16/offset: 300x300
]
7 [c1/offset: 90x35
c2/offset: 145x35
c3/offset: 35x90
c4/offset: 90x90
c5/offset: 145x90
c6/offset: 35x145
c7/offset: 90x145
c8/offset: c9/offset: c10/offset: c11/offset: c12/offset: c13/offset: c14/offset: c15/offset: c16/offset: 300x300
]
8 [c1/offset: 15x65
c2/offset: 65x65
c3/offset: 115x65
c4/offset: 165x65
c5/offset: 15x115
c6/offset: 65x115
c7/offset: 115x115
c8/offset: 165x115
c9/offset: c10/offset: c11/offset: c12/offset: c13/offset: c14/offset: c15/offset: c16/offset: 300x300
]
9 [c1/offset: 35x35
c2/offset: 90x35
c3/offset: 145x35
c4/offset: 35x90
c5/offset: 90x90
c6/offset: 145x90
c7/offset: 35x145
c8/offset: 90x145
c9/offset: 145x145
c10/offset: c11/offset: c12/offset: c13/offset: c14/offset: c15/offset: c16/offset: 300x300
]
10 [c1/offset: 65x35
c2/offset: 115x35
c3/offset: 15x90
c4/offset: 65x90
c5/offset: 115x90
c6/offset: 165x90
c7/offset: 15x145
c8/offset: 65x145
c9/offset: 115x145
c10/offset: 165x145
c11/offset: c12/offset: c13/offset: c14/offset: c15/offset: c16/offset: 300x300
]
12 [c1/offset: 15x35
c2/offset: 65x35
c3/offset: 115x35
c4/offset: 165x35
c5/offset: 15x90
c6/offset: 65x90
c7/offset: 115x90
c8/offset: 165x90
c9/offset: 15x145
c10/offset: 65x145
c11/offset: 115x145
c12/offset: 165x145
c13/offset: c14/offset: c15/offset: c16/offset: 300x300
]
14 [c1/offset: 15x15
c2/offset: 65x15
c3/offset: 165x15
c4/offset: 15x65
c5/offset: 65x65
c6/offset: 115x65
c7/offset: 165x65
c8/offset: 15x115
c9/offset: 65x115
c10/offset: 115x115
c11/offset: 165x115
c12/offset: 15x165
c13/offset: 115x165
c14/offset: 165x165
c15/offset: c16/offset: 300x300
]
16 [c1/offset: 15x15
c2/offset: 65x15
c3/offset: 115x15
c4/offset: 165x15
c5/offset: 15x65
c6/offset: 65x65
c7/offset: 115x65
c8/offset: 165x65
c9/offset: 15x115
c10/offset: 65x115
c11/offset: 115x115
c12/offset: 165x115
c13/offset: 15x165
c14/offset: 65x165
c15/offset: 115x165
c16/offset: 165x165
]
]
show [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14 c15 c16]
]
set-Spiel: func [/local obj i lst ] [
size-edges 0x0
lst: copy []
clear lst
for i 1 length? Spiel 1 [
insert lst to word! join 'c i
obj: do first lst
insert obj/text obj/data: pick Spiel i
]
show lst
sort Spiel
index: 1
]
blank-Spiel: func [
] [
clear-nums
size-edges 1x1
show [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14 c15 c16]
started: true
]
lay-main/size/y: lnk-home/offset/y + lnk-home/size/y + 2
lay-main/size/x: lnk-exit/offset/x + lnk-exit/size/x + 2
either main-offset [lay-main/offset: main-offset] [center-face lay-main]
view/kf lay-main
shutdown
