Friday, 30 November 2012

HTML calendar

Do you want to create a calendar of the current month in HTML, just use Rebol:

Here the source:
REBOL [
    Title: "HTML calendar"
    Date: 3-Dec-2003
    Author: "Bohdan Lechnowsky"
    File: %html-calendar.r
    Purpose: {
        Creates an HTML file containing the current calendar month and displays it in
        the browser
    }
]
date: now/date
colwidth: 100
dayrowcol: "806080"
daytextcol: "FFFFFF"
wkendcol: "FFCCCC"
wkdaycol: "FFFFFF"
notthismonthcol: "808080"
outfilename: %month.html
html: copy rejoin [{<HTML><TABLE border=1><TR><TD colspan=7 align=center><FONT size="+2">} pick system/locale/months date/month { } date/year {</FONT></TD></TR><TR>}]
days: head remove back tail insert head copy system/locale/days last system/locale/days
foreach day days [
    append html rejoin [{<TD bgcolor="#} dayrowcol {" align=center width=} colwidth {><FONT face="courier new,courier" color="} daytextcol {" size="+1">} copy/part day 3 {</FONT></TD>}]
]
append html {</TR><TR>}
sdate: date
sdate/day: 0
loop sdate/weekday // 7 + 1 [append html {<TD bgcolor=gray></TD>}]
while [sdate/day: sdate/day + 1 sdate/month = date/month][
    append html rejoin [
        {<TD bgcolor="#}
        either find [6 7] sdate/weekday [wkendcol][wkdaycol]
        {">} sdate/day {</TD>}
    ]
    if sdate/weekday = 6 [append html {</TR><TR>}]
]
loop 7 - sdate/weekday [append html rejoin [{<TD bgcolor="#} notthismonthcol {"></TD>}]]
append html {</TR></TABLE></HTML>}
write outfilename html
browse outfilename

Thursday, 29 November 2012

Compression

You know that Rebol compress function compress data, but you can manipulate also TAR.GZ archives and ZIP archives.
For TAR.GZ archives there are the following script:
They can be used this way:
do %tar.r
do %gzip.r
write/binary %test.tgz gzip tar [%some-files ...]


Resulting archive is usually smaller than a *.zip of the same files
To decompress use  gunzip.r script

For ZIP archives there is the following script: http://www.rebol.org/download-a-script.r?script-name=rebzip.r
usage: zip/deep %new-zip.zip [ %readme.txt "An example" ftp://192.168.1.10/my-file.txt %my-directory/ ]
to unzip unzip %new-zip.zip

If you want to only explore a zip file without decompress it, you can use this script: http://www.rebol.org/download-a-script.r?script-name=zip.r

Wednesday, 28 November 2012

Graphing calculator

Here a great script to draw graphic functions (graph), it's perfect:
Here the source code:


REBOL [
    Title: "Graph a function"
    File: %graph.r
    Author: "Phil Bevan"
    Date: 21-Oct-2001/12:00:00
    Version: 1.1.0
    Email: philb@upnaway.com
    Category: [math]
    Purpose: {
        Graph a function
        rounding function by Ladislav Mecir
        Usage ....
            Type in your function of x into the input field        
       
        Some pretty functions to get you started .....
        3 * sin (0.5 * pi * x)
        3 * sin (x * x)
        exp(0.1 * x) * (sin(4 * pi * x))
        4 * sin (4 * pi / x)
        0.2 * exp(- x) * sin (0.5 * pi * x)
        10 / ((3 * x * x) + (4 * x) - 3)
    }
    History: [
        1.0.1   ["Initial version" "Phil Bevan"]
        1.0.2   ["Initial Version submitted to library" "Phil Bevan"]
        1.0.3   ["Tidy up GUI Settings" "Phil Bevan"]
        1.0.4   ["Change line type Button choice to rotary" "Phil Bevan"]
        1.0.5   ["Add Navigation Panel" "Phil Bevan"]
        1.0.6   ["Add Grid Markings & Finish Nav Panel" "Phil Bevan"]
        1.0.7   ["Add help function,flash Drawing Graph" "Phil Bevan" ]
        1.1.0   ["Use draw dialect to draw graph" "Phil Bevan"]
        ]
    Email: philb@upnaway.com
]
; functions
paper: make object!
[
    size: 0x0
    x-min: -1
    x-max: 1
    y-min: -1
    y-max: 1
    grid: yes
    x-grid: 0.5
    y-grid: 0.5
    zoom-in: 0.5
    zoom-out: 2
    grid-color: sky
    axes: yes
    axes-color: black
    paper-color: white
    pen-color: black
    axes-color: black
    image: none
    draw: copy []
    crt: func
    [
        size [pair!]
        xmin [decimal!]
        xmax [decimal!]
        ymin [decimal!]
        ymax [decimal!]
    ]
    [
        self/size: size
        self/x-min: xmin
        self/x-max: xmax
        self/y-min: ymin
        self/y-max: ymax
    ]
]
; plot a point
fn-plot: func [paper [object!] p [pair!] col [tuple!] /local i xs ys]
[
    xs: paper/size/x
    ys: paper/size/y
    if any[p/x < 1 p/x > xs p/y < 1 p/y > ys]
        [return]
   
    append paper/draw 'pen
    append paper/draw col
    append paper/draw 'line
    append paper/draw p
    append paper/draw p
]
fn-draw-line: func [
    {draw line from point a to b using Bresenham's algorithm}
    paper [object!]
    a [pair!]
    b [pair!]
    color [tuple!]
    /local d inc dpr dpru p set-pixel xs ys
][
    append paper/draw 'pen
    append paper/draw color
    append paper/draw 'line
    append paper/draw a
    append paper/draw b
]
; Convert Degrees to Radians & Radians to Degrees
rad: function [x] [] [x * pi / 180 ]
deg: function [x] [] [x * 180 / pi ]
; trig functions
sin: function [x] [] [return sine/radians x]
cos: function [x] [] [return cosine/radians x]
tan: function [x] [] [return tangent/radians x]
; square-root
sqrt: function [x] [] [return square-root x]
; hyperbolic trig functions
sinh: function [x] [] [return ((exp(x)) - (exp(- x))) / 2]
cosh: function [x] [] [return ((exp(x)) + (exp(- x))) / 2]
tanh: function [x] [] [return ((exp(2 * x)) - 1) / ((exp(2 * x)) + 1)]
fac: func [x [integer!] /local fa i]
[
    if x < 0 [return none]
    fa: 1.0
    i: 1
    while [i <= x]
    [
        fa: fa * i
        i: i + 1
    ]
    return fa
]
; create a function
create-function: function [t-func [string!]] [f]
[
    ; return a newly created function
    if error? try [f: to-block load t-func]
        [return none]
    function [x [any-type!]] [] f
]
mod: func
[
    {compute a non-negative remainder}
    a [number!]
    b [number!]
    /local r
]
[
    either negative? r: a // b [
        r + abs b
    ] [r]
]
round: func
[
    "Round a number"
    n [number!]
    /places
    p [integer!] {Decimal places - can be negative}
    /local factor r
]
[
    factor: either places [10 ** (- p)] [1]
    n: 0.5 * factor + n
    n - mod n factor
]
floor: func [
    n [number!]
    /places
    p [integer!] {Decimal places - can be negative}
    /local factor r
] [
    factor: either places [10 ** (- p)] [1]
    n - mod n factor
]
ceiling: func [
    n [number!]
    /places
    p [integer!] {Decimal places - can be negative}
    /local factor r
] [
    factor: either places [10 ** (- p)] [1]
    n + mod (- n) factor
]
truncate: func [
    n [number!]
    /places
    p [integer!] {Decimal places - can be negative}
    /local factor r
] [
    factor: either places [10 ** (- p)] [1]
    n - (n // factor)
]
; initialise the graph
init-graph: func [paper [object!]]
[
    gr-paper-f/color: paper/paper-color
    show gr-paper-f
    clear paper/draw
    fn-draw-axes paper
]
fn-draw-axes: func [paper /local pt]
[
    fn-draw-grid paper
    pt: coordinates paper 0 0
    if all [pt/y >= 0 pt/y < paper/size/y]
        [fn-draw-line paper to-pair reduce [1 pt/y] to-pair reduce [(paper/size/x - 1) pt/y] paper/axes-color] ; x-axis
    if all [pt/x >= 0 pt/x < paper/size/x]
        [fn-draw-line paper to pair! reduce [pt/x 1] to pair! reduce [pt/x paper/size/y] paper/axes-color]; y-axis
]
; draw grid
fn-draw-grid: func [paper [object!] /local gs pt-from pt-to]
[
    if all [paper/x-grid <> 0 paper/x-max - paper/x-min > paper/x-grid]
    [
        ; draw x-gridlines
        either paper/x-min < 0
            [gs: (to-integer (paper/x-min / paper/x-grid) - 1) * paper/x-grid]
            [gs: (to-integer (paper/x-min / paper/x-grid) + 1) * paper/x-grid]
        while [gs <= paper/x-max]
        [
            gs: gs + paper/x-grid
            pt-from: coordinates paper gs 0
            pt-to: coordinates paper gs 0
            pt-from/y: 1
            pt-to/y: paper/size/y - 1
            ; print [pt-from pt-to]
            fn-draw-line paper pt-from pt-to paper/grid-color
        ]
    ]  
    if all [paper/x-grid <> 0 paper/y-max - paper/y-min > paper/y-grid]
    [
        ; draw y-gridlines
        gs: (to-integer (paper/y-min / paper/y-grid)) * paper/y-grid
        while [gs <= paper/y-max]
        [
            gs: gs + paper/y-grid
            pt-from: coordinates paper 0 gs
            pt-to: coordinates paper 0 gs
            pt-from/x: 1
            pt-to/x: paper/size/x - 1
            fn-draw-line paper pt-from pt-to paper/grid-color
        ]
    ]
    font-obj: make face/font [
        name: font-fixed
        size: 12
        ; style: [italic]
    ]
    lv-coords: rejoin ["(" paper/x-min "," paper/y-min ") - (" paper/x-max "," paper/y-max ")"]
    lv-text-pos: make pair! reduce [0 (paper/size/y - 14)]
    append paper/draw 'font
    append paper/draw font-obj
    append paper/draw 'pen
    append paper/draw paper/axes-color
    append paper/draw 'text
    append paper/draw lv-text-pos
    append paper/draw lv-coords
]
; convert to co-ordinates
coordinates: func [paper [object!] x [number!] y [number!] /local xc yc]
[
    xd: x - paper/x-min
    xp: (paper/x-max - paper/x-min) / paper/size/x
    xc: xd / xp
    if any [xc < 0 xc > paper/size/x] [-1]
    if error? try [ xc: to-integer round xc]
        [return none]
   
    yd: y - paper/y-min
    yp: (paper/y-max - paper/y-min) / paper/size/y
    yc: paper/size/y - (yd / yp)
    if any [yc < 0 yc > paper/size/y] [-1]
    if error? try [ yc: to-integer round yc]
        [return none]
    return make pair! reduce [xc yc]
]
new-styles: stylize
[
    fix-area: area font [name: "courier new" size: 12] wrap
    fix-field: field font [name: "courier new" size: 12]
    fix-text: text font [name: "courier new" size: 12]
]
; Draw the graph
draw-graph: func
[
    paper [object!] t-fx [string!] trace [string!]
    /local x x-step fx pt last-pt lv-flash
]
[
    if t-fx = ""
        [request/ok "No function entered" return]
    f-fx: create-function t-fx
    if not function? :f-fx
        [request/ok "Improper function entered" return]    
    lv-flash: flash "Drawing graph"
    last-pt: none
    x-step: (paper/x-max - paper/x-min) / paper/size/x
    for x paper/x-min paper/x-max x-step
    [
        either not error? try [fx: f-fx x]
        [
            pt: coordinates paper x fx
            if pt <> none
                [
                    switch trace
                    [
                        "Point"
                            [fn-plot paper pt paper/pen-color]
                        "Line"
                            [
                                either last-pt <> none
                                    [fn-draw-line paper last-pt pt paper/pen-color]
                                    [fn-plot paper pt paper/pen-color]
                            ]
                    ]
                ]
            last-pt: pt
        ]
        [last-pt: none]
    ]
    unview lv-flash
]
; Graph Paper settings
gr-settings: func
[
    paper [object!]
    gr-face [object!]
    /local f-xmin f-xmax f-ymin f-ymax f-paper-color f-pen-color lv-valid lv-col
        lv-x-min lv-x-max
        lv-y-min lv-y-max
        lv-x-grid lv-y-grid
]
[
    view/new layout
    [
        backdrop 0.150.0
        styles new-styles
        origin 5x5
        space 5
        across
        at 5x5
        label "Min X" right 80x24
        f-xmin: fix-field to-string(paper/x-min) 100x24
        return
        label "Max X" right 80x24
        f-xmax: fix-field to-string(paper/x-max) 100x24
        return
        label "Min Y" right 80x24
        f-ymin: fix-field to-string(paper/y-min) 100x24
        return
        label "Max Y" right 80x24
        f-ymax: fix-field to-string(paper/y-max) 100x24
        return
        label "X Grid size" right 80x24
        f-xgrid: fix-field to-string(paper/x-grid) 100x24
        return
        label "Y Grid size" right 80x24
        f-ygrid: fix-field to-string(paper/y-grid) 100x24
        return
        label "Zoom+" right 80x24
        f-zoom-in: fix-field to-string(paper/zoom-in) 100x24
        return
        label "Zoom-" right 80x24
        f-zoom-out: fix-field to-string(paper/zoom-out) 100x24
        return
        pad 0x-3
        label "Clear" right 80x24
        pad 0x3
        cb-clear: check with [state: false]
        return
        pad 0x-5
        button "Paper Color" 80x24
        [
            lv-col: request-color/color paper/paper-color
            if lv-col <> none
            [
                f-paper-color/color: lv-col
                show f-paper-color
            ]
        ]
        f-paper-color: box paper/paper-color 100x24 edge [size: 2x2 color: gray effect: 'bevel]
        return
        button "Pen Color" 80x24
        [
            lv-col: request-color/color paper/paper-color
            if lv-col <> none
            [
                f-pen-color/color: lv-col
                show f-pen-color
            ]
        ]
        f-pen-color: box paper/pen-color 100x24 edge [size: 2x2 color: gray effect: 'bevel]  
        return
        button "Grid Color" 80x24
        [
            lv-col: request-color/color paper/paper-color
            if lv-col <> none
            [
                f-grid-color/color: lv-col
                show f-grid-color
            ]
        ]
        f-grid-color: box paper/grid-color 100x24 edge [size: 2x2 color: gray effect: 'bevel]  
        return
        button "Apply" 185x24
        [
            lv-valid: true
            if error? try [lv-x-min: to-decimal f-xmin/text] [alert "Invalid Min X value entered" lv-valid: false focus f-xmin]
            if lv-valid [if error? try [lv-x-max: to-decimal f-xmax/text] [alert "Invalid Max X value entered" lv-valid: false focus f-xmax]]
            if lv-valid [if lv-x-min >= lv-x-max [alert "Min X value must be less than Max X value" lv-valid: no focus f-xmin]]
            if lv-valid [if error? try [lv-y-min: to-decimal f-ymin/text] [request/ok "Invalid Min Y value entered" lv-valid: false focus f-ymin]]
            if lv-valid [if error? try [lv-y-max: to-decimal f-ymax/text] [request/ok "Invalid Max Y value entered" lv-valid: false focus f-ymax]]
            if lv-valid [if lv-y-min >= lv-y-max [alert "Min Y value must be less than Max Y value" lv-valid: false focus f-ymin]]
            if lv-valid [if error? try [lv-x-grid: to-decimal f-xgrid/text] [request/ok "Invalid X grid value entered" lv-valid: false focus f-xgrid]]
            if lv-valid [if lv-x-grid < 0 [alert "X Grid value cannot be < 0" lv-valid: no focus f-xgrid]]
            if lv-valid [if error? try [lv-y-grid: to-decimal f-ygrid/text] [request/ok "Invalid Y grid value entered" lv-valid: false focus f-ygrid]]
            if lv-valid [if lv-y-grid < 0 [alert "Y Grid value cannot be < 0" lv-valid: no focus f-ygrid]]
            if lv-valid [if error? try [lv-zoom-in: to-decimal f-zoom-in/text] [request/ok "Invalid Zoom in factor entered" lv-valid: false focus f-zoom-in]]
            if lv-valid [if any [lv-zoom-in < 0 lv-zoom-in > 1] [alert "Zoom in factor must be between 0 & 1" lv-valid: no focus f-zoom-in]]
            if lv-valid [if error? try [lv-zoom-out: to-decimal f-zoom-out/text] [request/ok "Invalid Zoom out factor entered" lv-valid: false focus f-zoom-out]]
            if lv-valid [if lv-zoom-out < 1 [alert "Zoom out factor must be > 1" lv-valid: no focus f-zoom-out]]
            if lv-valid = yes
            [
                paper/x-min: lv-x-min
                paper/x-max: lv-x-max
                paper/y-min: lv-y-min
                paper/y-max: lv-y-max
                paper/x-grid: lv-x-grid
                paper/y-grid: to-decimal f-ygrid/text
                paper/zoom-in: lv-zoom-in
                paper/zoom-out: lv-zoom-out
                paper/paper-color: f-paper-color/color
                paper/pen-color: f-pen-color/color
                paper/grid-color: f-grid-color/color
                unview
                if cb-clear/data = true
                [
                    init-graph paper
                    show gr-face
                ]
            ]
        ]
    ]
]
fn-left: func [paper [object!] /local dx]
[
    dx: (paper/x-max - paper/x-min) / 10
    paper/x-min: paper/x-min - dx
    paper/x-max: paper/x-max - dx
    init-graph paper
    draw-graph paper t-func1/text first r-trace/data
    show gr-paper-f    
]
fn-right: func [paper [object!] /local dx]
[
    dx: (paper/x-max - paper/x-min) / 10
    paper/x-min: paper/x-min + dx
    paper/x-max: paper/x-max + dx
    init-graph paper
    draw-graph paper t-func1/text first r-trace/data
    show gr-paper-f    
]
fn-up: func [paper [object!] /local dy]
[
    dy: (paper/y-max - paper/y-min) / 10
    paper/y-min: paper/y-min + dy
    paper/y-max: paper/y-max + dy
    init-graph paper
    draw-graph paper t-func1/text first r-trace/data
    show gr-paper-f    
]
fn-down: func [paper [object!] /local dy]
[
    dy: (paper/y-max - paper/y-min) / 10
    paper/y-min: paper/y-min - dy
    paper/y-max: paper/y-max - dy
    init-graph paper
    draw-graph paper t-func1/text first r-trace/data
    show gr-paper-f    
]
fn-zoom-in: func [paper [object!] /local mid]
[
    mid: paper/x-min + ((paper/x-max - paper/x-min) / 2)
    nsize: (paper/x-max - paper/x-min) * paper/zoom-in / 2
    paper/x-min: mid - nsize
    paper/x-max: mid + nsize
    mid: paper/y-min + ((paper/y-max - paper/y-min) / 2)
    nsize: (paper/y-max - paper/y-min) * paper/zoom-in / 2
    paper/y-min: mid - nsize
    paper/y-max: mid + nsize
    init-graph paper
    draw-graph paper t-func1/text first r-trace/data
    show gr-paper-f    
]
fn-zoom-out: func [paper [object!] /local mid]
[
    mid: paper/x-min + ((paper/x-max - paper/x-min) / 2)
    nsize: (paper/x-max - paper/x-min) * paper/zoom-out / 2
    paper/x-min: mid - nsize
    paper/x-max: mid + nsize
    mid: paper/y-min + ((paper/y-max - paper/y-min) / 2)
    nsize: (paper/y-max - paper/y-min) * paper/zoom-out / 2
    paper/y-min: mid - nsize
    paper/y-max: mid + nsize
    init-graph paper
    draw-graph paper t-func1/text first r-trace/data
    show gr-paper-f    
]
;
; Main Line
;
gr-size: 500x500
gr-paper: make paper []
gr-paper/crt gr-size -5.0 5.0 -5.0 5.0
gr-paper/pen-color: 0.0.255
; colors
panel-back: 80.150.80
fn-draw-axes gr-paper
lv-init-eqn: "(sine (x * 256)) / x"
;
; view the window
;
lv-layout: layout [
    backdrop panel-back
    origin 0x0
    styles new-styles
    at 0x0
    space 0x0
    across
    panel teal
    [
        origin 0x0
        space 0
        across  
        vtext "Save" bold white teal 40x24
        [
            t-save-name: request-file/title/filter/keep/file "Save Graph as png" "Save" "*.png" "graph.png"
            if t-save-name <> none
            [
                if error? try [save/png to-file t-save-name to-image gr-paper-f] ; gr-paper/image]
                    [request/OK "Unable to Save graph"]
            ]
        ]
        vtext "Settings" bold white teal [gr-settings gr-paper gr-paper-f] 60x24
        vtext "Help" bold white teal 40x24
        [
            either exists? %graph.html
            [browse %graph.html]
            [browse http://www.upnaway.com/~philb/philip/utils/graph.html]
        ]
    ] edge [size: 1x1 color: gray effect: 'bevel] 495x24
    image logo.gif
    return
    panel
    [
        across
        origin 5x5
        space 5x5
        at 5x5
        gr-paper-f: box gr-paper/size gr-paper/paper-color
            effect reduce ['draw gr-paper/draw]
        return
        t-func1: fix-field lv-init-eqn (gr-size * 1x0 + 0x24)
        space 0
        return
        r-trace: rotary 120.20.120 100x24 data ["Line" "Point"]
        button "Graph Color"
        [
            gr-col: request-color/color gr-paper/pen-color
            if gr-col <> none [gr-paper/pen-color: gr-col]
        ]
        space 0x5
        button "Draw f(x)" 100x24
        [
          draw-graph gr-paper t-func1/text first r-trace/data
          show gr-paper-f
        ]
        button "Save Equation"
        [
            either t-func1/text = ""
            [request/ok "No equation to Save"]
            [
                filnm: request-file/title/filter/file/keep "Save Equation" "Save" "*.eqn" "graph.eqn"
                if filnm <> none
                [
                    if error? try [write to-file filnm t-func1/text]
                    [request/OK "Unable to Save Equation"]
                ]
            ]
        ]
        button "Load Equation"
        [
            filnm: request-file/title/filter/file/keep "Load Equation" "Load" "*.eqn" "graph.eqn"
            if filnm <> none
            [
                t-func1/text: read to-file filnm
                show t-func1
            ]
        ]
   
    ] 510x510 + (2 * 0x25) + 0x5
    panel
    [
        backdrop panel-back
        at 5x5
        panel
        [
            backdrop brick
           
            origin 5x5
            space 5
            at 5x5
            panel
            [
                at 0x20
                arrow left 20x20 [fn-left gr-paper]
                at 40x20
                arrow right 20x20 [fn-right gr-paper]
                at 20x0
                arrow up 20x20 [fn-up gr-paper]
                at 20x40
                arrow down 20x20 [fn-down gr-paper]
            ] 70x70
            button "Zoom +" [fn-zoom-in gr-paper] 60x24
            button "Zoom -" [fn-zoom-out gr-paper] 60x24
            button "Clear" [init-graph gr-paper show gr-paper-f] 60x24
        ] edge [size: 2x2 color: gray effect: 'bevel] 90x510 + (2 * 0x24) 0x3
    ] 80x510 + (2 * 0x25) + 0x10
]
lv-layout/offset: system/view/screen-face/size - lv-layout/size / 2
view/title lv-layout
    reform [system/script/header/title system/script/header/version]

A message from Carl

Carl Sassenrath wrote:
made good progress over the holiday, powered by turkey sandwiches from France.

Prep of C source nearly done. See, not just a dump and run. Sure, a few problems came up, but I'm not going to hold up the release for them. You can decide.

Grabbed latest git source and built it for this dev box (which did not support 1.8 version as bin.)

Once released, I've got a number of notes to write up. Like how to quickly port R3. Takes about 5 mins if you know what you're doing. Got it up on ARM & MIPS Linux.

Also, I have some goals in mind. Android and iphone, that kind of thing. Getting graphics and sound back up. GUI and tinyGUI. A micro-R3 for smallish embedded systems.

There's a lot you can help with. Delegation, right?


Tuesday, 27 November 2012

VID gradients

This is a collection of scripts about gradients in Rebol:
spec: [style grad box 160x160 font [color: yellow size: 24]]
vectors: [0x0 0x1 0x-1 | 1x0 1x1 1x-1 | -1x0 -1x1 -1x-1]
foreach v vectors [
    append spec either word? v ['return][
        compose/deep [grad form (v) effect [gradient (v) 200.0.0 0.0.200]
        ]
    ]
]
view layout spec


pic: load-thru/binary http://www.rebol.com/view/bay.jpg
page: does [
    foo: copy [backdrop 0.0.0 [unview/all view layout page]]
    loop 5 [loop 5 [append foo compose/deep [
        image pic 80x80 (random 255.255.255) with [effect: [fit gradcol (2x2 - random 3x3)
            (random 255.255.255) 0.0.0]]]]   append foo [return]
    ]
    append foo [backdrop [unview/all view layout page] with [color: none]]
]
view layout page

Click on the window to change gradients

pic: load-thru/binary http://www.rebol.com/view/bay.jpg
spec: [style grad box font [color: yellow size: 24]]
vectors: [0x0 0x1 0x-1 | 1x0 1x1 1x-1 | -1x0 -1x1 -1x-1]
foreach v vectors [
    append spec either word? v ['return][
        compose/deep [grad pic form (v) effect [gradcol (v) 200.0.0 0.0.200]
        ]
    ]
]
view layout spec



pairs: [1x0 -1x0 0x1 0x-1 1x1 -1x1 -1x-1 1x-1]
r-t: does [random 255.255.255]
r-s: does [50x50 + random 200x200]
r-v: does [pairs: next pairs all [tail? pairs pairs: head pairs] pairs/1]
view layout do page: does [
    foo: copy [backdrop 0.0.0]
    sz: r-s
    loop 3 [
    loop 3 [
        append foo compose/deep [box (sz) (form v: r-v) with [
            effect: [fit gradient (v)(r-t)(r-t)]]
            ]
        ]
    append foo [return]
    ]
    append foo [backdrop [unview/all view layout page] with [color: none]]
]



Click window to change

REBOL [
    Title: "Gradient Colorize Examples"
    Date: 22-May-2001/17:13:56-7:00
    Version: 1.0.0
    File: %grad-image.r
    Author: "Carl at REBOL"
    Purpose: "Applies multiple gradients to a single image."
    Email: carl@rebol.com
]
flash "Fetching image..."
img: load-thru/binary http://www.rebol.com/view/demos/nyc.jpg
unview
view layout [
    across backdrop 0.50.0
    style box box img 80
    vh1 "Gradient Colorize Examples"
    below guide
    box effect [fit gradcol]
    box yellow effect [fit gradcol]
    box effect [fit gradcol 200.0.0]
    box yellow effect [fit gradcol 200.0.0]
    box effect [fit gradcol 200.0.0 0.0.200]
    return
    box effect [fit gradcol 1x0]
    box yellow effect [fit gradcol 1x0]
    box effect [fit gradcol 1x0 200.0.0]
    box yellow effect [fit gradcol 1x0 200.0.0]
    box effect [fit gradcol 1x0 200.0.0 0.0.200]
    return
    box effect [fit gradcol -1x0]
    box yellow effect [fit gradcol -1x0]
    box effect [fit gradcol -1x0 200.0.0]
    box yellow effect [fit gradcol -1x0 200.0.0]
    box effect [fit gradcol -1x0 200.0.0 0.0.200]
    return
    box effect [fit gradcol 0x1]
    box yellow effect [fit gradcol 0x1]
    box effect [fit gradcol 0x1 200.0.0]
    box yellow effect [fit gradcol 0x1 200.0.0]
    box effect [fit gradcol 0x1 200.0.0 0.0.200]
    return
    box effect [fit gradcol 0x-1]
    box yellow effect [fit gradcol 0x-1]
    box effect [fit gradcol 0x-1 200.0.0]
    box yellow effect [fit gradcol 0x-1 200.0.0]
    box effect [fit gradcol 0x-1 200.0.0 0.0.200]
    return
    box effect [fit gradcol 1x1]
    box yellow effect [fit gradcol 1x1]
    box effect [fit gradcol 1x1 200.0.0]
    box yellow effect [fit gradcol 1x1 200.0.0]
    box effect [fit gradcol 1x1 200.0.0 0.0.200]
    return
    box effect [fit gradcol -1x1]
    box yellow effect [fit gradcol -1x1]
    box effect [fit gradcol -1x1 200.0.0]
    box yellow effect [fit gradcol -1x1 200.0.0]
    box effect [fit gradcol -1x1 200.0.0 0.0.200]
    return
    box effect [fit gradcol 1x-1]
    box yellow effect [fit gradcol 1x-1]
    box effect [fit gradcol 1x-1 200.0.0]
    box yellow effect [fit gradcol 1x-1 200.0.0]
    box effect [fit gradcol 1x-1 200.0.0 0.0.200]
    return
    box effect [fit gradcol -1x-1]
    box yellow effect [fit gradcol -1x-1]
    box effect [fit gradcol -1x-1 200.0.0]
    box yellow effect [fit gradcol -1x-1 200.0.0]
    box effect [fit gradcol -1x-1 200.0.0 0.0.200]
]







Monday, 26 November 2012

GLayout

What is Glayout?
Glayout is a new dialect for making wonderful resizable GUI, like RebGUI, here an example:
Developer page of Glayout is: http://www.pointillistic.com/open-REBOL/moa/steel/glayout/index.html
a demo is here: http://www.rebol.org/download-a-script.r?script-name=glayout-demo.r
unfortunately there isn't a good documentation, so I'll try to explain how it works and how to use it; otherwise you could try to contact the author at:  moliad@aei.ca
First of all you have to download two scripts:
Slim is a tool to avoid to overwrite system words, creating new object inside the slim object, glayout use slim because it recreates a new VID dialect without interfering with it.
Now our script must start this way:

Rebol[]
do %slim.r
do %glayout.r

then we must start the glayout engine:

gl: slim/open 'glayout none

this way we created a gl object that contains all names and functions of VID, but different from the classic VID.
Remember always to add:

do-events

at the end of you script.
The main difference between VID and Glayout is the items arrangement: if you don't specify object position or a object nesting objects, items will be one over another.
Here an example:
wrong
gl/view [button "Hello" button "world" ]
correct
gl/view [row [button "Hello" button "world"]]
So the best way is to alway put elements in row, column or other elastic sub-panels (see below for more information).
Another interesting topic is that you don't need to use the layout function, you can send you block of gui elements directly to the gl/view function.

Snaphsot

You can made a snapshot of every GUI with SHIFT+F8.

Separators

You can use spacer and elastic to add a fixed or elastic space between elements:
elastic
header "Hello"
spacer 30
text "world"
elastic

Styles

Text

The text styles are:
  • text: simple text
  • wtext: white text
  • vtext: video text
  • lvtext: left aligned video text
  • rvtext: right aligned video text
  • grp-text: video text with shadow on the top
  • label: label style
  • banner: a text inside a banner
  • header: title style
  • vh3: video style bold italic
  • hitext: yellow text

Buttons

Buttons are of just two types: button and btn. They both automatically resize to the length of the text.
You have many keywords to change their aspect:
  • shrink: is text is few, and you need a smaller button than standard, use shrink
  • corner: you can specify button corner radius
  • the first color specify outline color
  • the second  color specify the inner color
  • deep: you can specify the inner color without specifying the outline color

Fields

  • field
  • tel-fld: Field with input filter (america phone number: ###-###-####)
  • text-area

Toggles


  • check: a simple check, you can access to the state with refinement /data
  • toggle-text: a line of text, if you selects a toggle text, the other toggle-text are deselected. You can't access to the state, but you can add action like other VID elements

Drop-down menu

menu-choice is a drop-down menu with submenus. You can add submenu as sub-blcks of the main blocks. You can add separator lines with separator keyword. You can access to the selected with the data keyword. Look this example

menu-choice "Menu-choice 1" ["one" "two" separator "three" "four" ["submenu" "AAA" "BBB" "CCC"]] [gl/inform join "Selected: " data]

choiche is a simple drop-down menu.

Scroller

It's a simple scroller style

Progress

It' a simple progress bar, data starts from 0.0 (0%) to 1.0 (1%).

File browser box

This is a very useful box, just use the filebox keyword. You can access to the current dir and current file with: /current-dir and /current-file.
Tu update the box use /browse-path/update and the directory to show You must alway put filebox in a scrollpanel to avoid problems in filelist size; here an example:

do %slim.r
do %glayout.r
gl: slim/open 'glayout none
gl/view [
column [
scrollpane [ fbx: filebox browse-path what-dir ]
row [
button "root" [fbx/browse-path/update %/ ]
button "up" [fbx/browse-path/update 'parent]
]
]
]
do-events


Groups

You can/must groups elements with elastic sub-panels, you can nest them indefinitely:
  • center: it centers content, it has borders
  • row: it disposes content in a row, no borders
  • column: it disposes content in a column, no borders
  • hpane: it disposes content in a row, video borders
  • vpane: it disposes content in a column, video borders
  • hform: it disposes content in a row, edge borders
  • vform: it disposes content in a column, edge borders
  • hblack: it disposes content in a row, black edge borders
  • vblack: it disposes content in a column, black edge borders
  • scrollpane: automatic scrollable container

Requestors

  • gl/request-confirm: confirmation pop up, after a description string put a block containing buttons to show
  • gl/inform: ultra basic modal dialog
  • gl/request-file: file requester
  • gl/request-text: text requester
  • gl/request-error: first string title, second string error number/type, third string close button text, /help help button

Object browser

The best feature of GLayout, you can explore every object without limit: gl/request-inspector