unit _2d;

{
  ver 1.1  cut version

  Mefistofel
    (Костромин Кирилл)
  28.05.2010

  2d sprites/ GUI/ Text render
  Mouse Control

}

interface

uses
  Windows,
  OpenGL,
  _OpenGL,
  _Forms,
  _Font,
  _Geometry;

const
 panel_num = 30;
 TW = 1/16;
 TH = 1/8;
 FW = 0.32;
 FH = 0.64;
 FK = 0.32;

type
 TAct = procedure;
{$REGION 'TPanel'}
 TPanel = record
  Text:string;
  Point:TVect;
  Size:TVect;
  Group:byte;
  Visible:boolean;
  Checked:boolean;
  Active:boolean;
  Clicked:boolean;
  Action:TAct;
 end;
{$ENDREGION}

{$REGION 'TFont'}
 TFont = class
    private
    public
    base_Font:integer;
    Max_Font:integer;
    Texture:cardinal;
    W,H,Kern:Single;
    procedure Put_Text(Str:string;X,Y:single);overload;  {put text into Х У}
    procedure Put_Text(Str:string;Pt:TVect);overload;  {put text into Х У}
    constructor Create;
    procedure _Text(Str:string;X,Y:single);  {special put for menu - less code Х У}
 end;
{$ENDREGION}

{$REGION 'TMenu'}
 TMenu = class
   private
    procedure put(text:TPanel);
   public
    font:TFont;
    Shadowed:boolean;
    Visible_Group:byte;
    Panel:array [0..panel_num] of TPanel;
    constructor Create;
    function add_element(Text:string;X,Y:single;Group:byte):integer;overload;
    function add_element(Text:string;X,Y:single;Group:byte;Act:TAct):integer;overload;
    procedure Anim;
    procedure Render;
    function Check(Checked:boolean):integer;
   end;
{$ENDREGION}

function get_mouse():TVect;

var
 Menu:TMenu;
 DM:TVect;//mouse coords
 Finded:boolean = false;//all props founded
 Koef:TVect;//koef of real/ogl x,y
 TL:TVect;//screen top/left coords
 WH:TVect;//screen widht/heigth coords

implementation

{$REGION 'Find_Mouse'}
procedure Find_props();
var
 S:TCoord;
 P:TPoint;
begin
 P:=Point(1,1,0);
 S:=Point_To_Coord(P);
 Koef[0]:=S[0]-(PW/2);
 Koef[1]:=-S[1]+(PH/2);
 Koef[0]:=(PW)/Koef[0];
 Koef[1]:=(PH)/Koef[1];
 //find screen top/left and w/h in OGL coordinates
 TL[0]:=(-PW*0.5)/(PW)*Koef[0];
 TL[1]:=(-PH*0.5)/(PH)*Koef[1];
 WH[0]:=(PW*0.5)/(PW)*Koef[0];
 WH[1]:=(PH*0.5)/(PH)*Koef[1];
 WH:=minus(WH,TL);
 WH:=multi(WH,0.01);
 Finded:=true;
end;
// Found mouse coordinates (X,Y)
// in GL identity space Z=0;
function get_mouse:TVect;
var Ret:TVect;
begin
 if not Finded then
  Find_props;
 Ret[0]:=(MX-PW*0.5)/(PW)*Koef[0];
 Ret[1]:=(MY-PH*0.5)/(PH)*Koef[1];
 DM:=Ret;
 get_mouse:=Ret;
end;
{$ENDREGION}
{------------- font class -----------}
{$REGION 'gen texture'}
function GenTexture(Var pData: Pointer;Width: LongWord;Height: LongWord; var Texture: GLuint): Boolean;
begin
  if (Assigned(pData)) then
    Result := True
  else
  begin
    Result := False;
    exit;
  end;
  glGenTextures(1, @Texture);
  glBindTexture(GL_TEXTURE_2D, Texture);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);  //Texture blends with object background
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); // only first two can be used
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); // all of the above can be used
  glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, Width, Height, 0, GL_ALPHA, GL_UNSIGNED_BYTE, pData);  // Use when not wanting mipmaps to be built by openGL
end;
{$ENDREGION}

{$REGION 'Font_creation'}
constructor TFont.Create;
var
 i,j:cardinal; p:Pointer;
 b:byte;
 A:Array [0..128*128-1] of byte;
 T:TAlpha_Tex_Array;
begin
 //bites unpack
 for i:=0 to 127 do
  for j:=0 to 15 do
   begin
    b:=def_font[i*16+j];
    T[i*128+j*8+0]:=b>=128;  if b>=128 then b:=b-128;
    T[i*128+j*8+1]:=b>=64;   if b>=64  then b:=b-64;
    T[i*128+j*8+2]:=b>=32;   if b>=32  then b:=b-32;
    T[i*128+j*8+3]:=b>=16;   if b>=16  then b:=b-16;
    T[i*128+j*8+4]:=b>=8;    if b>=8   then b:=b-8;
    T[i*128+j*8+5]:=b>=4;    if b>=4   then b:=b-4;
    T[i*128+j*8+6]:=b>=2;    if b>=2   then b:=b-2;
    T[i*128+j*8+7]:=b>=1;    if b>=1   then b:=b-1;
   end;
 for i:=0 to 127 do
  for j:=0 to 127 do
   begin
    if not T[i*128+j] then
     A[i+j*128]:=255 else
     A[i+j*128]:=0;
   end;
 p:=@A;
 GenTexture(p,128,128,Texture);
 W:=FW;
 H:=FH;
 Kern:=FK;
end;
{$ENDREGION}

{$REGION 'put_text'}
procedure TFont.Put_Text(Str:string;X,Y:single);  {воткнуть текст в точке Х У}
Var i,num:integer;a,b,c:byte;s:Char;
begin
 {enable}
 glDisable(GL_Depth_Test);
 glEnable(GL_BLEND);
 glEnable(GL_TEXTURE_2D);
 glBindTexture(GL_Texture_2d,self.Texture);
 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 glPushMatrix();
 glLoadIdentity();
 _Text(Str,X,Y);
 glPopMatrix();
 glEnable(GL_Depth_Test);
end;

procedure TFont.Put_Text(Str:string;Pt:TVect);  {воткнуть текст в точке Х У}
Var i,num:integer;a,b,c:byte;s:Char;
begin
 {enable}
 glDisable(GL_Depth_Test);
 glEnable(GL_BLEND);
 glEnable(GL_TEXTURE_2D);   
 glBindTexture(GL_Texture_2d,self.Texture);
 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 glPushMatrix();
 glLoadIdentity();
 Pt:=plus(TL,Vector(pt[0]*WH[0],Pt[1]*WH[1]));//in percents
 _Text(Str,Pt[0],Pt[1]);
 glPopMatrix();
 glEnable(GL_Depth_Test);
end;
{$ENDREGION}

{$REGION 'spec_put'}
procedure TFont._Text(Str:string;X,Y:single);  {воткнуть текст в точке Х У}
Var i,num:integer;a,b,c:byte;s:Char;
begin
 {enable}
 for i:=1 to Length(Str) do
   begin
     s:=Str[i];
     c:=ord(s);
     case s of
     'A'..'P':begin a:=c-65;b:=0; end;
     'Q'..'Z':begin a:=c-81;b:=1; end;
     'a'..'p':begin a:=c-97; b:=2; end;
     'q'..'z':begin a:=c-113;b:=3; end;
     'А'..'П':begin a:=c-128;b:=4; end;
     'Р'..'Я':begin a:=c-144;b:=5; end;
     'а'..'п':begin a:=c-160;b:=6; end;
     'р'..'я':begin a:=c-176;b:=7; end;
     '0'..'4':begin a:=c-48+11;b:=1; end;
     '5'..'9':begin a:=c-48+6;b:=3; end;
     '.':begin a:=10;b:=1; end;
     '*':begin a:=10;b:=3; end;
     end;
     if s<>' ' then
     begin
       gltexcoord2f(a*TW   ,b*TH+TH); glvertex2f(x+  (-1+i)*Kern-Length(Str)/2*Kern,y);
       gltexcoord2f(a*TW+TW,b*TH+TH); glvertex2f(x+W+(-1+i)*Kern-Length(Str)/2*Kern,y);
       gltexcoord2f(a*TW+TW,b*TH);    glvertex2f(x+W+(-1+i)*Kern-Length(Str)/2*Kern,y+H);
       gltexcoord2f(a*TW   ,b*TH);    glvertex2f(x+  (-1+i)*Kern-Length(Str)/2*Kern,y+H);
     end;
   end;
end;
{$ENDREGION}
{------------- menu class -----------}
{$REGION 'Menu creation'}
constructor TMenu.Create;
begin
 Font:=TFont.Create;
end;
{$ENDREGION}

{$REGION 'put_text'}
procedure TMenu.put(text:TPanel);
begin
 glColor3f(0.1,0.1,0.1);
 Font._Text(text.Text,text.Point[0]+0.05,text.Point[1]-0.05);
 if Text.Checked then
  glColor3f(0.1,1,0.1) else
 glColor3f(1,1,1);
 Font._Text(text.Text,text.Point[0],text.Point[1]);
end;
{$ENDREGION}

{$REGION 'add_element'}
function TMenu.add_element(Text:string;X,Y:single;Group:byte):integer;
Var i:integer;vis:boolean;
begin
 vis:=false; 
 Get_Mouse;
 for i:=0 to panel_num do
  if (Panel[i].Text='') then
   begin
    vis:=true;{svobodnoye mesto naydeno}
    break;
   end;
 Panel[i].Text:=Text;   {addition of new Text element}
 Panel[i].Point:=plus(TL,Vector(X*WH[0],Y*WH[1]));//in percents
 Panel[i].Size:=Vector(Self.font.W+Length(Text)*Self.font.Kern,Self.font.H);
 Panel[i].Group:=Group;
 Panel[i].Visible:=false;
 Panel[i].Checked:=false;
 Panel[i].Active:=false;
 add_element:=i;
end;

function TMenu.add_element(Text:string;X,Y:single;Group:byte;Act:TAct):integer;
Var i:integer;
begin
 i:=add_element(Text,X,Y,Group);
 Panel[i].Action:=Act;
 add_element:=i;
end;
{$ENDREGION}

{$REGION 'Animation'}
procedure TMenu.Anim;
Var i:integer;
begin
 for i:=0 to panel_num do      {ne plavnaya animaciya}
  begin
   if (Panel[i].Group=Self.Visible_Group) then
     Panel[i].Visible:=true else           {if Text element in visible Group then make them visible}
    Panel[i].Visible:=false;
  end;
end;
{$ENDREGION}

{$REGION 'Render'}
procedure TMenu.Render;
Var i:integer;
begin
 Self.Anim;
 glDisable(GL_Depth_Test);
 glEnable(GL_BLEND);
 glEnable(GL_TEXTURE_2D);   
 glBindTexture(GL_Texture_2d,Font.Texture);
 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 glPushMatrix();
 glLoadIdentity();
 glBegin(Gl_Quads);
 for i:=0 to panel_num do               {drawning}
  if Panel[i].Visible then
   put(Panel[i]);
 glend;
 glPopMatrix();
 glEnable(GL_Depth_Test);
end;
{$ENDREGION}

{$REGION 'Check'}
function TMenu.Check(Checked:boolean):integer;
Var i,Action:integer;
begin
 Action:=0;
 glPushMatrix();
 glLoadIdentity();
 Get_Mouse;
 glPopMatrix();
 for i:=0 to panel_num do
  if Panel[i].Visible then
   if Point_in_Rect(DM,Panel[i].Point,plus(Panel[i].Point,Panel[i].Size)) then
    begin
     Panel[i].Checked:=true;
     Action:=i;
     if Checked then
     begin
      if Panel[i].Active and not Panel[i].clicked then
      begin
       Panel[i].Action();
       Panel[i].clicked:=true;
      end;
     end else
       Panel[i].clicked:=false;
    end else
     Panel[i].Checked:=false;
 Check:=Action;
end;
{$ENDREGION}

end.
