It'a Suduku engine and it contains 120 different sudoku tables.
Don't you know what is a Sudoku?
Read this: http://en.wikipedia.org/wiki/Sudoku
REBOL [
Title: "Rebudoku-It!"
Date: 12-Aug-2006
Name: "Rebudoku-It!"
Version: 1.5.2
File: %RebudokuIt.r
Home: http://www.TGD-Consulting.DE/Download.html
Author: "Dirk Weyand"
Owner: "Dirk Weyand"
Rights: "TGD-Consulting"
Needs: 'View
Purpose: "A Sudoku puzzle game."
Comment: {
TGD-Consulting's Rebudoku-It!
is based on REBOL/View.
The aim of Rebudoku-It! is to enter
a numeral from 1 through 9 in each
cell of a grid, starting with various
numerals given in some cells.
Each row, column and subgrid must
contain only one instance of each
numeral. Either use the mouse or
the cursor- and num-keys to set
the cells of the grid correct.
To unset a wrong guess use the
"0" or the right mouse-button.
Rebudoku-It! offers more than 100
pre calculated Sudoku puzzles and
you can easily generate new ones.
Either use the built-in editor (E) to
create your own Sudoku puzzles or to
let the computer calculate new ones.
Completing a puzzle requires
patience and logical ability.
To get hints on the next numeral or
for automatically solving Sudokus by
the computer use the solver (S).
This game is dedicated to
my wonderful beloved wife.
}
History: [
{0.0.1 ^-30-Sep-2005 ^-"initial release"^/}
{0.1.0 ^-03-Oct-2005 ^-"added key-strokes"^/}
{0.2.0 ^-06-Oct-2005 ^-"added Sudoku generator"^/}
{0.3.0 ^-07-Oct-2005 ^-"added About box"^/}
{0.3.1 ^-08-Oct-2005 ^-"enhanced Sudoku generator"^/}
{0.3.2 ^-08-Oct-2005 ^-"cleaned up code"^/}
{0.4.0 ^-09-Oct-2005 ^-"added highscore"^/}
{0.5.0 ^-11-Oct-2005 ^-"added 100 Sudokus"^/}
{1.0.0 ^-14-Oct-2005 ^-"first public release"^/}
{1.0.1 ^-23-Dec-2005 ^-"enhanced key-strokes"^/}
{1.1.0 ^-21-Jan-2006 ^-"added REBOL/View check"^/}
{1.1.1 ^-16-Feb-2006 ^-"fixed hot-keys"^/}
{1.2.0 ^-19-Feb-2006 ^-"added mouse-wheel support"^/}
{1.3.0 ^-05-Jun-2006 ^-"added Sudoku editor"^/}
{1.3.1 ^-06-Jun-2006 ^-"fixid grid edge reference"^/}
{1.4.0 ^-07-Jun-2006 ^-"added 30 special Sudokus"^/}
{1.5.0 ^-09-Jun-2006 ^-"added Sudoku solver"^/}
{1.5.1 ^-10-Jun-2006 ^-"changed reblet name"^/}
{1.5.2 ^-12-Aug-2006 ^-"fixed to run on MacOS X"^/}
]
Language: 'en
Type: 'view-app
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^/Rebudoku-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: water
blau: 122.154.198
coin: none
Sudoku: copy []
grid: copy [0 0 0 0 0 0 0 0 0]
current: 0
last-time: now/time
abort: solving: solver: edit-mode: lic-read: ulf: started: false
debug: false
MacOSX: all [equal? fourth system/version 2 equal? fifth system/version 4]
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]
random/seed now/precise
loop 9 [insert/only Sudoku copy grid ]
NULL: copy/deep Sudoku
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] [
[[name "T G D " time "1:00:01" date " 8-Oct-2005"]]
]
btn-styles: stylize [
btn: button no-wrap edge [color: bg-color 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: bg-color + 80 colors/1: color]
small-btn: box 19x19 no-wrap edge [size: 1x1 effect: 'bevel color: bg-color] font [color: bg-color + 80 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: 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: 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 compose [gradient 0x-1 (bg-color - 20) (bg-color - 5)]
across
pad x-p
button x-hdl copy hdl bg-color center middle font [size: 20 colors: compose [(c1) (c1 - 40)]] edge [color: bg-color size: 1x1 effect: 'bevel] effects compose/deep [[gradient 0x1 (bg-color - 10 + 32) (bg-color - 10 - 32)] [gradient 0x-1 (bg-color - 10 + 32) (bg-color - 10 - 32)]] [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
]
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 ['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: (bg-color - 25) 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: (bg-color - 25)] [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: (bg-color - 25) ] [f-sld/pane/edge/color: (bg-color - 25) ]
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? highscore-path] [
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
]
]
Sudokus: either any [not ulf error? err: try [load decompress read/direct/binary config-file]] [load decompress 64#{
eJx1nAtyJDcORK/CI4j/4lkcdf9rrJrIB6Blb0w4PGpVF0EQSCQ+nH/++aeXH/05
v//NMt7yD580/f/RZ7WM+/P6PKvPmr55//x+NvTzc5//fTa9r/LO+9lzf/4p3T/b
6Tned+6a06V83t8P/5lXih+twxubPxXf/rx/fn220jOPPmu/f5vFnt6/b66S+qRn
s2Z+f7qr1a/PfkxS/6xLWz9lX6mf328tf26nb9ffz2Mn5/fd6OD5/U33537/rjMw
qeN9+/c38b7P9/fX+6Y/t/w8P2/33/x+Vn/f8fj+ZmlX6uafhA75idNfbiHs+sf1
8Nlb0/NP0tdMz9l3zu+zj8n957mTzm67hTxfzyGn6RqJZzrljrRpZf+W/p9Pnh0v
rTzTSh9rQFeV7/tO/v2+rC3Oc+V1rtSjfO/l3CeXtBonj3W5VPeznb75uL7QwLm6
Mc8LzfYvT866jn0YMuTduXVK6imd7iR1/dcpf+xwu9fHKuN+zhs/OND8jMbHf5Ou
pzzvJ1ncR/bz8eCk64M8v5/NJNu43v2RuiZkiT3zVLbhpadsrX1RrmmFeS02e17G
pHktemjH7VpSS9L0zzuT1I5prhl0deSNgazSz31yZpllX9lif+XyzwIl45z2n/c9
JfmxrOYL6eXJ38811+Djn033xqZ1wl7R6WM7/zrl8J6/PmErdz210jnZM3h5thBw
I9Yd8eR/rLFk1zviWIp5dn7d4llCudizSbiTHkZaZfoqH8x17V0b/vn6bLrU5oft
C7vMO4irS97IuaPvoW87mkmHWOou4Y2xcvZQ8EfI+2Wb2ZLiNIc0k+1j6jyRzc9F
FnLSs09CKrwUpAoMGinaZg9tbtec+0j84rgW0OHjWq1pxyBzkydj+82+LaktYn78
PGzulC/93JVNGuyhJbbj0stCprwqx9XMWXo6p614lrnJ4o367MOzhCAuNWuP309n
2rPbgj7jPM0etkd+LKJ+RRmsJnBA+pNd76znr+gNfnU/k5r17RgCulR5Y4qKf/Yc
sX6kKI/HZKb6oz1Wt6RAOYv8VavsdMaxarDcLv/U6Vyp0bRb9vWKmVDzx6VWnE1I
Ve+nD+cq79l3pWFaTBZnGDS+3jeQJ1mIafW5Xhv8UTp0XVeX8aQIEPqar/FrPulp
ZYvTsTu4ClJlVnRcXxbJzn+gZnzSkz/ZOo/rGtvs2lG7+3u+WHzOFKpZ/58IHLzZ
vMF4UejapPhmCFdHwXj+6PoTKcaVpSfd7C+7/rk8AW88hVxhfq3i2VJi8RnbH/fk
b32hAWeIr7F9+2z9WeO5T3XnNc/NJ4LJGXvK9jDcGobHlH+ffPZaxaEvLvf1x6MM
DBRe0xN6ReQBUz6/W9dqQgv3BFOUSbEi7XmD21fCWfIbdvIos/WqnaTcUvzu82b4
LNa10zPnwycdk46zy+9IpsiXLCSY/U76EkNIefZwztKFDY8s4dvWHRkSU5paKeKl
eVTz52C9OcuL+Mm5I7X7tvS6Agd1KuhhOBN/tDJcLlb+ztyzFkDdkU5eyHCfm1+y
tKuZwJQtzbw3R481/mYFsK/hPATtR7aVPa/dlfMb67XXVsbXkzt5rfuPWw0Z+kjn
lPQgXVukwEbIhJbLYph7XI5vu86eUrXjpmz+KPIQBf/LrvECIgp7JpI5ryZjEL9O
ueAnh5SEOY/9RiU7lWA7xgsvXsnWp2Jglw4DZcLWj+9j/1nDWc21Qs6Oqtf+wmuP
NM4RvvfcndUofn957fnKR6ib5LxlgI76LDJVQ7rmz4U8nGfLvpIqC54Ve/TonLr7
fHNNw5GjFqWT0onmqFKThM55XBp2PYTX0z0WDUbUUGVJdT7WPq6HxFG9EmN8JvmF
OFrgbv+P2Aizz0iw/kSjYZU0WWb1t/18VdGQEamX8sNmUV3RVj/d31pN41wZ18XT
ek+0Xrz+RN91fzfvjuf9yXivode4z5yLQB+vqok1WPVv3ufm/Xu/KzWxBnv7vPlp
vfIhddPTQ+xwyP+bVTkk9ecZ4ypN1cl232b1u1ujvM+NyyHvbq9uPhLaykMrGdaP
u/8r3ecdVwvPzbinakP9+lO7tvVcnvupVH+ktvhZr64+UoZupt5nLGZf2T5vkATX
a2ep4tJbkefy4k+NSHqYd+V7Eiadovwj9sg5WUbX777O1d90HmI1Ilu7Suqmz8fV
q0ld71l2WYCt/FwZ29X48jPZVzvPjdgWZeyU7rs+q0vCdiUcVwvrvo9VVYu7UttJ
rSvh1HkebMgsT5XgLt08V555dbivjO2+syo7HffEe9luc9irWevUymYx9u1+JZyy
IE70yBqw4WulV0I7vUfnZJrhdGWvqod0WW9zBNqS0H5XZZv1ymESbLdrqw/UK3vX
mSy396b6iv29831JYxZhci7xn0eauj5zd9diTffGIQveYt/GG8zzLEfqssN1d43P
D53ykOVseV51rGhuIa1sSdPvsxZ/290tFt91JmYx5s1VeMZZXmyRhdy+RuEkHnmA
edNjmCHk61eWaQgruw5PqaqV2skdoYZZ15LEhg2P7L87NjR5d71WZXU1kPTRmit5
4yzZRsxCjmyhY+9uh6PgvV163VcSs9spq+luM3jjuL8XFgqvq32nWKWxXS1sWYP5
SxVeo4cbCaTrx9F16El7xmysKc+w3SpySF/VcfhxLzOrAkWGI+k2TZnVy+LAhy6L
O/JYPG8pao1rIUJFIZ/FsYvqeuNKSAUOgz1g7vA3Nu0QC8GnZOGyripr79c2Daeq
4kxEN3zTrGdpJ3ZWxoCn85AjX/y80TwPTFqOw0PnBjIdj40mSdXuunZ17VI1quXI
MO/aOcqDuWjrQffp7LZ2ds9WuYyxkEW0vk8uMUs7sy1cObLNK0WKthXuca0mmMhR
fvO4L1mNYDvyTWdAeHK/p7uunVTJUuU718qE10MnZX5r2Dzdy6o4h9nVFhs4yv0i
ym+3ri3mZRKd17i5eZ/eendnmG5+3FQ3fMTOzDLNa0da+ZGFPIoHA1wTsueIa7qZ
V1/EajiH4bqdg0VqQ1E80nZinGvL/sF6PHbKugxTH4+3Tchn6GEWXF3qdr9ruzyy
4e4rPUJ74zrmAUOxzPzY9DFlSV37sPXAgSMcGB5r8QeTYLp1dVVIQM2mmL8TXldZ
8MLO5GWw7iMbJiaINdydLHGpIw3B7x7tt4plVTEY9G+65pvNo/xKfnyjniMpeF8V
G4f7V08RgChoGhuymq/MQNI8zjWPEM2QBrt7xEPAV9DV3t2EphbdnmLxrSYUHm6r
cMOP1F2yTHE50+EUz33u2W9xPntCcd4jz5HXBovPLMYwdyfWB0Oo+vY0FnXft01z
OhdwavkpV2dPYk1fOHC0rmFRlW66uNeQXsEpQ6YpVlqVBZlPDWcIFn/x5CmEa4mH
m97x7+YVoCpNXav40jX63W7XHfuQh1Zhmnl0l5cZM7K997c4823Ckin0sn2YXaD/
5fvtQkNjSlvxJ1dFD2+VN5p3Xn7mLCbQ/+a78uUDg1T2sPWdkzx0iu914Q+xsSlX
mvKyRsSXFS5Fo1nIWclvuk7EouAj5As2XKXXVuCq5vlTyNdlXde+haV2QoaUwYDg
PE24vtL+7DwtThP5uhjyly3Iu6f2pTisbtJ0O4TztYLdKD7rlGvKH7pQ7sj6l6RZ
QoqtmE61gYxnyPPMc8IHzLuVSXyh5vMVPWCq28/05kdiQFOMBWngXZdNKRp1Mdkq
Xnw8lo04g5dc/kgz7b5vK6No7OYNXr+F/9aDB5V1yuIhj2z6uDdW+fxUDD5a5RT8
ZSh67/LvSsDRmTyFmsYSrntMeq1Lin0d8fCjnaCfJvsnxzRublI3jwFE5S6WY6tV
j2/w3uEcwbJxWbXs8DivjJoSDOg4Dxfe+cmTSxrLUa4hT57iqpbfgCGWSW5n7E0M
cMEo3qgVVUV/MoWQsjtfUbZj37/6N9Rbyj7M47fionEmy/zsO7mKVonu8qflFjLk
z92/XT1zuYilGEVWvGT/UxkGMbRKwqi6RMUscOlRBrYVGQ27LDaSU5hHLreQRzwC
fl0LeZVZxRRviOpFlb1OMQnjVeQyQ9+mP7gUDbrweLzkN1O29ci6LHdzG5MWTIfd
Y+OtIpVUH1Pe+EgSswbLjiLLgEtYrJyKUUO1D+oRyv995Sae1YWkJsdDnJPXPi7f
lK0TO3R6zkMe2Ul1qXuBmcLRZqGS2z2iLHEiIvN5yYCHsozQjT1lNmIM4RET7h5X
yZO2oqHF0C1EV81NVjOc8cVkHExrlagVqb5hfiK7Nu1RdZkeqWespehhcoNUYMgj
zrK9KjT9WXCd2kDUUkbxyqKdtXeTjjhDVGK2MDxqy8aja4pRhrlVUaW7bsQrZLV4
8ilwreFMqRdqQsNxKpCgucfjnVYpDW9sQsXj1cTEEISGVOqUk1/dsGfLAx7tLnwP
vhJ+S02pF6qdhnfWJd05Wkr/4QHTcxmvjogbHemLWjOZAtnSo1xoSoeP+AnccDn2
P45ollEc106XvcL2WzleRRvys6g9wXIMJekVTM8Wbrx6rZpV4QxiQGZfs9DPaLKQ
qQjDyvQZjNs84ndV8V1s56VjMsV/h2LjLPRHqGIuj1kj2XVTfkHt5JEvp0xG2EDl
yvjT/op5qlC/UTnneeM1W3maKgHuJxapq2sGlmUxoaXYUWEoqpgdjx7d42AVi1d3
57Vqg9mWLEURmJoETGnK5x/ZJvZPffLGKkk9CvZET00YY6xelZ2t+KbYILu2rJ8c
NTKhXaiTG79jFzPp1Vg8lQA75SXcq+6hu1APUvbh2FDDx1+qaEtSV2UjTyHntzr3
q3sFRxi8nZ1T3eoePUIDVlEcbnPm4zlHoTJ9bUKWRIWka3ddvN5qJFPPHclo3Hyn
3Q0yK+/cDWJRod/i+abZk3DF6hTN9br9GfNAsqipE1jasWENPULDeq+2KyOJmLAd
lThP+yZ+8qoHRneSfsvSqWNLTaucAqNY7rXN7agqD3LLN7b0UvuA13bZcFNMNXnI
KLpwLmqExg0io3g9A0MTw7nXEQZteR753CzRgznKd1pCzSoUJKqANYZ6xsfg3EcW
u9xPQhYQcvr3FB/drrdslahMlPWOyJvZpjFlKmHRR6/OOczLtttwFdf23oUs7pTo
4eMnlj/r+6/lS108fzleB5JW5yEguK3UvjpCVP+OcJgIMzzKH5iw40VzlDPkBjWp
vcKeolNs0XpIllao8j6yazgXzJkIQOYP9zWrZNeRseKJw6Wht/c4UwWb6ZZO6Rof
OdJ1Lbni+AgZyErBKSL6V79YUaGLg5LtNvQkfrfeYOxDKDYdvQy76AjR9fC+mmPD
9uhqrA22bjqk2wJXsSzDoswp9PSpppDFC390UmTJhoDrhTfTrX+UAawS8wlDZ0f9
xrQ4X7qDQyeIFU6xjurounxVi5L1q2JWtZ8ubGiFLIzO0ShU/mZilovveaSmB2WI
vF4qYcbQTmleI2xiWNX9iX77LtEr6NIfNfJX3f/gcjDL8L2tbGsW6iaqWLzUQ2LS
xnJq2IVZSNSytvK0KhveQmrLDMYbXQ/1VcQN8TsmDN6by+hGE5H4pWJDry3yFtUA
CvU7ovcgEmh3q0Q/xNireTErm088hWouOxnOFY3VUvvDFqwO9t76de4pU2fSVElR
FdwjRSvUw/pLZc2zEeUeaMAYShOiHc+kqlsIvTEqQIYMXcgEyyUuyjY9ykz5E7M4
+lt59Ju/nTZumzVnWLa+1Z6W+Gxzfk1HaMtzu/TfnKcStaozviHLfGRt9JbhIVbv
fcRYzW9Vh8LGXsup6f5M53wxnRN9RGyu+imT2Q/thnPa8p7oNwZajEL1yLNzW8l7
YF22CAPixI29DWc7kX8fsVJim6HmEobgA/SAuyR+UgbASVr8P46aTDFQlfZYAHeQ
1D6h55gL1z+J+1IbiC483U/yMirxqzApEz0dn+5z/a+SM3l6BdiksR7qu2RGMRnX
C3mpmNFL1XHINrvjsMUUdWpfZnaO7IseAPVAceWXibflnlvd4iInpxJp8dgQMPrM
Tda9lRVQnTQWNX3uQ8hqrFG6xgq5gRlZvOmIScKY06MvMD17OOIXsWZ3vtgLvWd7
C5Z5CpUAZoLRfdNpxSmTzUdvRXNyhcrCKOTOwiDhykrRkRknumDkLeSQZC7kQeDC
cotjjlAdZK+6z6SzrlgW1UMq58Z0cpfOa6nFahrBSqk7PqmPbsyPWQTLTel7MLnB
fKBJBTJERy0qZjFNQNZD7ZpswZCPbllUs9jtkveQKWgm0fzstUoFM29wGKqVE3x9
6aaSUSw/Y5+y8NhIv8lO4HgljNkcpmFnoXsTLL6J8RFbz8scD53YqLMa8jTPHujq
2vlFtY1ZBqYfNa9R6FxP8etdyBfIOsk8Yk6AmQXY2PE5ser21b0Ckecu6ZxGFXmm
Wsr35Mxy/q4O4UsuzyzCShNE29kAE8UmMdOzzW2d2DPcaoyXqsb7RkeafizTiuTd
jyI10fwRupBD0XmmLwYXroqbU3hNR3Q5onGeygkSA9V8mWcPTH6r6iwe4v2EQu2D
CnJ0qekB0pfBQ33yRVw/ZttOielaMejSZbXM0NHRG64v5oVU7ZNHnRKnVV9mRnqh
3sGcanVUpwJBRm5+3nV2zDDQkY4dKxOTN1rkGZIgIoXXKxWBDa+34l7UXmFlTXyR
nrzZ8H4j5yfLZMezxLT1ds4HX+xeRYupT3q7oAIzZESZkWI1kZp5H6peXahu32SC
pUr7ygJfOqxMajw6E+ZPLObGvcqYIZov06LTV+ZeQep5lOZ8QIhZmMY0pkeEmx5l
6HZFf9akGbIwcAD+FLPbMSF+3GrMs5ncgVHtwiRWTHyScaru8n+wIXoHy3GgO8NS
LHyZ2rQYdes7joaLCCpvhPcqF9CZGO/QvMAbHJI8f/u/xMFNk1XocVvVaQtJnpdq
g9eBE+ZOZ7WWKcCIlSu+5CNLMWE751NHoNCD5OaB6eDxNcJ7wOuunZE/MGvKdEhM
JpLtqCstjtDdjqfPzpi+NBskXTNhvgpVIc246/tHjOopPE3VfQj39DtZSMy7MUFE
BeLIaqjznRIzePRRTFfLM4qYUzVPmS+dEKJ18zscMZ3FVMtTYkInJiKHW3YVv445
U825vtwhiKoZEZ2JYDz0UXzXBLvsMFdVj7ybyXbN5SW+4l2Sl/mQVYiR05nXVNxZ
fq+gu63fk37JG8nAqzNV1RQKXY+KLwjZQLm4KXK8YpBmCxW1mJu1swMN/84OMwtG
xRr2ZOiwlL9wyj7TrpMahWqlcja3BnExxUE47xH+RFZsO2xCObzfOw0vVbnpT1ps
3MmbuOVD3cJr1o4DVLOq+3f1EzzOlHqhere8w5rvIdWX/jhVY6ZaqLooo5QVks1v
5yFM+FlURmpDYfJH5mTQP/UopiRVm/HKWvDf7nNiMAEyK+5VaHLS64Z0Z+k9+Jxb
ifs3trvgfdPvcHi/UB5lEYEbM0NM1RlboUtN13PBCl74Ysxk54qlRZQn9RlgGcyn
MWu6PTeCqfsNO6/iBLNcHgHitLoYUC9R7WcaFsaoiCjr4vYN3JDpCb+L8Qa/rvLQ
/tLh5tbSltXQHwcFLMrENAJzknl2FX7HLEbXOUS3eJU8XU7MwyKYsawlIuT2kx9l
peeGW41uKb7RA6NS2LwSTP+aKQjZQKEPQE3POLh6HS/ZbvBA4xziZmJBTBd+xVvX
P7UeKvtkNqoQy7qocV15pGvmLq1yuWVL1HKncHMIQei45YzJ5/pecvToEFKDZhat
yuK21mS+eSS+wlpxTmllr6ket3cq4syuNo9lMS8oPihp/B6RVqYawa3CWHk6y4h7
i/TBl2opcRuU6qSqWo7sLUUZbpmOdA/JupxRJad+x8QD3U86Esdvr23XIr0CZpi7
e2PMbQt5FVHoyjOR1wqzVdyofT0D4xZrTGjGPH1L9SOLe8wpUeHilu9RlOliXtXx
gnkyQ5j+0iVVDUCxkawWXCFO1zJdW1QnDam8FvYy/7v0bE2zXulpReroFsc8sd9i
cVzZekI9dve8hjelHhh94ZXu60krH82mSjCslqgAE9Q0p9tXdA3rm+8QGGu0nCfY
ABUbOOHSt5+XWw5k6NxT4BaBZWvMBBOJ7DYoGMLcJP3UqLNGjs5OjmJh3F8mt6Vn
6PfWnD3F9K+6Ji/TQkN6bMqXiPyqHCqScXvwxiivmDE3Tv4GhqtS4TfQ4h7lk3gb
/bbpFUaLE3rHGx1p+Ai5JNNBS+cUFT2946V/fApTcOQyHu2cqTbXXu5tHc88elkp
NlqOETcriTCaCdEpU3W0SULeZ7sjohMVj2IpGiRPuN6SZoKpjdKRYFqBiiC33rdH
R2p13PSAt/H3RgR4c85TS77zSAefCQ/6vZrR+7qhRQeAXoFu7ShS08f1OnXh5gl1
UXVvX3om9LaamJd5Ur4v5re1xLofRXT+bQf6MswSe7fBLfMU5tHwxl2i843f1kKn
7Ag3W4Hv1MRA6RRLco8edJGZHdslclMqa8y5WIxiFpC8gxmUJ52mITOxcbmFxb9L
EbdqmUmly1Y9btF9Y+ZzCwfiNhFVX6o60XsYBb6vKVmP6MwEUFmG86kn7vfA8AAi
q3ksM7fDs85R4l7tdH09wozq3X9W2dqdJhAKHQhqJFRu2R39Dhh/Ff4H+0dqeAn9
a5gSN8Ow11a4SRoTJ3HLRv1KRX7mYaMeFXd/aumpOobXHueQfutZnkxV0/A2btHH
/ejH8xbq4bqN+lqv4Pljr8y9MgmKdRElIoYy3S+e/DIz1V0/TVZIRfUIk/hX4eBz
1esh6tMX8hHdnXc8pEoLh8n/zgi4RG89qoG6LfgGX/e6mVBuOfNi7pvqU3S4Y7bB
6kK//Pr9HyJDM9VtXAAA
}] [err]
current: random length? Sudokus
Sudoku: copy/deep pick Sudokus current
shutdown: func ["Exits the programm." ] [
unview/all
either debug [halt] [quit]
]
hot-key-wrapped?: func [
key [string! char!]
] [
either all [found? system/view/focal-face system/view/caret] [
if all [found? system/view/highlight-start found? system/view/highlight-end] [
system/view/caret: remove/part system/view/highlight-start subtract index? system/view/highlight-end index? system/view/highlight-start
system/view/highlight-start: system/view/highlight-end: none
]
insert system/view/caret form key
system/view/caret: next system/view/caret
show system/view/focal-face
true
] [false ]
]
empty-coins?: func [
"Ermittelt welche Spielfelder leer sind."
count [integer!] "Anzahl der freien Felder."
/local rc i lst foo
] [
lst: copy []
i: 0
loop 81 [insert lst i: i + 1]
rc: copy []
loop count [
insert rc first lst: random lst
remove lst
]
return sort rc
]
display-Sudoku: func [/local n g i val obj ] [
n: 0
loop 81 [
n: n + 1
set [g i] to-grid n
val: pick pick Sudoku g i
obj: do reduce [to word! join "c" n]
either zero? val [
obj/text: none
obj/cid: 3
obj/color: bg-color - 30
obj/fix: false
obj/todo: true
] [
obj/texts: reduce [obj/text: form val]
obj/color: bg-color - 5
either started [obj/cid: 1] [obj/cid: 4]
obj/fix: true
obj/todo: false
obj/edge/color: first obj/edge/colors
]
show obj
]
]
start-Sudoku: func [
] [
if all [not edit-mode complete? Sudoku] [
foreach element empty-coins? 42 [
set [g i] grid? element
poke pick Sudoku g i 0
]
display-Sudoku
]
time/texts: reduce [time/text: "0:00:00"]
show time
started: true
]
grid?: func [
"Ermittelt die Position auf dem Spielfeld."
id [integer!]
/local g i
] [
g: 1
while [greater? id 9] [g: g + 1 id: id - 9]
reduce [g id]
]
id?: func [
"Ermittelt die Position auf dem Spielfeld."
gi [block!] "[Grid,Index]"
/local g i row id
] [
set [g i] gi
row: to integer! (subtract i 0.1) / 3
id: multiply 9 row
while [greater? i 3] [i: i - 3]
id: id + i
switch g [
1 [id: id + 0]
2 [id: id + 3]
3 [id: id + 6]
4 [id: id + 27]
5 [id: id + 30]
6 [id: id + 33]
7 [id: id + 54]
8 [id: id + 57]
9 [id: id + 60]
]
return id
]
row?: func [
"Ermittelt die Reihe."
id [integer!]
] [add 1 to integer! (subtract id 0.1) / 9 ]
col?: func [
"Ermittelt die Spalte."
id [integer!]
/local rc
] [
if zero? rc: id // 9 [rc: 9]
return rc
]
inverse?: func [
"Invertiert den Block (=> die möglichen Zahlen)."
blk [block!]
/local rc
] [
rc: copy []
foreach element [1 2 3 4 5 6 7 8 9] [
if not found? find blk element [
insert rc element
]
]
return rc
]
to-grid: func [
"Erzeugt Grid-Koordinate."
id [integer!]
/local col row g i foo grid-offset-x grid-offset-y
] [
row: row? id
col: col? id
grid-offset-y: 3 * (to integer! (subtract row 0.1) / 3)
grid-offset-x: 1 + (to integer! (subtract col 0.1) / 3)
g: grid-offset-x + grid-offset-y
if zero? foo: row // 3 [foo: 3]
foo: foo - 1
if zero? col: col // 3 [col: 3]
i: add col multiply foo 3
return reduce [g i]
]
grid-numbers?: func [
"Ermittelt die möglichen Zahlen des Grids."
id [integer!]
/grid
] [
inverse? unique pick Sudoku either grid [id] [first to-grid id]
]
row-numbers?: func [
"Ermittelt die möglichen Zahlen in dieser Zeile."
id [integer!]
/row
/current
/local n foo g i
] [
blk: copy []
either row [row: id] [row: row? id]
for n (foo: row * 9) (foo - 8) -1 [
set [g i] to-grid n
foo: pick pick Sudoku g i
if not zero? foo [insert blk foo]
]
either current [blk] [inverse? blk]
]
col-numbers?: func [
"Ermittelt die möglichen Zahlen für diese Spalte."
id [integer!]
/col
/current
/local g i foo
] [
blk: copy []
either col [col: id] [col: col? id]
loop 9 [
set [g i] to-grid col
foo: pick pick Sudoku g i
if not zero? foo [insert blk foo]
col: col + 9
]
either current [blk] [inverse? blk]
]
complete?: func [
blk [block!]
"Alle Ziffern des Sudoku gesetzt?"
] [
return all [none? find pick blk 1 0 none? find pick blk 2 0 none? find pick blk 3 0 none? find pick blk 4 0 none? find pick blk 5 0 none? find pick blk 6 0 none? find pick blk 7 0 none? find pick blk 8 0 none? find pick blk 9 0]
]
display: func [
"Zeigt Spielfeld an."
blk [block!]
/local g1 g2 g3 g4 g5 g6 g7 g8 g9
] [
g1: pick blk 1
g2: pick blk 2
g3: pick blk 3
g4: pick blk 4
g5: pick blk 5
g6: pick blk 6
g7: pick blk 7
g8: pick blk 8
g9: pick blk 9
print [g1/1 g1/2 g1/3 " " g2/1 g2/2 g2/3 " " g3/1 g3/2 g3/3]
print [g1/4 g1/5 g1/6 " " g2/4 g2/5 g2/6 " " g3/4 g3/5 g3/6]
print [g1/7 g1/8 g1/9 " " g2/7 g2/8 g2/9 " " g3/7 g3/8 g3/9 newline]
print [g4/1 g4/2 g4/3 " " g5/1 g5/2 g5/3 " " g6/1 g6/2 g6/3]
print [g4/4 g4/5 g4/6 " " g5/4 g5/5 g5/6 " " g6/4 g6/5 g6/6]
print [g4/7 g4/8 g4/9 " " g5/7 g5/8 g5/9 " " g6/7 g6/8 g6/9 newline]
print [g7/1 g7/2 g7/3 " " g8/1 g8/2 g8/3 " " g9/1 g9/2 g9/3]
print [g7/4 g7/5 g7/6 " " g8/4 g8/5 g8/6 " " g9/4 g9/5 g9/6]
print [g7/7 g7/8 g7/9 " " g8/7 g8/8 g8/9 " " g9/7 g9/8 g9/9]
]
score-nums: func [
{Bewertet alle möglichen Züge und liefert die besten zurück}
blk [block!]
/local id n1 n2 n3 n4 n5 n6 n7 n8 n9
] [
n1: copy []
n2: copy []
n3: copy []
n4: copy []
n5: copy []
n6: copy []
n7: copy []
n8: copy []
n9: copy []
foreach [id element] blk [
switch length? element [
1 [insert/only n1 reduce [id element]]
2 [insert/only n2 reduce [id element]]
3 [insert/only n3 reduce [id element]]
4 [insert/only n4 reduce [id element]]
5 [insert/only n5 reduce [id element]]
6 [insert/only n6 reduce [id element]]
7 [insert/only n7 reduce [id element]]
8 [insert/only n8 reduce [id element]]
9 [insert/only n9 reduce [id element]]
]
]
either empty? n1 [
either empty? n2 [
either empty? n3 [
either empty? n4 [
either empty? n5 [
either empty? n6 [
either empty? n7 [
either empty? n8 [
either empty? n9 [
copy []
] [n9 ]
] [n8 ]
] [n7 ]
] [n6 ]
] [n5 ]
] [n4 ]
] [n3 ]
] [n2 ]
] [n1 ]
]
get-best-nums: func [
{Bestimmt die besten eindeutigen Zug im aktuellen Sudoku.}
/only "Bestimmt nur den ersten eindeutigen Zug."
/local id g i rc nums
] [
rc: copy []
g: 1
foreach grid Sudoku [
i: 1
foreach num grid [
if all [zero? num equal? length? nums: intersect grid-numbers?/grid g intersect row-numbers? id: id? reduce [g i] col-numbers? id 1] [
insert/only rc nums
insert rc id
if only [break]
]
i: i + 1
]
if all [only not empty? rc] [break]
g: g + 1
]
return rc
]
get-all-nums: func [
"Bestimmt alle möglichen Züge im aktuellen Sudoku."
/local id gi rc nums
] [
rc: copy []
id: 1
loop 81 [
gi: to-grid id
if all [zero? pick pick Sudoku first gi second gi not empty? nums: intersect grid-numbers?/grid first gi intersect row-numbers? id col-numbers? id] [
insert/only rc nums
insert rc id
]
id: id + 1
]
return rc
]
solve-Sudoku: func [
"Versucht Sudoku zu lösen."
/local init num g i
] [
init: copy []
until [
either empty? num: get-best-nums/only [
insert/only tail init copy/deep Sudoku
either empty? num: score-nums get-all-nums [
wait [0.1]
if abort [break]
delight
Sudoku: first init
clear init
g: 1
foreach grid Sudoku [
i: 1
foreach num grid [
if zero? num [
set-coin/empty 0 id? reduce [g i]
]
i: i + 1
]
g: g + 1
]
] [
delight
num: first random num
coin: first num
set-coin/color/noscore first random second num 3
]
] [
delight
coin: first num
set-coin/color/noscore first second num 2
]
complete? Sudoku
]
]
make-Sudoku: func [
"Erzeugt Sudoku-Spiel."
init [block!]
/local id zahl offen rc val gi foo
] [
if edit-mode [poke Sudokus current copy/deep Sudoku]
Sudoku: copy/deep init
if not edit-mode [
until [
either empty? foo: score-nums get-all-nums [
if debug [
print now
display Sudoku
]
Sudoku: copy/deep init
] [
set [id zahl] foo: first random foo
gi: to-grid id
zahl: first random zahl
poke pick Sudoku first gi second gi zahl
]
complete? Sudoku
]
]
]
delight: func [
"delight recent face."
/local obj
] [
if found? coin [
obj: do reduce [to word! join "c" coin]
coin: none
obj/edge/color: first obj/edge/colors
show obj
]
]
move-highlight: func [
/up
/down
/left
/right
/this id [integer!]
/local old x y obj
] [
if not started [
start-Sudoku
if all [not solving solver not empty? i: get-best-nums/only] [
this: true
id: first i
]
]
old: coin
either found? old [
x: col? old
y: row? old
delight
if left [if zero? x: x - 1 [x: 9]]
if right [if greater? x: x + 1 9 [x: 1]]
if up [if zero? y: y - 1 [y: 9]]
if down [if greater? y: y + 1 9 [y: 1]]
coin: x + (multiply 9 y - 1)
] [coin: 41 ]
if this [coin: id]
obj: do reduce [to word! join "c" coin]
show obj
]
toggle-coin-color: func [/local o ] [
o: do reduce [to word! join "c" coin]
if not o/fix [
if greater? o/cid: o/cid + 1 3 [o/cid: 1]
show o
]
]
set-coin: func [
num [integer!]
/empty id [integer!]
/color c [integer!]
/noscore
/local o g i
] [
either empty [
o: do reduce [to word! join "c" id]
if any [edit-mode not o/fix] [
set [g i] to-grid id
poke pick Sudoku g i num
o/text: none
o/color: bg-color - 30
o/cid: 4
o/fix: false
o/todo: true
show o
]
] [
if found? coin [
o: do reduce [to word! join "c" coin]
if all [not o/fix found? find intersect grid-numbers?/grid first set [g i] to-grid coin intersect row-numbers? coin col-numbers? coin num] [
poke pick Sudoku g i num
o/texts: reduce [o/text: form num]
o/todo: false
o/color: bg-color - 5
either color [o/cid: c] [o/cid: 1]
if not color [o/edge/color: first o/edge/colors]
show o
if all [not solving solver not empty? i: get-best-nums/only] [move-highlight/this first i ]
if all [not noscore not edit-mode complete? Sudoku] [
started: false
message/color ["C O N G R A T U L A T I O N:" "You´ve completed this Sudoku puzzle !!!" "Start all over again ..."] green
update-highscore copy spielername/text to time! time/text
if ulf [save-file]
]
]
]
]
all [MacOSX wait 1E-5]
]
select-Sudoku: func [
"Stellt ein Sudoku auf dem Spielfeld dar."
/this id [integer!]
/up
/down
/local continue o
] [
unfocus
if not solving [
continue: false
either started [
if confirm "Current Sudoku is not finished! Continue?" [
solving: started: false
delight
time/texts: reduce [time/text: "0:00:00"]
show time
continue: true
]
] [continue: true]
if continue [
if this [current: id]
if up [current: current + 1]
if down [current: current - 1]
if not positive? current [current: length? Sudokus]
if greater? current length? Sudokus [current: 1]
Sudoku: copy/deep pick Sudokus current
sudoku-txt/texts: reduce [sudoku-txt/text: form current]
show sudoku-txt
display-Sudoku
]
]
]
add-Sudoku: func [
"Generiert ein neues Sudoku."
/local prompt
] [
prompt: flash "Please wait while generating a new Sudoku ..."
make-Sudoku NULL
unview/only prompt
either found? prompt: find/only Sudokus Sudoku [
prompt: index? prompt
] [
insert/only tail Sudokus copy/deep Sudoku
write/binary config-file compress mold Sudokus
LofS/texts: reduce [LofS/text: reform ["Sudoku" "(" prompt: length? Sudokus ") :"]]
show LofS
]
select-Sudoku/this prompt
]
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 time] [
clear scorelist/text
i: 1
rank: " "
append scorelist/text {TOP-20
Name Time Date
------------------------------------------------}
foreach element highscores [
append scorelist/text newline
clear rank
if i < 10 [append rank 0]
append rank i
append rank ". "
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 " " 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"
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 [
if mytime < to time! trim select element 'time [
insert at highscores index to block! mold reduce ['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 60 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 335x3 edge [size: 1x1 color: sky effect: 'bevel] return
scorelist: code 28.52.86 center bold no-wrap 335x100 " " 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 335x3 edge [size: 1x1 color: sky effect: 'bevel] return
]
init-highscore
history: layout [
styles btn-styles
backdrop effect compose [gradient 0x-1 (bg-color - 39) (bg-color - 24)]
origin 0x0
across
pad 20x10 banner "History" 306 bg-color + 80 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]
at 0x0
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 330x125 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 compose [gradient 0x-1 (bg-color - 39) (bg-color - 24)]
vh2 bg-color + 80 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 compose [gradient 0x-1 (bg-color - 44) (bg-color - 24)]
panel 335x273 bg-color - 25 edge [size: 2x2 color: bg-color - 20 effect: 'bevel] effect reduce ['gradient 0x1 (bg-color - 20) (bg-color - 10)] [
origin 15x15
space 0
banner "About ..." 300 bg-color + 80 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-Sudoku: layout [
styles btn-styles
backdrop effect compose [gradient 0x-1 (bg-color - 44) (bg-color - 24)]
style bx box 25x25 font [color: bg-color + 80 size: 20 colors/1: color] feel [
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]
]
]
across
origin 2x2
space 5
pad 25x10 banner 332 bg-color + 80 underline bold system/script/title with [feel: none] return
pad 25 bx keycode [left] [move-highlight/left]
bx keycode [right] [move-highlight/right]
bx keycode [up] [move-highlight/up]
bx keycode [down] [move-highlight/down]
bx keycode [#"0"] [either equal? sudoku-txt/color sudoku-txt/colors/2 [append sudoku-txt/text "0" show sudoku-txt] [if found? coin [set-coin/empty 0 coin]]]
bx keycode [#" "] [if found? coin [toggle-coin-color]] return
pad 25x-30
panel 332x332 edge [size: 1x1 color: (bg-color - 40) effect: 'bevel] [
origin 0x0
space 0x0
panel 330x330 edge [size: 1x1 color: (bg-color - 40) effect: 'ibevel] [
backdrop effect compose [gradient 0x-1 (bg-color - 20) (bg-color - 10)]
style fld box 25x25 (bg-color - 30) "0" font [colors: [255.255.55 55.255.55 255.155.55 160.216.255]] edge [size: 1x1 color: (bg-color - 20) effect: 'ibevel colors: reduce [bg-color - 20 255.180.55 255.255.55]] feel [
redraw: func [face act pos] [
face/font/color: pick face/font/colors face/cid
face/edge/effect: pick [ibevel bevel] face/todo
if equal? face/id coin [
either face/fix [face/edge/color: multiply first face/edge/colors 2] [face/edge/color: third face/edge/colors]
]
]
over: func [face action event] [
if not face/fix [
either action [
either equal? face/id coin [
face/edge/color: third face/edge/colors
show face
] [
face/edge/color: second face/edge/colors
show face
face/edge/color: first face/edge/colors
]
] [show face ]
]
]
engage: func [face action event] [
if not started [start-Sudoku]
if not face/fix [
switch action [
down [delight coin: face/id face/state: true face/edge/color: third face/edge/colors]
alt-down [delight coin: face/id face/state: true face/edge/color: third face/edge/colors]
up [if face/state [do-face face none] face/state: off]
alt-up [if face/state [do-face-alt face none] face/state: off]
]
cue face action
show face
]
]
] with [todo: true fix: false id: none cid: 4] [if all [not face/fix found? face/text greater? face/cid: face/cid + 1 3] [face/cid: 1]] [set-coin/empty 0 face/id]
across
origin 21x21
space 5
c1: fld "1" edge [size: 1x1] with [id: 1] c2: fld "2" edge [size: 1x1] with [id: 2] c3: fld "3" edge [size: 1x1] with [id: 3] pad 11 c4: fld "4" edge [size: 1x1] with [id: 4] c5: fld "5" edge [size: 1x1] with [id: 5] c6: fld "6" edge [size: 1x1] with [id: 6] pad 11 c7: fld "7" edge [size: 1x1] with [id: 7] c8: fld "8" edge [size: 1x1] with [id: 8] c9: fld "9" edge [size: 1x1] with [id: 9] return
c10: fld "10" edge [size: 1x1] with [id: 10] c11: fld "11" edge [size: 1x1] with [id: 11] c12: fld "12" edge [size: 1x1] with [id: 12] pad 11 c13: fld "13" edge [size: 1x1] with [id: 13] c14: fld "14" edge [size: 1x1] with [id: 14] c15: fld "15" edge [size: 1x1] with [id: 15] pad 11 c16: fld "16" edge [size: 1x1] with [id: 16] c17: fld "17" edge [size: 1x1] with [id: 17] c18: fld "18" edge [size: 1x1] with [id: 18] return
c19: fld "19" edge [size: 1x1] with [id: 19] c20: fld "20" edge [size: 1x1] with [id: 20] c21: fld "21" edge [size: 1x1] with [id: 21] pad 11 c22: fld "22" edge [size: 1x1] with [id: 22] c23: fld "23" edge [size: 1x1] with [id: 23] c24: fld "24" edge [size: 1x1] with [id: 24] pad 11 c25: fld "25" edge [size: 1x1] with [id: 25] c26: fld "26" edge [size: 1x1] with [id: 26] c27: fld "27" edge [size: 1x1] with [id: 27] return
pad 0x11 c28: fld "28" edge [size: 1x1] with [id: 28] c29: fld "29" edge [size: 1x1] with [id: 29] c30: fld "30" edge [size: 1x1] with [id: 30] pad 11 c31: fld "31" edge [size: 1x1] with [id: 31] c32: fld "32" edge [size: 1x1] with [id: 32] c33: fld "33" edge [size: 1x1] with [id: 33] pad 11 c34: fld "34" edge [size: 1x1] with [id: 34] c35: fld "35" edge [size: 1x1] with [id: 35] c36: fld "36" edge [size: 1x1] with [id: 36] return
c37: fld "37" edge [size: 1x1] with [id: 37] c38: fld "38" edge [size: 1x1] with [id: 38] c39: fld "39" edge [size: 1x1] with [id: 39] pad 11 c40: fld "40" edge [size: 1x1] with [id: 40] c41: fld "41" edge [size: 1x1] with [id: 41] c42: fld "42" edge [size: 1x1] with [id: 42] pad 11 c43: fld "43" edge [size: 1x1] with [id: 43] c44: fld "44" edge [size: 1x1] with [id: 44] c45: fld "45" edge [size: 1x1] with [id: 45] return
c46: fld "46" edge [size: 1x1] with [id: 46] c47: fld "47" edge [size: 1x1] with [id: 47] c48: fld "48" edge [size: 1x1] with [id: 48] pad 11 c49: fld "49" edge [size: 1x1] with [id: 49] c50: fld "50" edge [size: 1x1] with [id: 50] c51: fld "51" edge [size: 1x1] with [id: 51] pad 11 c52: fld "52" edge [size: 1x1] with [id: 52] c53: fld "53" edge [size: 1x1] with [id: 53] c54: fld "54" edge [size: 1x1] with [id: 54] return
pad 0x11 c55: fld "55" edge [size: 1x1] with [id: 55] c56: fld "56" edge [size: 1x1] with [id: 56] c57: fld "57" edge [size: 1x1] with [id: 57] pad 11 c58: fld "58" edge [size: 1x1] with [id: 58] c59: fld "59" edge [size: 1x1] with [id: 59] c60: fld "60" edge [size: 1x1] with [id: 60] pad 11 c61: fld "61" edge [size: 1x1] with [id: 61] c62: fld "62" edge [size: 1x1] with [id: 62] c63: fld "63" edge [size: 1x1] with [id: 63] return
c64: fld "64" edge [size: 1x1] with [id: 64] c65: fld "65" edge [size: 1x1] with [id: 65] c66: fld "66" edge [size: 1x1] with [id: 66] pad 11 c67: fld "67" edge [size: 1x1] with [id: 67] c68: fld "68" edge [size: 1x1] with [id: 68] c69: fld "69" edge [size: 1x1] with [id: 69] pad 11 c70: fld "70" edge [size: 1x1] with [id: 70] c71: fld "71" edge [size: 1x1] with [id: 71] c72: fld "72" edge [size: 1x1] with [id: 72] return
c73: fld "73" edge [size: 1x1] with [id: 73] c74: fld "74" edge [size: 1x1] with [id: 74] c75: fld "75" edge [size: 1x1] with [id: 75] pad 11 c76: fld "76" edge [size: 1x1] with [id: 76] c77: fld "77" edge [size: 1x1] with [id: 77] c78: fld "78" edge [size: 1x1] with [id: 78] pad 11 c79: fld "79" edge [size: 1x1] with [id: 79] c80: fld "80" edge [size: 1x1] with [id: 80] c81: fld "81" edge [size: 1x1] with [id: 81] return
]
] return
pad 25 bx "S" edge [size: 1x1 color: none] [
unfocus
either solver [
abort: true
solving: solver: false
face/edge/color: none
show face
] [
if confirm "Do you want to use the Sudoku solver-assistant ?" [
solver: true
face/edge/color: orange
show face
if all [started not solving solver not empty? foo: get-best-nums/only] [move-highlight/this first foo ]
]
]
] [
unfocus
either solver [
if confirm {Do you really want to automatically solve this Sudoku ?} [
abort: false
solving: true
solve-Sudoku
abort: solving: false
delight
started: false
]
] [
if confirm "Do you want to use the Sudoku solver-assistant ?" [
solver: true
face/edge/color: orange
show face
if all [started not solving solver not empty? foo: get-best-nums/only] [move-highlight/this first foo ]
]
]
]
pad 1 bx "1" keycode [#"1"] [if not hot-key-wrapped? "1" [set-coin 1]]
bx "2" keycode [#"2"] [if not hot-key-wrapped? "2" [set-coin 2]]
bx "3" keycode [#"3"] [if not hot-key-wrapped? "3" [set-coin 3]]
bx "4" keycode [#"4"] [if not hot-key-wrapped? "4" [set-coin 4]]
bx "5" keycode [#"5"] [if not hot-key-wrapped? "5" [set-coin 5]]
bx "6" keycode [#"6"] [if not hot-key-wrapped? "6" [set-coin 6]]
bx "7" keycode [#"7"] [if not hot-key-wrapped? "7" [set-coin 7]]
bx "8" keycode [#"8"] [if not hot-key-wrapped? "8" [set-coin 8]]
bx "9" keycode [#"9"] [if not hot-key-wrapped? "9" [set-coin 9]]
pad 6 bx "E" edge [size: 1x1 color: none] [
unfocus
either edit-mode [
poke Sudokus current copy/deep Sudoku
started: edit-mode: false
face/edge/color: none
show face
write/binary config-file compress mold Sudokus
] [
if confirm "Do you want to edit this Sudoku ?" [
edit-mode: true
face/edge/color: orange
show face
]
]
] [
unfocus
either edit-mode [
if confirm "Do you really want to remove this Sudoku ?" [
started: edit-mode: false
face/edge/color: none
show face
remove at Sudokus current
write/binary config-file compress mold Sudokus
LofS/texts: reduce [LofS/text: reform ["Sudoku" "(" length? Sudokus ") :"]]
show LofS
select-Sudoku/this current
]
] [
if confirm "Do you want to edit this Sudoku ?" [
edit-mode: true
face/edge/color: orange
show face
]
]
] return
pad 25 box 332x3 bg-color - 10 edge [size: 1x1 color: bg-color - 40 effect: 'bevel] return
pad 40x-2 LofS: text 85 center middle underline no-wrap (bg-color + 80) reform ["Sudoku" "(" length? Sudokus ") :"] with [feel: none] [
if all [not solving confirm join "Do you want to " [either edit-mode ["edit "] ["compute "] "a new Sudoku ?"]] [add-Sudoku]
] [
if all [not solving confirm join "Do you want to " [either edit-mode ["edit "] ["compute "] "a new Sudoku ?"]] [add-Sudoku]
]
pad 11x10 spielername: field 100x22 (bg-color + 80) middle center "Your name" no-wrap font [color: (bg-color / 3)] edge [color: (bg-color - 20) size: 2x2]
pad 20x-10 text 70 center middle underline (bg-color + 80) "Time:" with [feel: none] [view/new/options center-face highscore [no-title]] [view/new/options center-face highscore [no-title]] return
pad 45x-10 arrow left (bg-color - 20) edge [color: (bg-color - 20) size: 1x1] [select-Sudoku/down] [select-Sudoku/down]
pad -5x0 sudoku-txt: field 35x20 (bg-color / 4) middle center no-wrap bold form current edge [color: (bg-color - 20) size: 1x1 effect: 'ibevel] font [color: 255.180.55 size: 16] [either error? try [foo: to integer! face/text] [clear face/text insert face/text form current show face] [if not equal? foo current [current: foo select-Sudoku/this current]]]
pad -5x0 arrow right (bg-color - 20) edge [color: (bg-color - 20) size: 1x1] [select-Sudoku/up] [select-Sudoku/up]
pad 140 time: text 70x20 right middle bold edge [color: (bg-color - 20) size: 1x1 effect: 'ibevel] 255.180.55 (bg-color / 4) font [color: 255.180.55 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 ulf 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/Rights " & request a license-key."]] orange
]
]
]
after: none
rate: 1
] return
pad 25x2 box 332x3 bg-color - 10 edge [size: 1x1 color: bg-color - 40 effect: 'bevel] return
pad 25 text 332 center bg-color + 80 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 370x1
small-btn "X" keycode [#"^["] [
either solving [
if confirm "Abort solving this Sudoku ?" [abort: true]
] [
if confirm reform ["Do you really want to quit" system/script/title "?"] [shutdown]
]
] [
either solving [
if confirm "Abort Sudoku solving?" [abort: true]
] [
if confirm reform ["Do you really want to quit" system/script/title "?"] [shutdown]
]
]
at 350x1
small-btn "?" keycode [#"?"] [view/new/offset/title about (lay-Sudoku/offset + face/offset + face/size + 15x15) join "about " system/script/header/Name] [view/new/offset/title about (lay-Sudoku/offset + face/offset + face/size + 15x15) join "about " system/script/header/Name]
]
lay-Sudoku/feel: make lay-Sudoku/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-Sudoku]]
]
if rc [event]
]
]
display-Sudoku
view/kf center-face lay-Sudoku
shutdown
No comments:
Post a Comment