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;