REBOL [
Title: "Chinese Year"
Version: 1.0.0
Date: 9-Jan-2005
File: %chinese-year.r
Author: "Vincent Ecuyer"
Purpose: "Chinese Year name"
Language: 'en
Usage: "Type in the year -> get the chinese year name"
Comment: {
Works under both /View and /Core,
in english (language: 'en) and french (language: 'fr).
Fonctionne sous /View et /Core,
en anglais (language: 'en) et français (language: 'fr).
}
]
language: system/script/header/language
locale-strings: [
year [fr "Année: " en "Year: "]
chinese-year [fr "Année chinoise: " en "Chinese Year: "]
animal [fr [
"Rat" "Boeuf" "Tigre" "Lièvre" "Dragon" "Serpent"
"Cheval" "Chèvre" "Singe" "Coq" "Chien" "Porc"
] en [
"Rat" "Ox" "Tiger" "Rabbit" "Dragon" "Snake"
"Horse" "Goat" "Monkey" "Rooster" "Dog" "Pig"
]]
element [fr [
"de Bois" "de Bois" "de Feu" "de Feu" "de Terre"
"de Terre" "de Métal" "de Métal" "d'Eau" "d'Eau"
] en [
"Wood" "Wood" "Fire" "Fire" "Earth"
"Earth" "Metal" "Metal" "Water" "Water"
]]
]
gui-strings: [
l-year year
l-chinese-year chinese-year
]
locale: func [value][copy select select locale-strings value language ]
set-text: func [face value][
either face/text [append clear face/text value][face/text: copy value]
]
add-text: func [face value][
either face/text [append face/text value][face/text: copy value]
]
mod-3: func [face value][
if error? try [face: do trim face/text][face: 0]
face: face - 3 // value
either positive? face [face][face + value]
]
set-language: func [value][
language: value
foreach [label text] gui-strings [
set-text get label locale text
show get label
]
if all [year/data not empty? year/data][do-calculs]
]
do-calculs: does [
animal: mod-3 year 12
element: mod-3 year 10
set-text name-1 pick [
"Jia" "Yi" "Bing" "Ding" "Wu"
"Ji" "Geng" "Xin" "Ren" "Gui"
] element
add-text name-1 "-"
add-text name-1 pick [
"Zi" "Chou" "Yin" "Mao" "Chen" "Si"
"Wu" "Wei" "Shen" "Yu" "Xu" "Hai"
] animal
set-text name-2 either find [fr] language [pick locale 'animal animal ][pick locale 'element element ]
add-text name-2 " "
add-text name-2 either find [fr] language [pick locale 'element element ][pick locale 'animal animal ]
add-text name-2 pick [" (Yang)" " (Yin)"] odd? element
show [name-1 name-2]
]
either all [value? 'view? view? value? 'layout][
view layout [
size 400x100
style mini-label label 45x15 white font [
size: 9 colors: [255.255.255 0.0.0]
]
backcolor 255.82.41
across
l-year: label 46x19 locale 'year year: field 70 [do-calculs]
return
l-chinese-year: label 97x19 locale 'chinese-year
name-1: text "" 70 center label "/"
name-2: text "" 150 center
at 300x0
mini-label "English" [set-language 'en]
mini-label "Français" [set-language 'fr]
do [focus year]
]
][
name-1: make object! [text: none]
name-2: make object! [text: none]
year: make object! [text: none]
show: func [value][
value: append copy [] value
foreach item value [
item: get item
if none? item/text [item/text: copy ""]
]
]
forever [
until [
year/text: ask locale 'year
if empty? year/text [quit]
not error? try [to-integer year/text]
]
do-calculs
print rejoin [
locale 'chinese-year
name-1/text
" / "
name-2/text
]
]
]
;quit
This is a blog about Rebol, it's a fantastic free programming language, it permits easily to create complete software with few lines of code. It's cross-platform, so if you write it on Windows, it will work on Linux and Mac, and vice-versa. You can produce also wonderful GUI with just 3 lines of code!
Thursday, 26 January 2012
Chinese year
This script gives the Chinese year both in English and in French:
Wednesday, 25 January 2012
Graphical Internet Server Monitor
Carl Sassenrath wrote this script:
http://www.rebol.com/view/demos/gismo.r
I used that code to produce the simpler version:
Wait 10 seconds and this will be the result:
http://www.rebol.com/view/demos/gismo.r
I used that code to produce the simpler version:
Rebol []
time-out: 5 ; Seconds to wait for the connection (adjust it!)
poll-time: 0:00:10
system/schemes/default/timeout: time-out
system/schemes/http/timeout: time-out
sites: [
; List of URLs (http or tcp are allowed)
http://www.rebol.com
http://www.rebol.net
http://www.rebol.org
http://mail.rebol.net
http://www.altme.com
http://rebol2.blogspot.com/
]
;main layout
out: [
backeffect [ gradient 0x1 black coal ]
vh1 "Graphical Internet Server Monitor"
]
foreach site sites [
append out (reduce ['text (to-string site) ] )
]
append out [
pad 50x0
btn water 100 "Refresh" rate poll-time feel [
engage: func [ f a e ] [
if find [ time down ] a [check-sites ]
]
]
]
append out reduce ['vh4 yellow reform [ "Automatic refresh in" poll-time ] ]
check-sites: does [
foreach face out/pane [
if face/style = 'text [
face/color: gray
show face
either attempt [ close open to-url face/text true ] [
face/color: green
show face
] [
face/color: red
show face
]
]
]
]
out: layout out
view out
Wait 10 seconds and this will be the result:
Tuesday, 24 January 2012
TUI Dialect - A dialect to print ASCII sequences
I post here an interesting guide: Author: Ingo Hohmann
With REBOL 2.1 and on we got the ability to use ASCII sequences in REBOL's 'print statements, to control cursor behaviour. A really big step, because now we could do nifty things like:
Which would, actually, clear the screen, put the cursor at position 10, 10 on the screen, and print "Hello World!". That's nice enough for REBOL to print, but not for me to write, or even understand later. So, what could be done to make writing those strings easier?
A first idea could be to save the control sequences to some word, thus having:
Now the above could be written as:
Which is better readable than our first version, but has two disadvantages:
Now we can write our little "Hello World" message this way:
What I didn't like about it, that was the "/" notation used, so I decided to settle to write a dialect to position the cursor.
A Cursor Positioning Dialect
Creating a dialect means, to create a now mini language, that can be used in a specialized environment within REBOL. This means, dialects are organized as blocks, which are not treated by the normal REBOL interpreter, but by an interpreter written in REBOL.
O.K. first what we'll gain:
This will print exactly the same as the string we started with, but it is much easier to understand, and change later, should the need arise.
Have I got you interested? Well, of course, because otherwise you wouldn't have proceded until here...
First we'll need a function, that accepts a block:
Now we have to get this function interpret the block, this is best done with REBOLs block-parse ability:
And now all we need to do is fill in the rules ;-)
Let's proceed slowly, we have seen above, that we want to use specific words, to trigger output of the respective ASCII commands, let's give it a try:
Using this rule, our function will correctly parse a block containing any sequence of the words 'clear 'at:
Nice, isn't it? But we need to be able to give the 'at command the actual coordinates to put the cursor, and, well, I'd like to be able to insert Text-strings right between the commands, so we need to parse looking for data-types: (While I'm only changing the rules block, I'll not print the whole function again ...)
Now our dialect block can contain elements like
just the word 'clear
the word 'at, followed by a pair, this pair! will be saved into arg
strings
Let's give it a try again:
Yup, so far it works, but now we want it to make some real output.
Now, the part in parens is normal REBOL code, that gets executed, whenever the the part before it matches, now let's update our function with some things we need, and give it a try.
Aaaahhhhh, it worked like a charm, here. Now, what have we done since the last time we looked at the function? We made some new words local, initialized an empty string, that holds the return value, and the last thing, we return this value. Great.
Now you could go ahead, read the REBOL documentation, and fill in words for other ASCII commands, but wait, I want to do some little fine-tuning, first.
Think about it, wouldn't it be nice, if we could include arbitrary REBOL Code within the dialect? Maybe like you want include a row of dashes, of computed length.
Let's add a command to repeat a given string:
Let's try:
It works, but where's the promised REBOL Code support? Just a wee little moment of patience. Here it is, the 'command function. All we actually have to do is run the dialect block through compose first, like this:
What I am still missing, I want to know about the screen size, for some computation, can we add this, too? Sure.
To get the screen-size, we first have to print the ASCII command, and then read the data from the console port, and understand it, of course. Here's what I want to add to our dialect function:
So, we're setting screen-size to what the whole parent expression evaluates to. That's,
Now we have the screen-dimensions as a block in 'screen-size, let's try it out:
That's not exactly what we wanted, is it? The problem here is, 'compose runs the code in the dialect in the global context, where screen-size isn't defined, because it's only local to cursor2. So we have to manually 'bind it to this functions context, to be able to access the value, it's done like this:
Change the line
to
This tells REBOL, whenever you find a word you don't understand while working on our command string, try to find it where you can find 'screen-size right now.
Time for a final version
This text is already much longer than I planned it, so maybe we should just have a look at the final version.
I included some more words in the dialect, and a limited error handling, but you'll see ...
Maybe you wondered about the [catch] in the functions header (or maybe you didn't even notice), what does it do? Instead of trying to describe it, I'll show you the error messages of two cursor2 runs, once with, and once without catch:
Without [catch]
With [catch] included
You see, without [catch] the call of 'throw is displayed as originator of the error, whereas including [catch] displays the call of the dialect as source of the error. I think the latter is much more understandable to the user.
Creating a dialect is like creating a new language, so you have to be careful about what words you use, and about the grammar.
For example, I started out with 'pos for positioning the cursor, but settled for 'at at last. Because I got into trouble. Is 'pos used to get or set the position? If it sets the position, and I have get-pos for getting, why is there no set-pos? So, better use 'at and 'where, in my opinion.
Some rules: words should be,
For the repeat string command, I haven't actually included a command, I wan't able to decide what to use
So I thought this is short, and understandable, and not likely to be misunderstood/misused.
And last, I return the string instead of printing it directly, this way you are free to save the string returned for later use, without the need to run the dialect again.
With REBOL 2.1 and on we got the ability to use ASCII sequences in REBOL's 'print statements, to control cursor behaviour. A really big step, because now we could do nifty things like:
print "^[[J^[[10;10HHello World!"
Which would, actually, clear the screen, put the cursor at position 10, 10 on the screen, and print "Hello World!". That's nice enough for REBOL to print, but not for me to write, or even understand later. So, what could be done to make writing those strings easier?
First Steps
A first idea could be to save the control sequences to some word, thus having:
cls: "^(1B)[J"
Now the above could be written as:
print rejoin [ cls "^[[10;10HHello World!"]
Which is better readable than our first version, but has two disadvantages:
- words for the ascii strings clutter the global namespace
- we can't do positioning strings like that, because the position has to be added into the ASCII sequence.
Next take:
we'll create a single function, with refinements for every ASCII command, like this:cursor1: func [
"Positions the cursor"
/clear "clears the screen"
/pos "sets cursor to position row, col"
posi [pair! ]
/local ret
] [
pre: copy "^(1B)["
any [
all [
clear ret: join pre "J"
]
all [
pos ret: join pre rejoin [
posi/x ";" posi/y "H"
]
]
]
ret
]
Now we can write our little "Hello World" message this way:
print rejoin [cursor1/clear cursor1/pos 10x10 "Hello World!" ]
What I didn't like about it, that was the "/" notation used, so I decided to settle to write a dialect to position the cursor.
A Cursor Positioning Dialect
Creating a dialect means, to create a now mini language, that can be used in a specialized environment within REBOL. This means, dialects are organized as blocks, which are not treated by the normal REBOL interpreter, but by an interpreter written in REBOL.
O.K. first what we'll gain:
print cursor2 [clear pos 10x10 "Hello World!" ]
This will print exactly the same as the string we started with, but it is much easier to understand, and change later, should the need arise.
Have I got you interested? Well, of course, because otherwise you wouldn't have proceded until here...
How to do it
First we'll need a function, that accepts a block:
cursor2: func [
{Cursor positioning dialect (iho)}
commands [
block!
]
] [
]
Now we have to get this function interpret the block, this is best done with REBOLs block-parse ability:
cursor2: func [
{Cursor positioning dialect (iho)}
commands [
block!
]
] [
parse commands rules
]
And now all we need to do is fill in the rules ;-)
Let's proceed slowly, we have seen above, that we want to use specific words, to trigger output of the respective ASCII commands, let's give it a try:
rules: [
any [
'clear | 'at
]
]
Using this rule, our function will correctly parse a block containing any sequence of the words 'clear 'at:
cursor2: func [
{Cursor positioning dialect (iho)}
commands [
block!
]
/local rules
] [
rules: [
any [
'clear | 'at
]
]
parse commands rules
]
>> cursor2 [ clear at at clear at ]
== true
Nice, isn't it? But we need to be able to give the 'at command the actual coordinates to put the cursor, and, well, I'd like to be able to insert Text-strings right between the commands, so we need to parse looking for data-types: (While I'm only changing the rules block, I'll not print the whole function again ...)
rules: [
any [
'clear |
'at set arg pair! |
set arg string!
]
]
Now our dialect block can contain elements like
just the word 'clear
the word 'at, followed by a pair, this pair! will be saved into arg
strings
Let's give it a try again:
>> Cursor2 [ clear at 10x10 "Hi World!" ]
== true
Yup, so far it works, but now we want it to make some real output.
rules: [
any [
'clear (append string "^(1B)[J") |
'at set arg pair! (append string rejoin ["^(1B)[" arg/x ";" arg/y "H"]) |
set arg string! (append string arg)
]
]
Now, the part in parens is normal REBOL code, that gets executed, whenever the the part before it matches, now let's update our function with some things we need, and give it a try.
cursor2: func [
{Cursor positioning dialect (iho)}
commands [
block!
]
/local rules string arg
] [
string: copy "" ; Don't forget 'copy here ...
rules: [
any [
'clear (append string "^(1B)[J") |
'at set arg pair! (append string rejoin ["^(1B)[" arg/x ";" arg/y "H"]) |
set arg string! (append string arg)
]
]
parse commands rules
string
]
>> print Cursor2 [ clear at 10x10 "Hi World!" ]
Aaaahhhhh, it worked like a charm, here. Now, what have we done since the last time we looked at the function? We made some new words local, initialized an empty string, that holds the return value, and the last thing, we return this value. Great.
Now you could go ahead, read the REBOL documentation, and fill in words for other ASCII commands, but wait, I want to do some little fine-tuning, first.
Think about it, wouldn't it be nice, if we could include arbitrary REBOL Code within the dialect? Maybe like you want include a row of dashes, of computed length.
Let's add a command to repeat a given string:
rules: [
any [
'clear (append string "^(1B)[J") |
'at set arg pair! (append string rejoin ["^(1B)[" arg/x ";" arg/y "H"]) |
set cnt integer! set arg string! (append string head insert/dup copy "" arg cnt) |
set arg string! (append string arg)
]
]
Let's try:
>> print cursor2 [ clear 10 "-" ]
It works, but where's the promised REBOL Code support? Just a wee little moment of patience. Here it is, the 'command function. All we actually have to do is run the dialect block through compose first, like this:
cursor2: func [
{Cursor positioning dialect (iho)}
commands [
block!
]
/local rules string arg
] [
string: copy ""
commands: compose commands ; NEW LINE HERE
rules: [
any [
'clear (append string "^(1B)[J") |
'at set arg pair! (append string rejoin ["^(1B)[" arg/x ";" arg/y "H"]) |
set cnt integer! set arg string! (
append string head insert/dup copy "" arg cnt
) |
set arg string! (append string arg)
]
]
parse commands rules
string
]
>> x: 10x10
== 10x10
>> print cursor2 [ clear at (x) "Hello World!" at 11x10 (length? "Hello World!") "-" ]
What I am still missing, I want to know about the screen size, for some computation, can we add this, too? Sure.
To get the screen-size, we first have to print the ASCII command, and then read the data from the console port, and understand it, of course. Here's what I want to add to our dialect function:
; Don't forget to add 'screen-size to our functions locals
screen-size: (
; for Rebol Version 1.3
; c: open/binary [scheme: 'console]
; for later versions (changes in port handling)
c: open/binary/no-wait [scheme: 'console]
prin "^(1B)[7n"
arg: next next to-string copy c
close c
arg: parse/all arg ";R"
forall arg [change arg to-integer first arg]
arg: to-pair head arg
)
So, we're setting screen-size to what the whole parent expression evaluates to. That's,
- open port to the console
- print the ASCII command for "get screen dimension"
- get the return value (copy c)
- convert it to a string - this will be something like "^[[48;110R" - 48 lines, 110 columns wide
- skip the first two characters, and assign to arg
- close the port
- split the string, removing ";" and "R" - [ "48" "110" ]
- change those values into integers!
- and make a pair! from that block
Now we have the screen-dimensions as a block in 'screen-size, let's try it out:
>> print cursor2 [ clear (screen-size/y) "-" ]
** Script Error: screen-size has no value.
** Where: screen-size/y
That's not exactly what we wanted, is it? The problem here is, 'compose runs the code in the dialect in the global context, where screen-size isn't defined, because it's only local to cursor2. So we have to manually 'bind it to this functions context, to be able to access the value, it's done like this:
Change the line
commands: compose commands
to
commands: compose bind commands 'screen-size
This tells REBOL, whenever you find a word you don't understand while working on our command string, try to find it where you can find 'screen-size right now.
Time for a final version
This text is already much longer than I planned it, so maybe we should just have a look at the final version.
I included some more words in the dialect, and a limited error handling, but you'll see ...
cursor2: func [
{Cursor positioning dialect (iho)} [
catch
]
commands [
block!
]
/local screen-size string arg cnt cmd c err
] [
; get the size of the screen
screen-size: (
; for Rebol Version 1.3
; c: open/binary [scheme: 'console]
; for later versions (changes in port handling)
c: open/binary/no-wait [scheme: 'console]
prin "^(1B)[7n"
arg: next next to-string copy c
close c
arg: parse/all arg ";R"
forall arg [change arg to-integer first arg]
arg: to-pair head arg
)
; some setup
string: copy ""
; I added this little func, so I don't have to write the start
; of all the commands over and over
cmd: func [
s
] [
join "^(1B)[" s
]
; compose, so that () in the dialect gets reduced
; and catch any error within, then throw it again ...
if error? set/any 'err try [
commands: compose bind commands 'screen-size
] [
throw err
]
; ready to parse the dialect now (I included the rules block directly)
arg: parse commands [
any [
'direct set arg string! (append string arg) |
'home (append string cmd "H") |
'kill (append string cmd "K") |
'clear (append string cmd "J") |
'up set arg integer! (append string cmd [arg "A"]) |
'down set arg integer! (append string cmd [arg "B"]) |
'right set arg integer! (append string cmd [arg "C"]) |
'left set arg integer! (append string cmd [arg "D"]) |
'at set arg pair! (append string cmd [arg/x ";" arg/y "H" ]) |
'del set arg integer! (append string cmd [arg "P"]) |
'space set arg integer! (append string cmd [arg "@"]) |
'move set arg pair! (append string cmd [arg/x ";" arg/y "H" ]) |
set cnt integer! set arg string! (
append string head insert/dup copy "" arg cnt
) |
set arg string! (append string arg)
]
end
]
; ahh, maybe the user made an error when writing commands in
; the dialect? throw an error, then
if not arg [
throw make error! "Unable to parse block"
]
;return string to be printed
string
]
Maybe you wondered about the [catch] in the functions header (or maybe you didn't even notice), what does it do? Instead of trying to describe it, I'll show you the error messages of two cursor2 runs, once with, and once without catch:
Without [catch]
>> print cursor2 [ clear (screen-size/y) "-" x ]
** Throw Error: ** User Error: Unable to parse block.
** Where: throw make error! "Unable to parse block"
With [catch] included
>> print cursor2 [ clear (screen-size/y) "-" x ]
** User Error: Unable to parse block.
** Where: cursor2 [clear (screen-size/y) "-" x]
You see, without [catch] the call of 'throw is displayed as originator of the error, whereas including [catch] displays the call of the dialect as source of the error. I think the latter is much more understandable to the user.
Final thoughts
Creating a dialect is like creating a new language, so you have to be careful about what words you use, and about the grammar.
For example, I started out with 'pos for positioning the cursor, but settled for 'at at last. Because I got into trouble. Is 'pos used to get or set the position? If it sets the position, and I have get-pos for getting, why is there no set-pos? So, better use 'at and 'where, in my opinion.
Some rules: words should be,
- easy to remember
- hard to misunderstand
- short (?)
For the repeat string command, I haven't actually included a command, I wan't able to decide what to use
'repeat integer! string! (repeat 3 ".")
'repeat string! integer! (repeat "." 3)
'repeat string! 'x integer! (repeat "." x 3)
.
.
.
So I thought this is short, and understandable, and not likely to be misunderstood/misused.
And last, I return the string instead of printing it directly, this way you are free to save the string returned for later use, without the need to run the dialect again.
Monday, 23 January 2012
Text list
Making wonderful interfaces is easy with Rebol, if you are looking for text list with a more options and a better customization, you can add this script to yours:
http://www.rebol.org/view-script.r?script=change-text-lists.r
and the result will be like this demo:
Every function and style is well described in the script.
http://www.rebol.org/view-script.r?script=change-text-lists.r
and the result will be like this demo:
Every function and style is well described in the script.
Friday, 20 January 2012
Rebol as web application
The power of Rebol can be used also for web application. There are many languages for this purpose: PHP, Javascript, Ruby. But no other language is easy, complete and small as Rebol.
To install on a webserver you must download the rebol core version from here (just 300kb):
http://www.rebol.com/download-core.html
Then you can copy in your webserver, for example in /usr/bin/.
To use it you webserver must be configured to use CGI script (all webserver usually permit CGI scripts).
Now You are ready to write your first web application, like this: (call it example.cgi)
Now connect to your webserver, like www.myweb.com/example.cgi, and it'll appear on your browser like this:
The first 3 rows are mandatory:
To install on a webserver you must download the rebol core version from here (just 300kb):
http://www.rebol.com/download-core.html
Then you can copy in your webserver, for example in /usr/bin/.
To use it you webserver must be configured to use CGI script (all webserver usually permit CGI scripts).
Now You are ready to write your first web application, like this: (call it example.cgi)
#! /usr /bin /rebol-core -cs
Rebol [ title: "My first example" ]
print "Content-type: text/html^/"
print [ "REBOL CGI works!" "Time is: " now/time]
Now connect to your webserver, like www.myweb.com/example.cgi, and it'll appear on your browser like this:
The first 3 rows are mandatory:
- path to rebol core with option for CGI scripts
- Rebol header (rebol want it)
- HTML header (all webservers want it)
- http://www.rebol.com/docs/cgi1.html
- http://www.rebol.com/docs/cgi2.html
- http://www.rebol.com/docs/cgi-bbs.html
- http://www.rebol.com/docs/quick-start6.html
- http://www.rebol.com/docs/apache-cgi.html
- http://www.rebol.com/docs/fastcgi.html
- http://re-bol.com/cgi_tutorial.txt
- http://re-bol.com/rebol.html#section-9.9
- http://www.rebol.org/view-script.r?script=cgi-debug.r
- http://www.rebol.org/view-script.r?script=cgi.r
- http://www.rebol.org/view-script.r?script=cgicomment.r
- http://www.rebol.org/view-script.r?script=cgidump.r
- http://www.rebol.org/view-script.r?script=cgiemailer.r
- http://www.rebol.org/view-script.r?script=cgiemailhtml.r
- http://www.rebol.org/view-script.r?script=cgi-event-caledar.r
- http://www.rebol.org/view-script.r?script=cgiform.r
- http://www.rebol.org/view-script.r?script=cgiformhtml.r
- http://www.rebol.org/view-script.r?script=cgiformob.r
- http://www.rebol.org/view-script.r?script=cgi-ftp-folder-copy.r
- http://www.rebol.org/view-script.r?script=cgimail.r
Tuesday, 17 January 2012
"Le Compte Est Bon" game
"Le compt est Bon" ("the calculus is right") is a French game, the scope of the game is arriving to the target number using the number sequence with just the operator +,-,*,/ and the numbers or their results only one time.
I found this script that works good, but it's very hard to understand:
http://www.rebol.org/view-script.r?script=ceb.r
I tried to rewrite it in an easy way to understand, this is the result:
Here an example of how it works:
Can you find a more elegant solution? ;-)
I found this script that works good, but it's very hard to understand:
http://www.rebol.org/view-script.r?script=ceb.r
I tried to rewrite it in an easy way to understand, this is the result:
ceb: func [
"Find the way to reach the target number using the numbers in list"
list [ series! ]
target [integer! ]
/local op dv calculs nwlist
] [
text: reform [ "Series:" list ", target number:" target newline ]
sort list
kronos: now/time
op: [ + - * / ]
dv: func [ x y ] [
either all [( x <> 0 ) (y <> 0) ] [
either (x // y) = 0 [ x / y ] [ 0 ]
] [
0
]
]
;try to divide with no reminder, otherwise it returns zero
calculs: func [
x y
] [
reduce [
( x + y) ( x - y) ( x * y) (dv x y)
]
]
status: false
find-sol: func [
list text /local list2 list3 results
] [
if status [
exit
]
foreach item list [
if status [
break
]
list2: copy list
alter list2 item ;we remove the item from a copy of the list
foreach item2 list2 [
if status [
break
]
list3: copy list2
alter list3 item2 ;we remove the item2 from a copy of the list2
results: calculs item item2
for i 1 4 1 [
if status [
break
]
text2: append (copy text) (reform [item op/:i item2 "=" results/:i newline ])
if results/:i = target [
status: true print text2 print reform [
"time elapsed: " ( now/time - kronos )
]
]
list4: append (copy list3) results/:i ;add one of the reults to the list of numbers to use
if (length? list4) >= 2 [
find-sol list4 text2
]
]
]
]
]
find-sol list text
if status = false [
print "Sorry, I didn't find any solution."
]
]
Here an example of how it works:
>> ceb [ 1 2 3 4 ] 27
Series: 1 2 3 4 , target number: 27
2 * 4 = 8
1 + 8 = 9
3 * 9 = 27
time elapsed: 0:00
>> ceb [ 3 6 25 50 75 100 ] 698
Series: 3 6 25 50 75 100 , target number: 698
3 + 6 = 9
75 * 9 = 675
25 + 675 = 700
100 / 50 = 2
700 - 2 = 698
time elapsed: 0:00:18
Can you find a more elegant solution? ;-)
Tuesday, 10 January 2012
VID keycodes and shortcuts
Sometimes a GUI needs a key shortcuts, for example CTRL+S to save a file, how to do this job with Rebol?
It's easy, just use the key word:
The word keycode is used for more than one key or for special keys:
The CTRL button is represented with the letter pressed and the symbol ^:
Special key table:
If you need to intercept also SHIFT with CTRL, is possible, but a little more complicated; you need to use the event:
event/shift and event/control check SHIFT and CTRL keys
It's easy, just use the key word:
view layout [
text "Press A or B keys"
key #"a" [ alert "You pressed a"]
key #"A" [alert "You pressed A"]
key keycode [#"b" #"B"] [alert "You pressed b or B"]
]
The word keycode is used for more than one key or for special keys:
view layout [
text "Press PageUp or PageDown keys"
key keycode [page-up page-down] [alert "You pressed PageUp or PageDown"]
]
The CTRL button is represented with the letter pressed and the symbol ^:
view layout [
text "Press CTRL+S"
key #"^S" [alert "You pressed CTRL+S"]
]
Special key table:
Key | Code |
---|---|
Ins | insert |
Canc | #"^~" |
Home | home |
End | end |
PageUp | page-up |
PageDown | page-down |
Left arrow | left |
Right arrow | right |
Up arrow | up |
Down arrow | down |
Space | #" " |
TAB | #"^-" |
CTRL+S | #"^S" |
If you need to intercept also SHIFT with CTRL, is possible, but a little more complicated; you need to use the event:
view layout [
the-box: box "A Box" forest feel [
engage: func [face action event] [
if event/shift and (event/key = #"^S") [ print "You pressed CTRL+SIFT+S"]
]]
do [focus the-box]
]
event/shift and event/control check SHIFT and CTRL keys
Monday, 9 January 2012
Catch game
Here the source of a very simple game, move your brick using the arrows to touch the falling bricks:
You can use up and down arrow to change game speed. Please notice the use of key to assign a function to a keyboard key, and keycode to use special button like the arrows:
You can use up and down arrow to change game speed. Please notice the use of key to assign a function to a keyboard key, and keycode to use special button like the arrows:
REBOL [
title: "Catch Game"
date: 30-Apr-2010
file: %catch-game.r
author: Nick Antonaccio
purpose: {
A tiny game to demonstrate the basics of VID.
Taken from the tutorial at http://re-bol.com
}
]
alert "Arrow keys move left/right (up: faster, down: slower)"
random/seed now/time speed: 11 score: 0
view center-face layout [
size 600x440 backdrop white across
at 270x0 text "Score:" t: text bold 100 (form score)
at 280x20 y: btn 50x20 orange
at 280x420 z: btn 50x20 blue
key keycode [left] [z/offset: z/offset - 10x0 show z]
key keycode [right] [z/offset: z/offset + 10x0 show z]
key keycode [up] [speed: speed + 1]
key keycode [down] [if speed > 1 [speed: speed - 1]]
box 0x0 rate 0 feel [engage: func [f a e] [if a = 'time [
y/offset: y/offset + (as-pair 0 speed) show y
if y/offset/2 > 440 [
y/offset: as-pair (random 550) 20 show y
score: score - 1
]
if within? z/offset (y/offset - 50x0) 100x20 [
y/offset: as-pair (random 550) 20 show y
score: score + 1
]
t/text: (form score) show t
]]]
]
Thursday, 5 January 2012
Adress book
Here an example of a simple and effective address book:
Here the source code:
Here the source code:
REBOL [
title: "Card File"
date: 5-Mar-2010
file: %card-file.r
author: Nick Antonaccio
purpose: { This is the quintessential simple text field storage application. It can be used as shown here, to save contact information, but by adjusting just a few lines of code and text labels, it could be easily adapted to store recipes, home inventory information, or any other type of related pages of data. A version of this script with line-by-line documentation is available at http://re-bol.com }
]
write/append %data.txt ""
database: load %data.txt
view center-face gui: layout [
text "Load an existing record:"
name-list: text-list blue 400x100 data sort (extract database 4) [
if value = none [return]
marker: index? find database value
n/text: pick database marker
a/text: pick database (marker + 1)
p/text: pick database (marker + 2)
o/text: pick database (marker + 3)
show gui
]
text "Name:" n: field 400
text "Address:" a: field 400
text "Phone:" p: field 400
text "Notes:" o: area 400x100
across
btn "Save" [
if n/text = "" [alert "You must enter a name." return]
if find (extract database 4) n/text [
either true = request "Overwrite existing record?" [
remove/part (find database n/text) 4
] [return ]
]
save %data.txt repend database [n/text a/text p/text o/text]
name-list/data: sort (extract copy database 4)
show name-list
]
btn "Delete" [
if true = request rejoin ["Delete " n/text "?"] [
remove/part (find database n/text) 4
save %data.txt database
do-face clear-button 1
name-list/data: sort (extract copy database 4)
show name-list
]
]
clear-button: btn "New" [
n/text: copy ""
a/text: copy ""
p/text: copy ""
o/text: copy ""
show gui
]
]
Tuesday, 3 January 2012
New forum address
Here the new Rebol forum address:
http://synapse-ehr.com/community/forums/rebol.5/
http://synapse-ehr.com/community/forums/rebol.5/
Subscribe to:
Posts (Atom)