home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Equalizer BBS
/
equalizer-bbs-collection_2004.zip
/
equalizer-bbs-collection
/
DEMOSCENE-STUFF
/
INTRO93.ZIP
/
UBFUNIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-27
|
5KB
|
216 lines
{$A+,B-,D+,E+,F-,I-,L+,N+,O-,R-,S-,V-}
UNIT UBFUnit;
{- UBF: Universal Bitmap Format.
Source Handler.
Written by: Bonijoni
Mr.Spock.
version 0.99 }
INTERFACE
Uses Dos,TPCrt,Lzh,TPString,Graph320;
Const
UBFPAL : Boolean = True;
UBFLZW : Boolean = True;
UBFRLE : Boolean = False;
UBFCon : Boolean = True;
{- Those parameters refers for Save Only!}
Var
UBFPALETTE : PalArray;
UBFCharTable : String;
{- This is Where the Palette and CharTable are Saved/Loaded from UBF}
Function SaveUBF (FN : String ; Var FontP : Pointer ;
FontX,FontY : Byte ; CharNumber : Word) : Byte;
Function LoadUBF (FN : String ; Var FontP : Pointer ;
Var FontX,FontY : Byte; Var CharNumber : Word) : Byte;
{-Error Level: 0 - Loaded Okey
1 - File Not Found
2 - Not UBF File
3 - IO Error
4 - Loaded Okey With Palette}
IMPLEMENTATION
Var
IBuf,OBuf : Array[0..255] of Byte;
FXW,FYW : Word;
CharNumber : Word;
InFile : File;
Remain : Word;
Remain1 : Longint;
FP : Pointer;
OutptrCS : Word;
{$F+}
Procedure WriteMemBlock;
{$F-}
begin
Move(Mem[Seg(outbuf^):ofs(outBuf^)],Mem[seg(FP^):ofs(FP^)+(Remain1-Remain)],outptr);
Inc(OutptrCS,outptr);
Dec(Remain,Outptr);
outptr:= 0
end;
{$F+}
Procedure ReadMemBlock;
{$F-}
begin
inptr:= 0;
If Remain>Sizeof(ibuf) then
inend:=SizeOf(ibuf)
else
inend:=Remain;
Move(Mem[seg(FP^):ofs(FP^)+(Remain1-Remain)],Mem[Seg(Inbuf^):ofs(InBuf^)],inend);
Dec(Remain,inend);
end;
{$F+}
procedure ReadNextBlock;
{$F-}
begin
inptr:= 0;
BlockRead(Infile,inbuf^,sizeof(ibuf),inend);
end;
{$F+}
Procedure WriteNextBlock;
{$F-}
var
wr: word;
begin
BlockWrite(Infile,outbuf^,outptr,wr);
if (IoResult>0) or (wr<outptr) then
Halt;
outptr:= 0
end;
Function SaveUBF (FN : String ; Var FontP : Pointer ;
FontX,FontY : Byte ; CharNumber : Word) : Byte;
Var
S2 : String;
B : Byte;
NumWritten : Integer;
Begin
For Remain:=0 to Sizeof(Ibuf) do Ibuf[Remain]:=0;
For Remain:=0 to Sizeof(Obuf) do Obuf[Remain]:=0;
FP:=FontP;
Assign (InFile,FN);
ReWrite (InFile,1);
If IOResult<>0 then
Begin
SaveUBF:=1;
Exit;
End;
S2:='UBF92a';
BlockWrite (InFile,S2[1],6,NumWritten);
B:=CharNumber;
S2:=Chr(B);
BlockWrite (InFile,S2[1],1,NumWritten);
B:=FontX;
S2:=Chr(B);
BlockWrite (InFile,S2[1],1,NumWritten);
B:=FontY;
S2:=Chr(B);
BlockWrite (InFile,S2[1],1,NumWritten);
B:=0;
If UBFCon then B:=B OR 1;
If UBFPal then B:=B OR 2;
If UBFRle then B:=B OR 4;
If UBFLzw then B:=B OR 8;
S2:=Chr(B);
BlockWrite (InFile,S2[1],1,NumWritten);
If UBFCon then
BlockWrite (InFile,UBFCharTable[1],CharNumber,NumWritten);
If UBFPAL then
BlockWrite (InFile,UBFPalette,768,NumWritten);
FXW:=FontX; FYW:=FontY;
Remain:=FXW*FYW*CharNumber;
Remain1:=Remain;
inbuf:= @Ibuf;
ReadToBuffer:=ReadMemBlock;
ReadToBuffer;
Outbuf:= @obuf;
outEnd:= sizeof(obuf);
outptr:= 0;
WriteFromBuffer:= WriteNextBlock;
Encode(Remain1);
If outptr>0 then WriteNextBlock;
Close(InFile);
End;
Function LoadUBF (FN : String ; Var FontP : Pointer ;
Var FontX,FontY : Byte; Var CharNumber : Word) : Byte;
Var
S2 : String;
NumWritten : Integer;
B : Byte;
Begin
UBFCharTable:='';
outptr:=0;
inptr:=0;
outend:=0;
inend:=0;
outptrCS:=0;
For Remain:=0 to Sizeof(Ibuf) do Ibuf[Remain]:=0;
For Remain:=0 to Sizeof(Obuf) do Obuf[Remain]:=0;
FP:=FontP;
Assign (InFile,FN);
Reset (InFile,1);
If IOResult<>0 then
Begin
LoadUBF:=1;
WriteFont (0,16,'Erorr 1');
Exit;
End;
S2:=' ';
BlockRead (InFile,S2[1],6,NumWritten);
If S2<>'UBF92a' then
Begin
LoadUBF:=2;
WriteFont (0,16,'Erorr 2');
Exit;
End
Else
Begin
BlockRead (InFile,S2[1],1,NumWritten);
CharNumber:=Ord(S2[1]);
BlockRead (InFile,S2[1],1,NumWritten);
FontX:=Ord(S2[1]);
BlockRead (InFile,S2[1],1,NumWritten);
FontY:=Ord(S2[1]);
BlockRead (InFile,S2[1],1,NumWritten);
B:=Ord(S2[1]);
If (B And 1)=1 then
Begin
UBFCharTable:=Copy(Pad(UBFCharTable,CharNumber),1,CharNumber);
BlockRead (InFile,UBFCharTable[1],CharNumber,NumWritten);
End;
If (B And 2)=2 then
BlockRead (InFile,UBFPalette,768,NumWritten);
For Remain:=0 to 64999 do Mem[Seg(FP^):Ofs(FP^)+Remain]:=0;
FXW:=FontX; FYW:=FontY;
Remain:=FXW*FYW*CharNumber;
Remain1:=Remain;
inbuf:= @Ibuf;
ReadToBuffer:=ReadNextBlock;
ReadToBuffer;
Outbuf:= @obuf;
outEnd:= sizeof(obuf);
outptr:= 0;
WriteFromBuffer:= WriteMemBlock;
Decode;
If outptr>0 then WriteMemBlock;
Close(InFile);
If (B And 2)=2 then LoadUBF:=4 else LoadUBF:=0;
End;
End;
End.