program sircs2;

{
************************************************************

SIRCS - Serial Infrared Remote Control System (Ver. 2)


Heiko Purnhagen   27-nov-95, 30-jun-96
e-mail: purnhage@tnt.uni-hannover.de
WWW:    http://www.fet.uni-hannover.de/purnhage/


This program may be copied according to the GNU General Public Licence.


About this program
------------------

This program is written in Turbo Pascal 6.0 and requires a reasonable
fast PC (486SX 25 MHz or even 386DX 6 MHz is sufficient). Since
direct access to the PC hardware is employed, this program must be started
directly from DOS (and not from a DOS-Window within MS-Windows).

In order to be able to receive and transmit (infrared) remote control
signals, you have to connect an appropriate interface to the serial
port of your PC. This interface either containes an infrared LED and/or
photodiode to transmit and/or receive the infrared remote control signal
or it is connected directly to the device to be controlled.

A typical infrared transmitter generates a 40 kHz carrier which is
switched on and off according to the serial remote control signal
and then transmitted by the LED.

A typical infrared receiver contains a circuit that detects whether
or not the photodiode is receiving a 40 kHz carrier.

A typical direct interface has to convert (or just limit) the
logical levels of the serial remote control signal to those required
by the device to be controlled.

The different signals of the serial interface connector are used in
a slightly odd way here:

SG       ground
CTS      signal from receiver
RTS      signal to transmitter/device
TD, DTR  positive voltage providing some power for interface circuits


Serial Interface Connector
--------------------------

D25  D9  in/out  signal

  1   -     -    FG   Frame Ground
  2   3     O    TD   Transmit Data
  3   2     I    RD   Receive Data
  4   7     O    RTS  Request to Send
  5   8     I    CTS  Clear to Send
  6   6     I    DSR  Data Set Ready
  7   5     -    SG   Signal Ground
  8   1     I    DCD  Data Carrier Detected
 20   4     O    DTR  Data Terminal Ready
 22   9     I    RI   Ring Indicator

 +3V..+12V = active   = space = 0
 -3V..-12V = inactive = mark  = 1


A simple interface for Sony DAT TCD-D7
--------------------------------------

Note: The D7 requires a low-active serial remote control signal !!!

PC serial (D9)                        D7 connector
                 10kOhm    10kOhm
RTS (pin 7)   o---RRR---+---RRR---o   sircs (pin 7)      1 2 3 4
                        |                              +---------+
                        K z-diode                      | o o o o |
                        A ZPD 4.3V                     | o o o  /
                        |                              +--------
SG  (pin 5)   o---------+---------o   ground (pin 6)     5 6 7

For further information about the D7 connector, have a look at
http://www.fet.uni-hannover.de/purnhage/dat/d7connector.html


Sony serial remote control signal format
----------------------------------------

A message contains 12 bits and is transmitted every 45 ms (22.2 times
per second) as long as the key on the remote control is held down. A
message is transmitted at least 3 times.

The signal for the message "pause" for a Sony DAT recorder is

......XXXX.XX.X.X.XX.XX.XX.X.X.X.XX.XX.XX......

where X means an active signal (40kHz carrier transmitted by infrared
remote control) and . means no signal. Each X or . has a duration
of 0.6 ms. The message consists of a start pulse (2.4 ms) which is
followed by 12 data pulses (0.6 ms or 1.2 ms). Each pulse is followed
by a 0.6 ms pause. A 0.6 ms data pulse means a "0", a 1.2 ms pulse a "1".

This program can store such messages in a file, one message per line.
The DAT "pause" message shown above can be stored as

100111000111:pause


************************************************************
}



{ declarations }

uses
  crt, graph;

const
             { 16550 registers }
  rbr = 0;   { receiver buffer (read) }
  thr = 0;   { transmitter hold (write) }
  ier = 1;   { interrupt enable }
  iir = 2;   { interrupt identification (read) }
  fcr = 2;   { fifo control (write) }
  lcr = 3;   { line control }
  mcr = 4;   { modem control }
  lsr = 5;   { line status }
  msr = 6;   { modem status }
  scr = 7;   { scratch }
  dll = 0;   { divisor latch (lsb) }
  dlm = 1;   { divisor latch (msb) }

  clkfreq = 1.19318e6;   { pit 8253 cntr 0 clock freq. }
  msgsize = 201;

type
  wordptr = ^word;
  msgt = array[1..msgsize] of word;   { basic message, 0 = msg end }
  smsgt = array[1..12] of byte;   { sony message }

var
  base, mcrbuf : word;
  invrx, invtx : byte;
  clkbufl, clkbufh : word;
  c : char;
  b : boolean;
  readkeylast : char;


{ serial interface }

function initio (com : integer) : boolean;
{ ok -> true }
begin
  initio := false;
  if (com < 1) or (com > 4) then
    exit;
  base := wordptr(ptr($0040,2*(com-1)))^;
  if base = 0 then
    exit;
  initio := true;
  mcrbuf := (port[base+mcr] or $01) and $fd;   { set DTR, reset RTS }
  port[base+mcr] := mcrbuf;
  port[base+lcr] := port[base+lcr] or $40;   { set TX }
  invrx := 0;
  invtx := 0;
end;

procedure restoreio;
begin
  if base = 0 then
    exit;
  port[base+mcr] := mcrbuf and $fc;   { reset DTR, RTS }
  port[base+lcr] := port[base+lcr] and $bf;   { reset TX }
end;

function getrx : byte;
begin
  getrx := ((port[base+msr] and $10) shr 4) xor invrx;
end;

procedure puttx (b : byte);
begin
  port[base+mcr] := mcrbuf or (((b xor invtx) and 1) shl 1);
end;


{ timer (pit 8253 cntr 0 clk 1.19318 MHz) }

procedure initclk;
begin
  port[$0043] := $34;   { cntr 0: mode 2 16bit }
  port[$0040] := $00;
  port[$0040] := $00;
end;

procedure resetclk;
begin
  clkbufl := 0;
  clkbufh := 0;
end;

function getclk : longint;
  var
    t : word;
begin
  port[$0043] := $00;   { cntr 0: latch }
  t := port[$0040];
  t := not(t+(port[$0040] shl 8));
  if t < clkbufl then
    inc(clkbufh);
  clkbufl := t;
  getclk := clkbufl+(longint(clkbufh) shl 16);
end;


{ basic message i/o }

function getmsg (var msg : msgt; minbit, maxbit : word; timeout : longint;
                 keybreak : boolean) : longint;
{ error -> -1   timeout -> 0   ok -> time before start bit }
  var
    t,t0,tt,tb,tw : longint;
    b,b0 : byte;
    idx : byte;
begin
  getmsg := -1;
  idx := 1;
  msg[idx] := 0;
  resetclk;
  t := getclk;
  b := getrx;
  tt := t+timeout;
  repeat
    t0 := t;
    tb := t0+maxbit;
    while b > 0 do
    begin
      t := getclk;
      b := getrx;
      if t > tb then
        exit;
    end;
    t0 := t;
    while b = 0 do
    begin
      t := getclk;
      b := getrx;
      if t > tt then
      begin
        getmsg := 0;
        exit;
      end;
      if keybreak and keypressed then
        exit;
    end;
  until t > t0+maxbit;
  tw := t-t0;
  repeat
    t0 := t;
    tb := t0+maxbit;
    while b > 0 do
    begin
      t := getclk;
      b := getrx;
      if t > tb then
        exit;
    end;
    if t-t0 < minbit then
      exit;
    msg[idx] := t-t0;
    inc(idx);
    msg[idx] := 0;
    t0 := t;
    tb := t0+maxbit;
    while (b = 0) and (t <= tb) do
    begin
      t := getclk;
      b := getrx;
      if t > tt then
        exit;
    end;
    if t-t0 < minbit then
      exit;
    if t > tb then
    begin
      getmsg := tw;
      exit;
    end;
    msg[idx] := t-t0;
    inc(idx);
    msg[idx] := 0;
  until idx = msgsize;
end;

procedure putmsg (msg : msgt; wait : longint);
  var
    t,t0 : longint;
    idx : integer;
begin
  idx := 1;
  resetclk;
  t := getclk;
  t0 := t;
  while msg[idx] > 0 do
  begin
    puttx (idx and 1);
{    puttx (1-(idx and 1)); } { inverted }
    t0 := t0+msg[idx];
    repeat
      t := getclk
    until t > t0;
    inc(idx);
  end;
  puttx(0);
{  puttx(1); } { inverted }
  t0 := t0+wait;
  repeat
    t := getclk
  until t > t0;
end;


{ sony message codec }

function decsmsg (msg : msgt; var smsg : smsgt; var maxdev : real) : boolean;
{ ok -> true }
  const
    dt = 0.0006;
  var
    i : integer;

  procedure checkdev (dev : real);
  begin
    if dev < 0 then
      dev := -dev;
    if maxdev < dev then
      maxdev := dev;
  end;

begin
  maxdev := 0;
  i := 1;
  while msg[i] > 0 do
    inc(i);
  decsmsg := false;
  if i <> 26 then
    exit;
  decsmsg := true;
  checkdev (msg[1]/clkfreq-4*dt);
  for i := 1 to 12 do
  begin
    checkdev (msg[2*i]/clkfreq-dt);
    smsg[i] := 0;
    if msg[2*i+1]/clkfreq > 1.5*dt then
      smsg[i] := 1;
    checkdev (msg[2*i+1]/clkfreq-(1+smsg[i])*dt);
  end;
  maxdev := maxdev/dt;
  if maxdev > 0.4 then
    decsmsg := false;
end;

procedure encsmsg (smsg : smsgt; var msg : msgt; var wait : longint);
  const
    dt = 0.0006;
  var
    i : integer;
begin
  wait := round(0.045*clkfreq);
  msg[1] := round(4*dt*clkfreq);
  wait := wait - msg[1];
  for i := 1 to 12 do
  begin
    msg[2*i] := round(dt*clkfreq);
    msg[2*i+1] := round((1+smsg[i])*dt*clkfreq);
    wait := wait - msg[2*i];
    wait := wait - msg[2*i+1];
  end;
  msg[26] := 0;
end;


{ readkey for autorepeat }

function readkeyrepeat : char;
  var
    c : char;
begin
  if not keypressed then
    c := readkey
  else
    repeat
      c := readkey;
    until (not keypressed) or (c <> readkeylast);
  readkeylast := c;
  readkeyrepeat := c;
end;


{ basic test functions }

procedure testtext;
  var
    s : string;
begin
  s := '.1';
  repeat
    write(s[getrx+1]);
  until keypressed;
  writeln;
  write ('press <ret>');
  readln;
end;

procedure testgraph;
  var
    gd,gm : integer;
    x,y,xx,yy,cc : integer;
    s,ss : string;
begin
  gd := Detect;
  write ('bgi path (\tp6\bgi) ?');
  readln (s);
  if s = '' then
    s := '\tp6\bgi';
  write ('att400 (y/n) ? ');
  readln (ss);
  if ss = 'y' then
  begin
    gd := att400;
    gm := att400hi;
  end;
  InitGraph(gd,gm,s);
  if GraphResult <> grOk then
  begin
    writeln ('graph error');
    exit;
  end;
  xx := getmaxx;
  yy := getmaxy;
  cc := getmaxcolor;
  repeat
    for y := 0 to yy do
    begin
      for x := 0 to xx do
        putpixel (x,y,getrx*cc);
      if keypressed then
      begin
        closegraph;
        write ('press <ret>');
        readln;
        exit;
      end;
    end;
  until false;
end;

procedure testtime;
  var
    msg : array[1..10] of msgt;
    p : array[1..10] of longint;
    idx : integer;
    b,bb,i : integer;
    t,tt,maxt : longint;
    s : string;
begin
  writeln ('press any key to transmit last 5 messages');
  s := '\/';
  repeat
    for idx := 1 to 5 do
    begin
      p[idx] := getmsg(msg[idx],round(clkfreq*0.0001),round(clkfreq*0.020),
                       round(clkfreq*1.000),true);
      if p[idx] = -1 then
        writeln ('error')
      else if p[idx] = 0 then
        writeln ('timeout')
      else
      begin
        i := 1;
        while msg[idx][i] > 0 do
        begin
          write (s[1+(i and 1)],msg[idx][i]/clkfreq*1000:7:2);
          inc(i);
        end;
        if i > 1 then
          writeln;
        writeln (i div 2,' bits   ',0.020+p[idx]/clkfreq:9:6,' s pause');
      end;
    end;
  until keypressed;
  writeln ('press <ret> to start transmitting');
  readln;
  writeln ('press any key to quit');
  repeat
    for idx := 1 to 5 do
    begin
      if p[idx] > 0 then
      begin
        write (idx);
        putmsg (msg[idx],p[idx]);
      end;
    end;
  until keypressed;
  writeln;
  writeln ('press <ret>');
  readln;
end;


{ save basic message to file }

procedure timetofile;
  const
    maxmsg = 20;
  var
    msg : array[1..maxmsg] of msgt;
    p : array[1..maxmsg] of longint;
    i,n,idx,nn : integer;
    fn : string;
    f : text;
    s,ss : string;
    c : char;
begin
  write ('filename ? ');
  readln (fn);
  {$i-}
  assign (f,fn);
  rewrite (f);
  {$i+}
  if ioresult <> 0 then
  begin
    writeln ('file error');
    exit;
  end;
  write ('device name ? ');
  readln (s);
  writeln (f,'.device');
  writeln (f,s);
  repeat
    repeat
      write ('key name (<ret> to quit) ? ');
      readln (s);
      ss := 'y';
      if s = '' then
      begin
        write ('quit (y/n) ? ');
        readln (ss);
      end;
    until ss = 'y';
    if s <> '' then
    begin
      writeln ('<spc> to view, <ret> to write&quit, w to write, others to restart');
      repeat
        write ('receiving... ');
        idx := 1;
        repeat
          repeat
            p[idx] := getmsg(msg[idx],round(clkfreq*0.0001),round(clkfreq*0.020),
                             round(clkfreq*1.000),true);
          until keypressed or (p[idx] > 0);
          if p[idx] > 0 then
          begin
            n := 1;
            while msg[idx][n] > 0 do
              inc(n);
            write (n div 2,'bit ');
            inc(idx);
          end;
        until keypressed or (idx = maxmsg+1);
        nn := idx-1;
        if not keypressed then
          write ('<key>');
        writeln;
        repeat
          c := readkey;
          if c = ' ' then
          begin
            ss := '\/';
            for idx := 1 to nn do
            begin
              write (0.020+(p[idx]/clkfreq):8:6,' pause   ');
              n := 1;
              while msg[idx][n] > 0 do
                inc(n);
              writeln (n div 2,' bits');
              for i := 1 to n do
                write (ss[1+(i and 1)],msg[idx][i]/clkfreq:7:5);
              writeln;
            end;
            writeln (nn,' messages');
            writeln ('<spc> to view, <ret> to write&quit, w to write, others to restart');
          end;
        until c <> ' ';
        if (c = #13) or (c = 'w') then
        begin
          writeln (f,'.button');
          writeln (f,s);
          for idx := 1 to nn do
          begin
            writeln (f,'.pause');
            writeln (f,0.020+(p[idx]/clkfreq):8:6);
            n := 1;
            while msg[idx][n] > 0 do
              inc(n);
            writeln (f,'.bits');
            writeln (f,n div 2);
            for i := 1 to n do
              writeln (f,msg[idx][i]/clkfreq:8:6);
          end;
          writeln (nn,' messages written');
        end;
      until c = #13;
    end;
  until s = '';
  close (f);
end;


{ sony message functions }

procedure testsony;
  var
    msg : msgt;
    p : longint;
    smsg : array[0..1] of smsgt;
    i,ii : integer;
    maxdev : real;
    b : boolean;
    c : char;
begin
  writeln ('format: message_bits (rel. timing deviation)');
  writeln ('        (d.ddd)=wrong timing   e=error   .=timeout');
  writeln ('transmit last message: <spc>=3*tx 1=1*tx .. 9=9*tx');
  writeln ('q=quit');
  for i := 1 to 12 do
    smsg[1][i] := 0;
  c := ' ';
  repeat
    p := getmsg(msg,round(0.0003*clkfreq),round(0.003*clkfreq),round(1*clkfreq),true);
    if p < 0 then
      write ('e')
    else if p = 0 then
      write ('.')
    else
    begin
      if decsmsg (msg,smsg[0],maxdev) then
      begin
        b := true;
        for i := 1 to 12 do
          b := b and (smsg[0][i] = smsg[1][i]);
        if not b then
        begin
          writeln;
          for i := 1 to 12 do
          begin
            write (smsg[0][i]:1);
            smsg[1][i] := smsg[0][i];
          end;
        end;
        write ('(',maxdev:5:3,')');
      end
      else
        write ('(d.ddd)');
    end;
    if keypressed then
      c := readkey
    else
      c := #0;
    ii := 0;
    if c = ' ' then
      ii := 3;
    if (c >= '1') and (c <= '9') then
      ii := ord(c)-ord('0');
    if ii > 0 then
    begin
      encsmsg(smsg[1],msg,p);
      for i := 1 to ii do
      begin
        putmsg(msg,p);
        write ('T');
      end;
    end;
  until c = 'q';
  writeln;
end;


procedure savesony;
  var
    msg : msgt;
    p : longint;
    smsg : array[0..1] of smsgt;
    s : string;
    cnt : integer;
    i : integer;
    maxdev : real;
    b : boolean;
    c : char;
    fn : string;
    f : text;
begin
  write ('filename ? ');
  readln (fn);
  {$i-}
  assign (f,fn);
  rewrite (f);
  {$i+}
  if ioresult <> 0 then
  begin
    writeln ('file error');
    exit;
  end;
  write ('device ? ');
  readln (s);
  writeln (f,s);
  cnt := 0;
  repeat
    repeat
      write ('key (<ret> to quit) ? ');
      readln (s);
      if s = '' then
      begin
        repeat
          write ('quit (y/n) ? ');
          readln (c);
        until (c = 'n') or (c = 'y');
      end
      else
        c := 'y';
    until c = 'y';
    if s <> '' then
    begin
      repeat
        repeat
          write ('receiving... ');
          repeat
            repeat
              p := getmsg (msg,round(0.0003*clkfreq),round(0.003*clkfreq),
                           round(1*clkfreq),true);
              if p < 0 then
                write ('e');
            until (p > 0) or keypressed;
            if not keypressed then
            begin
              b := decsmsg (msg,smsg[0],maxdev);
              if not b then
                write ('d');
            end;
          until b or keypressed;
          if not keypressed then
          begin
            write ('(',maxdev:5:3,')');
            repeat
              repeat
                p := getmsg (msg,round(0.0003*clkfreq),round(0.003*clkfreq),
                             round(1*clkfreq),true);
                if p < 0 then
                  write ('e');
              until (p >= 0) or keypressed;
              if (p > 0) and not keypressed then
              begin
                b := decsmsg (msg,smsg[1],maxdev);
                if not b then
                  write ('d');
              end;
            until b or (p = 0) or keypressed;
            if not keypressed then
            begin
              if p = 0 then
              begin
                writeln (' timeout');
                b := false;
              end
              else
              begin
                write ('(',maxdev:5:3,')');
                b := true;
                for i := 1 to 12 do
                  b := b and (smsg[0][i] = smsg[1][i]);
                if not b then
                  writeln (' error');
              end;
            end;
          end;
          if keypressed then
          begin
            writeln (' interupted');
            c := readkey;
            b := false;
          end;
          c := #0;
          if not b then
          begin
            write ('   a=abort other=retry ? ');
            c := readkey;
            writeln;
            if c <> 'a'then
              c := #0;
          end;
        until b or (c = 'a');
        if b then
        begin
          writeln;
          write ('got ');
          for i := 1 to 12 do
            write (smsg[0][i]:1);
          write ('   a=abort <ret>=save other=retry ? ');
          c := readkey;
          writeln;
        end;
      until (c = 'a') or (c = #13);
      if c = #13 then
      begin
        for i := 1 to 12 do
          write (f,smsg[0][i]:1);
        writeln (f,':',s);
        write ('saving ');
        for i := 1 to 12 do
          write (smsg[0][i]:1);
        writeln (':',s);
        inc (cnt);
      end;
    end;
  until s = '';
  close (f);
  writeln (cnt,' keys saved');
end;

procedure playsony (verbose : boolean);
  const
    maxkey = 100;
  var
    fn,dev,s : string;
    f : text;
    cnt,i,j,n : integer;
    c : char;
    p : longint;
    msg : msgt;
    keyc : array[1..maxkey] of char;
    keyname : array[1..maxkey] of string[20];
    keysmsg : array[1..maxkey] of smsgt;
begin
  write ('filename ? ');
  readln (fn);
  {$i-}
  assign (f,fn);
  reset (f);
  {$i+}
  if ioresult <> 0 then
  begin
    writeln ('file error');
    exit;
  end;
  readln (f,dev);
  writeln ('device = ',dev);
  cnt := 0;
  while not eof(f) do
  begin
    readln (f,s);
    if cnt=maxkey then
    begin
      writeln ('file too long');
      exit;
    end;
    if length(s) < 14 then
    begin
      writeln ('file format error');
      exit;
    end;
    inc(cnt);
    for i := 1 to 12 do
    begin
      if s[i] = '0' then
        keysmsg[cnt][i] := 0
      else if s[i] = '1' then
        keysmsg[cnt][i] := 1
      else
      begin
        writeln ('file format error');
        exit;
      end;
    end;
    if s[13] <> ':' then
    begin
      writeln ('file format error');
      exit;
    end;
    keyname[cnt] := copy(s,14,length(s)-13);
  end;
  close(f);
  writeln (cnt,' keys loaded');
  if cnt = 0 then
    exit;
  c := 'a';
  for i := 1 to cnt do
  begin
    keyc[i] := #0;
    for j := 0 to 9 do
      if keyname[i] = chr(ord('0')+j) then
        keyc[i] := chr(ord('0')+j);
    if keyname[i] = '10' then
      keyc[i] := '0';
    if keyc[i] = #0 then
    begin
      keyc[i] := c;
      if c = 'z' then
        c := 'A'
      else
        c := chr(ord(c)+1);
    end;
  end;
  repeat
    write ('number of message transmissions (typ. 3) (0=quit) ? ');
    readln (n);
    if n > 0 then
    begin
      writeln;
      for i := 1 to cnt do
      begin
        s := copy(keyname[i],1,16);
        write (keyc[i],':',s,'':16-length(s));
        if i mod 4 = 0 then
          writeln
        else
          write ('  ');
      end;
      writeln;
      writeln ('<ret> to quit');
      if not verbose then
        write ('?');
      repeat
        if not verbose then
          write (#8,' ',#8);
        c := readkeyrepeat;
        i := 1;
        while (i <= cnt) and (keyc[i] <> c) do
          inc (i);
        if keyc[i] = c then
        begin
          encsmsg (keysmsg[i],msg,p);
          if not verbose then
            write (c);
          for j := 1 to n do
          begin
            putmsg (msg,p);
            if verbose then
              write (c);
          end;
        end
        else
          write ('?');
      until c = #13;
      writeln;
    end;
  until n = 0;
end;

procedure trysony;
  var
    msg : msgt;
    p : longint;
    smsg,mask : smsgt;
    s : string;
    cnt : integer;
    i : integer;
    c : char;
    b : boolean;
    fn : string;
    f : text;
begin
  write ('filename ? ');
  readln (fn);
  {$i-}
  assign (f,fn);
  rewrite (f);
  {$i+}
  if ioresult <> 0 then
  begin
    writeln ('file error');
    exit;
  end;
  write ('device ? ');
  readln (s);
  writeln (f,s);
  writeln ('pattern: 0=0 1=1 x,X=variable (start value x=0, X=1)');
  cnt := 0;
  for i := 1 to 12 do
  begin
    smsg[i] := 0;
    mask[i] := 1;
  end;
  repeat
    repeat
      s := '123456789012';
      for i := 1 to 12 do
        if mask[i] = 1 then
          s[i] := chr(ord('x')-(ord('x')-ord('X'))*smsg[i])
        else
          s[i] := chr(ord('0')+smsg[i]);
      write ('pattern (',s,') (<ret>=cont) ? ');
      readln (s);
      if s = ''then
        b := true
      else
      begin
        b := (length(s) = 12);
        for i := 1 to 12 do
          if s[i] = '0' then
          begin
           smsg[i] := 0;
           mask[i] := 0;
          end
          else if s[i] = '1' then
          begin
           smsg[i] := 1;
           mask[i] := 0;
          end
          else if s[i] = 'x' then
          begin
           smsg[i] := 0;
           mask[i] := 1;
          end
          else if s[i] = 'X' then
          begin
           smsg[i] := 1;
           mask[i] := 1;
          end
          else
            b := false;
        if not b then
          writeln ('pattern format error');
      end;
    until b;
    c := #0;
    writeln ('m=inc n=dec <spc>=repeat <ret>=save message');
    repeat
      if c <> ' 'then
      begin
        encsmsg (smsg,msg,p);
        for i := 1 to 12 do
          write (smsg[i]:1);
      end;
      for i := 1 to 3 do
      begin
        putmsg (msg,p);
        write ('T');
      end;
      c := readkeyrepeat;
      if c = 'm' then
      begin
        b := true;
        for i := 1 to 12 do
          if b and (mask[i] = 1) then
          begin
            smsg[i] := 1-smsg[i];
            b := (smsg[i] = 0);
          end;
        writeln;
      end
      else if c = 'n' then
      begin
        b := true;
        for i := 1 to 12 do
          if b and (mask[i] = 1) then
          begin
            smsg[i] := 1-smsg[i];
            b := (smsg[i] = 1);
          end;
        writeln;
      end;
    until c = #13;
    writeln;
    write ('function name (<ret> to cont/quit) ? ');
    readln (s);
    if s = '' then
    begin
      repeat
        repeat
          write ('c=continue q=quit ? ');
          readln (c);
        until (c = 'c') or (c = 'q');
        if c = 'e' then
        begin
          repeat
            write ('quit (y/n) ? ');
            readln (c);
          until (c = 'n') or (c = 'y');
          if c = 'y' then
            c := 'q';
        end;
      until (c = 'c') or (c = 'q');
    end
    else
    begin
      c := #0;
      for i := 1 to 12 do
        write (f,smsg[i]:1);
      writeln (f,':',s);
      write ('saving ');
      for i := 1 to 12 do
        write (smsg[i]:1);
      writeln (':',s);
      inc (cnt);
    end;
  until c = 'q';
  close (f);
  writeln (cnt,' keys saved');
end;


{ main }

begin
  readkeylast := #0;
  writeln ('SIRCS - Serial Infrared Remote Control System (Ver. 2)');
  writeln ('Heiko Purnhagen   27-nov-95, 30-jun-96');
  writeln ('e-mail: purnhage@tnt.uni-hannover.de');
  writeln ('WWW:    http://www.fet.uni-hannover.de/purnhage/');
  repeat
    write ('com (1,2,3,4)? ');
    readln (c);
  until (c >= '1') and (c <= '4');
  b := initio(ord(c)-ord('0'));
  if not b then
  begin
    writeln ('com',c,' error');
    exit;
  end;
  repeat
    write ('receiver input active level (0=low, 1=high) ? ');
    readln (invrx);
  until (invrx = 0) or (invrx = 1);
  invrx := 1-invrx;
  repeat
    write ('transmitter output active level (0=low, 1=high) ? ');
    readln (invtx);
  until (invtx = 0) or (invtx = 1);
  invtx := 1-invtx;
  initclk;
  repeat
    writeln;
    writeln ('1=test receiver (textmode)');
    writeln ('2=test receiver (graphic)');
    writeln ('3=test timing and echo messages');
    writeln ('4=save basic mesages to file');
    writeln ('5=receive and echo sony message');
    writeln ('6=receive sony messages to file');
    writeln ('7=transmit sony messages from file (USE THIS!!!)');
    writeln ('8=generate and transmit sony messages');
    writeln ('9=transmit sony messages from file (verbose)');
    writeln ('0=quit');
    write ('? ');
    readln (c);
    case c of
      '1' : testtext;
      '2' : testgraph;
      '3' : testtime;
      '4' : timetofile;
      '5' : testsony;
      '6' : savesony;
      '7' : playsony(false);
      '8' : trysony;
      '9' : playsony(true);
    end;
  until c = '0';
  restoreio;
end.