Rebol [
    Title: "View Player"
    Date: 31-Jan-2002
    Purpose: "An experiment in dynamically altering a View application."
    Author: "Brett Handley"
    Version: 0.5.0
    Comment: {

        This player works by taking over the WAIT function. When an application
        calls WAIT through using DO-EVENTS, VIEW or a requestor this application
        traps it and uses that as a signal to respond the application.

        Thus the task of the person "scripting" the application is to provide
        a scripted response to application for each WAIT that is called.

        Use PROCESS-APPLICATION in your script to seperate your scripted responses.
        So if there is only one WAIT in an application then you don't need to use
        PROCESS-APPLICATION. If there are two then you need to script two responses
        with a PROCESS-APPLICATION between them.

        See the demonstrations on the codeconscious.com rebsite "Code. C." for
        examples.

        The player is not guaranteed to work for any application. It is provided in
        case it works for you. Don't blame me nor hold me liable if it screws up!

        In particular, it is not recommended to run this application against
        production applications.
        
    }
    Rights: {Copyright © Brett Handley 2002

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, subrights,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.}

]

;
; Call process-application in your script (only at the top level) to
; allow the application to continue processing.
;
play-app: function [
    app [file! block!]
    script [block!]
][
    rule exp nested-call
    scripted-response responses
    was-error
][

    ;
    ; Parse out the scripted responses (delimited by process-appliation)
    ;

    nested-call: false
    depth-search: [any ['process-application (nested-call: true) to end skip | into [depth-search] | skip]]
    if not parse script [
        (responses: copy [])
        any [
            'process-application (insert/only tail responses copy []) |
            copy exp [into [depth-search] | skip] (
                if empty? responses [insert/only tail responses copy []]
                insert tail last responses exp
            )
        ]
    ] [
        throw make error! "Error parsing the script."
    ]
    if nested-call [
        throw make error! "process-application must not appear in a nested expression."
    ]

    ;
    ; Set up the response handler
    ;

    scripted-response: does [
        if not tail? responses [
            response: first responses
            responses: next responses
            do response
        ]
    ]

    ;
    ; Hook into the app through WAIT.
    ;

    process-events: :wait

    wait: func [
       value [number! time! port! block! none!]
        /all "Returns all events in a block"
    ][

        ; I make the assumption here that is value is a non-empty block,
        ; then it contains ports network ports and not the view events port.
        ; If the value is none or an empty block it is probably a do-events call
        ; made my the application or the VIEW function - so I need to trap it.

        either system/words/all [not none? :value block? :value not empty? :value] [
            process-events :value
        ][
            scripted-response
        ]

    ]

    ;
    ; Run the app
    ;

    if was-error: error? err: try [do app][disarm err]

    ;
    ; Clean up
    ;

    wait: :process-events
    if was-error [print mold :err halt]

]