Paint.r with print button
[1/1] from: gschwarz::netconnect::com::au at: 29-Apr-2003 12:03
REBOL [
Title: "Paint"
Date: 22-May-2001/17:15:51-7:00
Version: 1.0.0
File: %paint.r
Author: "Frank Sievertsen"
Purpose: "The world's smallest paint program."
Category: [util vid view 3]
history: {Print function added by Greg Schwarz 10/4/2003
The print button saves file as a png and a html file. File saved to c:\printing\pics
to be printed,
using www.pirella.com HTML printer software to send the picture to the printer.}
]
context [
color: fill-color: start: draw-image: draw-pos: tmp: none
type: 'box
undos: [] redos: []
draw: func [offset /local tmp] [
compose [
pen (color/color) fill-pen (fill-color/color)
(type) (start) (either type = 'circle [
tmp: offset - start
to-integer square-root add tmp/x ** 2 tmp/y ** 2
] [offset])
]
]
view lay: layout [
backdrop effect compose [gradient 1x1 (sky) (water)]
across
draw-image: image white 300x300 effect [draw []]
feel [engage: func [face action event] [
if all [type start] [
if find [over away] action [
append clear draw-pos draw event/offset
show face
]
if action = 'up [
append/only undos draw-pos
draw-pos: tail draw-pos
start: none
]
]
if all [type action = 'down] [
start: event/offset
]
]]
do [draw-pos: draw-image/effect/draw]
guide
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"
return
radio [type: 'box] on text "Box"
return
radio [type: 'circle] text "Circle"
return
style color-box box 15x15 [
face/color: either face/color [request-color/color face/color] [request-color]
] ibevel
color: color-box 0.0.0 text "Pen"
return
fill-color: color-box text "Fill-pen"
return
button "Undo" [if not empty? undos [
append/only redos copy last undos
draw-pos: clear last undos
remove back tail undos
show draw-image
]]
return
button "Redo" [if not empty? redos [
append/only undos draw-pos
draw-pos: insert draw-pos last redos
remove back tail redos
show draw-image
]]
return
button "Save" [ file-name: request-text/title "Save File:"
save/png to-file join file-name [".png"] to-image draw-image
]
return
button "Print" [ save/png %//printing/pics/picture.png to-image draw-image
write %//printing/picture.html {<html>^/<body>^/<IMG SRC="pics/picture.png">^/</body>^/</html>}
]
]
]
Regards,
Greg Schwarz.