#! perl -slw use strict; use threads; our $GUI //= 0; if( $GUI ) { require 'MyGui.pm'; async( \&MyGui::gui )->detach; } while( 1 ) { my $in = ; exit if $in =~ '!bye'; print $in; } __END__ C:\test>MyGui-t hello hello goodbye goodbye !bye #### package MyGuiStdin; our @ISA = qw[ Thread::Queue ]; sub TIEHANDLE { bless $_[1], $_[0]; } sub READLINE { $_[0]->dequeue(); } package MyGuiStdout; our @ISA = qw[ Thread::Queue ]; sub TIEHANDLE { bless $_[1], $_[0]; } sub PRINT { $_[0]->enqueue( $_[1] ); } package MyGui; use strict; use warnings; use threads; use Thread::Queue; my $Qin = new Thread::Queue; my $Qout = new Thread::Queue; tie *STDIN, 'MyGuiStdin', $Qin; tie *STDOUT, 'MyGuiStdout', $Qout; sub gui { require Tk; my $mw = Tk::MainWindow->new; my $lb = $mw->Listbox( -width => 80, -height => 24 )->pack; my $ef = $mw->Entry( -width => 70, -takefocus => 1 )->pack( -side => 'left' ); my $enter = sub { $Qin->enqueue( $ef->get ); $ef->delete(0, 'end' ); 1; }; my $do = $mw->Button( -text => 'go', -command => $enter)->pack( -after => $ef ); $mw->repeat( 100, sub { $lb->insert( 'end', $Qout->dequeue ) while $Qout->pending; $lb->see( 'end' ); } ); $mw->bind( '', $enter ); $ef->focus( -force ); Tk::MainLoop(); } 1;