Листинг 2

unit Text256a;
interface

{...}

implementation
uses dos,graph,sprites;

{...}

var
   FontTable : array[0..255,0..7,0..7]of byte;
                                      {таблица шрифта}
   colorline,colorlineb:array[0..7]of byte;
             {массивы по 8 точек цветов символа и фона}
   LenLine  : longint;            {длина строки буфера}
   Color1,bkColor1 : byte;
            {номера ?стандартных? цветов текста и фона}
   Color2,bkColor2 : byte;
      {номера цветов текста и фона в выбранной палитре}
   TextType : byte; {способ вывода (прозрачно или нет)}
   i,j,l    : longint;     {вспомогательные переменные}

procedure SetTextParm(color,bkcolor,typetext:byte);
begin
   Color1   := color;
   bkColor1 := bkcolor;
   TextType := typetext;
   Color2   := Colors[Color1];
   bkColor2 := Colors[bkColor1];
   for i := 0 to 7 do colorline[i] := Color2;
   for i := 0 to 7 do colorlineb[i] := bkColor2;
end;

{...}

procedure putchar(x,y:longint; chr:char);
begin
   l := byte(chr);
   LenLine := GetBytesPerScanLine;
   case TextType of
      0:                { прозрачный фон }
        asm
           push edi
           push esi
           push ecx
           lea edi,colorline
           movq mm0,[edi]       {mm0-цвет}
           mov esi,scr
           add esi,x
           mov eax,y
           mul LenLine
           add esi,eax
           mov ecx,l
           lea edi,FontTable
           shl ecx,6
           add edi,ecx          {edi — маска символа}
           mov ecx,8
       @l3:                      { непрозрачный фон }
           movq mm3,[edi]
           movq mm1,[esi]        {mm1-фон}
           movq mm4,mm3
           add edi,8
           pand mm3,mm0


           pandn mm4,mm1
           por mm3,mm4
           movq [esi],mm3
           add esi,LenLine
           dec ecx
           jnz @l3
           pop ecx
           pop esi
           pop edi
           emms
        end;
      1:
        asm
           push edi
           push esi
           push ecx
           lea edi,colorline
           movq mm0,[edi]       {mm0-цвет}
           lea edi,colorlineb
           movq mm1,[edi]       {mm1-фон}
           mov esi,scr
           add esi,x
           mov eax,y
           mul LenLine
           add esi,eax
           mov ecx,l
           lea edi,FontTable
           shl ecx,6
           add edi,ecx
           mov ecx,8
       @l3:
           movq mm3,[edi]
           movq mm4,mm3
           add edi,8
           pand mm3,mm0
           pandn mm4,mm1
           por mm3,mm4
           movq [esi],mm3
           add esi,LenLine
           dec ecx
           jnz @l3
           pop ecx
           pop esi
           pop edi
           emms
        end;
   end;
end;

var r : registers;

begin  {инициализация — получаем адрес таблицы шрифтов}
   r.ax := $1130;
   r.bh := 3;
   intr($10,r);
   for l := 0 to 255 do   {перебор по символам}
      for i := 0 to 7 do
         for j := 0 to 7 do
            if (mem[r.es:r.bp + i + l*8] and
                               (1 shl (7-j)) <> 0) then
               FontTable[l,i,j] := $ff
            else FontTable[l,i,j] := 0;
   SetTextParm(15,0,1);
end.