A try to see a line being drawn on the canvas

qi-dyn.red

Red [
	Needs: 'View
]

system/view/debug?: yes

workstation?: system/view/platform/product = 1

print [
	"Windows" switch system/view/platform/version [
		10.0.0	[pick ["10"			 "10 Server"	 ] workstation?]
		6.3.0	[pick ["8.1"		 "Server 2012 R2"] workstation?]
		6.2.0	[pick ["8"			 "Server 2012"	 ] workstation?]
		6.1.0	[pick ["7"			 "Server 2008 R1"] workstation?]
		6.0.0	[pick ["Vista"		 "Server 2008"	 ] workstation?]
		5.2.0	[pick ["Server 2003" "Server 2003 R2"] workstation?]
		5.1.0	["XP"]
		5.0.0	["2000"]
	] 
	"build" system/view/platform/build
]

win: make face! [
	type: 'window text: "Board View Test" offset: 500x500 size: 800x800

]

win/pane: reduce [
	make face! [ ; text or label
		type: 'text text: "Board" offset: 100x50 size: 70x24
	]

	canvas: make face! [
		type: 'base text: "canvas" offset: 100x100 size: 360x400 color: silver
		draw: [
			dummy draw contents
		]
	]

	make face! [ ; Start button
		type: 'button text: "Start" offset: 500x240 size: 60x24
		actors: object [
			on-click: func [face [object!] event [event!]][
				print "calling start"
				line-length: 0
				until [
					extend-line line-length
					line-length: line-length + 10
					canvas/data: on
					probe canvas/draw
					show canvas
					canvas/data: off
					200 < line-length
				]
				canvas/data: on
			]
		]
	]
	
	make face! [ ; clear button
		type: 'button text: "Clear" offset: 500x340 size: 60x24
		actors: object [
			on-click: func [face [object!] event [event!]][
				print "calling clear"
				canvas/draw: copy base-draw
				;probe canvas/draw
				canvas/data: off
				show canvas
			]
		]
	]
	
	make face! [ ; Quit button
		type: 'button text: "Quit" offset: 500x440 size: 60x24
		actors: object [
			on-click: func [face [object!] event [event!]][
				print "calling unview"
				unview/all
			]
		]
	]
]

base-draw: [
	pen red 
	fill-pen red
	line-width 5
]

canvas/draw: copy base-draw

extend-line: func [
	line-length [integer!]
	/local waitcount [integer!]
	p1 [pair!]
][
	;print " extend-line "
	p1: 200x0
	waitcount: 0

	until [
		waitcount: waitcount + 1
		60000 < waitcount 
	]
	
;	print ["line-length" line-length]
	
	new-draw: copy []
	
	append new-draw 'line
	append new-draw 200x0
	p1/2: line-length
	append new-draw p1

	canvas/draw: copy base-draw
	append canvas/draw new-draw
	
]

show win

do-events