#!/usr/bin/perl -w

# later we can add some very restrictive Perl languages syntax to it
# what about a no perl;  use perl qw(print); pragma that will eliminate all perl functions/syntax
# and enable only the ones we really ask for ? a sort of minimal Perl ?

=head1 SYNOPSIS

very simple LOGO implementation in Perl

=head1 DESCRIPTION


=head1 commands

go NUMBER-OF-PIXELS
left in-degrees
right in-degrees
color  name-of-the-color-like-red
up     pick up the pencil (stop drawing)
down   put down the pencil (start drawing)
procedure NAME     to define a procedure 
goto NAME          to execute a procedure



=head1 Example

procedure main
go 100
left 90
go 100
left 90
go 100
left 90
go 100
left 90
go 100
end

=head1 TODO

Write our LOGO documentation
Define grammar properly and not with our own tools
Tests ? How ?


=head1 See also

There is also a suggestion to a language called Boxer that might be even better for
educational purposes than LOGO. This should be researched a bit.
http://eurologo.web.elte.hu/lectures/dis.htm
http://eurologo.web.elte.hu/prog.htm

comenius logo

Learn to program in Logo
http://library.thinkquest.org/18446/

http://www.engin.umd.umich.edu/CIS/course.des/cis400/logo/logo.html

http://www.pcai.com/web/ai_info/pcai_logo.html
http://www.idiom.com/free-compilers/LANG/Logo-1.html

=head1 VERSION

$Id:$

=head1 AUTHOR

Gabor Szabo <gabor@pti.co.il>

=cut



use strict;
use constant PI => 3.14;

use Tk;

my $width = 100;
my $height = 100;

my $main = MainWindow->new;
my $canvas = $main->Canvas(
     -width  => $width,
     -height => $height,
     -relief => 'sunken',
);
$canvas->pack;

my %location;
my %new_location;
$location{x}  = int $width/2;
$location{y}  = int $height/2;
my $direction = 0; # 
my $color = 'black';
my $is_drawing = 1;
my $procedure = '';
my %proc;

while (my $line = <DATA>) {
   chomp $line;
   next if $line !~ /\S/;
   my ($command, @arg) = split /\s+/, $line;
   if (not $procedure and $command ne 'procedure') {
      die "Syntax error. Command '$line' found outside of a procedure\n";
   }
   if ($command eq 'procedure') {
      $procedure = $arg[0];
      next;
   }
   if ($command eq 'end') {
      $procedure = '';
      next;
   }
   if ($procedure ne 'main') {
      push @{$proc{$procedure}}, $line;
      next;
   }
   if ($command eq 'up') {
      $is_drawing = 0;
      next;
   }
   if ($command eq 'down') {
      $is_drawing = 1;
      next;
   }
   if ($command eq 'go') {
      $new_location{x} = $location{x} + $arg[0] * sin($direction*PI/180);
      $new_location{y} = $location{y} + $arg[0] * cos($direction*PI/180);
      if ($is_drawing) {
         $canvas->create('line', @location{'x', 'y'}, @new_location{'x', 'y'} );
      }
      %location = %new_location;
      next;
   }
   if ($command eq 'left') {
      $direction += $arg[0];
      $direction %= 360;
      next;
   }
   if ($command eq 'right') {
      $direction -= $arg[0];
      $direction %= 360;
      next;
   }
   die "Command not recognized: '$line'\n";
}

MainLoop;

=pod
=cut

__END__
go 20
left 90 
go 20
left 90
go 20
up
go 20
down
go 20
right 90
go 20
right 120
go 30