home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / x_10 / xe109.zip / SAMPLE.PAS next >
Pascal/Delphi Source File  |  1988-04-30  |  4KB  |  147 lines
  1. { X10 Computer Interface Communications in Turbo Pascal
  2.   Copyright 1988 by F.C. Wilczynski }
  3.  
  4. type
  5.           all  =  string[80];
  6.    HouseCodes  =  array[1..16] of char;
  7.     ConvHouse  =  array[1..16] of integer;
  8.  
  9. const
  10.     HouseCode:HouseCodes = ('A','B','C','D','E','F','G','H',
  11.                             'I','J','K','L','M','N','O','P');
  12.     HouseValue:ConvHouse = ($60,$E0,$20,$A0,$10,$90,$50,$D0,
  13.                             $70,$F0,$30,$B0,$00,$80,$40,$C0);
  14.  
  15.     aoff = $00;    { all units off }
  16.     alon = $01;    { all lights on }
  17.       on = $02;    { on }
  18.      off = $03;    { off }
  19.     loff = $04;    { dim light to off }
  20.      dim = $05;    { dim light to designated level }
  21.      osw = $06;    { turn off wall switch lights and designated on }
  22.       sw = $07;    { turn off wall switch lights }
  23. var
  24.                             stat,
  25.                          checksum : byte;
  26.                               inc : char;
  27.                    linein,lineout : all;
  28.                            buffer : array[1..2048] of char;
  29.   a,t,u,av,bv,ck,portval,portadd,
  30.                 c1,c2,c3,c4,c5,c6 : integer;
  31.                            recchr : boolean;
  32.  
  33. procedure SetBaud;
  34. begin
  35.   portadd := $3f8;
  36.     case portval of
  37.         2 : portadd := $2f8;
  38.         3 : portadd := $3e8;
  39.         4 : portadd := $2e8;
  40.     end;
  41.   port[portAdd+3]:=$80;  port[portAdd+1]:=0;   { set baud rate to 600      }
  42.   port[portAdd]:=$c0;  port[PortAdd+3]:=$03;   { No parity, 8 bits, 1 stop }
  43. end;
  44.  
  45. procedure OutPort(character:char);
  46. begin
  47.   while (port[PortAdd+5] and $40)=0 do begin end;
  48.   port[PortAdd]:=ord(character);
  49.   delay(2);
  50. end;
  51.  
  52. procedure InPort;
  53. begin
  54.   inc:=chr(port[PortAdd]);
  55.   recchr:=true;
  56. end;
  57.  
  58. procedure StatusPort;
  59. begin
  60.   recchr:=false;
  61.   stat:=port[PortAdd+5];
  62.   if ((stat and $1) = $1) then inport;
  63. end;
  64.  
  65. procedure Receive;
  66. begin
  67.   for t:=1 to 2048 do buffer[t]:=chr(0);
  68.   t:=1; u:=0;
  69.   while (u < 3200) do
  70.     begin
  71.       statusport;
  72.       if recchr then
  73.         begin
  74.           buffer[t]:=inc; t:=succ(t); u:=0;
  75.         end;
  76.       u:=succ(u);
  77.     end;
  78. end;
  79.  
  80. procedure send(anystr:all;bytes:integer);
  81. var    a : integer;
  82.     part : string[18];
  83. begin
  84.   receive; part:='';
  85.   for a:=1 to 16 do part:=part+chr($ff);
  86.   if bytes>0 then
  87.     begin
  88.       checksum:=0; anystr:=part+anystr;
  89.       for a:=length(anystr)-bytes to length(anystr) do
  90.         checksum:=(checksum+ord(anystr[a])) and $ff;
  91.       anystr:=anystr+chr(checksum);
  92.     end;
  93.   for A:=1 to length(anystr) do
  94.     outport(anystr[a]);
  95.   receive;
  96. end;
  97.  
  98. Begin
  99.   portval:=1; setbaud;
  100.   lineout:=chr(1)+chr($f)+chr(0)+chr(0)+chr(0);
  101.  
  102.   { UNIT/HOUSECODE VALUE }
  103.   linein:='A16';
  104.  
  105.   if (linein[1] < 'A') or (linein[1] > 'P') then
  106.     begin
  107.       writeln('Invalid house code'); exit;
  108.     end;
  109.   lineout[3]:=chr(housevalue[ord(linein[1])-64]);
  110.   if length(linein)>1 then
  111.     begin
  112.       linein:=copy(linein,2,length(linein));
  113.       val(linein,av,ck);
  114.       if (av>16) or (av<1) then
  115.         begin
  116.           writeln('Invalid unit value'); exit;
  117.         end;
  118.       bv:=$80;
  119.       if av>=9 then  lineout[4]:=chr((bv shr (av-9)))
  120.         else
  121.       lineout[5]:=chr(bv shr (av-1));
  122.     end;
  123.  
  124.   { OPERATION ON UNIT/HOUSECODE }
  125.   linein:='OFF';
  126.  
  127.   if linein = 'LIGHTOFF' then  lineout[2]:=chr(loff);
  128.   if linein = 'OFF' then       lineout[2]:=chr(off);
  129.   if linein = 'ON' then        lineout[2]:=chr(on);
  130.   if linein = 'ALLOFF' then    lineout[2]:=chr(aoff);
  131.   if linein = 'ALLON' then     lineout[2]:=chr(alon);
  132.   if linein = 'SWITCH' then    lineout[2]:=chr(sw);
  133.   if linein = 'ON/SWITCH' then lineout[2]:=chr(osw);
  134.  
  135.   if lineout[2]=chr(15) then  { NONE OF THE ABOVE IT'S A DIM VALUE; MAYBE }
  136.     begin
  137.       a:=0; val(linein,a,ck);
  138.       if (a>16) or (a<1) then
  139.         begin
  140.           writeln('Dim value out of range'); exit;
  141.         end
  142.         else lineout[2]:=chr(dim+((16-a)*16));
  143.     end;
  144.   if lineout[2]<>chr(15) then send(lineout,5);
  145.   receive;
  146. end.
  147.