Skip to content

Instantly share code, notes, and snippets.

@greggirwin
Last active February 8, 2018 18:29
Show Gist options
  • Save greggirwin/989ca6ffcec29f0700f54a0f3331d7eb to your computer and use it in GitHub Desktop.
Save greggirwin/989ca6ffcec29f0700f54a0f3331d7eb to your computer and use it in GitHub Desktop.
Red Paint with time travel
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
]
]
@iArnold
Copy link

iArnold commented Sep 25, 2016

Better use 'unview instead of 'quit.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment