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!


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

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"


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



Chars, string, binary and Rebol

Here a simple script to show the correlation between byte ad their chars representation:


Rebol [
Title: "ASCII Chart"
Author: "Sunanda"
]

hex-lo: copy [across banner "ASCII Chart" return box 25x25 red "\"]
hex-chars: "0123456789ABCDEF"

for n 1 16 1 [
append hex-lo [box 25x25 green]
append hex-lo form hex-chars/:n
]
append hex-lo 'return

for hn 0 15 1 [
append hex-lo [box 25x25 green]
append hex-lo form pick hex-chars (hn + 1)
for ln 0 15 1 [
append hex-lo [box 25x25 blue]
append hex-lo form (to-char 16 * hn + ln)
]
append hex-lo 'return
]

unview/all
view layout hex-lo

It's amazing how is simple to obtain this with Rebol. If you don't know what is an ASCII char, I'll explain in few words: every char is a PC is usually converted in a couple of hexadecimal values (like 42 or B2 ). This table explains how to make conversion, 61 is a. Look at the following example:

>> to-binary "Hello world"
== #{48656C6C6F20776F726C64}
>> to-string #{48}
== "H"
>> to-string #{65}
== "e"
>> to-string #{48656C6C6F}
== "Hello"


Area with scrollers

Many users ask if using VID the area style has the scroller(s): no. Standard area style has not the scroller(s), but it's possible to add it/them. There are many ways to add scroller(s) to any VID widget, the simpler is to use RebGUI, but there is also this script that add scroller(s) to text areas.
You can download the source from here: http://www.maxvessi.net/rebsite/area-scroll-style.r , thank to Mr.Didier Cadieu (alias DideC).
If you launch it alone, it will appear a demo where you can test all the options:

If you want to use in a script, I suggest you to comment the last part of the script this way:

comment [
view layout [
styles area-style
style toggle toggle 197 [update-all]
across space 5x5 origin 5x5
backcolor rebolor
vh3 "Demo - area-scroll style" return

vtext "Select the facets you want:" return
f-vscroll: toggle true "without vertical scroller" "width vertical scroller"
f-hscroll: toggle true "without horizontal scroller" "width horizontal scroller" return
f-swidth: toggle "default scroller width" "my scroller witdh"
vtext "width:"
f-width: field 50 "10" [
face/text: to-string any [attempt [to-integer face/text] 0]
update-all
] return
f-outer: toggle "edge is arround the area only" "edge is arround the scrollers too"
f-read: toggle false "editable" "not editable" return
vtext "Basic facets:" return
f-basic: info 400 return
vtext "Your facets:" return
f-facets: field 400 [update-all] return
vtext "Full VID specification:" return
f-final: info 400x50 return
button "Show the result" [show-result]
do [update-all]
]
]

So the demo will not appear, then you can use this way:

do %area-scroll-style.r
view layout [styles area-style area-scroll hscroll vscroll "Example" ]

If you don't want the horizontal scroller, omit hscroll; viceversa if you don't want the vertical scroll, omit vscroll. You can omit both.

ARC4 and ciphersaber crypting script

RC4 crypting method is a symmetric type of encryption, the ARC4 is the open source version of it. Ciphersaber, version 1 and version 2 are the improvements of that type of encryption. The following script permit to use ARC$ encryption and decrypt Ciphersaber V1 and V2 this way (use always binary data):


>> arcfour "w" to-binary "Hello world"
== #{52AD1ABFEC760C8B51875B}

>> to-string (arcfour "w" #{52AD1ABFEC760C8B51875B})
== "Hello world"


You can see that is a symmetric function and "w" is the key. Yo can manipulate any type of data, and reconvert it to the original.

Here another example with Ciphersaber v1 and v2:


>> to-string ciphersaber "asdfg" #{6F6D0BABF3AA6719031530EDB677CA74E0089DD0e7b8854356bb1448e37cdbefe7f3a84f4f5fb3fd}
== "This is a test of CipherSaber."

>> to-string ciphersaber/v2 "asdfg" #{ba9ab4cffb7700e618e382e8fcc5ab9813b1abc436ba7d5cdea1a31fb72fb5763c44cfc2ac77afee19ad} 10
== "This is a test of CipherSaber-2."


Here the source:

REBOL [
Title: "ARCFOUR and CipherSaber"
Date: 17-Jan-2004
File: %arcfour.r
Author: "Cal Dixon"
Purpose: {Provides encryption and decryption using the ARCFOUR algorithm}
Note: {this implementation can decrypt data at about 40KB/s on my 1Ghz AMD Duron system with Rebol/View 1.2.10.3.1}
Library: [
level: 'advanced
platform: 'all
type: [function module protocol]
domain: [encryption scheme]
tested-under: [view 1.2.10.3.1 on [W2K] by "Cal"]
license: 'PD
support: none
]
]

;ARCFOUR specification: http://www.mozilla.org/projects/security/pki/nss/draft-kaukonen-cipher-arcfour-03.txt
;CipherSabre specification: http://ciphersaber.gurus.com/faq.html#getrc4

arcfour-short: func [key [string! binary!] stream [binary! string!] /mix n /local state i j output swap addmod sz][
swap: func [a b s /local][ local: sz s a poke s a + 1 to-char sz s b poke s b + 1 to-char local ]
addmod: func [ a b ][ a + b // 256 ]
sz: func [ s a ][ pick s a + 1 ]
state: make binary! 256 repeat var 256 [ insert tail state to-char var - 1 ]
j: 0 loop any [ n 1 ] [ i: 0 loop 256 [ swap i j: addmod j add sz state i sz key i // length? key state i: i + 1] ]
i: j: 0 output: make binary! length? stream
repeat byte stream [
swap i: addmod i 1 j: addmod j sz state i state
insert tail output to-char xor~ byte to-char sz state addmod (sz state i) (sz state j)
]
clear state
return output
]

make root-protocol [
addmod: addmod: func [ a b ][ a + b // 256 ]
sz: func [ s a ][ pick s a + 1 ]
swap: func [a b s /local][ local: sz s a poke s a + 1 to-char sz s b poke s b + 1 to-char local ]
ins: get in system/words 'insert
i: 0 j: 0
open: func [port][
port/state/tail: 2000
port/state/index: 0
port/state/flags: port/state/flags or port-flags
port/locals: context [ inbuffer: make binary! 40000 state: make binary! 256]
use [key n i j] [
key: port/key
n: port/strength
repeat var 256 [ ins tail port/locals/state to-char var - 1 ]
j: 0 loop any [ n 1 ] [
i: 0 loop 256 [
swap i j: addmod j add sz port/locals/state i sz key i // length? key port/locals/state i: i + 1
]
]
]
i: j: 0
]
insert: func [port data][
system/words/insert tail port/locals/inbuffer data do []
]
copy: func [port /local output][
output: make binary! local: length? port/locals/inbuffer
loop local [
swap i: addmod i 1 j: addmod j sz port/locals/state i port/locals/state
ins tail output to-char sz port/locals/state addmod (sz port/locals/state i) (sz port/locals/state j)
]
local: xor~ output port/locals/inbuffer
clear port/locals/inbuffer
local
]
close: func [port][ clear port/locals/inbuffer clear port/locals/state clear port/url clear port/key]
port-flags: system/standard/port-flags/pass-thru
net-utils/net-install arcfour self 0
]

arcfour: func [key stream /mix n /local port][
port: open compose [scheme: 'arcfour key: (key) strength: (n)]
insert port stream
local: copy port
close port
return local
]

; CipherSaber is an ARCFOUR stream prepended with 10 bytes of random key data
ciphersaber: func [ key stream /v2 n ][
arcfour/mix join key copy/part stream 10 skip stream 10 either v2 [ any [ n 42 ] ][ 1 ]
]


Animated face resizer

Here another script showing how to create an image with Rebol DRAW:

The image is not downloaded, push the button and the image is scaled, use the slider to change image size.
Here the source:
REBOL [
Title: "Animated face Resize"
File: %animresize.r
Author: "Maxim Olivier-Adlhoch"
Date: 05-Jun-2007
Version: 1.0.0
Rights: "Copyright (c) 2007 Maxim Olivier-Adlhoch"
Usage: "do http://rebol.org/cgi-bin/cgiwrap/rebol/download-a-script?script-name=animresize.r"
Purpose: "An animated resize using DRAW and image!"
Comment: "Older demo by Maxim, prepped for rebol.org by btiffn"
History: [
05-Jun-2007 1.0.0 "btiffn" "First cut for Library"
05-Jun-2007 1.0.0 "moliad" "Code written"]
library: [
level: 'intermediate
platform: 'all
type: 'how-to
domain: 'graphics
tested-under: [view 2.7.5.4.2 on "Debian GNU/Linux 4.0" by "btiffin"]
support: [
"REBOL Mailing List"
http://www.opensource.org/licenses/mit-license.html
]
license: 'MIT
see-also: "fastscroll.r"
]
]

map-size: 200x200
steps: 50

sub-face-size-start: 50x50
sub-face-size-end: map-size * 5


; create image map
print "generating map buffer"
map: make image! reduce [map-size white]

fx: [
pen none
fill-pen diamond 863x9 0 216 225 8 8 142.128.110.213 250.240.230.179
0.48.0.128 250.240.230.128 255.228.196.160 128.128.0.192 255.255.0.189
0.255.255.191 0.128.128.203 128.0.128.193 175.155.120.202 100.136.116.163
72.0.90.199 38.58.108.192 160.180.160.131 255.0.255.179 255.228.196.184
139.69.19.135
box 0x0 map-size
pen none
fill-pen conic 127x863 0 300 116 9 7 192.192.192.160 255.0.255.171
240.240.240.157 40.100.130.137 255.164.200.133 255.255.255.154 0.128.128.163
0.0.128.166 255.228.196.145 255.0.255.168
box 0x0 map-size
pen none
fill-pen cubic 375x810 0 89 72 1 8 222.184.135.137 160.82.45.166
38.58.108.157 255.205.40.131 255.150.10.129 240.240.240.139 0.48.0.171
179.179.126.150 0.255.0.131 72.0.90.159
box 0x0 map-size
pen none
fill-pen radial -117x-266 0 65 158 3 2 255.255.255.143 72.0.90.181
40.100.130.146 100.120.100.130 178.34.34.185 128.0.128.169 72.0.90.160
139.69.19.190 100.120.100.165 178.34.34.148 222.184.135.164 0.0.255.141
160.82.45.143
box 0x0 map-size
pen none
fill-pen cubic 826x989 0 171 233 2 2 160.82.45.134 192.192.192.167
38.58.108.191 100.136.116.158 175.155.120.187 245.222.129.140 80.108.142.189
255.150.10.158 40.100.130.197 164.200.255.187 179.179.126.169 255.150.10.168
164.200.255.197 220.20.60.170 255.0.0.147 76.26.0.175
box 0x0 map-size
]

; render a pretty pic
print ["rendering pretty pic at " map-size]
draw map fx


do-size: func [
scale
][
sub/offset: (-200x-200 * scale)
sub/size: ((sub-face-size-end - sub-face-size-start) * (scale)) + sub-face-size-start
show sub
]



; anim simulation:
do-anim: does [
s: now/precise
repeat i steps [
do-size i / steps
;sub/offset: (-200x-200 * (i / steps))
;sub/size: ((sub-face-size-end - sub-face-size-start) * (i / steps)) + sub-face-size-start
;show sub
;print i
]
print ["map res: " map/size]
print ["steps: " steps]
print ["time: " difference now/precise s ]
print ["frame rate: " steps / (to-decimal difference now/precise s) "f/sec"]
]

; open gui
l: layout [
sub: box map 200x200 effect [fit]
]


view layout [
canvas: box 500x500
button "animate" [do-anim]
scroller 500x15 [do-size value]
do [
canvas/pane: sub
show canvas
]

]


One liner of the week


hist: does [repeat k system/console/history [print [";" k]]]


Print the console history, by Romano Paolo Tenca.

Cartoon animation

Rebol can use multiple image to create animations like this:

The following script shows how to use them:

Just click on the button to see the animation moving around the window:

This is the source code, don't be scared of the 12 image binary data embedded in this script; the real script is just the last 15 lines:


Rebol [
title: "Animated GIF Example"
date: 29-june-2008
file: %animated-gif.r
author: Nick Antonaccio
purpose: {
An example of how to use the 'anim' function.
Taken from the tutorial at http://musiclessonz.com/rebol_tutorial.html
}
]

make-dir %./frames

write/binary %./frames/frame-1.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zCHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJG8KqYk5uWnp5ukHxqjufmZWdnWxS/OsPJcODoPLtKprUcW9TPLXJT
V7LdFZIZuMx/Ll/rrJCkC3NZ1ztd6SpVCG+L363EsXpCTvhmtovzVCWurr7R6jG7
rzZarKFpd8XTS77Z1/Xu7Qn+vunr6+/v725rqv6nm/Oj4Or2Ll7jvDUOa8+e6FX3
3uYjbPz0fN/RKjbeWcU+Z5do2qfN2lWaelnXfbveKwkz7ytLqu0qBK6Xed1cyfhG
TC58xeujhyuF422FXxQeOPybbR1nzbbP18+khtXvu/H95Ns7Gzdv5ZtfaVX64fjZ
crf/d6xPvV7XmJ7PZ1/x/ueXm/nXrOfVZKyZ+DL8nt85zhWzqu8LPosvPyYZEdW8
QrJjvjdj3TOFJuXQFVEVEl0iC9L49pVJJvZcnR7XLn/w+ux64XUpizrvbF0R1PFx
4QvB3s29OxLylB9tW9Cj9+vEol5NLk+5ia7vLB74GvxbETxZRklSqI+HyWNpR7ri
VbkJtreOp05nF1O/EeGW9C01/RqjmVrF3l7PZxnfPStv12qxsjBYAwBolvDW2AQA
AA==
}

write/binary %./frames/frame-10.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJGcFnIAgdVr2kGybtEJDernZmpnfsqp9P48bn5tvr/ZKSuPApY4Koo
Fzvry8OgZb6Sdq1Sog9DZjJlh/l6mLz2ZeDfU3c3SuClwzQm+RWsC6bqOC7JOrwo
Vnv72uht1gfbeK0n6MWtKW/8pbrj2/uI7QU/F9Vmf14XMbfnolxpjWlR3GGbyXZb
a3ZufLY619b5H8+vnNRL8z7K6ciWbnG80B7Y3SZrrZF7bVN+ee6q6uKr9/ZFM8/X
qfnx7s6xYPGrs+7oPXrWzex83qes6svaa+v/n9OrtUp9fX9ve7j/ux8fP3x61rjY
vLZ6b+iNdzsPre/9l5a86itjv21cXGXk5p+Wx+fVM3K9CK15v7MtwZlL74RCAp+b
xsMWkbCMh60SaSsetsmUvXjYrtCm8ahDZVrGo06NPFEBBmsAOJHArHoEAAA=
}

write/binary %./frames/frame-11.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4a8uKBYvd+6Wd
i/54bFp8YjKf9yqTzk2ph6ZqxZ4S4dj87Mw00+J7IjM3Pz/Xa1v674jElecXJrom
yq3NKFbwWC4/PSiE68FB5llMay/1aJkuClobLhqyV2pa9vUp8SeZBLjL1t7czDM7
S9ViukrMlpCNYj2V5YlB03x/7/uzu3RpQqsjL5tdjYFhyIF8yfehWT82Rmz3VxXf
9rvi0+VJs8zdv8lsLYo/NK2b699pqS93r20wLu/lrTbNvbYt3/rcWmv9x5f2prb7
1VZbvHxwrPO1n94u8+IzB/XV+/VsTEpfXl5pn+9Xbf3l6b2J1cHP+6psKhc/43zk
d99Cs/qrXW17eW3Nl7Jfp1aff17zb2/Rjz8/v8uWMf1aGt/IobbiQROP2YsHzQJu
Gg9bRMIyHrZKpK142CZT9uJhu0KbxqMOlWk7Eh0YrAGyBMCKdgQAAA==
}

write/binary %./frames/frame-12.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJG8KqYk5uWnp5ukHxqjufmZb79XEWvrlROfnRuvn21F4tXSOOFNptu
JttVBisuzfURtJsrdfXBleWhnHFLZ5VqX18V18lnImW6JmwT/yamD1ofHG9tZbi0
TLV6ytrbOwqeHkrNCtePaiypntX7u+z9rTml7OIxWiZrbhy2kbbm45IsTDrevTDu
GM/PgptrkzWj360qefhi9nLH+b09VUa3Z62zPN+zNkLt7fVt+eK21tHf8w40Jv7S
Oxv148Pxg73y1898t4h4Pnvh9rh5c9S+XjZbH/5+757K7y/22bc716+Lzn168ln4
db/1917kfwvbOH+6/zzLD8ez7p/X9/u1/d+fiEq2+Joe3owHjRxqKx408Zi9eNAs
4KbxsEUkLONhq0SaqACDNQAYMLy/ZgQAAA==
}

write/binary %./frames/frame-2.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJG8KqYk5uWnp5ukHxqjufmZWdnW6hqBUwQfnxuvkPltxaJLSsuLOTt
ZWPdIPzSaal3vZUth6nWhZUsq7NsrUqzQ9f47K17qyWmdW1T2txFsreLdW/Pydu6
rXe2mHrsYuf3j86uLn95Z1/Qf6ZnWeUGD2e38V/3WVOh9viYkfzh3Fvmb1Iap+oq
P7OUKH64ocH2tsisGfkvTy7nXi6nG/n11dGZzLv3RQt8On3c19zY7e8stbyDCxtf
h0rLZBZuKjyYFrv6jsLdZ8xr99lGi3wueRLuGN6+zqSq7MW1700y/hHle4o/PhP8
5Xt+397f3z88Pj3ff/++v79/vGdnYbAGAJfEqNM/BAAA
}

write/binary %./frames/frame-3.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blri2cIVNC+GU2Hp6elcEX0tnsbLfPpNs++9mTE57fRcyepfJZxfFgUsdNWU
s51l8ihoma+8XatU6cOQVaHCca6zQh+GrYvlrWOVnvbgxrzUo/POzrz2JmpuLuu+
VuntT+9ML316T3VWuf79HXX/t/GuKTJIPBj5UW7bzB0fko75frwVGzP1ffIRa934
tpiQp88O9Zq3q84pL3qwq593uZ621dus61NCJ097K/714b7l3tf1bAv03jfNmv/v
264t3wu2Hn0r9973y6uiy2aql235hJeef35hovexONmK8jc3rzapXLeL03r+6cXl
1fHn9+39/f3D49Pz/ffv+/v7x+fX98/v3////1NWFgZrALxatNdHBAAA
}

write/binary %./frames/frame-4.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJG8KqYk5uWnp5ukHxKZMWCZWdnSuW+urOSId11nkP+rx6JLS8C2l0n
y6XO2PLyUovvXDtTCdNXV5pCl8YtnRn68tq6qOVNX6tKdW4uT+ud5sv9RTt6Xt79
Vz3a4Stu7Cq7+OitZ/i7i3tza5n4tCo+3JzWdniTz5oI1cfHNOVXt2pWqp87VaPv
LZf1413C3s7pdmKys0rSL88PZGbbe+vzva1rY3+/PV32+sCubRtnnd0rkJdwj/0h
0wyemh2p644UC7fl7H778NGh3vO6fKbGX1/f2Jx9/9ze3d/fPzjczSvvv2/Pz88v
Lq+Oj7dTYLAGANdbpyswBAAA
}

write/binary %./frames/frame-5.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJG8KqYk5uWnp5ukHxqjufmZWdnWxS/unNy8/Lz8x2auWR/BTVeXOwi
Khe7y2Sl47KAiVamXApZV5b4rnWSXbVVO3RB3OF/PN7X1G9usjnfdXdl2dpz2/IK
D339VZZ3fVfZ2kdnd5uqx++t+/9tqvaMlWfXh3IrT7sZ/jHxaHim0zWtSqOnM6a9
FDtbU26cfkDPvrlNc1dm6kVTb22Lv5alaYfm5C+qu3OrNPfa+tzj13Ijv+XemZzI
zv9n+oq7Kye6f9+js2Fz5IFZx4PK+MR+JSy/sTn7/rm9u7+/f3C4m/m7pACDNQAX
yZ/iJgQAAA==
}

write/binary %./frames/frame-6.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJG8KqYk5uWendyiezhkdy8zHemsfm9O5LG6m7zHGqjWKRCMo7MY+h4
Z/IrYGXwMp65dq2rAl6FrGJbG3fUKuB12DrPvVqs2gFvwlelHZ/ku3qadvSilMP7
9kqW653fWvay6ezq67rxS6r/P1qjPWPDg4Nu/N+/rvyh9/iYt7zzNs0So6enpi2M
cuuRNLp3qJH/d6hNlEnY+eXS09l6w0qzLq+PPP7s98yy3N2Fp5+dvTtVN78lqf77
u5XTi3wfHpYVj5lTnX3xfsHkeDe98qrS11catc/PK7D+/u74fnNpHv19e35+fnF5
dfz5fXt/f//w+PR8//37/v5mYGJisAYARqapGj4EAAA=
}

write/binary %./frames/frame-7.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8loBjYyMaj5ToqJNHjqOV0zsq/l56RnnjPlcq9t6Zy8+Nx8w+okFq8vywK6XDvl
ZGdNeR7Uyb9oUY7X55dH2INX7trCZbr62oIYSa+vv65mRDRHs05rrRR7GLU09+K+
v5LmD++sKuW/d3R2+YO4fbUn//G+MV+bsKpF9JzvnSKDx/vbhJ3DTkbo3j5coB2v
F72z4MzWubrBbLJWL25fWuZv7/d6y4q0bdMNj6udub7mzYnGuVV+v6qK8k/sl/We
l7Nb/+Ojyv5ytX0yFq/2LnRdfW3P79ef515b73/9nFRGSVPJ00c2fXwSf9685y1d
7B9ft/fu53ei/f3/5xnVtie8f33//P79wEKATeNBA4tYxoNGDrUVD5p4zF48aBZw
00h0ZGRksAYAd264o18EAAA=
}

write/binary %./frames/frame-8.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJG8KqYk5tUvVi5Yia1eG5edqbPtPjSnpWBy/0YDCvDvvwsXh7Q6TL5
kI1UYGbQMv65Wq2nAl6FrApd++vIrA8HmRc4smbxni59cH294d46Vu2tOQc3OzDO
cc2+ujZiZ9zjc6mvr+hFNGV+/rT31bUX9xuTTybFWllsTFzXI5uv6xO2yXe3m669
nrfIxrAzDaLqx9bc2Jx8aVZ90bWcWYZXr6xj39+W++NT4K1VuZ9LeqPfpM2cWHj8
ytmQHx/u79b9zSf3e9un5iOth/QkYnd9fHVy/fSydbWl5e8PBbYHLreJ+1Oyv1d1
cX5tVe2Li+94t/X7y9b9Wf5y4mx3u5919d/Orr1+s8jyovr9ZFYpjol1XGYvHjQL
uGk8bBEJy3jYKpG24mGbTNmLh+0KbRqPOoTYWBisAbfrxM90BAAA
}

write/binary %./frames/frame-9.gif to-binary decompress 64#{
eJxz93SzsEwMZwhn+M4AAg1g3ACmGsCsBjDnPxj/B1P/waz/YM4oGAXDBij+ZAHT
OiAClCfYOf4zMHLIeGxYcLCZQ1gr5sSGhYfbBZS95nhsXHS0W8I4686JjYuP9ys4
d8l4blpycrJG8KqYk5uWnp5ukHxqjufmZWdnWxRHhRwIfu46z6Hx1xSJLSsuLOTt
1XLdFfDy0mIfTqu5t4xfOayKWMt04NRVretrAvc3yWqVrTm/LnqlUuusba9Ct6aL
ctQ4mL+9syt3+jHWgO+Nd/fVPXxm88p8Q8y+Gl7/q5Il667sZjp7S0drqm7UHP/T
UrJ7LNc/2zFFOXudlNWyG9uzvs6yO1NgEj29V3RXH2/1tzfTthVv9lt52+zdvcXZ
zPZ/rb99OKfvLF+vu+d50Xaju3b3bSutnj+fsTx4/sra6pK3N9fed2Op/2uR/OZ5
+/pQf7GKiJ37tlb905I3LVw7s//St1W7NgW8f/l1+41qZr6O+MxvjuH3m3jMXjxo
FnDTeNgiEpbxsFUibUViGyMjgzUAhlm/D2kEAAA=
}

view center-face layout [
size 625x415
backcolor black
anim: anim rate 10 frames [%./frames/frame-1.gif %./frames/frame-2.gif %./frames/frame-3.gif %./frames/frame-4.gif %./frames/frame-5.gif %./frames/frame-6.gif %./frames/frame-7.gif %./frames/frame-8.gif %./frames/frame-9.gif %./frames/frame-10.gif %./frames/frame-11.gif %./frames/frame-12.gif]
btn "Run Animation" [
for counter 0 31 1 [anim/offset: anim/offset + to-pair rejoin [counter "x" 0] show anim wait .05]
for counter 0 24 1 [anim/offset: anim/offset + to-pair rejoin [0 "x" counter] show anim wait .05]
for counter 0 31 1 [anim/offset: anim/offset + to-pair rejoin ["-" counter "x" 0] show anim wait .05]
for counter 0 24 1 [anim/offset: anim/offset + to-pair rejoin [0 "x-" counter] show anim wait .05]
]
]


Anamonitor 2: check block contents

Using Rebol, and using blocks, users could be interested in checking every items in a block, or the items nested in a block or series. Mr. Romano Paolo Tenca wrote a very useful script for this job: anamonitor. Now with anamonitor, you can check every item in a block. If you run anamonitor, it will appear this window:

the standard behavior is to show the system block. You can click on every voice of the list to see what is nested inside and go on and on insede the level of the block.
If you launch it this way:
do/args %ana2.r false

It doesn't appear anything, but you can now use the command monitor, this way:
example: [1 2 3]
monitor example

here the result:

It's a very useful tool to check every item of our scripts. You can download from here:
http://www.maxvessi.net/rebsite/anamonitor2.r

Analog color clock

Here another funny script of a clock that change slowly its color:

Here the source code:


REBOL [
File: %analog-clock.r
Date: 11-Jun-2005
Title: "Analog Clock"
Version: 1.1.0
Author: "Vincent Ecuyer"
Purpose: {Colorful clock with analog display}
Notes: {
VID isn't used in this demo: all faces are made with make face [...]
}
History: [
1.0.0 [28-Dec-2003 "First version"]
1.1.0 [11-Jun-2005 "View 1.3 compatibility & Digital display fix"]
]
Library: [
level: 'advanced
platform: 'all
type: [demo tool]
domain: [sdk GUI]
tested-under: [
view 1.2.1.3.1 on [Win2K]
view 1.2.1.1.1 on [AmigaOS30]
view 1.3.0.3.1 on [Win2K]
face 1.2.47.3.1 on [Win2K]
]
support: none
license: 'public-domain
see-also: %clock.r
]
]
if none? system/view/event-port [
insert system/ports/wait-list
system/view/event-port: open make system/standard/port [
scheme: 'event
awake: func [port] bind [wake-event port] in system/view 'self
]
]
s1: m1: m2: m3: h1: h2: h3: 0x0
text-pos: 100x5
hour: form now/time
if 7 > length? hour [insert tail hour ":00"]
date: form now/date
l: make face [
offset: 50x50
text: hour
size: 201x226
color: 0.0.0
edge: none
feel: system/view/window-feel
rate: 10
pane: reduce [
clk: make face [
offset: 0x0
size: 201x201
color: 0.0.0
edge: none
effect: compose [
gradient 1x1 255.255.0 255.0.0 tint
(to-integer 6 * ((pick now/time 3) - 30))
draw [
pen 255.255.0 'line-width 2
line c s1
pen 255.0.0 fill-pen 255.255.0 'line-width 1
polygon c m1 m2 m3
line c m1 m2 m3 c
polygon c h1 h2 h3
line c h1 h2 h3 c
] oval 0.0.0
]
rate: 1
feel: context [
engage: func [f a e /local t v][
t: now/time
clk/effect/6: to-integer 6 * (t/second - 30)
s1: c + to-pair compose [
(to-integer rs/x * sine v: 6 * t/second)
(- to-integer rs/y * cosine v)
]
m1: c + to-pair compose [
(to-integer rm/x * 0.85 * sine (
v: (6 * t/minute) + (v / 60)) - 4)
(- to-integer rm/y * 0.85 * cosine v - 4)
]
m2: c + to-pair compose [
(to-integer rm/x * sine v)
(- to-integer rm/y * cosine v)
]
m3: c + to-pair compose [
(to-integer rm/x * 0.85 * sine v + 4)
(- to-integer rm/y * 0.85 * cosine v + 4)
]
h1: c + to-pair compose [
(to-integer rh/x * 0.85 * sine (
v: (t/hour // 12 * 30) + (v / 12)) - 4)
(- to-integer rh/y * 0.85 * cosine v - 4)
]
h2: c + to-pair compose [
(to-integer rh/x * sine v)
(- to-integer rh/y * cosine v)
]
h3: c + to-pair compose [
(to-integer rh/x * 0.85 * sine v + 4)
(- to-integer rh/y * 0.85 * cosine v + 4)
]
]
]
]
dgt: make face [
offset: 0x201
size: 201x25
color: 0.0.0
edge: none
font: make face/font [style: 'bold size: 16]
effect: [draw [
font dgt/font
text 5x5 hour text text-pos date
] gradcol 0x1 255.0.0 255.255.0]
rate: 1
feel: make face/feel [
engage: func [f a e][
if a = 'time [
insert clear hour form now/time
if 7 > length? hour [insert tail hour ":00"]
date: form now/date
l/changes: 'text show l
]
]
]
]
]
]
insert system/view/screen-face/feel/event-funcs func [face event][
if equal? event/type 'resize [
l/size/y: max l/size/y 25
resize clk/size: l/size - 0x25
dgt/size/x: l/size/x
dgt/offset: clk/size * 0x1
text-pos/x: max 80 dgt/size/x - 100
show l
]
return event
]
resize: func [value [pair!]][
c: value / 2
rs: c * 0.95
rm: rs * 0.95
rh: rm * 0.70
]
resize 201x201
view/options l 'resize
quit