Friday, 30 December 2011

Console output

Reading console history is very easy, just read system/console/hystory, like this:

>> print "Hello, word!"
== "Hello, world!"
>> 2 + 2
== 4
>> probe system/console/history
== [ "2 + 2" {print "Hello, word!"}]


but how to register the console output?
It's easy using one of the most important rule of Rebol, word redefinition.
The only command that send output on the console are prin and print, so we can redefine these commands to store the output in a variable. See this example, where we store all console output in temp:

>> temp: copy []
>> print-bak: get 'print
>> prin-bak: get 'prin
>> print: func [value] [append temp (reform value)  print-bak value]
>> prin: func [value] [append  temp (reform value) prin-bak value]
>> ? print-bak
USAGE:
PRINT-BAK value

DESCRIPTION:
Outputs a value followed by a line break.
PRINT-BAK is a native value.

ARGUMENTS:
value -- The value to print (Type: any)

>> probe temp
== ["USAGE:^/^-" "PRINT-BAK " "value " "" "^/DESCRIPTION:" "^- Outputs a value followed by a line break. " "^- PRINT-BAK is a nati...

Wednesday, 28 December 2011

Captcha

What is a captcha? Is a tool to avoid automatic spam on forum, comment, or whatever field on our sites. The captcha show an image containing a letter sequence that only a human being can understand.
Here an example:
It's possible to use Rebol to create the random captcha images, you can find all script and example in this page:
http://softinnov.org/rebol/captcha.shtml

Friday, 23 December 2011

Spellcheck

Check spelling is an important feature, and Rebol has integrated in the RebGUI script, just hit CTRL+S in any text area and spell check wik start (remember to download the dictionaries...).
However, if you don't like RebGUI, there are a lot of open source programs that can be used. The most famous are Ispell and Aspell. You can use these programs to check spelling texts with Rebol.
I'll show you Aspell, that is more recent, but you can use any software.
First of all download Aspell for your platform from here:
ftp.gnu.org/gnu/aspell/w32/
and install also the dictionaries of your languages.
Then we need a phrase as example:
"Hello, this is Carl; a great warrrior!"
There is an error on warrrior, now let's try with Rebol:

a: "Hello, this is Carl; a great warrrior!"

we should split the original sentences in single words, and is very easy with Rebol:

>> b: parse a none
== ["Hello" "this" "is" "Carl" "a" "great" "warrrior!"]

Now we use Aspell and we create a file were every line is a word checked. If a line starts with *,the word is OK; else the line starts with a &, the word is misspelled and Aspeel gives the suggested word.

call/input " c:\Programmi\Aspell\bin\aspell.exe -a --lang=en > ./spellout.txt " a

The spellout file will be:

@(#) International Ispell Version 3.1.20 (but really Aspell 0.50.3)
*
*
*
*
*
*
& warrrior 10 30: warrior, warriors, warier, worrier, wearier, waterier, warrior's, wartier, wearer, barrio

Now let's show to the user that he misspelled some word:

c: read/lines %spellout.txt
foreach word b [
c: next c ; so we skip the first line with Aspell copyright
if (first c/1) = #"&" [ alert reform ["You misspelled:" word]]
]

This are the basis of spell-checking. If you want to see something better let's see this example:
view layout [
    a: area
    text "English spellcheck"
    button "Spellcheck" [
        call/input " c:\Programmi\Aspell\bin\aspell.exe -a --lang=en > ./spellout.txt " a/text
        b: parse a/text none
        c: read/lines %spellout.txt
        temp: copy a/text
        foreach word b [
            temp: copy (find/case temp word); so we traverse the text
            c: next c ; so we skip the first line with Aspell copyright
            if (first c/1) = #"&" [
                temp2: copy/part (find/case/tail temp word) 50
                view/new/title layout [
                    across
                    text bold red word
                    text 200 temp2
                    return
                    box black 200x2
                    return
                    text 200 reform ["Suggest words" (find c/1 ":")]
                ] "Spellcheck"
]]]]

It's just a simple example in 10 lines of code, but here is the result:

Wednesday, 21 December 2011

Calculator

There are a lot of calculator scripts, let's see them (in alphabetic order).


Calculator
It's a tiny calculator with just 30 lines of code:
Here the source:
REBOL [
    Title: "Calculator"
    Date: 2-Apr-2001
    Version: 1.2.0
    File: %calculator.r
    Author: "Jeff Kreis"
    Purpose: "Simple numeric calculator."
]
auto-clear: true
calculate: does [
    if error? try [text-box/text: form do text-box/text][
        text-box/text: "Error"
        text-box/color: red
    ]
    auto-clear: true
    show text-box
]
calculator: layout [
    style btn button 40x24
    style kc btn brick [text-box/text: copy "0" auto-clear: true show text-box]
    style k= btn [calculate]
    style k   btn [
        if auto-clear [clear text-box/text text-box/color: snow auto-clear: false]
        append text-box/text face/text
        show text-box
    ]
    origin 10
    backcolor rebolor
    space 4
    text-box: field "0" 172x24 bold snow right feel none
    pad 4
    across
    kc "C" keycode [#"C" #"c" page-down]
    k "(" #"("   k ")" #")"   k " / " #"/" return
    k "7" #"7"   k "8" #"8"   k "9" #"9"   k " * " #"*" return
    k "4" #"4"   k "5" #"5"   k "6" #"6"   k " - " #"-" return
    k "1" #"1"   k "2" #"2"   k "3" #"3"   k " + " #"+" return
    k "0" #"0"   k "-"       k "." #"."
    k= "=" keycode [#"=" #"^m"] return
    key keycode [#"^(ESC)" #"^q"] [quit]
]
view center-face calculator

Calculator tutorial
It's a demo made by Nick Antonaccio:
Here the source (always no more than 30 lines of code):
REBOL [
    title: "calculator"
    date: 28-feb-2009
    file: %calculator-tutorial.r
    purpose: {
        A little GUI calculator example, with printout.  
        Taken from the tutorial at http://musiclessonz.com/rebol_tutorial.html
    }
]
prev-val: cur-val: 0 cur-eval: "+" display-flag: false
print "0"
view center-face layout/tight [
    size 300x350 space 0x0 across
    display: field 300x50 font-size 28 "0" return
    style butn button 100x50   [
        if display-flag = true [display/text: "" display-flag: false]
        if display/text = "0" [display/text: ""]
        display/text: rejoin [display/text value]
        show display
        cur-val: display/text
    ]
    style eval button 100x50 brown font-size 13 [
        prev-val: cur-val
        display/text: "" show display
        cur-eval: value
    ]
    butn "1"   butn "2"   butn "3"   return
    butn "4"   butn "5"   butn "6"   return
    butn "7"   butn "8"   butn "9"   return
    butn "0"   butn "."   eval "+" return
    eval "-" eval "*" eval "/" return
    button 300x50 gray font-size 16 "=" [
        if display-flag <> true [
            if ((cur-eval = "/") and (cur-val = "0")) [
                alert "Division by 0 is not allowed." break
            ]
            prin rejoin [prev-val " " cur-eval " " cur-val " = "]
            print display/text: cur-val: do rejoin [prev-val " " cur-eval " " cur-val ]
            show display
            display-flag: true
        ]
    ]
]

Desktop Calculator
It's a small calculator:
Here the source (70 lines):
REBOL [
    Title: "Desk Calculator"
    Date: 4-Oct-2004
    Version: 1.3.0
    File: %desk-calc.r
    Author: "Ryan S. Cole"
    Purpose: "A tool for simple calculations."
    Comment: "Standard function calculator."
    Email: ryan@skurunner.com
]
acc:         ; Accumulator
op:         ; Selected operation
mem:         ; Memory storage
err: none   ; Error state
reg: []     ; Register stack

; For working with the displayed number...
cur-str: does [any [reg/1 acc form 0]]
cur-num: does [to-decimal cur-str]
cur-set: func [val] [
    either not either op [reg/2][reg/1] [insert reg form val] [reg/1: form val]
]
; Updates the screen...
display: does [
    if not find lcd/text: copy cur-str "." [append lcd/text "."]
    err-flag/font/color: either err [yellow][gray]
    mem-flag/font/color: either mem [green][gray]
    show [lcd err-flag mem-flag]
]
; Does the equation...
solve: does [
    if not reg/2 [insert reg reg/1]
    acc: none
    if op [err: error? try [acc: form do reform [reg/2 op 'to-decimal reg/1]]]
    reg: copy []
    op: none
]
; Handles keypresses
press: func [key] [
    err: no
    if find ".0123456789" key [
        if not either op [reg/2][reg/1] [insert reg copy ""]
        if all ["." = key   find reg/1 key] [exit]
        either all [reg/1 = "0"   key <> "."] [reg/1: copy key] [append reg/1 key]
    ]
    if find "+-*/" key [
        if reg/2 [solve]
        if not reg/1 [insert reg cur-str]
        op: key
    ]
    switch key [
        "C" [acc: op: none reg: copy []]
        "E" [remove reg op: acc: none]
        "±" [cur-set negate cur-num]
        "MC" [mem: none]
        "MR" [cur-set any [mem 0]]
        "M+" [mem: add any [mem 0] cur-num]
        "M-" [mem: subtract any [mem 0] cur-num]
        "pi" [cur-set pi]
        "=" [solve]
    ]
]
; Construct the screen...
view layout compose [
    backdrop effect [gradient 0x1 85.155.205 80.130.180]
    origin 10x10 space 0x0 pad 0x10 across
    style text text 15x20 bold gray  
    mem-flag: text "M"
    err-flag: text "E"
    pad 5x0   space 5x5
    lcd: field "0." silver 170x20 right bold feel none
    return
    style k (pick [btn button] link?) 30x20 [press face/text display]
    k #"C" "C"   k "MC"   k #"7" "7"   k #"8" "8"   k #"9" "9"   k #"/" "/" return
    k #"E" "E"   k "MR"   k #"4" "4"   k #"5" "5"   k #"6" "6"   k #"*" "*" return
    k #"p" "pi"   k "M+"   k #"1" "1"   k #"2" "2"   k #"3" "3"   k #"+" "+" return
    k #"i" "±"   k "M-"   k #"0" "0"   k #"." "."   k #"=" "="   k #"-" "-"
    keycode #"^M" [press "=" display]
]                        

Mini calc
It's really a mini calculator:
Here the source (30 lines):
REBOL [
    Title: "Mini-Calculator"
    Date: 6-Mar-2002
    Version: 1.1.3
    File: %mini-calc.r
    Author: "Ryan Cole"
    Purpose: "Tiny calculator example."
    Email: ryancole@usa.com
]
reg: []
op: no

do solve: does [
    acc: none
    if op [error? try [acc: do reform [any [reg/2 acc 0] op 'to-decimal reg/1]]]
    reg: copy []
    op: no
]
calc: func [key] [
    if find ".0123456789" key [
        if none? pick reg not op [insert reg copy ""]
        if not all ["." = key   find reg/1 key] [append reg/1 key]
    ]
    if find "+-*/" key [
        if reg/2 [solve]
        any [reg/1 insert reg any [acc 0]]
        op: key
    ]
    if key = "=" [solve]
]
view layout [
    origin 0x0 space 0x0 across
    lcd: field "0." silver 140x22 right feel none
    return
    style k button 35x25 [
        calc face/text
        if not find lcd/text: form any [reg/1 acc 0] "." [append lcd/text "."]
        show lcd
    ]
    k "7" k "8" k "9" k "/" return
    k "4" k "5" k "6" k "*" return
    k "1" k "2" k "3" k "-" return
    k "0" k "." k "=" k "+"
]                                              

Scientific calculator
It's a scientific calculator, it reduce conde lenght because it uses the calculase dialect/script:
Here the source (40 lines):
REBOL [
    Title: "Scientific Calculator"
    Date: 16-Mar-2002
    Version: 0.9.5
    File: %sci-calc.r
    Author: ["Ryan S. Cole" "Massimiliano Vessi"]
    Purpose: {For scientific calculations.   Currently in beta, so dont use it to figure out critical information just yet.}
    Email: [ryanc@iesco-dms.com   maxint@tiscali.it]
]
if not exists? %calculese.r [
    temp: read http://www.rebol.org/download-a-script.r?script-name=calculese.r
    write temp %calculese.r
    ]
   
do %calculese.r
; depth of stack shown in parens
depth: has [fathoms] [
    fathoms: copy ""
    loop length? calc-engine/stack [append fathoms "'"]
    return fathoms
]
view layout [
    backdrop effect [gradient 0x1 74.74.74 32.32.32]
    origin 6x6 space 3x3
    lcd: field "0." 262x32 right bold silver feel none font-size 22
    across
    style k button gray 50x20 [
        lcd/text: calculese face/text
        lcd/effect: compose/deep [pen 0.0.0 draw [text 2x19 (depth)]]
        show lcd
    ]
    style r k brick
    style g k leaf
    style o k orange
    style s k sienna
    style t k teal
    style a k aqua
    style b k tan
    r "CE" b "and" b "or" b "xor" b "not" return
    r "AC" a "arcsin" a "arccos" a "arctan" a #"p" "pi" return
    g "M÷" a "sin" a "cos" a "tan" a "abs" return
    g "M×" a "exp-e" a "log-10" a "log-2" a "log-e" return
    g "M-" a "mod" a "sqr" a "exp" a "¹/x" return
    g "M+" a #"±" "±" a #"r" "rnd" a "²" a "³" return
    g "MR" k #"7" "7" k #"8" "8" k #"9" "9" t #"/" "÷" return
    g "MC" k #"4" "4" k #"5" "5" k #"6" "6" t #"*" "×" return
    s #"(" "(" k #"1" "1" k #"2" "2" k #"3" "3" t #"-" "-" return
    s #")" ")" k #"0" "0" k #"." "." o #"^M" "="   t #"+" "+"
]                                                

Supercalculator
It's a scientific calculator with history, configuration and session. All it's stored in ".supercalculator.conf" file:
Suorce code is about 200 lines, because it doesn't use any calculus lib, but it uses the RebGUI lib. You can download the script here:
http://www.rebol.org/view-script.r?script=supercalculator.r

Monday, 19 December 2011

Developer Conference 2012

In the weekend of 3 and 4 march, we will organise a DevCon for the REBOL family of programming languages in the "De War" Kleine Koppel 40, 3812 PH, Amersfoort in the Netherlands. Which is ten to fifteen minutes walking from Amersfoort Central Station.
To get an impression of the previous conference see here
http://reborcon.esperconsultancy.nl/
"De War" alongside the river "Eem" in the neighboorhood of the Koppelpoort on OpenStreetMap:
http://www.openstreetmap.org/?mlat=52.1628&mlon=5.3768&zoom=14&layers=M
Amersfoort Central Station is one of the largest railway junctions in the country.
http://en.wikipedia.org/wiki/Amersfoort
http://en.wikipedia.org/wiki/Koppelpoort
http://en.wikipedia.org/wiki/Eem

Amersfoort is also the birthplace of painter Piet Mondriaan. As a result of that you can visit the Mondriaan House:
http://en.wikipedia.org/wiki/The_Mondriaan_House

Nenad will be giving a workshop about Red. Kaj wil present his bindings. Other REBOL-related subjects are welcome?
Contact bas@esperconsultancy.nl

SQLite

SQLite is SQL database engine small and ready to use. There are many Rebol scripts that handle SQLite, if you don't know this light SQL engine, you should visit:
http://www.sqlite.org/

The first script  I'll show you  is the following:
http://www.rebol.org/view-script.r?script=btn-sqlite.r

you have to put sqlite executable in the same directory of the script (Windows) or in /usr/bin/ (Linux). It's slow but it works this way:

>> do %btn-sqlite.r
>> db: open btn://localhost/test.db3
>> insert db "CREATE TABLE t1 (a int, b text, c text)"
== true
>> repeat i 25 [
[ insert db [{INSERT INTO t1 VALUES (?, ?, ?)} i (join "cool" i) (join "cool"
(25 + 1 - i))]
[ ]
== true
>> insert db "SELECT * FROM t1"
== true
>> probe db/locals/columns
["a" "b" "c"]
== ["a" "b" "c"]
>> res: copy/part db 10
== [["1" "cool1" "cool25"] ["2" "cool2" "cool24"] ["3" "cool3" "cool23"] ["4" "coo
l4" "cool22"] ["5" "cool5" "cool21"] ["6" "cool6"...
>> probe res
[["1" "cool1" "cool25"] ["2" "cool2" "cool24"] ["3" "cool3" "cool23"] ["4" "cool4"
"cool22"] ["5" "cool5" "cool21"] ["6" "cool6" "cool20"] ["7" "cool7" "cool19"] ["
8" "cool8" "cool18"] ["9" "cool9" "cool17"] ["10" "cool10" "cool16"]]
== [["1" "cool1" "cool25"] ["2" "cool2" "cool24"] ["3" "cool3" "cool23"] ["4" "coo
l4" "cool22"] ["5" "cool5" "cool21"] ["6" "cool6"...
>> probe length? res
10
== 10
>> insert db "DROP TABLE t1"
== true
>> close db


The second script is a little bit complex, you have to download the DLL or the Linux library in the script folder, then you can download the following script:
http://www.rebol.org/view-script.r?script=sqlite3.r

modify the script with the correct path to your sql3 library
Windows
sql: load/library %sqlite3.dll
or Linux
sql: load/library %libsqlite3.so
Here how it works:

>> db: sqlite-open %test.db
== 16121296
>> sqlite-exec db "CREATE TABLE t1 (a int , b text , c text);"
== []
>> sqlite-exec db "CREATE TABLE t2 (a int , b text , c text);"
== []
>> ; Testing of 1000 inserts one transaction at a time.
>> t: now/time/precise
== 12:14:23.765
>> repeat i 1000 [ sqlite-exec db reduce [{INSERT INTO t1 VALUES (?,"cool1","cool1");} i]
== []
>> delta: now/time/precise - t
== 0:02:22.422
>> print join "elapsed time = " delta
elapsed time = 0:02:22.422
>> ; Testing of 1000 inserts in one global transaction.
>> t: now/time/precise
== 12:26:49.687
>> sqlite-exec db "begin transaction;"
== []
>> repeat i 1000 [ sqlite-exec db reduce [{INSERT INTO t2 VALUES (?,"cool2","cool2");} i]
== []
>> sqlite-exec db "commit transaction;"
== []
>> delta: now/time/precise - t
== 0:00:00.281
>> print join "elapsed time = " delta
elapsed time = 0:00:00.281
>> ; Select now all data from both tables.
>> ;Just go through "res" block if you want to see the results.

>> res: copy []
== []
>> t: now/time/precise
== 12:29:49.875
>> repeat i 1000 [
insert tail res sqlite-exec/names db reduce ["SELECT * FROM t1 WHERE a=?;" i]
insert tail res sqlite-exec/names db reduce ["SELECT * FROM t2 WHERE a=?;" i]
]
== []
>> delta: now/time/precise - t
== 0:00:04.828
>> print join "elapsed time = " delta
elapsed time = 0:00:04.828
>> sqlite-close db


Then you can attach more databases in a single database, Robert Paluch, alias BobikCZ, shows us how to do it:

do %sqlite3.r ;; load sqlite driver
db: sqlite-open %myfirstdb.db ;; open first db file
sqlite-exec db {attach database 'myseconddb.db' as myseconddb} ;; attach my second db file
res: sqlite-exec db {select * from myseconddb.mytable} ;;resulting select etc..
;; there can be use also joins of tables


If you need to use SQLite over internet, you can with this script:
http://www.rebol.org/view-script.r?script=techfell-protocol.r
Here how it works:

db: open techfell://user:password@webhost.com
insert db "CREATE TABLE t1 (a int, b text, c text)"
repeat i 25 [
insert db [{INSERT INTO t1 VALUES (?, ?, ?)} i (join "cool" i) (join "cool" (25 + 1 - i))]
]
insert db "SELECT * FROM t1"
probe db/locals/columns
res: copy/part db 10
probe res
probe length? res
insert db "DROP TABLE t1"
close db

Friday, 16 December 2011

Buttons

Here a sample script for buttons:




REBOL [
Title: "Piles of Button Styles"
Date: 20-May-2000
Version: 1.1.0
File: %buttons.r
Author: "Carl Sassenrath"
Purpose: {Displays 52 button styles out of the hundreds possible.}
]
flash "Fetching image..."
pic: load-thru/binary http://www.rebol.com/view/palms.jpg
unview
group: ["rotary" "test" "button"]
view layout [
origin 20x10
backdrop effect [gradient 0x1 100.20.0]
vh1 "52 Button Click-up - Each with a different click effect..."
vtext bold "Here is a small sampling of the thousands of button effects you can create. (This is 78 lines of code.)"
at 20x80 guide
button "simple"
button form now/date
button "colored" 100.0.0
button "text colored" font [colors: [255.80.80 80.200.80]]
button with [texts: ["up text" "down text"]]
button "bi-colored" colors [0.150.100 150.20.20]
button with [texts: ["up color" "down color"] colors: [0.150.100 150.20.20]]
button "image" pic
button "color image" pic 200.100.50
button "flip color" pic with [effects: [[fit colorize 50.50.200][fit colorize 200.50.50]]]
button "blink" with [rate: 2 colors: [160.40.40 40.160.40]]
return
button "multiply" pic with [effects: [[fit][fit multiply 128.80.60]]]
button "brighten" pic with [effects: [[fit][fit luma 80]]]
button "contrast" pic with [effects: [[fit][fit contrast 80]]]
button "horiz flip" pic with [effects: [[fit][fit flip 1x0]]]
button "vert reflect" pic with [effects: [[fit][fit reflect 0x1]]]
button "invert" pic with [effects: [[fit][fit invert]]]
button "vert grad" with [effects: [[gradient 0x1 0.0.0 0.200.0] [gradient 0x1 0.200.0 0.0.0]]]
button "horiz grad" with [effects: [[gradient 1x0 200.0.0 200.200.200][gradient 1x0 200.200.200 200.0.0]]]
button "both grad" with [effects: [[gradient 1x0 140.0.0 40.40.200] [gradient 0x1 40.40.200 140.0.0]]]
button "blink grad" with [rate: 4 effects: [[gradient 1x0 0.0.0 0.0.200] [gradient 1x0 0.0.200 0.0.0]]]
button "blink flip" pic with [rate: 8 effects: [[fit][fit flip 0x1]]]
return
button "big dull button with several lines" 100x80 0.0.100
button "dual color" pic 50.50.100 100.50.50 100x80 with [edge: [color: 80.80.80]]
button "big edge" pic 100x80 with [edge: [size: 5x5 color: 80.80.80] effects: [[fit colorize 50.100.50][fit]]]
button "oval reflect" pic 50.100.50 100x80 with [effect: [fit reflect 1x0 oval]]
return
button "text on top" pic 100x80 with [font: [valign: 'top] effects: [[fit gradcol 1x1 200.0.0 0.0.200] [fit gradcol -1x-1 200.0.0 0.0.200]]]
button "text on bottom" pic 100x80 50.50.100 with [font: [valign: 'bottom] effects: [[fit][fit invert]]]
button "big text font" pic 100x80 with [font: [size: 24] effects: [[fit multiply 50.100.200][fit]]]
button "cross flip" pic 50.100.50 100x80 with [effect: [fit flip 0x1 reflect 0x1 cross]]
return
toggle "toggle"
toggle "toggle red" 100.0.0
toggle "toggle up" "toggle down"
toggle "toggle colored" 0.150.100 150.20.20
toggle "up color" "down color" 0.150.100 150.20.20
toggle "toggle multiply" pic with [effects: [[fit][fit multiply 128.80.60]]]
toggle "toggle contrast" pic with [effects: [[fit][fit contrast 80]]]
toggle "toggle cross" pic with [effects: [[fit][fit cross]]]
toggle "toggle v-grad" with [effects: [[gradient 0x1 0.0.0 0.200.0] [gradient 0x1 0.200.0 0.0.0]]]
toggle "toggle h-grad" with [effects: [[gradient 1x0 200.0.0 200.200.200][gradient 1x0 200.200.200 200.0.0]]]
toggle "toggle both" with [effects: [[gradient 1x0 140.0.0 40.40.200] [gradient 0x1 40.40.200 140.0.0]]]
return
rotary data group
rotary data reduce [now/date now/time]
rotary data group 100.0.0 0.100.0 0.0.100
rotary data group with [font: [colors: [255.80.80 80.200.80]]]
rotary data group with [colors: [0.150.100 150.20.20]]
rotary data group pic
rotary data group pic 200.100.50
rotary data group pic with [effects: [[fit colorize 50.50.200][fit colorize 200.50.50]]]
rotary data group with [effects: [[gradient 0x1 0.0.0 0.200.0] [gradient 0x1 0.200.0 0.0.0]]]
rotary data group with [effects: [[gradient 1x0 200.0.0 200.200.200][gradient 1x0 200.200.200 200.0.0]]]
rotary data group with [effects: [[gradient 1x0 140.0.0 40.40.200] [gradient 0x1 40.40.200 140.0.0]]]
]

Friday, 9 December 2011

Examples

Here you can find a lot of examples:
http://re-bol.com/examples.txt


Rebol Examples ( 7-21-10)

Bingo

Here you can find the link for a Bingo table to use as main screen for number extraction:
http://www.rebol.org/view-script.r?script=bingo.r
Screenshot:

If you click on the money, you can change the text; if you click on the image, you can change it.

Wednesday, 7 December 2011

Transferring files over internet

I was reading this script of Nick Antonaccio here:
http://www.rebol.org/view-script.r?script=binary-file-transfer.r

And I was mazed how is simple to send files with Rebol, here how it works:
First of all the receiver PC start to hear on TCP port 8 (but you can choose any port you wish:

; server/receiver - run first:
if error? try [port: first wait open/binary/no-wait tcp://:8] [quit]
mark: find file: copy wait port #""
length: to-integer to-string copy/part file mark
while [length > length? remove/part file next mark] [append file port]
view layout [image load file]


Then the sender crate and send the image:
; client/sender - run after server (change IP address if using on 2 pcs):
save/png %image.png to-image layout [box blue "I traveled through ports!"]
port: open/binary/no-wait tcp://127.0.0.1:8   ; adjust this IP address
insert file: read/binary %image.png join l: length? file #""
insert port file


and here the result:



There are just few lines of code, and this way you can transfer any file (music, videos, images, text, whatever) trough internet. Amazing!
You can learn more here: http://www.rebol.net/cookbook/recipes/0058.html

Tuesday, 6 December 2011

Using bitmap font

If you use DRAW dialect to create drawings with text like this:

view layout [
box black 100x100 effect [
draw [
pen red
line 30x30 50x20 70x70 40x50
pen blue
box 20x20 80x80
fill-pen 0.100.0
box 20x60 40x80
pen white
text 8x25 "Example"
fill-pen gold
flood 2x2 ]]]

You should obtain this result:
Sometime it happens that under Linux and MacOS you don't see the text Example.

LINUX SOLUTION
Under Linux it's easy to avoid font problems just declares the font to use (Example FreeSans.ttf):
my-font: make face/font [
name: "/usr/share/fonts/truetype/freefont/FreeSans.ttf"
with your path to font you want to use
size: 12]

and then

view layout [ box black 100x100 effect [
draw [
font my-font
line 30x30 50x20 70x70 40x50
text 8x25 "Now it works!"]]]


If you want your script cross-platform, you can set the lines just if the OS is Linux:

;check OS
switch system/version/4 [
4 [ ; it's Linux ]
3 [ ;it's Windows ]
2 [;it's MacOS X ]
]


USING BITMAP FONT (UNIVERSAL SOLUTION)
Another solution works for every OS: using the bitmap font. If you load your preferred bitmap font, your texts will be transformed in transparent images that you can use in VID, DRAW or wherever you like.
You can download the script from here:
http://www.rebol.org/view-script.r?script=bdf-font-library.r
If you run the script as is, the example will pop-up:
Comment the last line to avoid this behavior.
You may convert font from OpenType to BDF by  otf2bdf.
How to use:

  1. Load the font you want to use, in BDF format
  2. Create the transparent image(s) with you font and text
  3. Put them wherever you like
Example, with tektite font:

>> a: read %tektite.bdf
>> my-font: make bdf-font [ parse-font a ]
>> my-text: my-font/render "Hello world!"
>> view layout [image my-text ]

You can use the image both in VID and in DRAW!!!

Friday, 2 December 2011

Big numbers

Rebol can works with integers number to 9 digits, this means that you can write:

>> -999999999
== -999999999
>> 999999999
== 999999999

If you digit a bigger number is automatically transformed in a decimal precision number. Decimal numbers has 15 digits of precision:

>> 12345678901234567890123456789
== 1.23456789012346E+28


This behavior is normal, it's difficult to preform calculus that need more than 15 digits. For example in engineering field no more than 3-4 digits is necessary.
However it can be useful working with big integers, like indexing of pages, databases, etc.
Rebol can manipulate any longer integer, if you need it; just transform the number in a string and use the following script:

rebol [
Author: [ "Alban Gabillon"   "Massimiliano Vessi" ]
  Library: [
        level: 'intermediate
        platform: 'all
        type: tool
        domain: [math]
        tested-under: windows
        support: none
        license: none
        see-also: none
        ]
    History: [
        [1.0 22-mar-2007 "First version"]
        [2.1 29-11-2011 "Now it's more human usable"]
        ]
    Title:       "Bignumbers.r"
    File:   %bignumbers.r
    Owner:       "Alban Gabillon"
    Version:         2.1.0
    Date:       22-Mar-2007
    Purpose: {
    This script allows you to apply the four classical operations (big-add, big-subtract, big-divide, big-multiply) on very big positive integers.
    Size of the integers is only limited by the size of a rebol string since numbers are represented as strings.   }]
big-add: func [
    {add two big numbers }
    n1 [string!]
    n2 [string!]
    /local mem plus n result][
    n1: reverse copy n1
    n2: reverse copy n2
    mem: 0
    result: copy ""
    if (length? n1) < (length? n2) [n: n1 n1: n2 n2: n]
    while [not tail? n2][
        plus: to-string ((to-integer to-string n1/1) + (to-integer to-string n2/1) + mem)
        either (length? plus) = 1 [mem: 0 result: insert result plus/1][mem: 1 result: insert result plus/2]
        n1: next n1
        n2: next n2
        ]
    while [  not tail? n1][
        plus: to-string ((to-integer to-string n1/1) + mem)
        either (length? plus) = 1 [mem: 0 result: insert result plus/1][mem: 1 result: insert result plus/2]
        n1: next n1
        ]
    either mem = 1 [insert result #"1"][insert result copy n1]
    result: head result
    return  result
    ]
big-multiply: func   ["multiply two big numbers" n1 [string!] n2 [string!] /local temp ] [
    n1: reverse   copy n1
    n2: copy n2
    temp:   copy "0"
    foreach item n1 [      
        for i 1 (to-integer to-string item) 1 [                    
            temp: big-add   temp   n2        
            ]  
        append n2 "0"      
        ]  
    return temp
    ]
big-greater: func [
    {compare two bignumbers:
    return true if n1 > n2
    return false if n1 < n2
    return none if n1 = n2
    }

    n1 [string!]
    n2 [string!]][
    n1: reverse copy n1
    n2: reverse copy n2
    either (length? n1) <> (length? n2) [(length? n1) > (length? n2)][
        either equal? n1 n2 [none][
            n1: back tail n1
            n2: back tail n2
            while [n1/1 = n2/1][n1: back n1 n2: back n2]
            n1/1 > n2/1
            ]
        ]
    ]
big-sub: func [
    {substract the smallest big number from the largest one }
    n1 [string!]
    n2 [string!]
    /local mem minus n result][
    if big-greater n2 n1 [n: n1 n1: n2 n2: n]
    n1: reverse copy n1
    n2: reverse copy n2
    mem: 0
    result: copy ""
    while [not tail? n2][
        minus: to-string (((to-integer to-string n1/1) - mem) + (10 - (to-integer to-string n2/1)))
        either (length? minus) = 1 [mem: 1 result: insert result minus/1][mem: 0 result: insert result minus/2]
        n1: next n1
        n2: next n2
        ]
    while [all[mem = 1 not tail? n1]][
        minus: to-string ((to-integer to-string n1/1) + (10 - mem))
        either (length? minus) = 1 [mem: 1 result: insert result minus/1][mem: 0 result: insert result minus/2]
        n1: next n1
        ]
    insert result copy n1
    result: back tail result
    while [all [result/1 = #"0" not head? result]][result: back result]
    clear next result
    result: head result
    return reverse result
    ]
big-divide: func [
    {divide two big numbers   -
    output is a block of two numbers [quotient remainder]}

    n1 [string!]
    n2 [string!]
    /local   count   ][
        n1: copy n1 ;this avoid to modify the original block
        if big-greater n2 n1 [return reduce ["0" n1]] ;obvius
        if equal? n1 n2 [return reduce ["1" "0"]] ;obvius  
        count: "0"
        while [big-greater n1 n2 ] [
            n1: big-sub n1 n2
            count: big-add count "1"
            ]
        if equal? n1 n2 [
            count: big-add count "1"
            n1: "0"
            ]
        return   reduce [count n1]
        ]



It can be used this way (now I'll use small number as example):

>> big-add "253" "2"
== "255"
>> big-sub "253" "2"
== "251"
>> big-multiply "253" "2"
== "506"
>> big-divide "253" "2"
== ["126" "1"]


Real world examples:

>> big-add "123456789012345678901234567890" "123456789012345678901234567890"
== "246913578024691357802469135780"
>> big-sub "123456789012345678901234567890" "123456789012345678901234567890"
== "0"
>> big-multiply "123456789012345678901234567890" "123456789012345678901234567890"
== {15241578753238836750495351562536198787501905199875019052100}
>> big-divide "123456789012345678901234567890" "123456789012345678901234567890"
== ["1" "0"]

Monday, 28 November 2011

Brainfuck converter

Yes, it exists. Brainfuck is programming language made of only the following chars: +, -, <, >, [, ].
But you can do every function you need, see: http://en.wikipedia.org/wiki/Brainfuck 
This is the source:


REBOL [
    Title:   "Brainfuck"
    Author: "John Niclasen"
    Date:   21-Mar-2009
    File:   %bf.r
    Purpose: {
        REBOL implementation of this language: http://en.wikipedia.org/wiki/Brainfuck
        bf is 232 bytes compressed (see end of script).
    }
]
bf: func [s] [
    p: make string! 3e4
    insert/dup p #{00} 3e4
    while [not tail? s] [
        switch s/1 [
            #">"     [p: next p s: next s]
            #"<"     [p: back p s: next s]
            #"+"     [p/1: either p/1 = 255 [#{00}][p/1 + 1] s: next s]
            #"-"     [p/1: either p/1 = 0 [#{ff}][p/1 - 1] s: next s]
            #"."     [prin p/1 s: next s]
            #","     [change p input s: next s]
            #"["     [
                if p/1 = 0 [
                    c: 1
                    until [
                        switch first s: next s [
                            #"["     [c: c + 1]
                            #"]"     [c: c - 1]
                        ]
                        c = 0
                    ]
                ]
                s: next s
            ]
            #"]"     [
                c: 1
                until [
                    switch first s: back s [
                        #"]"     [c: c + 1]
                        #"["     [c: c - 1]
                    ]
                    c = 0
                ]
            ]
        ]
    ]
]

or the same script compressed:

Rebol []
bf: do decompress #{
789C7590DD6E83300C855FC50B97FD01D6F506F5E741AC5CB02C2956698A8851
2B4D7BF739199BA0EA72E5F8F83B398E1BBCC1A0B1ABE0529F2D04EEC99F5E60
63DF807CB03DE71F43071D649F45F195DAB7865A8BFECAC035B547103ADC884D
03212F31530715DDBCBDB36061AC82CED42E09EFB5393F080B11F2B2024BDCD8
1EA4863DBC6EB7981ED5518405947ACAAC9E318510CE8DC4EA81580B21CBA5D1
697FA9D034B53F594945BE1B78A6A242727FF6A6821206CFD4FEEEECA80F1302
1321632625CE941E6F318D36D144CF52FDE8FF99A6CF8AA67A668A4F4CE57C03
F00D8B8FCD010000
}



And this is what you can do with the bf function:

bf {++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.}

Hello World!

Wednesday, 23 November 2011

Super mastermind

Do you remember the old "Mastermind" game? Well, you can download a Rebol version from here:
http://www.maxvessi.net/rebsite/supermastermind.r

Friday, 18 November 2011

Url shortening

A lot of sites today give the free opportunity to shorten web site urls, for example:
http://www.amazon.com/Kindle-Wireless-Reading-Display-Globa lly/dp/B003FSUDM4/ref=amb_link_353259562_2?pf_rd_m=ATVPDKIK X0DER&pf_rd_s=center-10&pf_rd_r=11EYKTN682A79T370AM3&pf_rd_ t=201&pf_rd_p=1270985982&pf_rd_i=B002Y27P3M

turn this way:
http://tinyurl.com/KindleWireless

How does it works?
Usually the url is recorded in a database and is assigned a number (132), then the number is converted in base58  (i.e using the following "human" characters   "123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ").
It's possible to obtain this with Rebol with very few lines (thank to Ross-Gill for the inspiration):

to-base58: use [ch out][
ch: "123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ"

func [id [number! issue!]][
id: load form id
out: copy ""
while [id > 0][
insert out ch/(round id // 58 + 1)
id: round/floor/to (id / 58) 1E0
]
out
]
]

load-base58: func [id [string! issue!]] [
ch: "123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ"
out: 0
temp: length? id
ad: copy []
foreach dg id [insert ad ( -1 + index? find/case ch dg) ]
pow: 0
foreach item ad [
out: out + ( ( 58 ** pow) * item )
pow: pow + 1

]
out
]


It can be used this way:

>> to-base58 115
== "2Z"
>> load-base58 "2Z"
== 115.0
>> to-base58 12345678911111
== "6Aipnrhc"
>> load-base58 "6Aipnrhc"
== 12345678911111.0


However decimal! type has "only" 15 digits of precision. When our short url software shorts the 999 trillionth page he can make some mistake. So we can analyze the number like integers of 9 digits at time:



REBOL [ Title: "Encode/Decode Base58"
Date: 5-Dec-2009
Author: ["Christopher Ross-Gill" "Massimiliano Vessi"]
File: %base58.r
Version: 1.0.2
Home: http://www.ross-gill.com/
Purpose: {
To Encode Integers as Base58.
Used by some URL shortening services. }
Example: [ browse join http://flic.kr/p/ to-base58 #2740009121 ]
]

url_short: func [ long [string!] ] [
replace/all long "0" "-"
count: 0
b: copy []
c: copy []
foreach item long [
either item <> #"-" [
append b item
count: count + 1
if count = 8 [
b: to-integer rejoin b
append c to-base58 b
count: 0
b: copy []
]
] [
if b <> [] [
b: to-integer rejoin b
append c to-base58 b
]
append c "-"
count: 0
b: copy []
]
]
if b <> [] [
b: to-integer rejoin b
append c to-base58 b
]

return rejoin c
]

to-base58: use [ch out][
ch: "123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ"

func [id [number! issue!]][
id: load form id
out: copy ""
while [id > 0][
insert out ch/(round id // 58 + 1)
id: to-integer id / 58
]
out
]
]



load-base58: use [out ch os][
ch: "123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ"
os: [
1 58 3364 195112 11316496 656356768 38068692544
2207984167552 128063081718016 7427658739644928
]

func [id [string! issue!]][
out: 0
foreach dg id [insert id: [] -1 + index? find/case ch dg]
forall id [out: os/(index? id) * id/1 + out]
return out
]
]

url_long: func [shorturl [string!]] [
count: 0
b: copy []
c: copy []
foreach item shorturl [
either item <> #"-" [
append b item
count: count + 1
if count = 5 [
b: rejoin b
append c load-base58 b
count: 0
b: copy []
]
][
if b <> [] [
b: rejoin b
append c load-base58 b
]
append c "0"
count: 0
b: copy []
]
]
if b <> [] [
b: rejoin b
append c load-base58 b
]
return rejoin c
]


It can be used this way, to avoid erros on number interpretation it must be writed as a string:

url_short "51333179229494856182760054086"
== "5x6yP32C5M4aMW--W-2u"
>> url_long "5x6yP32C5M4aMW--W-2u"
== "51333179229494856182760054086"

Thursday, 17 November 2011

Balls

Here a simple and script of funny balls moving randomly around the window:
Here the source code, notice that there aren't images loaded, all images are created with the DRAW command:


REBOL [
title: "Balls"
date: 2010-05-21
file: %balls.r
author: "Endo"
version: 1.0.0
purpose: "Fun for begginers. Cute balls moving around. Give it a try you will like it."
]

give-me-ball: func [pos color] [
compose [
fill-pen (color)
circle (pos) 30
fill-pen white
circle (pos - 14x5) 8
fill-pen black
circle (pos - 12x4) 3
fill-pen white
circle (pos - 0x5) 9
fill-pen black
circle (pos - 2x6) 3
]
]

move-it: does [
draw-block: copy []
forskip balls 2 [
append draw-block give-me-ball first balls second balls
]
compose/deep [
draw [
(draw-block)
]
]
]

random/seed now

balls: [
150x150 red
160x60 green
180x80 blue
180x120 yellow
190x40 purple
180x180 maroon
130x190 brown
180x200 gray
]

range: [-1 0 1]

window: layout [
backcolor white
bx: box 450x300 snow rate 60 feel [
engage: func [f action e] [
if action = 'time [
bx/effect: move-it
forskip balls 2 [
change balls add first balls as-pair random/only range random/only range
]
show bx
]
]
]
]

view window