The [https://chiselapp.com/user/aplsimple/repository/drawscreen%|%drawscreen%|%] draws on the screen. It can be sourced or used stand-alone. (I tried searching the ''screen draw'' in the [wiki], by words like ''screen draw drawing''. Got a lot of links, seemingly none satisfactory.) ** Usage ** When sourced, [drawscreen, drawing on the screen%|%drawscreen] runs 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 [drawscreen, drawing on the screen%|%drawscreen]' provides "cget" and "configure" for options ''-fill/fill, -width/fill, -distance/distance'', e.g.: ====== ::drawscreen::configure -fill red -width 20 -distance 30 puts [::drawscreen::cget fill -width -distance] ::drawscreen config fill blue width 30 distance 40 puts [::drawscreen cget -fill width distance] ====== When stand-alone, [drawscreen, drawing on the screen%|%drawscreen] runs 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 [drawscreen, drawing on the screen%|%drawscreen] is ready to draw. ** Code ** ====== #! /usr/bin/env tclsh ########################################################### # Name: drawscreen.tcl # Author: Alex Plotnikov (aplsimple@gmail.com) # 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 export cget configure namespace ensemble create 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 { }} 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) "::drawscreen::my::DrawStart %X %Y" bind $draw(cnv) "::drawscreen::my::Draw %X %Y" bind $draw(cnv) "::drawscreen::my::DrawFinish" bind $draw(cnv) ::drawscreen::my::DrawingDone bind $draw(cnv) ::drawscreen::my::DrawingDone # with "after" we avoid Tk shimmering after 10 [list after idle [list after 10 [list after idle [list after 10 " \ wm deiconify $win; \ wm geometry $win ${w}x${h}+0+0; \ wm attributes $win -alpha 1.0"]]]] Bell } #_______________________ proc ::drawscreen::my::DrawingDone {} { # Deletes the drawing stuff. variable draw set draw(started) no image delete $draw(img) destroy $draw(win) catch {focus $draw(oldfocus)} 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::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 } } } #_______________________ proc ::drawscreen::cget {args} { # Gets option values of drawscreen (width, fill, distance). # args - list of option names (can be "width fill -fill -width" etc.) variable my::draw set res [list] foreach opt $args { set opt [string trimleft $opt -] if {[info exists my::draw($opt)]} { set val $my::draw($opt) } else { set val {} } lappend res $val } return $res } #_______________________ proc ::drawscreen::configure {args} { # Sets option values of drawscreen (width, fill, distance). # args - list of pairs "option value" (e.g. "width 8 -fill blue") variable my::draw foreach {opt val} $args { set opt [string trimleft $opt -] if {[info exists my::draw($opt)]} { set my::draw($opt) $val } } } # _________________________________ 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 . exit ::drawscreen::run . $hotk $fill $width } # _________________________________ EOF _________________________________ # ====== <> GUI | Image Processing