home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / ANIVGA.ZIP / UNLIB.PAS < prev   
Pascal/Delphi Source File  |  1991-11-17  |  6KB  |  192 lines
  1. {$X+}
  2. PROGRAM Split_Sprite_LIB_Files;
  3. USES DOS;
  4.  
  5. CONST {Fehlercodes des Animationspaketes: }
  6.       Err_None=0;
  7.       Err_NotEnoughMemory=1;
  8.       Err_FileIO=2;
  9.       Err_NoSprite=4;
  10.       Err_DiskFull=7;
  11.  
  12. CONST dest:STRING[12]='UNLIB000.COD';
  13.  
  14. TYPE SpriteHeader= RECORD
  15.                     Zeiger_auf_Plane:Array[0..3] OF Word;
  16.                     Breite_in_4er_Gruppen:WORD;
  17.                     Hoehe_in_Zeilen:WORD;
  18.                     Translate:Array[1..4] OF Byte;
  19.                     SpriteLength:WORD;
  20.                     Dummy:Array[1..10] OF Word;
  21.                     Kennung:ARRAY[1..2] OF CHAR;
  22.                     Version:BYTE;
  23.                     Modus:BYTE;
  24.                     ZeigerL,ZeigerR,ZeigerO,ZeigerU:Word;
  25.                    END;
  26.  
  27. VAR Error : BYTE; {globale Fehlervariable}
  28.  
  29. FUNCTION GetErrorMessage:STRING;
  30. { in: Error = Nummer des aufgetretenen Fehlers}
  31. {out: den Fehler in Worten}
  32. BEGIN
  33.  CASE Error OF
  34.   Err_None:GetErrorMessage:='No Error';
  35.   Err_NotEnoughMemory:GetErrorMessage:='Not enough memory available on heap';
  36.   Err_FileIO:GetErrorMessage:='I/O-error with file';
  37.   Err_NoSprite:GetErrorMessage:='No (or corrupted) Sprite file';
  38.   Err_DiskFull:GetErrorMessage:='Fileerror: Disk full';
  39.  END;
  40. END;
  41.  
  42.  
  43. FUNCTION SplitSprites(Name:String):WORD;
  44. { in: Name   = Name des zu ladenden Sprite-Files (Typ: "*.COD" / "*.LIB" )}
  45. {     Number = Nummer, die das erste Sprite aus diesem File bekommen soll }
  46. {     dest   = Name, unter dem das erste Sprite abgelegt wird, i.d.R.     }
  47. {              "UNLIB000.COD"                                             }
  48. {out: Anzahl der aus dem File gelesenen Sprites (0 = Fehler trat auf)     }
  49. {     UNLIB000.COD, UNLIB001.COD,... = ausgelesene Sprites                }
  50. {rem: Die Routine erkennt automatisch, ob es sich bei dem File um ein ein-}
  51. {     zelnes Sprite oder eine ganze Spritebibliothek handelt und laedt    }
  52. {     alle Spritedaten auf den Heap, und zwar derart, dass die Adresse    }
  53. {     immer auf eine Segmentgrenze fällt. Diese Anfangsadressen werden    }
  54. {     dann in der Tabelle SPRITEAD[Number] abgelegt; sind mehrere Sprites }
  55. {     in der Datei so werden sie mit fortlaufender Nummer eingetragen,    }
  56. {     also Number+i }
  57.  
  58.    FUNCTION Update(VAR ch:CHAR):BOOLEAN;
  59.    { in: ch = Ziffer als Zeichen   : '0'..'9'}
  60.    {out: ch = um 1 erhöhtes Zeichen: '1'..'0'}
  61.    {     TRUE/FALSE, falls Übertrag in nächsthöhere Stelle}
  62.    BEGIN
  63.     IF ch='9'
  64.      THEN ch:='0'
  65.      ELSE ch:=chr(succ(ord(ch)));
  66.     Update:=ch='0'
  67.    END;
  68.  
  69. LABEL quit_loop;
  70. TYPE SpriteBuffer=ARRAY[0..65534] OF BYTE;
  71. VAR Buffer: ^SpriteBuffer;
  72.     len:LONGINT;
  73.     f,f2:File;
  74.     count,BytesWritten,Kopf:WORD;
  75.     Header:SpriteHeader;
  76. BEGIN
  77.  NEW(Buffer);
  78.  count:=0;  {Zahl der bisher eingelesenen Sprites}
  79.  Kopf:=SizeOf(SpriteHeader);
  80.  assign(f,name);
  81.  {$I-} reset(f,1); {$I+}
  82.  if (ioresult<>0)
  83.   THEN BEGIN  {Datei existiert nicht oder nicht unter diesem Pfad}
  84.         Error:=Err_FileIO;
  85.         SplitSprites:=0; exit
  86.        END;
  87.  len:=filesize(f);  {Dateilaenge ermitteln}
  88.  
  89.  WHILE NOT EOF(f) DO
  90.  BEGIN
  91.   WRITELN('...working on sprite '+dest);
  92.  
  93.   {Zunaechst den Spriteheader einlesen: }
  94.   {$I-}     {jetzt den Spriteheader vià BLOCKREAD auf den Heap laden}
  95.   blockread(f,Header,Kopf);
  96.   {$I+}
  97.  
  98.   IF (ioresult<>0)
  99.    THEN BEGIN
  100.          Error:=Err_FileIO;
  101.          goto quit_loop;
  102.         END;
  103.   IF (Header.Kennung[1]<>'K') or (Header.Kennung[2]<>'R')
  104.    THEN BEGIN
  105.          Error:=Err_NoSprite;
  106.          goto quit_loop;
  107.         END;
  108.   IF (Header.SpriteLength>MaxAvail+15)    {noch genug Platz da?}
  109.    THEN BEGIN
  110.          Error:=Err_NotEnoughMemory;
  111.          goto quit_loop;
  112.         END;
  113.  
  114.   MOVE(Header,Buffer^[0],Kopf);
  115.   {Jetzt eigentliche Spritedaten einlesen: }
  116.   {$I-}
  117.   blockread(f,Buffer^[Kopf],Header.SpriteLength-Kopf);
  118.   {$I+}
  119.   IF (ioresult<>0)
  120.    THEN BEGIN
  121.          Error:=Err_FileIO;
  122.          goto quit_loop
  123.         END;
  124.  
  125.   {$I-}     {jetzt das Sprite auf Disk schreiben}
  126.   assign(f2,dest);
  127.   Rewrite(f2,1);
  128.   {$I+}
  129.   IF (ioresult<>0)
  130.    THEN BEGIN
  131.          Error:=Err_FileIO;
  132.          goto quit_loop
  133.         END;
  134.   {$I-}
  135.   blockwrite(f2,Buffer^[0],Header.SpriteLength,BytesWritten);
  136.   {$I+}
  137.   IF Header.SpriteLength<>BytesWritten
  138.    THEN BEGIN
  139.          Error:=Err_DiskFull;
  140.          goto quit_loop
  141.         END;
  142.   IF (ioresult<>0)
  143.    THEN BEGIN
  144.          Error:=Err_FileIO;
  145.          goto quit_loop
  146.         END;
  147.   {$I-}
  148.   close(f2);
  149.   {$I+}
  150.   IF (ioresult<>0)
  151.    THEN BEGIN
  152.          Error:=Err_FileIO;
  153.          goto quit_loop
  154.         END;
  155.  
  156.   INC(count);
  157.   IF Update(dest[8])  {Filenamen für nächsten Aufruf generieren}
  158.    THEN IF Update(dest[7])
  159.          THEN Update(dest[6]);
  160.  
  161.  END;
  162.  
  163.  WRITELN('Done, extracted ',count,' sprites');
  164.  
  165. quit_loop: ;
  166.  close(f);
  167.  SplitSprites:=count
  168. END;
  169.  
  170.  
  171. BEGIN
  172.  WRITELN;
  173.  WRITELN('UNLIB V1.1  -- Splits a spritelibrary into its *.COD-files');
  174.  WRITELN(' by Kai Rohrbacher, 1991');
  175.  WRITELN;
  176.  IF ParamCount<>1
  177.   THEN BEGIN
  178.         WRITELN('*** Wrong parameters!');
  179.         WRITELN('Call UNLIB with the name of your spritelibrary to split, e.g.:');
  180.         WRITELN;
  181.         WRITELN('  UNLIB c:\sprites\my_files.LIB');
  182.         WRITELN;
  183.         WRITELN('UNLIB will create the *.COD-files in the current directory,');
  184.         WRITELN('starting with the name '+dest+' and using increasing numbers.');
  185.         Halt(1);
  186.        END;
  187.  Error:=Err_None;
  188.  IF SplitSprites(ParamStr(1))=0
  189.   THEN BEGIN
  190.         WRITELN('*** Error: '+GetErrorMessage);
  191.        END;
  192. END.