Archeology Lost mementos from another age...

De parte del señor alcalde se hace saber que:
El autor no asume ninguna responsabilidad por el uso o alteracion de este software. El autor no garantiza de ninguna forma su funcionamiento y en ningun caso sera el autor responsable de daños o perjuicios que se deriven del mal uso del software, aun cuando este haya sido notificado de la posibilidad de dicho daño.

Dicho lo dicho, a por la chicha:

Bueno, pos os presento el programa, que es un poco cutre y esta capado en muchos sentidos. ¿Pero para que me voy a molestar en hacer un interface que te pida el nombre de los ficheros si es otra cosa lo que quiero mostrar?. Dicho esto comento el programa: Parte de una imagen TGA (la informacion de las imagenes TGA va de regalo) y a partir de esta la copia invertida a su lado. Y a partir de esta ultima la copia invertida abajo. Con esto queda claro que no valdra cualquier fondo, tendra que ser uno mas o menos uniforme, de todas formas ya os dareis cuenta en el caso de que lo probeis. Ahora que lo sabeis direis ¡Que chorrada de algoritmo!. Suele pasar, en fin....

P.D.: Compilado con Turbo pascal v7.0 fonfona. Los TGA han de ser en 256 colores sin comprimir.

Program Conti_TGA;

{INFO: Los colores almacenados BGR no RGB}


uses
    crt,dos;
const
    FICHE='Ficheroorigen.tga';
    FICHEc='Ficherodestino.tga';
type
    tipopal=array[0..255,1..3] of byte;
    linea=array [1..640] of byte;
var
    Idlen :byte; {Tamaño de la informaciñn adiccional}
    CMtype :byte; {0 -> No hay paleta. 1 -> Si}
    Imtype :Byte; {0 -> No hay datos imagen
          1 -> Sin comprimir y con paleta
          2 -> RGB sin comprimir
          3 -> Escala de grises sin comprimir
          9 -> Comprimido RLE y con paleta
          10 -> RGB comprimido con RLE
          11 -> Escala grises comprimido RLE
          32 -> Comprimido Huffman con paleta
          33 -> Comprimido Huffman cuadruple pasada con paleta}
    Cmorg :integer; {Valor primer indice de la paleta; =0 si existe paleta}
    Cmcnt :integer; {Nº elementos paleta. Debe valer 256}
    cmsiz :byte; {Nº bits por elemento paleta}
    Imxorg :Integer; {Coor. horizontal esquina inf. izquierda}
    Imyorg :integer; {Coor. vertical esquina inf. izquierda}
    Imwidth :Integer; {Ancho imagen}
    Imheight :Integer; {Alto imagen}
    Imwidth2 :Integer; {Ancho imagen}
    Imheight2 :Integer; {Alto imagen}
    Imdepth :byte; {Bits por pixel (8,15,16,24 ¢ 32)}
    Imdesc :byte; {BITS 0-3: bits de overlay (0000,0001,1000)
          4 : 1 -> Imagen de derecha a izq.
          5 : 1 -> Imagen de abajo a arriba
          6-7: 01 -> Imagen entrelazada}

    f,fc:file;
    Comentario:array[0..255] of char;
    Tamcabe:word;
{******************************}

Procedure Gracioso;

    begin
      clrscr;
      write(' Preparate para tener un nuevo concepto de grafico...');
      delay(5000);
      write(' ¿Ta gustao tontolhaba?');
      halt;
    end;


Procedure voltea(v1:linea;var v2:linea;tama:Integer);
    var
      cont:word;

    begin
      for cont:=1 to tama do
        v2[tama+1-cont]:=v1[cont];
    end;


Procedure Normal;
    var
      paleta:tipopal;
      aux:byte;
      x1,val1,val2:word;
      incre:byte;
      AUXVEC,volvec:linea;
      k:char;
    begin
      blockread(f,paleta,sizeof(paleta));
      blockwrite(fc,paleta,sizeof(paleta));
      tamcabe:=tamcabe+sizeof(paleta);
      for x1:=imheight downto 1 do
        begin
          Seek(f,tamcabe+(x1-1)*imwidth);
          blockread(f,auxvec,imwidth);
          blockwrite(fc,auxvec,imwidth);
          voltea(auxvec,volvec,imwidth);
          blockwrite(fc,volvec,imwidth);
          write(x1);
        end;
      Seek(f,tamcabe);
      for x1:=1 to imheight do
        begin
          blockread(f,auxvec,imwidth);
          blockwrite(fc,auxvec,imwidth);
          voltea(auxvec,volvec,imwidth);
          blockwrite(fc,volvec,imwidth);
          write(x1);
        end;
    end;



Procedure Cabecera;

    begin
      blockread(f,idlen,sizeof(idlen));
      blockwrite(fc,idlen,sizeof(idlen));
      Tamcabe:=tamcabe+sizeof(idlen);
      blockread(f,cmtype,sizeof(cmtype));
      blockwrite(fc,cmtype,sizeof(cmtype));
      Tamcabe:=tamcabe+sizeof(Cmtype);
      blockread(f,imtype,sizeof(imtype));
      blockwrite(fc,imtype,sizeof(imtype));
      Tamcabe:=tamcabe+sizeof(imtype);
      blockread(f,cmorg,sizeof(cmorg));
      blockwrite(fc,cmorg,sizeof(cmorg));
      Tamcabe:=tamcabe+sizeof(cmorg);
      blockread(f,cmcnt,sizeof(cmcnt));
      blockwrite(fc,cmcnt,sizeof(cmcnt));
      Tamcabe:=tamcabe+sizeof(cmcnt);
      blockread(f,cmsiz,sizeof(cmsiz));
      blockwrite(fc,cmsiz,sizeof(cmsiz));
      Tamcabe:=tamcabe+sizeof(cmsiz);
      blockread(f,imxorg,sizeof(imxorg));
      blockwrite(fc,imxorg,sizeof(imxorg));
      Tamcabe:=tamcabe+sizeof(imxorg);
      blockread(f,imyorg,sizeof(imyorg));
      blockwrite(fc,imyorg,sizeof(imyorg));
      Tamcabe:=tamcabe+sizeof(imyorg);
      blockread(f,imwidth,sizeof(imwidth));
      Imwidth2:=Imwidth*2;
      blockwrite(fc,imwidth2,sizeof(imwidth));
      Tamcabe:=tamcabe+sizeof(imwidth);
      blockread(f,imheight,sizeof(imheight));
      Imheight2:=Imheight*2;
      blockwrite(fc,imheight2,sizeof(imheight));
      Tamcabe:=tamcabe+sizeof(imheight);
      blockread(f,imdepth,sizeof(imdepth));
      blockwrite(fc,imdepth,sizeof(imdepth));
      Tamcabe:=tamcabe+sizeof(imdepth);
      blockread(f,imdesc,sizeof(imdesc));
      blockwrite(fc,imdesc,sizeof(imdesc));
      Tamcabe:=tamcabe+sizeof(imdesc);
      if idlen>0 then
        begin
          blockread(f,Comentario,idlen);
          blockwrite(fc,Comentario,idlen);
          Tamcabe:=tamcabe+idlen;
        end;
      case imtype of
        0:Gracioso;
        1:Normal;
      end;
    end;





begin
    Tamcabe:=0;
    assign(f,fiche);
    assign(fc,fichec);
    reset(f,1);
    rewrite(fc,1);
    Cabecera;
end.