Program pre dekodovanie a zobrazenie teletextu cez SAA5281 s komunikaciou cez I2C

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie:

Program: Teletext.pas
Soubor exe: Teletext.exe
Potřebné: I2c_com.pasKodovani.pasSpec.pasTxtvga.pasVgaprog.pasTxtcz.vga

Program pre dekodovanie a zobrazenie teletextu cez SAA5281 s komunikaciou cez I2C.
{ TELETEXT.PAS                                                       }
{ Teletext SAA5281 s komunikaciou cez I2C.                           }
{                                                                    }
{ Datum:14.12.2017                              http://www.trsek.com }
 
program Teletext_SAA5281;
uses crt,spec,i2c_com,vgaprog;
var packet25:array[0..9]  of byte;
    a,b,c:integer;
    prep:boolean;
    row,col,stran:byte;
    stranka:array [0..39,0..23] of byte;
    hidden:boolean;
    substr:string[2];
    head:byte;
    hold:byte;
    klav:char;
 
{$I kodovani.pas}
{$I txtvga.pas}
 
function kodovani (kod:byte):byte;
begin
 case kod of
  0,16:kodovani:=1;
  1,17:kodovani:=12;
  2,18:kodovani:=10;
  3,19:kodovani:=14;
  4,20:kodovani:=9;
  5,21:kodovani:=13;
  6,22:kodovani:=11;
  7,23:kodovani:=15;
  35:kodovani:=35;
  36:kodovani:=133;
  64:kodovani:=159;
  91:kodovani:=156;
  92:kodovani:=167;
  93:kodovani:=236;
  94:kodovani:=161;
  95:kodovani:=253;
  96:kodovani:=130;
  123:kodovani:=160;
  124:kodovani:=216;
  125:kodovani:=163;
  126:kodovani:=231;
  127:kodovani:=219;
  240:kodovani:=181;
  243:kodovani:=214;
  203:kodovani:=248;
  238:kodovani:=162;
  245:kodovani:=224;
  247:KODOVANI:=233;
 else kodovani:=kod;
 end;
end;
 
procedure registr(cislo:byte;hodnota:byte);
begin
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(cislo);
 i2c_vystup(hodnota);
 i2c_stop;
end;
 
procedure volba(sto:byte;des:byte;jed:byte;bank:byte;prep:byte);
var hold:byte;
begin
 if prep=0 then
    hold:=0
 else
    hold:=8;
 
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(2);
 i2c_vystup(128+bank*64);
 i2c_vystup(sto and 247+16+hold);
 i2c_vystup(des + 16);
 i2c_vystup(jed + 16);
 i2c_vystup(0);
 i2c_vystup(0);
 i2c_vystup(0);
 i2c_vystup(0);
 i2c_vystup(0);
 i2c_stop;
 delay(1);
end;
 
procedure registry;
begin
 registr(0,0+head);                                    {advanced control}
 registr(1,0*128+0*64+0*32+0*16+0*8+0*4+0*2+0*1);      {mode u SAA5254 d4 invert}
 {registr(2,0);}
 {registr(3,0);}
 {registr(4,8);}
 registr(5,1*128+1*64+0*32+0*16+1*8+1*4+1*2+1*1);
 {registr(6,204);}
 {registr(7,0*128+0*64+0*32+0*16+0*8+0*4+0*2+0*1);}
 {registr(8,0);}
 {registr(9,0);}
 {registr(10,0);}
 {registr(12,0);}                                      {advanced control 2A}
 {registr(13,0);}                                      {advanced control 2B}
end;
 
procedure prevod(vstup:byte);
begin
 substr:='  ';
 str(vstup,substr);
 if (ord(substr[1])>ord('9')) or (ord(substr[1])<ord('0')) then
     substr[1]:=' ';
 
 if (ord(substr[2])>ord('9')) or (ord(substr[2])<ord('0')) then
     substr[2]:=' ';
end;
 
procedure substranka;
var substran:string[2];
begin
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(8);
 i2c_vystup(stran);
 i2c_vystup(0);
 i2c_vystup(4);
 i2c_vystup(ord('S'));
 prevod(packet25[2]);
 i2c_vystup(ord(substr[1]));
 i2c_vystup(ord(substr[2]));
 i2c_stop;
end;
 
procedure packet_25;
begin
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(8);
 i2c_vystup(stran);
 i2c_vystup(25);
 i2c_vystup(0);
 i2c_start;
 i2c_vystup(35);
 for col:=0 to 9 do
 begin
  packet25[col]:=i2c_cteni;
  if col-9=0 then i2c_noack else i2c_ack;
 end;
 i2c_stop;
end;
 
procedure row_1_23;
var znak:byte;
    attr:byte;
    klav:char;
begin
 packet_25;
 substranka;
 if (packet25[9] and 32)=32 then exit;
 if (packet25[8] and 16)=16 then exit;
 delay(20);
 attr:=15;
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(8);
 i2c_vystup(stran);
 i2c_vystup(1);
 i2c_vystup(0);
 i2c_start;
 i2c_vystup(35);
 for row:=1 to 23 do
  for col:=0 to 39 do
  begin
   stranka[col,row]:=i2c_cteni;
   if row-23+col-39=0 then i2c_noack else i2c_ack;
  end;
 i2c_stop;
 writeseite;
 {head:=16;
 volba(a,b,c,0,hold);}
end;
 
procedure row_0;
var column:array [0..39] of byte;
    znak:byte;
    attr:byte;
    a,b,c:byte;
    klav:char;
begin
 attr:=15;
 textattr:=white;
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(4);
 i2c_vystup(8+stran);
 i2c_stop;
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(8);
 i2c_vystup(stran);
 i2c_vystup(0);
 i2c_vystup(0);
 i2c_start;
 i2c_vystup(35);
 for col:=0 to 39 do
  begin
  column[col]:=i2c_cteni;
  if col-39=0 then i2c_noack else i2c_ack;
  end;
 i2c_stop;
 for col:=0 to 39 do
  begin
  gotoxy (col+1,1);
  znak:=kodovani(column[col]);
  if znak<16 then attr:=znak;
  if attr=0 then attr:=7;
  textcolor(attr);
  if znak<32 then znak:=32;
  write(chr(znak));
 end;
end;
 
procedure row_24;
var column:array [0..39] of byte;
    znak:byte;
    attr:byte;
    a,b,c:byte;
    klav:char;
begin
 attr:=15;
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(8);
 i2c_vystup(stran);
 i2c_vystup(24);
 i2c_vystup(0);
 i2c_start;
 i2c_vystup(35);
 for col:=0 to 39 do
  begin
  column[col]:=i2c_cteni;
  if col-39=0 then i2c_noack else i2c_ack;
  end;
 i2c_stop;
 for col:=0 to 39 do
  begin
  gotoxy (col+1,25);
  znak:=kodovani(column[col]);
  if znak<16 then attr:=znak;
  if attr=0 then attr:=7;
  textcolor(attr);
  if znak<32 then znak:=32;
  write(chr(znak));
 end;
end;
 
function status:byte;
begin
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(0);
 i2c_vystup(1+head);
 i2c_start;
 i2c_vystup(35);
 status:=i2c_cteni;
 i2c_noack;
 i2c_stop;
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(0);
 i2c_vystup(0+head);
 i2c_stop;
end;
 
procedure clear;
var p:byte;
begin
for p:=0 to 7 do
 begin
  i2c_start;
  i2c_vystup(34);
  i2c_vystup(8);
  i2c_vystup(8);
  i2c_stop;
  delay(100);
 end;
end;
 
procedure hold_v;
begin
 if not prep then
    prep:=true
 else
    prep:=false;
 
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(8);
 i2c_vystup(stran);
 i2c_vystup(0);
 i2c_vystup(3);
 
 if prep then
    i2c_vystup(ord('H')) else i2c_vystup(32);
 
 i2c_stop;
 if prep then
    hold:=0
 else
    hold:=1;
 
 volba(a,b,c,0,hold);
end;
 
procedure zapis;
begin
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(8);
 i2c_vystup(stran);
 i2c_vystup(0);
 i2c_vystup(0);
 i2c_vystup(a+48);
 i2c_vystup(b+48);
 i2c_vystup(c+48);
 i2c_stop;
end;
 
procedure hledani;
var readtmp:byte;
begin
 a:=ord(klav)-48;
 b:=-3;
 c:=-3;
 zapis;
 row_0;
 repeat
  readtmp:=ord(readkey);
 until (readtmp>47) and (readtmp<58);
 b:=readtmp-48;
 zapis;
 row_0;
 repeat
  readtmp:=ord(readkey);
 until (readtmp>47) and (readtmp<58);
 c:=readtmp-48;
 zapis;
 row_0;
 volba(a,b,c,0,hold);
 head:=0;
end;
 
procedure klavesa;
begin
if keypressed then
 begin
  klav:=readkey;
  if ord(klav)=27 then
   begin
    initscr(false);
    cursor(1);
    halt;
   end
 else
  case klav of
  'q' :stran:=0;
  'w' :stran:=1;
  'e' :stran:=2;
  'r' :stran:=3;
  't' :stran:=4;
  'y' :stran:=5;
  'u' :stran:=6;
  'i' :stran:=7;
  'h' :hold_v;
  'c' :clear;
  '1'..'8': hledani;
  end;
 end;
end;
 
procedure kvalita;
var co:string[3];
begin
 if (status and 1)<>1 then co:='NOV' else
  if (status and 2)<>2 then co:='NOT' else co:=chr(a+48)+chr(b+48)+chr(c+48);
 i2c_start;
 i2c_vystup(34);
 i2c_vystup(8);
 i2c_vystup(stran);
 i2c_vystup(0);
 i2c_vystup(0);
 i2c_vystup(ord(co[1]));
 i2c_vystup(ord(co[2]));
 i2c_vystup(ord(co[3]));
 i2c_stop;
end;
 
procedure vypis_25;
var poz:byte;
begin
 for poz:=1 to 10 do
 begin
  gotoxy(50,poz);
  write(poz-1,'-',packet25[poz-1],' ');
 end;
end;
 
begin
 clrscr;
 TextMode(co40);
 cursor(0);
 initscr(true);
 hidden:=false;
 prep:=false;
 clear;
 stran:=0;
 hold:=1;
 a:=1;b:=0;c:=0;
 registry;
 zapis;
 volba(a,b,c,0,1);
 head:=0;
 repeat
  row_0;
  row_1_23;
  {row_24;}
  kvalita;
  {vypis_25;}
  klavesa;
 until (1=0);
 end.