Mercurial > repo
diff interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Interface/None.pm @ 996:859f9b4339e6
<Gregor> tar xf egobot.tar.xz
author | HackBot |
---|---|
date | Sun, 09 Dec 2012 19:30:08 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Interface/None.pm Sun Dec 09 19:30:08 2012 +0000 @@ -0,0 +1,87 @@ +package Language::INTERCAL::Interface::None; + +# pseudo user interface which never enters interactive mode + +# This file is part of CLC-INTERCAL + +# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved. + +# CLC-INTERCAL is copyrighted software. However, permission to use, modify, +# and distribute it is granted provided that the conditions set out in the +# licence agreement are met. See files README and COPYING in the distribution. + +use strict; +use vars qw($VERSION $PERVERSION); +($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/Interface/None.pm 1.-94.-2") =~ /\s(\S+)$/; + +use Carp; +use Language::INTERCAL::Exporter '1.-94.-2'; +use Language::INTERCAL::GenericIO '1.-94.-2', qw($stdread $stdwrite); + +sub new { + @_ == 2 or croak "Usage: Language::INTERCAL::Interface::None->new(SERVER)"; + my ($class, $server) = @_; + my $none = bless { + server => $server, + line => '', + end => 0, + }, $class; + $| = 1; + if ($server) { + STDIN->blocking(0); + $server->file_listen(fileno(STDIN), + sub { + my $l; + if (sysread STDIN, $l, 1024) { + $none->{line} .= $l; + } else { + $none->{end} = 1; + $server->file_listen_close(fileno(STDIN)); + } + }); + } + $none; +} + +sub has_window { 0 } +sub is_interactive { 0 } + +sub is_terminal { + $stdwrite->is_terminal; +} + +sub run { + croak "Non interactive interface should never enter run()"; +} + +sub start { + croak "Non interactive interface should never enter start()"; +} + +sub stdread { + $stdread; +} + +sub getline { + @_ == 2 or croak "Usage: NONE->getline(PROMPT)"; + my ($none, $prompt) = @_; + $stdread->read_text($prompt); + my $timeout = 0; + while (1) { + $none->{server}->progress($timeout); + $timeout = undef; + $none->{line} =~ s/^(.*?\n)// and return $1; + $none->{end} or next; + my $l = $none->{line}; + $none->{line} = undef; + return $l; + } +} + +sub complete { + @_ == 1 || @_ == 2 or croak "Usage: NONE->complete [(CALLBACK)]"; + my ($none, $code) = @_; + $none; +} + +1;