Red Paint (World's smallest paint program)

paint.red

Red [
	title:   "Paint"
	Author:  [REBOL version "Frank Sievertsen" Red port "Gregg Irwin"]
	File: 	 %paint.red
	Tabs:	 4
	Needs:	 View
	version: 0.0.1
]

draw-blk: copy []
redos: copy []

distance: func [pos [pair!]][square-root add pos/x ** 2 pos/y ** 2]

draw-new-shape: function [offset] [
	compose [
		pen (color/color) fill-pen (fill-color/color) (tool) (down-pos) (
			either tool = 'circle [
				to integer! distance (offset - down-pos)
			][offset]
		)
	]
]

mouse-down: func [event][
	mouse-state: 'down
	down-pos: event/offset
]
mouse-up: func [event][
	mouse-state: 'up
	draw-pos: tail draw-pos
	dump	
	down-pos: none
]
mouse-down?: does [mouse-state = 'down]

mouse-move: func [event][
	append/only clear draw-pos draw-new-shape event/offset
]

dump: does [
	print [
		'blk  mold draw-blk newline
		;'pos  mold draw-pos newline
		'redo mold redos newline
		'canvas mold canvas/draw newline
		newline
	]
]
undo: does [
	move draw-pos: back tail draw-blk redos
	dump
	canvas/draw: canvas/draw
	show canvas
]

redo: does [
	draw-pos: move redos tail draw-blk
	dump
	canvas/draw: canvas/draw
	show canvas
]

view [
	backdrop water	;draw compose [fill-pen linear 0x0 0 400 90 1 1 (sky) (water)]
	across
	canvas: base white 350x350 all-over draw draw-blk
		on-down [mouse-down event]
		on-up   [mouse-up event]
		on-over [if mouse-down? [mouse-move event]]
	do [
		tool: 'box
		mouse-state: 'up
		draw-pos: draw-blk
	]

    panel [
    	below
    	text bold "World's smallest paint program"
    	text  "Tool:"  bold
    	radio "Line"   [tool: 'line]  [tool]
    	radio "Box"    [tool: 'box]   [tool]  data on
    	radio "Circle" [tool: 'circle][tool]
    	panel [
    		across
	    	style color-box: base 15x15 [
	    		;face/color: either face/color [request-color/color face/color] [request-color]
	    	]
	    	color: color-box 0.0.0 text "Pen"		return
	    	fill-color: color-box text "Fill-pen"	return
	    	button "Undo" [undo]					return
	    	button "Redo" [redo]
	    ]
    ]
]