Title: "Paint "
    Date: 22-May-2001/17:15:51-7:00
    Version: 1.0.0
    File: %paintplus.r
    Author: "Frank Sievertsen"
    Purpose: "The world's smallest paint program."
    library: [
        level: 'intermediate 
        platform: [all]
        type: 'tool 
        domain: [GUI] 
        support: none 
        license: 'BSD 
        see-also: none
    Comment: {
    	Modified by Graham to load in a Rebol image, and a block containing draw dialected commands.
    	Thanks to Anton for suggestion on how to do the free hand draw.
    	Supports the arrow command, free hand draw, line width, and text tools.
    	Can't yet load in draw dialect with text commands.
    	useage: paint image [image! none!] data [block!]
    	paint none [] ; brings up empty canvas
    	paint load %logo.png [] ; brings up the logo.png as the canvas
    	paint load %logo.png [[pen 0.0.0 line-width 2 fill-pen none box 147x90 191x117]] ; applies the draw to the logo

context [
	color: fill-color: start: draw-image: draw-pos: tmp: file-name: fs: fn: fontatt: fontlist: none
	line-width: 2
	type: 'box oldtype: 'box
	undos: [] redos: []
	my-text: copy "Hello there"
	select-text: does [
		view/new/title center-face layout [across
			attribute1cg: check label black "bold" 
			attribute2cg: check label black "italic" 
			attribute3cg: check label black "underline" return
			attribute1rg: radio of 'fontstyle l: label black "Sans Serif"
			attribute2rg: radio of 'fontstyle label black "Serif"
			attribute3rg: radio of 'fontstyle label black "Fixed"
			text "Size" font [] fontsz: field "20" 40 [if error? try [fs: to-integer face/text] [face/text: 14 show fontsz]] return
			deftextarea: area 400x100 return
			btn "OK" [my-text: copy deftextarea/text unview
				if error? try [fs: to-integer fontsz/text] [fs: 14]
				fontatt: copy []
				fn: copy "Sans Serif"
				if attribute1cg/data [append fontatt [bold]]
				if attribute2cg/data [append fontatt [italic]]
				if attribute3cg/data [append fontatt [underline]]
				fn: copy case [
					attribute1rg/data ["Sans Serif"]
					attribute2rg/data ["Serif"]
					attribute3rg/data ["Fixed"]
					true ["Sans Serif"]
				append fontlist make face/font compose/deep [style: [(fontatt)] size: (fs) name: (fn)]
			] pad 300 btn "Cancel" [unview]
		] "Text Requester"

	draw: func [offset /local tmp bl] [
		bl: copy []
		all [
			either all [oldtype = type type = 'free-hand] [
				oldtype: type
				repend bl [start offset]
			] [true]

			either all [oldtype = 'arrow type <> 'arrow] [append bl [arrow 0x0] true] [true]

			append bl compose [pen (color/color) line-width (line-width) fill-pen (fill-color/color)]

			either type = 'text [
				append bl compose [font (last fontlist) text (my-text) (offset)]
			] [true]

			switch/default type [
				arrow [append bl [arrow 1x2 line]]
				free-hand [append bl [line]]
			] [append bl type]

			append bl start

			either type = 'circle [
				append bl reduce [tmp: offset - start
					to-integer square-root add tmp/x ** 2 tmp/y ** 2
			] [append bl offset]
			if type = 'arrow [
				append bl [ arrow 0x0 ]

	redo-draw: does [
		append/only undos draw-pos
		draw-pos: insert draw-pos last redos
		remove back tail redos
		show draw-image
	undo-draw: does [
		append/only redos copy last undos
		draw-pos: clear last undos
		remove back tail undos
		show draw-image
	set 'paint func [
		image-data [image! none!] {load a REBOL image}
		redos-data [block!] {read in draw dialect commands}
		/local ln data
	] [
		undos: copy []
		redos: copy []
		fontlist: copy []
		type: 'box
		if not empty? redos-data [
			redos: copy/deep redos-data
		if none? image-data [
			image-data: to-image layout [ box 300x300 ]
		view center-face lay: layout compose/deep [
			backdrop effect compose [gradient 1x1 (sky) (water)]
			draw-image: image (image-data) effect [draw []]
			feel [engage: func [face action event] [
					if all [type start] [
						if find [over away] action [
							if type <> 'free-hand [clear draw-pos]
							append draw-pos draw event/offset
							if type = 'free-hand [start: event/offset]
							show face
						if action = 'up [
							append/only undos draw-pos
							draw-pos: tail draw-pos
							start: none
							oldtype: type
					if all [type action = 'down] [
						start: event/offset
			do [if error? try [
					draw-pos: draw-image/effect/draw
					while [not empty? redos] [redo-draw]
				] [
					alert "Error in image data - discarded"
			style text text [
				tmp: first back find face/parent-face/pane face
				tmp/feel/engage tmp 'down none
				tmp/feel/engage tmp 'up none
			label "Tool:" return
			radio [type: 'line] text "Line" font []
			mark: at
			radio [type: 'free-hand] text "Free" font []
			radio true [type: 'box] on text "Box" font []
			radio [type: 'circle] text "Circle" font []
			radio [type: 'arrow] text "Arrow" font []
			radio [type: 'text select-text] text "Text" font []
			button "Undo" [if not empty? undos [
			button "Clear" [
				while [not empty? undos] [undo-draw]
				oldtype: none
			] return
			button "Redo" [if not empty? redos [
				]] return
			button "Save" [
				if r: request-file [
					save/all r/1 undos
			button "Print" [save/png %picture.png to-image draw-image

				write %picture.html {^/^/^/^/}
				browse %picture.html
			button "Dump" [
				print "undos" probe undos
			at mark
			style color-box box 15x15 [
				oldtype: none
				face/color: either face/color [request-color/color face/color] [request-color]
				; face/color: request-color
			] ibevel
			color: color-box 0.0.0 text "Pen"
			fill-color: color-box text "Fill-pen"
			widthfld: field "2" 20 [oldtype: none if error? try [line-width: to-integer face/text] [face/text: line-width: 2 show face]] label "Width"