Hi cmv, and ELISHEVA,

It's an interesting question to try to solve, so I started looking at some test code for it.  While I was doing so, I noticed that ELISHEVA came up with the algorithm getArcEnd; unfortunately, after plugging it into my program, it doesn't seem to work, at least not consistently:

#!/usr/bin/perl -w ############### ## Libraries ## ############### use strict; use warnings; use Math::Trig; use Tk; ################## ## User-defined ## ################## my $cw = 768; my $ch = 512; my $x1 = 40; my $y1 = 40; my $x2 = 250; my $y2 = 250; my $deg = 60; my $ext = 45; ################## ## Main Program ## ################## my @ids = ( ); my $top = MainWindow->new; my $frm = $top->Frame()->pack(-fill => 'x'); my $can = canvas($top, $cw, $ch); labent($frm, 'X1', \$x1, 8); labent($frm, 'Y1', \$y1, 8); labent($frm, 'X2', \$x2, 8); labent($frm, 'Y2', \$y2, 8); labent($frm, 'Start', \$deg, 8); labent($frm, 'Extent', \$ext, 8); button($frm, 'Exit (Esc)', 'r', sub { exit }, 'Esca +pe'); button($frm, 'Clear Canvas (^L)', 'r', sub { clear_canvas() }, 'Cont +rol-l'); button($frm, 'Random Draw (Space)', 'r', sub { random_draw() }, 'spac +e'); button($frm, 'Draw Arc', 'r', sub { arrowed_arc() }); button($frm, 'Random Args', 'r', sub { random_args() }); MainLoop; ################# ## Subroutines ## ################# sub canvas { my ($w, $width, $height) = @_; my $bg = 'peachpuff'; my $can = $w->Canvas(-width => $width, -height => $height, -bg => +$bg); $can->pack(-expand => 1, -fill => 'both'); return $can; } sub labent { my ($w, $text, $s_var, $width) = @_; my @fargs = (-relief => 'groove', -borderwidth => 4); my @pargs = (-side => 'left', -expand => 1, -fill => 'y'); my $f = $w->Frame(@fargs)->pack(@pargs); my $lbl = $f->Label(-text => $text); my $ent = $f->Entry(-textvar => $s_var, -width => $width); $lbl->pack($ent, -side => 'left'); return [ $lbl, $ent ]; } sub button { my ($f, $text, $side, $c_sub, $binding) = @_; my $btn = $f->Button(-text => $text, -bg => 'lightgreen'); $btn->configure(-command => $c_sub); my $h_sides = {qw( l left r right t top b bottom )}; exists($h_sides->{$side}) and $side = $h_sides->{$side}; $btn->pack(-side => $side); ($binding || 0) and $top->bind("<$binding>" => sub { $btn->invoke +}); return $btn; } sub arrowed_arc { my @opts = ( -style => 'arc', -start => $deg, -extent => $ext ); my $id1 = $can->createArc($x1, $y1, $x2, $y2, @opts); my $a_end = getArcEnd($x1, $y1, $x2, $y2, $deg, $ext); my ($x, $y) = @$a_end; my $id2 = $can->createOval($x - 5, $y - 5, $x + 5, $y + 5, -fill = +> 'red'); push @ids, $id1, $id2; } sub random_args { $x1 = random_value(0, $cw); $x2 = random_value(0, $cw); $y1 = random_value(0, $ch); $y2 = random_value(0, $ch); $deg = random_value(0, 360); } sub clear_canvas { foreach my $id (@ids) { $can->delete($id); } @ids = ( ); $top->update; } sub random_draw { random_args(); arrowed_arc(); } sub random_value { my ($min, $max) = @_; my $rnd = int(rand($max - $min + 1)) + $min; return $rnd; } sub getArcEnd { my ($x, $y, $x2, $y2, $start, $extent) = @_; # $x, $y, $x2, $y2 can be the bounding box of an # ellipse (not just a circle) so calculate vertical # and horizontal radius separately my $radiusX = ($x2 - $x)/2; my $centerX = $x + $radiusX; my $radiusY = ($y2 - $y)/2; my $centerY = $y + $radiusY; # Tk expects the starting angle and length of the # arc (extent) to be in degrees but cos and sin expect # them in radian my $radians = deg2rad($start + $extent); # [ x coord of arc end point, y coord of arc end point ] # the coordinate system for Tk::Canvas makes "down" # positive so we need to subtract the Y component # rather than add it. return [ $centerX + $radiusX*cos($radians) , $centerY - $radiusY*sin($radians) ]; }

My subroutine arrowed_arc is obviously not yet complete; it draws the arc, and then (for the moment) draws only a small, red circle at the coordinates returned by getArcEnd.  Sometimes that circle appears to be correctly placed, and sometimes not.

I'm almost out of time this evening, having also been busy watching the Red Sox currently losing the baseball game against the Angels (as well as getting not one but two ridiculous calls by the first-base umpire, who appears to be blind!).  I'll try to look at the problem later, but perhaps someone else will come up with a solution in the meantime (and feel free to use my test code if that helps!)


s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

In reply to Re: Tk:Canvas - Arc with an arrow? by liverpole
in thread Tk:Canvas - Arc with an arrow? by cmv

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.