src/Particles.pas

   1 unit Particles;
   2
   3 interface
   4
   5   const
   6     none = 0;
   7     whiteSmoke = 1;
   8     graySmoke = 2;
   9     blackSmoke = 3;
  10     redSmoke = 4;
  11     pinkSmoke = 5;
  12     bubble = 6;
  13     explosion = 7;
  14
  15   var
  16     enabled : boolean;
  17
  18   procedure Create(typ, x, y : integer);
  19   procedure Update;
  20   procedure Draw(camx, camy : integer);
  21
  22   procedure LoadTextures(path : string);
  23   procedure FreeTextures;
  24
  25   procedure SaveData;
  26   procedure LoadData;
  27   procedure ResetData;
  28
  29 implementation
  30
  31   uses vars, maps, func, canvas, jsr75i;
  32
  33   const
  34     lastParticle = 64;
  35
  36   var
  37     tail : integer;
  38     ptype, px, py, pa : array [0..lastParticle] of integer;
  39     smokeSprites : array [0..4, 0..7] of image;
  40     explosionSprites : array [0..15] of image;
  41     bubbleSprite : image;
  42
  43   procedure Create(typ, x, y : integer);
  44     begin
  45       if not enabled then exit;
  46       ptype[tail] := typ;
  47       px[tail] := x;
  48       py[tail] := y;
  49       pa[tail] := 0;
  50       tail := (tail + 1) mod lastParticle;
  51     end;
  52
  53   procedure Update;
  54     var
  55       typ, i : integer;
  56     begin
  57       if not enabled then exit;
  58       for i := 0 to lastParticle do if ptype[i] <> none then begin
  59         typ := ptype[i];
  60         if (typ >= whiteSmoke) and (typ <= pinkSmoke) then begin
  61           py[i] := py[i] - 1;
  62           pa[i] := pa[i] + 1;
  63           if pa[i] > 14 then ptype[i] := none;
  64         end else if typ = bubble then begin
  65           py[i] := py[i] - 1;
  66           if GetMap(px[i] / 16, py[i] / 16) <> 50 then ptype[i] := none;
  67         end else if typ = explosion then begin
  68           pa[i] := pa[i] + 1;
  69           if pa[i] > 15 then ptype[i] := none;
  70         end;
  71       end;
  72     end;
  73
  74   procedure Draw(camx, camy : integer);
  75     var
  76       typ, i : integer;
  77     begin
  78       if not enabled then exit;
  79       for i := 0 to lastParticle do if ptype[i] <> none then begin
  80         typ := ptype[i];
  81         if (typ >= whiteSmoke) and (typ <= pinkSmoke) then begin
  82           DrawImage(smokeSprites[typ - 1, pa[i] / 2], px[i] - camx, py[i] - camy);
  83         end else if typ = bubble then begin
  84           DrawImage(bubbleSprite, px[i] - camx, py[i] - camy)
  85         end else if typ = explosion then begin
  86           DrawImage(explosionSprites[pa[i]], px[i] - camx, py[i] - camy);
  87         end;
  88       end;
  89     end;
  90
  91   procedure LoadTextures(path : string);
  92     var
  93       im : image;
  94       i, j : integer;
  95     begin
  96       if not enabled then exit;
  97       im := ld_tex('particles.png', path, 'terrain/');
  98       for i := 0 to 4 do begin
  99         for j := 0 to 7 do begin
 100           smokeSprites[i, j] := rotate_image_from_image(im, 8 * j, 8 * i, 8, 8, 0);
 101         end;
 102       end;
 103
 104       bubbleSprite := rotate_image_from_image(im, 0, 40, 8, 8, 0);
 105
 106       im := ld_tex('explosion.png', path, 'terrain/');
 107       for i := 0 to 15 do begin
 108         explosionSprites[i] := rotate_image_from_image(im, 32 * i, 0, 32, 32, 0);
 109       end;
 110     end;
 111
 112   procedure FreeTextures;
 113     var
 114       nullimg : image;
 115       i, j : integer;
 116     begin
 117       for i := 0 to 4 do begin
 118         for j := 0 to 7 do begin
 119           smokeSprites[i, j] := nullimg;
 120         end;
 121       end;
 122
 123       bubbleSprite := nullimg;
 124
 125       for i := 0 to 15 do begin
 126         explosionSprites[i] := nullimg;
 127       end;
 128     end;
 129
 130   procedure SaveData;
 131     var
 132       i : integer;
 133     begin
 134       for i := 0 to lastParticle do begin
 135         write_byte(ptype[i]);
 136         WriteInt(px[i]);
 137         WriteInt(py[i]);
 138         WriteInt(pa[i]);
 139       end;
 140     end;
 141
 142   procedure LoadData;
 143     var
 144       i : integer;
 145     begin
 146       for i := 0 to lastParticle do begin
 147         ptype[i] := read_byte;
 148         px[i] := ReadInt;
 149         py[i] := ReadInt;
 150         pa[i] := ReadInt;
 151       end;
 152     end;
 153
 154   procedure ResetData;
 155     var
 156       i : integer;
 157     begin
 158       for i := 0 to lastParticle do begin
 159         ptype[i] := none;
 160         px[i] := 0;
 161         py[i] := 0;
 162         pa[i] := 0;
 163       end;
 164     end;
 165
 166 end.