--- a/CMakeLists.txt Tue Jan 21 22:44:37 2014 +0100
+++ b/CMakeLists.txt Tue Jan 21 22:53:15 2014 +0100
@@ -41,6 +41,8 @@
set(DATA_INSTALL_DIR "share/hedgewars" CACHE STRING "Resource folder path")
endif()
+option(NOVERSIONINFOUPDATE "Disable update of version_info.txt. To be used if source is in a git/repo that is NOT the hedgewars repo" OFF)
+
#system paths for finding required fonts (see share/hedgewars/Data/fonts)
#subdirectories will NOT be searched.
#all fonts that can't be found will be bundled with hedgewars
@@ -234,4 +236,11 @@
set(LUAAPITESTS "${LUATESTS}/luaAPI")
set(TESTSDATADIR "${CMAKE_SOURCE_DIR}/share/hedgewars/Data")
-add_test("LuaAPI:GetZoom/SetZoom" "bin/hwengine" "--prefix" "${TESTSDATADIR}" "--lua-test" "${LUATESTS}/luaAPI/zoom_get_set.lua")
+
+add_test("LuaAPI:GetZoom/SetZoom" "bin/hwengine" "--prefix" "${TESTSDATADIR}" "--nosound" "--nomusic" "--lua-test" "${LUAAPITESTS}/zoom_get_set.lua")
+
+# set set this to "" if you want to see what's going on
+set(STATSONLYFLAG "--stats-only")
+add_test("LuaAPI:GetGravity/SetGravity" "bin/hwengine" "--prefix" "${TESTSDATADIR}" "--nosound" "--nomusic" ${STATSONLYFLAG} "--lua-test" "${LUAAPITESTS}/gravity_get_set.lua")
+add_test("DrillRockets_drill" "bin/hwengine" "--prefix" "${TESTSDATADIR}" "--nosound" "--nomusic" ${STATSONLYFLAG} "--lua-test" "${LUATESTS}/drillrockets_drill.lua")
+add_test("DrillRockets_boom" "bin/hwengine" "--prefix" "${TESTSDATADIR}" "--nosound" "--nomusic" ${STATSONLYFLAG} "--lua-test" "${LUATESTS}/drillrockets_boom.lua")
--- a/gameServer/EngineInteraction.hs Tue Jan 21 22:44:37 2014 +0100
+++ b/gameServer/EngineInteraction.hs Tue Jan 21 22:53:15 2014 +0100
@@ -1,18 +1,20 @@
{-# LANGUAGE OverloadedStrings #-}
-module EngineInteraction where
+module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData) where
import qualified Data.Set as Set
import Control.Monad
import qualified Codec.Binary.Base64 as Base64
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString as BW
+import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as Map
import qualified Data.List as L
import Data.Word
import Data.Bits
import Control.Arrow
import Data.Maybe
+import Codec.Compression.Zlib as Z
-------------
import CoreTypes
import Utils
@@ -28,6 +30,11 @@
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
removeLength _ = Nothing
+em :: B.ByteString -> B.ByteString
+em = toEngineMsg
+
+eml :: [B.ByteString] -> B.ByteString
+eml = em . B.concat
splitMessages :: B.ByteString -> [B.ByteString]
splitMessages = L.unfoldr (\b -> if B.null b then Nothing else Just $ B.splitAt (1 + fromIntegral (BW.head b)) b)
@@ -72,16 +79,14 @@
, [em "!"]
]
where
- em = toEngineMsg
- eml = em . B.concat
mapGenTypes = ["+rnd+", "+maze+", "+drawn+"]
maybeScript = let s = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
maybeMap = let m = mParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]]
scheme = tail $ prms Map.! "SCHEME"
mapgen = mParams Map.! "MAPGEN"
mapgenSpecific = case mapgen of
- "+maze+" -> [eml ["e$maze_size ", head $ prms Map.! "MAZE_SIZE"]]
- "+drawn" -> drawnMapData . head $ prms Map.! "DRAWNMAP"
+ "1" -> [eml ["e$maze_size ", head $ prms Map.! "MAZE_SIZE"]]
+ "2" -> drawnMapData . head $ prms Map.! "DRAWNMAP"
_ -> []
gameFlags :: Word32
gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .|. f) 0 $ zip scheme gameFlagConsts
@@ -108,7 +113,20 @@
)
drawnMapData :: B.ByteString -> [B.ByteString]
-drawnMapData = error "drawnMapData"
+drawnMapData =
+ L.map (\m -> eml ["edraw ", BW.pack m])
+ . L.unfoldr by200
+ . BL.unpack
+ . Z.decompress
+ . BL.pack
+ . L.drop 4
+ . fromMaybe []
+ . Base64.decode
+ . B.unpack
+ where
+ by200 :: [a] -> Maybe ([a], [a])
+ by200 [] = Nothing
+ by200 m = Just $ L.splitAt 200 m
schemeParams :: [(B.ByteString, Int)]
schemeParams = [
--- a/gameServer/HWProtoInRoomState.hs Tue Jan 21 22:44:37 2014 +0100
+++ b/gameServer/HWProtoInRoomState.hs Tue Jan 21 22:53:15 2014 +0100
@@ -14,7 +14,7 @@
import HandlerUtils
import RoomsAndClients
import EngineInteraction
-
+import Votes
startGame :: Reader (ClientIndex, IRnC) [Action]
startGame = do
@@ -397,6 +397,35 @@
rm <- thisRoom
return [ModifyRoom (\r -> r{greeting = msg}) | isAdministrator cl || (isMaster cl && (not $ isSpecial rm))]
+
+handleCmd_inRoom ["CALLVOTE"] = do
+ cl <- thisClient
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", "Available callvote commands: kick <nickname>"]]
+
+handleCmd_inRoom ["CALLVOTE", "KICK"] = do
+ cl <- thisClient
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: specify nickname"]]
+
+handleCmd_inRoom ["CALLVOTE", "KICK", nickname] = do
+ (thisClientId, rnc) <- ask
+ cl <- thisClient
+ maybeClientId <- clientByNick nickname
+ let kickId = fromJust maybeClientId
+ let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId
+
+ if isJust maybeClientId && sameRoom then
+ startVote $ VoteKick nickname
+ else
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: no such user"]]
+
+handleCmd_inRoom ["VOTE", m] = do
+ cl <- thisClient
+ let b = if m == "YES" then Just True else if m == "NO" then Just False else Nothing
+ if isJust b then
+ voted (clUID cl) (fromJust b)
+ else
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", "vote: 'yes' or 'no'"]]
+
handleCmd_inRoom ["LIST"] = return [] -- for old clients (<= 0.9.17)
handleCmd_inRoom (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in room)"]
--- a/hedgewars/uGearsHandlersMess.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uGearsHandlersMess.pas Tue Jan 21 22:53:15 2014 +0100
@@ -3010,6 +3010,8 @@
FollowGear := Gear;
+ Gear^.dY:= cMaxWindSpeed * 100;
+
Gear^.doStep := @doStepCakeFall
end;
@@ -3192,7 +3194,7 @@
procedure doStepDrill(Gear: PGear);
var
t: PGearArray;
- oldDx, oldDy: hwFloat;
+ oldX, oldY, oldDx, oldDy: hwFloat;
t2: hwFloat;
begin
AllInactive := false;
@@ -3202,6 +3204,8 @@
oldDx := Gear^.dX;
oldDy := Gear^.dY;
+ oldX := Gear^.X;
+ oldY := Gear^.Y;
doStepFallingGear(Gear);
@@ -3217,6 +3221,8 @@
//hit
Gear^.dX := oldDx;
Gear^.dY := oldDy;
+ Gear^.X := oldX;
+ Gear^.Y := oldY;
if GameTicks > Gear^.FlightTime then
t := CheckGearsCollision(Gear)
@@ -3241,6 +3247,8 @@
exit;
end;
+ Gear^.X:= Gear^.X+Gear^.dX*4;
+ Gear^.Y:= Gear^.Y+Gear^.dY*4;
Gear^.SoundChannel := LoopSound(sndDrillRocket);
Gear^.doStep := @doStepDrillDrilling;
--- a/hedgewars/uGearsList.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uGearsList.pas Tue Jan 21 22:53:15 2014 +0100
@@ -20,7 +20,7 @@
unit uGearsList;
interface
-uses uFloat, uTypes;
+uses uFloat, uTypes, SDLh;
function AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
procedure DeleteGear(Gear: PGear);
@@ -156,6 +156,7 @@
function AddGear(X, Y: LongInt; Kind: TGearType; State: Longword; dX, dY: hwFloat; Timer: LongWord): PGear;
var gear: PGear;
+ c: byte;
begin
inc(GCounter);
@@ -182,6 +183,7 @@
// Define ammo association, if any.
gear^.AmmoType:= GearKindAmmoTypeMap[Kind];
gear^.CollisionMask:= $FFFF;
+gear^.Tint:= $FFFFFFFF;
if CurrentHedgehog <> nil then
begin
@@ -237,6 +239,18 @@
if (GameFlags and gfAISurvival) <> 0 then
if gear^.Hedgehog^.BotLevel > 0 then
gear^.Hedgehog^.Effects[heResurrectable] := 1;
+ // this would presumably be set in the frontend
+ // if we weren't going to do that yet, would need to reinit GetRandom
+ // oh, and, randomising slightly R and B might be nice too.
+ //gear^.Tint:= $fa00efff or ((random(80)+128) shl 16)
+ //gear^.Tint:= $faa4efff
+ //gear^.Tint:= (($e0+random(32)) shl 24) or
+ // ((random(80)+128) shl 16) or
+ // (($d5+random(32)) shl 8) or $ff
+ c:= random(32);
+ gear^.Tint:= (($e0+c) shl 24) or
+ ((random(90)+128) shl 16) or
+ (($d5+c) shl 8) or $ff
end;
gtShell: begin
gear^.Elasticity:= _0_8;
@@ -274,6 +288,9 @@
Health:= random(vobFrameTicks);
if gear^.Timer = 0 then Timer:= random(vobFramesCount);
Damage:= (random(2) * 2 - 1) * (vobVelocity + random(vobVelocity)) * 8;
+ Tint:= (ExplosionBorderColor and RMask shl RShift) or
+ (ExplosionBorderColor and GMask shl GShift) or
+ (ExplosionBorderColor and BMask shl BShift) or $FF;
end
end;
gtGrave: begin
@@ -402,7 +419,10 @@
gear^.Radius:= 15;
gear^.Tag:= Y
end;
- gtAirAttack: gear^.Z:= cHHZ+2;
+ gtAirAttack: begin
+ gear^.Z:= cHHZ+2;
+ gear^.Tint:= gear^.Hedgehog^.Team^.Clan^.Color shl 8 or $FF
+ end;
gtAirBomb: begin
gear^.Radius:= 5;
gear^.Density:= _2;
@@ -487,7 +507,8 @@
gtRCPlane: begin
if gear^.Timer = 0 then gear^.Timer:= 15000;
gear^.Health:= 3;
- gear^.Radius:= 8
+ gear^.Radius:= 8;
+ gear^.Tint:= gear^.Hedgehog^.Team^.Clan^.Color shl 8 or $FF
end;
gtJetpack: begin
gear^.Health:= 2000;
@@ -546,10 +567,12 @@
gtPoisonCloud: begin
if gear^.Timer = 0 then gear^.Timer:= 5000;
gear^.dY:= int2hwfloat(-4 + longint(getRandom(8))) / 1000;
+ gear^.Tint:= $C0C000C0
end;
gtResurrector: begin
gear^.Radius := 100;
- gear^.Tag := 0
+ gear^.Tag := 0;
+ gear^.Tint:= $F5DB35FF
end;
gtWaterUp: begin
gear^.Tag := 47;
--- a/hedgewars/uGearsRender.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uGearsRender.pas Tue Jan 21 22:53:15 2014 +0100
@@ -808,13 +808,24 @@
begin
if defaultPos then
begin
- if HH^.Team^.hasGone then Tint($FF, $FF, $FF, $80);
+ if HH^.Team^.hasGone then
+ Tint($FFFFFF80)
+ else if HH^.Effects[hePoisoned] <> 0 then
+ Tint($B7FFBCFF)
+ else Tint(HH^.Gear^.Tint);
DrawSpriteRotatedF(sprHHIdle,
sx,
sy,
(RealTicks div 128 + Gear^.Pos) mod 19,
sign,
0);
+ untint;
+ DrawSpriteRotatedF(sprHHIdle,
+ sx,
+ sy,
+ (RealTicks div 128 + Gear^.Pos) mod 19 + 32,
+ sign,
+ 0);
HatVisible:= true;
end;
@@ -1052,7 +1063,7 @@
gtRCPlane: begin
aangle:= Gear^.Angle * 360 / 4096;
if Gear^.Tag < 0 then aangle:= 360-aangle;
- Tint(Gear^.Hedgehog^.Team^.Clan^.Color shl 8 or $FF);
+ Tint(Gear^.Tint);
DrawSpriteRotatedF(sprPlane, x, y, 0, Gear^.Tag, aangle - 90);
untint;
DrawSpriteRotatedF(sprPlane, x, y, 1, Gear^.Tag, aangle - 90)
@@ -1174,7 +1185,7 @@
DrawAltWeapon(Gear, x + 1, y - 3)
end;
gtAirAttack: begin
- Tint(Gear^.Hedgehog^.Team^.Clan^.Color shl 8 or $FF);
+ Tint(Gear^.Tint);
DrawSpriteRotatedF(sprAirplane, x, y, 0, Gear^.Tag, 0);
untint;
DrawSpriteRotatedF(sprAirplane, x, y, 1, Gear^.Tag, 0);
@@ -1250,27 +1261,24 @@
end;
gtPoisonCloud: begin
if Gear^.Timer < 1020 then
- Tint($C0, $C0, $00, Gear^.Timer div 8)
+ Tint(Gear^.Tint and $FFFFFF00 or Gear^.Timer div 8)
else if Gear^.Timer > 3980 then
- Tint($C0, $C0, $00, (5000 - Gear^.Timer) div 8)
+ Tint(Gear^.Tint and $FFFFFF00 or (5000 - Gear^.Timer) div 8)
else
- Tint($C0, $C0, $00, $C0);
+ Tint(Gear^.Tint);
DrawTextureRotatedF(SpritesData[sprSmokeWhite].texture, 3, 0, 0, x, y, 0, 1, 22, 22, (RealTicks shr 36 + Gear^.UID * 100) mod 360);
untint
end;
gtResurrector: begin
DrawSpriteRotated(sprCross, x, y, 0, 0);
- Tint($f5, $db, $35, max($00, round($C0 * abs(1 - (GameTicks mod 6000) / 3000))));
+ Tint(Gear^.Tint and $FFFFFF00 or max($00, round($C0 * abs(1 - (GameTicks mod 6000) / 3000))));
DrawTexture(x - 108, y - 108, SpritesData[sprVampiric].Texture, 4.5);
untint;
end;
gtNapalmBomb: DrawSpriteRotated(sprNapalmBomb, x, y, 0, DxDy2Angle(Gear^.dY, Gear^.dX));
gtFlake: if Gear^.State and (gstDrowning or gstTmpFlag) <> 0 then
begin
- Tint((ExplosionBorderColor shr RShift) and $FF,
- (ExplosionBorderColor shr GShift) and $FF,
- (ExplosionBorderColor shr BShift) and $FF,
- $FF);
+ Tint(Gear^.Tint);
// Needs a nicer white texture to tint
DrawTextureRotatedF(SpritesData[sprSnowDust].Texture, 1, 0, 0, x, y, 0, 1, 8, 8, Gear^.DirAngle);
//DrawSpriteRotated(sprSnowDust, x, y, 0, Gear^.DirAngle);
--- a/hedgewars/uLand.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uLand.pas Tue Jan 21 22:53:15 2014 +0100
@@ -31,7 +31,7 @@
implementation
uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, SysUtils,
uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures,
- uLandGenMaze, uLandOutline, uPhysFSLayer;
+ uLandGenMaze, uLandOutline, uPhysFSLayer, uScript;
var digest: shortstring;
@@ -60,6 +60,13 @@
end;
end;
+procedure PrettifyLandAlpha();
+begin
+ if (cReducedQuality and rqBlurryLand) <> 0 then
+ PrettifyAlpha2D(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2)
+ else
+ PrettifyAlpha2D(LandPixels, LAND_HEIGHT, LAND_WIDTH);
+end;
procedure DrawBorderFromImage(Surface: PSDL_Surface);
var tmpsurf: PSDL_Surface;
@@ -811,6 +818,8 @@
LandPixels[y,x]:= w or (LandPixels[y div 2, x div 2] and AMask)
end
end;
+
+PrettifyLandAlpha();
end;
procedure GenPreview(out Preview: TPreview);
@@ -877,6 +886,8 @@
adler:= Adler32Update(adler, @Land[i,0], LAND_WIDTH);
s:= 'M' + IntToStr(adler) + cScriptName;
+ ScriptSetString('LandDigest', s);
+
chLandCheck(s);
SendIPCRaw(@s[0], Length(s) + 1)
end;
--- a/hedgewars/uLandGraphics.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uLandGraphics.pas Tue Jan 21 22:53:15 2014 +0100
@@ -679,6 +679,7 @@
function Despeckle(X, Y: LongInt): boolean;
var nx, ny, i, j, c, xx, yy: LongInt;
pixelsweep: boolean;
+
begin
Despeckle:= true;
@@ -709,11 +710,14 @@
begin
if ((cReducedQuality and rqBlurryLand) <> 0) then
begin
- nx:= nx div 2;
- ny:= ny div 2
- end;
- if LandPixels[ny, nx] <> 0 then
- inc(c);
+ ny:= Y div 2 + i;
+ nx:= X div 2 + j;
+ if ((ny and (LAND_HEIGHT_MASK div 2)) = 0) and ((nx and (LAND_WIDTH_MASK div 2)) = 0) then
+ if LandPixels[ny, nx] <> 0 then
+ inc(c);
+ end
+ else if LandPixels[ny, nx] <> 0 then
+ inc(c);
end
else if Land[ny, nx] > 255 then
inc(c);
--- a/hedgewars/uLandTexture.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uLandTexture.pas Tue Jan 21 22:53:15 2014 +0100
@@ -33,6 +33,8 @@
uses uConsts, GLunit, uTypes, uVariables, uTextures, uDebug, uRender;
const TEXSIZE = 128;
+ // in avoid tile borders stretch the blurry texture by 1 pixel more
+ BLURRYLANDOVERLAP = 1 / TEXSIZE / 2.0; // 1 pixel divided by texsize and blurry land scale factor
type TLandRecord = record
shouldUpdate, landAdded: boolean;
@@ -181,9 +183,10 @@
if tex <> nil then
if (cReducedQuality and rqBlurryLand) = 0 then
DrawTexture(dX + x * TEXSIZE, dY + y * TEXSIZE, tex)
- else
+ else if (cReducedQuality and rqClampLess) = 0 then
DrawTexture(dX + x * TEXSIZE * 2, dY + y * TEXSIZE * 2, tex, 2.0)
-
+ else
+ DrawTexture2(dX + x * TEXSIZE * 2, dY + y * TEXSIZE * 2, tex, 2.0, BLURRYLANDOVERLAP);
end;
procedure SetLandTexture;
--- a/hedgewars/uRender.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uRender.pas Tue Jan 21 22:53:15 2014 +0100
@@ -34,6 +34,7 @@
procedure DrawTexture (X, Y: LongInt; Texture: PTexture); inline;
procedure DrawTexture (X, Y: LongInt; Texture: PTexture; Scale: GLfloat);
+procedure DrawTexture2 (X, Y: LongInt; Texture: PTexture; Scale, Overlap: GLfloat);
procedure DrawTextureFromRect (X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture); inline;
procedure DrawTextureFromRect (X, Y, W, H: LongInt; r: PSDL_Rect; SourceTexture: PTexture); inline;
procedure DrawTextureFromRectDir(X, Y, W, H: LongInt; r: PSDL_Rect; SourceTexture: PTexture; Dir: LongInt);
@@ -181,6 +182,33 @@
end;
+{ this contains tweaks in order to avoid land tile borders in blurry land mode }
+procedure DrawTexture2(X, Y: LongInt; Texture: PTexture; Scale, Overlap: GLfloat);
+var
+ TextureBuffer: array [0..3] of TVertex2f;
+begin
+glPushMatrix();
+glTranslatef(X, Y, 0);
+glScalef(Scale, Scale, 1);
+
+glBindTexture(GL_TEXTURE_2D, Texture^.id);
+
+TextureBuffer[0].X:= Texture^.tb[0].X + Overlap;
+TextureBuffer[0].Y:= Texture^.tb[0].Y + Overlap;
+TextureBuffer[1].X:= Texture^.tb[1].X - Overlap;
+TextureBuffer[1].Y:= Texture^.tb[1].Y + Overlap;
+TextureBuffer[2].X:= Texture^.tb[2].X - Overlap;
+TextureBuffer[2].Y:= Texture^.tb[2].Y - Overlap;
+TextureBuffer[3].X:= Texture^.tb[3].X + Overlap;
+TextureBuffer[3].Y:= Texture^.tb[3].Y - Overlap;
+
+glVertexPointer(2, GL_FLOAT, 0, @Texture^.vb);
+glTexCoordPointer(2, GL_FLOAT, 0, @TextureBuffer);
+glDrawArrays(GL_TRIANGLE_FAN, 0, Length(Texture^.vb));
+
+glPopMatrix();
+end;
+
procedure DrawTextureF(Texture: PTexture; Scale: GLfloat; X, Y, Frame, Dir, w, h: LongInt);
begin
DrawTextureRotatedF(Texture, Scale, 0, 0, X, Y, Frame, Dir, w, h, 0)
--- a/hedgewars/uRenderUtils.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uRenderUtils.pas Tue Jan 21 22:53:15 2014 +0100
@@ -302,7 +302,7 @@
var textWidth, textHeight, x, y, w, h, i, j, pos, prevpos, line, numLines, edgeWidth, edgeHeight, cornerWidth, cornerHeight: LongInt;
finalSurface, tmpsurf, rotatedEdge: PSDL_Surface;
rect: TSDL_Rect;
- //chars: set of char = [#9,' ',';',':','?','!',','];
+ chars: set of char = [#9,' ',';',':','?','!',','];
substr: shortstring;
edge, corner, tail: TSPrite;
begin
--- a/hedgewars/uScript.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uScript.pas Tue Jan 21 22:53:15 2014 +0100
@@ -245,30 +245,66 @@
function lc_enablegameflags(L : Plua_State) : LongInt; Cdecl;
var i : integer;
begin
- for i:= 1 to lua_gettop(L) do
- GameFlags := GameFlags or LongWord(lua_tointeger(L, i));
- ScriptSetInteger('GameFlags', GameFlags);
+ if lua_gettop(L) = 0 then
+ begin
+ LuaParameterCountError('EnableGameFlags', '', lua_gettop(L));
+ lua_pushnil(L);
+ end
+ else
+ begin
+ for i:= 1 to lua_gettop(L) do
+ GameFlags := GameFlags or LongWord(lua_tointeger(L, i));
+ ScriptSetInteger('GameFlags', GameFlags);
+ end;
lc_enablegameflags:= 0;
end;
function lc_disablegameflags(L : Plua_State) : LongInt; Cdecl;
var i : integer;
begin
- for i:= 1 to lua_gettop(L) do
- GameFlags := (GameFlags and (not (LongWord(lua_tointeger(L, i)))));
- ScriptSetInteger('GameFlags', GameFlags);
+ if lua_gettop(L) = 0 then
+ begin
+ LuaParameterCountError('DisableGameFlags', '', lua_gettop(L));
+ lua_pushnil(L);
+ end
+ else
+ begin
+ for i:= 1 to lua_gettop(L) do
+ GameFlags := GameFlags and not(LongWord(lua_tointeger(L, i)));
+ ScriptSetInteger('GameFlags', GameFlags);
+ end;
lc_disablegameflags:= 0;
end;
function lc_cleargameflags(L : Plua_State) : LongInt; Cdecl;
begin
- // Silence hint
- L:= L;
- GameFlags:= 0;
- ScriptSetInteger('GameFlags', GameFlags);
+ if lua_gettop(L) <> 0 then
+ begin
+ LuaParameterCountError('ClearGameFlags', '', lua_gettop(L));
+ lua_pushnil(L);
+ end
+ else
+ begin
+ GameFlags:= 0;
+ ScriptSetInteger('GameFlags', GameFlags);
+ end;
lc_cleargameflags:= 0;
end;
+function lc_getgameflag(L : Plua_State) : LongInt; Cdecl;
+begin
+ if lua_gettop(L) <> 1 then
+ begin
+ LuaParameterCountError('GetGameFlag', 'gameflag', lua_gettop(L));
+ lua_pushnil(L);
+ end
+ else
+ begin
+ lua_pushboolean(L, (GameFlags and LongWord(lua_tointeger(L, 1)) <> 0));
+ end;
+ lc_getgameflag:= 1;
+end;
+
function lc_addcaption(L : Plua_State) : LongInt; Cdecl;
begin
if lua_gettop(L) = 1 then
@@ -1911,18 +1947,20 @@
begin
if lua_gettop(L) <> 0 then
LuaParameterCountError('GetGravity', '', lua_gettop(L))
+ else if cGravity.isNegative then
+ lua_pushinteger(L, hwRound(-_0_5 + (cGravity * 50 / cMaxWindSpeed)))
else
- lua_pushinteger(L, hwRound(cGravity * 50 / cWindSpeed));
+ lua_pushinteger(L, hwRound( _0_5 + (cGravity * 50 / cMaxWindSpeed)));
lc_getgravity:= 1
end;
function lc_setgravity(L : Plua_State) : LongInt; Cdecl;
begin
if lua_gettop(L) <> 1 then
- LuaParameterCountError('SetGravity', 'gravity', lua_gettop(L))
+ LuaParameterCountError('SetGravity', 'percent', lua_gettop(L))
else
begin
- cGravity:= cMaxWindSpeed * lua_tointeger(L, 1) * _0_02;
+ cGravity:= _0_02 * lua_tointeger(L, 1) * cMaxWindSpeed;
cGravityf:= 0.00025 * lua_tointeger(L, 1) * 0.02
end;
lc_setgravity:= 0
@@ -2000,6 +2038,7 @@
end
else
begin
+ WriteLnToConsole('Lua test finished');
halt(lua_tointeger(L, 1));
lc_endluatest:= 0;
end;
@@ -2560,6 +2599,7 @@
lua_register(luaState, _P'EnableGameFlags', @lc_enablegameflags);
lua_register(luaState, _P'DisableGameFlags', @lc_disablegameflags);
lua_register(luaState, _P'ClearGameFlags', @lc_cleargameflags);
+lua_register(luaState, _P'GetGameFlag', @lc_getgameflag);
lua_register(luaState, _P'DeleteGear', @lc_deletegear);
lua_register(luaState, _P'AddVisualGear', @lc_addvisualgear);
lua_register(luaState, _P'DeleteVisualGear', @lc_deletevisualgear);
--- a/hedgewars/uTextures.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uTextures.pas Tue Jan 21 22:53:15 2014 +0100
@@ -25,6 +25,8 @@
function NewTexture(width, height: Longword; buf: Pointer): PTexture;
procedure Surface2GrayScale(surf: PSDL_Surface);
function Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
+procedure PrettifySurfaceAlpha(surf: PSDL_Surface; pixels: PLongwordArray);
+procedure PrettifyAlpha2D(pixels: TLandArray; height, width: LongWord);
procedure FreeTexture(tex: PTexture);
procedure FreeAndNilTexture(var tex: PTexture);
@@ -121,6 +123,88 @@
end;
end;
+{ this will make invisible pixels that have a visible neighbor have the
+ same color as their visible neighbor, so that bilinear filtering won't
+ display a "wrongly" colored border when zoomed in }
+procedure PrettifyAlpha(row1, row2: PLongwordArray; firsti, lasti, ioffset: LongWord);
+var
+ i: Longword;
+ lpi, cpi, bpi: boolean; // was last/current/bottom neighbor pixel invisible?
+begin
+ // suppress incorrect warning
+ lpi:= true;
+ for i:=firsti to lasti do
+ begin
+ // use first pixel in row1 as starting point
+ if i = firsti then
+ cpi:= ((row1^[i] and AMask) = 0)
+ else
+ begin
+ cpi:= ((row1^[i] and AMask) = 0);
+ if cpi <> lpi then
+ begin
+ // invisible pixels get colors from visible neighbors
+ if cpi then
+ begin
+ row1^[i]:= row1^[i-1] and not AMask;
+ // as this pixel is invisible and already colored correctly now, no point in further comparing it
+ lpi:= cpi;
+ continue;
+ end
+ else
+ row1^[i-1]:= row1^[i] and not AMask;
+ end;
+ end;
+ lpi:= cpi;
+ // also check bottom neighbor
+ if row2 <> nil then
+ begin
+ bpi:= ((row2^[i+ioffset] and AMask) = 0);
+ if cpi <> bpi then
+ begin
+ if cpi then
+ row1^[i]:= row2^[i+ioffset] and not AMask
+ else
+ row2^[i+ioffset]:= row1^[i] and not AMask;
+ end;
+ end;
+ end;
+end;
+
+procedure PrettifySurfaceAlpha(surf: PSDL_Surface; pixels: PLongwordArray);
+var
+ // current row index, second last row index of array, width and first/last i of row
+ r, slr, w, si, li: LongWord;
+begin
+ w:= surf^.w;
+ slr:= surf^.h - 2;
+ si:= 0;
+ li:= w - 1;
+ for r:= 0 to slr do
+ begin
+ PrettifyAlpha(pixels, pixels, si, li, w);
+ // move indices to next row
+ si:= si + w;
+ li:= li + w;
+ end;
+ // don't forget last row
+ PrettifyAlpha(pixels, nil, si, li, w);
+end;
+
+procedure PrettifyAlpha2D(pixels: TLandArray; height, width: LongWord);
+var
+ // current y; last x, second last y of array;
+ y, lx, sly: LongWord;
+begin
+ sly:= height - 2;
+ lx:= width - 1;
+ for y:= 0 to sly do
+ begin
+ PrettifyAlpha(PLongWordArray(pixels[y]), PLongWordArray(pixels[y+1]), 0, lx, 0);
+ end;
+ // don't forget last row
+ PrettifyAlpha(PLongWordArray(pixels[sly+1]), nil, 0, lx, 0);
+end;
function Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
var tw, th, x, y: Longword;
@@ -148,7 +232,6 @@
exit
end;
-
glGenTextures(1, @Surface2Tex^.id);
glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id);
@@ -161,6 +244,8 @@
if GrayScale then
Surface2GrayScale(Surf);
+PrettifySurfaceAlpha(surf, fromP4);
+
if (not SupportNPOTT) and (not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h))) then
begin
tw:= toPowerOf2(Surf^.w);
--- a/hedgewars/uTypes.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uTypes.pas Tue Jan 21 22:53:15 2014 +0100
@@ -272,8 +272,9 @@
Tag: LongInt; // Quite generic. Variety of uses.
FlightTime: Longword; // Initially added for batting of hogs to determine homerun. Used for some firing delays
MsgParam: LongWord; // Initially stored a set of messages. So usually gm values like Message. Frequently overriden
-// These are not used generically, but should probably be used for purpose intended. Definitely should not override pointer type
- Tex: PTexture; // A texture created by the gear. Should not use for anything but textures
+// These are not used generically, but should probably be used for purpose intended. Definitely shouldn't override pointer type
+ Tex: PTexture; // A texture created by the gear. Shouldn't use for anything but textures
+ Tint: LongWord; // Used to colour a texture
LinkedGear: PGear; // Used to track a related gear. Portal pairs for example.
Hedgehog: PHedgehog; // set to CurrentHedgehog on gear creation
SoundChannel: LongInt; // Used to track a sound the gear started
--- a/hedgewars/uWorld.pas Tue Jan 21 22:44:37 2014 +0100
+++ b/hedgewars/uWorld.pas Tue Jan 21 22:53:15 2014 +0100
@@ -658,7 +658,7 @@
DrawTexture(AmmoRect.x + AMShiftX, AmmoRect.y + AMShiftY, AmmoMenuTex);
if ((AMState = AMHiding) or (AMState = AMShowingUp)) and ((AMAnimType and AMTypeMaskAlpha) <> 0 )then
- Tint($FF, $ff, $ff, $ff);
+ untint;
Pos:= -1;
Slot:= -1;
@@ -1374,7 +1374,7 @@
begin
SetScale(cDefaultZoomLevel);
if TeamsCount * 20 > Longword(cScreenHeight) div 5 then
- Tint($FF,$FF,$FF,$FF);
+ untint;
end;
end;
Binary file share/hedgewars/Data/Fonts/DroidSansFallback.ttf has changed