{ KODOVANI.PAS                                                       }
{ Kodovana stranka pre teletext.                                     }
{                                                                    }
{ Datum:14.12.2017                              http://www.trsek.com }

type bytearray=array[0..255] of byte;
const
  bit7p : Bytearray=
    { 0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15}
   ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F, {0}
    $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F, {1}
    $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2A,$2B,$2C,$2D,$2E,$2F, {2}
    $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3A,$3B,$3C,$3D,$3E,$3F, {3}
    $40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,$4D,$4E,$4F, {4}
    $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A,$8E,$99,$9A,$5E,$5F, {5}
    $F8,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6A,$6B,$6C,$6D,$6E,$6F, {6}
    $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7A,$84,$94,$81,$E1,$FE, {7}
    $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, {8}
    $7E,$20,$61,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, {9}
    $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2A,$2B,$2C,$2D,$2E,$2F, {2}
    $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3A,$3B,$3C,$3D,$3E,$3F, {3}
    $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$e3,$20,$20,$20,$20, {12}
    $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$99,$20,$20,$20, {13}
    $F8,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$7F,$20, {14}
    $7B,$20,$20,$7D,$20,$7C,$20,$81,$20,$20,$20,$84,$20,$81,$E1,$20);{15}

  bit7pG : Bytearray=
    { 0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15}
   ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F, {0}
    $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F, {1}
    $20,$80,$82,$83,$85,$86,$87,$88,$89,$8A,$8B,$8C,$8D,$8F,$90,$91, {2g}
    $92,$93,$95,$96,$97,$98,$9B,$9C,$9D,$9E,$9F,$A0,$A1,$A2,$A3,$A4, {3g}
    $40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,$4D,$4E,$4F, {4}
    $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A,$8E,$99,$9A,$5E,$5F, {5}
    $A5,$A6,$A7,$A8,$A9,$AA,$AD,$AE,$AF,$B0,$B1,$B2,$E0,$E2,$E4,$E5, {6g}
    $E7,$E8,$E9,$EA,$EB,$EC,$ED,$EE,$EF,$F0,$F1,$F2,$F3,$F4,$F5,$F7, {7g}
    $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, {8}
    $7E,$20,$61,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, {9}
    $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2A,$2B,$2C,$2D,$2E,$2F, {2}
    $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3A,$3B,$3C,$3D,$3E,$3F, {3}
    $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$e3,$20,$20,$20,$20, {12}
    $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$99,$20,$20,$20, {13}
    $F8,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$7F,$20, {14}
    $7B,$20,$20,$7D,$20,$7C,$20,$81,$20,$20,$20,$84,$20,$81,$E1,$20);{15}

procedure WriteSeite;
var attralt               : byte;
    oldattr,oldattr1      : byte;
    oldcctchr,cctc        : CHAR;
    grafikflag,                  { Grafik ein/aus }
    doubleflag,
    doublerow,
    blinkflag,		       { Blinken ein/aus }
    holdflag              : boolean;   { Zeichenhalten ein/aus }
    SHELP                 : String[4];
    row1,col1:byte;
{************************************************}
  procedure cctcolor;
  begin
    CASE ord (cctc) AND $F OF
      0 : TextAttr := TextAttr AND $70 OR black     OR (ord(Blinkflag)SHL 7);
      1 : TextAttr := TextAttr AND $70 OR red       OR (ord(Blinkflag)SHL 7);
      2 : TextAttr := TextAttr AND $70 OR green     OR (ord(Blinkflag)SHL 7);
      3 : TextAttr := TextAttr AND $70 OR brown     OR (ord(Blinkflag)SHL 7);
      4 : TextAttr := TextAttr AND $70 OR blue      OR (ord(Blinkflag)SHL 7);
      5 : TextAttr := TextAttr AND $70 OR magenta   OR (ord(Blinkflag)SHL 7);
      6 : TextAttr := TextAttr AND $70 OR cyan      OR (ord(Blinkflag)SHL 7);
      7 : TextAttr := TextAttr AND $70 OR lightgray OR (ord(Blinkflag)SHL 7);
    end;
  end;

{----------------------------   M A I N   ----------------------------------}
Begin
  gotoxy (1,2);
  attralt      := textattr;
  doublerow:=false;
  for row:= 1 to 23 do begin
    Holdflag     := false;
    grafikflag   := false;
    blinkflag    := false;
    doubleflag:=false;
    textattr     := white  { schwarz/weiss} ;
    for col:= 0 to 39 do begin
      if grafikflag then
	cctc := chr(bit7pG[stranka[col,row]])
      else
	cctc := chr(bit7p[stranka[col,row]]);
      IF cctc >= ' ' THEN begin
	write(cctc);
	oldcctchr := cctc;
      end
      ELSE begin
	case ord(cctc) of
	 0..7,
	 16..23 : grafikflag:= ORD (cctc) AND $10 > 0;
	 30: Holdflag := true;
	 31: Holdflag := false;
	 28: Textattr := textattr AND $F; {black}
	 29: Textattr := (Textattr AND $F) or ((textattr shl 4) AND $70);
	end;
	 if holdflag and grafikflag then Write (oldcctchr) else
	  if holdflag then begin write(' '); oldcctchr:=' '; end;

	case ord(cctc) of
	 12: doubleflag:=false;
	 13: begin
	      if not doublerow then doubleflag:=true;
	      doublerow:=false;
	     end;
	end;

	if (not doublerow) and doubleflag then
	 begin
	  for col1:=0 to 39 do stranka[col1,row+1]:=stranka[col1,row];
	  doublerow:=true;
	 end;

	case ord(cctc) of
	  0..7,
	 16..23 : cctcolor;
	  8:begin
	      blinkflag:=true;
	      textattr:=textattr or 128;
	    end; { Blinken ein }
	  9: begin
	       blinkflag := false;
	       textattr := textattr and 127;
	     end;
	 24: if hidden then
		Textattr := textattr AND $F0 OR (textattr shr 4) AND $F7;
	end; {case}
	if not holdflag then  write (' ');
       end; {else}
    end;{col}
  end;{row}
End;{writeSeite}