hedgewars/uGearsHandlers.pas
author Wuzzy <Wuzzy2@mail.ru>
Sat, 12 Oct 2019 02:06:11 +0200
changeset 15478 20066da10268
parent 14287 6015b74eea55
permissions -rw-r--r--
Add dynamite fuse sound
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
     1
(*
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10108
diff changeset
     3
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
     4
 *
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
     8
 *
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    12
 * GNU General Public License for more details.
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    13
 *
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    14
 * You should have received a copy of the GNU General Public License
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    15
 * along with this program; if not, write to the Free Software
10108
c68cf030eded update FSF address. note: two sdl include files (by Sam Lantinga) still have the old FSF address in their copyright - but I ain't gonna touch their copyright headers
sheepluva
parents: 10015
diff changeset
    16
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    17
 *)
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    18
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    19
{$INCLUDE "options.inc"}
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    20
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    21
unit uGearsHandlers;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    22
interface
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    23
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    24
uses uTypes;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    25
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    26
function cakeStep(Gear: PGear): boolean;
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    27
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    28
implementation
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    29
13612
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
    30
uses SDLh, uFloat, uCollisions, uVariables, uGearsUtils;
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    31
7398
2b7b939014b5 Start TestCake
unc0rr
parents: 7370
diff changeset
    32
2b7b939014b5 Start TestCake
unc0rr
parents: 7370
diff changeset
    33
9521
8054d9d775fd merge with latest defaul, fixing compiling with fpc, parsing and rendering with pas2c, some minor problems with compiling with clang
koda
parents: 9080
diff changeset
    34
const dirs: array[0..3] of TPoint = ((x: 0;  y: -1),
8054d9d775fd merge with latest defaul, fixing compiling with fpc, parsing and rendering with pas2c, some minor problems with compiling with clang
koda
parents: 9080
diff changeset
    35
                                     (x: 1;  y:  0),
8054d9d775fd merge with latest defaul, fixing compiling with fpc, parsing and rendering with pas2c, some minor problems with compiling with clang
koda
parents: 9080
diff changeset
    36
                                     (x: 0;  y:  1),
8054d9d775fd merge with latest defaul, fixing compiling with fpc, parsing and rendering with pas2c, some minor problems with compiling with clang
koda
parents: 9080
diff changeset
    37
                                     (x: -1; y:  0));
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    38
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    39
procedure PrevAngle(Gear: PGear; dA: LongInt); inline;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    40
begin
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    41
    inc(Gear^.WDTimer);
7721
2b1ad418ba39 - Fix warnings and hints
unc0rr
parents: 7671
diff changeset
    42
    Gear^.Angle := (LongInt(Gear^.Angle) - dA) and 3
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    43
end;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    44
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    45
procedure NextAngle(Gear: PGear; dA: LongInt); inline;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    46
begin
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    47
    inc(Gear^.WDTimer);
7721
2b1ad418ba39 - Fix warnings and hints
unc0rr
parents: 7671
diff changeset
    48
    Gear^.Angle := (LongInt(Gear^.Angle) + dA) and 3
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    49
end;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    50
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    51
function cakeStep(Gear: PGear): boolean;
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    52
var
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    53
    xx, yy, xxn, yyn: LongInt;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    54
    dA: LongInt;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    55
begin
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    56
    dA := hwSign(Gear^.dX);
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    57
    xx := dirs[Gear^.Angle].x;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    58
    yy := dirs[Gear^.Angle].y;
7721
2b1ad418ba39 - Fix warnings and hints
unc0rr
parents: 7671
diff changeset
    59
    xxn := dirs[(LongInt(Gear^.Angle) + dA) and 3].x;
2b1ad418ba39 - Fix warnings and hints
unc0rr
parents: 7671
diff changeset
    60
    yyn := dirs[(LongInt(Gear^.Angle) + dA) and 3].y;
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    61
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    62
    if (xx = 0) then
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    63
        if TestCollisionYwithGear(Gear, yy) <> 0 then
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    64
            PrevAngle(Gear, dA)
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    65
        else
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    66
            begin
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    67
            Gear^.Tag := 0;
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    68
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    69
            if TestCollisionXwithGear(Gear, xxn) <> 0 then
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    70
                Gear^.WDTimer:= 0;
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    71
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    72
            Gear^.Y := Gear^.Y + int2hwFloat(yy);
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    73
            if TestCollisionXwithGear(Gear, xxn) = 0 then
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    74
                begin
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    75
                Gear^.X := Gear^.X + int2hwFloat(xxn);
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    76
                NextAngle(Gear, dA)
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    77
                end
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    78
            end;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    79
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    80
    if (yy = 0) then
9706
5178d2263521 return land word from uCollisions to make decisions based on it. Should be handy for trampoline.
nemo
parents: 9080
diff changeset
    81
        if TestCollisionXwithGear(Gear, xx) <> 0 then
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    82
            PrevAngle(Gear, dA)
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    83
        else
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    84
            begin
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    85
            Gear^.Tag := 0;
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    86
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    87
            if TestCollisionYwithGear(Gear, yyn) <> 0 then
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    88
                Gear^.WDTimer:= 0;
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    89
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    90
            Gear^.X := Gear^.X + int2hwFloat(xx);
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    91
            if TestCollisionYwithGear(Gear, yyn) = 0 then
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    92
                begin
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    93
                Gear^.Y := Gear^.Y + int2hwFloat(yyn);
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    94
                NextAngle(Gear, dA)
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    95
                end
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
    96
            end;
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
    97
13612
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
    98
    // Handle world wrap and bounce edge manually
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
    99
    if (WorldEdge = weWrap) and
14287
6015b74eea55 overall, using LongInt for leftX/rightX results in fewer casts, since most comparisons are against ints.
nemo
parents: 13619
diff changeset
   100
        ((hwRound(Gear^.X) < leftX) or (hwRound(Gear^.X) > rightX)) then
13612
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   101
        begin
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   102
        LeftImpactTimer:= 150;
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   103
        RightImpactTimer:= 150;
13619
c9642782778b Fix cake walking through land when reaching wrap world edge
Wuzzy <Wuzzy2@mail.ru>
parents: 13612
diff changeset
   104
        Gear^.WDTimer:= 0;
c9642782778b Fix cake walking through land when reaching wrap world edge
Wuzzy <Wuzzy2@mail.ru>
parents: 13612
diff changeset
   105
        Gear^.Karma:= 1;
13612
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   106
        end
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   107
    else if (WorldEdge = weBounce) and
14287
6015b74eea55 overall, using LongInt for leftX/rightX results in fewer casts, since most comparisons are against ints.
nemo
parents: 13619
diff changeset
   108
        (((hwRound(Gear^.X) - Gear^.Radius) < leftX) or ((hwRound(Gear^.X) + Gear^.Radius) > rightX)) then
13612
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   109
        begin
14287
6015b74eea55 overall, using LongInt for leftX/rightX results in fewer casts, since most comparisons are against ints.
nemo
parents: 13619
diff changeset
   110
        if (hwRound(Gear^.X) - Gear^.Radius < leftX) then
13612
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   111
            LeftImpactTimer:= 333
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   112
        else
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   113
            RightImpactTimer:= 333;
13619
c9642782778b Fix cake walking through land when reaching wrap world edge
Wuzzy <Wuzzy2@mail.ru>
parents: 13612
diff changeset
   114
        Gear^.Karma:= 2;
13612
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   115
        Gear^.WDTimer:= 0;
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   116
        if (Gear^.Radius > 2) and (Gear^.dX.QWordValue > _0_001.QWordValue) then
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   117
            AddBounceEffectForGear(Gear);
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   118
        end;
212036414957 Make cake bounce off bounce edge, stop cake at wrap edge to prevent other bug
Wuzzy <Wuzzy2@mail.ru>
parents: 11046
diff changeset
   119
9969
f27921b31b61 Cake falls when loses ground
unc0rr
parents: 9706
diff changeset
   120
    cakeStep:= Gear^.WDTimer < 4
7370
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
   121
end;
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
   122
d50b874e7ee8 Introduce uGearsHandlers.pas, for now only part of cake handlers is moved there
unc0rr
parents:
diff changeset
   123
end.