Rebol [
    Title: "Start"
    File: %start.r
    Date: 12-Jan-2006
    Version: 1.0.7
    Needs: [view]
    Author: "Anton Rolls"
    Language: 'English
    Purpose: {Custom "launcher"}
    History: [
        1.0.0 [20-May-2001 {First version} "Anton"]
        1.0.1 [4-Jun-2001 {adding a load-thru to first image icon in demo-panel} "Anton"]
        1.0.2 [5-Jun-2001 {fixed icon loading} "Anton"]
        1.0.3 [25-Jun-2001 {
            - fixed doing this script from console
            - contextualized everything... :)
            - fixed bug where after unview the icon images were recycled
        } "Anton"]
        1.0.4 [18-Aug-2001 {demo icon now has minature image of demo-panel} "Anton"]
        1.0.5 [8-Nov-2001 {moved site, improved loading code} "Anton"]
        1.0.6 [8-Apr-2002 {update for include} "Anton"]
        1.0.7 [12-Jan-2006 {site determination from reboltech} "Anton"]
    ]
    ToDo: {
    - informative error messages when can't load a remote file
    - perhaps rewrap [view] with [view/new wait none] just like quit ?
    - only re'view start-context/lay if window has been closed by one of the scripts:

      ; find if a window (lay) is currently shown
      if system/view/screen-face/pane lay [print "shown"]]
   
    - Carl's idea of wrapping quit:

        before DOing the script:

           quit: does [unview/all throw/name 'done]

        and use a catch around DO:

           catch/name [do %the-script.r] 'done


    - Scripts can still quit everything, though!
      Their 'quit must tunnel down to global context somehow
      or vid context or something...

    - right mouse button for information like desktop
    - bulge for anim-icon (pond-drop bulge?)
    - Volker's method from AltME Rebol3 world, UDP group):
        o-launch: :launch
        launch: func[file /secure-cmd][
        header: first load/header file
        either in header 'launch[
        do func[file] header/launch file
        ][
        either secure-cmd [o-launch/secure-cmd file][o-launch file]
        ]
        ]
        desktop
    }
    Notes: {
        see http://antonrolls.net
        see examples/petrProgress.r for saving a style
    }
]

start-context: context [

site: select load-thru http://www.rebol.net/reb/index.r [folder "Anton"]
clear find site %index.r
do load-thru site/library/include.r
include [site/library/graphics.r 'all]

sandbox: context [
    ; Carl's redefinition
    quit: halt: does [unview/all throw/name "quit/halt caught by start-context/sandbox" 'done]

    do-net: func [file][
        unview/only start-context/lay
        site: select load-thru http://www.rebol.net/reb/index.r [folder "Anton"]
clear find site %index.r
        catch/name [do load-thru start-context/site/:file] 'done
        ;read-thru start-context/site/start.r ; make sure this file is in the cache.
        ;do path-thru start-context/site/start.r
        ;quit
        ;if not find system/view/screen-face/pane lay [ ; are we currently shown?
            view/new center-face start-context/lay
            wait none
        ;]
    ]
]

; copy built-in icon feel engage
saved-feel: make system/view/vid/vid-styles/icon/feel []
saved-engage: get in saved-feel 'engage
engage-func-block: second get 'saved-engage

; modify engage function block
append engage-func-block [
    if action = 'time [
        ;print 'tick
        fr: fr + 1
        if fr > 2 [fr: 1] ;loop
        SetPenColour to-tuple reduce [255 - (fr * 32) 0 0]

        ; we can't refer to face/image here because after
        ; an unview then view, the face/image has been freed?
        SetTargetImage ic-img ; demo-fungus does not restore the TargetImage

        oval 15 15 10 10
        show face
    ]
]

; rebuild the engage function
saved-engage: func [face action event] engage-func-block
; connect the new engage function back to the feel
saved-feel/engage: get 'saved-engage

; stylize using the new feel
my-style: stylize [
    anim-icon: icon with [feel: make saved-feel []]
]

; ensure icon images are in the cache
foreach [sub-dir icon][
    anim iconDilbert.png
    anim PondDrop.png
    anim stars.png
    demo bt-process.png
    demo sonic-fungus.png
][
    read-thru site/:sub-dir/images/:icon
]

im-site: site/anim/images

anim-panel: layout [
    origin 8x8
    size 320x200
    backdrop effect [gradient 128.128.128 0.0.0]
    h2 "Animations"
    across
    icon "VR 4" im-site/iconDilbert.png [sandbox/do-net %anim/vr4.r]
    icon "anim.r" im-site/PondDrop.png [sandbox/do-net %anim/anim.r]
      ;info "anim.r - animation with rate control"
    icon "stars" im-site/stars.png [sandbox/do-net %anim/anim-stars.r]
    icon "stars 2" im-site/stars.png [sandbox/do-net %anim/anim-stars2.r]
    ; effect [blah blah gradcol blah]

]

im-site: site/demo/images

demo-panel: layout [
    origin 8x8
    size 320x200
    backdrop effect [gradient 128.128.128 0.0.0]
    h2 "Demos"
    across
    icon "bt-process" 72x60 im-site/bt-process.png [sandbox/do-net %demo/bt-process.r]
    icon "demo-fungus" im-site/sonic-fungus.png [sandbox/do-net %demo/demo-fungus.r]
]

SetTargetImage ic-img: make image! 64x48
fr: 1

lay: layout [
    styles my-style
    origin 8x8
    backdrop effect [gradient 0.0.0 128.128.128]
    ;guide
    pad 20
    anim-icon ic-img "Animations" rate 8 [
        ;probe get in face/feel 'engage
        panels/pane: anim-panel show panels
    ]
    icon "Demos" to-image demo-panel [panels/pane: demo-panel show panels]
    return
    box 2x200 maroon
    return
    panels: box 320x200
]

foreach p [anim-panel demo-panel][set in get p 'offset 0x0]

;default panel
panels/pane: anim-panel

init: does [view center-face lay]

] ; end start-context

start-context/init