home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ANIVGA11.ZIP / DUMP_SPR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-17  |  10.0 KB  |  369 lines
  1. {$UNDEF test}
  2.  
  3. {$IFDEF test}
  4.  {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
  5.  {$M 16384,65536,655360}
  6. {$ELSE}
  7.  {$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-}
  8.  {$M 16384,65536,655360}
  9. {$ENDIF}
  10.  
  11. PROGRAM DumpSpriteFile;
  12. {Zweck    : Erstellt aus einem Spritefile eine leserliche ASCII-Beschreibung}
  13. {Autor    : Kai Rohrbacher                }
  14. {Sprache  : TurboPascal V6.0              }
  15. {Datum    : 29.10.1991                    }
  16. {Anmerkung: Ausgabe kann in eine Datei umgeleitet werden!}
  17.  
  18. USES DOS;
  19. CONST Datenbytes=65485;  {maximale Spritegroesse eines Sprites, die hier}
  20.                          {im Programm bearbeitet werden kann  (-40) }
  21.       Err_None=0;
  22.       Err_NotEnoughMemory=1;
  23.       Err_FileIO=2;
  24.       Err_NoSprite=4;
  25.       Err_NoFile=99;
  26.  
  27. TYPE SpriteHeader= RECORD
  28.                     Zeiger_auf_Plane:Array[0..3] OF Word;
  29.                     Breite_in_4er_Gruppen:WORD;
  30.                     Hoehe_in_Zeilen:WORD;
  31.                     Translate:Array[1..4] OF Byte;
  32.                     SpriteLength:WORD;
  33.                     Dummy:Array[1..10] OF Word;
  34.                     Kennung:ARRAY[1..2] OF CHAR;
  35.                     Version:BYTE;
  36.                     Modus:BYTE;
  37.                     ZeigerL,ZeigerR,ZeigerO,ZeigerU:Word;
  38.                    END;
  39.  
  40.      sprite_typ= record case Integer of
  41.       0:( Header:Spriteheader;
  42.           Data:Array[1..Datenbytes] OF Byte;
  43.         );
  44.       1:(
  45.          readin:Array[0..Datenbytes-1 +40] OF Byte;
  46.         )
  47.      END;
  48.  
  49. LABEL quit_loop,
  50.       quit_without_close;
  51.  
  52. VAR f:file;
  53.     sprite:^sprite_typ;
  54.     count,Kopf:WORD;
  55.     Error:BYTE;
  56.     P: PathStr;
  57.     D: DirStr;
  58.     N: NameStr;
  59.     E: ExtStr;
  60.  
  61.  
  62. FUNCTION FillBlanks(s:STRING):STRING;
  63. {haengt an s soviele Blanks an, dass es ein Vielfaches von 13 lang wird}
  64. CONST blanks='            '; {12 Stueck}
  65. BEGIN
  66.  FillBlanks:=s+Copy(blanks,1,(13-(length(s) MOD 13)) MOD 13)
  67. END;
  68.  
  69. PROCEDURE Put(s:STRING);
  70. BEGIN
  71.  WRITELN(s);
  72. END;
  73.  
  74. PROCEDURE SpriteDatenausgeben(VAR sprite:sprite_typ; count:WORD;
  75.                               P:PathStr; name:NameStr);
  76. CONST tab1='     '; {Tabulator vom linken Rand bis zum Operandenfeld}
  77. VAR Tabellen_Breite,i,j:Word;
  78.     sp,t1,t2:STRING;
  79.  
  80. BEGIN
  81.  IF count=0
  82.   THEN BEGIN  {erster Aufruf dieser Routine}
  83.         Put(';');
  84.         Put('; ASCII-listing of ANIVGA sprite file '+P);
  85.         Put('; Created with "DUMP_SPR '+P+'"');
  86.         Put(';');
  87.         Put('; This file can be recompiled to a valid sprite file '
  88.             +'with these commands:');
  89.         Put(Fillblanks(';  MASM '+name+'.TXT;')+' -> gives you '+name+'.OBJ');
  90.         Put(Fillblanks(';  LINK '+name+'.OBJ;')+' -> gives you '+name+'.EXE');
  91.         Put(';  EXE2BIN '+name+'.EXE '+name+'.COD  (or .LIB)');
  92.         Put('');
  93.         Put(Fillblanks('DATA SEGMENT')+' ; to cheat the assembler...');
  94.        END;
  95.  STR(count,sp); sp:=name+sp; {Spritename erzeugen}
  96.  
  97.  Put('');
  98.  Put(';------------------------------------------');
  99.  Put(Fillblanks(sp+' EQU $')+' ; arbitrarily chosen name for this sprite');
  100.  
  101.  WITH Sprite.Header DO
  102.  BEGIN
  103.   Put('');
  104.   Put('; Offset-pointer to plane data tables:');
  105.   FOR i:=0 TO 3 DO
  106.    BEGIN
  107.     STR(Zeiger_auf_Plane[i]:4,t1); STR(i,t2);
  108.     t1:=Fillblanks(tab1+'DW '+sp+'_Plane'+t2+' -'+sp)
  109.         +' ; ptr to plane '+t2+' (= DW '+t1+')';
  110.     Put(t1)
  111.    END;
  112.  
  113.   Put('');
  114.   STR(Breite_in_4er_Gruppen:4,t1);
  115.   Put(Fillblanks(tab1+'DW '+t1)+' ; sprite width in multiples of 4 points');
  116.  
  117.   STR(Hoehe_in_Zeilen:4,t1);
  118.   Put(Fillblanks(tab1+'DW '+t1)+' ; sprite height in lines');
  119.  
  120.   t1:=tab1+'DB ';
  121.   FOR i:=1 TO 4 DO
  122.    BEGIN
  123.     STR(Translate[i],t2);
  124.     t1:=t1+t2;
  125.     IF i<>4 THEN t1:=t1+','
  126.    END;
  127.   Put(Fillblanks(t1)+' ; some constants: "translate tab", must be 1,2,4,8');
  128.  
  129.   STR(SpriteLength:4,t1);
  130.   Put(Fillblanks(tab1+'DW '+t1)+' ; length of this sprite in bytes');
  131.  
  132.   t1:=tab1+'DW ';
  133.   FOR i:=1 TO 10 DO
  134.    BEGIN
  135.     STR(Dummy[i],t2);
  136.     t1:=t1+t2;
  137.     IF i<>10 THEN t1:=t1+','
  138.    END;
  139.   Put(Fillblanks(t1)+' ; 10 dummy words, should be all 0');
  140.  
  141.   t1:=tab1+'DB '+''''+Kennung[1]+''','''+Kennung[2]+'''';
  142.   Put(Fillblanks(t1)+' ; flag, must be "KR"');
  143.  
  144.   STR(Version:4,t1);
  145.   Put(Fillblanks(tab1+'DB '+t1)+' ; version number, normally "1"');
  146.  
  147.   STR(Modus:4,t1);
  148.   Put(Fillblanks(tab1+'DB '+t1)+' ; default display mode of sprite');
  149.  
  150.   STR(ZeigerL:4,t1);
  151.   Put(Fillblanks(tab1+'DW '+sp+'_Left  -'+sp)+' ; ptr to left   boundaries (= DW '+t1+')');
  152.   STR(ZeigerR:4,t1);
  153.   Put(Fillblanks(tab1+'DW '+sp+'_Right -'+sp)+' ; ptr to right  boundaries (= DW '+t1+')');
  154.   STR(ZeigerO:4,t1);
  155.   Put(Fillblanks(tab1+'DW '+sp+'_Top   -'+sp)+' ; ptr to top    boundaries (= DW '+t1+')');
  156.   STR(ZeigerU:4,t1);
  157.   Put(Fillblanks(tab1+'DW '+sp+'_Bottom-'+sp)+' ; ptr to bottom boundaries (= DW '+t1+')');
  158.  
  159.   Put('');
  160.   Put(Fillblanks(sp+'_Left   EQU $')+' ; Left boundary table');
  161.   t1:=tab1+'DW ';
  162.   FOR i:=0 TO Hoehe_in_Zeilen-1 DO
  163.    BEGIN
  164.     STR(INTEGER(Sprite.Readin[ZeigerL +i shl 1]
  165.            +256*Sprite.Readin[Succ(ZeigerL +i shl 1)]),t2);
  166.     t1:=t1+t2;
  167.     IF length(t1)>75
  168.      THEN BEGIN
  169.            Put(t1);
  170.            t1:=tab1+'DW ';
  171.           END
  172.      ELSE BEGIN
  173.            IF i<>Hoehe_in_Zeilen-1
  174.             THEN t1:=t1+','
  175.             ELSE Put(t1)
  176.           END;
  177.    END;
  178.  
  179.   Put(Fillblanks(sp+'_Right  EQU $')+' ; Right boundary table');
  180.   t1:=tab1+'DW ';
  181.   FOR i:=0 TO Hoehe_in_Zeilen-1 DO
  182.    BEGIN
  183.     STR(INTEGER(Sprite.Readin[ZeigerR +i shl 1]
  184.            +256*Sprite.Readin[Succ(ZeigerR +i shl 1)]),t2);
  185.     t1:=t1+t2;
  186.     IF length(t1)>75
  187.      THEN BEGIN
  188.            Put(t1);
  189.            t1:=tab1+'DW ';
  190.           END
  191.      ELSE BEGIN
  192.            IF i<>Hoehe_in_Zeilen-1
  193.             THEN t1:=t1+','
  194.             ELSE Put(t1)
  195.           END;
  196.    END;
  197.  
  198.   Put(Fillblanks(sp+'_Top    EQU $')+' ; Top boundary table');
  199.   t1:=tab1+'DW ';
  200.   FOR i:=0 TO Breite_in_4er_Gruppen*4-1 DO
  201.    BEGIN
  202.     STR(INTEGER(Sprite.Readin[ZeigerO +i shl 1]
  203.            +256*Sprite.Readin[Succ(ZeigerO +i shl 1)]),t2);
  204.     t1:=t1+t2;
  205.     IF length(t1)>75
  206.      THEN BEGIN
  207.            Put(t1);
  208.            t1:=tab1+'DW ';
  209.           END
  210.      ELSE BEGIN
  211.            IF i<>Breite_in_4er_Gruppen*4-1
  212.             THEN t1:=t1+','
  213.             ELSE Put(t1)
  214.           END;
  215.    END;
  216.  
  217.   Put(Fillblanks(sp+'_Bottom EQU $')+' ; Bottom boundary table');
  218.   t1:=tab1+'DW ';
  219.   FOR i:=0 TO Breite_in_4er_Gruppen*4-1 DO
  220.    BEGIN
  221.     STR(INTEGER(Sprite.Readin[ZeigerU +i shl 1]
  222.            +256*Sprite.Readin[Succ(ZeigerU +i shl 1)]),t2);
  223.     t1:=t1+t2;
  224.     IF length(t1)>75
  225.      THEN BEGIN
  226.            Put(t1);
  227.            t1:=tab1+'DW ';
  228.           END
  229.      ELSE BEGIN
  230.            IF i<>Breite_in_4er_Gruppen*4-1
  231.             THEN t1:=t1+','
  232.             ELSE Put(t1)
  233.           END;
  234.    END;
  235.  
  236.   Put(''); 
  237.   Tabellen_Breite:=Breite_in_4er_Gruppen*Hoehe_in_Zeilen;
  238.   FOR j:=0 TO 3 DO
  239.    BEGIN
  240.     STR(j,t2);
  241.     t1:=Fillblanks(sp+'_Plane'+t2+' EQU $')+' ; Data for plane '+t2;
  242.     Put(t1);
  243.     t1:=tab1+'DB ';
  244.     FOR i:=Zeiger_auf_Plane[j] TO Pred(Zeiger_auf_Plane[j]+Tabellen_Breite)
  245.      DO BEGIN
  246.          STR(Sprite.Readin[i],t2);
  247.          t1:=t1+t2;
  248.          IF length(t1)>75
  249.           THEN BEGIN
  250.                 Put(t1);
  251.                 t1:=tab1+'DB '
  252.                END
  253.           ELSE BEGIN
  254.                 IF i<>Pred(Zeiger_auf_Plane[j]+Tabellen_Breite)
  255.                  THEN t1:=t1+','
  256.                  ELSE Put(t1)
  257.                END;
  258.         END; 
  259.  
  260.    END;
  261.   Put('');
  262.  
  263.  END; {of WITH}
  264. END;
  265.  
  266. FUNCTION GetErrorMessage:STRING;
  267. { in: Error = Nummer des aufgetretenen Fehlers}
  268. {out: den Fehler in Worten}
  269. BEGIN
  270.  CASE Error OF
  271.   Err_None:GetErrorMessage:='No Error';
  272.   Err_NotEnoughMemory:GetErrorMessage:='Not enough memory available on heap';
  273.   Err_FileIO:GetErrorMessage:='I/O-error with file';
  274.   Err_NoSprite:GetErrorMessage:='No (or corrupted) sprite file';
  275.   Err_NoFile:GetErrorMessage:='File doesn''t exist!';
  276.   ELSE GetErrorMessage:='Unknown error';
  277.  END;
  278. END;
  279.  
  280.  
  281. BEGIN
  282.  New(sprite);
  283.  Error:=Err_None;
  284.  P:=paramstr(1);
  285.  IF (ParamCount<>1) OR (P='/?') OR (P='-?') THEN
  286.   BEGIN
  287.    WRITELN;
  288.    WRITELN('SpriteDumper, V1.10     -- by Kai Rohrbacher  (c) 1991,1992');
  289.    WRITELN('Disassembles *.COD or *.LIB files into readable ASCII-text.');
  290.    WRITELN;
  291.    WRITELN('Call SpriteDumper in one of these forms:');
  292.    WRITELN;
  293.    WRITELN(' '+ParamStr(0)+' sprite.ext     or');
  294.    WRITELN(' '+ParamStr(0)+' sprite.ext >sprite.TXT');
  295.    WRITELN;
  296.    WRITELN('The first form will list the sprite''s contents to the screen, '
  297.           +'while the second');
  298.    WRITELN('one will produce the ASCII-file sprite.TXT for further usage.');
  299.    goto quit_without_close;
  300.   END;
  301.  
  302.  FSplit(P,D,N,E);
  303.  
  304.  assign(f,P);
  305.  {$I-}
  306.  reset(f,1);
  307.  {$I+}
  308.  IF (ioresult<>0) or (P='')
  309.   THEN BEGIN
  310.         Error:=Err_NoFile; goto quit_without_close;
  311.        END;
  312.  
  313.  Kopf:=SizeOf(SpriteHeader); count:=0;
  314.  
  315.  WHILE NOT EOF(f) DO
  316.  BEGIN
  317.   {Zunaechst den Spriteheader einlesen: }
  318.   {$I-}     {jetzt den Spriteheader vià BLOCKREAD auf den Heap laden}
  319.   blockread(f,Sprite^.Readin[0],Kopf);
  320.   {$I+}
  321.  
  322.   IF (ioresult<>0)
  323.    THEN BEGIN
  324.          Error:=Err_FileIO;
  325.          goto quit_loop;
  326.         END;
  327.   IF (Sprite^.Header.Kennung[1]<>'K') or (Sprite^.Header.Kennung[2]<>'R')
  328.    THEN BEGIN
  329.          Error:=Err_NoSprite;
  330.          goto quit_loop;
  331.         END;
  332.   IF (Sprite^.Header.SpriteLength>SizeOf(Sprite_Typ))  {noch genug Platz da?}
  333.    THEN BEGIN
  334.          Error:=Err_NotEnoughMemory;
  335.          goto quit_loop;
  336.         END;
  337.  
  338.   {Jetzt eigentliche Spritedaten einlesen: }
  339.   {$I-}
  340.   blockread(f,Sprite^.Data[1],Sprite^.Header.SpriteLength-Kopf);
  341.   {$I+}
  342.   IF (ioresult<>0)
  343.    THEN BEGIN
  344.          Error:=Err_FileIO;
  345.          goto quit_loop;
  346.         END;
  347.  
  348.   SpriteDatenausgeben(sprite^,count,P,N);
  349.   INC(count);
  350.  
  351.  END; {of WHILE}
  352.  
  353. quit_loop: ;
  354.  
  355.  {$I-}
  356.  close(f);
  357.  {$I+}
  358.  
  359.  Put(Fillblanks('DATA ENDS')+' ; to make the assembler happy');
  360.  Put(Fillblanks('END')+' ; that''s all folks!');
  361.  
  362. quit_without_close: ;
  363.  
  364.  IF Error<>Err_None
  365.   THEN WRITELN('*** Error: '+GetErrorMessage);
  366.  
  367.  Dispose(sprite);
  368. END.
  369.