Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search

[REBOL] Paint.r with print button

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 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.