REBOL [
    Title: "VID Style Ancestry"
    Purpose: "To show how the styles of VID are derived."
    Author: "Brett Handley"
    email: brett@codeconscious.com
    Date: 20-Jan-2005
    Version: 1.0.5
    Comment: {
        Makes an assumption that the stylesheet in vid-styles stores the dependencies.
        With hindsight, could be written in a simpler way.
    }
    History: [
        1.0.0 [7-Jun-2001 "Initial version." "Brett Handley"]
        1.0.1 [12-Dec-2001 "Added the facet information after seeing email by Volker." "Brett Handley"]
        1.0.2 [16-Dec-2001 "Using walk-forest function now." "Brett Handley"]
        1.0.3 [27-Dec-2001 "Show style definition and try to identify feel objects." "Brett Handley"]
        1.0.4 [29-Dec-2003 "Make text contrast with background for new REBOL versions." "Brett Handley"]
        1.0.5 [20-Jan-2005 "Add info to window title. License changed." "Brett Handley"]
    ]
    Copyright: {Copright (C) Brett Handley. For AnaMonitor.r copyright see the script.}
    License: {Copyright (C) 2004 Brett Handley All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.  Redistributions
in binary form must reproduce the above copyright notice, this list of
conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.  Neither the name of
the author nor the names of its contributors may be used to
endorse or promote products derived from this software without specific
prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  
}
]

;
; Supporting Code
;

do load-thru http://www.codeconscious.com/rebsite/rebol-library/standard-guis.r
do load-thru http://www.codeconscious.com/rebsite/rebol-library/vid-tools.r
do load-thru http://www.codeconscious.com/rebsite/rebol-library/graph-functions.r
do load-thru http://www.codeconscious.com/rebsite/rebol-library/tree-functions.r

;
; Given a style show-field-info displays the style's info
;

show-style-def: function [
    style [word!]
] [ def ][
    def: mold style-definition? style
    def: copy/part find/tail def "[" find/last def "]"
    show-info def join "Style definition for " mold style
]

show-feel-info: function [
    style [word!]
][result p f][
    f: get in get-style style 'feel
    result: copy {}
    if object? f [
        if p: identify-feel-object f [
            result: join mold :p [":" newline]
        ]
    ]
    result: append result mold f
    show-info result join "Feel for " mold style
]

show-info: function [
    info [string!] title [string!]
] [vid-spec] [
    vid-spec: compose [
        styles utility-styles
        space 0x0 origin 0x0 backdrop orange
        h1 (title)
        scrollpanel subface
    ]
    append/only vid-spec reduce [
        'text 'as-is info
    ]
    view/new center-face layout vid-spec
]

show-anamonitor: does [
    if not value? 'monitor [
        do load-thru http://web.tiscali.it/anarkick/anamonitor.r
    ]
    monitor system/view
]

show-evaluator: does [
    do load-thru http://www.codeconscious.com/rebsite/rebol-library/little-evaluator.r
    show-evaluator
]

;
; Create an adjancey-list for the graph functions to work on.
;

dependencies: copy []
foreach [s f] system/view/vid/vid-styles [
    append dependencies f/style
    append/only dependencies reduce [s]
]

;
; Calculate the derivation paths
;

derivations: walk-forest first next graph-trees? dependencies

;
; Now compute the vid specification.
;

vid-spec: copy [space 0x3 origin 0x0]
for i 1 length? derivations 1 [
    p: derivations/:i
    append vid-spec compose/deep [
        at (
            to-pair reduce [
                add multiply 30 subtract length? p 1 15
                multiply i 21
            ]
        )
        text white coal
        (join to-string face-name: last p [ " ---- (" form next head reverse p ")"])
        [show-style-def (to-lit-word face-name )]
        [show-feel-info (to-lit-word face-name )]
    ]
]

;
; Complete the vid spec.
;

pane-size: (system/view/screen-face/size - 50x200)

vid-spec: append/only compose [
    styles utility-styles
    space 0x0 origin 0x0 backdrop orange
    title "VID Style Ancestry"
    across
    text as-is {Click on a style heading for the definition of the style.
Right Click for the feel object.
Scroll down to see all the master stylesheet styles.
}
    dobtn: button 100x20 "Evaluator" [show-evaluator]
    monbtn: button 100x20 "AnaMonitor" [show-anamonitor]
    do [
        monbtn/offset/1: subtract pane-size/1 monbtn/size/1
        dobtn/offset/1: subtract monbtn/offset/1 dobtn/size/1
    ]
    return
    pnl: scrollpanel pane-size edge [size: 5x5 color: yellow] subface
] vid-spec

;
; Time to show what we have
;

view/title center-face layout vid-spec rejoin [
    "VID Style Ancestry " system/script/header/version
    " on " system/product " " system/version]