hedgewars/uVisualGears.pas
author unc0rr
Mon, 29 Sep 2008 22:14:23 +0000
changeset 1301 c6fe8a4bfd34
parent 1132 b4c0698fbb6b
child 1505 3a96e93572cb
permissions -rw-r--r--
Fix a bug screwing team selection up in network game (REMOVETEAM message doesn't have teamID, and after removing the team QMap still contains old info, when add and remove team with the same name, total hedgehogs number will be decreased by first team hh number)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
     1
(*
1066
1f1b3686a2b0 Update copyright headers a bit
unc0rr
parents: 1047
diff changeset
     2
 * Hedgewars, a free turn based strategy game
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
     3
 * Copyright (c) 2008 Andrey Korotaev <unC0Rr@gmail.com>
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
     4
 *
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
     8
 *
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    12
 * GNU General Public License for more details.
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    13
 *
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    14
 * You should have received a copy of the GNU General Public License
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    15
 * along with this program; if not, write to the Free Software
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    16
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    17
 *)
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    18
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    19
unit uVisualGears;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    20
interface
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    21
uses SDLh, uConsts, uFloat, GL;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    22
{$INCLUDE options.inc}
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    23
const AllInactive: boolean = false;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    24
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    25
type PVisualGear = ^TVisualGear;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    26
     TVGearStepProcedure = procedure (Gear: PVisualGear; Steps: Longword);
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    27
     TVisualGear = record
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    28
             NextGear, PrevGear: PVisualGear;
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    29
             Frame,
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    30
             FrameTicks: Longword;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    31
             X : hwFloat;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    32
             Y : hwFloat;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    33
             dX: hwFloat;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    34
             dY: hwFloat;
945
4ead9cde4e14 - Start chat implementation: chat strings are on the screen
unc0rr
parents: 938
diff changeset
    35
             mdY: QWord;
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    36
             Angle, dAngle: real;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    37
             Kind: TVisualGearType;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    38
             doStep: TVGearStepProcedure;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    39
             end;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    40
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    41
function  AddVisualGear(X, Y: LongInt; Kind: TVisualGearType): PVisualGear;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    42
procedure ProcessVisualGears(Steps: Longword);
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
    43
procedure DrawVisualGears(Layer: LongWord);
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
    44
procedure DeleteVisualGear(Gear: PVisualGear);
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    45
procedure AddClouds;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    46
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    47
var VisualGearsList: PVisualGear = nil;
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    48
    vobFrameTicks, vobFramesCount: Longword;
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    49
    vobVelocity, vobFallSpeed: LongInt;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    50
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    51
implementation
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    52
uses uWorld, uMisc, uStore;
1047
ca7078116c0c Update explosion graphics
unc0rr
parents: 1046
diff changeset
    53
const cExplFrameTicks = 110;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    54
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    55
// ==================================================================
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    56
procedure doStepFlake(Gear: PVisualGear; Steps: Longword);
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    57
begin
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    58
with Gear^ do
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    59
  begin
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    60
  inc(FrameTicks, Steps);
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    61
  if FrameTicks > vobFrameTicks then
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    62
    begin
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    63
    dec(FrameTicks, vobFrameTicks);
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    64
    inc(Frame);
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    65
    if Frame = vobFramesCount then Frame:= 0
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    66
    end
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    67
  end;
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    68
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    69
Gear^.X:= Gear^.X + (cWindSpeed * 200 + Gear^.dX) * Steps;
808
09ffccb9600a Fix arithmetics
unc0rr
parents: 806
diff changeset
    70
Gear^.Y:= Gear^.Y + (Gear^.dY + cGravity * vobFallSpeed) * Steps;
09ffccb9600a Fix arithmetics
unc0rr
parents: 806
diff changeset
    71
Gear^.Angle:= Gear^.Angle + Gear^.dAngle * Steps;
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    72
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    73
if hwRound(Gear^.X) < -cScreenWidth - 64 then Gear^.X:= int2hwFloat(cScreenWidth + 2048) else
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    74
if hwRound(Gear^.X) > cScreenWidth + 2048 then Gear^.X:= int2hwFloat(-cScreenWidth - 64);
938
0c8d2085fa71 Add City theme by Tiyuri
unc0rr
parents: 853
diff changeset
    75
if hwRound(Gear^.Y) > 1100 then Gear^.Y:= Gear^.Y - int2hwFloat(1228)
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    76
end;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
    77
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    78
procedure doStepCloud(Gear: PVisualGear; Steps: Longword);
1079
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    79
var i: Longword;
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    80
begin
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    81
Gear^.X:= Gear^.X + (cWindSpeed * 200 + Gear^.dX) * Steps;
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    82
1079
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    83
for i:= 0 to Steps - 1 do
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    84
	begin
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    85
	if hwRound(Gear^.Y) > -160 then
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    86
		Gear^.dY:= Gear^.dY - _1div50000
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    87
	else
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    88
		Gear^.dY:= Gear^.dY + _1div50000;
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    89
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    90
	Gear^.Y:= Gear^.Y + Gear^.dY
2a4a8a5ca392 Fix clouds shaking up
unc0rr
parents: 1066
diff changeset
    91
	end;
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
    92
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    93
if hwRound(Gear^.X) < -cScreenWidth - 256 then Gear^.X:= int2hwFloat(cScreenWidth + 2048) else
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    94
if hwRound(Gear^.X) > cScreenWidth + 2048 then Gear^.X:= int2hwFloat(-cScreenWidth - 256)
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    95
end;
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
    96
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
    97
procedure doStepExpl(Gear: PVisualGear; Steps: Longword);
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
    98
begin
1046
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
    99
Gear^.X:= Gear^.X + Gear^.dX * Steps;
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   100
1046
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   101
Gear^.Y:= Gear^.Y + Gear^.dY * Steps;
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   102
//Gear^.dY:= Gear^.dY + cGravity;
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   103
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   104
if Gear^.FrameTicks <= Steps then
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   105
	if Gear^.Frame = 0 then DeleteVisualGear(Gear)
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   106
	else
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   107
		begin
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   108
		dec(Gear^.Frame);
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   109
		Gear^.FrameTicks:= cExplFrameTicks
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   110
		end
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   111
	else dec(Gear^.FrameTicks, Steps)
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   112
end;
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   113
1046
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   114
procedure doStepFire(Gear: PVisualGear; Steps: Longword);
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   115
begin
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   116
Gear^.X:= Gear^.X + Gear^.dX * Steps;
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   117
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   118
Gear^.Y:= Gear^.Y + Gear^.dY * Steps;// + cGravity * (Steps * Steps);
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   119
Gear^.dY:= Gear^.dY + cGravity * Steps;
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   120
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   121
if Gear^.FrameTicks <= Steps then
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   122
	DeleteVisualGear(Gear)
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   123
else
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   124
	dec(Gear^.FrameTicks, Steps)
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   125
end;
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   126
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
   127
// ==================================================================
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   128
const doStepHandlers: array[TVisualGearType] of TVGearStepProcedure =
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   129
                        (
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
   130
                          @doStepFlake,
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   131
                          @doStepCloud,
1046
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   132
                          @doStepExpl,
1047
ca7078116c0c Update explosion graphics
unc0rr
parents: 1046
diff changeset
   133
                          @doStepExpl,
1046
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   134
                          @doStepFire
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   135
                        );
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   136
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   137
function  AddVisualGear(X, Y: LongInt; Kind: TVisualGearType): PVisualGear;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   138
var Result: PVisualGear;
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   139
	t: Longword;
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   140
	sp: hwFloat;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   141
begin
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   142
New(Result);
812
cbc392576990 Fix memory corrupt due to wrong parameter in sizeof()
unc0rr
parents: 808
diff changeset
   143
FillChar(Result^, sizeof(TVisualGear), 0);
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   144
Result^.X:= int2hwFloat(X);
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   145
Result^.Y:= int2hwFloat(Y);
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   146
Result^.Kind := Kind;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   147
Result^.doStep:= doStepHandlers[Kind];
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   148
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
   149
case Kind of
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   150
   vgtFlake: with Result^ do
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   151
               begin
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   152
               FrameTicks:= random(vobFrameTicks);
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   153
               Frame:= random(vobFramesCount);
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   154
               Angle:= random * 360;
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   155
               dx.isNegative:= random(2) = 0;
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   156
               dx.QWordValue:= random(100000000);
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   157
               dy.isNegative:= false;
806
d397c502a5dd Finish flakes implementation
unc0rr
parents: 805
diff changeset
   158
               dy.QWordValue:= random(70000000);
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   159
               dAngle:= (random(2) * 2 - 1) * (1 + random) * vobVelocity / 1000
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   160
               end;
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   161
   vgtCloud: with Result^ do
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   162
               begin
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   163
               Frame:= random(4);
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   164
               dx.isNegative:= random(2) = 0;
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   165
               dx.QWordValue:= random(214748364);
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   166
               dy.isNegative:= random(2) = 0;
945
4ead9cde4e14 - Start chat implementation: chat strings are on the screen
unc0rr
parents: 938
diff changeset
   167
               dy.QWordValue:= 21474836 + random(64424509);
4ead9cde4e14 - Start chat implementation: chat strings are on the screen
unc0rr
parents: 938
diff changeset
   168
               mdY:= dy.QWordValue
805
4d75759b38bd Flakes concept, still need some development
unc0rr
parents: 803
diff changeset
   169
               end;
1047
ca7078116c0c Update explosion graphics
unc0rr
parents: 1046
diff changeset
   170
  vgtExplPart,
ca7078116c0c Update explosion graphics
unc0rr
parents: 1046
diff changeset
   171
 vgtExplPart2: with Result^ do
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   172
               begin
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   173
               t:= random(1024);
1047
ca7078116c0c Update explosion graphics
unc0rr
parents: 1046
diff changeset
   174
               sp:= _0_001 * (random(95) + 70);
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   175
               dx:= AngleSin(t) * sp;
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   176
               dx.isNegative:= random(2) = 0;
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   177
               dy:= AngleCos(t) * sp;
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   178
               dy.isNegative:= random(2) = 0;
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   179
               Frame:= 7 - random(3);
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   180
               FrameTicks:= cExplFrameTicks
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   181
               end;
1046
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   182
      vgtFire: with Result^ do
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   183
               begin
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   184
               t:= random(1024);
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   185
               sp:= _0_001 * (random(85) + 95);
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   186
               dx:= AngleSin(t) * sp;
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   187
               dx.isNegative:= random(2) = 0;
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   188
               dy:= AngleCos(t) * sp;
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   189
               dy.isNegative:= random(2) = 0;
1047
ca7078116c0c Update explosion graphics
unc0rr
parents: 1046
diff changeset
   190
               FrameTicks:= 650 + random(250);
1046
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   191
               Frame:= random(8)
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   192
               end;
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
   193
     end;
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
   194
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   195
if VisualGearsList <> nil then
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   196
   begin
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   197
   VisualGearsList^.PrevGear:= Result;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   198
   Result^.NextGear:= VisualGearsList
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   199
   end;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   200
VisualGearsList:= Result;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   201
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   202
AddVisualGear:= Result
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   203
end;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   204
1041
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   205
procedure DeleteVisualGear(Gear: PVisualGear);
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   206
begin
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   207
if Gear^.NextGear <> nil then Gear^.NextGear^.PrevGear:= Gear^.PrevGear;
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   208
if Gear^.PrevGear <> nil then Gear^.PrevGear^.NextGear:= Gear^.NextGear
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   209
   else VisualGearsList:= Gear^.NextGear;
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   210
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   211
Dispose(Gear)
362b95d49cf4 - Fix previous commit
unc0rr
parents: 945
diff changeset
   212
end;
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   213
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   214
procedure ProcessVisualGears(Steps: Longword);
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   215
var Gear, t: PVisualGear;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   216
begin
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
   217
if Steps = 0 then exit;
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
   218
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   219
t:= VisualGearsList;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   220
while t <> nil do
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   221
      begin
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   222
      Gear:= t;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   223
      t:= Gear^.NextGear;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   224
      Gear^.doStep(Gear, Steps)
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   225
      end
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   226
end;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   227
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   228
procedure DrawVisualGears(Layer: LongWord);
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   229
var Gear: PVisualGear;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   230
begin
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   231
Gear:= VisualGearsList;
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   232
case Layer of
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   233
	0: while Gear <> nil do
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   234
		begin
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   235
		case Gear^.Kind of
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   236
			vgtFlake: if vobVelocity = 0 then
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   237
						DrawSprite(sprFlake, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Frame)
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   238
					else
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   239
						DrawRotatedF(sprFlake, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Frame, 1, Gear^.Angle);
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   240
			vgtCloud: DrawSprite(sprCloud, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Frame);
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   241
			end;
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   242
		Gear:= Gear^.NextGear
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   243
		end;
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   244
	1: while Gear <> nil do
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   245
		begin
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   246
		case Gear^.Kind of
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   247
			vgtExplPart: DrawSprite(sprExplPart, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 7 - Gear^.Frame);
1047
ca7078116c0c Update explosion graphics
unc0rr
parents: 1046
diff changeset
   248
			vgtExplPart2: DrawSprite(sprExplPart2, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 7 - Gear^.Frame);
1046
c22d833c3ae2 Better ?? implementation of explosion
unc0rr
parents: 1045
diff changeset
   249
			vgtFire: DrawSprite(sprFlame, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, (RealTicks div 64 + Gear^.Frame) mod 8);
1045
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   250
			end;
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   251
		Gear:= Gear^.NextGear
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   252
		end
ea195268734f Testing explosion particles implementation
unc0rr
parents: 1041
diff changeset
   253
	end
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   254
end;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   255
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   256
procedure AddClouds;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   257
var i: LongInt;
803
3f73901a350a - Use cloud as 'visual gear'
unc0rr
parents: 802
diff changeset
   258
begin
1132
b4c0698fbb6b - Fix problem when clouds number is 0
unc0rr
parents: 1079
diff changeset
   259
for i:= 0 to cCloudsNumber - 1 do
b4c0698fbb6b - Fix problem when clouds number is 0
unc0rr
parents: 1079
diff changeset
   260
    AddVisualGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div (cCloudsNumber + 1)), -160, vgtCloud)
802
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   261
end;
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   262
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   263
initialization
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   264
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   265
finalization
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   266
ed5450a89b96 Start implementing 'visual gears' - gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
diff changeset
   267
end.