Wednesday, 27 March 2013

Wiki completed!

The wiki on http://rebol.informe.com/wiki/ is completed, I suggest you the followings topics:

Looking the following images they seem cool:

Tuesday, 26 March 2013

Memory usage

There are several tools to see the memory usage of Rebol.
The first one is to see the system/stats:

system/stats
== 5524993


The value showed represents the bytes used, you have to divide to 106 to find out how many Megabytes are exactly, so you may write:

system/stats / (10 ** 6)
== 5.525153


The second method is to use the stats function, it may show:
  • total memory used

    stats
    == 5524993

  • /pools Returns: width units free-units units-per-alloc segments mem-in-use

    >> ? stats/pools
    == STATS/POOLS is a block of value: [[16 5888 342 256 23 94392] [32 4224 1040 128 33 135432]
    [48 11520 2683 128 90 553680] [64 6208 1974 64 97 398088] [80 2368 556 64 37 189736] [96 1504 301 32 47 144760] [112 1312 119 32 41 147272] [128 768 20 32 24 98496] [144 512 118 32 16 73856] [160 480 187 32 15 76920] [176 320 77 32 10 56400] [192 384 110 32 12 73824 ] [208 224 70 32 7 46648] [224 160 42 32 5 35880] [240 160 45 32 5 38440] [256 128 34 324 32800] [512 784 177 16 49 401800] [1024 504 10 8 63 516600] [2048 64 13 8 8 131136] [40 96 304 292 4 76 1245792] [16 37376 7742 512 73 598600] [16 2304 812 256 9 36936] [1 23879 68 15 1 0 0]]

  • /types Returns: Datatype count
    >> ? stats/types
    == STATS/TYPES is a block of value: [end! 30 unset! 4130 error! 2 datatype! 1406 context! 0
    native! 151 action! 126 routine! 0 op! 19 function! 712 object! 3193 struct! 0 library! 0
    port! 20 any-type! 0 any-word! 0 any-function! 0 number! 0 series! 0 any-string! 0 any-block! 0 symbol! 2947 word! 58270 set-word! 6725 get-word! 541 lit-word! 1358 refinement! 1397 none! 9679 logic! 585 integer! 5750 decimal! 35 money! 0 time! 6 date! 48 char! 235
    pair! 1953 event! 114 tuple! 947 bitset! 42 string! 3795 issue! 10 binary! 20 file! 107 email! 9 url! 57 tag! 2 image! 55 block! 11264 paren! 712 path! 5695 set-path! 1708 lit-path! 0 hash! 1 list! 0]

  • /series Returns: total, blocks, strings, other, avail, free, expansions
    >> ? stats/series
    == STATS/SERIES is a block of value: [37376 22797 6777 23 7779 7778 949]

    (are avail and free always the same?)
  • /frames Returns: total, used, unused, free, values-total
    >> ? stats/frames
    == STATS/FRAMES is a block of value: [2304 1492 812 812 22246]

    (are unused and free always the same?)
  • /recycle Returns: count, series-total, series-last, frames-total, frames-last, ballast
  • >> ? stats/recycle == STATS/RECYCLE is a block of value: [17 16443 451 1263 32 2998576]
  • /evals Returns: values functions blocks
    >> ? stats/evals
    == STATS/EVALS is a block of value: [112536 44009 16120]

  • /clear Clears the evals counters
  • >> ? stats/clear == STATS/CLEAR is an integer of value: 5536561

Another very handle tool is the mem-stats.r script, it show a window with all memory stats and you may use the console in the same time and test your scripts:

Here is the source:
REBOL [
    Title: Name: "Memory Watcher"
    Author: "Nenad Rakocevic"
    Email: dockimbel@free.fr
    Date: 12/02/2001
    File: %mem-watch.r
    Version: 1.0.0
    Purpose: "Watch memory evolve during a console session"
    Needs: [view]
    Usage: {
        Just do :
            >> do %mem-watch.r
       
        then at any time :
            >> mem-watch
       
        Now you're in the mem-watch console (rebol-like). Type anything
        on the command-line and watch memory change !
       
        The red background shows last modified values.
       
        Type 'quit to exit from mem-watcher.
       
        You can even run complete scripts, but you'll see memory
        changes only after the end of your script.
        If you want to see changes during your script evaluation,
        just place in your script calls to the 'refresh-watcher
        function.
       
        refresh-watcher         ; update the memory window.
        refresh-watcher/wait     ; update the memory window and wait until
                                ; you press a key.
                               
        Note: a 'recycle is done each time the prompt is printed.
    }
    Comment: {
        - All the infos are taken for Carl's mem-stats.r script.
        - If you're always worrying about memory, mem-watch will show you
          where it's gone !
        - Won't work with /View apps (for now)
        - This script could much more handier if it could show also
          the difference between two updates for each values.
        - 'Throws are not catched in the mem-watch console.
        - I'm not sure that my approach is really accurate. 8/
    }
]
watcher-object: context [
    norm-color: 255.255.255
    high-color: 250.160.160
    watcher: total: plane: none
   
    set 'refresh-watcher func [/wait /local blk val row item p-face][
        ;--- Updating total mem ---
        either total/text = val: mold system/stats [
            total/color: norm-color
        ][
            total/text: :val
            total/color: high-color
        ]  
        ;--- Updating general infos ---
        blk: join join system/stats/recycle system/stats/series system/stats/frames
        p-face: plane/pane
        foreach item blk [
            either p-face/1/text = val: mold item [
                p-face/1/color: norm-color
            ][
                p-face/1/text: :val
                p-face/1/color: high-color
            ]
            p-face: next p-face
        ]
        ;--- Updating pools ---
        blk: system/stats/pools
        p-face: at plane/pane 19
        foreach row blk [
            foreach item row [
                either p-face/1/text = val: mold item [
                    p-face/1/color: norm-color
                ][
                    p-face/1/text: :val
                    p-face/1/color: high-color
                ]
                p-face: next p-face
            ]
        ]
        show watcher
        if wait [ask "Press Enter key to continue..."]
    ]
    ss: stylize [
        lab: tt 60 right black font []
            edge [size: 1x1 color: 144.144.144 effect: 'ibevel]
            with [color: norm-color]
        txt: txt no-wrap 0.0.80
            edge [size: 1x1 color: 144.144.144 effect: 'ibevel]
            with [color: 188.188.188]
        txt60: txt 60 center
        txt-large: txt 175x18
        pool-face: face 60x18
            edge [size: 1x1 color: 144.144.144 effect: 'ibevel]
            font [color: 0.0.0 shadow: none align: 'center]
            with [color: norm-color init: []]
    ]
    set 'mem-watch func [/local watch-win pos cmd err][
        unview/all
        watcher: layout [
            styles ss
            size 605x440
            plane: backdrop 188.188.188
            space 0
            at 0x0 h5 "Total memory allocated" 0.0.80
            at 175x0 total: pool-face right "0"
            origin 60x38
            txt-large "recycles since boot"
            txt-large "series recycled since boot"
            txt-large "series last recycled"
            txt-large "frames recycled since boot"
            txt-large "frames last recycled"
            txt-large "ballast remaining"
            txt-large "total series"
            txt-large "block series"
            txt-large "string series"
            txt-large "other series"
            txt-large "unused series"
            txt-large "free series (= unused)"
            txt-large "expansions performed"
            txt-large "frames"
            txt-large "frames in use"
            txt-large "frames not in use"
            txt-large "free frames (= unused)"
            txt-large "values held in frames"
            across at 240x0
            txt60 "Width" txt60 "Units" txt60 "Free" txt60 "Segment" txt60 "Units/Alloc"
            txt60 "Bytes"
            do [
                plane/pane: make block! (23 * 6) + 18
                pos: 0x0
                loop 18 [
                    append plane/pane make ss/pool-face [
                        offset: pos + 0x38
                        font: make font [align: 'right]
                    ]
                    pos/y: pos/y + 18
                ]  
                pos: 0x0
                loop 23 [
                    loop 6 [
                        append plane/pane make ss/pool-face [offset: pos + 240x20]
                        pos/x: pos/x + 60
                    ]
                    pos/x: 0
                    pos/y: pos/y + 18
                ]
                recycle
            ]
        ]
        watcher/offset: to-pair reduce [system/view/screen-face/size/x - watcher/size/x 0]
        watch-win: view/new watcher
        ;--- Rebol console emulator ---
        print "^/Entering Memory Watcher...(type 'quit to exit)"
        forever [
            refresh-watcher
            recycle
            cmd: ask "[mem-watcher]>> "
            either "quit" = trim cmd [unview/only watch-win halt ][
                either error? set/any 'err try [do cmd][
                    err: disarm err
                    print ["**" err/type "error:" err/id "on" remold [err/arg1]]
                    print ["** Where:" mold err/near]
                ][
                    if all [
                        not unset? 'err
                        value? 'err
                        not object? err
                        not port? err
                    ][
                        if all [series? :err 80 < length? :err][err: join mold copy/part err 80 "..." ]
                        print rejoin [system/console/result :err]
                    ]
                ]
                unset 'err
            ]
        ]
    ]
]
;You should comment this line (this is only usefull when running from TestPanel)
mem-watch

Another useful script is mem2.r, it gives you the opportunity to check a single function or block. This script gives you several function: mem-all, mem-do, mem-func, mem-free, pool. Let's see the some examples:

>> mem-all "[1 2 3]"
Load : 128
Execute : 128
== 0

>> mem-all "func [a b][a + b]"
Load : 224
Execute : 512
== 288

>> mem-all %test.r
>> mem-all %temp.r
Load : 2432
test done ;the script is executed
Execute : 2496
== 64

>> mem-func :help
Load : 14336
Execute : 27904
== 13568

>> print pool
3289056

>> print mem-free
2404310


Here is the source:
REBOL [
    Title: "Mem-Usage - a set of routines to test memory usage"
    Date: 9-Oct-2001
    Version: 0.0.2
    File: %mem2.r
    Author: "Romano Paolo Tenca"
    Purpose: {Functions to test memory usage}
Notes: {
pool: "Return the total of used memory in the allocated pool"
mem-free: "Return the total of free memory in the allocated pool"
mem-ld: return memory usage of "load string"
mem-tb: return memory usage of "to-block string"
mem-do: return memory usage of "do load string"
mem-all: call mem-ld and mem-do and return the difference
mem-func: memory usage of loading and creating a function
Examples:
^-a: 1
^-mem-all ""^-^-^-; memory usage of a empty block
^-mem-all "a"^-^-^-; memory usage of a block with a word
^-mem-all "func [][]"^-; memory usage of a new void func
^-mem-all "make object! []"^-; memory usage of a void object
^-mem-all %prova.r^-; memory usage of executing a rebol program
^-mem-do "help 4"     ; memory usage of executing some code
^-mem-func :help^-     ; memory usage of re-loading and re-creating a function
^-print pool^-^-^-; memory used
^-print mem-free^-^-; memory free
}
    History: [0.0.2 "First public release" ]
    Email: rotenca@libero.it
    library: [
        level: 'intermediate
        platform: []
        type: []
        domain: [debug]
        tested-under: none
        support: none
        license: none
        see-also: none
    ]
]
pool: has ["Return the total of used memory in the allocated pool"][
    tot-used: 0
    foreach y system/stats/pools [
        if 1 <> first y [
            tot-used: y/2 - y/3 * y/1 + tot-used
        ]
    ]
    tot-used
]
mem-free: has ["Return the total free memory in the allocated pool"] [system/stats - pool]
;funzione per stabilire il valore da sottrarre
init-mem: func [code /local old new ret][
    recycle
    old: pool
    new: pool
    print ["Pool usage:" ret: new - old]
    ret
]
mem-tb: func [{Return memory usage of "to-block string"} code [string! file!] /local old new ret][
    recycle
    old: pool
    to-block code
    new: pool
    print ["To block   :" ret: new - old - pool-usg]
    ret
]
mem-ld: func [{Return memory usage of "load string"} code [string! file!] /local old new ret][
    recycle
    old: pool
    load code
    new: pool
    print ["Load       :" ret: new - old - pool-usg]
    ret
]
mem-do: func [{Return memory usage of "do load string"} code [string! file!] /local old new ret][
    recycle
    old: pool
    do load code
    new: pool
    print ["Execute   :" ret: new - old - pool-usg]
    ret
]
mem-func: func [{Return difference between "load a function" and "load and create a function"} code [function!]][- (mem-ld mold :code) + (mem-do mold :code) ]
mem-all:   func [{Return difference between "load string" and "do load string"} code [string! file!]][- (mem-ld :code) + (mem-do :code) ]
;example
pool-usg: init-mem ""
mem-ld ""
mem-do ""
mem-all ""
;change 'comment in 'do to try all examples
comment [
    a: 1
    mem-all ""           ; memory usage of a empty block
    mem-all "a"         ; memory usage of a block with a word
    mem-all "func [][]" ; memory usage of a new void func
    mem-all "make object! []"   ; memory usage of a void object
    ;mem-all %prova.r   ; memory usage of a rebol program
    mem-do "help 4"     ; memory usage of using a function
    mem-func :help       ; memory usage of re-loading and re-creating a function
    print pool           ; memory used
    print mem-free       ; memory free
    recycle
    print pool           ; memory used after recycle
    print mem-free       ; memory free after recycle
]
print system/script/header/Purpose
ask "See the source for examples - Return to Quit - Esc for Shell "
                                                                                                         

The last memory tool showed today is from Carl Sassenrath (Rebol Author), it's just a function that show you all memory statistics:

>> mem-stats
REBOL MEMORY STATISTICS

>> mem-stats
REBOL MEMORY STATISTICS

-------- RECYCLE STATS:
      26 recycles since boot
   20256 series recycled since boot
      56 series last recycled
    2046 frames recycled since boot
       6 frames last recycled
 2921344 ballast remaining

-------- SERIES STATS:
   37376 total series
   24373 block series
    7793 string series
      41 other series
    5169 unused series
    5168 free series (should be same as above)
    1920 expansions performed

-------- FRAME STATS:
    2560 total frames
    1638 frames in use
     922 frames not in use
     922 free frames (should be same as above)
   19517 values held in frames

-------- MEMORY POOLS:
      16 wide     5888 units       36 free       23 segs      256 per    94392 bytes
      32 wide     5248 units     1524 free       41 segs      128 per   168264 bytes
      48 wide    11392 units     1461 free       89 segs      128 per   547528 bytes
      64 wide     6272 units     1572 free       98 segs       64 per   402192 bytes
      80 wide     2496 units      557 free       39 segs       64 per   199992 bytes
      96 wide     1792 units      436 free       56 segs       32 per   172480 bytes
     112 wide     1152 units      191 free       36 segs       32 per   129312 bytes
     128 wide      736 units       25 free       23 segs       32 per    94392 bytes
     144 wide      832 units      381 free       26 segs       32 per   120016 bytes
     160 wide      544 units      218 free       17 segs       32 per    87176 bytes
     176 wide      320 units       58 free       10 segs       32 per    56400 bytes
     192 wide      384 units       98 free       12 segs       32 per    73824 bytes
     208 wide      224 units       26 free        7 segs       32 per    46648 bytes
     224 wide      160 units       29 free        5 segs       32 per    35880 bytes
     240 wide      192 units       69 free        6 segs       32 per    46128 bytes
     256 wide      128 units       26 free        4 segs       32 per    32800 bytes
     512 wide      768 units       93 free       48 segs       16 per   393600 bytes
    1024 wide      464 units       22 free       58 segs        8 per   475600 bytes
    2048 wide       88 units       23 free       11 segs        8 per   180312 bytes
    4096 wide      312 units      291 free       78 segs        4 per  1278576 bytes
      16 wide    37376 units     5081 free       73 segs      512 per   598600 bytes
      16 wide     2560 units      921 free       10 segs      256 per    41040 bytes
       1 wide  2406400 units       26 free        0 segs        1 per        0 bytes
 5801750 bytes total memory allocated by REBOL kernel

-------- TOTAL DATATYPES:
      84 end!
    4112 unset!
       2 error!
    1418 datatype!
       0 context!
     147 native!
     126 action!
      17 routine!
      19 op!
     880 function!
    2927 object!
       2 struct!
       5 library!
      43 port!
       0 any-type!
       0 any-word!
       0 any-function!
       0 number!
       0 series!
       0 any-string!
       0 any-block!
    3020 symbol!
   64383 word!
    5834 set-word!
     567 get-word!
    1135 lit-word!
    1512 refinement!
    8181 none!
     455 logic!
    6692 integer!
      66 decimal!
       1 money!
       7 time!
      50 date!
     267 char!
    1377 pair!
       7 event!
     507 tuple!
      43 bitset!
    4622 string!
      11 issue!
      23 binary!
     296 file!
       9 email!
      85 url!
       2 tag!
     119 image!
   11401 block!
     797 paren!
    6240 path!
    1912 set-path!
       0 lit-path!
       0 hash!
       0 list!

Here is the source:
REBOL [
    Title: "REBOL Memory Stats"
    Date: 21-Jun-2000
    File: %mem-stats.r
    Author: "Carl Sassenrath"
    Purpose: {Print out statistics for memory usage. (Command only.) }
]
stats: get in system 'stats
fmt: func [n /local str] [
    str: form n
    head insert/dup str " " (8 - length? str)
]
peach: func [title vals strings] [
    print [newline "--------" title]
    foreach val vals [
        print [fmt val first strings]
        strings: next strings
    ]
]
mem-stats: does [
    print "REBOL MEMORY STATISTICS"
    peach "RECYCLE STATS:" stats/recycle [
        "recycles since boot"
        "series recycled since boot"
        "series last recycled"
        "frames recycled since boot"
        "frames last recycled"
        "ballast remaining"
    ]
    peach "SERIES STATS:" stats/series [
        "total series"
        "block series"
        "string series"
        "other series"
        "unused series"
        "free series (should be same as above)"
        "expansions performed"
    ]
    peach "FRAME STATS:" stats/frames [
        "total frames"
        "frames in use"
        "frames not in use"
        "free frames (should be same as above)"
        "values held in frames"
    ]
    print "^/-------- MEMORY POOLS:"
    foreach a stats/pools [
        print [
            fmt a/1 "wide"
            fmt a/2 "units"
            fmt a/3 "free"
            fmt a/5 "segs"
            fmt a/4 "per"
            fmt a/6 "bytes"
        ]
    ]
    print [fmt stats "bytes total memory allocated by REBOL kernel"]
    print "^/-------- TOTAL DATATYPES:"
    foreach [type cnt] stats/types [print [fmt cnt type]]
]
mem-stats
halt

Monday, 25 March 2013

PBKDF2 encryption

Do you know the PBKDF2 encryption?
It's the encryption used on Wi-Fi, Mac and more systems. You may read something here: http://en.wikipedia.org/wiki/PBKDF2


refaktor wrote a script to use PBKDF2 encryption, and so you can use it with Rebol!

The source code is here: https://github.com/refaktor/Rebol2-PBKDF2/blob/master/pbkdf2.r

REBOL []
pbkdf2: context [
unsigned-to-binary: func [n [number!] /rev][
  if n > (2 ** 31 - 1) [n: n - (2 ** 32)]
  n: load join "#{" [form to-hex to-integer n "}"]
  either rev [head reverse n][n]
]
calc-sha1: func [pwd salt count key-len /string
  /local hash-len block-len output i j ] [
  hash-len: length? to-string checksum/secure ""
  block-cnt: round/ceiling (key-len / hash-len)
  output: copy #{}
  repeat i block-cnt [
  last: join salt unsigned-to-binary i
  last: xorsum: checksum/key last pwd
  repeat j (count - 1) [
    xorsum: (xorsum xor (last: checksum/key last pwd))
  ]
  output: join output xorsum
  ]
  output: copy/part output key-len
  either string [trim/with enbase/base output 16 #"^/" ] [output ]
]
]

Friday, 22 March 2013

MD5 checksum

If you use Rebol 2, don't use the checksum/method 'md5 since is broken.
Fortunately Andreas Bolka made a script to correct this behavior:

md5sum: func [
    "Returns an MD5 checksum for the contents of the file given."
    fname [file!] /local fport sport chunk-size
] [
    chunk-size: 4096 ;; 4K chunks, just like in md5sum (matches page size)
    fport: open/seek/binary/read fname
    sport: open [scheme: 'checksum algorithm: 'md5]
    while [not tail? fport] [
        insert sport copy/part fport chunk-size
        fport: skip fport chunk-size
    ]
    close fport
    update sport
    sum: copy sport
    close sport
    sum
]


The Rebol 3 checksum works well, unfortunately is not so friendly as the Rebol 2 version: the R3 wants a binary as input, so you have to write:
checksum/method (to-binary read %myfile)   'md5

Wednesday, 20 March 2013

Mass mailer

The following script can be used for good or for bad intentions: it's a mass emailer.
The scope of the script is to send an email to any number of address avoiding antispam protection of your service provider. Usually any service provider put a limit to the number of email's addresses, this script read your adresses list and send an email at a time to every address.
First of all prepare your addresses list in a text file, like this:

maxint@tiscali.it
myfriend@hotmail.com
myotherfriend@gmail.com

then you have to write your email message with your preferred email software (mine is thunderbird) and save your email as an EML file (just "Save as file..." of your client).
Finally start the script:

Push the button Settings to configure your email settings, your settings are stored in a file, so next time you don't need to write them again.

Push the Email button and select your email file, the red led will become green.
Push the Email list button and select your address list file, the red led will become green.


Now select the interval of seconds between email sendings and push MASS MAILING! button.
If something goes wrong during sendings, the script creates a errors.log file containing the last email sent:
Last sent email is: maxint@tiscali.it
This way you can restart from the last email sent, shortening the email list file. Moreover you haven't to fill again fields, just push the Reload last button, and all old configuration will be restored.
This script commonly is used with more than 3000 addresses!
Here the source:
Rebol [title: "Mass mailer"
    version: 2.3.24
    author: "Massimiliano Vessi"
    date:   29/9/2009
    email: maxint@tiscali.it
    file: %massmailer.r
    Purpose: {"Mass emailng the world!"}
    ]
header-script: system/script/header
version: "Version: "
append version header-script/version
config: array 7
; the file %mass_mailer_conf.txt contains all configurations
; from 1-8 fields are settings
; 1 email adress from
; 2 smtp
; 3   user
; 4 password
; 5 email template file
; 6 email list
; 7 retard

;function to save all data in mass_mailer_conf.txt file
salvatutto: func [config] [
    write %mass_mailer_conf.txt ""
    save   %mass_mailer_conf.txt   config
    ]
   
;check massmailer conf file existance
either exists? %mass_mailer_conf.txt [config:   load   %mass_mailer_conf.txt ] [
    alert "You must set access data. Please fill in data in Settings panel."
    ritardo: 2
    ]
;Setting panel
configurazione_lay: layout [
    across
    title "Settings"
    return
    text "Your email:"
    email_fl: field  
    return
    text "SMTP server:"
    smtp_fl: field  
    return
    text "SMTP user:"
    smtpuser_fl: field
    return
    text "SMTP password:"
    smtppass_fl: field
    return
    button "Save" [
        poke config 1   to-email email_fl/text    
        poke config 2   to-word smtp_fl/text
        poke config 3 to-string smtpuser_fl/text
        poke config 4   to-string smtppass_fl/text
    salvatutto config
        unview]
    button "Exit" [unview]  
    ]
;Help panel
aiuto_lay: layout [
    title "HELP"
    text 190 {This is a mass email, it permits to send any number of emails without problems. It will send an email each 2 seconds (or the time you choose).
If you'll fill correctly settings panel, all will be alright. File loaded by Mass mailer must be in ASCII not in
unicode. There is also a errors.log file with the last email sent, it's useful in case of interruption.
Now this software works with any email. If you have problems, please contact me:   }

text blue (rejoin ["maxint" "@" "tiscali.it"])
    ]
;checking if the email list is   OK
controllo_emails: func [lista] [
    lista_nera: copy []
    avvertire: false
    foreach indirizzo lista [
        temp2: length? parse indirizzo "@."
        if temp2 < 3 [  
            avvertire: true
            append lista_nera   indirizzo
            ]
        ]
    if avvertire = true [alert reform ["The following addresses are NOT correct:" lista_nera ]]    
    ]
assemblaggio: func [] [
    ;SET-NET is a function value.
    ;ARGUMENTS:
    ;settings -- [email-addr default-server pop-server proxy-server proxy-port-id proxy-type esmtp-user esmtp-pass] (Type: block)
    set-net   reduce [config/1   config/2   none none none none   config/3 config/4]
    ;now we construct the header
    il_header: make object! [
        X-REBOL: "View 2.7.8.3.1 http://WWW.REBOL.COM"
        Subject:   email/Subject
        From:   to-email config/1
        Return-Path: to-email config/1
        To: to-email config/1
        Date: to-idate now   ;we must set an correct RFC 822 standard format date or our emails will be identified as spam
        MIME-Version:   "1.0"
        Content-Type: email/Content-Type
        ]
    ]
leggi_email: func [corpo_ind ] [
    a_lay/text: to-string corpo_ind
    show a_lay
    testo: read/string to-file corpo_ind
    email: import-email testo          
    led2/data: true
    show led2
    ;probe email
    ]
view layout [
    across
    title "Mass mailing"
    return
    btn-help [ view/new aiuto_lay]
    text   version
    return
    button "Settings" [
        email_fl/text: to-string config/1
        smtp_fl/text:   to-string config/2
        smtpuser_fl/text: to-string config/3
        smtppass_fl/text: to-string config/4
        show [email_fl   smtp_fl smtpuser_fl smtppass_fl ]
        view/new configurazione_lay
        ]
    button "Reload last" [
        b_lay/text: to-string config/6      
        ritardo/text: to-integer config/7
        db_mail2: read/lines to-file   config/6
        leggi_email config/5
        ;debug
        ;probe email        
        led3/data: true    
        show [ a_lay b_lay   led2   led3   ritardo]
        ]
    return
        led2: led
    button "Email" [
        corpo_ind: request-file
        either   (parse (to-string corpo_ind)   [thru ".eml" end]) [leggi_email corpo_ind ] [alert "It isn't a valid eml file!"]
        ]
    a_lay: field "no text file loaded, html files are the best!"
    return
    led3: led
    button "Email list" [
        temp:   to-file request-file
        db_mail: read temp
        db_mail:   parse db_mail none
        sort db_mail
        db_mail2: copy unique db_mail
        write/lines   temp db_mail2 ;scrive il file su hdd
        controllo_emails db_mail2
        b_lay/text: to-string temp
        show b_lay
        led3/data: true
        show led3
        ]  
    b_lay: field "no email list file loaded"
    return    
    text "Retard:"
    button 22x22 "+" [temp: to-integer ritardo/text
        temp: temp + 1
        ritardo/text: to-string temp
        show ritardo
        ]
    ritardo: field   40 "2"
    button 22x22 "-" [temp: to-integer ritardo/text
        temp: temp - 1
        if temp < 1 [temp: 1]
        ritardo/text: to-string temp
        show ritardo
        ]
    return
    button red "MASS MAILING!" [
        counter: 0
        b: length? db_mail2
        a: confirm reform ["You are going to send" b "emails. I already deleted double entries. Do you want to proced?"]
        if a = true [
            ;saving configurations
            poke config 5 to-file a_lay/text ; email file
            poke   config 6 to-file b_lay/text ; emails list
            poke   config 7 to-integer ritardo/text ; retard
            salvatutto config ;save configuration
            ;sending emails
            foreach record db_mail2 [
                assemblaggio ;we now assemble the email
                il_header/To:   record
                counter: counter + 1
                sped_lay/text: reform ["Sending email n." counter]
                show sped_lay
                send/header     ( to-email record )     email/Content   il_header
                wait to-integer ritardo/text
                write %errors.log   reform ["Last sent email is: " record]
                ]  
            alert reform ["Finished! You sent" counter "emails."]
            sped_lay/text: reform ["Finished! You sent" counter "emails." ]
            show sped_lay          
            ]
        ]
    return
    sped_lay: text red "____________________________"
    ]

Monday, 18 March 2013

Gob! type

Rebol 3 has a new type: gob!
GOB stands for Grafical Object, before using this guide, remember to launch load-gui

Concept

A GOB is a low-level graphical object.
GOBs are used for for constructing windows, panels, images, text, and drawings. They support two dimensional compositing with transparency (alpha channel), scalar vector graphics, image effects, and rich-text.
A GOB is a highly optimized native datatype. It has been designed to provide the primary features required for graphics, but substantially reduce the memory footprint and processing overhead required. As a result, complex displays, such as animations, simulations, or video games can be created that are composed of thousands of individual GOB elements.

Usually users do not need this information just to use the GUI. This information is provided for users who want to use the graphics system directly or to create new styles for the GUI.

GOB is a Datatype

A GOB is an optimized datatype for supporting graphics. Technically, it is not a series nor is it an object, but it will respond to action functions similar to both of those.

Making GOBs

New GOBs are created with make and a specification block.
gob1: make gob! [text: "Example" size: 400x40]
view gob1




logo-image: load %reb-logo.gif
gob2: make gob! [offset: 10x20 image: logo-image]
view gob2



You may use also the Rebol 2 Draw commands, but at the moment you can't access directly, you have to use the stylize function:


stylize [
 circle: [
 about: "A circle style"
 facets: [init-size: 100x100]
 draw: [
  pen black
  line-width 2.7
  fill-pen maroon
  circle 50x50 40
  ]
 ]
]
view [a: circle]



If inspect a/gob/draw you you'll find the DRAW commands, but don't try to modify directly it!


>> ? a/gob
A/GOB is a gob of value: make gob! [
 offset: 5x5
 size: 105x104
 alpha: 0
 draw: [translate 0x0 clip 0x0 105x104 anti-alias false pen false line-width
   1.0 variable
   pen 255.255.255 fill-pen false anti-alias true pen 0.0.0 line-width 2.7
   variable fill-pen 128.0.0 circle 50x50 40x40
   ]
]



Note that the specification block is not reduced and only valid field names are allowed (see list below.)
You can also create a GOB from another GOB, inheriting its settings:

gob4: make gob1 [text: "Another example"]


Content Types

Each GOB is of a content type that determines the format of its data and how it will be rendered on the display. Complex displays are created by combining layers of GOBs of these various types. For example, you can create a display that has colored text on top of an image on top of a draw-rendered gradient on top of a colored background.
Type Description
color An RGBA color to fill the specified area.
image An RGBA image. The size of the GOB is determined by the size of the image.
draw A block of scalar vector graphic (SVG) commands, such as line, box, and circle.
effect A block of special effect commands, such as blur or colorize, etc.
text A block of rich-text commands including special modes such as bold, italic, color, etc.
In addition a GOB may have no content type and just be used as a pane that holds a list of GOBs that will be composited together. For example a window or a panel used for an input form may be used just for "organizational" purposes.

Access Fields

A GOB datatype allows access to the following fields:
Field Datatype Description
offset pair! the x-y coordinate relative to parent
size pair! width and height of gob canvas or coordinate space
pane block! a block of child gobs (see below)
parent gob! the parent gob (in its pane)
data object! block! string! binary! integer! none! normally used to reference data related to the gob, such as the VID face object
flags block! special flags, see section below
alpha integer! alpha transparency for the gob overall
owner gob! a temporary field used for popup windows to specify the owning parent window
For example:
agob/offset: 100x100
print agob/size
bgob: agob/parent

In addition, these fields are used to access the content of a GOB, depending on its type:
Field Datatype Description
color tuple! the color of the gob
image image! an image within the gob
draw block! a DRAW dialect block
effect block! an EFFECT dialect block
text block! string! a richtext dialect block
Examples:
agob/color: blue
agob/image: load %photo.jpg

Note that you can only specify one content field per GOB. If you attempt to set a second field, it overwrites the earlier one.

Offset and Size

Spatial information about the GOB can be accessed with:
Name Description
offset The x-y offset of the GOB relative to its parent. Either value (or both) can be negative and clipping will occur.
size The width and height of GOB content area. Any graphics that extends outside this area will be clipped.
For example:
gob/offset: 100x20
print gob/offset
gob/size: 150x50

Data Reference

The primary purpose of the data field is to provide a way to reference an object, block, or other data related to your rendering, subsystem, or application.
Although the data field is under the control of the programmer and is not accessed by the GOB system itself, it is used by subsystems like the GUI. For example, in the GUI the data field might point to the face object that stores run-time information such as event handling to quickly locate the face.
Internally, the data field is pointer-sized (32 bits as of writing this page) for optimization reasons. It is not a fully-qualified value field, so can only hold the specific values mentioned above, and any series references contain no indexed offsets. If you need to store general values, use a block or object.

Panes

The pane field provides the tree structure (the hierarchy) for a GOB display. Each pane begins a new relative-coordinate system with sub-GOBs located within it.
Each GOB can include a content and a pane. In such cases, the content is layered behind any GOBs of the pane. The GOBs of the pane are also clipped according to the size of the parent GOB.
The order of layering for GOBs in a pane is last-on-top. That is, they are rendered in the order they appear in the pane, with each successive GOB on top of the others.
Reuse restriction: When a GOB can only be in one pane at a time. If you attempt to insert a GOB into more than one pane, it will be removed form it prior pane. This is a necessary requirement of the linked list used to manage panes and state internal variables required for rendering.

Adding GOBS to Panes

To add one or more GOBs to a pane, use the append or insert functions.
For example, given these gobs:
gob1: make gob! [size: 200x200 color: white]
gob2: make gob! [offset: 20x20 size: 40x30 color: red]
gob3: make gob! [offset: 120x80 size: 50x40 color: blue]

this line will add gob2 to the gob1 pane:
append gob1 gob2
view gob1


Or, you can add several GOBs at the same time:
append gob1 [gob2 gob3]
view gob1


Note that the block of words is not reduced, but words will be looked up.

Other Useful Actions

You can use other series-like functions, such as getting the length:
length? gob1
Or clearing the pane, or specific parts of the pane:
clear gob1
clear at gob1 2

You can also remove from the pane:
remove find gob1 gob2

As well as use indexing refinements:
gob1/1: gob4
gob1/2/image: new-image

All Valid Actions

Here's a full list of all the action functions that operate on the GOB datatype:
Action Description
append Inserts a value at tail of series and returns the series at head. (Modifies)
at Returns the series at the specified index.
back Returns the series at its previous position.
clear Removes all values. For series, removes from current index to tail and returns tail. (Modifies)
find Finds a value in a series and returns the series at the start of it.
head Returns the series at its head.
head? Returns TRUE if a series is at its head.
index? Returns the index number of the current position in the series.
insert Inserts into a series and returns the series after the insert. (Modifies)
length? Returns the length of the series from the current position.
next Returns the series at its next position.
past? Returns TRUE if a series index is past its tail.
pick Returns the value at the specified position in a series.
poke Returns value after changing its data at the given index. (Modifies)
remove Removes value(s) from a series and returns after the remove. (Modifies)
reverse Reverses a series and similar types. (Modifies)
skip Returns the series forward or backward from the current position.
tail Returns the series at the position after the last value.
tail? Returns TRUE if empty, or for series, if index is at or beyond its tail.
take Copies and removes from series. (Typically, removes last GOB.)

Coordinate Mapping

Each GOB pane provides it's own coordinate system. That is, all of it's sub-gobs are located relative to the origin of their parent.
Often you will need to take a position at the top level and map it to a position within a sub-gob, or within even deeper sub-gobs. There are two functions to help perform this mapping:
Function Description
map-gob-offset Translates a gob and offset to the deepest gob and offset in it, returned as a block: the gob and offset. Also supports the reverse operation: given a GOB and offset, provide the GOB and offset within its top-most GOB.
map-event Within an event datatype that has a GOB and offset position, modify the event by mapping to its terminal (lowest) GOB and offset.

GOBs as Windows

The screen and its windows are controlled with GOBs. New windows are opened by adding a window GOB to the screen GOB pane. Windows are closed by removing the window GOB from the pane.

The Screen GOB

The screen-gob is a field in system/view object. The size field of the GOB is the size of the screen:
print system/view/screen-gob/size
1440x900

Each GOB within the screen-gob/pane is a window.

Creating a Window

Note: See R3 View - Windowing System for more information about windows.
Normally, windows are created by the view function. Internally, it creates a new GOB for the window. The offset provides the position of the window, and the size provides its width and height. If text is provided, it will become the window caption. (Window GOBs do not allow color, image, draw, or effect content types, only text for the caption.)
For example, if you create a GOB:
win: make gob! [text: "Test Window" offset: 100x100 size: 300x200]

You can use that for a window by calling view this way:
view/as-is win ; use the argument as the window itself

Or, you could open the window on screen with this:
append system/view/screen-gob win
show win

However, this method should be avoided. You should use the view function, which handles many other features.

Window Flags

Window GOBs accept these special flags:
Flag Description
dropable allow drag and drop of files
hidden window is hidden
modal modal event handling (for requestors)
no-border do not draw window borders (or title)
no-title do not show window title
on-top keep window on top
popup a popup window (has owning parent window)
resize allow the window to be resized
transparent let the window be transparent
These flags can be set like this:
win/flags: [resize dropable]

or during the MAKE with:
win: make gob! [size: 100x200 flags: [resize]]

You can obtain the flags block with:
probe win/flags

Event Handling

Window events such as mouse moves and button clicks are mapped by the native system to an offset within a specific window gob. The higher level event system is responsible for locating the specific sub-gob target of the click, if that action is desired.
Typically, a GOB that requires interactivity, such as processing of button events will be part of a higher level face object, and the processing of the specific events will be done by functions of that face.
For more information see R3 View - Event Handling and R3 View - Windowing System sections.

Rendering Graphics

Graphics is rendered with the show function. This same function is used for both initial rendering as well as updates (refresh). The target GOB to render is specified as the argument.
The line:
show gob1

Render gob1 as well as all sub-gobs in its pane, if it has one. If the GOB is already being displayed, it's display would be refreshed.
This same function is true for window GOBs:
show win

renders all of the graphics in the window and redisplays it.
The show function also allows a block of GOBs:
show [gob1 gob2 gob3]

As you can see, if the gobs are words, their values will be used.
Here are a few important notes about rendering:
  • Rendering order is first to last
    For GOB panes, each GOB is rendered in the order it appears in the pane, with each successive GOB on top of the others, with the last GOB on top.
  • Background refresh
    When a GOB offset is moved relative to its parent GOB, or when it changes size, any background behind the GOB is re-rendered. (Internally a GOB stores its old-offset and old-size information for use in this process.)
  • Optimized show
    If a gob appears more than once within a show block (and the panes of gobs in that block) the second case of the GOB will be ignored (an optimization).
  • Delayed show
    If you are changing several GOBs during a single event, it is more efficient to keep a list of changes then render all the changes together with a single call to show. In the R3 GUI, this is done by defining a show-later that queues the requests to a block, then calls show-now to refresh the display.

Transparency

GOBs support two levels of transparency.
  1. Images or colors may specify transparency. For example, an image with transparent rounded edges.
  2. The transparency of a GOB can be controlled with /alpha. This setting affects the entire GOB (and all subGOBs within it). The range is 0 to 255.
An example of setting the transparency of a GOB:

gob1: make gob! [size: 200x100 text: "Example of transapency"]
gob2: make gob! [size: 180x50]
gob2/image: load %logo.gif
gob2/alpha: 200
append gob1 gob2
view gob1



Note on speed optimization: if an image or color is found not to be transparent, and the /alpha field fully opaque, the compositing system will optimize the action (using a non-transparent blit). The speed difference is significantly faster, but should only matter in special cases, such as when moving or updating large areas of a window (e.g. playing a large animation or video, where alpha is not so important.)

Examples

The example below creates a window with a background image and an image on top of that background. Note, that setting gobb/image to back-img automatically sets gobb/size to the image's size - or, to state it differently, for image GOBs the size is always equal to that of the image.
Rebol []
;-- Background image
gobb: make gob! [offset: 0x0]
gobb/image: load %rebol-3d.png
;-- Top image:
gobi: make gob! [offset: 10x10]
gobi/image: load %icon.png
;-- The window:
win: make gob! [] ;[text: "Test Window"]
win/size: gobb/size
append win gobb
append win gobi
view win