#!/usr/bin/perl

# pqtsh : a graphical shell for PerlTQt.
#
# author: Germain Garand <germain@ebooksfrance.org>
# license: GNU Public License v2
#

use utf8;
use strict 'vars';

package TQtShellControl;

use TQt;
use TQt::isa qw(TQt::MainWindow);
use TQt::slots
    fileOpen => [],
    fileSave => [],
    fileSaveAs => [],
    filePrint => [],
    fileExit => [],
    helpExample => [];
use TQt::signals
    fileNeedsEval => [TQString];
use TQt::attributes qw(
    menubar
    fileMenu
    helpMenu
    toolBar
    fileName
    fileOpenAction
    fileSaveAction
    fileSaveAsAction
    filePrintAction
    fileExitAction
    helpExampleAction
    comboBox
    sessionLog
    executedLines
    printer
);

our $image0_data =
["22 22 7 1",
". c None",
"# c #000000",
"b c #292c29",
"c c #5a5d5a",
"d c #838583",
"e c #c5c2c5",
"a c #ffffff",
"......................",
"....##########........",
"....#aaaaaaa#b#.......",
"....#aaaaaaa#cb#......",
"....#aaaaaaa#dcb#.....",
"....#aaaaaaa#edcb#....",
"....#aaaaaaa#aedcb#...",
"....#aaaaaaa#######...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....#aaaaaaaaaaaaa#...",
"....###############...",
"......................",
"......................"];

our $image1_data =
["22 22 5 1",
". c None",
"# c #000000",
"c c #838100",
"a c #ffff00",
"b c #ffffff",
"......................",
"......................",
"......................",
"............####....#.",
"...........#....##.##.",
"..................###.",
".................####.",
".####...........#####.",
"#abab##########.......",
"#babababababab#.......",
"#ababababababa#.......",
"#babababababab#.......",
"#ababab###############",
"#babab##cccccccccccc##",
"#abab##cccccccccccc##.",
"#bab##cccccccccccc##..",
"#ab##cccccccccccc##...",
"#b##cccccccccccc##....",
"###cccccccccccc##.....",
"##cccccccccccc##......",
"###############.......",
"......................"];

our $image2_data =
["22 22 5 1",
". c None",
"# c #000000",
"a c #838100",
"b c #c5c2c5",
"c c #cdb6d5",
"......................",
".####################.",
".#aa#bbbbbbbbbbbb#bb#.",
".#aa#bbbbbbbbbbbb#bb#.",
".#aa#bbbbbbbbbcbb####.",
".#aa#bbbccbbbbbbb#aa#.",
".#aa#bbbccbbbbbbb#aa#.",
".#aa#bbbbbbbbbbbb#aa#.",
".#aa#bbbbbbbbbbbb#aa#.",
".#aa#bbbbbbbbbbbb#aa#.",
".#aa#bbbbbbbbbbbb#aa#.",
".#aaa############aaa#.",
".#aaaaaaaaaaaaaaaaaa#.",
".#aaaaaaaaaaaaaaaaaa#.",
".#aaa#############aa#.",
".#aaa#########bbb#aa#.",
".#aaa#########bbb#aa#.",
".#aaa#########bbb#aa#.",
".#aaa#########bbb#aa#.",
".#aaa#########bbb#aa#.",
"..##################..",
"......................"];

our $image3_data =
["22 22 88 2",
"TQt c None",
".2 c #000000",
".S c #08ff08",
"#v c #100810",
".U c #101010",
"#c c #101018",
".M c #181018",
"#e c #181818",
".A c #181820",
".L c #201820",
"#l c #202020",
".z c #202029",
"#m c #292029",
"#u c #292829",
"#n c #292831",
".R c #29ff29",
"#o c #312831",
".T c #313031",
"#p c #313039",
".Z c #31ff31",
"#q c #393039",
"#t c #393839",
".y c #393841",
"#s c #413841",
".o c #414041",
"#h c #4a4852",
".n c #5a505a",
"#r c #5a5962",
".I c #5ace5a",
"#b c #6a616a",
".p c #6a696a",
".x c #6a6973",
".Y c #6aff62",
".l c #736973",
".t c #7b717b",
".s c #7b7183",
".0 c #7bff7b",
".r c #837983",
".u c #83798b",
"#g c #83858b",
".v c #8b7994",
"#i c #8b858b",
".w c #8b8594",
"#j c #8b8d8b",
".8 c #8b8d94",
".m c #948d94",
"#k c #948d9c",
"#f c #949594",
".q c #94959c",
".J c #94c694",
"#d c #9c959c",
"#a c #9c95a4",
".k c #9c9d9c",
".N c #9c9da4",
".H c #9ccea4",
".K c #a49da4",
"#. c #a49dac",
".i c #a4a5a4",
".3 c #a4a5ac",
"## c #ac9dac",
".V c #aca5ac",
".d c #acaeac",
".j c #acaeb4",
".9 c #b4aeb4",
".# c #b4b6b4",
".a c #bdbebd",
".7 c #bdd6bd",
".c c #c5c6c5",
".5 c #cdc6cd",
".b c #cdcecd",
".4 c #cdced5",
".F c #d5ced5",
".G c #d5cede",
".h c #d5d6d5",
".E c #d5d6de",
".Q c #d5ffd5",
".B c #ded6de",
".1 c #ded6e6",
".g c #dedede",
".D c #dedee6",
".6 c #e6dee6",
".f c #e6e6e6",
".C c #e6e6ee",
".X c #e6ffe6",
".O c #eee6ee",
".e c #eeeeee",
".W c #f6f6f6",
".P c #ffffff",
"TQtTQtTQtTQtTQtTQt.#.a.b.b.b.b.c.c.a.a.d.aTQtTQtTQtTQt",
"TQtTQtTQtTQtTQtTQt.a.e.f.f.f.f.f.e.e.e.g.aTQtTQtTQtTQt",
"TQtTQtTQtTQtTQtTQt.a.c.c.c.b.b.c.c.c.c.a.cTQtTQtTQtTQt",
"TQtTQtTQtTQtTQtTQt.#.a.a.a.a.#.a.a.#.#.d.aTQtTQtTQtTQt",
"TQtTQtTQtTQtTQt.c.d.c.a.c.c.c.a.a.a.c.#TQtTQtTQtTQtTQt",
"TQtTQtTQtTQtTQt.a.a.#.a.a.a.a.a.a.c.c.#TQtTQtTQtTQtTQt",
"TQtTQtTQtTQtTQt.a.#.c.a.a.a.a.a.c.a.c.dTQtTQtTQtTQtTQt",
"TQtTQtTQtTQtTQt.c.a.a.a.a.a.a.a.a.a.a.#TQtTQtTQtTQtTQt",
"TQtTQtTQtTQtTQt.d.b.f.g.g.g.g.g.g.h.g.i.i.jTQtTQtTQt",
"TQtTQtTQt.a.k.l.#.h.b.h.b.h.b.h.g.g.m.n.o.p.#TQt",
"TQtTQt.a.q.r.s.t.t.t.t.t.t.t.u.v.w.x.y.z.A.o.i",
"TQt.a.k.B.C.D.B.E.E.E.E.F.G.H.I.J.K.o.L.L.M.y",
".a.N.O.P.P.P.P.P.P.P.P.P.Q.R.S.R.b.v.T.A.U.L",
".V.W.P.P.P.P.P.P.P.P.P.P.X.Y.Z.0.P.1.t.A.2.L",
".3.E.4.5.4.h.E.E.g.6.D.B.D.E.7.F.4.5.8.M.2.A",
".m.9.j.V.3#..3.K#.#..i#..K#.###a.q.8#b#c.2.L",
".m.j.j#..3.K.K.K.N.K.N.N.N.N#a#d#d.w#b#c.2#e",
"#f#.#..K.N.K.N.N.N#a.k#a#d#d#d#a.m#g#b.M.2#h",
".m.3.K.K#a.k#a#d#a.k#a#d#a#d.q.m.8#i.x#c#e.d",
"#f#g#i.w#j.w#i.8.w#i.8.8.m.8.m#k.8.w#b#e#fTQt",
".#.l.z.A#l.z#m#m#m#n#o#o#p#p#q#q#p#o#p#fTQtTQt",
"TQtTQt.d#r#s#s#t#p.T.T.T#u#u.z#e#e#v.o.kTQtTQtTQt"];


sub NEW
{
    shift->SUPER::NEW(@_);

    my $image0 = TQt::Pixmap($image0_data);
    my $image1 = TQt::Pixmap($image1_data);
    my $image2 = TQt::Pixmap($image2_data);
    my $image3 = TQt::Pixmap($image3_data);
    my $box = VBox(this);
    sessionLog = TextEdit($box, "sessionLog");
    sessionLog->setTextFormat(TQt::RichText());
    sessionLog->setReadOnly(1);
    comboBox = ComboBox($box, "comboBox");
    comboBox->setEditable(1);
    comboBox->setAutoCompletion(1);
    this->setCentralWidget($box);
    comboBox->setFocus;
    this->resize(500,300);
    setCaption("PerlTQt Shell");
#   fileNewAction= TQt::Action(this, "fileNewAction");
#   fileNewAction->setIconSet(TQt::IconSet($image0));
#   fileNewAction->setText(trUtf8("New"));
#   fileNewAction->setMenuText(trUtf8("&New"));
#   fileNewAction->setAccel(KeySequence(trUtf8("Ctrl+N")));
    fileOpenAction= TQt::Action(this, "fileOpenAction");
    fileOpenAction->setIconSet(TQt::IconSet($image1));
    fileOpenAction->setText(trUtf8("Open"));
    fileOpenAction->setMenuText(trUtf8("&Open..."));
    fileOpenAction->setAccel(KeySequence(trUtf8("Ctrl+O")));
    fileSaveAction= TQt::Action(this, "fileSaveAction");
    fileSaveAction->setIconSet(TQt::IconSet($image2));
    fileSaveAction->setText(trUtf8("Save"));
    fileSaveAction->setMenuText(trUtf8("&Save"));
    fileSaveAction->setAccel(KeySequence(trUtf8("Ctrl+S")));
    fileSaveAsAction= TQt::Action(this, "fileSaveAsAction");
    fileSaveAsAction->setText(trUtf8("Save As"));
    fileSaveAsAction->setMenuText(trUtf8("Save &As..."));
    fileSaveAsAction->setAccel(KeySequence(trUtf8("Ctrl+A")));
    filePrintAction= TQt::Action(this, "filePrintAction");
    filePrintAction->setIconSet(TQt::IconSet($image3));
    filePrintAction->setText(trUtf8("Print"));
    filePrintAction->setMenuText(trUtf8("&Print..."));
    filePrintAction->setAccel(KeySequence(trUtf8("Ctrl+P")));
    fileExitAction= TQt::Action(this, "fileExitAction");
    fileExitAction->setText(trUtf8("Exit"));
    fileExitAction->setMenuText(trUtf8("E&xit"));
    fileExitAction->setAccel(KeySequence(trUtf8("Ctrl+E")));

    helpExampleAction= TQt::Action(this, "helpExampleAction");
    helpExampleAction->setText(trUtf8("Example"));
    helpExampleAction->setMenuText(trUtf8("Examp&le"));
    helpExampleAction->setAccel(KeySequence(trUtf8("Ctrl+L")));

    toolBar = TQt::ToolBar("", this, DockTop());

    toolBar->setLabel(trUtf8("Tools"));
    fileOpenAction->addTo(toolBar);
    fileSaveAction->addTo(toolBar);
    filePrintAction->addTo(toolBar);


    menubar= TQt::MenuBar( this, "menubar");

    fileMenu= TQt::PopupMenu(this);
#   fileNewAction->addTo(fileMenu);
    fileOpenAction->addTo(fileMenu);
    fileSaveAction->addTo(fileMenu);
    fileSaveAsAction->addTo(fileMenu);
    fileMenu->insertSeparator;
    filePrintAction->addTo(fileMenu);
    fileMenu->insertSeparator;
    fileExitAction->addTo(fileMenu);
    menubar->insertItem(trUtf8("&File"), fileMenu);

    menubar->insertSeparator;

    helpMenu= TQt::PopupMenu(this);
    helpExampleAction->addTo(helpMenu);
    menubar->insertItem(trUtf8("&Help"), helpMenu);

#   TQt::Object::connect(fileNewAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileNew()");
    TQt::Object::connect(fileOpenAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileOpen()");
    TQt::Object::connect(fileSaveAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSave()");
    TQt::Object::connect(fileSaveAsAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSaveAs()");
    TQt::Object::connect(filePrintAction, TQT_SIGNAL "activated()", this, TQT_SLOT "filePrint()");
    TQt::Object::connect(fileExitAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileExit()");
    TQt::Object::connect(helpExampleAction, TQT_SIGNAL "activated()", this, TQT_SLOT "helpExample()");


    executedLines = [];
}

#sub fileNew
#{
#    print "Form1->fileNew(): Not implemented yet.\n";
#}

sub fileOpen
{
    my $fn = TQt::FileDialog::getOpenFileName(
                    ".",
                    "Pqtsh Session (*.pqts)",
                    this,
                    "open session",
                    "Choose a file to open" );
    $fn or return;
    emit fileNeedsEval($fn);

}

sub getFileName
{
    fileName = TQt::FileDialog::getSaveFileName(
               ".",
               "Pqtsh Session (*.pqts)",
               this,
               "save session",
               "Choose a filename" );
    fileName !~ /\.pqts$/ and fileName = fileName . ".pqts";
    return fileName;
}


sub save
{
    my $fn = shift;
    open( OUT, ">$fn") or do {
        TQt::MessageBox::critical( 
                     this, 
                     "Error" , 
                     "Couldn't open $fn for writing: $!", 
                     &TQt::MessageBox::Ok, 
                     &TQt::MessageBox::NoButton );
        return
    };
    for (@{ &executedLines })
    {
        next if /^\s*$/;
        chomp;
        $_ .= ";" unless /;\s*$/;
        print OUT $_, "\n"
    }
    close OUT
}

sub fileSave
{
    emptySession() and return;     
    my $fn = fileName || getFileName();
    $fn or return;
    save($fn)
}

sub fileSaveAs
{
    emptySession() and return; 
    my $fn;
    my ($cond, $doit);
    AGAIN:
    {
        $fn  = getFileName();
        $fn or return;
        if( -e $fn )
        {
            $cond++;
            $doit = TQt::MessageBox::warning(
                        this,
                        "Warning" ,
                        "File exists, overwrite ?",
                        &TQt::MessageBox::Yes,
                        &TQt::MessageBox::No );
        }
        else
        {  $cond = 0  }
    }
    goto AGAIN if $cond and $doit == &TQt::MessageBox::No;
    save($fn)       
}

sub filePrint
{
    my $Margin = 10;
    my $pageNo = 1;
    emptySession() and return; 
    printer = TQt::Printer unless printer;
    if ( printer->setup(this) ) {  
        statusBar()->message( "Printing..." );
        my $p = TQt::Painter;
        if( !$p->begin( printer ) )  
        { 
            statusBar()->message( "An error occured..." );
            return               
        }

        $p->setFont( sessionLog->font() );
        my $yPos = 0; 
        my $fm = $p->fontMetrics;
        my $metrics = TQt::PaintDeviceMetrics( printer );
  
        for( my $i = 0 ; $i < @{ &executedLines } ; $i++ ) {
            if ( $Margin + $yPos > $metrics->height() - $Margin ) {
                my $msg ="Printing (page ". ++$pageNo . ")...";
                statusBar()->message( $msg );
                printer->newPage();             
                $yPos = 0;                      
            }
            $p->drawText( $Margin, $Margin + $yPos,
                        $metrics->width(), $fm->lineSpacing(),
                        &ExpandTabs | &DontClip,
                        ${ &executedLines }[ $i ] );
            $yPos = $yPos + $fm->lineSpacing();
        }
        $p->end();       
        statusBar()->message( "Printing completed", 3000 );
    } else {
        statusBar()->message( "Printing aborted", 3000 );
    }  
}

sub fileExit
{
    emit TQt::app()->quit() if confirmExit();
}

sub closeEvent
{
   my $e = shift;
   if(confirmExit())
   {
       $e->accept
   }
   else
   {
       $e->ignore
   }
}

sub confirmExit
{
    my $doit;
    if(@{ &executedLines })
    {
        $doit = TQt::MessageBox::warning(
                    this,
                    "Warning" ,
                    "A session is opened, quit anyway ?",
                     &TQt::MessageBox::Yes,
                     &TQt::MessageBox::No );
    }
    else
    {  return 1  }
 
    return (($doit == &TQt::MessageBox::No) ? 0 : 1);
}

sub emptySession
{
    unless (@{ &executedLines })
    {
        statusBar()->message("Session is empty...", 3000);
        return 1;
    }
    0
}

sub helpExample
{
    emit fileNeedsEval("__DATA__")
}

1;

package TQtShell;

use TQt;
use TQt::isa qw(TQt::MainWindow);
use TQt::slots
    evalInput=>[],
    evalFile=>[TQString];
use TQt::attributes qw(
    shellWindow
);
use TQtShellControl;   

sub NEW
{
    shift->SUPER::NEW(@_);

    shellWindow = TQtShellControl(undef, "shellWindow");
    this->resize(350,350);
    this->move(Point(10,10));
    shellWindow->move(Point(300,200));
    this->show;
    shellWindow->show;


    this->connect(shellWindow->comboBox->lineEdit, TQT_SIGNAL 'returnPressed()', TQT_SLOT 'evalInput()');
    this->{'prompt'} = '<b><font color="blue">$&gt;</font></b>';
    setCaption("MainWindow - this");
    shellWindow->sessionLog->setText("Ready.<br>");
    TQt::Object::connect(shellWindow, TQT_SIGNAL 'fileNeedsEval(TQString)', this, TQT_SLOT 'evalFile(TQString)');
}

sub logAppend
{
    shellWindow->sessionLog->setText( shellWindow->sessionLog->text . shift )
}

sub evalInput
{
    evalOneLine( shellWindow->comboBox->currentText );
}

sub evalOneLine
{
    my $prot = my $ln = shift;
    $prot =~ s/</&lt;/gs;
    $prot =~ s/>/&gt;/gs;    
    logAppend( this->{'prompt'}. "$prot<br>" );
    {
      no strict;
      eval $ln;
    }
    if($@)
    {
        my $prot = $@ ;
        $prot =~ s/</&lt;/gs;
        $prot =~ s/>/&gt;/gs;    
        my $c = shellWindow->sessionLog->color;
        $prot =~ s/\n/<br>/gs;
        logAppend('<font color="red">'.$prot.'</font><br>');
        shellWindow->sessionLog->setColor( $c );
    }
    else
    {        
        push @{ shellWindow()->{'executedLines'} }, $ln;
        shellWindow->comboBox->clearEdit;
        shellWindow->comboBox->setFocus;
    }   
    shellWindow->sessionLog->scrollToBottom
}

sub evalFile
{
    my $fn = shift;
    my $fh;
    if($fn eq "__DATA__")
    {
        $fh = \*::DATA
    }
    else
    {
        open($fh, $fn) or do {
            TQt::MessageBox::warning ( 
                this, 
                "Error" , 
                "Couldn't open $fn: $!", 
                &TQt::MessageBox::Ok, 
                &TQt::MessageBox::NoButton );
            return
        };
    }
    while(<$fh>)
    {
        evalOneLine($_)    
    }
    close $fh
}

1;

package TQt::TextHandle;

sub TIEHANDLE { my ( $classnm, $widg, $color) = @_;
  my $h = { widg => $widg, color => $color};
  bless  $h, $classnm;

}

sub PRINT {
  my $me = shift;
  my $color = $me->{color};
  my $printed = join $/,  @_;
  $printed =~ s/</&lt;/gs;
  $printed =~ s/>/&gt;/gs;
  $printed =~ s/\n/<br>/gs;
  $me->{widg}->setText( $me->{widg}->text . "<font color=\"$color\">$printed</font>" );

}

sub PRINTF { shift->PRINT(sprintf shift, @_); }
sub CLOSE  { shift->UNTIE; }
sub UNTIE  { }


1;

package main;
use strict;
use TQt;
use TQtShell;
use TQt::debug;

my $app = TQt::Application(\@ARGV);
my $w = TQtShell(undef, "mainWindow");
my $shw = $w->shellWindow;
$app->setMainWidget($shw);
tie *STDOUT, 'TQt::TextHandle', $shw->sessionLog, 'black';
tie *STDERR, 'TQt::TextHandle', $shw->sessionLog, 'red';

exit $app->exec;

__DATA__
statusBar()->message("Hello World !");
use TQt::attributes qw|datetime button textedit sample vbox| ;
vbox = VBox(this);
datetime = DateTimeEdit(vbox);
textedit = TQt::TextEdit(vbox);
button = PushButton("Hello World!", vbox) ;
this->setCentralWidget(vbox);
resize(220,240);
vbox->show;
sample = TQt::PopupMenu( this );
use TQt::slots 'there' => [];
sample->insertItem("&There", this, TQT_SLOT 'there()');
menuBar()->insertItem("&Here", sample);
sub there { statusBar()->message("There...", 2000) };