REBOL [
	Title:  "Fill image with colored bars"
	Author: "Gregg Irwin"
	Type:	'graphic
	Purpose: {
		Fills an image a row of pixels at a time, cycling colors
		up and down. Demonstrates looping, branching, and image
		modification.
	}
	Needs:  [core 2.7.0]
]


to-hex-color: func [color [tuple!]] [
    to-issue enbase/base to-binary color 16
]
to-rebol-color: func [color [issue!]] [
    to-tuple debase/base color 16
]

; Create UI
img: make image! 320x240
view/new out: layout [
	image img
	speed: slider 320x16 with [data: .5]
	watch-drawing?: check-line "Watch drawing"
]

; Initialize vars
wd: 	 img/size/x		; The width of the image
end:     length? img	; end--the last byte--of the image
cur-pix: end + 1		; forces an initial refresh
direction: 1 			; going down
diff:    to integer! #030303	; how much to change color for each line
color:   none			; current color
U-limit: none			; upper-limit; number of times to change color.

; Generates a new random color
new-color: does [
	to integer! to-hex-color 32.32.32 + random 255.255.255
]

; Figures out how many times to change color (up/down) and sets the upper limit.
new-count: func [color] [
	color: to-rebol-color to-hex color
	U-Limit: to integer! divide  min min color/2 color/3 color/4  3 ; 3 = diff incr
]

; Fills one line of the image with the current color. Checks for end of image,
; and direction change.
fill-line: rebcode [img [image!]] [
	; If we've passed the end of the image, reset and start again.
	gteq.i cur-pix end
	ift [
		set cur-pix 0 
		apply color new-color []
		apply count new-count [color]
		abs.i diff
		set direction 1 
	]
	eq.i direction -1
	brat going-up
label going-down
	eq.i count 0
	ift [
		neg.i direction  ; switch to going-up
		neg.i diff
	]
	brat going-up
	sub.i  count 1
	bra  draw
label going-up	
	eq.i count U-limit
	ift [
		neg.i direction  ; switch to going-down
		neg.i diff
	]
	brat going-down
	add.i count 1
label draw	
	sub.i color diff		; always subtract; sign of diff changes to go up or down.
	; draw one horizontal line
	repeat i wd [
		add.i cur-pix 1
		gt.i  cur-pix end
		iff	[poke img cur-pix color]
	]
]

while [not empty? system/view/screen-face/pane] [
	fill-line img
	if cur-pix >= (end - 1)    [show out  wait get-face speed]
	if get-face watch-drawing? [show out  wait 0.001]
]