Events, Canvas & Paint

#!/usr/bin/env perl
# =============================================================================
#  perl_gui_03_events_canvas.pl  —  GUI Tutorial Part 3: Events & Canvas
#  Companion to: perl_mac_guide.md  Sections 25–27
#
#  Run with:  perl perl_gui_03_events_canvas.pl
#  Requires:  Perl/Tk  (cpanm Tk)
#
#  This file teaches:
#    • bind() — keyboard and mouse events
#    • Modifier keys (Ctrl, Shift, Meta/Cmd on macOS)
#    • after() timers — animated clock
#    • Menu bar and context (right-click) menus
#    • File open/save/color dialogs
#    • Canvas widget — drawing shapes, text, and images
#    • A mini paint application combining all of the above
# =============================================================================
use strict;
use warnings;
use Tk;
use Tk::Canvas;
use Tk::Menu;

# =============================================================================
# Application State
# =============================================================================
my $current_tool    = "pencil";   # pencil | line | rect | oval | text
my $current_color   = "#007aff";
my $current_width   = 3;
my $status_text     = "Ready — Select a tool and draw on the canvas";
my $clock_text      = "";
my @undo_stack      = ();          # Stores canvas item IDs for undo

# Drawing state
my ($start_x, $start_y) = (0, 0);
my $current_item    = undef;
my @pencil_points   = ();

# =============================================================================
# Main Window
# =============================================================================
my $mw = MainWindow->new;
$mw->title("Perl/Tk Paint — Events & Canvas Tutorial");
$mw->geometry("800x650+60+30");
$mw->configure(-background => "#1c1c1e");
$mw->protocol("WM_DELETE_WINDOW", sub {
    my $ans = $mw->messageBox(
        -title   => "Quit?",
        -message => "Exit the paint application?",
        -type    => "YesNo",
        -icon    => "question",
    );
    exit if $ans eq "Yes";
});

# =============================================================================
# Menu Bar  (Section 26)
# =============================================================================
my $menubar = $mw->Menu;
$mw->configure(-menu => $menubar);

# File menu
my $file_menu = $menubar->cascade(-label => "File", -underline => 0, -tearoff => 0);
$file_menu->command(-label => "New Canvas",   -accelerator => "Cmd+N", -command => \&new_canvas);
$file_menu->command(-label => "Open Image…",  -accelerator => "Cmd+O", -command => \&open_image);
$file_menu->separator;
$file_menu->command(-label => "Quit",         -accelerator => "Cmd+Q", -command => sub { exit });

# Edit menu
my $edit_menu = $menubar->cascade(-label => "Edit", -underline => 0, -tearoff => 0);
$edit_menu->command(-label => "Undo",    -accelerator => "Cmd+Z", -command => \&undo_last);
$edit_menu->command(-label => "Clear All",-command => \&clear_canvas);

# Tools menu
my $tools_menu = $menubar->cascade(-label => "Tools", -underline => 0, -tearoff => 0);
$tools_menu->radiobutton(-label => "Pencil",    -value => "pencil",    -variable => \$current_tool);
$tools_menu->radiobutton(-label => "Line",      -value => "line",      -variable => \$current_tool);
$tools_menu->radiobutton(-label => "Rectangle", -value => "rect",      -variable => \$current_tool);
$tools_menu->radiobutton(-label => "Oval",      -value => "oval",      -variable => \$current_tool);
$tools_menu->radiobutton(-label => "Text",      -value => "text",      -variable => \$current_tool);

# Colors menu
my $colors_menu = $menubar->cascade(-label => "Colors", -tearoff => 0);
for my $pair (
    ["Blue",   "#007aff"], ["Red",    "#ff3b30"], ["Green",  "#34c759"],
    ["Purple", "#5856d6"], ["Orange", "#ff9500"], ["Black",  "#000000"],
    ["White",  "#ffffff"], ["Pick…",  "picker"  ],
) {
    my ($label, $val) = @$pair;
    if ($val eq "picker") {
        $colors_menu->command(-label => $label, -command => \&pick_color);
    } else {
        $colors_menu->command(-label => $label, -command => sub { $current_color = $val; update_status() });
    }
}

# =============================================================================
# Toolbar
# =============================================================================
my $toolbar = $mw->Frame(
    -background  => "#2c2c2e",
    -relief      => "flat",
    -borderwidth => 0,
)->pack(-fill => "x");

# Tool buttons
my @tools = (
    ["✏",  "pencil",  "Pencil (freehand)"],
    ["╱",  "line",    "Line"],
    ["▭",  "rect",    "Rectangle"],
    ["○",  "oval",    "Oval"],
    ["T",  "text",    "Text"],
);

for my $t (@tools) {
    my ($icon, $tool, $tip) = @$t;
    $toolbar->Button(
        -text             => $icon,
        -font             => "Helvetica 14",
        -background       => "#2c2c2e",
        -foreground       => "white",
        -activebackground => "#007aff",
        -activeforeground => "white",
        -relief           => "flat",
        -padx             => 12, -pady => 6,
        -command          => sub { $current_tool = $tool; update_status() },
    )->pack(-side => "left");
}

$toolbar->Label(-text => "|", -foreground => "#555", -background => "#2c2c2e"
               )->pack(-side => "left", -padx => 4);

# Color swatches in toolbar
for my $color ("#007aff", "#ff3b30", "#34c759", "#5856d6", "#ff9500", "#ffffff", "#000000") {
    $toolbar->Button(
        -background       => $color,
        -activebackground => $color,
        -width            => 2,
        -relief           => "flat",
        -padx             => 4, -pady => 6,
        -command          => sub { $current_color = $color; update_status() },
    )->pack(-side => "left", -padx => 1);
}

$toolbar->Button(
    -text             => "⊕ Color",
    -font             => "Helvetica 10",
    -background       => "#2c2c2e",
    -foreground       => "#aaaaaa",
    -activebackground => "#3a3a3c",
    -relief           => "flat",
    -padx             => 6, -pady => 6,
    -command          => \&pick_color,
)->pack(-side => "left", -padx => 4);

$toolbar->Label(-text => "|", -foreground => "#555", -background => "#2c2c2e"
               )->pack(-side => "left", -padx => 4);

# Brush size
$toolbar->Label(-text => "Size:", -font => "Helvetica 10",
                -foreground => "#aaaaaa", -background => "#2c2c2e"
               )->pack(-side => "left");
$toolbar->Scale(
    -from       => 1,
    -to         => 20,
    -orient     => "horizontal",
    -variable   => \$current_width,
    -length     => 80,
    -showvalue  => 0,
    -background => "#2c2c2e",
    -foreground => "white",
    -troughcolor=> "#555",
)->pack(-side => "left", -padx => 4);

# Undo and Clear
$toolbar->Label(-text => "|", -foreground => "#555", -background => "#2c2c2e"
               )->pack(-side => "left", -padx => 4);
$toolbar->Button(-text => "↩ Undo", -font => "Helvetica 10",
                 -background => "#2c2c2e", -foreground => "#aaaaaa",
                 -activebackground => "#3a3a3c", -relief => "flat",
                 -padx => 6, -pady => 6,
                 -command => \&undo_last)->pack(-side => "left", -padx => 2);
$toolbar->Button(-text => "✕ Clear", -font => "Helvetica 10",
                 -background => "#2c2c2e", -foreground => "#ff453a",
                 -activebackground => "#3a3a3c", -relief => "flat",
                 -padx => 6, -pady => 6,
                 -command => \&clear_canvas)->pack(-side => "left", -padx => 2);

# Clock label (right side of toolbar)
$toolbar->Label(
    -textvariable     => \$clock_text,
    -font             => "Courier 11",
    -foreground       => "#aaaaaa",
    -background       => "#2c2c2e",
)->pack(-side => "right", -padx => 10);

# =============================================================================
# Canvas (Section 27)
# =============================================================================
my $canvas = $mw->Canvas(
    -background => "white",
    -cursor     => "crosshair",
)->pack(-fill => "both", -expand => 1);

# =============================================================================
# Status Bar
# =============================================================================
my $status_bar = $mw->Frame(-background => "#2c2c2e", -height => 24)->pack(
    -fill => "x", -side => "bottom"
);
$status_bar->Label(
    -textvariable => \$status_text,
    -font         => "Helvetica 10",
    -foreground   => "#aaaaaa",
    -background   => "#2c2c2e",
    -anchor       => "w",
)->pack(-side => "left", -padx => 10);

my $coord_text = "";
$status_bar->Label(
    -textvariable => \$coord_text,
    -font         => "Courier 10",
    -foreground   => "#555555",
    -background   => "#2c2c2e",
)->pack(-side => "right", -padx => 10);

# =============================================================================
# Canvas Event Bindings  (Section 25)
# =============================================================================

# Mouse press — start drawing
$canvas->bind("<Button-1>", \&on_mouse_press);

# Mouse drag — continue drawing
$canvas->bind("<B1-Motion>", \&on_mouse_drag);

# Mouse release — finish shape
$canvas->bind("<ButtonRelease-1>", \&on_mouse_release);

# Track mouse position for status bar
$canvas->bind("<Motion>", sub {
    my $e = $canvas->XEvent;
    $coord_text = sprintf("x: %4d  y: %4d", $e->x, $e->y);
});

# Right-click context menu
my $ctx_menu = $mw->Menu(-tearoff => 0);
$ctx_menu->command(-label => "Undo Last",  -command => \&undo_last);
$ctx_menu->command(-label => "Clear All",  -command => \&clear_canvas);
$ctx_menu->separator;
$ctx_menu->command(-label => "Pick Color…", -command => \&pick_color);

$canvas->bind("<Button-3>", sub {
    my $e = $canvas->XEvent;
    $ctx_menu->popup($e->X, $e->Y);
});

# =============================================================================
# Keyboard Shortcuts  (Section 25)
# =============================================================================
# macOS Command key = Meta in Perl/Tk
$mw->bind("<Meta-z>",  \&undo_last);
$mw->bind("<Meta-n>",  \&new_canvas);
$mw->bind("<Meta-q>",  sub { exit });
$mw->bind("<Escape>",  sub { $current_tool = "pencil"; update_status() });

# Tool hotkeys
$mw->bind("<p>", sub { $current_tool = "pencil"; update_status() });
$mw->bind("<l>", sub { $current_tool = "line";   update_status() });
$mw->bind("<r>", sub { $current_tool = "rect";   update_status() });
$mw->bind("<o>", sub { $current_tool = "oval";   update_status() });
$mw->bind("<t>", sub { $current_tool = "text";   update_status() });

# =============================================================================
# after() Timer — Animated Clock  (Section 25)
# =============================================================================
# after() schedules a callback. By rescheduling itself inside the callback,
# we create a repeating timer without blocking the event loop.
sub tick_clock {
    $clock_text = scalar localtime();
    $mw->after(1000, \&tick_clock);   # Re-schedule after 1 second
}
tick_clock();   # Start the clock

# =============================================================================
# Draw a welcome message on the canvas
# =============================================================================
$mw->after(100, sub {
    my $w = $canvas->width;
    my $h = $canvas->height;
    $canvas->createText($w/2, $h/2 - 30,
        -text   => "Perl/Tk Canvas",
        -font   => "Helvetica 28 bold",
        -fill   => "#e0e0e0",
        -anchor => "center",
    );
    $canvas->createText($w/2, $h/2 + 10,
        -text   => "Select a tool from the toolbar and start drawing!",
        -font   => "Helvetica 12",
        -fill   => "#cccccc",
        -anchor => "center",
    );
    $canvas->createText($w/2, $h/2 + 35,
        -text   => "Hotkeys: p=pencil  l=line  r=rect  o=oval  t=text  Cmd+Z=undo",
        -font   => "Helvetica 10",
        -fill   => "#aaaaaa",
        -anchor => "center",
    );
});

# =============================================================================
# Drawing Callbacks
# =============================================================================
sub on_mouse_press {
    my $e = $canvas->XEvent;
    ($start_x, $start_y) = ($e->x, $e->y);
    @pencil_points = ($start_x, $start_y);
    $current_item  = undef;

    if ($current_tool eq "text") {
        # For text tool, ask for input
        my $txt = "";
        my $dlg = $mw->Toplevel;
        $dlg->title("Add Text");
        $dlg->geometry("280x110");
        $dlg->transient($mw);
        $dlg->grab;
        $dlg->Label(-text => "Enter text to place at ($start_x, $start_y):"
                   )->pack(-padx => 10, -pady => 8);
        $dlg->Entry(-textvariable => \$txt, -width => 30, -font => "Helvetica 11"
                   )->pack(-padx => 10);
        $dlg->Frame->pack(-pady => 3);
        $dlg->Button(
            -text    => "Place",
            -command => sub {
                if ($txt) {
                    my $id = $canvas->createText($start_x, $start_y,
                        -text   => $txt,
                        -font   => "Helvetica " . ($current_width * 3 + 8) . " bold",
                        -fill   => $current_color,
                        -anchor => "nw",
                    );
                    push @undo_stack, $id;
                }
                $dlg->destroy;
            },
        )->pack;
        $dlg->waitWindow;
    }
}

sub on_mouse_drag {
    my $e  = $canvas->XEvent;
    my ($x, $y) = ($e->x, $e->y);

    if ($current_tool eq "pencil") {
        # Freehand: add point to the polyline
        push @pencil_points, ($x, $y);
        if ($current_item) { $canvas->delete($current_item) }
        $current_item = $canvas->createLine(
            @pencil_points,
            -fill    => $current_color,
            -width   => $current_width,
            -capstyle => "round",
            -joinstyle => "round",
            -smooth  => 1,
        );
    } elsif ($current_tool eq "line") {
        if ($current_item) { $canvas->delete($current_item) }
        $current_item = $canvas->createLine(
            $start_x, $start_y, $x, $y,
            -fill  => $current_color,
            -width => $current_width,
            -arrow => "none",
        );
    } elsif ($current_tool eq "rect") {
        if ($current_item) { $canvas->delete($current_item) }
        $current_item = $canvas->createRectangle(
            $start_x, $start_y, $x, $y,
            -outline => $current_color,
            -width   => $current_width,
            -fill    => "",
        );
    } elsif ($current_tool eq "oval") {
        if ($current_item) { $canvas->delete($current_item) }
        $current_item = $canvas->createOval(
            $start_x, $start_y, $x, $y,
            -outline => $current_color,
            -width   => $current_width,
            -fill    => "",
        );
    }
}

sub on_mouse_release {
    push @undo_stack, $current_item if $current_item;
    $current_item  = undef;
    @pencil_points = ();
}

# =============================================================================
# Canvas Operations
# =============================================================================
sub undo_last {
    if (@undo_stack) {
        my $id = pop @undo_stack;
        $canvas->delete($id);
        update_status("Undo: removed item $id");
    } else {
        update_status("Nothing to undo.");
    }
}

sub clear_canvas {
    my $ans = $mw->messageBox(
        -title   => "Clear Canvas",
        -message => "Clear all drawings?",
        -type    => "YesNo",
        -icon    => "question",
    );
    if ($ans eq "Yes") {
        $canvas->delete("all");
        @undo_stack = ();
        update_status("Canvas cleared.");
    }
}

sub new_canvas {
    clear_canvas();
}

sub open_image {
    # File open dialog (Section 26)
    my $file = $mw->getOpenFile(
        -title      => "Open Image",
        -initialdir => $ENV{HOME} // ".",
        -filetypes  => [
            ["PNG Images", ".png"],
            ["GIF Images", ".gif"],
            ["All Files",  "*"],
        ],
    );
    return unless $file;

    eval {
        my $photo = $mw->Photo(-file => $file);
        my $id    = $canvas->createImage(20, 20, -image => $photo, -anchor => "nw");
        push @undo_stack, $id;
        update_status("Opened: $file");
    };
    if ($@) {
        $mw->messageBox(
            -title   => "Error",
            -message => "Could not load image:\n$@",
            -type    => "OK",
            -icon    => "error",
        );
    }
}

sub pick_color {
    # Color chooser dialog (Section 26)
    my $chosen = $mw->chooseColor(
        -title        => "Pick Drawing Color",
        -initialcolor => $current_color,
    );
    if ($chosen) {
        $current_color = $chosen;
        update_status("Color set to $current_color");
    }
}

sub update_status {
    my ($msg) = @_;
    my $tool_names = { pencil => "Pencil ✏", line => "Line ╱", rect => "Rect ▭",
                       oval => "Oval ○", text => "Text T" };
    my $tname = $tool_names->{$current_tool} // $current_tool;
    $status_text = ($msg // "") . "   Tool: $tname   Color: $current_color   Width: $current_width";
}

update_status();

# =============================================================================
# Main Loop
# =============================================================================
MainLoop;