REBOL [
    Title: "Standard GUIS"
    Purpose: "A few handy things for View."
    Author: "Brett Handley"
    Date: 4-May-2001
    Comment: {
        The scrolling stuff here was made for View 1.2. Later
        versions of View may render this stuff obsolete.
    }
]

scroll-face: function [
    face [object!]
    max-size [pair!]
    /width slider-width
    /fixed "Return a face extactly of size max-size." default-color
][
    crop-size max-scroll vslide? hslide? up-down left-right
    crop-box ud-sld lr-sld vid-spec
][
    if not width [slider-width: 15]
    if not fixed [default-color: face/color]
    vslide?: func [size max-size][greater? size/2 max-size/2]
    hslide?: func [size max-size][greater? size/1 max-size/1]
    up-down: vslide? face/size max-size
    left-right: hslide? face/size max-size
    repeat i 2 [
        if all [left-right vslide? (0x1 * slider-width + face/size) max-size][up-down: true break]
        if all [up-down hslide? (1x0 * slider-width + face/size) max-size][left-right: true break]
    ]

    if all [(not fixed) (not left-right) (not up-down)] [RETURN face]

    either fixed [
        crop-size: max-size
        if up-down [crop-size/1: max-size/1 - slider-width]
        if left-right [crop-size/2: max-size/2 - slider-width]
    ][
        crop-size: 0x0
        crop-size/1: either up-down [min (max-size/1 - slider-width) face/size/1][min max-size/1 face/size/1]
        crop-size/2: either left-right [min (max-size/2 - slider-width) face/size/2][min max-size/2 face/size/2]
    ]

    slider-event: function [face][sld-ctx crop-box max-scroll][
        crop-box: first face/user-data
        max-scroll: second face/user-data
        either greater? face/size/1 face/size/2 [
            crop-box/pane/offset/1: (max-scroll/1) * face/data
        ][
            crop-box/pane/offset/2: (max-scroll/2) * face/data
        ]
        crop-box/pane/changes: 'offset
        show crop-box/pane
    ]

    vid-spec: compose copy [space 0x0 origin 0x0 across crop-box: box (crop-size)]
    if up-down [
        append vid-spec compose [ud-sld: slider (to-pair reduce [slider-width crop-size/2]) [slider-event face]]
    ]
    append vid-spec 'return
    if left-right [
        append vid-spec compose [lr-sld: slider (to-pair reduce [crop-size/1 slider-width]) [slider-event face]]
    ]

    lo: layout vid-spec
    max-scroll: subtract crop-size face/size
    if up-down [
;       ud-sld/action: func [face value ][crop-box/pane/offset/2: (max-scroll/2) * face/data show crop-box]
        ud-sld/user-data: reduce [crop-box max-scroll]
        ud-sld/redrag min 1.0 divide max slider-width crop-box/size/2 face/size/2
    ]
    if left-right [
;       lr-sld/action: func[face value][crop-box/pane/offset/1: max-scroll/1 * face/data show crop-box]
        lr-sld/user-data: reduce [crop-box max-scroll]
        lr-sld/redrag min 1.0 divide max slider-width crop-box/size/1 face/size/1
    ]
    crop-box/pane: face
    lo/offset: face/offset
    face/offset: 0x0
    RETURN lo
]

object-gui?: function [
    "Given an object returns a face."
    object [object!]
    /fields "Show only these fields." field-names
][result vid-spec face faces lo][
    faces: copy []
    vid-spec: copy [
        style label label 170x25
        space 0x0 origin 0x0 across
    ]
    foreach [s v] third object [
        if any [not fields find field-names to-word :s][
            append faces face: quick-gui? :v
            face/offset: 0x0
            append vid-spec reduce ['label to-string :s 'box face/size 'return]
        ]
    ]
    lo: layout vid-spec
    for i 1 length? faces 1 [
        set in pick lo/pane (i * 2) 'pane faces/:i
    ]
    RETURN lo
]

block-gui?: function [
    block [block!]
][face faces vid-spec lo val][
    faces: copy []
    vid-spec: copy [space 0x0 origin 0x0]
    for i 1 length? block 1 [
        append faces face: quick-gui? val: block/:i
        face/offset: 0x0
        if block? val [append vid-spec [indent 25]]
        append vid-spec reduce ['box face/size]
        if block? val [append vid-spec [indent -25]]
    ]
    if empty? block [append vid-spec [text "Empty block"]]
    lo: layout vid-spec
    for i 1 length? faces 1 [set in lo/pane/:i 'pane faces/:i]
    RETURN lo
]

quick-gui?: function [
    value [any-type!]
    /no-center "Don't center the face."
][result max-size][
    max-size: system/view/screen-face/size - 75x75
    result: switch/default mold type? value [
        "block!"  [ block-gui? value ]
        "object!" [ object-gui? value ]
        "image!" [ layout [space 0x0 origin 0x0 image value] ]
        "string!" [ either greater? length? value 100 [
                        layout [space 0x0 origin 0x0 text as-is value ]
                    ][
                        layout [space 0x0 origin 0x0 info 400x25 value ]
                    ]
        ]
    ][quick-gui? mold value]
    if any [greater? result/size/1 max-size/1 greater? result/size/2 max-size/2] [
        result: scroll-face result max-size
    ]
    RETURN either no-center [result][center-face result]
]

utility-styles: stylize [
    scrollpanel: face with [
        vid: subface: none
        words: [subface [new/subface: second args next args]]
        init: [
            if subface [
                if block? subface [ subface: layout/styles subface copy self/styles]
                either size [
                    pane: scroll-face/fixed subface (subtract size 2 * edge/size) color
                ][
                    pane: scroll-face subface (subtract system/view/screen-face/size - 80x100 2 * edge/size)
                    size: pane/size
                ]
                pane/offset: 0x0
            ]
            if not size [size: 100x100]
        ]
    ]
]