home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / sprite21 / rotates.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-08  |  5.8 KB  |  206 lines
  1. program RotateSprite;
  2. { Written by Scott Harbour
  3.   Released 15-April-92
  4.   Compiles with Turbo Pascal 5.0+ }
  5.  
  6. uses crt,graph,library,bgidriv;
  7. {$M 64000,0,655360}
  8.  
  9. const spritesize = 30; 
  10.       x1 = 95; y1 = 95; x2 = 135; y2 = 125;
  11. type SpriteInfo = RECORD
  12.        name : STRING[40];
  13.        loc : ARRAY[0..SpriteSize-1,0..SpriteSize-1] OF SHORTINT;
  14.      END;
  15.     movement = (invert,rotate);
  16. var spritefile : file of spriteinfo;
  17.     sprite2,sprite : spriteinfo;
  18.     img : array [1..16] of pointer;
  19.     dist,n,gd,gm : integer;
  20.     r : real;
  21.     key : char;
  22.  
  23. PROCEDURE GetPic(VAR pic : POINTER);
  24. VAR size : WORD;
  25. BEGIN
  26.   size := IMAGESIZE(x1,y1,x2,y2);
  27.   GETMEM(pic,size);
  28.   GETIMAGE(x1,y1,x2,y2,pic^);
  29. END;  { GetPic }
  30.  
  31. PROCEDURE LoadSprite(fn,spr : string; var sprite : spriteinfo);
  32. VAR count,h,k,x1,y1,x2,y2 : WORD;
  33. BEGIN
  34.   if pos('.',fn) = 0 then fn := fn + '.SCF';
  35.   ASSIGN(SpriteFile,fn);
  36.   {$I-} RESET(SpriteFile); {$I+}
  37.   IF IORESULT <> 0 THEN
  38.   BEGIN
  39.     textmode(co80);
  40.     writeln('Sprite file not found - ',UpperCase(fn));
  41.     halt(1);
  42.   END;
  43.   count := 0;
  44.   RESET(SpriteFile);
  45.   WHILE NOT EOF(SpriteFile) DO
  46.   BEGIN
  47.     READ(SpriteFile,Sprite);
  48.     INC(count);
  49.   END;
  50.   IF count > 1 THEN
  51.   BEGIN
  52.     RESET(SpriteFile);
  53.     WHILE (spr<>Sprite.name) AND (NOT EOF(SpriteFile)) DO
  54.       READ(SpriteFile,Sprite);
  55.     IF spr <> Sprite.name THEN
  56.     BEGIN
  57.       TEXTMODE(co80);
  58.       WRITELN('Sprite not found - ',UpperCase(fn), ' | ',UpperCase(spr));
  59.       halt(1);
  60.     END;
  61.     {$I-} CLOSE(SpriteFile); {$I+}
  62.   END ELSE
  63.   BEGIN
  64.     RESET(SpriteFile);
  65.     READ(SpriteFile,Sprite);
  66.     CLOSE(SpriteFile);
  67.   END;
  68.   FOR h := 0 TO 29 DO
  69.     FOR k := 0 TO 29 DO
  70.       if sprite.loc[h,k] = -1 then sprite.loc[h,k] := 0;
  71. END;  { LoadSprite }
  72.  
  73. procedure showsprite(sprite : spriteinfo; x,y : word);
  74. var h,k,c : shortint;
  75. begin
  76.   FOR h := 0 TO 29 DO
  77.     FOR k := 0 TO 29 DO
  78.       if sprite.loc[h,k] <> 0 then
  79.         putpixel(x+h,y+k,sprite.loc[h,k]);
  80. end;
  81.  
  82. procedure rotate_sprite(sprite : spriteinfo; dist,startx,starty : integer);
  83. const ratio = 0.7; rot = 0.017453;
  84. var x,y,oldx,oldy : array [0..29,0..29] of real;
  85.     angle : real;
  86.     firstx,firsty,lastx,lasty,h,k : integer;
  87.     c : array [0..29,0..29] of word;
  88. begin
  89.   angle := dist * rot;
  90.   for h := 0 to 29 do
  91.     for k := 0 to 29 do
  92.     if sprite.loc[h,k] <> 0 then
  93.     begin
  94.       c[h,k] := sprite.loc[h,k];
  95.       x[h,k] := h; y[h,k] := k;
  96.       oldx[h,k] := x[h,k]; oldy[h,k] := y[h,k];
  97.       x[h,k] := (oldx[h,k] * cos(angle))+(oldy[h,k] * sin(angle));
  98.       y[h,k] := (oldy[h,k] * cos(angle))-(oldx[h,k] * sin(angle));
  99.       if c[h,k] <> 0 then
  100.         putpixel(startx+round(x[h,k]),starty+round(y[h,k]*ratio),c[h,k]);
  101.     end;
  102. end;  { rotate_sprite }
  103.  
  104. procedure AlterImage(var sprite : spriteinfo; mvt : MOVEMENT);
  105. VAR h,k,x,y : WORD;
  106.     Temp : SpriteInfo;
  107. BEGIN
  108.   FOR x := 0 TO SpriteSize-1 DO
  109.     FOR y := 0 TO SpriteSize-1 DO
  110.     BEGIN
  111.       CASE mvt OF
  112.         ROTATE : BEGIN
  113.       k := SpriteSize-1-x;
  114.       h := SpriteSize-1-y
  115.     END;
  116.         INVERT : BEGIN
  117.       h := x;
  118.       k := SpriteSize-1-y;
  119.     END;
  120.       END;
  121.       Temp.loc[h,k] := Sprite.loc[x,y];
  122.     END;
  123.   sprite := Temp;
  124. END;  { AlterImage }
  125.  
  126. procedure movearound;
  127. var ship : array [1..16] of pointer;
  128. begin
  129.   for n := 1 to 16 do ship[n] := img[n];
  130.   settextstyle(defaultfont,horizdir,1);
  131.   setcolor(white);
  132.   outtextxy(0,0,'Press LEFT or RIGHT to rotate, ESC to quit');
  133.   n := 1; dist := 16;
  134.   repeat
  135.     putimage(x1,y1,ship[n]^,normalput);
  136.     key := readkey;
  137.     case key of
  138.       #77 : begin
  139.         putimage(x1,y1,ship[n]^,normalput);
  140.         inc(n);
  141.         if n > dist then n := 1;
  142.       end;
  143.       #75 : begin
  144.         putimage(x1,y1,ship[n]^,normalput);
  145.         dec(n);
  146.         if n < 1 then n := dist;
  147.       end;
  148.     end;
  149.   until key = #27;
  150.   closegraph;
  151.   textmode(co80);
  152.   halt;
  153. end;  { movearound }
  154.  
  155. begin
  156.   if registerbgidriver(@egavgadriverproc) < 0 then
  157.     fatal('Graphics driver not found');
  158.   detectgraph(gd,gm);
  159.   if gd <> vga then fatal('VGA required');
  160.   gd := vga; gm := vgamed;
  161.   initgraph(gd,gm,'');
  162.   if graphresult <> 0 then fatal('Graphics driver failure!');
  163.   setlinestyle(solidln,0,1);
  164.   setcolor(white);
  165.   rectangle(x1-1,y1-1,x2+1,y2+1);
  166.   loadsprite('test','',sprite);
  167.   sprite2 := sprite;
  168.   rotate_sprite(sprite,0,100,99);
  169.   getpic(img[1]); putimage(x1,y1,img[1]^,xorput);
  170.   rotate_sprite(sprite,-23,108,96);
  171.   getpic(img[2]); putimage(x1,y1,img[2]^,xorput);
  172.   rotate_sprite(sprite,-45,116,96);
  173.   getpic(img[3]); putimage(x1,y1,img[3]^,xorput);
  174.   rotate_sprite(sprite,-67,124,96);
  175.   getpic(img[4]); putimage(x1,y1,img[4]^,xorput);
  176.   alterimage(sprite,rotate);
  177.   rotate_sprite(sprite,0,101,100);
  178.   getpic(img[5]); putimage(x1,y1,img[5]^,xorput);
  179.   rotate_sprite(sprite,-23,108,98);
  180.   getpic(img[6]); putimage(x1,y1,img[6]^,xorput);
  181.   rotate_sprite(sprite,-45,116,96);
  182.   getpic(img[7]); putimage(x1,y1,img[7]^,xorput);
  183.   rotate_sprite(sprite,-67,123,97);
  184.   getpic(img[8]); putimage(x1,y1,img[8]^,xorput);
  185.   sprite := sprite2;
  186.   alterimage(sprite,invert);
  187.   rotate_sprite(sprite,0,100,100);
  188.   getpic(img[9]); putimage(x1,y1,img[9]^,xorput);
  189.   rotate_sprite(sprite,-23,107,97);
  190.   getpic(img[10]); putimage(x1,y1,img[10]^,xorput);
  191.   rotate_sprite(sprite,-45,115,96);
  192.   getpic(img[11]); putimage(x1,y1,img[11]^,xorput);
  193.   rotate_sprite(sprite,-67,122,96);
  194.   getpic(img[12]); putimage(x1,y1,img[12]^,xorput);
  195.   rotate_sprite(sprite,-89,129,100);
  196.   getpic(img[13]); putimage(x1,y1,img[13]^,xorput);
  197.   rotate_sprite(sprite,-111,133,103);
  198.   getpic(img[14]); putimage(x1,y1,img[14]^,xorput);
  199.   rotate_sprite(sprite,-133,134,109);
  200.   getpic(img[15]); putimage(x1,y1,img[15]^,xorput);
  201.   rotate_sprite(sprite,-155,133,114);
  202.   getpic(img[16]); putimage(x1,y1,img[16]^,xorput);
  203.   movearound;
  204.   closegraph;
  205. end.
  206.