Skip to content

Instantly share code, notes, and snippets.

@greggirwin
Last active February 8, 2018 18:28
Show Gist options
  • Save greggirwin/989cf1909edc0d98cc38bc47e4b6718f to your computer and use it in GitHub Desktop.
Save greggirwin/989cf1909edc0d98cc38bc47e4b6718f to your computer and use it in GitHub Desktop.
Red Paint (World's smallest paint program)
Red [
title: "Paint"
Author: [REBOL version "Frank Sievertsen" Red port "Gregg Irwin"]
File: %paint.red
Tabs: 4
Needs: View
version: 0.0.2
]
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 [
move redos tail draw-blk
draw-pos: 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]
]
]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment