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 >
Pascal/Delphi Source File  |  1993-02-27  |  5KB  |  216 lines
  1. {$A+,B-,D+,E+,F-,I-,L+,N+,O-,R-,S-,V-}
  2. UNIT UBFUnit;
  3.  
  4.  {- UBF: Universal Bitmap Format.
  5.     Source Handler.
  6.      Written by: Bonijoni
  7.                  Mr.Spock.
  8.      version 0.99 }
  9.  
  10. INTERFACE
  11. Uses Dos,TPCrt,Lzh,TPString,Graph320;
  12.  
  13. Const
  14.   UBFPAL         : Boolean = True;
  15.   UBFLZW         : Boolean = True;
  16.   UBFRLE         : Boolean = False;
  17.   UBFCon         : Boolean = True;
  18.  {- Those parameters refers for Save Only!}
  19.  
  20. Var
  21.   UBFPALETTE     : PalArray;
  22.   UBFCharTable   : String;
  23.  {- This is Where the Palette and CharTable are Saved/Loaded from UBF}
  24.  
  25. Function SaveUBF (FN : String ; Var FontP : Pointer ;
  26.                   FontX,FontY : Byte ; CharNumber : Word) : Byte;
  27. Function LoadUBF (FN : String ; Var FontP : Pointer ;
  28.                   Var FontX,FontY : Byte; Var CharNumber : Word) : Byte;
  29.   {-Error Level: 0 - Loaded Okey
  30.                  1 - File Not Found
  31.                  2 - Not UBF File
  32.                  3 - IO Error
  33.                  4 - Loaded Okey With Palette}
  34.  
  35. IMPLEMENTATION
  36.  
  37. Var
  38.  IBuf,OBuf      : Array[0..255] of Byte;
  39.  FXW,FYW        : Word;
  40.  CharNumber     : Word;
  41.  InFile         : File;
  42.  Remain         : Word;
  43.  Remain1        : Longint;
  44.  FP             : Pointer;
  45.  OutptrCS       : Word;
  46.  
  47. {$F+}
  48. Procedure WriteMemBlock;
  49. {$F-}
  50.  
  51.   begin
  52.     Move(Mem[Seg(outbuf^):ofs(outBuf^)],Mem[seg(FP^):ofs(FP^)+(Remain1-Remain)],outptr);
  53.     Inc(OutptrCS,outptr);
  54.     Dec(Remain,Outptr);
  55.     outptr:= 0
  56.   end;
  57.  
  58. {$F+}
  59.   Procedure ReadMemBlock;
  60. {$F-}
  61.   begin
  62.     inptr:= 0;
  63.     If Remain>Sizeof(ibuf) then
  64.       inend:=SizeOf(ibuf)
  65.      else
  66.       inend:=Remain;
  67.     Move(Mem[seg(FP^):ofs(FP^)+(Remain1-Remain)],Mem[Seg(Inbuf^):ofs(InBuf^)],inend);
  68.     Dec(Remain,inend);
  69.   end;
  70.  
  71. {$F+}
  72.   procedure ReadNextBlock;
  73. {$F-}
  74.   begin
  75.     inptr:= 0;
  76.     BlockRead(Infile,inbuf^,sizeof(ibuf),inend);
  77.   end;
  78.  
  79. {$F+}
  80. Procedure WriteNextBlock;
  81. {$F-}
  82.   var
  83.     wr: word;
  84.   begin
  85.     BlockWrite(Infile,outbuf^,outptr,wr);
  86.     if (IoResult>0) or (wr<outptr) then
  87.      Halt;
  88.     outptr:= 0
  89.   end;
  90.  
  91. Function SaveUBF (FN : String ; Var FontP : Pointer ;
  92.                   FontX,FontY : Byte ; CharNumber : Word)     : Byte;
  93.  
  94. Var
  95.   S2  : String;
  96.   B   : Byte;
  97.   NumWritten : Integer;
  98.  
  99. Begin
  100.  For Remain:=0 to Sizeof(Ibuf) do Ibuf[Remain]:=0;
  101.  For Remain:=0 to Sizeof(Obuf) do Obuf[Remain]:=0;
  102.  FP:=FontP;
  103.  Assign (InFile,FN);
  104.  ReWrite (InFile,1);
  105.  If IOResult<>0 then
  106.   Begin
  107.    SaveUBF:=1;
  108.    Exit;
  109.   End;
  110.   S2:='UBF92a';
  111.   BlockWrite (InFile,S2[1],6,NumWritten);
  112.   B:=CharNumber;
  113.   S2:=Chr(B);
  114.   BlockWrite (InFile,S2[1],1,NumWritten);
  115.   B:=FontX;
  116.   S2:=Chr(B);
  117.   BlockWrite (InFile,S2[1],1,NumWritten);
  118.   B:=FontY;
  119.   S2:=Chr(B);
  120.   BlockWrite (InFile,S2[1],1,NumWritten);
  121.   B:=0;
  122.   If UBFCon then B:=B OR 1;
  123.   If UBFPal then B:=B OR 2;
  124.   If UBFRle then B:=B OR 4;
  125.   If UBFLzw then B:=B OR 8;
  126.   S2:=Chr(B);
  127.   BlockWrite (InFile,S2[1],1,NumWritten);
  128.   If UBFCon then
  129.    BlockWrite (InFile,UBFCharTable[1],CharNumber,NumWritten);
  130.   If UBFPAL then
  131.    BlockWrite (InFile,UBFPalette,768,NumWritten);
  132.   FXW:=FontX; FYW:=FontY;
  133.   Remain:=FXW*FYW*CharNumber;
  134.   Remain1:=Remain;
  135.   inbuf:= @Ibuf;
  136.   ReadToBuffer:=ReadMemBlock;
  137.   ReadToBuffer;
  138.   Outbuf:= @obuf;
  139.   outEnd:= sizeof(obuf);
  140.   outptr:= 0;
  141.   WriteFromBuffer:= WriteNextBlock;
  142.   Encode(Remain1);
  143.   If outptr>0 then WriteNextBlock;
  144.   Close(InFile);
  145. End;
  146.  
  147. Function LoadUBF (FN : String ; Var FontP : Pointer ;
  148.                   Var FontX,FontY : Byte; Var CharNumber : Word) : Byte;
  149. Var
  150.   S2         : String;
  151.   NumWritten : Integer;
  152.   B          : Byte;
  153.  
  154. Begin
  155.  UBFCharTable:='';
  156.  outptr:=0;
  157.  inptr:=0;
  158.  outend:=0;
  159.  inend:=0;
  160.  outptrCS:=0;
  161.  For Remain:=0 to Sizeof(Ibuf) do Ibuf[Remain]:=0;
  162.  For Remain:=0 to Sizeof(Obuf) do Obuf[Remain]:=0;
  163.  FP:=FontP;
  164.  Assign (InFile,FN);
  165.  Reset (InFile,1);
  166.  If IOResult<>0 then
  167.   Begin
  168.    LoadUBF:=1;
  169.    WriteFont (0,16,'Erorr 1');
  170.    Exit;
  171.   End;
  172.  S2:='      ';
  173.  BlockRead (InFile,S2[1],6,NumWritten);
  174.  If S2<>'UBF92a' then
  175.   Begin
  176.    LoadUBF:=2;
  177.    WriteFont (0,16,'Erorr 2');
  178.    Exit;
  179.   End                                          
  180.  Else                                          
  181.   Begin
  182.    BlockRead (InFile,S2[1],1,NumWritten);
  183.    CharNumber:=Ord(S2[1]);
  184.    BlockRead (InFile,S2[1],1,NumWritten);
  185.    FontX:=Ord(S2[1]);
  186.    BlockRead (InFile,S2[1],1,NumWritten);
  187.    FontY:=Ord(S2[1]);
  188.    BlockRead (InFile,S2[1],1,NumWritten);
  189.    B:=Ord(S2[1]);
  190.    If (B And 1)=1 then
  191.     Begin
  192.      UBFCharTable:=Copy(Pad(UBFCharTable,CharNumber),1,CharNumber);
  193.      BlockRead (InFile,UBFCharTable[1],CharNumber,NumWritten);
  194.     End;
  195.    If (B And 2)=2 then
  196.     BlockRead (InFile,UBFPalette,768,NumWritten);
  197.    For Remain:=0 to 64999 do Mem[Seg(FP^):Ofs(FP^)+Remain]:=0;
  198.    FXW:=FontX; FYW:=FontY;
  199.    Remain:=FXW*FYW*CharNumber;
  200.    Remain1:=Remain;
  201.    inbuf:= @Ibuf;
  202.    ReadToBuffer:=ReadNextBlock;
  203.    ReadToBuffer;
  204.    Outbuf:= @obuf;
  205.    outEnd:= sizeof(obuf);
  206.    outptr:= 0;
  207.    WriteFromBuffer:= WriteMemBlock;
  208.    Decode;
  209.    If outptr>0 then WriteMemBlock;
  210.    Close(InFile);
  211.    If (B And 2)=2 then LoadUBF:=4 else LoadUBF:=0;
  212.   End;
  213. End;
  214.  
  215. End.
  216.