program sircsall; { ************************************************************ SIRCS - Serial Infrared Remote Control System (Ver. 4) Original Software written by: Heiko Purnhagen 27-nov-95, 30-jun-96, 19-aug-96, 08-sep-96 e-mail: purnhage@tnt.uni-hannover.de WWW: http://www.fet.uni-hannover.de/purnhage/ Modified by sircs 30-May-1998 email: sircs@Geocities.com www: http://www.geocities.com/capecanaveral/launchpad/4652 This program now read all versions of the sircs commands ie: 12bit, 15bit & 20bit. This program may be copied according to the GNU General Public Licence. Changes: SIRCS 27-nov-95 first version SIRCS2 30-jun-96 improved handling of auto-repeat keys added non-verbose version of "transmit sony msgs" SIRCS3 19-aug-96 added command line options added cli/sti and timing check SIRCS4 08-sep-96 added 38.4 kHz carrier generation to drive an IR-LED directly from TD SIRCSALL 30-may-98 changed to read and send 12bit, 15bit &20bit commands 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 DTR positive voltage providing some power for interface circuits TD normal mode: positive voltage (as "DTR") LED mode: transmit signal (with 38.4 kHz carrier) 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 / TCD-D8 ------------------------------------------------ Note: The D7 requires a low-active serial remote control signal !!! PC serial (D9) D7 / D8 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/dat.html An optocoupler-based interface for Sony DAT TCD-D7 / TCD-D8 ------------------------------------------------------------ Note: This interface is inverting, so you have to feed it with an high-active SIRCS signal !!! D8 connector +-----------o # 2 +4V/+5V | | R 10 kOhm R PC serial (D25) | 470 Ohm | RTS (pin 4) o---RRR------+ +-----------o # 7 sircs pin1| |pin5 | | A -> C K -> E | | | | SG (pin 7) o------------+ +-----------o # 6 ground pin2 pin4 CNY17 or similar This interface was designed by Ulrich Hornstein . His original description is also available on http://www.fet.uni-hannover.de/purnhage/dat/dat.html Connecting an IR receiver module -------------------------------- There is a cheap ( < 5 US$ ) IR receiver module available from "Conrad Electronic" (Nr. 177695). It requires a few mA power at 5 V and has a low-active output. It can be connected directly to a TCD-D7 / TCD-D8. To connect it to the PC's serial port (for usage with SIRCS), an additional 5 V power source / voltage regulator and a 4.7 kOhm pull-up resistor is required. Driving an IR-LED directly from TD ---------------------------------- It is also possible to connect an IR-LED directly to the TD pin of the PC's serial port to transmit SIRCS messages with an 38.4 kHz carrier signal. 470 Ohm TD o---RR---+ | A IR K LED | SG o--------+ 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 For a complete list of commands look at: http://www.geocities.com/capecanaveral/launchpad/4652 ************************************************************ } { declarations } {$n-} {$e-} {$d-} {$l-} 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..20] of byte; { maximum sony message } var base, mcrbuf,bits : word; invrx, invtx : byte; clkbufl, clkbufh : word; c : char; b : boolean; readkeylast : char; err : integer; com,rpt : integer; fns : string; yn : string; tmg : real; { serial interface } function initio (com : integer) : boolean; { ok -> true } var b : byte; l : longint; 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 or (((b xor invtx) and 1) shl 1); if invtx >= 2 then begin b := 2; { 7N1 } l := 1; { 115200 baud } port[base+lcr] := $80; { dlab = 1 } port[base+dll] := lo(word(l)); port[base+dlm] := hi(word(l)); port[base+lcr] := b; port[base+ier] := 0; { no interrupts } port[base+fcr] := 0; { fifo disabled } end else port[base+lcr] := port[base+lcr] or $40; { set TD } 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 TD } 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; procedure gen38k; begin repeat until (port[base+lsr] and $20) = $20; port[base+thr] := $12; { start= 0 0100100 1 =stop 0=+12V=LED on } 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; { check system timing } function clkmax : real; var t0,t1,dt,max,tm : longint; i : integer; b : byte; begin resetclk; tm := round(0.5 * clkfreq); max := 0; asm cli; end; t1 := getclk; tm := tm + t1; repeat b := getrx; t0 := t1; t1 := getclk; dt := t1-t0; if dt > max then max := dt; until t1 > tm; asm sti; end; clkmax := max / clkfreq; 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 asm cli; end; 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 begin asm sti; end; exit; end; end; t0 := t; while b = 0 do begin t := getclk; b := getrx; if t > tt then begin getmsg := 0; asm sti; end; exit; end; if keybreak and keypressed then begin asm sti; end; exit; end; 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 begin asm sti; end; exit; end; end; if t-t0 < minbit then begin asm sti; end; exit; end; 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 begin asm sti; end; exit; end; end; if t-t0 < minbit then begin asm sti; end; exit; end; if t > tb then begin getmsg := tw; asm sti; end; exit; end; msg[idx] := t-t0; inc(idx); msg[idx] := 0; until idx = msgsize; asm sti; end; end; procedure putmsg (msg : msgt; wait : longint); const gen38time = 93; { 1.19318 MHz / 115.2 kbit/s * 9 bit } var t,t0 : longint; idx,i,n : integer; begin asm cli; end; idx := 1; resetclk; t := getclk; t0 := t; while msg[idx] > 0 do begin puttx (idx and 1); if (invtx >= 2) and ((idx and 1) = 1) then begin n := (msg[idx]+gen38time div 2) div gen38time; for i := 1 to n do gen38k; end; t0 := t0+msg[idx]; repeat t := getclk until t > t0; inc(idx); end; puttx(0); t0 := t0+wait; repeat t := getclk until t > t0; asm sti; end; 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 <> ((bits*2)+2) then exit; decsmsg := true; checkdev (msg[1]/clkfreq-4*dt); for i := 1 to bits 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 bits 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[((bits*2)+2)] := 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 '); readln; end; procedure testgraph; var gd,gm : integer; x,y,xx,yy,cc : integer; s,ss : string; begin gd := Detect; write ('bgi path (\tp\bgi) ?'); readln (s); if s = '' then s := '\tp\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 '); 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 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 '); 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 ( 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 (' to view, 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 (''); 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 (' to view, 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: =3*tx 1=1*tx .. 9=9*tx'); writeln ('q=quit'); for i := 1 to bits 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 bits do b := b and (smsg[0][i] = smsg[1][i]); if not b then begin writeln; for i := 1 to bits 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 ( 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 bits 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 bits do write (smsg[0][i]:1); write (' a=abort =save other=retry ? '); c := readkey; writeln; end; until (c = 'a') or (c = #13); if c = #13 then begin for i := 1 to bits do write (f,smsg[0][i]:1); writeln (f,':',s); write ('saving '); for i := 1 to bits 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; fns : string; rpt : integer); 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 if rpt = 0 then begin write ('filename ? '); readln (fn); end else fn := fns; {$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) < (bits+2) then begin writeln ('file format error'); exit; end; inc(cnt); for i := 1 to bits 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[bits+1] <> ':' then begin writeln ('file format error'); exit; end; keyname[cnt] := copy(s,(bits+2),length(s)-(bits+1)); 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 if rpt = 0 then begin write ('number of message transmissions (typ. 3) (0=quit) ? '); readln (n); end else n := rpt; 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 (' 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; if rpt > 0 then n := 0; 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 bits do begin smsg[i] := 0; mask[i] := 1; end; repeat repeat if bits=12 then s := '123456789012'; if bits=15 then s := '123456789012345'; if bits=20 then s := '12345678901234567890'; for i := 1 to bits 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,') (=cont) ? '); readln (s); if s = ''then b := true else begin b := (length(s) = bits); for i := 1 to bits 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 =repeat =save message'); repeat if c <> ' 'then begin encsmsg (smsg,msg,p); for i := 1 to bits 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 bits 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 bits 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 ( 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 bits do write (f,smsg[i]:1); writeln (f,':',s); write ('saving '); for i := 1 to bits 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. 4)'); writeln ('Heiko Purnhagen 27-nov-95, 30-jun-96, 19-aug-96, 08-sep-96'); writeln ('e-mail: purnhage@tnt.uni-hannover.de'); writeln ('WWW: http://www.fet.uni-hannover.de/purnhage/'); writeln; writeln ('Modified by sircs 30-may 98'); writeln ('email: sircs@geocities.com'); writeln ('WWW: http://geocities.com/capecanaveral/launchpad/4652'); writeln ('Now reads 12bit,15bit & 20bit'); writeln; writeln ('usage: SIRCSALL'); writeln (' or: SIRCSALL [ ]'); writeln (' port: 1,2,3,4'); writeln (' output active : 0=low 1=high 2,3=LED'); writeln; if paramcount > 0 then begin if paramcount <> 3 then begin writeln ('parameter error'); exit; end; val (paramstr(1),com,err); if (err <> 0) or (com < 1) or (com > 4) then begin writeln (' parameter error'); exit; end; invrx := 0; invtx := 2; b := initio(com); if not b then begin writeln ('com',com,' error'); exit; end; restoreio; val (paramstr(2),invtx,err); if (err <> 0) or (invtx < 0) or (invtx > 3) then begin writeln (' parameter error'); exit; end; fns := paramstr(3); invtx := invtx xor 1; invrx := 0; rpt := 3; end else begin rpt := 0; repeat write ('com (1,2,3,4)? '); readln (com); until (com >= 1) and (com <= 4); invrx := 0; invtx := 2; b := initio(com); if not b then begin writeln ('com',com,' error'); exit; end; restoreio; 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, 2,3=LED) ? '); readln (invtx); until (invtx >= 0) and (invtx <= 3); invtx := invtx xor 1; repeat write ('number of bits 12, 15 or 20 ? '); readln (bits); until (bits =12) or (bits=15) or (bits=20); end; initclk; tmg := clkmax; writeln ('system timing: ',tmg:8:6,' sec'); if tmg > 0.000100 then begin writeln ('WARNING: unstable or slow system timing'); writeln (' -> SIRCS might not operate reliable!'); writeln ('Hint: Don''t use SIRCS from a DOS-Window within MS-Windows.'); writeln; write ('continue (y/n): '); readln (yn); if yn <> 'y' then exit; end; b := initio(com); if rpt > 0 then playsony(false,fns,rpt) else 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,'',0); '8' : trysony; '9' : playsony(true,'',0); end; until c = '0'; restoreio; end.