REBOL [
	Title: "Test Protocol"
	File: %test-port.r
	Date: 15-Aug-2006
	Author: "Christopher Ross-Gill"
	Comments: {Kudos: http://www.rebolforces.com/articles/protocols/}
]

flag-defs: [
	         1 read
	         2 write
	         4 append
	         8 new
	        16 #[none]
	        32 binary
	        64 lines
	       128 part
	       256 with
	       512 open
	      1024 closed
	      2048 no-wait
	      4096 #[none]
	      8192 #[none]
	     16384 #[none]
	     32768 allow
	     65536 mode
	    131072 #[none]
	    262144 #[none]
	    524288 direct
	   1048576 custom
	   2097152 #[none]
	   4194304 pass-thru
	   8388608 #[none]
	  16777216 #[none]
	  33554432 skip
	  67108864 #[none]
	 134217728 #[none]
	 268435456 allow-read
	 536870912 allow-write
	1073741824 allow-execute
]

get-all-flags: func [port /local out][
	out: copy []
	foreach flag [
		1 2 4 8 16 32 64 128 256 512 1024 2048 4096 8192 16384 32768
		65536 131072 262144 524288 1048576 2097152 4194304 8388608
		16777216 33554432 67108864 134217728 268435456 536870912 1073741824
	][
		if flag = (port/state/flags and flag) [
			append out any [select flag-defs flag flag]
		]
	]
	out
]

test-handler: context [
	count: 0

	port-flags: system/standard/port-flags/pass-thru
	print-flags: func [port][
		foreach flag get-all-flags port [print ["    FLAG:" form flag]]
	]

	init: func [port spec][print ["INIT:" count: count + 1] false]

	query: func [port][
		print "QUERY"
		print-flags port
		port/status: true
	]

	open: func [port /local filename][
		print "OPEN"

		do bind [
			all [
				prin "^-TEST: " probe value? 'user-data
				prin "^-TEST: " probe user-data
			]
		] port

		do bind [
			;-- Say how big we are
			tail: 3
			index: 0

			outBuffer: [1 2 3]
		] port/state

		;-- Take our flags and merge
		;   them into the port/state/flags ( Voodoo )
		port/state/flags: port/state/flags or port-flags

		print-flags port
	]

	copy: func [port][
		print "COPY"
		print-flags port
		none
	]

	select: func [port locator][
		print ["SELECT" either block? locator ["SOME"][mold locator]]
		print-flags port
		[]
	]

	close: func [port][
		print "CLOSE"
		print-flags port
	]

	read: func [port][
		print "READ"
		print-flags port
		random 1000
	]

	write: func [port data][
		print "WRITE"
		print-flags port
	]

	find: func [port params][
		print ["FIND:" mold params]
		print-flags port
		random 1000
	]

	pick: func [port][
		print ["PICK:" port/state/index]
		print-flags port
		port/state/index ** 2
	]

	poke: func [port index data][
		print ["POKE data:" mold data]
		print ['length port/state/tail 'at index]
		print-flags port
		random 1000
	]

	insert: func [port data][
		print ["INSERT data:" mold data]
		print-flags port
		'foobar
	]

	change: func [port data][
		print ["CHANGE data:" mold data]
		print-flags port
		random 1000
	]

	remove: func [port][
		print "REMOVE"
		print ['length port/state/tail 'index port/state/index 'scope port/state/num]
		print-flags port
		random 1000
	]

	update: func [port][
		print "UPDATE"
		print-flags port
		random 1000
	]

	get-modes: func [port modes][
		print "GET-MODES"
		print-flags port
	]

	set-modes: func [port modes][
		print "SET-MODES"
		print-flags port
	]
]

add-protocol: func ['proto-name proto-port-id proto-handler][
	unless in system/schemes proto-name [
		system/schemes: make system/schemes compose [
			(to-set-word proto-name) #[none]
		]
	]
	set in system/schemes proto-name make system/standard/port [
		scheme: proto-name
		port-id: proto-port-id
		handler: proto-handler
		passive: none
		cache-size: 5
		proxy: make object! [host: port-id: user: pass: type: bypass: #[none]]
	]
]

add-protocol test 0 test-handler