Version 3 of drawscreen, drawing on the screen

Updated 2023-02-11 16:15:02 by aplsimple

The drawscreen draws on the screen. It can be sourced or used stand-alone.

(I tried to find the screen drawing in the wiki, by words screen drawing. Got a lot of pages, seemingly no one fit the query.)

Usage

When sourced, it's run this way:

    source drawscreen.tcl
    ::drawscreen::run wins events ?fill? ?width?

where:

  • wins - list of toplevel windows the events are bound to, e.g. ".w1 .w2"
  • events - list of events to start drawing on the screen, e.g. "Alt-x Control-K"
  • fill - color of drawing brush
  • width - width of drawing brush

When stand-alone, it's run this way:

    tclsh drawscreen.tcl ?events? ?fill? ?width?

where:

  • events, fill, width are the same as above

Alt+X keys are used to start drawing. Then the left mouse button is used to drag-and-drop the mouse pointer. To end with the drawing, the right / double click is used.

In Windows, there is a short lag between Alt+X and the bell signalizing the drawing is available.

Code 

#! /usr/bin/env tclsh
###########################################################
# Name:    drawscreen.tcl
# Author:  Alex Plotnikov  ([email protected])
# Date:    02/11/2023
# Brief:   Handles drawing on the screen.
# License: MIT.
###########################################################

package require Tk
package require treectrl

# ________________________ Data of drawscreen _________________________ #

namespace eval ::drawscreen {

  namespace eval my {
    variable draw
    array set draw {
      width 6
      fill #ff0000
      distance 10
      dobell yes started no X 0 Y 0 img {}
    }
  }
}

# ________________________ Private procedures _________________________ #

proc ::drawscreen::my::Bind {w events} {
  # Binds drawing events on a window to Drawing proc.
  #   w - the window's path
  #   events - list of events to start drawing
  # The windows may be created and destroyed,
  # this procedure checks periodically if they are available.

  variable draw
  set scrp "::drawscreen::my::Drawing $w"
  if {[winfo exists $w]} {
    foreach ev $events {
      if {[string first $scrp [bind $w $ev]]==-1} {
        if {![string match <*> $ev]} {set ev <$ev>}
        bind $w $ev "$scrp ; break"
      }
    }
  }
  after 200 [list ::drawscreen::my::Bind $w $events]
}
#_______________________

proc ::drawscreen::my::Binds {wins events {fill ""} {width ""}} {
  # Sets the bindings to start drawing.
  #   wins - the list of parent window pathes
  #   events - events to start drawing
  #   fill - color of draw brush
  #   width - width of draw brush

  variable draw
  if {$fill ne {}} {set draw(fill) $fill}
  if {$width ne {}} {set draw(width) $width}
  if {$events eq {}} {set events {<Alt-x> <Alt-X>}}
  foreach w $wins {
    after 10 [list ::drawscreen::my::Bind $w $events]
  }
}
#_______________________

proc ::drawscreen::my::Drawing {rootwin} {
  # Initializes drawing: creates a canvas holding the screen's content.
  #   rootwin - a parent window's path

  variable draw
  set win [string trimright $rootwin .].drawscreen
  if {[winfo exists $win]} return ;# esp. for Windows' lag
  catch {set draw(oldfocus) [focus]}
  focus $rootwin
  set draw(win) $win
  set draw(cnv) $win.canvas
  set w [winfo screenwidth .]
  set h [winfo screenheight .]
  toplevel $win
  wm geometry $win 1x1+0+0
  wm attributes $win -alpha 0.0 -topmost 1
  wm overrideredirect $win 1
  wm withdraw $win
  set draw(img) [image create photo -width $w -height $h]
  canvas $draw(cnv) -width $w -height $h -relief flat -bd 0 -highlightthickness 0
  $draw(cnv) create image 0 0 -image $draw(img) -anchor nw
  pack $draw(cnv) -expand 1 -fill both -ipady 0 -padx 0 -pady 0 -side top
  ::drawscreen::my::Loupe $w $h
  bind $draw(cnv) <ButtonPress-1>  "::drawscreen::my::DrawStart %X %Y"
  bind $draw(cnv) <Motion>          "::drawscreen::my::Draw %X %Y"
  bind $draw(cnv) <ButtonRelease-1> "::drawscreen::my::DrawFinish"
  bind $draw(cnv) <Double-Button-1> ::drawscreen::my::DrawEnd
  bind $draw(cnv) <ButtonPress-3>   ::drawscreen::my::DrawEnd
  # with "after" we avoid Tk shimmering
  after 10 [list after idle [list after 10 [list after idle [list after 10 " \
    wm deiconify $win; \
    wm attributes $win -alpha 1.0; \
    wm geometry $win ${w}x${h}+0+0"]]]]
  Bell
}
#_______________________

proc ::drawscreen::my::DrawStart {X Y} {
  # Starts a current drawing.
  #   X - x-coordinate of mouse pointer
  #   Y - y-coordinate of mouse pointer

  variable draw
  set draw(X) $X
  set draw(Y) $Y
  set draw(started) yes
}
#_______________________

proc ::drawscreen::my::Draw {X Y} {
  # Does a current drawing.
  #   X - x-coordinate of mouse pointer
  #   Y - y-coordinate of mouse pointer

  variable draw
  if {$draw(started)} {
    if {abs($X-$draw(X))>$draw(distance) || abs($Y-$draw(Y))>$draw(distance)} {
      $draw(cnv) create line $X $Y $draw(X) $draw(Y) -fill $draw(fill) -width $draw(width)
      set draw(X) $X
      set draw(Y) $Y
    }
  }
}
#_______________________

proc ::drawscreen::my::DrawFinish {} {
  # Finishes a current drawing.

  variable draw
  set draw(started) no
}
#_______________________

proc ::drawscreen::my::DrawEnd {} {
  # Destroys drawing stuff.

  variable draw
  set draw(started) no
  image delete $draw(img)
  destroy $draw(win)
  catch {focus $draw(oldfocus)}
  Bell
}
#_______________________

proc ::drawscreen::my::Loupe {w h} {
  # Captures a screen image and pushes it into the canvas.
  #   w - width of image
  #   h - height of image

  variable draw
  set loupe_ctr_x [expr {$w / 2}]
  set loupe_ctr_y [expr {$h / 2}]
  loupe $draw(img) $loupe_ctr_x $loupe_ctr_y $w $h 1
}
#_______________________

proc ::drawscreen::my::Bell {} {
  # Sounds.

  variable draw
  if {$draw(dobell)} bell
}

# ________________________ Interface procedures _________________________ #

proc ::drawscreen::run {args} {
  # Runs my::Binds and catches errors. Logs errors to a log file.
  #   args - arguments of my::Binds

  if {[catch {my::Binds {*}$args} err]} {
    Bell
    catch {
      set ch [open ~/TMP/drawscreen.log a]
      puts $ch $err
      close $ch
    }
  }
}

# _________________________________ main _________________________________ #

if {[info exist ::argv0] && [file normalize $::argv0] eq [file normalize [info script]]} {
  lassign $::argv hotk fill width
  if {$hotk eq {}} {set hotk {Alt-x Alt-X}}
  set hk [string map [list < {} > {} { } {, }] $hotk]
  label .labinfo -text \
    "Press $hk, then\ndrag-n-drop... or\nright/double click."
  pack .labinfo -padx 50 -pady 50
  bind . <Escape> exit
  ::drawscreen::run . $hotk $fill $width
}

# _________________________________ EOF _________________________________ #
Category GUICategory Image Processing