Red Paint with time travel

red-paint-with-time-travel.red

Red [
	title:   "Paint"
	Author:  [REBOL version "Frank Sievertsen" Red port "Gregg Irwin"]
	File: 	 %paint-with-time-travel.red
	Tabs:	 4
	Needs:	 View
	version: 0.0.3
	Notes:   {
		The original didn't have time travel.

		Fyodor Shchukin (@honix), wrote a really great paint example
		(https://github.com/honix/Redraw) which inspired me to graft
		some of his ideas into this program. For now, setting the pen
		size, and his approach for a color palette. I just turned it
		into a color picker popup.
		
	}
]

;-------------------------------------------------------------------------------

set 'request-color func [/size sz [pair!] /local palette res dn?][
	sz: any [sz 150x150]
	palette: make image! sz
	draw palette compose [
		pen off
		fill-pen linear red orange yellow green aqua blue purple
		box 0x0 (sz)
		fill-pen linear white transparent black 0x0 (as-pair 0 sz/y)
		box 0x0 (sz)
	]
	view/flags [
		; The mouse down check here is because the window may pop up directly
		; over the mouse, and get focus. Hence, it gets a mouse up event, even
		; though they didn't mouse down on the color palette.
		image palette on-down [dn?: true] on-up [
			if dn? [
				res: pick palette event/offset
				unview
			]
		]
	][modal popup no-buttons]
	res
]

;-------------------------------------------------------------------------------

tool: context [
	type:  'box
	color: 0.0.0
	size:  25
]

;-------------------------------------------------------------------------------

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) line-width (tool/size)
		(tool/type) (down-pos) (
			either tool/type = '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 [
	move redos tail draw-blk
	draw-pos: tail draw-blk
	;dump
	canvas/draw: canvas/draw ; = show canvas
]

save-data: does [
	if file: request-file/save [
		save file reduce [draw-blk redos]
	]
]

load-data: has [d r] [
	if file: request-file [
		set [d r] load file
		append clear draw-blk d
		append clear redos r
		draw-pos: tail draw-blk
		canvas/draw
	]
]

view [
	title "World's smallest paint program"
	backdrop 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]]
	panel [
		below
		panel [
			below
			text  "Tool:"  40 bold
			radio "Line"   [tool/type: 'line]
			radio "Box"    [tool/type: 'box] data on
			radio "Circle" [tool/type: 'circle]
		]
		panel [
			text "Pen Size"
			slider data 20% react [tool/size: to-integer face/data * 25]
		]
		panel [
			across
			style color-box: base 15x15 [face/color: any [request-color/size 250x250  face/color]]
			color: color-box 0.0.0 text "Pen"		return
			fill-color: color-box text "Fill-pen"	return
			button "Undo" [undo] button "Save" [save-data]	return
			button "Redo" [redo] button "Load" [load-data] button "Quit" [quit]
		]
	]
	do [
		mouse-state: 'up
		draw-pos: draw-blk
	]
]

Better use 'unview instead of 'quit.