#!perl -w

use strict;

use Win32::GUI;
use Cwd;

my $VERSION = "0.14.00";
my %objects = ();
my %varobjects = ();

my %TreeStruct;

my $EM_SCROLLCARET = 183;
my $EM_LINESCROLL = 182;
my $EM_SETSEL = 177;
my $EM_EXLINEFROMCHAR = 1078;

my ($DOS) = Win32::GUI::GetPerlWindow();
#Win32::GUI::Hide($DOS);

my $Menu = new Win32::GUI::Menu(
    "&File" => "File",
    "   >   &New" => "FileNew",
    "   >   &Open" => "FileOpen",
    "   >   &Save" => "FileSave",
    "   >   Save &As" => "FileSaveAs",
    "   >   &Close" => "FileClose",
    "   >   -" => 0,
    "   >   &Repride" => "FileRepride",
    "   >   -" => 0,
    "   >   E&xit" => "FileExit",

    "&Edit" => "Edit",
    "   >   &Undo" => "EditUndo",
    "    >    -" => 0,
    "   >   Cu&t" => "EditCut",
    "   >   &Copy" => "EditCopy",
    "   >   &Paste" => "EditPaste",

    "&Program" => "Program",
    "   >   &View Structure" => { -name => "ProgramViewStructure", -checked => 1 },
    "   >   &Rebuild Structure" => "ProgramRebuildStructure",

    "&Run" => "Run",
    "   >   &Execute" => "RunExecute",
    "   >   &Debug" => "RunDebug",

);

my $EditorFont = new Win32::GUI::Font(
    -name => "Courier New", 
    -height => 16,
);

my $EditorClass = new Win32::GUI::Class(
    -name => "PRIDE_${VERSION}_Editor",
    -extends => "RichEdit",
    -widget => "RichEdit",
);

my $Window = new Win32::GUI::Window(
    -name   => "Window",
    -left   => 100,
    -top    => 100,
    -width  => 800,
    -height => 500,
    -title  => "PRIDE version ".$VERSION,
    -menu   => $Menu,
);

$Window->AddStatusBar(
    -name => "Status",
    -text => "PRIDE version $VERSION - Ready",
);

$Window->AddRichEdit(
    -class     => $EditorClass,
    -name      => "Editor",
    -multiline => 1,
    -left      => 150,
    -top       => 28,
    -width     => $Window->ScaleWidth,
    -height    => $Window->ScaleHeight-28-$Window->Status->Height,
    -font      => $EditorFont,
    -exstyle   => WS_EX_CLIENTEDGE,
    -style     => WS_CHILD | WS_VISIBLE | WS_VSCROLL | WS_HSCROLL
        | ES_LEFT | ES_MULTILINE | ES_AUTOHSCROLL | ES_AUTOVSCROLL,
);

$Window->Editor->SendMessage(1093, 0, 1);

$Window->AddTreeView(   
    -name   => "ProgStruct",
    -pos    => [0, 0],
    -size   => [ 150, $Window->ScaleHeight-28-$Window->Status->Height ],
    -lines  => 1,
    -buttons => 1,
    -rootlines => 1,
);

#
#$Window->AddCombobox(
#    -name      => "SelectObj",
#    -left      => 0,
#    -top       => 5,
#    -width     => $Window->ScaleWidth/2,
#    -height    => 300,
#    -style     => Win32::GUI::constant("WS_VISIBLE", 0) | 3 | Win32::GUI::constant("WS_NOTIFY", 0),
#);
#
#$Window->AddCombobox(
#    -name      => "SelectSub",
#    -left      => $Window->ScaleWidth/2,
#    -top       => 5,
#    -width     => $Window->ScaleWidth/2,
#    -height    => 300,
#    -style     => Win32::GUI::constant("WS_VISIBLE", 0) | 3 | Win32::GUI::constant("WS_NOTIFY", 0),
#);
#

my $GotoWindow = new Win32::GUI::DialogBox(
    -name => "GotoWindow",
    -text => "Goto line...",
    -left => 150,
    -top  => 150,
    -width => 200,
    -height => 100,
);

$GotoWindow->AddLabel(
    -name => "GotoLabel",
    -text => "Line:",
    -left => 5,
    -top => 10,
);

$GotoWindow->AddTextfield(
    -name => "GotoLine",
    -left => 5,
    -top => 25,
    -width => 190,
    -height => 22, 
    -tabstop => 1,
);

$GotoWindow->AddButton(
    -name => "GotoOK",
    -text => "OK", 
    -left => 5,
    -top => 50,
    -height => 22,
    -width => 90,
    -tabstop => 1,
    -ok => 1,
    -default => 1,
);

$GotoWindow->AddButton(
    -name => "GotoCancel",
    -text => "Cancel", 
    -left => 100,
    -top => 50,
    -height => 22,
    -width => 90,
    -tabstop => 1,
    -cancel => 1,
);

$Window->Show();

my $FILE = ($ARGV[0] or $0);
LoadFile($FILE);

$Window->{-dialogui} = 1;

print "DIALOGUI: $Window->{-dialogui}\n";<STDIN>;

Win32::GUI::Dialog();

Win32::GUI::Show($DOS);
print "Bye bye from PRIDE version $VERSION...\n";

sub Window_Terminate {
    if(OkToClose()) {
    return -1;
    } else {
    return 1;
    }
}

sub Window_Resize {
    my $Width = $Window->ScaleWidth;
    my $Height = $Window->ScaleHeight;
    $Window->Editor->Resize($Width, $Height-28-$Window->Status->Height);
    $Window->Status->Resize($Width, $Window->Status->Height);
#    $Window->SelectObj->Resize($Width/2, $Window->SelectObj->Height);
#    $Window->SelectSub->Resize($Width/2, $Window->SelectSub->Height);
#    $Window->SelectSub->Move($Width/2, 5);
    $Window->Status->Move(0, $Window->ScaleHeight-$Window->Status->Height);
}

sub Window_Activate {
    $Window->Editor->SetFocus();
}

sub LoadFile {
    ($FILE) = @_;
    my $DEBUG = 1;
    print "FILE: $FILE\n" if $DEBUG;
    open(FILE, $FILE) or return 0;
    my $file = "";
    my $object;
    my $parent;
    my $sub;
    my $defo;
    my $var;  
    my $what;
    my $name;
    my $c = 1;

    %objects = ("<perl>" => []);
    %varobjects = ();
#    $Window->SelectObj->Clear();
#    $Window->SelectSub->Clear();
#    $Window->SelectObj->AddString("<perl>");

    $Window->ProgStruct->Clear();

    $TreeStruct{"<perl>"} = $Window->ProgStruct->InsertItem(-text => "<perl>");

    while(<FILE>) {
    chomp;
    # converts tabs in 4 spaces
    s/\t/    /g;

        if(/^\s*#/) {
            $file .= $_."\r\n";
        } else {

            if(/\$(.+)\s*=\s*new (Win32::)?GUI::/) {
                $var = $1;
                $var =~ s/^\s*//;
                $var =~ s/\s*$//;
                print "Found variable: [$var]\n" if $DEBUG;
                $object = "[TBD]";
                $what = "X";
                $defo = length($file);
            }

            #    $Window->SelectObj->AddString($object);
            #    $Window->SelectObj->Text($object);
            #    if(exists($objects{$object})) {
            #        push(@{$objects{$object}}, "<definition>;".length($file));
            #    } else {
            #        $objects{$object} = [ "<definition>;".length($file) ];
            #    }
            #}

            if(/\s*\$(\S+)->Add/) {
                $parent = $1;
                $parent =~ s/^\s*//;
                $parent =~ s/\s*$//;
                print "Found child of [$parent]\n" if $DEBUG;
                print "varobjects(parent): $varobjects{$parent}\n" if $DEBUG;
                if(exists($varobjects{$parent})) {
                    $object = "[TBD]";
                    $what = "";
                    $defo = length($file);
                } else {
                    print "Skipping because [$parent] doesn't exists...\n" if $DEBUG;
                }
            }
            if(/-name\s*=>\s*["']?([^,"']+)["']?,?/ and $object eq "[TBD]") {
                $object = $1;
                $object =~ s/^\s*//;
                $object =~ s/\s*$//;
                print "Found name: [$object]\n" if $DEBUG;
                if(exists($objects{$object})) {
                    push(@{$objects{$object}}, "<definition>;".$defo);
                } else {
                    $objects{$object} = [ "<definition>;".$defo ];
                }
                if($var) {
                    #$Window->SelectObj->AddString($object." (\$".$var.")");
                    #$Window->SelectObj->Text($object." (\$".$var.")");

                    $TreeStruct{$object} = $Window->ProgStruct->InsertItem(
                        -text => "$object (\$$var)",
                    );
                    $varobjects{$var} = $object;
                } else {
                    $TreeStruct{$object} = $Window->ProgStruct->InsertItem(
                        -text => "$object",
                    );
                    #$Window->SelectObj->AddString($object);
                    #$Window->SelectObj->Text($object);
                }            
                $object = "";
                $var = "";
                $what = "";
            }
            if(/\$(.+)\s*=\s*\$(.+)->Add/) {
                $object = $1;
                $parent = $2;
                $object =~ s/^\s*//;
                $object =~ s/\s*$//;
                $parent =~ s/^\s*//;
                $parent =~ s/\s*$//;
                print "Found object: [$object] (parent: [$parent])\n" if $DEBUG;
                print "objects(parent): $objects{$parent}\n" if $DEBUG;
                #if(exists($objects{$parent})) {
                #    $Window->SelectObj->AddString($object);
                #    $Window->SelectObj->Text($object);
                #    push(@{$objects{$object}}, "<definition>;".length($file));
                #}
                if(exists($varobjects{$parent})) {
                    $object = "[TBD]";
                    $what = "";
                    $defo = length($file);
                } else {
                    print "Skipping because [$parent] doesn't exists...\n" if $DEBUG;
                }

            }
            if(/^\s*sub ([^\s{]+)_([^\s{]+)/) {
                $parent = $1;
                $sub    = $2;
                if(exists($objects{$parent})) {
                    push(@{$objects{$parent}}, $sub.";".length($file));
                } else {
                    $parent = "<perl>";
                    $sub    = $1."_".$2;
                    if(exists($objects{$parent})) {
                        push(@{$objects{$parent}}, $sub.";".length($file));
                    }               
                }               
            } else {
                if(/^\s*sub ([^\s{]+)/) {
                    $parent = "<perl>";
                    $sub    = $1;
                    if(exists($objects{$parent})) {
                        push(@{$objects{$parent}}, $sub.";".length($file));
                    }               
                }
            }
            # $file .= $c++." ".$_."\r\n";
            $file .= $_."\r\n";
        }               
    }
    close(FILE);

    foreach $object (keys %objects) {
        foreach $sub (@{$objects{$object}}) {
            ($name, undef) = split(/;/, $sub, 2);
            $TreeStruct{$object."-".$name} = $Window->ProgStruct->InsertItem(
                -text => $name, 
                -parent => $TreeStruct{$object},
            );
        }
    }


    $Window->Editor->Text($file);
    $Window->Caption("PRIDE Version $VERSION - $FILE");
    $Window->Editor->SetFocus();
    return 1;
}

sub SelectObj_Change {
    my $object = $Window->SelectObj->GetString($Window->SelectObj->SelectedItem);
    $object =~ s/ \(\$.*\)$//;
    print "Selected object: $object\n";
    $Window->SelectSub->Clear();
    my $sub;
    my $name;
    foreach $sub (@{$objects{$object}}) {
    ($name, undef) = split(/;/, $sub, 2);
    $Window->SelectSub->AddString($name);
    }
    $Window->SelectSub->Select(0);
    SelectSub_Change();
}

sub SelectSub_Change {
    my $object;
    my $ssub;
    my $issub = $Window->SelectSub->SelectedItem;
    my $isobject = $Window->SelectObj->SelectedItem;
    if($isobject >= 0) {
    $object = $Window->SelectObj->GetString($Window->SelectObj->SelectedItem);
    $object =~ s/ \(\$.*\)$//;
    } else {
    return 1;
    }
    if($issub >= 0) {
    $ssub = $Window->SelectSub->GetString($Window->SelectSub->SelectedItem);
    } else {
    return 1;
    }
    my $sub;
    my $name;
    my $pos;
    foreach $sub (@{$objects{$object}}) {
    ($name, $pos) = split(/;/, $sub, 2);
    if($name eq $ssub) {

        GotoLine($Window->Editor->LineFromChar($pos));

        #print "Object: $object / Sub: $ssub / Pos: $pos\n";
        ## $Window->Editor->Select($pos-1, $pos+1);
        #$Window->Editor->SendMessage($EM_SETSEL, $pos, $pos);
        #$Window->Editor->SendMessage($EM_SCROLLCARET, 0, 0);
        
        $Window->Editor->Update();
        $Window->Editor->SetFocus();
    }
    }
}

sub FileRepride_Click {
    # system("perl $0");
    if(OkToClose()) {

    system("start /min perl $0");

    #my $pid = 0;
    #my $file;
    #if($FILE !~ /^[a-z]:\\/i) {
    #    $file = Win32::GetCwd."\\".$FILE;
    #} else {
    #    $file = $FILE;
    #}
    #print "Executing p:\\perl5\\bin\\perl.exe $file ...\n";
    #my $r = Win32::Spawn("perl", "$file", $pid);
    #my $err = Win32::GetLastError();
    #print "Repride r=$r err=$err pid=$pid\n";
    return -1;
    } else {
    return 1;
    }
}


sub FileExit_Click {
    if(OkToClose()) {
    return -1;
    } else {
    return 1;
    }
}

sub FileSave_Click {
    # make a backup copy
    open(BAKFILE, ">$FILE.bak");
    open(OLDFILE, "<$FILE");
    while(<OLDFILE>) { print <BAKFILE>; }
    close(BAKFILE);
    close(OLDFILE);

    open(FILE, ">$FILE");
    my $text = $Window->Editor->Text();
    $text =~ s/\r\n/\n/g;
    print FILE $text;
    close(FILE);
    $text = $Window->Text();
    if($text =~ s/ \*$//) {
    $Window->Text($text);
    }
}


sub FileClose_Click {
    if(OkToClose()) {
    $Window->Editor->Text("");
    $FILE = "untitled.pl";
    $Window->Text("PRIDE version $VERSION - untitled.pl");
    }
}

sub FileNew_Click {
    if(OkToClose()) {
    $Window->Editor->Text("");
    $FILE = "untitled.pl";
    $Window->Text("PRIDE version $VERSION - untitled.pl");
    }
}

sub FileOpen_Click {
    my $file = GUI::GetOpenFileName(-directory => Win32::GetCwd());
    if($file) {
    LoadFile($file);
    }
}


sub FileSaveAs_Click {
    my $file = GUI::GetSaveFileName(-directory => Win32::GetCwd());
    if($file) {
        open(BAKFILE, ">$FILE.bak");
        open(OLDFILE, "<$FILE");
        while(<OLDFILE>) { print <BAKFILE>; }
        close(BAKFILE);
        close(OLDFILE);

        open(FILE, ">$file");
        my $text = $Window->Editor->Text();
        $text =~ s/\r\n/\n/g;
        print FILE $text;
        close(FILE);
        $text = $Window->Text();
        if($text =~ s/ \*$//) {
            $Window->Text($text);
        }
    }
}


sub Editor_KeyPress {
    my($key) = @_;

    if($key == 7) {
    $GotoWindow->Move(
        $Window->Left+($Window->ScaleWidth-$GotoWindow->Width)/2,
        $Window->Top+($Window->ScaleHeight-$GotoWindow->Height)/2,
    );
    $GotoWindow->Show();
    $GotoWindow->GotoLine->SetFocus();
    $Window->Disable();
    return 0;
    } else {
    print "Editor_KeyPress got $key\n";
    my($pos, undef) = $Window->Editor->Selection();
    my $line = 1 + $Window->Editor->LineFromChar($pos);
    $Window->Status->Text("on line $line");
    return 1;
    }
}

sub GotoWindow_Terminate {
    GotoCancel_Click();
}

sub GotoCancel_Click {
    $GotoWindow->Hide();
    $Window->Enable();
    $Window->SetForegroundWindow();
    return 1;
}

sub GotoOK_Click {
    $GotoWindow->Hide();
    $Window->Enable();
    GotoLine($GotoWindow->GotoLine->Text);
    return 1;
}

sub GotoLine {
    my($line) = @_;
    print "Line=$line\n";
    my $fvl = $Window->Editor->FirstVisibleLine;
    print "FVL=$fvl\n";
    my $diff = ($line-1) - $fvl;
    print "DIFF=$diff\n";
    $Window->Editor->SendMessage($EM_LINESCROLL, 0, $diff);
    my ($ci, $li) = $Window->Editor->CharFromPos(1, 1);
    print "CI=$ci\n";
    $Window->Editor->Select($ci, $ci);
    $Window->Editor->SendMessage($EM_SCROLLCARET, 0, 0);
    $Window->Editor->SetFocus();
}

sub Editor_Change {
    my $text = $Window->Text;
    if($text !~ /\*$/) {
    $Window->Text($text." *");
    }
    return 1;
}

sub OkToClose {
    # if($Window->Editor->Modified()) {
    if($Window->Text =~ /\*$/) {
    my $answer = $Window->MessageBox("Save changes to $FILE ?", "PRIDE", 3+48);
    if($answer == 3) { # IDCANCEL
        return 0;
    } elsif($answer == 6) {
        FileSave_Click();
        return 1;
    } elsif($answer == 7) {
        return 1;
    }
    } else {
    return 1;
    }
    return 0;
}

#=======================
sub ProgStruct_KeyDown {
#=======================
    my($key) = @_;
    if($key == 13) {
        ProgStruct_DblClick();
    }
}
#========================
sub ProgStruct_DblClick {
#========================
    my $sub = $Window->ProgStruct->SelectedItem;
    print "ProgStruct_DblClick: sub=$sub\n";
    my %sub = $Window->ProgStruct->GetItem($sub);
    my $obj = $Window->ProgStruct->GetParent($sub);
    print "ProgStruct_DblClick: obj=$obj\n";
    my %obj = $Window->ProgStruct->GetItem($obj);

    $obj{-text} =~ s/\s\(.*\)$//;

    if(exists $TreeStruct{$obj{-text}."-".$sub{-text}}) {
        foreach my $o (@{$objects{$obj{-text}}}) {
            my ($name, $pos) = split(/;/, $o, 2);
            if($name eq $sub{-text}) {
                GotoLine($Window->Editor->LineFromChar($pos));

                $Window->Editor->Update();
                $Window->Editor->SetFocus();
            }
        }
    } else {
        print "not a child: $obj{-text}-$sub{-text}\n";
    }
    return 0;
}

