DEMO.DESIGN
Frequently Asked Questions
 
оглавление | demo party в ex-СССР | infused bytes e-mag | новости от ib/news | другие проекты | письмо | win koi lat

следующий фpагмент (2)
Program TIFFViewer; Uses Strings,Crt,Dos,VESA; Const { TIFF sizes } TIFFByte = 1; TIFFASCII = 2; { PChar type string } TIFFShort = 3; { Word } TIFFLong = 4; TIFFRational = 5; { 1st Long / 2nd Long } { TIFF compression types (2-4 are monochrome only) } CompNone = 1; { Simple uncompressed image } CompHuff = 2; { CCITT Group 3, 1-Dimensional Modified Huffman RLE } CompFax3 = 3; CompFax4 = 4; CompLZW = 5; { GIF style LZW compression } CompWrdL = $8003; { Word aligned image } CompPakB = $8005; { PackBits RL encoding } Type PStrip=^TStrip; { we make a list of strips } TStrip=Record num : Word; { which strip it is } loc : LongInt; { location of the strip in the file } size : LongInt; { size of the strip in bytes } next : PStrip; { Next strip in list } End; PByte=^Byte; Var Format : Boolean; { True if Intel format, False if Motorola format } fl : File; name : Array[0..63] Of Char; data,tagnum : Word; offset,maxstp : LongInt; Strips : PStrip; width,height : Word; palette : Array[0..767] Of Byte; spp,bps,comp : Word; { samples per pixel, bits per sample, compression methold } photo,ns,rps : Word; { Photometric interpretation, no. of strips, rows per strip } buf : PByte; Function GetWord(Var f:File):Word; Var temp:Word; Begin BlockRead(f,temp,2); If Not(Format) Then temp:=Swap(temp); GetWord:=temp; End; Function GetLong(Var f:File):LongInt; Var temp:LongInt; Begin BlockRead(f,temp,4); If Not(Format) Then GetLong:=((temp And $FF000000)Shr 24)+((temp And $FF0000)Shr 8)+ ((temp And $FF00)Shl 8)+((temp And $FF)Shl 24) Else GetLong:=temp; End; Function Power(base,index:Word):LongInt; Var i:Word; t:LongInt; Begin t:=base; For i:=1 To index-1 Do t:=t*base; Power:=t; End; Function GetStr(slength,foffset:LongInt):String; Var strng:Array[0..255] Of Char; curpos:LongInt; Begin If slength>256 Then slength:=256; curpos:=FilePos(fl); Seek(fl,foffset); BlockRead(fl,strng,slength); Seek(fl,curpos); GetStr:=StrPas(strng); End; Function GetRational(foffset:LongInt):Real; Var n,d,curpos:LongInt; Begin curpos:=FilePos(fl); Seek(fl,foffset); n:=GetLong(fl); d:=GetLong(fl); GetRational:=n/d; Seek(fl,curpos); End; Procedure GetStripOffsets(len,off:LongInt); Var curpos : LongInt; i : Word; temp,last : PStrip; Begin curpos:=FilePos(fl); Seek(fl,off); ns:=len; For i:=1 To len Do Begin New(temp); temp^.num:=i; temp^.size:=0; temp^.loc:=GetLong(fl); temp^.next:=Nil; If i=1 Then Strips:=temp Else last^.next:=temp; last:=temp; End; Seek(fl,curpos); End; Procedure GetStripSize(len,off:LongInt); Var curpos : LongInt; i : Word; temp : PStrip; Begin curpos:=FilePos(fl); Seek(fl,off); temp:=Strips; If (temp=Nil)Or(ns<>len) Then Begin Writeln('Error in TIFF file'); Close(fl); Halt; End; For i:=1 To len Do Begin temp^.size:=GetLong(fl); If temp^.size>maxstp Then maxstp:=temp^.size; { Find largest strip } temp:=temp^.Next; End; Seek(fl,curpos); End; Procedure GetPalette(len,off:LongInt); Var curpos : LongInt; i,j,c : Word; Begin curpos:=FilePos(fl); Seek(fl,off); c:=(len Div 3)-1; For i:=0 To 2 Do For j:=0 To c Do palette[j*3+i]:=GetWord(fl) Shr 10; { Convert 48 bit colour to 18 bit VGA colour } Seek(fl,curpos); End; Procedure ShowImage256(buffer:PByte); Assembler; Var handle,bank,rows,i,dseg,btg,wide : Word; loc,size : LongInt; next : Pointer; Asm Mov dseg,ds Mov bank,0 Mov bx,width Mov wide,bx Mov ax,VesaMode.Bytes Sub ax,bx Mov btg,ax Mov es,VesaMode.SegA Xor di,di Mov ax,$3D00 Mov dx,offset name Int $21 { Open the file for assembler } Jc @Ex Mov handle,ax Lds si,Strips Mov ax,[si+2] Mov loc.Word[0],ax Mov ax,[si+4] Mov loc.Word[2],ax Mov ax,[si+6] Mov size.Word[0],ax Mov ax,[si+8] Mov size.Word[2],ax Mov ax,[si+10] Mov next.Word[0],ax Mov ax,[si+12] Mov next.Word[2],ax Mov ds,dseg Mov i,0 @Bgn: Mov bx,handle Mov ax,$4200 Mov cx,loc.Word[2] Mov dx,loc.Word[0] Int $21 { Seek to image location } Mov bx,handle Mov cx,size.Word[0] Lds si,buffer Mov dx,si Mov ah,$3F Int $21 Push ds Mov ds,dseg Mov ax,rps Mov rows,ax Cmp comp,1 Pop ds Je @0S { PackBits compressed TIFF } @1S: Xor dx,dx { Set DX as the width count } @10: Xor ah,ah { Clear upper byte } Lodsb { Get "index" byte } Test al,$80 { See if high bit is set } Jz @14 { Jump if following is a string } { Repeat byte } Neg al { count = -index } Inc ax Mov cx,ax Add dx,cx Lodsb { Load data to repeat "index" times } Mov bx,di Add bx,cx Jc @12 @1A: Mov ah,al Shr cx,1 Jnc @1B Stosb @1B: Rep Stosw Jmp @20 @12: Stosb { Draw byte to screen } Or di,di { Check to see if line crosses bank } Jnz @13 Inc bank { Change bank if crossed } Call @B1 @13: Loop @12 { Store all repeated bytes } Jmp @20 { Dump string } @14: Inc ax { bytes in string = index + 1 } Mov cx,ax Add dx,cx Mov ax,di Add ax,cx Jnc @17 @15: Movsb { Transfer string to screen } Or di,di Jnz @16 { bank checking } Inc bank Call @B1 @16: Loop @15 { Repeat for string } Jmp @20 @17: Shr cx,1 Jnc @18 Movsb @18: Rep Movsw @20: Cmp dx,wide Jne @10 Add di,btg { Move screen pointer to start of line } Jnc @23 { Jump if not crossed bank } Inc bank { Update bank if crossed } Call @B1 @23: Dec rows { Update line count } Jnz @1S { Jump to start if not end of the image } Jmp @NS { Exit if image drawn } { Un-compressed TIFF } @0S: Mov cx,wide Mov ax,di Add ax,cx Jc @03 { Jump if line crosses bank } Shr cx,1 Jnc @01 Movsb @01: Rep Movsw { Show line } Add di,btg Jnc @02 Inc bank { See if line above is in another bank } Call @B1 @02: Dec rows Jnz @0S Jmp @NS @03: Movsb Or di,di Jnz @05 Inc bank Call @B1 @05: Loop @03 Add di,btg Jnc @06 Inc bank Call @B1 @06: Dec rows Jnz @0S @NS: Lds si,next Mov ax,[si+2] Mov loc.Word[0],ax Mov ax,[si+4] Mov loc.Word[2],ax Mov ax,[si+6] Mov size.Word[0],ax Mov ax,[si+8] Mov size.Word[2],ax Mov ax,[si+10] Mov next.Word[0],ax Mov ax,[si+12] Mov next.Word[2],ax Mov ds,dseg Inc i Mov ax,i Cmp ax,ns Jne @Bgn Jmp @Ex { Set bank } @B1: Push ax Push ds Mov ds,dseg Mov al,vesaon Or al,al Jz @B3 Push bx Push dx Mov dx,bank Xor bx,bx Mov ax,64 Mul dx Div VesaMode.Gran Mov dx,ax Push dx Call VesaMode.WinFunc Pop dx Inc bx Call VesaMode.WinFunc Pop dx Pop bx @B3: Pop ds Pop ax RetN @Ex: Mov bx,handle { Close the file } Mov ah,$3E Int $21 End; Procedure ShowImage16; Assembler; Asm End; Procedure ShowImage; Var r : Registers; Begin SetMode($101); r.ax:=$1012; r.bx:=0; r.cx:=256; r.dx:=Ofs(palette); r.es:=Seg(palette); Intr($10,r); { Set palette } GetMem(buf,maxstp); If bps=8 Then ShowImage256(buf) Else If bps=4 Then ShowImage16; FreeMem(buf,maxstp); Sound(660); Delay(100); Sound(880); Delay(50); Sound(440); Delay(75); NoSound; ReadKey; SetMode(3); End; Procedure ReadTag; Var tag,typ : Word; len,off : LongInt; Begin tag:=GetWord(fl); typ:=GetWord(fl); len:=GetLong(fl); off:=GetLong(fl); If (Not Format)And(typ=TIFFByte)And(len=1) Then off:=off Shr 24; If (Not Format)And(typ=TIFFShort)And(len=1) Then off:=off Shr 16; Case tag Of 254 : Writeln(tagnum:2,' - New Subfile Type: ',off); { New Subfile type } 255 : Writeln(tagnum:2,' - Old Subfile Type (obsolete): ',off); { Subfile type } 256 : Begin Writeln(tagnum:2,' - Image width = ',off,' pixels'); width:=off; End; 257 : Begin Writeln(tagnum:2,' - Image height = ',off,' pixels'); height:=off; End; 258 : Begin Writeln(tagnum:2,' - Bits per sample = ',off); bps:=off; End; 259 : Begin comp:=off; Case Word(off) Of { Compression } CompNone : Writeln(tagnum:2,' - Non-compressed image, Byte aligned'); CompHuff : Writeln(tagnum:2,' - CCITT Group 3 one-dim. modified Huffman run-length encoding'); CompFax3 : Writeln(tagnum:2,' - Fax compatible CCITT Group 3 compression'); CompFax4 : Writeln(tagnum:2,' - Fax compatible CCITT Group 4 compression'); CompLZW : Writeln(tagnum:2,' - GIF style LZW compressed image'); CompWrdL : Writeln(tagnum:2,' - Non-compressed image, Word aligned'); CompPakB : Writeln(tagnum:2,' - MacPaint style PackBits RL image compression'); Else Writeln(tagnum:2,' - Unrecognized image compression'); End; End; 262 : Begin { Photometric Interpretation } Write(tagnum:2,' - Photometric Interpretation: '); photo:=off; Case off Of 0 : Writeln('MinSampleValue is white, MaxSampleValue is black'); 1 : Writeln('MinSampleValue is black, MaxSampleValue is white'); 2 : Writeln('RGB'); 3 : Writeln('Paletted colour'); 4 : Writeln('Transparency mask'); Else Writeln('Unknown'); End; End; 263 : Writeln(tagnum:2,' - Thresholding (obsolete): ',off); { Thresholding } 264 : Writeln(tagnum:2,' - Cell Width (obsolete) = ',off); { Cell Width } 265 : Writeln(tagnum:2,' - Cell Length (obsolete) = ',off); { Cell Length } 266 : Writeln(tagnum:2,' - Fill Order (obsolete) = ',off); { Fill order } 269 : Writeln(tagnum:2,' - Document name: ',GetStr(len,off)); { Document name } 270 : Writeln(tagnum:2,' - Image description: ',GetStr(len,off)); { Image description } 271 : Writeln(tagnum:2,' - Manufacturer of scanner or whatever: ',GetStr(len,off)); { Make - scanner manufacturer } 272 : Writeln(tagnum:2,' - Model name of scanner or whatever: ',GetStr(len,off)); { Model - scanner model name & number } 273 : Begin { Strip offset } Writeln(tagnum:2,' - Number of Strip offsets = ',len); Writeln(' - Location of Strip offsets = ',off); GetStripOffsets(len,off); End; 274 : Writeln(tagnum:2,' - Image Orientation (obsolete): ',off); { Orientation } 277 : Begin Writeln(tagnum:2,' - Samples per pixel = ',off); spp:=off; End; 278 : Begin Writeln(tagnum:2,' - Rows per strip = ',off); { Rows per Strip } rps:=off; End; 279 : Begin Writeln(tagnum:2,' - Bytes per strip offset = ',off); { Bytes per Strip } GetStripSize(len,off); End; 280 : Writeln(tagnum:2,' - Minimum sample value offset (obsolete): ',off); { Minimum Sample Value } 281 : Writeln(tagnum:2,' - Maximum sample value offset (obsolete): ',off); { Maximum Sample Value } 282 : Writeln(tagnum:2,' - X resolution = ',GetRational(off):1:1,' pixels per Resolution Unit'); 283 : Writeln(tagnum:2,' - Y resolution = ',GetRational(off):1:1,' pixels per Resolution Unit'); 284 : Begin { Planar configuration } Write(tagnum:2,' - Planar configuration: '); Case off Of 1 : Writeln('Samples are contiguous stored'); 2 : Writeln('Each of the RGB samples are stored in separate planes'); End; End; 285 : Writeln(tagnum:2,' - Page Name: ',GetStr(len,off)); { Page name } 286 : Writeln(tagnum:2,' - X Position offset (fraction): ',off); { X Position } 287 : Writeln(tagnum:2,' - Y Position offset (fraction): ',off); { Y Position } 288 : Writeln(tagnum:2,' - Free Offsets (obsolete) = ',off); { Free Offsets } 289 : Writeln(tagnum:2,' - Free Bytes Count (obsolete) = ',off); { Free Bytes Count } 290 : Writeln(tagnum:2,' - Gray response unit ',Power(10,off)); { Grey response unit } 291 : Writeln(tagnum:2,' - Gray response curve offset: ',off); { Grey response curve } 292 : Writeln(tagnum:2,' - Group 3 Options: ',off); { Group 3 Options } 293 : Writeln(tagnum:2,' - Group 4 Options: ',off); { Group 4 Options } 296 : Begin { Resolution Unit } Write(tagnum:2,' - Resolution Unit: '); Case off Of 1 : Writeln('No unit of measurement'); 2 : Writeln('Inches'); 3 : Writeln('Centimetres'); End; End; 297 : Writeln(tagnum:2,' - Page Number offset: ',off); { Page number } 300 : Writeln(tagnum:2,' - Colour response unit: ',Power(10,off)); { Colour response unit } 301 : Writeln(tagnum:2,' - Colour response curve offset = ',off); { Colour response curves } 305 : Writeln(tagnum:2,' - Software that created the image: ',GetStr(len,off)); 306 : Writeln(tagnum:2,' - Date & Time image was created: ',GetStr(len,off)); 315 : Writeln(tagnum:2,' - Person who created the image: ',GetStr(len,off)); 316 : Writeln(tagnum:2,' - Host computer: ',GetStr(len,off)); 317 : Writeln(tagnum:2,' - Predictor = ',off); 320 : Begin Writeln(tagnum:2,' - Palette offset = ',off); GetPalette(len,off); End; Else Writeln(tagnum:2,' - Unrecognized tag: ',tag); End; End; Begin If ParamCount>0 Then Begin Strips:=Nil; maxstp:=0; If Pos('.',ParamStr(1))=0 Then StrPCopy(name,ParamStr(1)+'.TIF') Else StrPCopy(name,ParamStr(1)); Assign(fl,name); {$I-} Reset(fl,1); {$I+} If IOResult=0 Then Begin data:=GetWord(fl); If data=$4949 Then Format:=True Else If data=$4D4D Then Format:=False Else Begin Writeln('File is not a TIFF'); Halt; End; If Format Then Writeln('TIFF stored in Intel format') Else Writeln('TIFF stored in Motorola format'); data:=GetWord(fl); Writeln('TIFF version ',data/10:1:1); offset:=GetLong(fl); Writeln('Tagged fields at offset ',offset,' bytes'); Seek(fl,offset); { Move to "tags" in file } data:=GetWord(fl); Writeln(data,' tagged fields in the directory...'); For tagnum:=1 To data Do ReadTag; If spp=1 Then Begin { Show image if paletted, not true colour } Writeln; Writeln('Press a key to view the image'); ReadKey; ShowImage; End; Close(fl); End Else Writeln('File not found'); End Else Writeln('Usage: TIFFVIEW <filename>'); End.

Всего 1 фpагмент(а/ов) |пpедыдущий фpагмент (1)

Если вы хотите дополнить FAQ - пожалуйста пишите.

design/collection/some content by Frog,
DEMO DESIGN FAQ (C) Realm Of Illusion 1994-2000,
При перепечатке материалов этой страницы пожалуйста ссылайтесь на источник: "DEMO.DESIGN FAQ, http://www.enlight.ru/demo/faq".