PROGRAM FONT_EDIT;      { Editor de fuentes en para GRAPH v2.0 }

USES  Crt;

CONST
   VGA  =  $A000;

VAR
  SizeX, SizeY,
  x, y, b : WORD;
  letra,
  color,
  modo    : BYTE;
  code    : Integer;
  fichero : File;

(***********   Funciones y procedimientos  ***********)

PROCEDURE InicMouse; Assembler;
ASM
  xor ax, ax
  int $33
  mov ax, 1
  int $33
  mov ax, 0fh
  mov cx, 8
  mov dx, 16
  int $33
  mov cx, 5
  mov dx, SizeX
  inc dx
  mov ax, 5
  mul dx
  mov dx, ax
  mov ax, 7
  int $33
  mov cx, 5
  mov dx, SizeY
  inc dx
  mov ax, 5
  mul dx
  mov dx, ax
  mov ax, 8
  int $33
END;

PROCEDURE ShowMouse; Assembler;
ASM
  mov ax, 1
  int $33
END;

PROCEDURE HideMouse; Assembler;
ASM
  mov ax, 2
  int $33
END;

PROCEDURE AskMouse(VAR x1, y1, b1:WORD);
 VAR
   a, b, c : WORD;
BEGIN
  ASM
    mov ax, 3
    int $33
    mov a, cx
    mov b, dx
    mov c, bx
  END;
  x1:=a; y1:=b; b1:=c;  { ¨Porque el TPascal no me deja hacer esto desde }
END;                    {  el propio c¢digo ensamblador?  }

PROCEDURE InicGraph; Assembler;
ASM
  mov ax, $13
  int $10
END;

PROCEDURE EndGraph; Assembler;
ASM
  mov ax, $3
  int $10
END;

PROCEDURE PonPixel(x1, y1:WORD; c:BYTE);
BEGIN
  Mem[VGA:y1*320+x1] := c;
END;

FUNCTION GetPixel(x1, y1:WORD) : BYTE;
BEGIN
  GetPixel := Mem[VGA:y1*320+x1];
END;

{ Dibuja una linea vertical muy r pidamente }
PROCEDURE VertLine(a, b, h:WORD; c:BYTE);
 VAR
  i : WORD;
BEGIN
  If a>b then
   BEGIN                {  Intercambia los valores  }
     i:=a;
     a:=b;
     b:=i;
   END;
  For i:=a to b DO
    PonPixel(h, i, c);
END;

{ Dibuja una linea horizontal muy r pidamente }
PROCEDURE HorzLine(a, b, h:WORD; c:BYTE);
 VAR
  i : WORD;
BEGIN
  If a>b then
   BEGIN                {  Intercambia los valores  }
     i:=a;
     a:=b;
     b:=i;
   END;
  For i:=a to b DO
    PonPixel(i, h, c);
END;

{ Dibuja la red donde se dibujaran los car cteres }
PROCEDURE DrawWeb(x1, y1:WORD);
 VAR
  i : WORD;
BEGIN
  i:=5;
  While i<5*(x1+2) DO
   BEGIN
     VertLine(5, 5*(y1+1), i, 15);
     Inc(i, 5);
   END;
  i:=5;
  While i<5*(y1+2) DO
   BEGIN
     HorzLine(5, 5*(x1+1), i, 15);
     Inc(i, 5);
   END;
END;

{ Dibuja un punto gordito }
PROCEDURE FatPixel(x1, y1:WORD; c1, c2:BYTE);
 VAR
   i1,
   i2 : WORD;
   c  : BYTE;
BEGIN
  HideMouse;
  If (x1<1) or (x1>SizeX) or (y1<1) or (y1>SizeY) then
   BEGIN
     Sound(300);
     Delay(35);
     NoSound;
   END
   Else
    BEGIN
      If GetPixel(5*x1+1, 5*y1+1)=c1 then
        c:=c2
      Else
        c:=c1;
      For i1:=1 to 4 DO
       For i2:=1 to 4 DO
         PonPixel(x1*5+i1, y1*5+i2, c);
    END;
  ShowMouse;
END;

PROCEDURE MuestraColor(c:BYTE);
 VAR
   i1,
   i2 : WORD;
BEGIN
  For i1:=1 to 40 DO
    For i2:=1 to 40 DO
      PonPixel(260+i1, 20+i2, c);
END;

PROCEDURE GuardaLetra;
 VAR
   i1,
   i2  : WORD;
   c1, c2, c3, c4, c5, c6, c7, c8,
   c   : Byte;
   buf : ARRAY [0..50*38] of Char;
   kk  : WORD;
   Cont: Integer;
BEGIN
  HideMouse;
  cont:=0;
  If modo=1 then                {  256 colores  }
   BEGIN
     For i2:=1 to SizeY DO
       For i1:=1 to SizeX DO
         BEGIN
           buf[(i2-1)*SizeX+i1-1]:=Char(GetPixel(5*(i1-1)+6, 5*(i2-1)+6));
         END;
     BlockWrite(fichero, buf, SizeX*SizeY);
   END;
  If modo=2 then                {  16  colores  }
   BEGIN
     For i2:=1 to SizeY DO
       For i1:=1 to SizeX DO
         BEGIN
           c1:=GetPixel(5*(i1-1)+6, 5*(i2-1)+6);
           c2:=GetPixel(5*(i1-1)+11, 5*(i2-1)+6);
           c:=(c1 SHL 4)+c2;
           buf[cont]:=Char(c);
           Inc(i1); Inc(cont);
         END;
     BlockWrite(fichero, buf, (SizeX*SizeY) DIV 2);
   END;
  If modo=4 then                {  4   colores  }
   BEGIN
     For i2:=1 to SizeY DO
       For i1:=1 to SizeX DO
         BEGIN
           c1:=GetPixel(5*(i1-1)+6, 5*(i2-1)+6);
           c2:=GetPixel(5*(i1-1)+11, 5*(i2-1)+6);
           c3:=GetPixel(5*(i1-1)+16, 5*(i2-1)+6);
           c4:=GetPixel(5*(i1-1)+21, 5*(i2-1)+6);
           c:=(c1 SHL 6)+(c2 SHL 4)+(c3 SHL 2)+c4;
           buf[cont]:=Char(c);
           Inc(i1, 3); Inc(cont);
         END;
     BlockWrite(fichero, buf, (SizeX*SizeY) DIV 4);
   END;
  If modo=8 then                {  2   colores  }
   BEGIN
     For i2:=1 to SizeY DO
       For i1:=1 to SizeX DO
         BEGIN
           c1:=GetPixel(5*(i1-1)+6, 5*(i2-1)+6);
           c2:=GetPixel(5*(i1-1)+11, 5*(i2-1)+6);
           c3:=GetPixel(5*(i1-1)+16, 5*(i2-1)+6);
           c4:=GetPixel(5*(i1-1)+21, 5*(i2-1)+6);
           c5:=GetPixel(5*(i1-1)+26, 5*(i2-1)+6);
           c6:=GetPixel(5*(i1-1)+31, 5*(i2-1)+6);
           c7:=GetPixel(5*(i1-1)+36, 5*(i2-1)+6);
           c8:=GetPixel(5*(i1-1)+41, 5*(i2-1)+6);
           c:=(c1 SHL 7)+(c2 SHL 6)+(c3 SHL 5)+(c4 SHL 4)+
              (c5 SHL 3)+(c6 SHL 2)+(c7 SHL 1)+c8;
           buf[cont]:=Char(c);
           Inc(i1, 7); Inc(cont);
         END;
     BlockWrite(fichero, buf, (SizeX*SizeY) DIV 8);
   END;
  ShowMouse;
END;

{  Funci¢n  Principal  }
{ Desde el DOS se la llama as¡:
     FNTEDIT  archivo  modo  tama¤oX  tama¤oY  }
BEGIN
  If ParamCount<>4 then
   BEGIN
     WriteLn;
     WriteLn('Uso:   FNTEDIT  <archivo>  <modo>  <Tama¤oX>  <Tama¤oY>');
     Halt(1);
   END;
  Val(ParamStr(2), modo, code);
  Val(ParamStr(3), SizeX, code);
  Val(ParamStr(4), SizeY, code);
  If (SizeY>38) or (SizeX>50) then
   BEGIN
     WriteLn;
     WriteLn('El n£mero m ximo de filas es 38 y el de columnas 50');
     Halt(2);
   END;
  If (modo<>1) and (modo<>2) and (modo<>4) and (modo<>8) then
   BEGIN
     WriteLn;
     WriteLn('Modos permitidos: 1, 2, 4 y 8');
     Halt(2);
   END;
  {$I-}                         {  Quitamos el I/O checking. }
  Assign(fichero, ParamStr(1));
  Reset(fichero, 1);
  {$I+}
  If IOResult=0 then
   BEGIN
     WriteLn('El fichero ya existe.');
     Close(fichero);
     Halt(1);
   END
  Else
    Rewrite(fichero, 1);        {  Creamos el fichero. }
  If SizeX MOD modo<>0 then
   BEGIN
     WriteLn('Tama¤o X no compatible con el tipo de fuente.');
     Close(fichero);
     Halt(3);
   END;

  InicGraph;
  DrawWeb(SizeX, SizeY);
  InicMouse;  
  color:=1;
  MuestraColor(color);

  While not KeyPressed DO
   BEGIN
     AskMouse(x, y, b);
     If b=1 then                {  Bot¢n izquierdo --> Dibujar p¡xel. }
      BEGIN
        x:=x SHR 1;             {  Adaptamos a la resoluci¢n 320x200. }
        x:=x DIV 5;
        y:=y DIV 5;             {  Averiguamos coordenadas de la malla. }
        FatPixel(x, y, color, 0);
        While b=1 DO
          AskMouse(x, y, b);    {  Esperamos a soltar el bot¢n. }
      END;
     If b=2 then                {  Bot¢n derecho --> Cambiar de color }
      BEGIN
        Inc(color);             {  Restringimos la visualizaci¢n de colores }
        If (modo=8) and (color>=2)  then color:=0;
        If (modo=4) and (color>=4)  then color:=0;
        If (modo=2) and (color>=16) then color:=0;
        MuestraColor(color);
        While b=2 DO
          AskMouse(x, y, b);    {  Esperamos a soltar el bot¢n. }
      END;
     If b=3 then                {  Los dos botones --> siguiente letra. }
      BEGIN
        GuardaLetra;
        If letra=255 then       {  En caso de que sea la £ltima letra. }
         BEGIN
           Close(fichero);
           EndGraph;
           WriteLn(' Todos los car cteres han sido guardados.');
           Halt(0);
         END;
        HideMouse;
        Inc(letra);
        InicGraph;              {  Reseteamos la pantalla. }
        DrawWeb(SizeX, SizeY);
        InicMouse;
        While b=3 DO
          AskMouse(x, y, b);    {  Esperamos a soltar el bot¢n. }
      END;
   END;

  {$I-}
  Close(fichero);
  HideMouse;
  EndGraph;
END.
