test of async

REBOL [
	file: %test-async-http.r
	author: "Graham"
	email: [ compkarori<@>gmail.com ]
        date: 10-June-2010
]
 
do %async-protocol.r
do %async-http.r
 
buffer: copy ""
content-length: 0
 
handler: func [port [port!] event [error! word!]
] [	
	switch event [
		connect [print "Connected." false]
		read [
			if port/sub-port/state/inbuffer [
				statustxt/text: form length? port/sub-port/state/inbuffer
				show statustxt
				if zero? content-length [
					either parse/all port/sub-port/state/inbuffer [ thru "content-length: " copy content-length to newline to end ][
						if content-length [
							content-length: to-integer trim/all content-length
						]
					][ content-length: none ]
				]
				if all [ content-length content-length > 0 ][
					prog/data: ( to-integer statustxt/text ) / content-length		
					show prog			
				]		
			]
			false
		]
		write [false]
		close [print "Peer closed connection."  append buffer copy port 
			close port 
			write/binary last split-path to-url urlfld/text buffer 
			false ; if you use true here, you'll exit the View event handler as well
		]
	]
]
 
do-download: has [url link ][
	if not empty? url: urlfld/text [
		if parse/all url [ "http" opt "s" "://" to end][
			insert head url 'a
			link: open to-url url
			link/awake: :handler		
		]
	]
]
 
 
view/new center-face layout [
	across
	label "URL: " gold urlfld: field 300 return 
	prog: progress 340x15 return
	btn "Download" [ do-download ] return
	label "You can type while downloading" black return
	area 340x200 wrap
	at 160x50 statustxt: text "bytes" 100 white
]
 
wait []