%%% BEGIN pibfi_io.erl %%%
%%%
%%% pibfi - Platonic Ideal Brainf*ck Interpreter
%%% Copyright (c)2003 Cat's Eye Technologies.  All rights reserved.
%%%
%%% Redistribution and use in source and binary forms, with or without
%%% modification, are permitted provided that the following conditions
%%% are met:
%%%
%%%   Redistributions of source code must retain the above copyright
%%%   notice, this list of conditions and the following disclaimer.
%%%
%%%   Redistributions in binary form must reproduce the above copyright
%%%   notice, this list of conditions and the following disclaimer in
%%%   the documentation and/or other materials provided with the
%%%   distribution.
%%%
%%%   Neither the name of Cat's Eye Technologies nor the names of its
%%%   contributors may be used to endorse or promote products derived
%%%   from this software without specific prior written permission.
%%%
%%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
%%% CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
%%% INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
%%% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
%%% DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
%%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
%%% OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
%%% PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
%%% OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
%%% ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
%%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
%%% OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
%%% POSSIBILITY OF SUCH DAMAGE. 

%% @doc I/O subsystem of the Platonic Ideal Brainf*ck Interpreter.
%%
%% <p>Deals with the input and output servers, their filters, and
%% their translators.</p>
%%
%% @end

%          --->  input translator --->  input filter --->
% terminal                                                i/o    <-> Brainf*ck
%  or file                                                subsys     program
%          <--- output translator <--- output filter <---

-module(pibfi_io).
-vsn('2003.0427').
-copyright('Copyright (c)2003 Cat`s Eye Technologies. All rights reserved.').

-export([start/3, stop/1, server/1]).
-export([input/1, output/2, flush/1]).

-record(io,
{
  device  = standard_io,
  maxout  = infinity,
  minout  = 0,
  wrapout = false,
  maxin   = infinity,
  minin   = 0,
  wrapin  = false,
  outxlat = [],
  inxlat  = [],
  eof     = 0
}).

%% @spec start(Supervisor::pid(), [option()], CannedInput::string()) -> pid()
%% @doc Creates and spawns a new I/O subsystem.
%% For a description of the allowed options, see the documentation for
%% the <code><a href="pibfi_options.html">pibfi_options</a></code> module.

start(Supervisor, Options, CannedInput) ->
  IO = config(#io{}, Options),

  % start i/o server
  IoPid = pibfi_supervisor:spawn_link(Supervisor, "i/o subsystem",
    critical,  ?MODULE, server, [IO]),

  % start filters & translators
  InFilter = pibfi_filter:start(Supervisor, input, IoPid,
    IO#io.maxin, IO#io.minin, IO#io.wrapin),

  OutXlat = pibfi_xlat:start(IO#io.outxlat, IoPid),
  pibfi_supervisor:link(Supervisor, "output translator", OutXlat),

  InXlat = pibfi_xlat:start(IO#io.inxlat, InFilter),
  pibfi_supervisor:link(Supervisor, "input translator", InXlat),

  % start input server
  InFile = pibfi_options:get_option(Options, infile, tty),
  Interactive = InFile == tty,
  IoDevice = case InFile of
    tty ->
      standard_io; % IO#io.device;
    heredoc ->
      undefined;
    Filename ->
      {ok, I} = file:open(Filename, [read, read_ahead]),
      I
  end,
  case IoDevice of
    undefined ->
      % don't start an input server, do send canned input
      lists:foreach(fun(Char) ->
        % ce_log:write("sending canned ~c", [Char]),
        pibfi_xlat:send(InXlat, Char)
      end, CannedInput),
      pibfi_xlat:notify(InXlat, IO#io.eof);
    _ ->
      InputPid = pibfi_input:start(Supervisor, IoPid, InXlat, Interactive,
        IoDevice, IO#io.eof)
  end,
  % notify I/O server of who to talk to
  IoPid ! {self(), hello, {OutXlat, InFilter}},
  IoPid.

%% @spec server(IO) -> never_returns()
%% @doc Spawned by <code>start/1</code>.
%% Should not be called directly by user code.

server(IO) ->
  receive  
    {Spawner, hello, {OutXlat, InFrom}} ->
      loop(IO, OutXlat, InFrom)
  end.

loop(IO, OutXlat, InFrom) ->
  #io{
       device  = Device,
       maxout  = MaxOut,
       minout  = MinOut,
       wrapout = WrapOut,
       maxin   = MaxIn,
       minin   = MinIn,
       wrapin  = WrapIn,
       eof     = EOF
     } = IO,
  % ce_log:write("looping"),
  receive  
    {Pid, output, [Output]} ->
      % ce_log:write("handling output request"),
      pibfi_xlat:send(OutXlat, Output),
      loop(IO, OutXlat, InFrom);
    {OutXlat, xlat_char, Char} ->
      % ce_log:write("handling xlated output ~c", [Char]),
      write(Device, MaxOut, MinOut, WrapOut, Char),
      loop(IO, OutXlat, InFrom);
    {Pid, input, []} ->
      case EOF of
        % first check to see if we noticed the input server go down.
        {eof, Char} when is_integer(Char) ->
          Pid ! {self(), input, Char},
	  loop(IO, OutXlat, InFrom);
        _ ->
          input_loop(Pid, IO, OutXlat, InFrom)
      end;
    {Pid, flush} ->
      pibfi_xlat:flush(OutXlat),
      Result = flush_loop(IO, OutXlat, InFrom),
      Pid ! {self(), flush, Result},
      loop(IO, OutXlat, InFrom);
    {Pid, stop} ->
      % ce_log:write("stopping"),
      Pid ! {self(), stop, ok}
  end.

input_loop(Pid, IO, OutXlat, InFrom) ->
  #io{
       device  = Device,
       maxout  = MaxOut,
       minout  = MinOut,
       wrapout = WrapOut,
       maxin   = MaxIn,
       minin   = MinIn,
       wrapin  = WrapIn,
       eof     = EOF
     } = IO,
  receive
    % in case the translation system decides to output something
    % while we're waiting for input, we have to react to the
    % output translator's messages here, too.
    {OutXlat, xlat_char, Char} ->
      % ce_log:write("handling xlated output ~c", [Char]),
      write(Device, MaxOut, MinOut, WrapOut, Char),
      input_loop(Pid, IO, OutXlat, InFrom);
    
    % Receive messages from the input_server (possibly via the
    % input translator / filter.)
    {InFrom, xlat_char, Char} ->
      % ce_log:write("input xlatted ~p", [Char]),
      Pid ! {self(), input, Char},
      loop(IO, OutXlat, InFrom);
    {InFrom, _, message, X} ->
      % direct, non-xlated msg from input server
      % this means the input server has kicked the bucket
      % and that we must know that for future input requests
      % ce_log:write("direct input ~p", [X]),
      Pid ! {self(), input, X},
      IO0 = IO#io{ eof = {eof, IO#io.eof}},
      loop(IO0, OutXlat, InFrom)
  end.

flush_loop(IO, OutXlat, InXlat) ->
  #io{
       device  = Device,
       maxout  = MaxOut,
       minout  = MinOut,
       wrapout = WrapOut,
       maxin   = MaxIn,
       minin   = MinIn,
       wrapin  = WrapIn,
       eof     = EOF
     } = IO,
  receive
    {OutXlat, xlat_char, Char} ->
      % ce_log:write("flushing xlated output"),
      write(Device, MaxOut, MinOut, WrapOut, Char),
      flush_loop(IO, OutXlat, InXlat)
    after 200 ->
      ok
  end.

%% @spec write(iodevice(), Max::integer(), Min::integer(), Wrap::boolean(),
%%         char()) -> ok
%% @doc Writes a character to the output, within the given constraints.

write(Device, MaxOut, MinOut, false, Char) ->
  pibfi:assert_in_bounds(output_character, MinOut, Char, MaxOut),
  put_char(Device, Char);
write(Device, MaxOut, MinOut, true, Char) ->
  put_char(Device, pibfi:wrap(Char, MinOut, MaxOut)).

put_char(Device, Char) when Char >= 0, Char < 256 ->
  io:put_chars(Device, [Char]);
put_char(Device, Char) ->
  CharString = "&#" ++ integer_to_list(Char) ++ ";",
  io:put_chars(Device, CharString).

%% @spec config([option()], tape()) -> tape()
%% @doc Sets the various options of an I/O subsystem.

config(IO, []) ->
  IO;
config(IO, [Head | Tail]) ->
  config(config(IO, Head), Tail);

config(IO, {outfile, tty}) ->
  IO#io{ device = standard_io };
config(IO, {outfile, OutFile}) ->
  {ok, Device} = file:open(OutFile, [write, delayed_write]),
  IO#io{ device = Device };
config(IO, {infile, InFile}) ->
  IO;
config(IO, {device, Device})
 when is_pid(Device); Device == standard_io ->
  IO#io{ device = Device };
config(IO, {eof, EOF})
 when is_integer(EOF); EOF == halt; EOF == nop; EOF == stop ->
  IO#io{ eof = EOF };
config(IO, {maxout, MaxOut})
 when is_integer(MaxOut); MaxOut == infinity ->
  IO#io{ maxout = MaxOut };
config(IO, {minout, MinOut})
 when is_integer(MinOut); MinOut == infinity ->
  IO#io{ minout = MinOut };
config(IO, {wrapout, WrapOut})
 when WrapOut == true; WrapOut == false ->
  IO#io{ wrapout = WrapOut };
config(IO, {maxin, MaxIn})
 when is_integer(MaxIn); MaxIn == infinity ->
  IO#io{ maxin = MaxIn };
config(IO, {minin, MinIn})
 when is_integer(MinIn); MinIn == infinity ->
  IO#io{ minin = MinIn };
config(IO, {wrapin, WrapIn})
 when WrapIn == true; WrapIn == false ->
  IO#io{ wrapin = WrapIn };
config(IO, {xlatin, InXlat}) when is_list(InXlat) ->
  IO#io{ inxlat = InXlat };
config(IO, {xlatout, OutXlat}) when is_list(OutXlat) ->
  IO#io{ outxlat = OutXlat }.

%%% interface

%% @spec output(pid(), integer()) -> ok
%% @doc Sends the given character value to the output stream.

output(IoPid, Output) ->
  % ce_log:write("~p", [Output]),
  IoPid ! {self(), output, [Output]},
  ok.

%% @spec input(pid()) -> integer() | nop
%% @doc Retrieves the next character value from the input stream.

input(IoPid) ->
  % ce_log:write("input"),
  IoPid ! {self(), input, []},
  Result = receive
    {IoPid, input, nop} ->
      nop;
    {IoPid, input, stop} ->
      stop;
    {IoPid, input, Input} when is_integer(Input) ->
      Input
  end,
  % ce_log:write("input ~p", [Result]),
  Result.

%% @spec flush(pid()) -> ok
%% @doc Flushes any pending output, even if it has not been translated yet.

flush(IoPid) ->
  IoPid ! {self(), flush},
  receive
    {IoPid, flush, ok} ->
      ok
  end.

%% @spec stop(pid()) -> ok
%% @doc Tells the I/O server to stop.

stop(IoPid) ->
  IoPid ! {self(), stop},
  receive
    {IoPid, stop, ok} ->
      ok
  end.

%%% END of pibfi_io.erl %%%