{$MODE OBJFPC}
{$ASMMODE INTEL}

{DEFINE USE_PAS}
unit VenomTTF;
interface
uses venomGFX,tools,{vipgfx,}FreeType,TTTypes;

type

      ttfFont=record
              face     : TT_Face;
              instance : TT_Instance;
              charMap  : TT_CharMap;
              CharList:array of record
                                    charNumber:dword;
                                    CharImage:gfxImage;
                                    yoffset:integer;
                                end;
              maxCharWidth:integer;
              maxCharHeight:integer;
              fontSize:integer;
             end;


procedure initTTF;
procedure closeTTF;

procedure ttfCreateFont(const fname: string; h: integer; var theFont: ttfFont);

procedure ttfCloseFont(var theFont: ttfFont);

procedure ttfPrintStringXY(where:gfxImage; theFont: ttfFont; posX, posY: longint; color: dword; s: string);

procedure ttfGetStringSize(theFont:ttfFont; s: string; var sizeX, sizeY: longint);



implementation
uses sysutils,math;

procedure initTTF;
begin
   if TT_Init_FreeType <> TT_Err_Ok then gfxError('FT_Init_FreeType failed');
end;

procedure closeTTF;
begin
   TT_Done_FreeType;
end;

procedure createChars(var theFont: ttfFont);
var
  x, y: integer;
  glyph: TT_Glyph;
  col: dword;
  metrics: TT_Glyph_Metrics;
  Bit: TT_Raster_Map;
  ft_charnum: dword;
  xmin, ymin: integer;
  curchar: dword;
  i: word;
  b: byte;
begin

  if TT_New_Glyph(theFont.face, glyph) <> TT_Err_Ok then gfxError('TT_New_Glyph failed');

  for i:=0 to $ffff do begin

    ft_charnum:= TT_Char_Index(theFont.charmap,i);

    if ft_charnum = 0 then continue;

    curchar:= length(theFont.CharList);

    setlength(theFont.CharList, curchar+1);




    if TT_Load_Glyph(theFont.instance, glyph, ft_charnum, TT_Load_Scale_Glyph or TT_Load_Hint_Glyph ) <> TT_Err_Ok then gfxError('FT_Load_Glyph failed');

    if TT_Get_Glyph_Metrics(glyph, metrics) <> TT_Err_Ok then gfxError('TT_Get_Glyph_Metrics failed');

    Bit.rows:= round(metrics.bbox.ymax / (1 shl 6) - metrics.bbox.ymin / (1 shl 6));
    Bit.cols:= round(metrics.bbox.xmax / (1 shl 6));
    Bit.width:= round(metrics.bbox.xmax / (1 shl 6));
    Bit.flow:= TT_Flow_Down;
    Bit.size:= (Bit.width + 1) * Bit.rows;
    GetMem(Bit.buffer, Bit.size);
    fillchar(Bit.buffer^, Bit.size, 0);


    xmin:= metrics.bbox.xMin and -64;
    ymin:= metrics.bbox.yMin and -64;

    TT_Get_Glyph_Pixmap(glyph, Bit,-xmin, -ymin);

    if theFont.maxCharWidth < bit.width then theFont.maxCharWidth:= bit.width;
    if theFont.maxCharHeight < bit.rows then theFont.maxCharHeight:= bit.rows;

    theFont.CharList[length(theFont.CharList) - 1].charNumber:=i;

    allocimage(theFont.CharList[curchar].CharImage, bit.width, bit.rows);

    for y:=0 to bit.rows-1 do
    for x:=0 to bit.cols-1 do begin
      b:=byte((pointer(bit.buffer) + y * bit.width + x)^);
      b:=b * 8;

      col:=rgba(b, b, 255, b);
      putpixel(theFont.CharList[curchar].charimage, x, y, col);
    end;



    if bit.rows = 0 then begin
      theFont.charlist[length(theFont.CharList)-1].charimage.width:= round(metrics.advance / (1 shl 6));
    end;

    theFont.charlist[length(theFont.CharList)-1].yoffset:= ((0 - bit.rows) - (round(metrics.bearingY / (1 shl 6)) - bit.rows));

    freemem(Bit.buffer);

  end;

  TT_Done_Glyph(glyph);

end;



procedure ttfCreateFont(const fname: string; h: integer; var theFont: ttfFont);
var
  psize : integer;
  props : TT_Face_Properties;
begin
  psize:= h;


  if TT_Open_Face(fname, theFont.face) <> TT_Err_Ok then gfxError('FT_New_Face failed (there is probably a problem with your font file)');

  if TT_Get_Face_Properties(theFont.face, props) <> TT_Err_OK then gfxError('TT_Get_Face_Properties failed');

  if TT_New_Instance(theFont.face, theFont.instance) <> TT_Err_Ok then gfxError('TT_New_Instance failed');

  if TT_Set_Instance_Resolutions(theFont.instance, psize, psize) <> TT_Err_OK then gfxError('TT_Set_Instance_Resolutions failed');

  if TT_Set_Instance_PointSize(theFont.instance, psize) <> TT_Err_OK  then gfxError('TT_Set_Instance_PointSize failed');


{
  for i:= 0 to TT_Get_CharMap_Count(theFont.face) do begin

      TT_Get_CharMap_ID( theFont.face, i, platform, encoding );
      if ( (platform = 3) and (encoding = 1 )  or (platform = 0) and (encoding = 0 ) ) then begin

        TT_Get_CharMap( theFont.face, i, theFont.charmap );
        break;
      end;

  end;
}

  TT_Get_CharMap(theFont.face, 0, theFont.charmap);

  thefont.fontsize:= psize;
  theFont.maxCharWidth:= 0;
  theFont.maxCharHeight:= 0;

  createChars(theFont);

end;







procedure ttfCloseFont(var theFont: ttfFont);
var i:dword;
begin
  TT_Close_Face(theFont.face);

  for i:=0 to length(theFont.charlist) - 1 do freeImage(theFont.charlist[i].charimage);
end;




function getCharIndex(s: string; var offset: dword; theFont: ttfFont): dword;
label ll,Lonebyte;
var
    i, ii, t : dword;
    s1 : string;
    s2 : widestring;
    d : word;
begin

  i:= offset;
  s1:= s[i];

  // one byte
  if ord(s1[1]) < $c2 then begin
    d:= ord(s1[1]);
    goto Lonebyte;
  end;

  // two bytes
  for t:=$c2 to $df do begin
    if s1[1] = char(t) then begin
      inc(i);
      s1:= s1 + s[i];
      goto ll;
    end;
  end;

  // three bytes
  for t:=$e0 to $ef do begin
    if s1[1] = char(t) then begin
      inc(i);
      s1:= s1 + s[i];
      inc(i);
      s1:= s1 + s[i];
      goto ll;
    end;
  end;

  // forth bytes
  for t:=$f0 to $ff do begin
    if s1[1] = char(t) then begin
      inc(i);
      s1:= s1 + s[i];
      inc(i);
      s1:= s1 + s[i];
      inc(i);
      s1:= s1+s[i];
      goto ll;
    end;
  end;

ll:


  s2:=utf8decode(s1);


  d:=dword(s2[1]);


Lonebyte:

  offset:= i;

  for ii:=0 to length(theFont.CharList) - 1 do
    if theFont.CharList[ii].charNumber = d then begin
      result:= ii;
      exit;
    end;


  result:= 0;

end;


{$IFNDEF CPUAARCH64}

{$IFNDEF USE_PAS}

{$IFDEF CPU64}
procedure ttfPrintStringXY(where: gfxImage; theFont: ttfFont; posX, posY: longint; color: dword; s: string);
var
    xoffset : integer;
    x, y: integer;
    col, col1, col2, col3 : dword;
    gradient : single;
    stringheight : longint;
    i, ch : dword;

    yofs : qword;
    image_data, image_width, image_hieght : qword;
    rr, gg, bb, aa : int64;
    r, r1, r2, g, g1, g2, b, b1, b2, Alphanot, a, a1, a2:byte;
begin
  if length(s) < 1 then exit;

  xoffset:= 0;
  i:= 0;

  stringheight:= theFont.maxCharHeight;

  repeat

    inc(i);

    ch:=getCharIndex(s, i, theFont);

    if theFont.charlist[ch].charImage.height > 0 then begin

            image_data:= qword(theFont.charlist[ch].charImage.data);
            image_width:= theFont.charlist[ch].charImage.width;
            image_hieght:= theFont.charlist[ch].charImage.height;

            yofs:= theFont.charlist[ch].yoffset;

            asm
              mov rax,0
              mov y,rax
          @YLoop:
              mov rax,0
              mov x,rax
          @XLoop:
              mov eax,y
             imul rax,image_width
              add eax,x
              shl rax,2
              add rax,image_data
              mov edx,dword ptr [rax]

              mov col1,edx


              cmp edx,0
               jz @quit


              mov eax,col1
              shr eax,16
              and eax,$ff
              mov rr,rax

              mov aa,255

            finit
             fild rr
             fild aa
            fdivp st(1),st(0)

              xor rax,rax
              mov aa,rax
              mov rr,rax
              mov gg,rax
              mov bb,rax

              mov eax,color
              mov byte ptr [bb],al
              mov byte ptr [gg],ah
              shr eax,16
              mov byte ptr [rr],al
              mov byte ptr [aa],ah

              fld st(0)
             fild rr
            fmulp
          frndint
            fistp rr
              fld st(0)
             fild gg
            fmulp
          frndint
            fistp gg
              fld st(0)
             fild bb
            fmulp
          frndint
            fistp bb
              fld st(0)
             fild aa
            fmulp
          frndint
            fistp aa

              mov rcx,rr
              mov rdx,gg
              mov r8,bb
              mov r9,aa
              mov al,cl
              mov cl,r9b
              mov ah,cl
              mov ch,dl
              mov cl,r8b
              shl eax,16
              mov ax,cx
              mov col3,eax

              mov edx,posx
              add edx,xoffset
              add edx,x

              mov r8d,where.width

              cmp edx,r8d
               ja @quit

              mov ecx,posy
              add ecx,yofs
              add ecx,y
              add ecx,stringheight

              mov r9d,where.height
              cmp ecx,r9d
               ja @quit

             imul ecx,r8d
              add ecx,edx
              shl ecx,2
              add rcx,where.data
              mov eax, [rcx]
              mov col2,eax

             push rbx

              mov cl,aa
              mov eax,col3
              mov edx,col2
              mov a,cl

              mov rbx,255
              sub rbx,rcx
              mov Alphanot,bl

              mov eax,col3
              mov b1,al
              mov g1,ah
              shr eax,16
              mov r1,al
              mov a1,ah
              mov eax,col2
              mov b2,al
              mov g2,ah
              shr eax,16
              mov r2,al
              mov a2,ah

// ALPHA g:=((g1*Alpha)+(g2*AlphaNot)) shr 8;
              xor rax,rax
              add al,r1
              xor rdx,rdx
              add dl,a
             imul rax,rdx
              xor rdx,rdx
              add dl,r2
              xor rcx,rcx
              add cl,Alphanot
             imul rdx,rcx
              add rax,rdx
              shr rax,8
              mov r,al

              xor rax,rax
              add al,g1
              xor rdx,rdx
              add dl,a
             imul rax,rdx
              xor rdx,rdx
              add dl,g2
              xor rcx,rcx
              add cl,Alphanot
             imul rdx,rcx
              add rax,rdx
              shr rax,8
              mov g,al

              xor rax,rax
              add al,b1
              xor rdx,rdx
              add dl,a
             imul rax,rdx
              xor rdx,rdx
              add dl,b2
              xor rcx,rcx
              add cl,Alphanot
             imul rdx,rcx
              add rax,rdx
              shr rax,8
              mov b,al

              xor rax,rax
              add al,a1
              xor rdx,rdx
              add dl,a
             imul rax,rdx
              xor rdx,rdx
              add dl,a2
              xor rcx,rcx
              add cl,Alphanot
             imul rdx,rcx
              add rax,rdx
              shr rax,8
              mov a,al

              pop rbx


              xor rcx,rcx
              mov cl,r
              xor rdx,rdx
              mov dl,g
              xor r8,r8
              mov r8b,b
              xor r9,r9
              mov r9b,a
              mov al,r
              mov cl,a
              mov ah,cl
              mov ch,g
              mov cl,b
              shl eax,16
              mov ax,cx
              mov col,eax


              mov edx,posx
              add edx,xoffset
              add edx,x

              mov r8d,where.width

              cmp edx,r8d
               ja @quit

              mov ecx,posy
              add ecx,yofs
              add ecx,y
              add ecx,stringheight

              mov r9d,where.height
              cmp ecx,r9d
               ja @quit

             imul ecx,r8d
              add ecx,edx
              shl ecx,2
              add rcx,where.data
              mov [rcx],eax

           @quit:

              inc x
              mov eax,x
              cmp eax,image_width
               jb @XLoop

              inc y
              mov eax,y
              cmp eax,image_hieght
               jb @YLoop

              mov eax,xoffset
              add eax,image_width
              mov xoffset,eax
            end;

    end else begin
      xoffset:= xoffset + theFont.charlist[ch].charImage.width;
    end;

until i >= length(s);


end;



{$ENDIF}


{$IFDEF CPU32}
{$DEFINE USE_PAS}
{$ENDIF}
{$ENDIF}
{$ENDIF}

{$IFDEF USE_PAS}
procedure ttfPrintStringXY(where : gfxImage; theFont : ttfFont; posX, posY : longint; color : dword; s : string);
var
    xoffset : integer;
    x, y : integer;
    col, col1, col2, col3 : dword;
    gradient : single;
    r, g, b, a : byte;
    stringheight : longint;
    i, ch : dword;
begin

  if length(s) < 1 then exit;

  xoffset:= 0;
  i:= 0;

  stringheight:= theFont.maxCharHeight;

  repeat


    inc(i);

    ch:= getCharIndex(s, i, theFont);

    if theFont.charlist[ch].charImage.height > 0 then begin



        for y:= 0 to theFont.charlist[ch].charImage.height-1 do
          for x:= 0 to theFont.charlist[ch].charImage.width-1 do begin

            col1:= getpixel(theFont.charlist[ch].charImage, x, y);

            if col1 = 0 then continue;

            getRGBA(col1, r, g, b, a);

            gradient:= r / 255;

            getRGBA(color, r, g, b, a);

            r:= round(r * gradient);
            g:= round(g * gradient);
            b:= round(b * gradient);
            a:= round(a * gradient);

            col3:= RGBA(r, g, b, a);
            col2:= getpixelclip(where,posX + xoffset + x,posY + theFont.charlist[ch].yoffset + y + stringheight);
            col:= alpha(col3, col2, a);

            if a <> 0 then putpixelclip(where, posX + xoffset + x,posY + theFont.charlist[ch].yoffset + y + stringheight, col);
        end;


      xoffset:= xoffset + theFont.charlist[ch].charImage.width;



  end else begin
      xoffset:= xoffset + theFont.charlist[ch].charImage.width;
    end;

until i >= length(s);


end;

{$ENDIF}

procedure ttfGetStringSize(theFont : ttfFont; s : string; var sizeX, sizeY : longint);
var i : dword;
  	xoffset : dword;
  	ch : longint;
begin
  sizeX:= 0;
  sizeY:= 0;

  if length(s) < 1 then exit;

  xoffset:= 0;
  i:= 0;
  repeat

    inc(i);

    ch:= getCharIndex(s, i, theFont);

    xoffset:= xoffset+theFont.charlist[ch].CharImage.width;

  until i >= length(s);

  sizeX:= xoffset;
  sizeY:= theFont.maxCharHeight;

end;



begin
end.
