--- a/.hgignore Sun Jan 27 00:01:26 2013 +0100
+++ b/.hgignore Sun Jan 27 00:28:57 2013 +0100
@@ -41,6 +41,8 @@
glob:*.orig
glob:*.bak
glob:*.rej
+glob:project_files/hwc/*.c
+glob:project_files/hwc/*.h
glob:project_files/Android-build/SDL-android-project/jni/**
glob:project_files/Android-build/SDL-android-project/obj
glob:project_files/Android-build/SDL-android-project/libs/armeabi*
--- a/CMakeLists.txt Sun Jan 27 00:01:26 2013 +0100
+++ b/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -19,10 +19,15 @@
option(NOPNG "Disable screenshoot compression [default: auto]" OFF)
option(NOVIDEOREC "Disable video recording [default: auto]" OFF)
-option(BUILD_ENGINE_LIBRARY "Enable hwengine library [default: off]" OFF)
+
+option(WEBGL "Enable WebGL build (implies NOPASCAL) [default: off]" OFF)
+option(NOPASCAL "Compile hwengine as native C [default: off]" ${WEBGL})
+option(LIBENGINE "Enable hwengine library [default: off]" OFF)
+
option(ANDROID "Enable Android build [default: off]" OFF)
option(NOAUTOUPDATE "Disable OS X Sparkle update checking" OFF)
option(MINIMAL_FLAGS "Respect system flags as much as possible [default: off]" OFF)
+option(GL2 "Enable OpenGL 2 rendering [default: off]" OFF)
set(FPFLAGS "" CACHE STRING "Additional Freepascal flags")
set(GHFLAGS "" CACHE STRING "Additional Haskell flags")
if(UNIX AND NOT APPLE)
@@ -30,7 +35,7 @@
endif()
#detect Mercurial revision (if present)
-if(NOT NOREVISION)
+if(NOT ${NOREVISION})
set(default_build_type "DEBUG")
set(version_suffix "-development_version")
set(HW_DEV true)
@@ -53,11 +58,11 @@
endif()
set(version_suffix "-${revision_number}${HGCHANGED}")
endif()
-else(NOT NOREVISION)
+else(NOT ${NOREVISION})
set(default_build_type "RELEASE")
set(HWDEV false)
message(STATUS "Building distributable version")
-endif(NOT NOREVISION)
+endif(NOT ${NOREVISION})
#versioning
@@ -66,6 +71,18 @@
set(CPACK_PACKAGE_VERSION_PATCH 19${version_suffix})
set(HEDGEWARS_PROTO_VER 44)
set(HEDGEWARS_VERSION "${CPACK_PACKAGE_VERSION_MAJOR}.${CPACK_PACKAGE_VERSION_MINOR}.${CPACK_PACKAGE_VERSION_PATCH}")
+set(required_clang_version 3.0)
+
+
+if (${NOPASCAL})
+ find_package(Clang)
+ # Check LLVM/Clang version
+ if (CLANG_VERSION VERSION_LESS required_clang_version)
+ message(FATAL_ERROR "LLVM/Clang compiler required version is ${REQUIRED_CLANG_VERSION} but version ${CLANG_VERSION} was found!")
+ else()
+ message(STATUS "Found CLANG: ${CLANG_EXECUTABLE} (version ${CLANG_VERSION})")
+ endif()
+endif(${NOPASCAL})
set(EXECUTABLE_OUTPUT_PATH ${PROJECT_BINARY_DIR}/bin)
@@ -233,8 +250,8 @@
endif()
-#server discovery
-if(NOT NOSERVER)
+#Haskell compiler discovery (for server and engine in c)
+if((NOT NOSERVER) OR NOPASCAL)
if(GHC)
set(ghc_executable ${GHC})
else()
@@ -242,25 +259,31 @@
endif()
if(ghc_executable)
- set(HAVE_NETSERVER true)
- add_subdirectory(gameServer)
- message(STATUS "Found GHC: ${ghc_executable}")
+ exec_program(${ghc_executable} ARGS "-V" OUTPUT_VARIABLE ghc_version_long)
+ string(REGEX REPLACE ".*([0-9]+\\.[0-9]+\\.[0-9]+)" "\\1" ghc_version "${ghc_version_long}")
+ message(STATUS "Found GHC: ${ghc_executable} (version ${ghc_version})")
else()
- message(WARNING "Could NOT find GHC, server will not be built")
- set(HAVE_NETSERVER false)
+ message(STATUS "Could NOT find GHC, needed by gameServer and pas2c")
endif()
+endif()
+
+
+#check gameServer
+if((ghc_executable) AND (NOT NOSERVER) AND (NOT WEBGL))
+ set(HAVE_NETSERVER true)
+ add_subdirectory(gameServer)
else()
- message(STATUS "Server will not be built per user request")
+ message(STATUS "Skipping gameServer target")
set(HAVE_NETSERVER false)
endif()
#lua discovery
find_package(Lua)
-if(LUA_FOUND)
+if(LUA_FOUND AND (NOT WEBGL))
message(STATUS "Found LUA: ${LUA_DEFAULT}")
else()
- message(STATUS "LUA will be provided by the bundled sources")
+ message(STATUS "Using internal LUA library")
add_subdirectory(misc/liblua)
#linking with liblua.a requires system readline
list(APPEND pascal_flags "-k${EXECUTABLE_OUTPUT_PATH}/lib${LUA_LIBRARY}.a" "-k-lreadline")
@@ -274,22 +297,39 @@
endif()
-#main engine
-add_subdirectory(hedgewars)
+#frontend library
+add_subdirectory(project_files/frontlib)
+
-#Android related build scripts
-if(ANDROID)
- #run cmake -DANDROID=1 to enable this
- add_subdirectory(project_files/Android-build)
+if(NOPASCAL)
+ if (NOT ghc_executable)
+ message(FATAL_ERROR "A Haskell compiler is required to build engine in C")
+ endif()
+ #pascal to c converter
+ add_subdirectory(tools/pas2c)
+ add_subdirectory(project_files/hwc)
+else()
+ #main pascal engine
+ add_subdirectory(hedgewars)
endif()
-#TODO: when ANDROID, BUILD_ENGINE_LIBRARY should be set
-if(NOT ANDROID)
- add_subdirectory(bin)
- add_subdirectory(QTfrontend)
- add_subdirectory(share)
- add_subdirectory(tools)
-endif()
+if(WEBGL)
+ #WEBGL deps
+else(WEBGL)
+ #Android related build scripts
+ if(ANDROID)
+ add_subdirectory(project_files/Android-build)
+ endif()
+
+ #TODO: when ANDROID, LIBENGINE should be set
+ if(NOT ANDROID)
+ add_subdirectory(bin)
+ add_subdirectory(QTfrontend)
+ add_subdirectory(share)
+ add_subdirectory(tools)
+ endif()
+endif(WEBGL)
+
# CPack variables
--- a/QTfrontend/CMakeLists.txt Sun Jan 27 00:01:26 2013 +0100
+++ b/QTfrontend/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -191,6 +191,11 @@
if(CMAKE_BUILD_TYPE MATCHES "RELEASE")
set(console_access "WIN32")
endif(CMAKE_BUILD_TYPE MATCHES "RELEASE")
+if(${LIBENGINE})
+ add_definitions(-DHWLIBRARY)
+ set(HW_LINK_LIBS hwengine ${HW_LINK_LIBS})
+ link_directories(${EXECUTABLE_OUTPUT_PATH})
+endif()
add_executable(hedgewars ${console_access}
${hwfr_src}
@@ -199,7 +204,7 @@
${hwfr_rez_src}
)
-if((UNIX AND NOT APPLE) AND ${BUILD_ENGINE_LIBRARY})
+if((UNIX AND NOT APPLE) AND ${LIBENGINE})
set_target_properties(hedgewars PROPERTIES LINK_FLAGS "-Wl,-rpath,${CMAKE_INSTALL_PREFIX}/${target_library_install_dir}")
endif()
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cmake_modules/FindClang.cmake Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,20 @@
+# Load LLVM/Clang
+if (CLANG)
+ set(CLANG_EXECUTABLE ${CLANG})
+else()
+ find_program(CLANG_EXECUTABLE
+ NAMES clang-mp-3.2 clang-mp-3.1 clang-mp-3.0 clang
+ PATHS /opt/local/bin /usr/local/bin /usr/bin)
+endif()
+
+# Check LLVM/Clang version
+if (CLANG_EXECUTABLE)
+ exec_program(${CLANG_EXECUTABLE} ARGS "-v" OUTPUT_VARIABLE CLANG_VERSION_FULL)
+
+ string(REGEX MATCH "[0-9]+\\.[0-9]+" CLANG_VERSION_LONG "${CLANG_VERSION_FULL}")
+ string(REGEX REPLACE "([0-9]+\\.[0-9]+)" "\\1" CLANG_VERSION "${CLANG_VERSION_LONG}")
+else()
+ message(FATAL_ERROR "No LLVM/Clang compiler found (required for engine_c target)")
+endif()
+
+set(CMAKE_C_COMPILER ${CLANG_EXECUTABLE})
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cmake_modules/FindGLEW.cmake Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,64 @@
+#
+# Try to find GLEW library and include path.
+# Once done this will define
+#
+# GLEW_FOUND
+# GLEW_INCLUDE_PATH
+# GLEW_LIBRARY
+#
+
+if (GLEW_LIBRARY AND GLEW_INCLUDE_PATH)
+ # in cache already
+ set(GLEW_FOUND TRUE)
+else (GLEW_LIBRARY AND GLEW_INCLUDE_PATH)
+
+ IF (WIN32)
+ FIND_PATH( GLEW_INCLUDE_PATH GL/glew.h
+ $ENV{PROGRAMFILES}/GLEW/include
+ ${PROJECT_SOURCE_DIR}/src/nvgl/glew/include
+ DOC "The directory where GL/glew.h resides")
+ FIND_LIBRARY( GLEW_LIBRARY
+ NAMES glew GLEW glew32 glew32s
+ PATHS
+ $ENV{PROGRAMFILES}/GLEW/lib
+ ${PROJECT_SOURCE_DIR}/src/nvgl/glew/bin
+ ${PROJECT_SOURCE_DIR}/src/nvgl/glew/lib
+ DOC "The GLEW library")
+ ELSE (WIN32)
+ FIND_PATH( GLEW_INCLUDE_PATH GL/glew.h
+ /usr/include
+ /usr/local/include
+ /sw/include
+ /opt/local/include
+ DOC "The directory where GL/glew.h resides")
+ FIND_LIBRARY( GLEW_LIBRARY
+ NAMES GLEW glew
+ PATHS
+ /usr/lib64
+ /usr/lib
+ /usr/local/lib64
+ /usr/local/lib
+ /sw/lib
+ /opt/local/lib
+ DOC "The GLEW library")
+ ENDIF (WIN32)
+
+ IF (GLEW_LIBRARY AND GLEW_INCLUDE_PATH)
+ SET( GLEW_FOUND 1 CACHE STRING "Set to 1 if GLEW is found, 0 otherwise")
+ ELSE (GLEW_LIBRARY AND GLEW_INCLUDE_PATH)
+ SET( GLEW_FOUND 0 CACHE STRING "Set to 1 if GLEW is found, 0 otherwise")
+ ENDIF (GLEW_LIBRARY AND GLEW_INCLUDE_PATH)
+
+endif(GLEW_LIBRARY AND GLEW_INCLUDE_PATH)
+
+if (GLEW_FOUND)
+ if (NOT GLEW_FIND_QUIETLY)
+ message(STATUS "Found GLEW: ${GLEW_LIBRARY}, ${GLEW_INCLUDE_PATH}")
+ endif (NOT GLEW_FIND_QUIETLY)
+else (GLEW_FOUND)
+ if (GLEW_FIND_REQUIRED)
+ message(FATAL_ERROR "Could NOT find GLEW")
+ endif (GLEW_FIND_REQUIRED)
+endif (GLEW_FOUND)
+
+#MARK_AS_ADVANCED( GLEW_FOUND )
\ No newline at end of file
--- a/gameServer/Actions.hs Sun Jan 27 00:01:26 2013 +0100
+++ b/gameServer/Actions.hs Sun Jan 27 00:28:57 2013 +0100
@@ -526,7 +526,7 @@
processAction (BanNick n seconds reason) = do
currentTime <- io getCurrentTime
- let msg =
+ let msg =
if seconds > 60 * 60 * 24 * 365 then
B.concat ["Permanent ban (", reason, ")"]
else
--- a/gameServer/CMakeLists.txt Sun Jan 27 00:01:26 2013 +0100
+++ b/gameServer/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -23,11 +23,11 @@
hedgewars-server.hs
)
-set(hwserv_main ${hedgewars_SOURCE_DIR}/gameServer/hedgewars-server.hs)
+set(hwserv_main ${CMAKE_SOURCE_DIR}/gameServer/hedgewars-server.hs)
set(ghc_flags
--make ${hwserv_main}
- -i${hedgewars_SOURCE_DIR}/gameServer
+ -i${CMAKE_CURRENT_SOURCE_DIR}
-o ${EXECUTABLE_OUTPUT_PATH}/hedgewars-server${CMAKE_EXECUTABLE_SUFFIX}
-odir ${CMAKE_CURRENT_BINARY_DIR}
-hidir ${CMAKE_CURRENT_BINARY_DIR}
--- a/gameServer/HWProtoInRoomState.hs Sun Jan 27 00:01:26 2013 +0100
+++ b/gameServer/HWProtoInRoomState.hs Sun Jan 27 00:28:57 2013 +0100
@@ -54,7 +54,7 @@
roomChans <- roomClientsChans
cl <- thisClient
teamColor <-
- if clientProto cl < 42 then
+ if clientProto cl < 42 then
return color
else
liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom
--- a/gameServer/hedgewars-server.cabal Sun Jan 27 00:01:26 2013 +0100
+++ b/gameServer/hedgewars-server.cabal Sun Jan 27 00:28:57 2013 +0100
@@ -16,7 +16,6 @@
Build-depends:
base >= 4.3,
- unix,
containers,
vector,
bytestring,
--- a/hedgewars/ArgParsers.inc Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/ArgParsers.inc Sun Jan 27 00:28:57 2013 +0100
@@ -160,8 +160,7 @@
getStringParameter:= str;
end;
-
-procedure parseClassicParameter(cmdArray: Array of String; size:LongInt; var paramIndex:LongInt); Forward;
+procedure parseClassicParameter(cmdArray: array of String; size:LongInt; var paramIndex:LongInt); forward;
function parseParameter(cmd:String; arg:String; var paramIndex:LongInt): Boolean;
const videoArray: Array [1..5] of String = ('--fullscreen-width','--fullscreen-height', '--width', '--height', '--depth');
@@ -234,7 +233,7 @@
end;
end;
-procedure parseClassicParameter(cmdArray: Array of String; size:LongInt; var paramIndex:LongInt);
+procedure parseClassicParameter(cmdArray: array of String; size:LongInt; var paramIndex:LongInt);
var index, tmpInt: LongInt;
isBool, isValid: Boolean;
cmd, arg, newSyntax: String;
@@ -264,13 +263,13 @@
if isValid then
begin
parseParameter(cmd, arg, tmpInt);
- newSyntax := newSyntax + cmd + ' ';
+ newSyntax:= newSyntax + cmd + ' ';
if not isBool then
- newSyntax := newSyntax + arg + ' ';
+ newSyntax:= newSyntax + arg + ' ';
end;
inc(index);
end;
-
+
WriteLn(stdout, 'Attempted to automatically convert to the new syntax:');
WriteLn(stdout, newSyntax);
WriteLn(stdout, '');
--- a/hedgewars/CMakeLists.txt Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -6,15 +6,15 @@
include(${CMAKE_SOURCE_DIR}/cmake_modules/FindSDL_Extras.cmake)
-configure_file(${hedgewars_SOURCE_DIR}/hedgewars/config.inc.in ${CMAKE_CURRENT_BINARY_DIR}/config.inc)
+configure_file(${CMAKE_CURRENT_SOURCE_DIR}/config.inc.in ${CMAKE_CURRENT_BINARY_DIR}/config.inc)
#SOURCE AND PROGRAMS SECTION
-if(${BUILD_ENGINE_LIBRARY})
+if(${LIBENGINE})
set(engine_output_name "${CMAKE_SHARED_LIBRARY_PREFIX}hwengine${CMAKE_SHARED_LIBRARY_SUFFIX}")
- set(hwengine_project ${hedgewars_SOURCE_DIR}/hedgewars/hwLibrary.pas)
+ set(hwengine_project ${CMAKE_CURRENT_SOURCE_DIR}/hwLibrary.pas)
else()
set(engine_output_name "hwengine${CMAKE_EXECUTABLE_SUFFIX}")
- set(hwengine_project ${hedgewars_SOURCE_DIR}/hedgewars/hwengine.pas)
+ set(hwengine_project ${CMAKE_CURRENT_SOURCE_DIR}/hwengine.pas)
endif()
if (APPLE)
@@ -63,6 +63,7 @@
uLandTemplates.pas
uLandTexture.pas
uLocale.pas
+ uMatrix.pas
uMisc.pas
uPhysFSLayer.pas
uRandom.pas
@@ -90,7 +91,7 @@
${CMAKE_CURRENT_BINARY_DIR}/config.inc
)
-if(${BUILD_ENGINE_LIBRARY})
+if(${LIBENGINE})
message(WARNING "Engine will be built as library (experimental)")
list(APPEND pascal_flags "-dHWLIBRARY")
@@ -104,11 +105,16 @@
list(APPEND pascal_flags "-k-no_order_inits")
endif()
set(destination_dir ${target_library_install_dir})
-else(${BUILD_ENGINE_LIBRARY})
+else(${LIBENGINE})
set(destination_dir ${target_binary_install_dir})
-endif(${BUILD_ENGINE_LIBRARY})
+endif(${LIBENGINE})
+#opengl 2
+IF(${GL2})
+ set(pascal_flags "-dGL2" ${pascal_flags})
+ message(STATUS "Building using OpenGL 2")
+ENDIF(${GL2})
# Check Freepascal version
find_package(Freepascal)
@@ -128,7 +134,7 @@
endif()
#on OSX we need to provide the SDL_main() function when building as executable
- if(NOT ${BUILD_ENGINE_LIBRARY})
+ if(NOT ${LIBENGINE})
#let's look for the installed sdlmain file; if it is not found, let's build our own
find_package(SDL REQUIRED)
#remove the ";-framework Cocoa" from the SDL_LIBRARY variable
@@ -138,7 +144,7 @@
if(SDLMAIN_LIB MATCHES "SDLMAIN_LIB-NOTFOUND")
include_directories(${SDL_INCLUDE_DIR})
- add_library (SDLmain STATIC SDLMain.m)
+ add_library (SDLmain STATIC sdlmain_osx/SDLMain.m)
#add a dependency to the hwengine target
list(APPEND engine_sources SDLmain)
set(SDLMAIN_LIB "${LIBRARY_OUTPUT_PATH}/libSDLmain.a")
@@ -171,7 +177,7 @@
else()
set(SAFE_BUILD_TOOL ${CMAKE_BUILD_TOOL})
endif()
- add_custom_target(ENGINECLEAN COMMAND ${SAFE_BUILD_TOOL} "clean" "${PROJECT_BINARY_DIR}" "${hedgewars_SOURCE_DIR}/hedgewars")
+ add_custom_target(ENGINECLEAN COMMAND ${SAFE_BUILD_TOOL} "clean" "${PROJECT_BINARY_DIR}" "${CMAKE_SOURCE_DIR}/hedgewars")
endif()
@@ -188,11 +194,11 @@
list(APPEND pascal_flags "-dUSE_VIDEO_RECORDING")
IF (WIN32)
# there are some problems with linking our avwrapper as static lib, so link it as shared
- add_library(avwrapper SHARED avwrapper.c)
+ add_library(avwrapper SHARED videorec/avwrapper.c)
target_link_libraries(avwrapper ${FFMPEG_LIBRARIES})
install(PROGRAMS "${EXECUTABLE_OUTPUT_PATH}/${CMAKE_SHARED_LIBRARY_PREFIX}avwrapper${CMAKE_SHARED_LIBRARY_SUFFIX}" DESTINATION ${target_library_install_dir})
ELSE()
- add_library(avwrapper STATIC avwrapper.c)
+ add_library(avwrapper STATIC videorec/avwrapper.c)
list(APPEND pascal_flags "-k${FFMPEG_LIBAVCODEC}" "-k${FFMPEG_LIBAVFORMAT}" "-k${FFMPEG_LIBAVUTIL}")
ENDIF()
else()
--- a/hedgewars/GL.h Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-#pragma once
-
-#include <GL/gl.h>
--- a/hedgewars/GSHandlers.inc Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/GSHandlers.inc Sun Jan 27 00:28:57 2013 +0100
@@ -53,7 +53,7 @@
sX:= dX / steps;
sY:= dY / steps;
end
-
+
else
begin
sX:= dX;
@@ -75,7 +75,7 @@
end;
procedure makeHogsWorry(x, y: hwFloat; r: LongInt);
-var
+var
gi: PGear;
d: LongInt;
begin
@@ -89,7 +89,7 @@
begin
if (CurrentHedgehog^.Gear = gi) then
PlaySoundV(sndOops, gi^.Hedgehog^.Team^.voicepack)
-
+
else
begin
if (gi^.State and gstMoving) = 0 then
@@ -97,15 +97,15 @@
gi^.dX.isNegative:= X<gi^.X;
gi^.State := gi^.State or gstLoser;
end;
-
+
if d > r div 2 then
- PlaySoundV(sndNooo, gi^.Hedgehog^.Team^.voicepack)
+ PlaySoundV(sndNooo, gi^.Hedgehog^.Team^.voicepack)
else
PlaySoundV(sndUhOh, gi^.Hedgehog^.Team^.voicepack);
end;
end;
end;
-
+
gi := gi^.NextGear
end;
end;
@@ -116,10 +116,10 @@
DeleteCI(HH^.Gear);
if FollowGear = HH^.Gear then
FollowGear:= nil;
-
+
if lastGearByUID = HH^.Gear then
lastGearByUID := nil;
-
+
HH^.Gear^.Message:= HH^.Gear^.Message or gmRemoveFromList;
with HH^.Gear^ do
begin
@@ -151,13 +151,13 @@
Gear^.Y := Gear^.Y + cDrownSpeed;
Gear^.X := Gear^.X + Gear^.dX * cDrownSpeed;
// Create some bubbles (0.5% might be better but causes too few bubbles sometimes)
- if ((not SuddenDeathDmg and (WaterOpacity < $FF))
+ if (((not SuddenDeathDmg) and (WaterOpacity < $FF))
or (SuddenDeathDmg and (SDWaterOpacity < $FF))) and ((GameTicks and $1F) = 0) then
if (Gear^.Kind = gtHedgehog) and (Random(4) = 0) then
AddVisualGear(hwRound(Gear^.X) - Gear^.Radius, hwRound(Gear^.Y) - Gear^.Radius, vgtBubble)
else if Random(12) = 0 then
AddVisualGear(hwRound(Gear^.X) - Gear^.Radius, hwRound(Gear^.Y) - Gear^.Radius, vgtBubble);
- if (not SuddenDeathDmg and (WaterOpacity > $FE))
+ if ((not SuddenDeathDmg) and (WaterOpacity > $FE))
or (SuddenDeathDmg and (SDWaterOpacity > $FE))
or (hwRound(Gear^.Y) > Gear^.Radius + cWaterLine + cVisibleWater) then
DeleteGear(Gear);
@@ -165,7 +165,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepFallingGear(Gear: PGear);
-var
+var
isFalling: boolean;
//tmp: QWord;
tdX, tdY: hwFloat;
@@ -173,7 +173,7 @@
land: word;
begin
// clip velocity at 2 - over 1 per pixel, but really shouldn't cause many actual problems.
-{$IFNDEF WEB}
+{$IFNDEF WEBGL}
if Gear^.dX.Round > 2 then
Gear^.dX.QWordValue:= 8589934592;
if Gear^.dY.Round > 2 then
@@ -220,16 +220,16 @@
else if (Gear^.AdvBounce=1) and (TestCollisionYwithGear(Gear, 1) <> 0) then
collV := 1;
end
- else
+ else
begin // Gear^.dY.isNegative is false
land:= TestCollisionYwithGear(Gear, 1);
if land <> 0 then
begin
collV := 1;
isFalling := false;
- if land and lfIce <> 0 then
+ if land and lfIce <> 0 then
Gear^.dX := Gear^.dX * (_0_9 + Gear^.Friction * _0_1)
- else
+ else
Gear^.dX := Gear^.dX * Gear^.Friction;
Gear^.dY := - Gear^.dY * Gear^.Elasticity;
@@ -252,7 +252,7 @@
Gear^.State := Gear^.State or gstCollision
end
else if (Gear^.AdvBounce=1) and TestCollisionXwithGear(Gear, -hwSign(Gear^.dX)) then
- collH := -hwSign(Gear^.dX);
+ collH := -hwSign(Gear^.dX);
//if Gear^.AdvBounce and (collV <>0) and (collH <> 0) and (hwSqr(tdX) + hwSqr(tdY) > _0_08) then
if (Gear^.AdvBounce=1) and (collV <>0) and (collH <> 0) and ((collV=-1)
or ((tdX.QWordValue + tdY.QWordValue) > _0_2.QWordValue)) then
@@ -260,7 +260,7 @@
Gear^.dX := tdY*Gear^.Elasticity*Gear^.Friction;
Gear^.dY := tdX*Gear^.Elasticity;
//*Gear^.Friction;
- Gear^.dY.isNegative := not tdY.isNegative;
+ Gear^.dY.isNegative := (not tdY.isNegative);
isFalling := false;
Gear^.AdvBounce := 10;
end;
@@ -285,18 +285,18 @@
else
Gear^.State := Gear^.State or gstMoving;
- if (Gear^.nImpactSounds > 0) and
+ if (Gear^.nImpactSounds > 0) and
(Gear^.State and gstCollision <> 0) and
(((Gear^.Kind <> gtMine) and (Gear^.Damage <> 0)) or (Gear^.State and gstMoving <> 0)) and
(((Gear^.Radius < 3) and (Gear^.dY < -_0_1)) or
- ((Gear^.Radius >= 3) and
+ ((Gear^.Radius >= 3) and
((Gear^.dX.QWordValue > _0_1.QWordValue) or (Gear^.dY.QWordValue > _0_1.QWordValue)))) then
PlaySound(TSound(ord(Gear^.ImpactSound) + LongInt(GetRandom(Gear^.nImpactSounds))), true);
end;
////////////////////////////////////////////////////////////////////////////////
procedure doStepBomb(Gear: PGear);
-var
+var
i, x, y: LongInt;
dX, dY, gdX: hwFloat;
vg: PVisualGear;
@@ -307,7 +307,7 @@
dec(Gear^.Timer);
if Gear^.Timer = 1000 then // might need adjustments
- case Gear^.Kind of
+ case Gear^.Kind of
gtGrenade: makeHogsWorry(Gear^.X, Gear^.Y, 50);
gtClusterBomb: makeHogsWorry(Gear^.X, Gear^.Y, 20);
gtWatermelon: makeHogsWorry(Gear^.X, Gear^.Y, 75);
@@ -331,10 +331,10 @@
if Gear^.Timer = 0 then
begin
- case Gear^.Kind of
+ case Gear^.Kind of
gtGrenade: doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 50, Gear^.Hedgehog, EXPLAutoSound);
gtBall: doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 40, Gear^.Hedgehog, EXPLAutoSound);
- gtClusterBomb:
+ gtClusterBomb:
begin
x := hwRound(Gear^.X);
y := hwRound(Gear^.Y);
@@ -347,7 +347,7 @@
FollowGear := AddGear(x, y, gtCluster, 0, dX, dY, 25)
end
end;
- gtWatermelon:
+ gtWatermelon:
begin
x := hwRound(Gear^.X);
y := hwRound(Gear^.Y);
@@ -361,7 +361,7 @@
FollowGear^.DirAngle := i * 60
end
end;
- gtHellishBomb:
+ gtHellishBomb:
begin
x := hwRound(Gear^.X);
y := hwRound(Gear^.Y);
@@ -377,7 +377,7 @@
AddGear(x, y, gtFlame, 0, dX, -dY, 0)
end
else
- begin
+ begin
AddGear(x, y, gtFlame, 0, dX, dY, 0);
AddGear(x, y, gtFlame, gstTmpFlag, dX, -dY, 0)
end;
@@ -417,7 +417,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepMolotov(Gear: PGear);
-var
+var
s: Longword;
i, gX, gY: LongInt;
dX, dY: hwFloat;
@@ -437,7 +437,7 @@
i:= 130
else
i:= 50;
-
+
smoke:= AddVisualGear(hwRound(Gear^.X)-round(cos((Gear^.DirAngle+i) * pi / 180)*20), hwRound(Gear^.Y)-round(sin((Gear^.DirAngle+i) * pi / 180)*20), vgtSmoke);
if smoke <> nil then
smoke^.Scale:= 0.75;
@@ -537,8 +537,8 @@
if (Gear^.State and gstCollision) <> 0 then
begin
kick:= hwRound((hwAbs(Gear^.dX)+hwAbs(Gear^.dY)) * _20);
- Gear^.dY.isNegative:= not Gear^.dY.isNegative;
- Gear^.dX.isNegative:= not Gear^.dX.isNegative;
+ Gear^.dY.isNegative:= (not Gear^.dY.isNegative);
+ Gear^.dX.isNegative:= (not Gear^.dX.isNegative);
AmmoShove(Gear, 0, kick);
for i:= 15 + kick div 10 downto 0 do
begin
@@ -696,10 +696,10 @@
end;
p:= @(p^[s^.pitch shr 2])
end;
-
- // Why is this here. For one thing, there's no test on +1 being safe.
+
+ // Why is this here. For one thing, there's no test on +1 being safe.
//Land[py, px+1]:= lfBasic;
-
+
if allpx then
UpdateLandTexture(xx, Pred(s^.h), yy, Pred(s^.w), true)
else
@@ -744,7 +744,7 @@
if TestCollisionY(Gear, -1) then
Gear^.dY := _0;
- if not Gear^.dY.isNegative then
+ if (not Gear^.dY.isNegative) then
if TestCollisionY(Gear, 1) then
begin
Gear^.dY := - Gear^.dY * Gear^.Elasticity;
@@ -764,7 +764,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepBeeWork(Gear: PGear);
-var
+var
t: hwFloat;
gX,gY,i: LongInt;
uw, nuw: boolean;
@@ -879,7 +879,7 @@
Gear^.Hedgehog^.Gear^.Message:= Gear^.Hedgehog^.Gear^.Message and (not gmAttack);
Gear^.Hedgehog^.Gear^.State:= Gear^.Hedgehog^.Gear^.State and (not gstAttacking);
AttackBar:= 0;
-
+
Gear^.SoundChannel := LoopSound(sndBee);
Gear^.Timer := 5000;
// save initial speed in otherwise unused Friction variable
@@ -901,7 +901,7 @@
end;
procedure doStepShotgunShot(Gear: PGear);
-var
+var
i: LongWord;
shell: PVisualGear;
begin
@@ -977,7 +977,7 @@
// Bullet trail
VGear := AddVisualGear(hwRound(ox), hwRound(oy), vgtLineTrail);
-
+
if VGear <> nil then
begin
VGear^.X:= hwFloat2Float(ox);
@@ -1000,8 +1000,9 @@
end;
procedure doStepBulletWork(Gear: PGear);
-var
- i, x, y: LongWord;
+var
+ i: LongInt;
+ x, y: LongWord;
oX, oY: hwFloat;
VGear: PVisualGear;
begin
@@ -1015,7 +1016,7 @@
Gear^.Y := Gear^.Y + Gear^.dY;
x := hwRound(Gear^.X);
y := hwRound(Gear^.Y);
-
+
if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0) and (Land[y, x] <> 0) then
inc(Gear^.Damage);
// let's interrupt before a collision to give portals a chance to catch the bullet
@@ -1037,7 +1038,7 @@
else
AmmoShove(Gear, Gear^.Timer, 20);
CheckGearDrowning(Gear);
- dec(i)
+ dec(i)
until (i = 0) or (Gear^.Damage > Gear^.Health) or ((Gear^.State and gstDrowning) <> 0);
if Gear^.Damage > 0 then
@@ -1046,7 +1047,7 @@
dec(Gear^.Health, Gear^.Damage);
Gear^.Damage := 0
end;
- if ((Gear^.State and gstDrowning) <> 0) and (Gear^.Damage < Gear^.Health) and ((not SuddenDeathDmg and (WaterOpacity < $FF)) or (SuddenDeathDmg and (SDWaterOpacity < $FF))) then
+ if ((Gear^.State and gstDrowning) <> 0) and (Gear^.Damage < Gear^.Health) and (((not SuddenDeathDmg) and (WaterOpacity < $FF)) or (SuddenDeathDmg and (SDWaterOpacity < $FF))) then
begin
for i:=(Gear^.Health - Gear^.Damage) * 4 downto 0 do
begin
@@ -1065,7 +1066,7 @@
cLaserSighting := false;
if (Ammoz[Gear^.AmmoType].Ammo.NumPerTurn <= CurrentHedgehog^.MultiShootAttacks) and ((GameFlags and gfArtillery) = 0) then
cArtillery := false;
-
+
// Bullet Hit
if (hwRound(Gear^.X) and LAND_WIDTH_MASK = 0) and (hwRound(Gear^.Y) and LAND_HEIGHT_MASK = 0) then
begin
@@ -1075,7 +1076,7 @@
VGear^.Angle := DxDy2Angle(-Gear^.dX, Gear^.dY);
end;
end;
-
+
spawnBulletTrail(Gear);
Gear^.doStep := @doStepShotIdle
end;
@@ -1091,7 +1092,7 @@
end;
procedure doStepSniperRifleShot(Gear: PGear);
-var
+var
HHGear: PGear;
shell: PVisualGear;
begin
@@ -1122,7 +1123,7 @@
Gear^.dY := -AngleCos(HHGear^.Angle) * _0_5;
PlaySound(sndGun);
// add 3 initial steps to avoid problem with ammoshove related to calculation of radius + 1 radius as gear widths, and also just weird angles
- Gear^.X := Gear^.X + Gear^.dX * 3;
+ Gear^.X := Gear^.X + Gear^.dX * 3;
Gear^.Y := Gear^.Y + Gear^.dY * 3;
Gear^.doStep := @doStepBulletWork;
end
@@ -1151,7 +1152,7 @@
begin
dec(Gear^.Timer);
case Gear^.Kind of
- gtATStartGame:
+ gtATStartGame:
begin
AllInactive := false;
if Gear^.Timer = 0 then
@@ -1159,7 +1160,7 @@
AddCaption(trmsg[sidStartFight], cWhiteColor, capgrpGameState);
end
end;
- gtATFinishGame:
+ gtATFinishGame:
begin
AllInactive := false;
if Gear^.Timer = 1000 then
@@ -1182,7 +1183,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepPickHammerWork(Gear: PGear);
-var
+var
i, ei, x, y: LongInt;
HHGear: PGear;
begin
@@ -1273,7 +1274,7 @@
end;
procedure doStepPickHammer(Gear: PGear);
-var
+var
i, y: LongInt;
ar: TRangeArray;
HHGear: PGear;
@@ -1300,11 +1301,11 @@
end;
////////////////////////////////////////////////////////////////////////////////
-var
+var
BTPrevAngle, BTSteps: LongInt;
procedure doStepBlowTorchWork(Gear: PGear);
-var
+var
HHGear: PGear;
b: boolean;
prevX: LongInt;
@@ -1313,7 +1314,7 @@
dec(Gear^.Timer);
if ((GameFlags and gfInfAttack) <> 0) and (TurnTimeLeft > 0) then
dec(TurnTimeLeft);
-
+
HHGear := Gear^.Hedgehog^.Gear;
HedgehogChAngle(HHGear);
@@ -1394,7 +1395,7 @@
end;
procedure doStepBlowTorch(Gear: PGear);
-var
+var
HHGear: PGear;
begin
BTPrevAngle := High(LongInt);
@@ -1426,15 +1427,15 @@
doStepFallingGear(Gear);
if (Gear^.Health = 0) then
begin
- if not Gear^.dY.isNegative and (Gear^.dY > _0_2) and (TestCollisionYwithGear(Gear, 1) <> 0) then
+ if (not Gear^.dY.isNegative) and (Gear^.dY > _0_2) and (TestCollisionYwithGear(Gear, 1) <> 0) then
inc(Gear^.Damage, hwRound(Gear^.dY * _70))
- else if not Gear^.dX.isNegative and (Gear^.dX > _0_2) and TestCollisionXwithGear(Gear, 1) then
+ else if (not Gear^.dX.isNegative) and (Gear^.dX > _0_2) and TestCollisionXwithGear(Gear, 1) then
inc(Gear^.Damage, hwRound(Gear^.dX * _70))
else if Gear^.dY.isNegative and (Gear^.dY < -_0_2) and (TestCollisionYwithGear(Gear, -1) <> 0) then
inc(Gear^.Damage, hwRound(Gear^.dY * -_70))
else if Gear^.dX.isNegative and (Gear^.dX < -_0_2) and TestCollisionXwithGear(Gear, -1) then
inc(Gear^.Damage, hwRound(Gear^.dX * -_70));
-
+
if ((GameTicks and $FF) = 0) and (Gear^.Damage > random(30)) then
begin
vg:= AddVisualGear(hwRound(Gear^.X) - 4 + Random(8), hwRound(Gear^.Y) - 4 - Random(4), vgtSmoke);
@@ -1496,9 +1497,9 @@
procedure doStepSMine(Gear: PGear);
begin
// TODO: do real calculation?
- if TestCollisionXwithGear(Gear, 2)
- or (TestCollisionYwithGear(Gear, -2) <> 0)
- or TestCollisionXwithGear(Gear, -2)
+ if TestCollisionXwithGear(Gear, 2)
+ or (TestCollisionYwithGear(Gear, -2) <> 0)
+ or TestCollisionXwithGear(Gear, -2)
or (TestCollisionYwithGear(Gear, 2) <> 0) then
begin
if (not isZero(Gear^.dX)) or (not isZero(Gear^.dY)) then
@@ -1573,20 +1574,20 @@
Try tweaking friction some more
*)
procedure doStepRollingBarrel(Gear: PGear);
-var
+var
i: LongInt;
particle: PVisualGear;
begin
if (Gear^.dY.QWordValue = 0) and (Gear^.dY.QWordValue = 0) and (TestCollisionYwithGear(Gear, 1) = 0) then
SetLittle(Gear^.dY);
Gear^.State := Gear^.State or gstAnimation;
-
+
if ((Gear^.dX.QWordValue <> 0)
or (Gear^.dY.QWordValue <> 0)) then
begin
DeleteCI(Gear);
AllInactive := false;
- if not Gear^.dY.isNegative and (Gear^.dY > _0_2) and (TestCollisionYwithGear(Gear, 1) <> 0) then
+ if (not Gear^.dY.isNegative) and (Gear^.dY > _0_2) and (TestCollisionYwithGear(Gear, 1) <> 0) then
begin
Gear^.State := Gear^.State or gsttmpFlag;
inc(Gear^.Damage, hwRound(Gear^.dY * _70));
@@ -1597,12 +1598,12 @@
particle^.dX := particle^.dX + (Gear^.dX.QWordValue / 21474836480)
end
end
- else if not Gear^.dX.isNegative and (Gear^.dX > _0_2) and TestCollisionXwithGear(Gear, 1) then
+ else if (not Gear^.dX.isNegative) and (Gear^.dX > _0_2) and TestCollisionXwithGear(Gear, 1) then
inc(Gear^.Damage, hwRound(Gear^.dX * _70))
-
+
else if Gear^.dY.isNegative and (Gear^.dY < -_0_2) and (TestCollisionYwithGear(Gear, -1) <> 0) then
inc(Gear^.Damage, hwRound(Gear^.dY * -_70))
-
+
else if Gear^.dX.isNegative and (Gear^.dX < -_0_2) and TestCollisionXwithGear(Gear, -1) then
inc(Gear^.Damage, hwRound(Gear^.dX * -_70));
@@ -1632,7 +1633,7 @@
if Gear^.dX.QWordValue = 0 then AddGearCI(Gear)
end; *)
- if not Gear^.dY.isNegative and (Gear^.dY < _0_001) and (TestCollisionYwithGear(Gear, 1) <> 0) then
+ if (not Gear^.dY.isNegative) and (Gear^.dY < _0_001) and (TestCollisionYwithGear(Gear, 1) <> 0) then
Gear^.dY := _0;
if hwAbs(Gear^.dX) < _0_001 then
Gear^.dX := _0;
@@ -1651,7 +1652,7 @@
end;
procedure doStepCase(Gear: PGear);
-var
+var
i, x, y: LongInt;
k: TGearType;
exBoom: boolean;
@@ -1692,7 +1693,7 @@
exBoom := true;
end
else
- begin
+ begin
if (Gear^.Pos <> posCaseHealth) and (GameTicks and $1FFF = 0) then // stir 'em up periodically
begin
gi := GearsList;
@@ -1729,12 +1730,12 @@
sparkles^.dX:= 0;
sparkles^.dY:= 0;
sparkles^.Angle:= 270;
- if Gear^.Tag = 1 then
+ if Gear^.Tag = 1 then
sparkles^.Tint:= $3744D7FF
else sparkles^.Tint:= $FAB22CFF
end;
end;
- if Gear^.Timer < 1000 then
+ if Gear^.Timer < 1000 then
begin
AllInactive:= false;
exit
@@ -1793,7 +1794,7 @@
if Gear^.dY > _0_2 then
for i:= min(12, hwRound(Gear^.dY*_10)) downto 0 do
AddVisualGear(hwRound(Gear^.X) - 5 + Random(10), hwRound(Gear^.Y) + 12, vgtDust);
-
+
Gear^.dY := - Gear^.dY * Gear^.Elasticity;
if Gear^.dY > - _0_001 then
Gear^.dY := _0
@@ -1847,7 +1848,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepShover(Gear: PGear);
-var
+var
HHGear: PGear;
begin
HHGear := Gear^.Hedgehog^.Gear;
@@ -1863,7 +1864,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepWhip(Gear: PGear);
-var
+var
HHGear: PGear;
i: LongInt;
begin
@@ -1885,14 +1886,14 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepFlame(Gear: PGear);
-var
+var
gX,gY,i: LongInt;
sticky: Boolean;
vgt: PVisualGear;
tdX,tdY: HWFloat;
begin
sticky:= (Gear^.State and gsttmpFlag) <> 0;
- if not sticky then AllInactive := false;
+ if (not sticky) then AllInactive := false;
if TestCollisionYwithGear(Gear, 1) = 0 then
begin
@@ -1912,10 +1913,10 @@
if Gear^.dX.QWordValue > _0_01.QWordValue then
Gear^.dX := Gear^.dX * _0_995;
-
+
Gear^.dY := Gear^.dY + cGravity;
// if sticky then Gear^.dY := Gear^.dY + cGravity;
-
+
if Gear^.dY.QWordValue > _0_2.QWordValue then
Gear^.dY := Gear^.dY * _0_995;
@@ -1959,7 +1960,7 @@
gX := hwRound(Gear^.X);
gY := hwRound(Gear^.Y);
// Standard fire
- if not sticky then
+ if (not sticky) then
begin
if ((GameTicks and $1) = 0) then
begin
@@ -1976,13 +1977,13 @@
Gear^.Radius := 1;
end
else if ((GameTicks and $3) = 3) then
- doMakeExplosion(gX, gY, 8, Gear^.Hedgehog, 0);//, EXPLNoDamage);
+ doMakeExplosion(gX, gY, 8, Gear^.Hedgehog, 0);//, EXPLNoDamage);
//DrawExplosion(gX, gY, 4);
-
+
if ((GameTicks and $7) = 0) and (Random(2) = 0) then
for i:= Random(2) downto 0 do
AddVisualGear(gX - 3 + Random(6), gY - 2, vgtSmoke);
-
+
if Gear^.Health > 0 then
dec(Gear^.Health);
Gear^.Timer := 450 - Gear^.Tag * 8
@@ -2009,7 +2010,7 @@
begin
gX := hwRound(Gear^.X);
gY := hwRound(Gear^.Y);
- if not sticky then
+ if (not sticky) then
begin
if ((GameTicks and $3) = 0) and (Random(1) = 0) then
for i:= Random(2) downto 0 do
@@ -2025,7 +2026,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepFirePunchWork(Gear: PGear);
-var
+var
HHGear: PGear;
begin
AllInactive := false;
@@ -2048,7 +2049,7 @@
end;
HHGear^.dY := HHGear^.dY + cGravity;
- if not (HHGear^.dY.isNegative) then
+ if (not HHGear^.dY.isNegative) then
begin
HHGear^.State := HHGear^.State or gstMoving;
DeleteGear(Gear);
@@ -2062,7 +2063,7 @@
end;
procedure doStepFirePunch(Gear: PGear);
-var
+var
HHGear: PGear;
begin
AllInactive := false;
@@ -2085,7 +2086,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepParachuteWork(Gear: PGear);
-var
+var
HHGear: PGear;
begin
HHGear := Gear^.Hedgehog^.Gear;
@@ -2114,13 +2115,13 @@
if (Gear^.Message and gmLeft) <> 0 then
HHGear^.X := HHGear^.X - cMaxWindSpeed * 80
-
+
else if (Gear^.Message and gmRight) <> 0 then
HHGear^.X := HHGear^.X + cMaxWindSpeed * 80;
-
+
if (Gear^.Message and gmUp) <> 0 then
HHGear^.Y := HHGear^.Y - cGravity * 40
-
+
else if (Gear^.Message and gmDown) <> 0 then
HHGear^.Y := HHGear^.Y + cGravity * 40;
@@ -2133,7 +2134,7 @@
end;
procedure doStepParachute(Gear: PGear);
-var
+var
HHGear: PGear;
begin
HHGear := Gear^.Hedgehog^.Gear;
@@ -2157,10 +2158,10 @@
AllInactive := false;
Gear^.X := Gear^.X + cAirPlaneSpeed * Gear^.Tag;
- if (Gear^.Health > 0)and(not (Gear^.X < Gear^.dX))and(Gear^.X < Gear^.dX + cAirPlaneSpeed) then
+ if (Gear^.Health > 0) and (not (Gear^.X < Gear^.dX)) and (Gear^.X < Gear^.dX + cAirPlaneSpeed) then
begin
dec(Gear^.Health);
- case Gear^.State of
+ case Gear^.State of
0: FollowGear := AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtAirBomb, 0, cBombsSpeed * Gear^.Tag, _0, 0);
1: FollowGear := AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtMine, 0, cBombsSpeed * Gear^.Tag, _0, 0);
2: FollowGear := AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtNapalmBomb, 0, cBombsSpeed * Gear^.Tag, _0, 0);
@@ -2203,7 +2204,7 @@
// calcs for Napalm Strike, so that it will hit the target (without wind at least :P)
if (Gear^.State = 2) then
- Gear^.dX := Gear^.dX - cBombsSpeed * Gear^.Tag * 900
+ Gear^.dX := Gear^.dX - cBombsSpeed * Gear^.Tag * 900
// calcs for regular falling gears
else if (int2hwFloat(Gear^.Target.Y) - Gear^.Y > _0) then
Gear^.dX := Gear^.dX - cBombsSpeed * hwSqrt((int2hwFloat(Gear^.Target.Y) - Gear^.Y) * 2 /
@@ -2237,7 +2238,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepGirder(Gear: PGear);
-var
+var
HHGear: PGear;
x, y, tx, ty: hwFloat;
begin
@@ -2250,7 +2251,7 @@
y := HHGear^.Y;
if (Distance(tx - x, ty - y) > _256)
- or (not TryPlaceOnLand(Gear^.Target.X - SpritesData[sprAmGirder].Width div 2, Gear^.Target.Y - SpritesData[sprAmGirder].Height div 2, sprAmGirder, Gear^.State, true, false)) then
+ or (not (TryPlaceOnLand(Gear^.Target.X - SpritesData[sprAmGirder].Width div 2, Gear^.Target.Y - SpritesData[sprAmGirder].Height div 2, sprAmGirder, Gear^.State, true, false))) then
begin
PlaySound(sndDenied);
HHGear^.Message := HHGear^.Message and (not gmAttack);
@@ -2259,7 +2260,7 @@
isCursorVisible := true;
DeleteGear(Gear)
end
- else
+ else
begin
PlaySound(sndPlaced);
DeleteGear(Gear);
@@ -2272,7 +2273,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepTeleportAfter(Gear: PGear);
-var
+var
HHGear: PGear;
begin
HHGear := Gear^.Hedgehog^.Gear;
@@ -2306,15 +2307,15 @@
end;
procedure doStepTeleport(Gear: PGear);
-var
+var
HHGear: PGear;
begin
AllInactive := false;
HHGear := Gear^.Hedgehog^.Gear;
- if not TryPlaceOnLand(Gear^.Target.X - SpritesData[sprHHTelepMask].Width div 2,
+ if (not (TryPlaceOnLand(Gear^.Target.X - SpritesData[sprHHTelepMask].Width div 2,
Gear^.Target.Y - SpritesData[sprHHTelepMask].Height div 2,
- sprHHTelepMask, 0, false, false) then
+ sprHHTelepMask, 0, false, false))) then
begin
HHGear^.Message := HHGear^.Message and (not gmAttack);
HHGear^.State := HHGear^.State and (not gstAttacking);
@@ -2347,7 +2348,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepSwitcherWork(Gear: PGear);
-var
+var
HHGear: PGear;
hedgehog: PHedgehog;
State: Longword;
@@ -2385,7 +2386,7 @@
until (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear <> nil) and (CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog].Gear^.Damage = 0);
SwitchCurrentHedgehog(@CurrentTeam^.Hedgehogs[CurrentTeam^.CurrHedgehog]);
- AmmoMenuInvalidated:= true;
+ AmmoMenuInvalidated:= true;
HHGear := CurrentHedgehog^.Gear;
HHGear^.State := State;
@@ -2399,7 +2400,7 @@
end;
procedure doStepSwitcher(Gear: PGear);
-var
+var
HHGear: PGear;
begin
Gear^.doStep := @doStepSwitcherWork;
@@ -2450,7 +2451,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepKamikazeWork(Gear: PGear);
-var
+var
i: LongWord;
HHGear: PGear;
sparkles: PVisualGear;
@@ -2485,7 +2486,7 @@
i := 2;
repeat
-
+
Gear^.X := Gear^.X + HHGear^.dX;
Gear^.Y := Gear^.Y + HHGear^.dY;
HHGear^.X := Gear^.X;
@@ -2568,7 +2569,7 @@
end;
procedure doStepKamikaze(Gear: PGear);
-var
+var
HHGear: PGear;
begin
AllInactive := false;
@@ -2589,7 +2590,7 @@
////////////////////////////////////////////////////////////////////////////////
const cakeh = 27;
-var
+var
CakePoints: array[0..Pred(cakeh)] of record
x, y: hwFloat;
end;
@@ -2609,7 +2610,7 @@
end;
procedure doStepCakeDown(Gear: PGear);
-var
+var
gi: PGear;
dmg, dmgBase: LongInt;
fX, fY, tdX, tdY: hwFloat;
@@ -2695,7 +2696,7 @@
end;
procedure doStepCakeUp(Gear: PGear);
-var
+var
i: Longword;
begin
AllInactive := false;
@@ -2735,7 +2736,7 @@
end;
procedure doStepCake(Gear: PGear);
-var
+var
HHGear: PGear;
begin
AllInactive := false;
@@ -2753,6 +2754,7 @@
procedure doStepSeductionWork(Gear: PGear);
var i: LongInt;
hogs: PGearArrayS;
+ len: Integer;
begin
AllInactive := false;
hogs := GearsNear(Gear^.X, Gear^.Y, gtHedgehog, Gear^.Radius);
@@ -2839,7 +2841,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepWaterUp(Gear: PGear);
-var
+var
i: LongWord;
begin
if (Gear^.Tag = 0)
@@ -2873,7 +2875,7 @@
forward;
procedure doStepDrillDrilling(Gear: PGear);
-var
+var
t: PGearArray;
ox, oy: hwFloat;
begin
@@ -2897,14 +2899,14 @@
if GameTicks > Gear^.FlightTime then
t := CheckGearsCollision(Gear)
-
+
else t := nil;
//fixes drill not exploding when touching HH bug
-
+
if (Gear^.Timer = 0) or ((t <> nil) and (t^.Count <> 0))
or ( ((Gear^.State and gsttmpFlag) = 0) and (TestCollisionYWithGear(Gear, hwSign(Gear^.dY)) = 0) and (not TestCollisionXWithGear(Gear, hwSign(Gear^.dX))))
// CheckLandValue returns true if the type isn't matched
- or (not CheckLandValue(hwRound(Gear^.X), hwRound(Gear^.Y), lfIndestructible)) then
+ or (not (CheckLandValue(hwRound(Gear^.X), hwRound(Gear^.Y), lfIndestructible))) then
begin
//out of time or exited ground
StopSoundChan(Gear^.SoundChannel);
@@ -2915,8 +2917,8 @@
DeleteGear(Gear);
exit
end
-
- else if (TestCollisionYWithGear(Gear, hwSign(Gear^.dY)) = 0) and (not TestCollisionXWithGear(Gear, hwSign(Gear^.dX))) then
+
+ else if (TestCollisionYWithGear(Gear, hwSign(Gear^.dY)) = 0) and (not (TestCollisionXWithGear(Gear, hwSign(Gear^.dX)))) then
begin
StopSoundChan(Gear^.SoundChannel);
Gear^.Tag := 1;
@@ -2927,7 +2929,7 @@
end;
procedure doStepDrill(Gear: PGear);
-var
+var
t: PGearArray;
oldDx, oldDy: hwFloat;
t2: hwFloat;
@@ -2951,7 +2953,7 @@
Gear^.dX := oldDx;
Gear^.dY := oldDy;
- if GameTicks > Gear^.FlightTime then
+ if GameTicks > Gear^.FlightTime then
t := CheckGearsCollision(Gear)
else
t := nil;
@@ -2962,7 +2964,7 @@
Gear^.dX := Gear^.dX * t2;
Gear^.dY := Gear^.dY * t2;
end
-
+
else if (t <> nil) then
begin
//explode right on contact with HH
@@ -2976,14 +2978,14 @@
Gear^.SoundChannel := LoopSound(sndDrillRocket);
Gear^.doStep := @doStepDrillDrilling;
-
+
if (Gear^.State and gsttmpFlag) <> 0 then
gear^.RenderTimer:= true;
if Gear^.Timer > 0 then dec(Gear^.Timer)
end
else if ((Gear^.State and gsttmpFlag) <> 0) and (Gear^.Tag <> 0) then
begin
- if Gear^.Timer > 0 then
+ if Gear^.Timer > 0 then
dec(Gear^.Timer)
else
begin
@@ -2995,7 +2997,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepBallgunWork(Gear: PGear);
-var
+var
HHGear, ball: PGear;
rx, ry: hwFloat;
gX, gY: LongInt;
@@ -3025,7 +3027,7 @@
end;
procedure doStepBallgun(Gear: PGear);
-var
+var
HHGear: PGear;
begin
HHGear := Gear^.Hedgehog^.Gear;
@@ -3038,7 +3040,7 @@
procedure doStepRCPlaneWork(Gear: PGear);
const cAngleSpeed = 3;
-var
+var
HHGear: PGear;
i: LongInt;
dX, dY: hwFloat;
@@ -3147,7 +3149,7 @@
begin
if TagTurnTimeLeft = 0 then
TagTurnTimeLeft:= TurnTimeLeft;
-
+
TurnTimeLeft:= 14 * 125;
end;
@@ -3157,7 +3159,7 @@
end;
procedure doStepRCPlane(Gear: PGear);
-var
+var
HHGear: PGear;
begin
HHGear := Gear^.Hedgehog^.Gear;
@@ -3165,7 +3167,7 @@
HHGear^.State := HHGear^.State or gstNotKickable;
Gear^.Angle := HHGear^.Angle;
Gear^.Tag := hwSign(HHGear^.dX);
-
+
if HHGear^.dX.isNegative then
Gear^.Angle := 4096 - Gear^.Angle;
Gear^.doStep := @doStepRCPlaneWork
@@ -3173,7 +3175,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepJetpackWork(Gear: PGear);
-var
+var
HHGear: PGear;
fuel, i: LongInt;
move: hwFloat;
@@ -3252,9 +3254,9 @@
if Gear^.Health < 0 then
Gear^.Health := 0;
-
+
i:= Gear^.Health div 20;
-
+
if (i <> Gear^.Damage) and ((GameTicks and $3F) = 0) then
begin
Gear^.Damage:= i;
@@ -3263,19 +3265,19 @@
Gear^.Tex := RenderStringTex(trmsg[sidFuel] + ': ' + inttostr(i) + '%', cWhiteColor, fntSmall)
end;
- if HHGear^.Message and (gmAttack or gmUp or gmPrecise or gmLeft or gmRight) <> 0 then
+ if HHGear^.Message and (gmAttack or gmUp or gmPrecise or gmLeft or gmRight) <> 0 then
Gear^.State := Gear^.State and (not gsttmpFlag);
-
+
HHGear^.Message := HHGear^.Message and (not (gmUp or gmPrecise or gmLeft or gmRight));
HHGear^.State := HHGear^.State or gstMoving;
Gear^.X := HHGear^.X;
Gear^.Y := HHGear^.Y;
- if not isUnderWater and hasBorder and ((HHGear^.X < _0)
+ if (not isUnderWater) and hasBorder and ((HHGear^.X < _0)
or (hwRound(HHGear^.X) > LAND_WIDTH)) then
HHGear^.dY.isNegative:= false;
-
+
if ((Gear^.State and gsttmpFlag) = 0)
or (HHGear^.dY < _0) then
doStepHedgehogMoving(HHGear);
@@ -3307,7 +3309,7 @@
end;
procedure doStepJetpack(Gear: PGear);
-var
+var
HHGear: PGear;
begin
Gear^.Pos:= 0;
@@ -3320,7 +3322,7 @@
begin
State := State and (not gstAttacking);
Message := Message and (not (gmAttack or gmUp or gmPrecise or gmLeft or gmRight));
-
+
if (dY < _0_1) and (dY > -_0_1) then
begin
Gear^.State := Gear^.State or gsttmpFlag;
@@ -3343,13 +3345,13 @@
end;
procedure doStepBirdyFly(Gear: PGear);
-var
+var
HHGear: PGear;
fuel, i: LongInt;
move: hwFloat;
begin
HHGear := Gear^.Hedgehog^.Gear;
- if HHGear = nil then
+ if HHGear = nil then
begin
DeleteGear(Gear);
exit
@@ -3373,11 +3375,11 @@
if (not HHGear^.dY.isNegative)
or (HHGear^.Y > -_256) then
HHGear^.dY := HHGear^.dY - move;
-
+
dec(Gear^.Health, fuel);
Gear^.MsgParam := Gear^.MsgParam or gmUp;
end;
-
+
if (HHGear^.Message and gmLeft) <> 0 then move.isNegative := true;
if (HHGear^.Message and (gmLeft or gmRight)) <> 0 then
begin
@@ -3388,7 +3390,7 @@
if Gear^.Health < 0 then
Gear^.Health := 0;
-
+
if ((GameTicks and $FF) = 0) and (Gear^.Health < 500) then
for i:= ((500-Gear^.Health) div 250) downto 0 do
AddVisualGear(hwRound(Gear^.X), hwRound(Gear^.Y), vgtFeather);
@@ -3406,7 +3408,7 @@
if HHGear^.Message and (gmUp or gmPrecise or gmLeft or gmRight) <> 0 then
Gear^.State := Gear^.State and (not gsttmpFlag);
-
+
HHGear^.Message := HHGear^.Message and (not (gmUp or gmPrecise or gmLeft or gmRight));
HHGear^.State := HHGear^.State or gstMoving;
@@ -3449,7 +3451,7 @@
end;
procedure doStepBirdyDescend(Gear: PGear);
-var
+var
HHGear: PGear;
begin
if Gear^.Timer > 0 then
@@ -3490,12 +3492,12 @@
end;
procedure doStepBirdy(Gear: PGear);
-var
+var
HHGear: PGear;
begin
gear^.State := gear^.State or gstAnimation and (not gstTmpFlag);
Gear^.doStep := @doStepBirdyAppear;
-
+
if CurrentHedgehog = nil then
begin
DeleteGear(Gear);
@@ -3520,12 +3522,14 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepEggWork(Gear: PGear);
-var
+var
vg: PVisualGear;
i: LongInt;
begin
AllInactive := false;
+ {$IFNDEF PAS2C}
Gear^.dX := Gear^.dX;
+ {$ENDIF}
doStepFallingGear(Gear);
// CheckGearDrowning(Gear); // already checked for in doStepFallingGear
CalcRotationDirAngle(Gear);
@@ -3561,18 +3565,18 @@
if (CurAmmoType = amPortalGun) then
begin
CurrentHedgehog^.Gear^.Message := CurrentHedgehog^.Gear^.Message and (not gmSwitch);
-
+
CurWeapon:= GetCurAmmoEntry(CurrentHedgehog^);
if CurWeapon^.Pos <> 0 then
CurWeapon^.Pos := 0
-
+
else
CurWeapon^.Pos := 1;
end;
end;
procedure doStepPortal(Gear: PGear);
-var
+var
iterator, conPortal: PGear;
s, r, nx, ny, ox, oy, poffs, noffs, pspeed, nspeed,
resetx, resety, resetdx, resetdy: hwFloat;
@@ -3666,18 +3670,18 @@
// won't port stuff that does not move towards the front/portal entrance
if iscake then
begin
- if not (((iterator^.X - Gear^.X)*ox + (iterator^.Y - Gear^.Y)*oy).isNegative) then
+ if (not (((iterator^.X - Gear^.X)*ox + (iterator^.Y - Gear^.Y)*oy).isNegative)) then
continue;
end
else
- if not ((Gear^.dX*ox + Gear^.dY*oy).isNegative) then
+ if (not ((Gear^.dX*ox + Gear^.dY*oy).isNegative)) then
continue;
isbullet:= (iterator^.Kind in [gtShotgunShot, gtDEagleShot, gtSniperRifleShot, gtSineGunShot]);
r:= int2hwFloat(iterator^.Radius);
- if not (isbullet or iscake) then
+ if (not (isbullet or iscake)) then
begin
// wow! good candidate there, let's see if the distance and direction is okay!
if hasdxy then
@@ -3705,7 +3709,7 @@
oy := (iterator^.Y - Gear^.Y);
poffs:= (Gear^.dX * ox + Gear^.dY * oy);
- if not isBullet and poffs.isNegative then
+ if (not isBullet) and poffs.isNegative then
continue;
// only port bullets close to the portal
@@ -3732,7 +3736,7 @@
if Gear^.Elasticity.isNegative then
nx.isNegative := (not nx.isNegative)
else
- ny.isNegative := not ny.isNegative;
+ ny.isNegative := (not ny.isNegative);
// calc gear offset in portal normal vector direction
noffs:= (nx * ox + ny * oy);
@@ -3741,7 +3745,7 @@
continue;
// avoid gravity related loops of not really moving gear
- if not (iscake or isbullet)
+ if (not (iscake or isbullet))
and (Gear^.dY.isNegative)
and (conPortal^.dY.isNegative)
and ((iterator^.dX.QWordValue + iterator^.dY.QWordValue) < _0_08.QWordValue)
@@ -3766,7 +3770,7 @@
if conPortal^.Elasticity.isNegative then
nx.isNegative := (not nx.isNegative)
else
- ny.isNegative := not ny.isNegative;
+ ny.isNegative := (not ny.isNegative);
// inverse cake's normal movement direction,
// as if it just walked through a hole
@@ -3802,14 +3806,14 @@
iterator^.X := conPortal^.X + poffs * conPortal^.dX + noffs * nx;
iterator^.Y := conPortal^.Y + poffs * conPortal^.dY + noffs * ny;
- if not hasdxy and (not (conPortal^.dY.isNegative)) then
+ if (not hasdxy) and (not (conPortal^.dY.isNegative)) then
begin
iterator^.dY:= iterator^.dY + hwAbs(cGravity * (iterator^.Y - conPortal^.Y))
end;
// see if the space on the exit side actually is enough
- if not (isBullet or isCake) then
+ if (not (isBullet or isCake)) then
begin
// TestCollisionXwithXYShift requires a hwFloat for xShift
ox.QWordValue := _1.QWordValue;
@@ -3825,7 +3829,7 @@
isCollision := TestCollisionY(iterator, sy)
or TestCollisionX(iterator, sx);
- if not isCollision then
+ if (not isCollision) then
begin
// check center area (with half the radius so that the
// the square check won't check more pixels than we want to)
@@ -3873,11 +3877,11 @@
resetx.QWordValue:= 4294967296 * 35;
resetdx.isNegative:= false;
resetdx.QWordValue:= 4294967296 * 1152;
-
+
resetdy:=hwAbs(iterator^.dX*4);
resetdy:= resetdy + hwPow(resetdy,3)/_6 + _3 * hwPow(resetdy,5) / _40 + _5 * hwPow(resetdy,7) / resety + resetx * hwPow(resetdy,9) / resetdx;
iterator^.Angle:= hwRound(resetdy*_2048 / _PI);
- if not iterator^.dY.isNegative then iterator^.Angle:= 2048-iterator^.Angle;
+ if (not iterator^.dY.isNegative) then iterator^.Angle:= 2048-iterator^.Angle;
if iterator^.dX.isNegative then iterator^.Angle:= 4096-iterator^.Angle;
end
// VISUAL USE OF ANGLE ONLY
@@ -3894,7 +3898,7 @@
and (CurAmmoGear^.Kind =gtRope) then
CurAmmoGear^.PortalCounter:= 1;
- if not isbullet and (iterator^.State and gstInvisible = 0)
+ if (not isbullet) and (iterator^.State and gstInvisible = 0)
and (iterator^.Kind <> gtFlake) then
FollowGear := iterator;
@@ -3940,7 +3944,7 @@
end;
procedure doStepMovingPortal_real(Gear: PGear);
-var
+var
x, y, tx, ty: LongInt;
s: hwFloat;
begin
@@ -3954,9 +3958,9 @@
begin
Gear^.State := Gear^.State or gstCollision;
Gear^.State := Gear^.State and (not gstMoving);
-
+
if (Land[y, x] and lfBouncy <> 0)
- or (not CalcSlopeTangent(Gear, x, y, tx, ty, 255))
+ or (not (CalcSlopeTangent(Gear, x, y, tx, ty, 255)))
or (DistanceI(tx,ty) < _12) then // reject shots at too irregular terrain
begin
loadNewPortalBall(Gear, true);
@@ -3969,7 +3973,7 @@
Gear^.dY := -s * tx;
Gear^.DirAngle := DxDy2Angle(-Gear^.dY,Gear^.dX);
- if not Gear^.dX.isNegative then
+ if (not Gear^.dX.isNegative) then
Gear^.DirAngle := 180-Gear^.DirAngle;
if ((Gear^.LinkedGear = nil)
@@ -3982,7 +3986,7 @@
else
loadNewPortalBall(Gear, true);
end
-
+
else if (y > cWaterLine)
or (y < -max(LAND_WIDTH,4096))
or (x > 2*max(LAND_WIDTH,4096))
@@ -3994,13 +3998,13 @@
begin
doPortalColorSwitch();
doStepPerPixel(Gear, @doStepMovingPortal_real, true);
- if (Gear^.Timer < 1)
+ if (Gear^.Timer < 1)
or (Gear^.Hedgehog^.Team <> CurrentHedgehog^.Team) then
deleteGear(Gear);
end;
procedure doStepPortalShot(newPortal: PGear);
-var
+var
iterator: PGear;
s: hwFloat;
CurWeapon: PAmmo;
@@ -4059,7 +4063,7 @@
iterator:= GearsList;
while iterator <> nil do
begin
- if not (iterator^.Kind in [gtPortal, gtAirAttack, gtKnife]) and ((iterator^.Hedgehog <> CurrentHedgehog)
+ if (not (iterator^.Kind in [gtPortal, gtAirAttack, gtKnife])) and ((iterator^.Hedgehog <> CurrentHedgehog)
or ((iterator^.Message and gmAllStoppable) = 0)) then
begin
iterator^.Active:= true;
@@ -4080,15 +4084,15 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepPiano(Gear: PGear);
-var
+var
r0, r1: LongInt;
odY: hwFloat;
begin
AllInactive := false;
- if (CurrentHedgehog <> nil) and (CurrentHedgehog^.Gear <> nil) and
+ if (CurrentHedgehog <> nil) and (CurrentHedgehog^.Gear <> nil) and
((CurrentHedgehog^.Gear^.Message and gmSlot) <> 0) then
begin
- case CurrentHedgehog^.Gear^.MsgParam of
+ case CurrentHedgehog^.Gear^.MsgParam of
0: PlaySound(sndPiano0);
1: PlaySound(sndPiano1);
2: PlaySound(sndPiano2);
@@ -4168,7 +4172,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepSineGunShotWork(Gear: PGear);
-var
+var
x, y, rX, rY, t, tmp, initHealth: LongInt;
oX, oY, ldX, ldY, sdX, sdY, sine, lx, ly, amp: hwFloat;
justCollided: boolean;
@@ -4263,7 +4267,7 @@
end;
if random(100) = 0 then
- AddVisualGear(x, y, vgtSmokeTrace);
+ AddVisualGear(x, y, vgtSmokeTrace);
end
else dec(Gear^.Health, 5); // if underwater get additional damage
end;
@@ -4301,7 +4305,7 @@
var
HHGear: PGear;
begin
- PlaySound(sndSineGun);
+ PlaySound(sndSineGun);
// push the shooting Hedgehog back
HHGear := CurrentHedgehog^.Gear;
@@ -4321,7 +4325,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepFlamethrowerWork(Gear: PGear);
-var
+var
HHGear, flame: PGear;
rx, ry, speed: hwFloat;
i, gX, gY: LongInt;
@@ -4331,7 +4335,7 @@
HedgehogChAngle(HHGear);
gX := hwRound(Gear^.X) + GetLaunchX(amBallgun, hwSign(HHGear^.dX), HHGear^.Angle);
gY := hwRound(Gear^.Y) + GetLaunchY(amBallgun, HHGear^.Angle);
-
+
if (GameTicks and $FF) = 0 then
begin
if (HHGear^.Message and gmRight) <> 0 then
@@ -4345,11 +4349,11 @@
begin
if HHGear^.dX.isNegative and (Gear^.Tag > 5) then
dec(Gear^.Tag)
- else if Gear^.Tag < 20 then
+ else if Gear^.Tag < 20 then
inc(Gear^.Tag);
end
end;
-
+
dec(Gear^.Timer);
if Gear^.Timer = 0 then
begin
@@ -4359,12 +4363,12 @@
rx := rndSign(getRandomf * _0_1);
ry := rndSign(getRandomf * _0_1);
speed := _0_5 * (_10 / Gear^.Tag);
-
+
flame:= AddGear(gx, gy, gtFlame, gstTmpFlag,
SignAs(AngleSin(HHGear^.Angle) * speed, HHGear^.dX) + rx,
AngleCos(HHGear^.Angle) * ( - speed) + ry, 0);
flame^.CollisionMask:= $FF7F;
-
+
if (Gear^.Health mod 30) = 0 then
begin
flame:= AddGear(gx, gy, gtFlame, 0,
@@ -4395,7 +4399,7 @@
end;
procedure doStepFlamethrower(Gear: PGear);
-var
+var
HHGear: PGear;
begin
HHGear := Gear^.Hedgehog^.Gear;
@@ -4406,7 +4410,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepLandGunWork(Gear: PGear);
-var
+var
HHGear, land: PGear;
rx, ry, speed: hwFloat;
i, gX, gY: LongInt;
@@ -4416,7 +4420,7 @@
HedgehogChAngle(HHGear);
gX := hwRound(Gear^.X) + GetLaunchX(amBallgun, hwSign(HHGear^.dX), HHGear^.Angle);
gY := hwRound(Gear^.Y) + GetLaunchY(amBallgun, HHGear^.Angle);
-
+
if (GameTicks and $FF) = 0 then
begin
if (HHGear^.Message and gmRight) <> 0 then
@@ -4434,7 +4438,7 @@
inc(Gear^.Tag);
end
end;
-
+
dec(Gear^.Timer);
if Gear^.Timer = 0 then
begin
@@ -4444,11 +4448,11 @@
ry := rndSign(getRandomf * _0_1);
speed := (_3 / Gear^.Tag);
- land:= AddGear(gx, gy, gtFlake, gstTmpFlag,
- SignAs(AngleSin(HHGear^.Angle) * speed, HHGear^.dX) + rx,
+ land:= AddGear(gx, gy, gtFlake, gstTmpFlag,
+ SignAs(AngleSin(HHGear^.Angle) * speed, HHGear^.dX) + rx,
AngleCos(HHGear^.Angle) * ( - speed) + ry, 0);
land^.CollisionMask:= $FF7F;
-
+
Gear^.Timer:= Gear^.Tag
end;
@@ -4472,7 +4476,7 @@
end;
procedure doStepLandGun(Gear: PGear);
-var
+var
HHGear: PGear;
begin
HHGear := Gear^.Hedgehog^.Gear;
@@ -4541,7 +4545,7 @@
end;
procedure doStepHammerHitWork(Gear: PGear);
-var
+var
i, j, ei: LongInt;
HitGear: PGear;
begin
@@ -4596,7 +4600,7 @@
end;
procedure doStepHammerHit(Gear: PGear);
-var
+var
i, y: LongInt;
ar: TRangeArray;
HHGear: PGear;
@@ -4628,6 +4632,7 @@
resgear: PGear;
hh: PHedgehog;
i: LongInt;
+ len: Integer;
begin
if (TurnTimeLeft > 0) then
dec(TurnTimeLeft);
@@ -4646,7 +4651,7 @@
begin
if (GameTicks and $F) <> 0 then
exit;
- end
+ end
else if (GameTicks and $1FF) <> 0 then
exit;
@@ -4683,8 +4688,8 @@
inc(graves[i]^.Health);
end;
end; -}
- end
- else
+ end
+ else
begin
// now really resurrect the hogs with the hp saved in the graves
for i:= 0 to graves.size - 1 do
@@ -4719,6 +4724,7 @@
var
graves: PGearArrayS;
i: LongInt;
+ len: Integer;
begin
AllInactive := false;
graves := GearsNear(Gear^.X, Gear^.Y, gtGrave, Gear^.Radius);
@@ -4731,8 +4737,8 @@
graves.ar^[i]^.Health := 0;
end;
Gear^.doStep := @doStepResurrectorWork;
- end
- else
+ end
+ else
begin
StopSoundChan(Gear^.SoundChannel);
Gear^.Timer := 250;
@@ -4752,7 +4758,7 @@
begin
doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 10, Gear^.Hedgehog, EXPLAutoSound);
gX := hwRound(Gear^.X);
- gY := hwRound(Gear^.Y);
+ gY := hwRound(Gear^.Y);
for i:= 0 to 10 do
begin
dX := AngleCos(i * 2) * ((_0_1*(i div 5))) * (GetRandomf + _1);
@@ -4780,7 +4786,7 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepStructure(Gear: PGear);
-var
+var
x, y: LongInt;
HH: PHedgehog;
t: PGear;
@@ -4797,7 +4803,7 @@
dec(Gear^.Health, Gear^.Damage);
Gear^.Damage:= 0;
-
+
if Gear^.Pos = 1 then
begin
AddGearCI(Gear);
@@ -4808,7 +4814,7 @@
HideHog(HH);
Gear^.Pos:= 2
end;
-
+
if Gear^.Pos = 2 then
begin
if ((GameTicks mod 100) = 0) and (Gear^.Timer < 1000) then
@@ -4824,7 +4830,7 @@
if Gear^.Tag <= TotalRounds then
Gear^.Pos:= 3;
end;
-
+
if Gear^.Pos = 3 then
if Gear^.Timer < 1000 then
begin
@@ -4842,7 +4848,7 @@
RestoreHog(HH);
Gear^.Pos:= 4;
end;
-
+
if Gear^.Pos = 4 then
if ((GameTicks mod 1000) = 0) and ((GameFlags and gfInvulnerable) = 0) then
begin
@@ -4854,12 +4860,12 @@
t:= t^.NextGear;
end;
end;
-
+
if Gear^.Health <= 0 then
begin
if HH^.GearHidden <> nil then
RestoreHog(HH);
-
+
x := hwRound(Gear^.X);
y := hwRound(Gear^.Y);
@@ -4872,7 +4878,7 @@
////////////////////////////////////////////////////////////////////////////////
(*
- TARDIS needs
+ TARDIS needs
Warp in. Pos = 1
Pause. Pos = 2
Hide gear (TARDIS hedgehog was nil)
@@ -4898,7 +4904,7 @@
begin
AfterAttack;
if Gear = CurAmmoGear then CurAmmoGear := nil;
- if (HH^.Gear^.Damage = 0) and (HH^.Gear^.Health > 0) and
+ if (HH^.Gear^.Damage = 0) and (HH^.Gear^.Health > 0) and
((Gear^.State and (gstMoving or gstHHDeath or gstHHGone)) = 0) then
HideHog(HH)
end
@@ -4918,7 +4924,7 @@
if (Gear^.Pos = 1) and (GameTicks and $1F = 0) and (Gear^.Power < 255) then
begin
inc(Gear^.Power);
- if (Gear^.Power = 172) and (HH^.Gear <> nil) and
+ if (Gear^.Power = 172) and (HH^.Gear <> nil) and
(HH^.Gear^.Damage = 0) and (HH^.Gear^.Health > 0) and
((HH^.Gear^.State and (gstMoving or gstHHDeath or gstHHGone)) = 0) then
with HH^.Gear^ do
@@ -4959,7 +4965,7 @@
begin
if HH^.GearHidden <> nil then
FindPlace(HH^.GearHidden, false, 0, LAND_WIDTH,true);
-
+
if HH^.GearHidden <> nil then
begin
Gear^.X:= HH^.GearHidden^.X;
@@ -5035,19 +5041,21 @@
WIP. The ice gun will have the following effects. It has been proposed by sheepluva that it take the appearance of a large freezer
spewing ice cubes. The cubes will be visual gears only. The scatter from them and the impact snow dust should help hide imprecisions in things like the GearsNear effect.
For now we assume a "ray" like a deagle projected out from the gun.
-All these effects assume the ray's angle is not changed and that the target type was unchanged over a number of ticks. This is a simplifying assumption for "gun was applying freezing effect to the same target".
+All these effects assume the ray's angle is not changed and that the target type was unchanged over a number of ticks. This is a simplifying assumption for "gun was applying freezing effect to the same target".
* When fired at water a layer of ice textured land is added above the water.
* When fired at non-ice land (land and $FF00 and not lfIce) the land is overlaid with a thin layer of ice textured land around that point (say, 1 or 2px into land, 1px above). For attractiveness, a slope would probably be needed.
* When fired at a hog (land and $00FF <> 0), while the hog is targetted, the hog's state is set to frozen. As long as the gun is on the hog, a frozen hog sprite creeps up from the feet to the head. If the effect is interrupted before reaching the top, the freezing state is cleared.
A frozen hog will animate differently. To be decided, but possibly in a similar fashion to a grave when it comes to explosions. The hog might (possibly) not be damaged by explosions. This might make freezing potentially useful for friendlies in a bad position. It might be better to allow damage though.
A frozen hog stays frozen for a certain number of turns. Each turn the frozen overlay becomes fainter, until it fades and the hog animates normally again.
*)
+
procedure doStepIceGun(Gear: PGear);
var
HHGear: PGear;
ndX, ndY: hwFloat;
i, t, gX, gY: LongInt;
hogs: PGearArrayS;
+ len: Integer;
begin
HHGear := Gear^.Hedgehog^.Gear;
if (Gear^.Health = 0) or (HHGear = nil) or (HHGear^.Damage <> 0) then
@@ -5073,8 +5081,8 @@
HedgehogChAngle(HHGear);
ndX:= SignAs(AngleSin(HHGear^.Angle), HHGear^.dX) * _4;
ndY:= -AngleCos(HHGear^.Angle) * _4;
- if (ndX <> dX) or (ndY <> dY) or
- ((Target.X <> NoPointX) and (Target.X and LAND_WIDTH_MASK = 0) and
+ if (ndX <> dX) or (ndY <> dY) or
+ ((Target.X <> NoPointX) and (Target.X and LAND_WIDTH_MASK = 0) and
(Target.Y and LAND_HEIGHT_MASK = 0) and ((Land[Target.Y, Target.X] = 0))) then
begin
dX:= ndX;
@@ -5088,8 +5096,8 @@
iter := GearsList;
while iter <> nil do
begin
- if (iter^.Kind = gtHedgehog) and
- (iter^.Hedgehog^.Effects[heFrozen] < 0) then
+ if (iter^.Kind = gtHedgehog) and
+ (iter^.Hedgehog^.Effects[heFrozen] < 0) then
iter^.Hedgehog^.Effects[heFrozen]:= 0;
iter:= iter^.NextGear
end *)
@@ -5157,7 +5165,7 @@
begin
with gi^ do CheckSum:= CheckSum xor X.round xor X.frac xor dX.round xor dX.frac xor Y.round xor Y.frac xor dY.round xor dY.frac;
AddRandomness(CheckSum);
- if gi^.Kind = gtGenericFaller then gi^.State:= gi^.State and not gstTmpFlag;
+ if gi^.Kind = gtGenericFaller then gi^.State:= gi^.State and (not gstTmpFlag);
gi := gi^.NextGear
end;
AddPickup(Gear^.Hedgehog^, a, Gear^.Power, hwRound(Gear^.X), hwRound(Gear^.Y));
@@ -5211,7 +5219,7 @@
DeleteGear(Gear)
end;
// ssssss he essssscaped
- if (Gear^.Timer > 250) and ((HHGear = nil) or
+ if (Gear^.Timer > 250) and ((HHGear = nil) or
(((abs(HHGear^.X.Round-Gear^.X.Round) + abs(HHGear^.Y.Round-Gear^.Y.Round) + 2) > 180) and
(Distance(HHGear^.X-Gear^.X,HHGear^.Y-Gear^.Y) > _180))) then
begin
@@ -5222,7 +5230,7 @@
end;
// Search out a new target, as target seek time has expired, target is dead, target is out of range, or we did not have a target
-if (HHGear = nil) or (Gear^.Timer = 0) or
+if (HHGear = nil) or (Gear^.Timer = 0) or
(((abs(HHGear^.X.Round-Gear^.X.Round) + abs(HHGear^.Y.Round-Gear^.Y.Round) + 2) > Gear^.Angle) and
(Distance(HHGear^.X-Gear^.X,HHGear^.Y-Gear^.Y) > int2hwFloat(Gear^.Angle)))
then
@@ -5257,7 +5265,7 @@
begin
tdX:= HHGear^.X-Gear^.X;
dir:= hwSign(tdX);
- if not TestCollisionX(Gear, dir) then
+ if (not TestCollisionX(Gear, dir)) then
Gear^.X:= Gear^.X + signAs(_1,tdX);
if TestCollisionXwithXYShift(Gear, signAs(_10,tdX), 0, dir) then
begin
@@ -5330,8 +5338,8 @@
else if GameTicks and $3F = 0 then
begin
if (TestCollisionYwithGear(Gear, -1) = 0)
- and (not TestCollisionXwithGear(Gear, 1))
- and (not TestCollisionXwithGear(Gear, -1))
+ and (not (TestCollisionXwithGear(Gear, 1)))
+ and (not (TestCollisionXwithGear(Gear, -1)))
and (TestCollisionYwithGear(Gear, 1) = 0) then Gear^.State:= Gear^.State and (not gstCollision) or gstMoving;
end
end;
@@ -5339,7 +5347,7 @@
This didn't end up getting used, but, who knows, might be reasonable for javellin or something
// Make the knife initial angle based on the hog attack angle, or is that too hard?
procedure doStepKnife(Gear: PGear);
-var t,
+var t,
gx, gy, ga, // gear x,y,angle
lx, ly, la, // land x,y,angle
ox, oy, // x,y offset
@@ -5363,7 +5371,7 @@
begin
if CheckLandValue(gx, gy, $FF00) then
begin
- t:= Angle + hwRound((hwAbs(dX)+hwAbs(dY)) * _10);
+ t:= Angle + hwRound((hwAbs(dX)+hwAbs(dY)) * _10);
if t < 0 then inc(t, 4096)
else if 4095 < t then dec(t, 4096);
@@ -5400,7 +5408,7 @@
4: begin
ox:= 29; oy:= 8;
w:= 19; h:= 19;
- tx:= 0; ty:= 17
+ tx:= 0; ty:= 17
end;
5: begin
ox:= 29; oy:= 32;
@@ -5410,7 +5418,7 @@
6: begin
ox:= 51; oy:= 3;
w:= 11; h:= 23;
- tx:= 0; ty:= 22
+ tx:= 0; ty:= 22
end;
7: begin
ox:= 51; oy:= 34;
@@ -5418,7 +5426,7 @@
tx:= 0; ty:= 23
end
end;
-
+
surf:= SDL_CreateRGBSurface(SDL_SWSURFACE, w, h, 32, RMask, GMask, BMask, AMask);
copyToXYFromRect(SpritesData[sprKnife].Surface, surf, ox, oy, w, h, 0, 0);
// try to make the knife hit point first
@@ -5440,7 +5448,7 @@
AddFileLog('la: '+inttostr(la)+' ga: '+inttostr(ga)+' Angle: '+inttostr(Angle))
end;
case Angle div 1024 of
- 0: begin
+ 0: begin
flipSurface(surf, true);
flipSurface(surf, true);
BlitImageAndGenerateCollisionInfo(gx-(w-tx), gy-(h-ty), w, surf)
--- a/hedgewars/LuaPas.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/LuaPas.pas Sun Jan 27 00:28:57 2013 +0100
@@ -54,12 +54,14 @@
@* of a function in debug information.
** CHANGE it if you want a different size.
*)
+
const
LUA_IDSIZE = 60;
(*
@@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system.
*)
+
const
LUAL_BUFFERSIZE = 1024;
@@ -69,6 +71,7 @@
** CHANGE them if you want different prompts. (You can also change the
** prompts dynamically, assigning to globals _PROMPT/_PROMPT2.)
*)
+
const
LUA_PROMPT = '> ';
LUA_PROMPT2 = '>> ';
@@ -112,6 +115,7 @@
** See Copyright Notice at the end of this file
*)
+
const
LUA_VERSION = 'Lua 5.1';
LUA_VERSION_NUM = 501;
@@ -131,8 +135,10 @@
LUA_ENVIRONINDEX = -10001;
LUA_GLOBALSINDEX = -10002;
+
function lua_upvalueindex(idx : LongInt) : LongInt; // a marco
+
const
(* thread status; 0 is OK *)
LUA_YIELD_ = 1; // Note: the ending underscore is needed in Pascal
@@ -141,6 +147,7 @@
LUA_ERRMEM = 4;
LUA_ERRERR = 5;
+
type
lua_CFunction = function(L : Plua_State) : LongInt; cdecl;
@@ -155,6 +162,7 @@
*)
lua_Alloc = function (ud, ptr : Pointer; osize, nsize : size_t) : Pointer; cdecl;
+
const
(*
** basic types
@@ -180,6 +188,7 @@
(* type for integer functions *)
lua_Integer = LUA_INTEGER_;
+
(*
** state manipulation
*)
@@ -240,10 +249,9 @@
function lua_type(L : Plua_State; idx : LongInt) : LongInt;
cdecl; external LuaLibName;
-
+
function lua_typename(L : Plua_State; tp : LongInt) : PChar;
cdecl; external LuaLibName;
-
function lua_equal(L : Plua_State; idx1, idx2 : LongInt) : LongBool;
cdecl; external LuaLibName;
@@ -263,10 +271,9 @@
function lua_toboolean(L : Plua_State; idx : LongInt) : LongBool;
cdecl; external LuaLibName;
-
function lua_tolstring(L : Plua_State; idx : LongInt; len : Psize_t) : PChar;
cdecl; external LuaLibName;
-
+
function lua_objlen(L : Plua_State; idx : LongInt) : size_t;
cdecl; external LuaLibName;
@@ -294,14 +301,13 @@
procedure lua_pushinteger(L : Plua_State; n : lua_Integer);
cdecl; external LuaLibName;
-
+
procedure lua_pushlstring(L : Plua_State; const s : PChar; ls : size_t);
cdecl; external LuaLibName;
procedure lua_pushstring(L : Plua_State; const s : PChar);
cdecl; external LuaLibName;
-
function lua_pushvfstring(L : Plua_State;
const fmt : PChar; argp : Pointer) : PChar;
cdecl; external LuaLibName;
@@ -327,10 +333,10 @@
*)
procedure lua_gettable(L : Plua_State ; idx : LongInt);
cdecl; external LuaLibName;
-
+
procedure lua_getfield(L : Plua_State; idx : LongInt; k : PChar);
cdecl; external LuaLibName;
-
+
procedure lua_rawget(L : Plua_State; idx : LongInt);
cdecl; external LuaLibName;
@@ -355,10 +361,10 @@
*)
procedure lua_settable(L : Plua_State; idx : LongInt);
cdecl; external LuaLibName;
-
+
procedure lua_setfield(L : Plua_State; idx : LongInt; const k : PChar);
cdecl; external LuaLibName;
-
+
procedure lua_rawset(L : Plua_State; idx : LongInt);
cdecl; external LuaLibName;
@@ -406,6 +412,7 @@
(*
** garbage-collection functions and options
*)
+
const
LUA_GCSTOP = 0;
LUA_GCRESTART = 1;
@@ -415,7 +422,7 @@
LUA_GCSTEP = 5;
LUA_GCSETPAUSE = 6;
LUA_GCSETSTEPMUL = 7;
-
+
function lua_gc(L : Plua_State; what, data : LongInt) : LongInt;
cdecl; external LuaLibName;
--- a/hedgewars/Math.h Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,2 +0,0 @@
-#pragma once
-
--- a/hedgewars/SDLMain.h Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,16 +0,0 @@
-/* SDLMain.m - main entry point for our Cocoa-ized SDL app
- Initial Version: Darrell Walisser <dwaliss1@purdue.edu>
- Non-NIB-Code & other changes: Max Horn <max@quendi.de>
-
- Feel free to customize this file to suit your needs
-*/
-
-#ifndef _SDLMain_h_
-#define _SDLMain_h_
-
-#import <Cocoa/Cocoa.h>
-
-@interface SDLMain : NSObject
-@end
-
-#endif /* _SDLMain_h_ */
--- a/hedgewars/SDLMain.m Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,385 +0,0 @@
-/* SDLMain.m - main entry point for our Cocoa-ized SDL app
- Initial Version: Darrell Walisser <dwaliss1@purdue.edu>
- Non-NIB-Code & other changes: Max Horn <max@quendi.de>
-
- Feel free to customize this file to suit your needs
-*/
-
-#include "SDL.h"
-#include "SDLMain.h"
-#include <sys/param.h> /* for MAXPATHLEN */
-#include <unistd.h>
-
-/* For some reaon, Apple removed setAppleMenu from the headers in 10.4,
- but the method still is there and works. To avoid warnings, we declare
- it ourselves here. */
-@interface NSApplication(SDL_Missing_Methods)
-- (void)setAppleMenu:(NSMenu *)menu;
-@end
-
-/* Use this flag to determine whether we use SDLMain.nib or not */
-#define SDL_USE_NIB_FILE 0
-
-/* Use this flag to determine whether we use CPS (docking) or not */
-#define SDL_USE_CPS 1
-#ifdef SDL_USE_CPS
-/* Portions of CPS.h */
-typedef struct CPSProcessSerNum
-{
- UInt32 lo;
- UInt32 hi;
-} CPSProcessSerNum;
-
-extern OSErr CPSGetCurrentProcess( CPSProcessSerNum *psn);
-extern OSErr CPSEnableForegroundOperation( CPSProcessSerNum *psn, UInt32 _arg2, UInt32 _arg3, UInt32 _arg4, UInt32 _arg5);
-extern OSErr CPSSetFrontProcess( CPSProcessSerNum *psn);
-
-#endif /* SDL_USE_CPS */
-
-static int gArgc;
-static char **gArgv;
-static BOOL gFinderLaunch;
-static BOOL gCalledAppMainline = FALSE;
-
-static NSString *getApplicationName(void)
-{
- const NSDictionary *dict;
- NSString *appName = 0;
-
- /* Determine the application name */
- dict = (const NSDictionary *)CFBundleGetInfoDictionary(CFBundleGetMainBundle());
- if (dict)
- appName = [dict objectForKey: @"CFBundleName"];
-
- if (![appName length])
- appName = [[NSProcessInfo processInfo] processName];
-
- return appName;
-}
-
-#if SDL_USE_NIB_FILE
-/* A helper category for NSString */
-@interface NSString (ReplaceSubString)
-- (NSString *)stringByReplacingRange:(NSRange)aRange with:(NSString *)aString;
-@end
-#endif
-
-@interface SDLApplication : NSApplication
-@end
-
-@implementation SDLApplication
-/* Invoked from the Quit menu item */
-- (void)terminate:(id)sender
-{
- /* Post a SDL_QUIT event */
- SDL_Event event;
- event.type = SDL_QUIT;
- SDL_PushEvent(&event);
-}
-@end
-
-/* The main class of the application, the application's delegate */
-@implementation SDLMain
-
-/* Set the working directory to the .app's parent directory */
-- (void) setupWorkingDirectory:(BOOL)shouldChdir
-{
- if (shouldChdir)
- {
- char parentdir[MAXPATHLEN];
- CFURLRef url = CFBundleCopyBundleURL(CFBundleGetMainBundle());
- CFURLRef url2 = CFURLCreateCopyDeletingLastPathComponent(0, url);
- if (CFURLGetFileSystemRepresentation(url2, 1, (UInt8 *)parentdir, MAXPATHLEN)) {
- chdir(parentdir); /* chdir to the binary app's parent */
- }
- CFRelease(url);
- CFRelease(url2);
- }
-}
-
-#if SDL_USE_NIB_FILE
-
-/* Fix menu to contain the real app name instead of "SDL App" */
-- (void)fixMenu:(NSMenu *)aMenu withAppName:(NSString *)appName
-{
- NSRange aRange;
- NSEnumerator *enumerator;
- NSMenuItem *menuItem;
-
- aRange = [[aMenu title] rangeOfString:@"SDL App"];
- if (aRange.length != 0)
- [aMenu setTitle: [[aMenu title] stringByReplacingRange:aRange with:appName]];
-
- enumerator = [[aMenu itemArray] objectEnumerator];
- while ((menuItem = [enumerator nextObject]))
- {
- aRange = [[menuItem title] rangeOfString:@"SDL App"];
- if (aRange.length != 0)
- [menuItem setTitle: [[menuItem title] stringByReplacingRange:aRange with:appName]];
- if ([menuItem hasSubmenu])
- [self fixMenu:[menuItem submenu] withAppName:appName];
- }
- [ aMenu sizeToFit ];
-}
-
-#else
-
-static void setApplicationMenu(void)
-{
- /* warning: this code is very odd */
- NSMenu *appleMenu;
- NSMenuItem *menuItem;
- NSString *title;
- NSString *appName;
-
- appName = getApplicationName();
- appleMenu = [[NSMenu alloc] initWithTitle:@""];
-
- /* Add menu items */
- title = [@"About " stringByAppendingString:appName];
- [appleMenu addItemWithTitle:title action:@selector(orderFrontStandardAboutPanel:) keyEquivalent:@""];
-
- [appleMenu addItem:[NSMenuItem separatorItem]];
-
- title = [@"Hide " stringByAppendingString:appName];
- [appleMenu addItemWithTitle:title action:@selector(hide:) keyEquivalent:@"h"];
-
- menuItem = (NSMenuItem *)[appleMenu addItemWithTitle:@"Hide Others" action:@selector(hideOtherApplications:) keyEquivalent:@"h"];
- [menuItem setKeyEquivalentModifierMask:(NSAlternateKeyMask|NSCommandKeyMask)];
-
- [appleMenu addItemWithTitle:@"Show All" action:@selector(unhideAllApplications:) keyEquivalent:@""];
-
- [appleMenu addItem:[NSMenuItem separatorItem]];
-
- title = [@"Quit " stringByAppendingString:appName];
- [appleMenu addItemWithTitle:title action:@selector(terminate:) keyEquivalent:@"q"];
-
-
- /* Put menu into the menubar */
- menuItem = [[NSMenuItem alloc] initWithTitle:@"" action:nil keyEquivalent:@""];
- [menuItem setSubmenu:appleMenu];
- [[NSApp mainMenu] addItem:menuItem];
-
- /* Tell the application object that this is now the application menu */
- [NSApp setAppleMenu:appleMenu];
-
- /* Finally give up our references to the objects */
- [appleMenu release];
- [menuItem release];
-}
-
-/* Create a window menu */
-static void setupWindowMenu(void)
-{
- NSMenu *windowMenu;
- NSMenuItem *windowMenuItem;
- NSMenuItem *menuItem;
-
- windowMenu = [[NSMenu alloc] initWithTitle:@"Window"];
-
- /* "Minimize" item */
- menuItem = [[NSMenuItem alloc] initWithTitle:@"Minimize" action:@selector(performMiniaturize:) keyEquivalent:@"m"];
- [windowMenu addItem:menuItem];
- [menuItem release];
-
- /* Put menu into the menubar */
- windowMenuItem = [[NSMenuItem alloc] initWithTitle:@"Window" action:nil keyEquivalent:@""];
- [windowMenuItem setSubmenu:windowMenu];
- [[NSApp mainMenu] addItem:windowMenuItem];
-
- /* Tell the application object that this is now the window menu */
- [NSApp setWindowsMenu:windowMenu];
-
- /* Finally give up our references to the objects */
- [windowMenu release];
- [windowMenuItem release];
-}
-
-/* Replacement for NSApplicationMain */
-static void CustomApplicationMain (int argc, char **argv)
-{
- NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
- SDLMain *sdlMain;
-
- /* Ensure the application object is initialised */
- [SDLApplication sharedApplication];
-
-#ifdef SDL_USE_CPS
- {
- CPSProcessSerNum PSN;
- /* Tell the dock about us */
- if (!CPSGetCurrentProcess(&PSN))
- if (!CPSEnableForegroundOperation(&PSN,0x03,0x3C,0x2C,0x1103))
- if (!CPSSetFrontProcess(&PSN))
- [SDLApplication sharedApplication];
- }
-#endif /* SDL_USE_CPS */
-
- /* Set up the menubar */
- NSMenu *menu = [[NSMenu alloc] init];
- [NSApp setMainMenu:menu];
- setApplicationMenu();
- setupWindowMenu();
- [menu release];
-
- /* Create SDLMain and make it the app delegate */
- sdlMain = [[SDLMain alloc] init];
- [NSApp setDelegate:sdlMain];
-
- /* Start the main event loop */
- [NSApp run];
-
- [sdlMain release];
- [pool release];
-}
-
-#endif
-
-
-/*
- * Catch document open requests...this lets us notice files when the app
- * was launched by double-clicking a document, or when a document was
- * dragged/dropped on the app's icon. You need to have a
- * CFBundleDocumentsType section in your Info.plist to get this message,
- * apparently.
- *
- * Files are added to gArgv, so to the app, they'll look like command line
- * arguments. Previously, apps launched from the finder had nothing but
- * an argv[0].
- *
- * This message may be received multiple times to open several docs on launch.
- *
- * This message is ignored once the app's mainline has been called.
- */
-- (BOOL)application:(NSApplication *)theApplication openFile:(NSString *)filename
-{
- const char *temparg;
- size_t arglen;
- char *arg;
- char **newargv;
-
- if (!gFinderLaunch) /* MacOS is passing command line args. */
- return FALSE;
-
- if (gCalledAppMainline) /* app has started, ignore this document. */
- return FALSE;
-
- temparg = [filename UTF8String];
- arglen = SDL_strlen(temparg) + 1;
- arg = (char *) SDL_malloc(arglen);
- if (arg == NULL)
- return FALSE;
-
- newargv = (char **) realloc(gArgv, sizeof (char *) * (gArgc + 2));
- if (newargv == NULL)
- {
- SDL_free(arg);
- return FALSE;
- }
- gArgv = newargv;
-
- SDL_strlcpy(arg, temparg, arglen);
- gArgv[gArgc++] = arg;
- gArgv[gArgc] = NULL;
- return TRUE;
-}
-
-
-/* Called when the internal event loop has just started running */
-- (void) applicationDidFinishLaunching: (NSNotification *) note
-{
- int status;
-
- /* Set the working directory to the .app's parent directory */
- [self setupWorkingDirectory:gFinderLaunch];
-
-#if SDL_USE_NIB_FILE
- /* Set the main menu to contain the real app name instead of "SDL App" */
- [self fixMenu:[NSApp mainMenu] withAppName:getApplicationName()];
-#endif
-
- /* Hand off to main application code */
- gCalledAppMainline = TRUE;
- status = SDL_main (gArgc, gArgv);
-
- /* We're done, thank you for playing */
- exit(status);
-}
-@end
-
-
-@implementation NSString (ReplaceSubString)
-
-- (NSString *)stringByReplacingRange:(NSRange)aRange with:(NSString *)aString
-{
- unsigned int bufferSize;
- unsigned int selfLen = [self length];
- unsigned int aStringLen = [aString length];
- unichar *buffer;
- NSRange localRange;
- NSString *result;
-
- bufferSize = selfLen + aStringLen - aRange.length;
- buffer = (unichar *)NSAllocateMemoryPages(bufferSize*sizeof(unichar));
-
- /* Get first part into buffer */
- localRange.location = 0;
- localRange.length = aRange.location;
- [self getCharacters:buffer range:localRange];
-
- /* Get middle part into buffer */
- localRange.location = 0;
- localRange.length = aStringLen;
- [aString getCharacters:(buffer+aRange.location) range:localRange];
-
- /* Get last part into buffer */
- localRange.location = aRange.location + aRange.length;
- localRange.length = selfLen - localRange.location;
- [self getCharacters:(buffer+aRange.location+aStringLen) range:localRange];
-
- /* Build output string */
- result = [NSString stringWithCharacters:buffer length:bufferSize];
-
- NSDeallocateMemoryPages(buffer, bufferSize);
-
- return result;
-}
-
-@end
-
-
-
-#ifdef main
-# undef main
-#endif
-
-
-/* Main entry point to executable - should *not* be SDL_main! */
-int main (int argc, char **argv)
-{
- /* Copy the arguments into a global variable */
- /* This is passed if we are launched by double-clicking */
- if ( argc >= 2 && strncmp (argv[1], "-psn", 4) == 0 ) {
- gArgv = (char **) SDL_malloc(sizeof (char *) * 2);
- gArgv[0] = argv[0];
- gArgv[1] = NULL;
- gArgc = 1;
- gFinderLaunch = YES;
- } else {
- int i;
- gArgc = argc;
- gArgv = (char **) SDL_malloc(sizeof (char *) * (argc+1));
- for (i = 0; i <= argc; i++)
- gArgv[i] = argv[i];
- gFinderLaunch = NO;
- }
-
-#if SDL_USE_NIB_FILE
- [SDLApplication poseAsClass:[NSApplication class]];
- NSApplicationMain (argc, argv);
-#else
- CustomApplicationMain (argc, argv);
-#endif
- return 0;
-}
-
--- a/hedgewars/SDLh.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/SDLh.pas Sun Jan 27 00:28:57 2013 +0100
@@ -244,7 +244,11 @@
SDL_SRCCOLORKEY = $00001000;
SDL_RLEACCEL = $00004000;
SDL_SRCALPHA = $00010000;
+ {$IFDEF PAS2C}
+ SDL_ANYFORMAT = $10000000;
+ {$ELSE}
SDL_ANYFORMAT = $00100000;
+ {$ENDIF}
SDL_HWPALETTE = $20000000;
SDL_DOUBLEBUF = $40000000;
SDL_FULLSCREEN = $80000000;
@@ -387,7 +391,7 @@
{$ENDIF}
end;
- TSDL_eventaction = (SDL_ADDEVENT, SDL_PEEPEVENT, SDL_GETEVENT);
+ TSDL_eventaction = (SDL_ADDEVENT, SDL_PEEKEVENT, SDL_GETEVENT);
PSDL_Surface = ^TSDL_Surface;
TSDL_Surface = record
@@ -397,6 +401,16 @@
pitch : {$IFDEF SDL13}LongInt{$ELSE}Word{$ENDIF};
pixels: Pointer;
offset: LongInt;
+{$IFDEF PAS2C}
+ hwdata:Pointer;
+ clip_rect:TSDL_Rect;
+ unsed1:LongWord;
+ locked:LongWord;
+ map:Pointer;
+ format_version:Longword;
+ refcount:LongInt;
+{$ELSE}
+
{$IFDEF SDL13}
userdata: Pointer;
locked: LongInt;
@@ -405,6 +419,7 @@
map: Pointer;
refcount: LongInt;
{$ENDIF}
+{$ENDIF}
end;
@@ -747,6 +762,7 @@
TByteArray = array[0..65535] of Byte;
PByteArray = ^TByteArray;
+
TLongWordArray = array[0..16383] of LongWord;
PLongWordArray = ^TLongWordArray;
@@ -1109,22 +1125,31 @@
SDL_EnableKeyRepeat:= 0;
end;
{$ELSE}
-const conversionFormat: TSDL_PixelFormat = (
+const convFormat:TSDL_PixelFormat = (
palette: nil; BitsPerPixel: 32; BytesPerPixel: 4;
Rloss: 0; Gloss: 0; Bloss: 0; Aloss: 0;
Rshift: RShift; Gshift: GShift; Bshift: BShift; Ashift: AShift;
+
+ //TODO: FIXME in pas2c
+ {$IFDEF WEBGL}
+ Rmask: RMask; Gmask: GMask; Bmask: BMask; Amask: AMask;
+ {$ELSE}
RMask: RMask; GMask: GMask; BMask: BMask; AMask: AMask;
- colorkey: 0; alpha: 255);
+ colorkey: 0; alpha: 255
+ {$ENDIF}
+ );
function SDL_AllocFormat(format: LongWord): PSDL_PixelFormat;
begin
format:= format;
- SDL_AllocFormat:= @conversionFormat;
+ SDL_AllocFormat:= @convFormat;
end;
procedure SDL_FreeFormat(pixelformat: PSDL_PixelFormat);
begin
+ {$IFNDEF PAS2C}
pixelformat:= pixelformat; // avoid hint
+ {$ENDIF}
end;
{$ENDIF}
@@ -1134,7 +1159,7 @@
{$IFDEF SDL13}
((surface^.flags and SDL_RLEACCEL) <> 0)
{$ELSE}
- ( surface^.offset <> 0 ) or (( surface^.flags and (SDL_HWSURFACE or SDL_ASYNCBLIT or SDL_RLEACCEL)) <> 0)
+ {$IFNDEF WEBGL}( surface^.offset <> 0 ) or {$ENDIF}(( surface^.flags and (SDL_HWSURFACE or SDL_ASYNCBLIT or SDL_RLEACCEL)) <> 0)
{$ENDIF}
end;
--- a/hedgewars/VGSHandlers.inc Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/VGSHandlers.inc Sun Jan 27 00:28:57 2013 +0100
@@ -60,8 +60,8 @@
else
if Angle < - 360 then
Angle:= Angle + 360;
-
-
+
+
if (round(X) >= cLeftScreenBorder)
and (round(X) <= cRightScreenBorder)
and (round(Y) - 75 <= LAND_HEIGHT)
@@ -197,7 +197,9 @@
////////////////////////////////////////////////////////////////////////////////
procedure doStepLineTrail(Gear: PVisualGear; Steps: Longword);
begin
+{$IFNDEF PAS2C}
Steps := Steps;
+{$ENDIF}
if Gear^.Timer <= Steps then
DeleteVisualGear(Gear)
else
@@ -464,7 +466,9 @@
b: boolean;
t: LongInt;
begin
+{$IFNDEF PAS2C}
Steps:= Steps; // avoid compiler hint
+{$ENDIF}
for t:= 0 to Pred(TeamsCount) do
with thexchar[t] do
@@ -532,7 +536,10 @@
procedure doStepSpeechBubble(Gear: PVisualGear; Steps: Longword);
begin
+
+{$IFNDEF PAS2C}
Steps:= Steps; // avoid compiler hint
+{$ENDIF}
with Gear^.Hedgehog^ do
if SpeechGear <> nil then
@@ -637,10 +644,10 @@
begin
gX:= round(Gear^.X);
gY:= round(Gear^.Y);
-for i:= 0 to 31 do
+for i:= 0 to 31 do
begin
vg:= AddVisualGear(gX, gY, vgtFire);
- if vg <> nil then
+ if vg <> nil then
begin
vg^.State:= gstTmpFlag;
inc(vg^.FrameTicks, vg^.FrameTicks)
@@ -681,10 +688,10 @@
gX:= round(Gear^.X);
gY:= round(Gear^.Y);
AddVisualGear(gX, gY, vgtSmokeRing);
-for i:= 0 to 46 do
+for i:= 0 to 46 do
begin
vg:= AddVisualGear(gX, gY, vgtFire);
- if vg <> nil then
+ if vg <> nil then
begin
vg^.State:= gstTmpFlag;
inc(vg^.FrameTicks, vg^.FrameTicks)
@@ -761,7 +768,7 @@
procedure doStepSmoothWindBar(Gear: PVisualGear; Steps: Longword);
begin
inc(Gear^.Timer, Steps);
-
+
while Gear^.Timer >= 10 do
begin
dec(Gear^.Timer, 10);
@@ -780,8 +787,8 @@
cWindspeedf := cWindspeedf + Gear^.Angle*Steps;
if cWindspeedf > Gear^.dAngle then cWindspeedf:= Gear^.dAngle;
end;
-
-if (WindBarWidth = Gear^.Tag) and (cWindspeedf = Gear^.dAngle) then
+
+if (WindBarWidth = Gear^.Tag) and (cWindspeedf = Gear^.dAngle) then
DeleteVisualGear(Gear)
end;
////////////////////////////////////////////////////////////////////////////////
@@ -795,7 +802,7 @@
else
begin
dec(Gear^.FrameTicks, Steps);
- if (Gear^.FrameTicks < 501) and (Gear^.FrameTicks mod 5 = 0) then
+ if (Gear^.FrameTicks < 501) and (Gear^.FrameTicks mod 5 = 0) then
Gear^.Tint:= (Gear^.Tint and $FFFFFF00) or (((Gear^.Tint and $000000FF) * Gear^.FrameTicks) div 500)
end
end;
--- a/hedgewars/adler32.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/adler32.pas Sun Jan 27 00:28:57 2013 +0100
@@ -2,8 +2,8 @@
{ZLib - Adler32 checksum function}
-
interface
+uses uTypes;
(*************************************************************************
@@ -66,7 +66,7 @@
Also, the structure was removed to simplify C conversion
*)
-function Adler32Update ( var adler :longint; Msg :pointer; Len :longint ) : longint;
+function Adler32Update (var adler : longint; Msg :Pointer; Len :longint ) : longint;
implementation
@@ -124,17 +124,19 @@
end;
*)
-function Adler32Update(var adler: longint; Msg: pointer; Len :longint) : longint;
+function Adler32Update(var adler:longint; Msg: Pointer; Len :longint) : longint;
{-update Adler32 with Msg data}
const
BASE = 65521; {max. prime < 65536 }
NMAX = 3854; {max. n with 255n(n+1)/2 + (n+1)(BASE-1) < 2^31}
var
- s1, s2: longint;
- i, n: integer;
+ s1, s2 : longint;
+ i, n : integer;
+ m : PByte;
begin
- s1 := adler and $FFFF;
- s2 := adler shr 16;
+ m := PByte(Msg);
+ s1 := Longword(adler) and $FFFF;
+ s2 := Longword(adler) shr 16;
while Len>0 do
begin
if Len<NMAX then
@@ -144,8 +146,8 @@
for i := 1 to n do
begin
- inc(s1, pByte(Msg)^);
- inc(Msg);
+ inc(s1, m^);
+ inc(m);
inc(s2, s1);
end;
s1 := s1 mod BASE;
--- a/hedgewars/avwrapper.c Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,509 +0,0 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; version 2 of the License
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
- */
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdint.h>
-#include <string.h>
-#include <stdarg.h>
-#include "libavformat/avformat.h"
-#include "libavutil/mathematics.h"
-
-#ifndef AVIO_FLAG_WRITE
-#define AVIO_FLAG_WRITE AVIO_WRONLY
-#endif
-
-static AVFormatContext* g_pContainer;
-static AVOutputFormat* g_pFormat;
-static AVStream* g_pAStream;
-static AVStream* g_pVStream;
-static AVFrame* g_pAFrame;
-static AVFrame* g_pVFrame;
-static AVCodec* g_pACodec;
-static AVCodec* g_pVCodec;
-static AVCodecContext* g_pAudio;
-static AVCodecContext* g_pVideo;
-
-static int g_Width, g_Height;
-static uint32_t g_Frequency, g_Channels;
-static int g_VQuality;
-static AVRational g_Framerate;
-
-static FILE* g_pSoundFile;
-static int16_t* g_pSamples;
-static int g_NumSamples;
-
-
-#if LIBAVCODEC_VERSION_MAJOR < 54
-#define OUTBUFFER_SIZE 200000
-static uint8_t g_OutBuffer[OUTBUFFER_SIZE];
-#endif
-
-// pointer to function from hwengine (uUtils.pas)
-static void (*AddFileLogRaw)(const char* pString);
-
-static void FatalError(const char* pFmt, ...)
-{
- char Buffer[1024];
- va_list VaArgs;
-
- va_start(VaArgs, pFmt);
- vsnprintf(Buffer, 1024, pFmt, VaArgs);
- va_end(VaArgs);
-
- AddFileLogRaw("Error in av-wrapper: ");
- AddFileLogRaw(Buffer);
- AddFileLogRaw("\n");
- exit(1);
-}
-
-// Function to be called from libav for logging.
-// Note: libav can call LogCallback from different threads
-// (there is mutex in AddFileLogRaw).
-static void LogCallback(void* p, int Level, const char* pFmt, va_list VaArgs)
-{
- char Buffer[1024];
-
- vsnprintf(Buffer, 1024, pFmt, VaArgs);
- AddFileLogRaw(Buffer);
-}
-
-static void Log(const char* pFmt, ...)
-{
- char Buffer[1024];
- va_list VaArgs;
-
- va_start(VaArgs, pFmt);
- vsnprintf(Buffer, 1024, pFmt, VaArgs);
- va_end(VaArgs);
-
- AddFileLogRaw(Buffer);
-}
-
-static void AddAudioStream()
-{
-#if LIBAVFORMAT_VERSION_MAJOR >= 53
- g_pAStream = avformat_new_stream(g_pContainer, g_pACodec);
-#else
- g_pAStream = av_new_stream(g_pContainer, 1);
-#endif
- if(!g_pAStream)
- {
- Log("Could not allocate audio stream\n");
- return;
- }
- g_pAStream->id = 1;
-
- g_pAudio = g_pAStream->codec;
-
- avcodec_get_context_defaults3(g_pAudio, g_pACodec);
- g_pAudio->codec_id = g_pACodec->id;
-
- // put parameters
- g_pAudio->sample_fmt = AV_SAMPLE_FMT_S16;
- g_pAudio->sample_rate = g_Frequency;
- g_pAudio->channels = g_Channels;
-
- // set quality
- g_pAudio->bit_rate = 160000;
-
- // for codecs that support variable bitrate use it, it should be better
- g_pAudio->flags |= CODEC_FLAG_QSCALE;
- g_pAudio->global_quality = 1*FF_QP2LAMBDA;
-
- // some formats want stream headers to be separate
- if (g_pFormat->flags & AVFMT_GLOBALHEADER)
- g_pAudio->flags |= CODEC_FLAG_GLOBAL_HEADER;
-
- // open it
-#if LIBAVCODEC_VERSION_MAJOR >= 53
- if (avcodec_open2(g_pAudio, g_pACodec, NULL) < 0)
-#else
- if (avcodec_open(g_pAudio, g_pACodec) < 0)
-#endif
- {
- Log("Could not open audio codec %s\n", g_pACodec->long_name);
- return;
- }
-
-#if LIBAVCODEC_VERSION_MAJOR >= 54
- if (g_pACodec->capabilities & CODEC_CAP_VARIABLE_FRAME_SIZE)
-#else
- if (g_pAudio->frame_size == 0)
-#endif
- g_NumSamples = 4096;
- else
- g_NumSamples = g_pAudio->frame_size;
- g_pSamples = (int16_t*)av_malloc(g_NumSamples*g_Channels*sizeof(int16_t));
- g_pAFrame = avcodec_alloc_frame();
- if (!g_pAFrame)
- {
- Log("Could not allocate frame\n");
- return;
- }
-}
-
-// returns non-zero if there is more sound
-static int WriteAudioFrame()
-{
- if (!g_pAStream)
- return 0;
-
- AVPacket Packet = { 0 };
- av_init_packet(&Packet);
-
- int NumSamples = fread(g_pSamples, 2*g_Channels, g_NumSamples, g_pSoundFile);
-
-#if LIBAVCODEC_VERSION_MAJOR >= 53
- AVFrame* pFrame = NULL;
- if (NumSamples > 0)
- {
- g_pAFrame->nb_samples = NumSamples;
- avcodec_fill_audio_frame(g_pAFrame, g_Channels, AV_SAMPLE_FMT_S16,
- (uint8_t*)g_pSamples, NumSamples*2*g_Channels, 1);
- pFrame = g_pAFrame;
- }
- // when NumSamples == 0 we still need to call encode_audio2 to flush
- int got_packet;
- if (avcodec_encode_audio2(g_pAudio, &Packet, pFrame, &got_packet) != 0)
- FatalError("avcodec_encode_audio2 failed");
- if (!got_packet)
- return 0;
-#else
- if (NumSamples == 0)
- return 0;
- int BufferSize = OUTBUFFER_SIZE;
- if (g_pAudio->frame_size == 0)
- BufferSize = NumSamples*g_Channels*2;
- Packet.size = avcodec_encode_audio(g_pAudio, g_OutBuffer, BufferSize, g_pSamples);
- if (Packet.size == 0)
- return 1;
- if (g_pAudio->coded_frame && g_pAudio->coded_frame->pts != AV_NOPTS_VALUE)
- Packet.pts = av_rescale_q(g_pAudio->coded_frame->pts, g_pAudio->time_base, g_pAStream->time_base);
- Packet.flags |= AV_PKT_FLAG_KEY;
- Packet.data = g_OutBuffer;
-#endif
-
- // Write the compressed frame to the media file.
- Packet.stream_index = g_pAStream->index;
- if (av_interleaved_write_frame(g_pContainer, &Packet) != 0)
- FatalError("Error while writing audio frame");
- return 1;
-}
-
-// add a video output stream
-static void AddVideoStream()
-{
-#if LIBAVFORMAT_VERSION_MAJOR >= 53
- g_pVStream = avformat_new_stream(g_pContainer, g_pVCodec);
-#else
- g_pVStream = av_new_stream(g_pContainer, 0);
-#endif
- if (!g_pVStream)
- FatalError("Could not allocate video stream");
-
- g_pVideo = g_pVStream->codec;
-
- avcodec_get_context_defaults3(g_pVideo, g_pVCodec);
- g_pVideo->codec_id = g_pVCodec->id;
-
- // put parameters
- // resolution must be a multiple of two
- g_pVideo->width = g_Width & ~1; // make even (dimensions should be even)
- g_pVideo->height = g_Height & ~1; // make even
- /* time base: this is the fundamental unit of time (in seconds) in terms
- of which frame timestamps are represented. for fixed-fps content,
- timebase should be 1/framerate and timestamp increments should be
- identically 1. */
- g_pVideo->time_base.den = g_Framerate.num;
- g_pVideo->time_base.num = g_Framerate.den;
- //g_pVideo->gop_size = 12; /* emit one intra frame every twelve frames at most */
- g_pVideo->pix_fmt = PIX_FMT_YUV420P;
-
- // set quality
- if (g_VQuality > 100)
- g_pVideo->bit_rate = g_VQuality;
- else
- {
- g_pVideo->flags |= CODEC_FLAG_QSCALE;
- g_pVideo->global_quality = g_VQuality*FF_QP2LAMBDA;
- }
-
- // some formats want stream headers to be separate
- if (g_pFormat->flags & AVFMT_GLOBALHEADER)
- g_pVideo->flags |= CODEC_FLAG_GLOBAL_HEADER;
-
-#if LIBAVCODEC_VERSION_MAJOR < 53
- // for some versions of ffmpeg x264 options must be set explicitly
- if (strcmp(g_pVCodec->name, "libx264") == 0)
- {
- g_pVideo->coder_type = FF_CODER_TYPE_AC;
- g_pVideo->flags |= CODEC_FLAG_LOOP_FILTER;
- g_pVideo->crf = 23;
- g_pVideo->thread_count = 3;
- g_pVideo->me_cmp = FF_CMP_CHROMA;
- g_pVideo->partitions = X264_PART_I8X8 | X264_PART_I4X4 | X264_PART_P8X8 | X264_PART_B8X8;
- g_pVideo->me_method = ME_HEX;
- g_pVideo->me_subpel_quality = 7;
- g_pVideo->me_range = 16;
- g_pVideo->gop_size = 250;
- g_pVideo->keyint_min = 25;
- g_pVideo->scenechange_threshold = 40;
- g_pVideo->i_quant_factor = 0.71;
- g_pVideo->b_frame_strategy = 1;
- g_pVideo->qcompress = 0.6;
- g_pVideo->qmin = 10;
- g_pVideo->qmax = 51;
- g_pVideo->max_qdiff = 4;
- g_pVideo->max_b_frames = 3;
- g_pVideo->refs = 3;
- g_pVideo->directpred = 1;
- g_pVideo->trellis = 1;
- g_pVideo->flags2 = CODEC_FLAG2_BPYRAMID | CODEC_FLAG2_MIXED_REFS | CODEC_FLAG2_WPRED | CODEC_FLAG2_8X8DCT | CODEC_FLAG2_FASTPSKIP;
- g_pVideo->weighted_p_pred = 2;
- }
-#endif
-
- // open the codec
-#if LIBAVCODEC_VERSION_MAJOR >= 53
- AVDictionary* pDict = NULL;
- if (strcmp(g_pVCodec->name, "libx264") == 0)
- av_dict_set(&pDict, "preset", "medium", 0);
-
- if (avcodec_open2(g_pVideo, g_pVCodec, &pDict) < 0)
-#else
- if (avcodec_open(g_pVideo, g_pVCodec) < 0)
-#endif
- FatalError("Could not open video codec %s", g_pVCodec->long_name);
-
- g_pVFrame = avcodec_alloc_frame();
- if (!g_pVFrame)
- FatalError("Could not allocate frame");
-
- g_pVFrame->linesize[0] = g_Width;
- g_pVFrame->linesize[1] = g_Width/2;
- g_pVFrame->linesize[2] = g_Width/2;
- g_pVFrame->linesize[3] = 0;
-}
-
-static int WriteFrame(AVFrame* pFrame)
-{
- double AudioTime, VideoTime;
-
- // write interleaved audio frame
- if (g_pAStream)
- {
- VideoTime = (double)g_pVStream->pts.val*g_pVStream->time_base.num/g_pVStream->time_base.den;
- do
- AudioTime = (double)g_pAStream->pts.val*g_pAStream->time_base.num/g_pAStream->time_base.den;
- while (AudioTime < VideoTime && WriteAudioFrame());
- }
-
- if (!g_pVStream)
- return 0;
-
- AVPacket Packet;
- av_init_packet(&Packet);
- Packet.data = NULL;
- Packet.size = 0;
-
- g_pVFrame->pts++;
- if (g_pFormat->flags & AVFMT_RAWPICTURE)
- {
- /* raw video case. The API will change slightly in the near
- future for that. */
- Packet.flags |= AV_PKT_FLAG_KEY;
- Packet.stream_index = g_pVStream->index;
- Packet.data = (uint8_t*)pFrame;
- Packet.size = sizeof(AVPicture);
-
- if (av_interleaved_write_frame(g_pContainer, &Packet) != 0)
- FatalError("Error while writing video frame");
- return 0;
- }
- else
- {
-#if LIBAVCODEC_VERSION_MAJOR >= 54
- int got_packet;
- if (avcodec_encode_video2(g_pVideo, &Packet, pFrame, &got_packet) < 0)
- FatalError("avcodec_encode_video2 failed");
- if (!got_packet)
- return 0;
-
- if (Packet.pts != AV_NOPTS_VALUE)
- Packet.pts = av_rescale_q(Packet.pts, g_pVideo->time_base, g_pVStream->time_base);
- if (Packet.dts != AV_NOPTS_VALUE)
- Packet.dts = av_rescale_q(Packet.dts, g_pVideo->time_base, g_pVStream->time_base);
-#else
- Packet.size = avcodec_encode_video(g_pVideo, g_OutBuffer, OUTBUFFER_SIZE, pFrame);
- if (Packet.size < 0)
- FatalError("avcodec_encode_video failed");
- if (Packet.size == 0)
- return 0;
-
- if( g_pVideo->coded_frame->pts != AV_NOPTS_VALUE)
- Packet.pts = av_rescale_q(g_pVideo->coded_frame->pts, g_pVideo->time_base, g_pVStream->time_base);
- if( g_pVideo->coded_frame->key_frame )
- Packet.flags |= AV_PKT_FLAG_KEY;
- Packet.data = g_OutBuffer;
-#endif
- // write the compressed frame in the media file
- Packet.stream_index = g_pVStream->index;
- if (av_interleaved_write_frame(g_pContainer, &Packet) != 0)
- FatalError("Error while writing video frame");
-
- return 1;
- }
-}
-
-void AVWrapper_WriteFrame(uint8_t* pY, uint8_t* pCb, uint8_t* pCr)
-{
- g_pVFrame->data[0] = pY;
- g_pVFrame->data[1] = pCb;
- g_pVFrame->data[2] = pCr;
- WriteFrame(g_pVFrame);
-}
-
-void AVWrapper_Init(
- void (*pAddFileLogRaw)(const char*),
- const char* pFilename,
- const char* pDesc,
- const char* pSoundFile,
- const char* pFormatName,
- const char* pVCodecName,
- const char* pACodecName,
- int Width, int Height,
- int FramerateNum, int FramerateDen,
- int VQuality)
-{
- AddFileLogRaw = pAddFileLogRaw;
- av_log_set_callback( &LogCallback );
-
- g_Width = Width;
- g_Height = Height;
- g_Framerate.num = FramerateNum;
- g_Framerate.den = FramerateDen;
- g_VQuality = VQuality;
-
- // initialize libav and register all codecs and formats
- av_register_all();
-
- // find format
- g_pFormat = av_guess_format(pFormatName, NULL, NULL);
- if (!g_pFormat)
- FatalError("Format \"%s\" was not found", pFormatName);
-
- // allocate the output media context
- g_pContainer = avformat_alloc_context();
- if (!g_pContainer)
- FatalError("Could not allocate output context");
-
- g_pContainer->oformat = g_pFormat;
-
- // store description of file
- av_dict_set(&g_pContainer->metadata, "comment", pDesc, 0);
-
- // append extesnion to filename
- char ext[16];
- strncpy(ext, g_pFormat->extensions, 16);
- ext[15] = 0;
- ext[strcspn(ext,",")] = 0;
- snprintf(g_pContainer->filename, sizeof(g_pContainer->filename), "%s.%s", pFilename, ext);
-
- // find codecs
- g_pVCodec = avcodec_find_encoder_by_name(pVCodecName);
- g_pACodec = avcodec_find_encoder_by_name(pACodecName);
-
- // add audio and video stream to container
- g_pVStream = NULL;
- g_pAStream = NULL;
-
- if (g_pVCodec)
- AddVideoStream();
- else
- Log("Video codec \"%s\" was not found; video will be ignored.\n", pVCodecName);
-
- if (g_pACodec)
- {
- g_pSoundFile = fopen(pSoundFile, "rb");
- if (g_pSoundFile)
- {
- fread(&g_Frequency, 4, 1, g_pSoundFile);
- fread(&g_Channels, 4, 1, g_pSoundFile);
- AddAudioStream();
- }
- else
- Log("Could not open %s\n", pSoundFile);
- }
- else
- Log("Audio codec \"%s\" was not found; audio will be ignored.\n", pACodecName);
-
- if (!g_pAStream && !g_pVStream)
- FatalError("No video, no audio, aborting...");
-
- // write format info to log
- av_dump_format(g_pContainer, 0, g_pContainer->filename, 1);
-
- // open the output file, if needed
- if (!(g_pFormat->flags & AVFMT_NOFILE))
- {
- if (avio_open(&g_pContainer->pb, g_pContainer->filename, AVIO_FLAG_WRITE) < 0)
- FatalError("Could not open output file (%s)", g_pContainer->filename);
- }
-
- // write the stream header, if any
- avformat_write_header(g_pContainer, NULL);
-
- g_pVFrame->pts = -1;
-}
-
-void AVWrapper_Close()
-{
- // output buffered frames
- if (g_pVCodec->capabilities & CODEC_CAP_DELAY)
- while( WriteFrame(NULL) );
- // output any remaining audio
- while( WriteAudioFrame() );
-
- // write the trailer, if any.
- av_write_trailer(g_pContainer);
-
- // close the output file
- if (!(g_pFormat->flags & AVFMT_NOFILE))
- avio_close(g_pContainer->pb);
-
- // free everything
- if (g_pVStream)
- {
- avcodec_close(g_pVideo);
- av_free(g_pVideo);
- av_free(g_pVStream);
- av_free(g_pVFrame);
- }
- if (g_pAStream)
- {
- avcodec_close(g_pAudio);
- av_free(g_pAudio);
- av_free(g_pAStream);
- av_free(g_pAFrame);
- av_free(g_pSamples);
- fclose(g_pSoundFile);
- }
-
- av_free(g_pContainer);
-}
Binary file hedgewars/hwengine.ico has changed
--- a/hedgewars/hwengine.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/hwengine.pas Sun Jan 27 00:28:57 2013 +0100
@@ -19,7 +19,7 @@
{$INCLUDE "options.inc"}
{$IFDEF WIN32}
-{$R hwengine.rc}
+{$R res/hwengine.rc}
{$ENDIF}
{$IFDEF HWLIBRARY}
@@ -36,6 +36,7 @@
{$IFDEF USE_VIDEO_RECORDING}, uVideoRec {$ENDIF}
{$IFDEF USE_TOUCH_INTERFACE}, uTouch {$ENDIF}
{$IFDEF ANDROID}, GLUnit{$ENDIF}
+ {$IFDEF WEBGL}, uWeb{$ENDIF}
;
var isInternal: Boolean;
@@ -56,6 +57,20 @@
{$INCLUDE "ArgParsers.inc"}
+{$IFDEF WEBGL}
+procedure playFile(path: PChar); forward;
+function isEngineRunning():Integer; forward;
+procedure shutdown();forward;
+function getRealTicks():Integer; forward;
+procedure mainhook(); forward;
+var
+ args: array[0..3] of PChar;
+ PrevTime, CurrTime: LongInt;
+ isTerminated: boolean;
+ prevFocusState: boolean;
+ isRunning : boolean;
+{$ENDIF}
+
///////////////////////////////////////////////////////////////////////////////
function DoTimer(Lag: LongInt): boolean;
var s: shortstring;
@@ -94,7 +109,13 @@
end;
gsConfirm, gsGame:
begin
- if not cOnlyStats then DrawWorld(Lag);
+ if not cOnlyStats then
+{$IFDEF WEBGL}
+ drawworld_hook();
+{$ELSE}
+ // never place between ProcessKbd and DoGameTick - bugs due to /put cmd and isCursorVisible
+ DrawWorld(Lag);
+{$ENDIF}
DoGameTick(Lag);
if not cOnlyStats then ProcessVisualGears(Lag);
end;
@@ -147,20 +168,28 @@
///////////////////////////////////////////////////////////////////////////////
procedure MainLoop;
var event: TSDL_Event;
- PrevTime, CurrTime: Longword;
+{$IFNDEF WEBGL}
+ PrevTime, CurrTime: LongInt;
isTerminated: boolean;
{$IFDEF SDL13}
previousGameState: TGameState;
{$ELSE}
prevFocusState: boolean;
{$ENDIF}
+
+{$ENDIF}
+
begin
+
+{$IFNDEF WEBGL}
isTerminated:= false;
PrevTime:= SDL_GetTicks;
while isTerminated = false do
begin
+{$ENDIF}
+
SDL_PumpEvents();
-
+
while SDL_PeepEvents(@event, 1, SDL_GETEVENT, {$IFDEF SDL13}SDL_FIRSTEVENT, SDL_LASTEVENT{$ELSE}SDL_ALLEVENTS{$ENDIF}) > 0 do
begin
case event.type_ of
@@ -174,7 +203,7 @@
SDL_KEYUP:
if GameState <> gsChat then
ProcessKey(event.key);
-
+
SDL_WINDOWEVENT:
if event.window.event = SDL_WINDOWEVENT_SHOWN then
begin
@@ -200,13 +229,13 @@
cNewScreenHeight:= max(2 * (event.window.data2 div 2), cMinScreenHeight);
cScreenResizeDelay:= RealTicks + 500{$IFDEF IPHONEOS}div 2{$ENDIF};
end;
-
+
SDL_FINGERMOTION:
onTouchMotion(event.tfinger.x, event.tfinger.y,event.tfinger.dx, event.tfinger.dy, event.tfinger.fingerId);
-
+
SDL_FINGERDOWN:
onTouchDown(event.tfinger.x, event.tfinger.y, event.tfinger.fingerId);
-
+
SDL_FINGERUP:
onTouchUp(event.tfinger.x, event.tfinger.y, event.tfinger.fingerId);
{$ELSE}
@@ -218,7 +247,7 @@
SDL_KEYUP:
if GameState <> gsChat then
ProcessKey(event.key);
-
+
SDL_MOUSEBUTTONDOWN:
if GameState = gsConfirm then
begin
@@ -227,10 +256,10 @@
end
else
ProcessMouse(event.button, true);
-
+
SDL_MOUSEBUTTONUP:
- ProcessMouse(event.button, false);
-
+ ProcessMouse(event.button, false);
+
SDL_ACTIVEEVENT:
if (event.active.state and SDL_APPINPUTFOCUS) <> 0 then
begin
@@ -239,7 +268,7 @@
if prevFocusState xor cHasFocus then
onFocusStateChanged()
end;
-
+
SDL_VIDEORESIZE:
begin
// using lower values than cMinScreenWidth or cMinScreenHeight causes widget overlap and off-screen widget parts
@@ -287,12 +316,24 @@
CurrTime:= SDL_GetTicks();
if PrevTime + longword(cTimerInterval) <= CurrTime then
begin
- isTerminated := isTerminated or DoTimer(CurrTime - PrevTime);
- PrevTime:= CurrTime
+ isTerminated:= isTerminated or DoTimer(CurrTime - PrevTime);
+ PrevTime:= CurrTime;
+ {$IFDEF WEBGL}
+ if not isTerminated then
+ mainloop_hook();
+ else
+ begin
+ freeEverything(true);
+ isRunning := false;
+ end
+ {$ENDIF}
end
- else SDL_Delay(1);
+ else {$IFNDEF WEBGL}SDL_Delay(1){$ELSE}mainloop_hook(){$ENDIF};
IPCCheckSock();
+
+{$IFNDEF WEBGL}
end;
+{$ENDIF}
end;
{$IFDEF USE_VIDEO_RECORDING}
@@ -333,6 +374,10 @@
//var p: TPathType;
var s: shortstring;
i: LongInt;
+{$IFDEF WEBGL}
+ l:TResourceList;
+{$ENDIF}
+
begin
{$IFDEF HWLIBRARY}
preInitEverything();
@@ -340,9 +385,7 @@
{$ENDIF}
initEverything(true);
WriteLnToConsole('Hedgewars ' + cVersionString + ' engine (network protocol: ' + inttostr(cNetProtoVersion) + ')');
- AddFileLog('Prefix: "' + PathPrefix +'"');
- AddFileLog('UserPrefix: "' + UserPathPrefix +'"');
-
+
for i:= 0 to ParamCount do
AddFileLog(inttostr(i) + ': ' + ParamStr(i));
@@ -362,7 +405,7 @@
InitOffscreenOpenGL()
else
{$ENDIF}
- begin
+ begin
// show main window
if cFullScreen then
ParseCommand('fullscr 1', true)
@@ -414,13 +457,27 @@
{$IFDEF USE_VIDEO_RECORDING}
if GameType = gmtRecord then
- RecorderMainLoop()
- else
+ begin
+ RecorderMainLoop();
+ freeEverything(true);
+ exit;
+ end;
{$ENDIF}
- MainLoop();
+{$IFDEF WEBGL}
+ l := generateResourceList();
+ clear_filelist_hook();
+ for i:= 0 to l.count - 1 do
+ add_file_hook(PChar(l.files[i] + '.png'));
+ isTerminated := false;
+ isRunning := true;
+ PrevTime := SDL_GetTicks();
+ idb_loader_hook();
+{$ELSE}
+ MainLoop;
// clean up all the memory allocated
freeEverything(true);
+{$ENDIF}
end;
///////////////////////////////////////////////////////////////////////////////
@@ -540,7 +597,18 @@
///////////////////////////////////////////////////////////////////////////////
/////////////////////////////////// m a i n ///////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
+{$IFDEF WEBGL}
+procedure hwmain(argc:Integer; argv:PPChar);
+{$ENDIF}
begin
+{$IFDEF PAS2C}
+ // workaround for pascal's ParamStr and ParamCount
+ init(argc, argv);
+{$IFDEF WEBGL}
+ // patch emscripten's SDL implementation
+ SDL_InitPatch();
+{$ENDIF}
+{$ENDIF}
preInitEverything();
GetParams();
@@ -550,6 +618,62 @@
Game();
// return 1 when engine is not called correctly
- halt(LongInt(GameType = gmtSyntax));
+ {$IFDEF PAS2C}
+ {$IFNDEF WEBGL}
+ exit(LongInt(GameType = gmtSyntax));
+ {$ENDIF}
+ {$ELSE}
+ halt(LongInt(GameType = gmtSyntax));
+ {$ENDIF}
+
+
+{$IFDEF WEBGL}
+end;
+
+// hook
+procedure playFile(path: PChar);
+begin
+ args[0] := PChar('');
+ args[1] := PChar('');
+ args[2] := PChar('Data');
+ args[3] := path;
+ hwmain(4, args);
+end;
+
+// hook
+function isEngineRunning:Integer;
+begin
+ isEngineRunning := isRunning;
+end;
+
+// hook
+procedure shutdown;
+begin
+ GameState := gsExit;
+end;
+
+// hook
+function getRealTicks():Integer;
+begin
+ getRealTicks := RealTicks;
+end;
+
+// main
+begin
+ isRunning := false;
+
+ // avoid hooks to be eliminated by optimizer
+ if argc = 1234 then
+ begin
+ mainhook();
+ isRunning := isEngineRunning();
+ playFile(argv);
+ argc := getRealTicks();
+ DrawWorld(argc);
+ MainLoop;
+ shutdown;
+ end
+{$ENDIF}
+
{$ENDIF}
end.
--- a/hedgewars/hwengine.rc Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1 +0,0 @@
-MAINICON ICON "hwengine.ico"
\ No newline at end of file
--- a/hedgewars/options.inc Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/options.inc Sun Jan 27 00:28:57 2013 +0100
@@ -29,6 +29,13 @@
{$DEFINE USE_LUA_SCRIPT}
+{$IF DEFINED(WEBGL) AND NOT DEFINED(PAS2C)}
+{$UNDEF WEBGL}
+{$ENDIF}
+
+{$IFDEF WEBGL}
+{$DEFINE GL2}
+{$ENDIF}
{$IFDEF ANDROID}
{$DEFINE MOBILE}
--- a/hedgewars/pas2c.h Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,144 +0,0 @@
-#pragma once
-
-#include <stddef.h>
-#include <stdint.h>
-#include <stdbool.h>
-#include <wchar.h>
-
-typedef union string255_
- {
- struct {
- char s[256];
- };
- struct {
- char len;
- char str[255];
- };
- } string255;
-typedef struct string192_
- {
- char s[193];
- } string192;
-typedef struct string31_
- {
- char s[32];
- } string31;
-typedef struct string15_
- {
- char s[16];
- } string15;
-
-typedef string255 shortstring;
-typedef string255 ansistring;
-
-typedef uint8_t Byte;
-typedef int8_t ShortInt;
-typedef uint16_t Word;
-typedef int16_t SmallInt;
-typedef uint32_t LongWord;
-typedef int32_t LongInt;
-typedef uint64_t QWord;
-typedef int64_t Int64;
-typedef LongWord Cardinal;
-
-typedef LongInt Integer;
-typedef float extended;
-typedef float real;
-typedef float single;
-
-typedef bool boolean;
-typedef int LongBool;
-
-typedef void * pointer;
-typedef Byte * PByte;
-typedef char * PChar;
-typedef LongInt * PLongInt;
-typedef LongWord * PLongWord;
-typedef Integer * PInteger;
-typedef int PtrInt;
-typedef wchar_t widechar;
-
-#define new(a) __new((void **)&a, sizeof(*(a)))
-void __new(void ** p, int size);
-#define dispose(a) __dispose(a, sizeof(*(a)))
-void __dispose(pointer p, int size);
-
-void * GetMem(int size);
-void FreeMem(void * p, int size);
-
-#define FillChar(a, b, c) __FillChar(&(a), b, c)
-
-void __FillChar(pointer p, int size, char fill);
-string255 _strconcat(string255 a, string255 b);
-string255 _strappend(string255 s, char c);
-string255 _strprepend(char c, string255 s);
-string255 _chrconcat(char a, char b);
-bool _strcompare(string255 a, string255 b);
-bool _strcomparec(string255 a, char b);
-bool _strncompare(string255 a, string255 b);
-char * _pchar(string255 s);
-string255 pchar2str(char * s);
-
-int Length(string255 a);
-string255 copy(string255 a, int s, int l);
-string255 delete(string255 a, int s, int l);
-string255 trim(string255 a);
-
-#define STRINIT(a) {.len = sizeof(a) - 1, .str = a}
-
-
-int length_ar(void * a);
-
-typedef int file;
-typedef int TextFile;
-extern int FileMode;
-extern int IOResult;
-extern int stdout;
-extern int stderr;
-
-#define assign(a, b) assign_(&(a), b)
-void assign_(int * f, string255 fileName);
-void reset_1(int f, int size);
-void reset_2(int f, int size);
-#define BlockRead(a, b, c, d) BlockRead_(a, &(b), c, &(d))
-void BlockRead_(int f, void * p, int size, int * sizeRead);
-#define BlockWrite(a, b, c) BlockWrite_(a, &(b), c)
-void BlockWrite_(int f, void * p, int size);
-void close(int f);
-
-void write(int f, string255 s);
-void writeLn(int f, string255 s);
-
-bool DirectoryExists(string255 dir);
-bool FileExists(string255 filename);
-
-bool odd(int i);
-
-
-typedef int TThreadId;
-void ThreadSwitch();
-#define InterlockedIncrement(a) __InterlockedIncrement(&(a))
-#define InterlockedDecrement(a) __InterlockedDecrement(&(a))
-void __InterlockedIncrement(int * a);
-void __InterlockedDecrement(int * a);
-
-bool Assigned(void * a);
-
-void randomize();
-int random(int max);
-int abs(int i);
-double sqr(double n);
-double sqrt(double n);
-int trunc(double n);
-int round(double n);
-
-string255 ParamStr(int n);
-int ParamCount();
-
-#define val(a, b, c) _val(a, (LongInt*)&(b), (LongInt*)&(c))
-void _val(string255 str, LongInt * a, LongInt * c);
-
-extern double pi;
-
-string255 EnumToStr(int a);
-string255 ExtractFileName(string255 f);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/pas2cRedo.pas Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,112 @@
+redo;
+{This file contains functions that are re-implemented}
+{pas2c will add prefix fpcrtl_ to all these functions}
+type
+ uinteger = uinteger;
+ Integer = integer;
+ LongInt = integer;
+ LongWord = uinteger;
+ Cardinal = uinteger;
+ PtrInt = integer;
+ Word = uinteger;
+ Byte = integer;
+ SmallInt = integer;
+ ShortInt = integer;
+ Int64 = integer;
+ QWord = uinteger;
+ GLint = integer;
+ GLuint = integer;
+ int = integer;
+ size_t = integer;
+
+ pointer = pointer;
+
+ float = float;
+ single = float;
+ double = float;
+ real = float;
+ extended = float;
+ GLfloat = float;
+
+ boolean = boolean;
+ LongBool = boolean;
+
+ string = string;
+ shortstring = string;
+ ansistring = string;
+ widechar = string;
+
+ char = char;
+ PChar = ^char;
+ PPChar = ^Pchar;
+
+ PByte = ^Byte;
+ PLongInt = ^LongInt;
+ PLongWord = ^LongWord;
+ PInteger = ^Integer;
+
+ Handle = integer;
+
+var
+ write, writeLn, read, readLn, flush: procedure;
+
+ halt:procedure;
+
+ GetEnumName:function:shortstring;
+ TypeInfo:function:Integer;
+
+ lo:function:Integer;
+
+ init:procedure;
+
+ StrLen:function : integer;
+ odd, even : function : boolean;
+
+ Length : function : integer;
+
+ Now : function : integer;
+
+ new, dispose, FillChar, Move : procedure;
+
+ trunc, round : function : integer;
+ abs, sqr : function : integer;
+
+ StrPas, FormatDateTime, copy, delete, str, pos, PosS, trim, LowerCase : function : shortstring;
+ StrToInt : function : integer;
+ SetLength, val : procedure;
+ _pchar : function : PChar;
+ pchar2str : function : string;
+ memcpy : procedure;
+
+ min, max:function:integer;
+ assign, rewrite, rewrite_2, reset, reset_2, flush, BlockWrite, BlockRead, close : procedure;
+ FileExists, DirectoryExists, eof : function : boolean;
+ ExtractFileName : function : string;
+
+ ParamCount : function : integer;
+ ParamStr : function : string;
+
+ arctan2, power: function : float;
+
+ //TypeInfo, GetEnumName : function : shortstring;
+
+ UTF8ToUnicode, WrapText: function : shortstring;
+
+ GetMem : function : pointer;
+ FreeMem : procedure;
+
+ BeginThread, ThreadSwitch : procedure;
+ InterlockedIncrement, InterlockedDecrement : procedure;
+
+ random : function : integer;
+ randomize : procedure;
+
+ Assigned : function : boolean;
+
+ //EnumToStr : function : string;
+
+ initParams : procedure;
+
+ Load_GL_VERSION_2_0 : procedure;
+
+
--- a/hedgewars/pas2cSystem.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/pas2cSystem.pas Sun Jan 27 00:28:57 2013 +0100
@@ -1,18 +1,22 @@
system;
type
+ uinteger = uinteger;
Integer = integer;
LongInt = integer;
- LongWord = integer;
- Cardinal = integer;
+ LongWord = uinteger;
+ Cardinal = uinteger;
PtrInt = integer;
- Word = integer;
+ Word = uinteger;
Byte = integer;
SmallInt = integer;
ShortInt = integer;
- QWord = integer;
+ Int64 = integer;
+ QWord = uinteger;
GLint = integer;
GLuint = integer;
+ GLenum = integer;
+
int = integer;
size_t = integer;
@@ -51,51 +55,22 @@
var
false, true: boolean;
- write, writeLn, read, readLn: procedure;
-
- StrLen, ord, Succ, Pred : function : integer;
+ ord, Succ, Pred : function : integer;
inc, dec, Low, High, Lo, Hi : function : integer;
- odd, even : function : boolean;
-
- Now : function : integer;
-
- new, dispose, FillChar, Move : procedure;
- trunc, round : function : integer;
- abs, sqr : function : integer;
-
- StrPas, FormatDateTime, copy, delete, str, pos, trim, LowerCase : function : shortstring;
- Length, StrToInt : function : integer;
- SetLength, val : procedure;
- _pchar : function : PChar;
- pchar2str : function : string;
- memcpy : procedure;
-
- assign, rewrite, reset, flush, BlockWrite, BlockRead, close : procedure;
IOResult : integer;
exit, break, halt, continue : procedure;
- TextFile, file : Handle;
+
+ TextFile, File : Handle;
FileMode : integer;
- FileExists, DirectoryExists, eof : function : boolean;
- ExtractFileName : function : string;
exitcode : integer;
stdout, stderr : Handle;
-
- ParamCount : function : integer;
- ParamStr : function : string;
- sqrt, arctan2, cos, sin, power : function : float;
+ sqrt, cos, sin: function : float;
pi : float;
- TypeInfo, GetEnumName : function : shortstring;
-
- UTF8ToUnicode, WrapText: function : shortstring;
-
sizeof : function : integer;
- GetMem : function : pointer;
- FreeMem : procedure;
-
glGetString : function : pchar;
glBegin, glBindTexture, glBlendFunc, glClear, glClearColor,
@@ -110,7 +85,15 @@
glDeleteFramebuffersEXT, glGenFramebuffersEXT,
glGenRenderbuffersEXT, glBindFramebufferEXT,
glBindRenderbufferEXT, glRenderbufferStorageEXT,
- glFramebufferRenderbufferEXT, glFramebufferTexture2DEXT : procedure;
+ glFramebufferRenderbufferEXT, glFramebufferTexture2DEXT,
+ glUniformMatrix4fv, glVertexAttribPointer, glCreateShader,
+ glShaderSource, glCompileShader, glGetShaderiv, glGetShaderInfoLog,
+ glCreateProgram, glAttachShader, glBindAttribLocation, glLinkProgram,
+ glDeleteShader, glGetProgramiv, glGetProgramInfoLog, glUseProgram,
+ glUniform1i, glGetUniformLocation, glEnableVertexAttribArray,
+ glGetError, glDeleteProgram, glDeleteBuffers,
+ glGenBuffers, glBufferData, glBindBuffer, glewInit,
+ glUniform4f, glDisableVertexAttribArray : procedure;
GL_BGRA, GL_BLEND, GL_CLAMP_TO_EDGE, GL_COLOR_ARRAY,
GL_COLOR_BUFFER_BIT, GL_DEPTH_BUFFER_BIT, GL_DEPTH_COMPONENT,
@@ -124,16 +107,12 @@
GL_TEXTURE_WRAP_T, GL_TRIANGLE_FAN, GL_TRUE, GL_VENDOR,
GL_VERSION, GL_VERTEX_ARRAY, GLenum, GL_FRAMEBUFFER_EXT,
GL_RENDERBUFFER_EXT, GL_DEPTH_ATTACHMENT_EXT,
- GL_COLOR_ATTACHMENT0_EXT, GL_FLOAT, GL_UNSIGNED_BYTE : integer;
+ GL_COLOR_ATTACHMENT0_EXT, GL_FLOAT, GL_UNSIGNED_BYTE, GL_COMPILE_STATUS,
+ GL_INFO_LOG_LENGTH, GL_LINK_STATUS, GL_VERTEX_SHADER, GL_FRAGMENT_SHADER,
+ GL_NO_ERROR, GL_ARRAY_BUFFER, GL_STATIC_DRAW, GLEW_OK,
+ GL_AUX_BUFFERS: integer;
TThreadId : function : integer;
- BeginThread, ThreadSwitch : procedure;
- InterlockedIncrement, InterlockedDecrement : procedure;
-
- random : function : integer;
- randomize : procedure;
-
- Assigned : function : boolean;
_strconcat, _strappend, _strprepend, _chrconcat : function : string;
_strcompare, _strncompare, _strcomparec : function : boolean;
@@ -144,5 +123,7 @@
png_write_row, png_set_ihdr, png_write_info,
png_write_end : procedure;
- EnumToStr : function : string;
+ clear_filelist_hook, add_file_hook, idb_loader_hook, mainloop_hook, drawworld_hook : procedure;
+ SDL_InitPatch : procedure;
+
Binary file hedgewars/res/hwengine.ico has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/res/hwengine.rc Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,1 @@
+MAINICON ICON "res/hwengine.ico"
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/sdlmain_osx/SDLMain.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,16 @@
+/* SDLMain.m - main entry point for our Cocoa-ized SDL app
+ Initial Version: Darrell Walisser <dwaliss1@purdue.edu>
+ Non-NIB-Code & other changes: Max Horn <max@quendi.de>
+
+ Feel free to customize this file to suit your needs
+*/
+
+#ifndef _SDLMain_h_
+#define _SDLMain_h_
+
+#import <Cocoa/Cocoa.h>
+
+@interface SDLMain : NSObject
+@end
+
+#endif /* _SDLMain_h_ */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/sdlmain_osx/SDLMain.m Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,385 @@
+/* SDLMain.m - main entry point for our Cocoa-ized SDL app
+ Initial Version: Darrell Walisser <dwaliss1@purdue.edu>
+ Non-NIB-Code & other changes: Max Horn <max@quendi.de>
+
+ Feel free to customize this file to suit your needs
+*/
+
+#include "SDL.h"
+#include "SDLMain.h"
+#include <sys/param.h> /* for MAXPATHLEN */
+#include <unistd.h>
+
+/* For some reaon, Apple removed setAppleMenu from the headers in 10.4,
+ but the method still is there and works. To avoid warnings, we declare
+ it ourselves here. */
+@interface NSApplication(SDL_Missing_Methods)
+- (void)setAppleMenu:(NSMenu *)menu;
+@end
+
+/* Use this flag to determine whether we use SDLMain.nib or not */
+#define SDL_USE_NIB_FILE 0
+
+/* Use this flag to determine whether we use CPS (docking) or not */
+#define SDL_USE_CPS 1
+#ifdef SDL_USE_CPS
+/* Portions of CPS.h */
+typedef struct CPSProcessSerNum
+{
+ UInt32 lo;
+ UInt32 hi;
+} CPSProcessSerNum;
+
+extern OSErr CPSGetCurrentProcess( CPSProcessSerNum *psn);
+extern OSErr CPSEnableForegroundOperation( CPSProcessSerNum *psn, UInt32 _arg2, UInt32 _arg3, UInt32 _arg4, UInt32 _arg5);
+extern OSErr CPSSetFrontProcess( CPSProcessSerNum *psn);
+
+#endif /* SDL_USE_CPS */
+
+static int gArgc;
+static char **gArgv;
+static BOOL gFinderLaunch;
+static BOOL gCalledAppMainline = FALSE;
+
+static NSString *getApplicationName(void)
+{
+ const NSDictionary *dict;
+ NSString *appName = 0;
+
+ /* Determine the application name */
+ dict = (const NSDictionary *)CFBundleGetInfoDictionary(CFBundleGetMainBundle());
+ if (dict)
+ appName = [dict objectForKey: @"CFBundleName"];
+
+ if (![appName length])
+ appName = [[NSProcessInfo processInfo] processName];
+
+ return appName;
+}
+
+#if SDL_USE_NIB_FILE
+/* A helper category for NSString */
+@interface NSString (ReplaceSubString)
+- (NSString *)stringByReplacingRange:(NSRange)aRange with:(NSString *)aString;
+@end
+#endif
+
+@interface SDLApplication : NSApplication
+@end
+
+@implementation SDLApplication
+/* Invoked from the Quit menu item */
+- (void)terminate:(id)sender
+{
+ /* Post a SDL_QUIT event */
+ SDL_Event event;
+ event.type = SDL_QUIT;
+ SDL_PushEvent(&event);
+}
+@end
+
+/* The main class of the application, the application's delegate */
+@implementation SDLMain
+
+/* Set the working directory to the .app's parent directory */
+- (void) setupWorkingDirectory:(BOOL)shouldChdir
+{
+ if (shouldChdir)
+ {
+ char parentdir[MAXPATHLEN];
+ CFURLRef url = CFBundleCopyBundleURL(CFBundleGetMainBundle());
+ CFURLRef url2 = CFURLCreateCopyDeletingLastPathComponent(0, url);
+ if (CFURLGetFileSystemRepresentation(url2, 1, (UInt8 *)parentdir, MAXPATHLEN)) {
+ chdir(parentdir); /* chdir to the binary app's parent */
+ }
+ CFRelease(url);
+ CFRelease(url2);
+ }
+}
+
+#if SDL_USE_NIB_FILE
+
+/* Fix menu to contain the real app name instead of "SDL App" */
+- (void)fixMenu:(NSMenu *)aMenu withAppName:(NSString *)appName
+{
+ NSRange aRange;
+ NSEnumerator *enumerator;
+ NSMenuItem *menuItem;
+
+ aRange = [[aMenu title] rangeOfString:@"SDL App"];
+ if (aRange.length != 0)
+ [aMenu setTitle: [[aMenu title] stringByReplacingRange:aRange with:appName]];
+
+ enumerator = [[aMenu itemArray] objectEnumerator];
+ while ((menuItem = [enumerator nextObject]))
+ {
+ aRange = [[menuItem title] rangeOfString:@"SDL App"];
+ if (aRange.length != 0)
+ [menuItem setTitle: [[menuItem title] stringByReplacingRange:aRange with:appName]];
+ if ([menuItem hasSubmenu])
+ [self fixMenu:[menuItem submenu] withAppName:appName];
+ }
+ [ aMenu sizeToFit ];
+}
+
+#else
+
+static void setApplicationMenu(void)
+{
+ /* warning: this code is very odd */
+ NSMenu *appleMenu;
+ NSMenuItem *menuItem;
+ NSString *title;
+ NSString *appName;
+
+ appName = getApplicationName();
+ appleMenu = [[NSMenu alloc] initWithTitle:@""];
+
+ /* Add menu items */
+ title = [@"About " stringByAppendingString:appName];
+ [appleMenu addItemWithTitle:title action:@selector(orderFrontStandardAboutPanel:) keyEquivalent:@""];
+
+ [appleMenu addItem:[NSMenuItem separatorItem]];
+
+ title = [@"Hide " stringByAppendingString:appName];
+ [appleMenu addItemWithTitle:title action:@selector(hide:) keyEquivalent:@"h"];
+
+ menuItem = (NSMenuItem *)[appleMenu addItemWithTitle:@"Hide Others" action:@selector(hideOtherApplications:) keyEquivalent:@"h"];
+ [menuItem setKeyEquivalentModifierMask:(NSAlternateKeyMask|NSCommandKeyMask)];
+
+ [appleMenu addItemWithTitle:@"Show All" action:@selector(unhideAllApplications:) keyEquivalent:@""];
+
+ [appleMenu addItem:[NSMenuItem separatorItem]];
+
+ title = [@"Quit " stringByAppendingString:appName];
+ [appleMenu addItemWithTitle:title action:@selector(terminate:) keyEquivalent:@"q"];
+
+
+ /* Put menu into the menubar */
+ menuItem = [[NSMenuItem alloc] initWithTitle:@"" action:nil keyEquivalent:@""];
+ [menuItem setSubmenu:appleMenu];
+ [[NSApp mainMenu] addItem:menuItem];
+
+ /* Tell the application object that this is now the application menu */
+ [NSApp setAppleMenu:appleMenu];
+
+ /* Finally give up our references to the objects */
+ [appleMenu release];
+ [menuItem release];
+}
+
+/* Create a window menu */
+static void setupWindowMenu(void)
+{
+ NSMenu *windowMenu;
+ NSMenuItem *windowMenuItem;
+ NSMenuItem *menuItem;
+
+ windowMenu = [[NSMenu alloc] initWithTitle:@"Window"];
+
+ /* "Minimize" item */
+ menuItem = [[NSMenuItem alloc] initWithTitle:@"Minimize" action:@selector(performMiniaturize:) keyEquivalent:@"m"];
+ [windowMenu addItem:menuItem];
+ [menuItem release];
+
+ /* Put menu into the menubar */
+ windowMenuItem = [[NSMenuItem alloc] initWithTitle:@"Window" action:nil keyEquivalent:@""];
+ [windowMenuItem setSubmenu:windowMenu];
+ [[NSApp mainMenu] addItem:windowMenuItem];
+
+ /* Tell the application object that this is now the window menu */
+ [NSApp setWindowsMenu:windowMenu];
+
+ /* Finally give up our references to the objects */
+ [windowMenu release];
+ [windowMenuItem release];
+}
+
+/* Replacement for NSApplicationMain */
+static void CustomApplicationMain (int argc, char **argv)
+{
+ NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
+ SDLMain *sdlMain;
+
+ /* Ensure the application object is initialised */
+ [SDLApplication sharedApplication];
+
+#ifdef SDL_USE_CPS
+ {
+ CPSProcessSerNum PSN;
+ /* Tell the dock about us */
+ if (!CPSGetCurrentProcess(&PSN))
+ if (!CPSEnableForegroundOperation(&PSN,0x03,0x3C,0x2C,0x1103))
+ if (!CPSSetFrontProcess(&PSN))
+ [SDLApplication sharedApplication];
+ }
+#endif /* SDL_USE_CPS */
+
+ /* Set up the menubar */
+ NSMenu *menu = [[NSMenu alloc] init];
+ [NSApp setMainMenu:menu];
+ setApplicationMenu();
+ setupWindowMenu();
+ [menu release];
+
+ /* Create SDLMain and make it the app delegate */
+ sdlMain = [[SDLMain alloc] init];
+ [NSApp setDelegate:sdlMain];
+
+ /* Start the main event loop */
+ [NSApp run];
+
+ [sdlMain release];
+ [pool release];
+}
+
+#endif
+
+
+/*
+ * Catch document open requests...this lets us notice files when the app
+ * was launched by double-clicking a document, or when a document was
+ * dragged/dropped on the app's icon. You need to have a
+ * CFBundleDocumentsType section in your Info.plist to get this message,
+ * apparently.
+ *
+ * Files are added to gArgv, so to the app, they'll look like command line
+ * arguments. Previously, apps launched from the finder had nothing but
+ * an argv[0].
+ *
+ * This message may be received multiple times to open several docs on launch.
+ *
+ * This message is ignored once the app's mainline has been called.
+ */
+- (BOOL)application:(NSApplication *)theApplication openFile:(NSString *)filename
+{
+ const char *temparg;
+ size_t arglen;
+ char *arg;
+ char **newargv;
+
+ if (!gFinderLaunch) /* MacOS is passing command line args. */
+ return FALSE;
+
+ if (gCalledAppMainline) /* app has started, ignore this document. */
+ return FALSE;
+
+ temparg = [filename UTF8String];
+ arglen = SDL_strlen(temparg) + 1;
+ arg = (char *) SDL_malloc(arglen);
+ if (arg == NULL)
+ return FALSE;
+
+ newargv = (char **) realloc(gArgv, sizeof (char *) * (gArgc + 2));
+ if (newargv == NULL)
+ {
+ SDL_free(arg);
+ return FALSE;
+ }
+ gArgv = newargv;
+
+ SDL_strlcpy(arg, temparg, arglen);
+ gArgv[gArgc++] = arg;
+ gArgv[gArgc] = NULL;
+ return TRUE;
+}
+
+
+/* Called when the internal event loop has just started running */
+- (void) applicationDidFinishLaunching: (NSNotification *) note
+{
+ int status;
+
+ /* Set the working directory to the .app's parent directory */
+ [self setupWorkingDirectory:gFinderLaunch];
+
+#if SDL_USE_NIB_FILE
+ /* Set the main menu to contain the real app name instead of "SDL App" */
+ [self fixMenu:[NSApp mainMenu] withAppName:getApplicationName()];
+#endif
+
+ /* Hand off to main application code */
+ gCalledAppMainline = TRUE;
+ status = SDL_main (gArgc, gArgv);
+
+ /* We're done, thank you for playing */
+ exit(status);
+}
+@end
+
+
+@implementation NSString (ReplaceSubString)
+
+- (NSString *)stringByReplacingRange:(NSRange)aRange with:(NSString *)aString
+{
+ unsigned int bufferSize;
+ unsigned int selfLen = [self length];
+ unsigned int aStringLen = [aString length];
+ unichar *buffer;
+ NSRange localRange;
+ NSString *result;
+
+ bufferSize = selfLen + aStringLen - aRange.length;
+ buffer = (unichar *)NSAllocateMemoryPages(bufferSize*sizeof(unichar));
+
+ /* Get first part into buffer */
+ localRange.location = 0;
+ localRange.length = aRange.location;
+ [self getCharacters:buffer range:localRange];
+
+ /* Get middle part into buffer */
+ localRange.location = 0;
+ localRange.length = aStringLen;
+ [aString getCharacters:(buffer+aRange.location) range:localRange];
+
+ /* Get last part into buffer */
+ localRange.location = aRange.location + aRange.length;
+ localRange.length = selfLen - localRange.location;
+ [self getCharacters:(buffer+aRange.location+aStringLen) range:localRange];
+
+ /* Build output string */
+ result = [NSString stringWithCharacters:buffer length:bufferSize];
+
+ NSDeallocateMemoryPages(buffer, bufferSize);
+
+ return result;
+}
+
+@end
+
+
+
+#ifdef main
+# undef main
+#endif
+
+
+/* Main entry point to executable - should *not* be SDL_main! */
+int main (int argc, char **argv)
+{
+ /* Copy the arguments into a global variable */
+ /* This is passed if we are launched by double-clicking */
+ if ( argc >= 2 && strncmp (argv[1], "-psn", 4) == 0 ) {
+ gArgv = (char **) SDL_malloc(sizeof (char *) * 2);
+ gArgv[0] = argv[0];
+ gArgv[1] = NULL;
+ gArgc = 1;
+ gFinderLaunch = YES;
+ } else {
+ int i;
+ gArgc = argc;
+ gArgv = (char **) SDL_malloc(sizeof (char *) * (argc+1));
+ for (i = 0; i <= argc; i++)
+ gArgv[i] = argv[i];
+ gFinderLaunch = NO;
+ }
+
+#if SDL_USE_NIB_FILE
+ [SDLApplication poseAsClass:[NSApplication class]];
+ NSApplicationMain (argc, argv);
+#else
+ CustomApplicationMain (argc, argv);
+#endif
+ return 0;
+}
+
--- a/hedgewars/uAI.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uAI.pas Sun Jan 27 00:28:57 2013 +0100
@@ -33,6 +33,11 @@
uAmmos, SysUtils{$IFNDEF USE_SDLTHREADS} {$IFDEF UNIX}, cthreads{$ENDIF} {$ENDIF}, uTypes,
uVariables, uCommands, uUtils, uDebug, uAILandMarks;
+{$IFDEF AI_MAINTHREAD}
+const
+ mainThreadMaxThinkTime:Integer = 1500;
+{$ENDIF}
+
var BestActions: TActions;
CanUseAmmo: array [TAmmoType] of boolean;
StopThinking: boolean;
@@ -42,7 +47,7 @@
ThinkThread: TThreadID;
{$ENDIF}
hasThread: LongInt;
- StartTicks: Longword;
+ StartTicks: LongInt;
procedure FreeActionsList;
begin
@@ -332,7 +337,7 @@
end;
// 'not CanGO' means we can't go straight, possible jumps are checked above
- if not CanGo then
+ if (not CanGo) then
break;
inc(steps);
@@ -360,6 +365,15 @@
if GoInfo.FallPix >= FallPixForBranching then
Push(ticks, Actions, Me^, Me^.Message xor 3); // aia_Left xor 3 = aia_Right
+
+{$IFDEF AI_MAINTHREAD}
+ if StartTicks < (SDL_GetTicks() - mainThreadMaxThinkTime) then
+ StopThinking := true;
+{$ELSE}
+ if (StartTicks > GameTicks - 1500) and (not StopThinking) then
+ SDL_Delay(1000);
+{$ENDIF}
+
end {while};
if BestRate > BaseRate then
@@ -371,12 +385,18 @@
function Think(Me: Pointer): ptrint;
var BackMe, WalkMe: TGear;
switchCount: LongInt;
- StartTicks, currHedgehogIndex, itHedgehog, switchesNum, i: Longword;
+ currHedgehogIndex, itHedgehog, switchesNum, i: Longword;
switchImmediatelyAvailable: boolean;
Actions: TActions;
begin
InterlockedIncrement(hasThread);
+
+{$IFDEF AI_MAINTHREAD}
+StartTicks:= SDL_GetTicks();
+{$ELSE}
StartTicks:= GameTicks;
+{$ENDIF}
+
currHedgehogIndex:= CurrentTeam^.CurrHedgehog;
itHedgehog:= currHedgehogIndex;
switchesNum:= 0;
@@ -386,7 +406,7 @@
switchCount:= HHHasAmmo(PGear(Me)^.Hedgehog^, amSwitch)
else switchCount:= 0;
-if (PGear(Me)^.State and gstAttacked) = 0 then
+if (PGear(Me)^.State and gstAttacking) = 0 then
if Targets.Count > 0 then
begin
// iterate over current team hedgehogs
@@ -398,7 +418,7 @@
Actions.Score:= 0;
if switchesNum > 0 then
begin
- if not switchImmediatelyAvailable then
+ if (not switchImmediatelyAvailable) then
begin
// when AI has to use switcher, make it cost smth unless they have a lot of switches
if (switchCount < 10) then Actions.Score:= (-27+switchCount*3)*4000;
@@ -423,8 +443,13 @@
or (itHedgehog = currHedgehogIndex)
or BestActions.isWalkingToABetterPlace;
- if (StartTicks > GameTicks - 1500) and (not StopThinking) then
- SDL_Delay(1000);
+ {$IFDEF AI_MAINTHREAD}
+ if StartTicks < (SDL_GetTicks() - mainThreadMaxThinkTime) then
+ StopThinking := true;
+ {$ELSE}
+ if (StartTicks > GameTicks - 1500) and (not StopThinking) then
+ SDL_Delay(1000);
+ {$ENDIF}
if (BestActions.Score < -1023) and (not BestActions.isWalkingToABetterPlace) then
begin
@@ -436,22 +461,29 @@
else
begin
BackMe:= PGear(Me)^;
+
+//{$IFNDEF AI_MAINTHREAD}
while (not StopThinking) and (BestActions.Count = 0) do
begin
+
(*
// Maybe this would get a bit of movement out of them? Hopefully not *toward* water. Need to check how often he'd choose that strategy
if SuddenDeathDmg and ((hwRound(BackMe.Y)+cWaterRise*2) > cWaterLine) then
AddBonus(hwRound(BackMe.X), hwRound(BackMe.Y), 250, -40);
*)
+
FillBonuses(true);
WalkMe:= BackMe;
Actions.Count:= 0;
Actions.Pos:= 0;
Actions.Score:= 0;
Walk(@WalkMe, Actions);
- if not StopThinking then
+{$IFNDEF AI_MAINTHREAD}
+ if (not StopThinking) then
SDL_Delay(100)
+{$ENDIF}
end
+//{$ENDIF}
end;
PGear(Me)^.State:= PGear(Me)^.State and (not gstHHThinking);
@@ -487,12 +519,17 @@
FillBonuses((Me^.State and gstAttacked) <> 0);
AddFileLog('Enter Think Thread');
+
+{$IFDEF AI_MAINTHREAD}
+Think(Me);
+{$ELSE}
{$IFDEF USE_SDLTHREADS}
ThinkThread := SDL_CreateThread(@Think{$IFDEF SDL13}, nil{$ENDIF}, Me);
{$ELSE}
BeginThread(@Think, Me, ThinkThread);
{$ENDIF}
AddFileLog('Thread started');
+{$ENDIF}
end;
//var scoreShown: boolean = false;
@@ -539,7 +576,9 @@
begin
hasThread:= 0;
StartTicks:= 0;
+{$IFNDEF PAS2C}
ThinkThread:= ThinkThread;
+{$ENDIF}
end;
procedure freeModule;
--- a/hedgewars/uAIAmmoTests.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uAIAmmoTests.pas Sun Jan 27 00:28:57 2013 +0100
@@ -21,7 +21,7 @@
unit uAIAmmoTests;
interface
uses SDLh, uConsts, uFloat, uTypes;
-const
+const
amtest_Rare = $00000001; // check only several positions
amtest_NoTarget = $00000002; // each pos, but no targetting
@@ -163,9 +163,9 @@
dX:= dX + windSpeed;
dY:= dY + cGravityf;
dec(t)
- until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
+ until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, trunc(x), trunc(y), 5))) or (t <= 0);
-
+
EX:= trunc(x);
EY:= trunc(y);
if Level = 1 then
@@ -222,9 +222,9 @@
dX:= dX + windSpeed;
dY:= dY + cGravityf;
dec(t)
- until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
+ until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, trunc(x), trunc(y), 5))) or (y > cWaterLine);
-
+
EX:= trunc(x);
EY:= trunc(y);
if Level = 1 then
@@ -281,7 +281,7 @@
dX:= dX + windSpeed;
dY:= dY + cGravityf;
dec(t)
- until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
+ until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, trunc(x), trunc(y), 5))) or (t <= 0);
EX:= trunc(x);
EY:= trunc(y);
@@ -333,7 +333,7 @@
y:= y + dY;
dY:= dY + cGravityf;
dec(t)
- until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 6)) or
+ until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 6)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, trunc(x), trunc(y), 6))) or (t = 0);
EX:= trunc(x);
EY:= trunc(y);
@@ -341,7 +341,7 @@
Score:= RateExplosion(Me, EX, EY, 97) // average of 17 attempts, most good, but some failing spectacularly
else
Score:= BadTurn;
-
+
if valueResult < Score then
begin
ap.Angle:= DxDy2AttackAnglef(Vx, Vy) + AIrndSign(random(Level));
@@ -377,7 +377,7 @@
if not (r > 1) then
begin
x:= meX;
- y:= meY;
+ y:= meY;
dY:= -Vy;
t:= TestTime;
repeat
@@ -385,15 +385,15 @@
y:= y + dY;
dY:= dY + cGravityf;
dec(t)
- until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
+ until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, trunc(x), trunc(y), 5))) or (t = 0);
EX:= trunc(x);
EY:= trunc(y);
- if t < 50 then
+ if t < 50 then
if Level = 1 then
Score:= RateExplosion(Me, EX, EY, 101, afTrackFall or afErasesLand)
else Score:= RateExplosion(Me, EX, EY, 101)
- else
+ else
Score:= BadTurn;
if (valueResult < Score) and (Score > 0) then
@@ -445,13 +445,13 @@
y:= y + dY;
dY:= dY + cGravityf;
dec(t)
- until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
+ until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 5)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, trunc(x), trunc(y), 5))) or (t = 0);
EX:= trunc(x);
EY:= trunc(y);
- if t < 50 then
+ if t < 50 then
Score:= RateExplosion(Me, EX, EY, 41)
- else
+ else
Score:= BadTurn;
if valueResult < Score then
@@ -498,16 +498,16 @@
y:= y + dY;
dY:= dY + cGravityf;
dec(t)
- until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 6)) or
+ until (((Me = CurrentHedgehog^.Gear) and TestColl(trunc(x), trunc(y), 6)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, trunc(x), trunc(y), 6))) or (t = 0);
-
+
EX:= trunc(x);
EY:= trunc(y);
- if t < 50 then
+ if t < 50 then
Score:= RateExplosion(Me, EX, EY, 200) + RateExplosion(Me, EX, EY + 120, 200)
- else
+ else
Score:= BadTurn;
-
+
if valueResult < Score then
begin
ap.Angle:= DxDy2AttackAnglef(Vx, Vy) + AIrndSign(random(Level));
@@ -544,7 +544,7 @@
else
Solve:= 0
end;
-
+
function TestMortar(Me: PGear; Targ: TPoint; Level: LongInt; var ap: TAttackParams): LongInt;
//const tDelta = 24;
var Vx, Vy: real;
@@ -579,7 +579,7 @@
dY:= dY + cGravityf;
EX:= trunc(x);
EY:= trunc(y);
- until (((Me = CurrentHedgehog^.Gear) and TestColl(EX, EY, 4)) or
+ until (((Me = CurrentHedgehog^.Gear) and TestColl(EX, EY, 4)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, EX, EY, 4))) or (EY > cWaterLine);
if (EY < cWaterLine) and (dY >= 0) then
@@ -633,16 +633,16 @@
y:= y + vY;
rx:= trunc(x);
ry:= trunc(y);
- if ((Me = CurrentHedgehog^.Gear) and TestColl(rx, ry, 2)) or
+ if ((Me = CurrentHedgehog^.Gear) and TestColl(rx, ry, 2)) or
((Me <> CurrentHedgehog^.Gear) and TestCollExcludingMe(Me, rx, ry, 2)) then
begin
x:= x + vX * 8;
y:= y + vY * 8;
valueResult:= RateShotgun(Me, vX, vY, rx, ry);
-
- if valueResult = 0 then
+
+ if valueResult = 0 then
valueResult:= 1024 - Metric(Targ.X, Targ.Y, rx, ry) div 64
- else
+ else
dec(valueResult, Level * 4000);
// 27/20 is reuse bonus
exit(valueResult * 27 div 20)
@@ -748,7 +748,7 @@
fallDmg:= TraceShoveFall(Targ.X, Targ.Y, vX * 0.00166 * dmg, vY * 0.00166 * dmg);
if fallDmg < 0 then
TestSniperRifle:= BadTurn
- else
+ else
TestSniperRifle:= Max(0, trunc((dmg + fallDmg) * dmgMod) * 1024)
end
else
@@ -764,7 +764,7 @@
Targ:= Targ; // avoid compiler hint
if Level < 3 then trackFall:= afTrackFall
- else trackFall:= 0;
+ else trackFall:= 0;
ap.ExplR:= 0;
ap.Time:= 0;
@@ -787,13 +787,13 @@
, 32, 30, 115
, dx, -dy, trackFall);
if (v1 > valueResult) or (v2 > valueResult) then
- if (v2 > v1)
+ if (v2 > v1)
or {don't encourage turning for no gain}((v2 = v1) and (not Me^.dX.isNegative)) then
begin
ap.Angle:= a;
valueResult:= v2
end
- else
+ else
begin
ap.Angle:= -a;
valueResult:= v1
@@ -801,7 +801,7 @@
a:= a - 15 - random(cMaxAngle div 16)
end;
-
+
if valueResult <= 0 then
valueResult:= BadTurn;
@@ -847,18 +847,18 @@
, 19, 30, 40
, 0.45, -0.9, trackFall);
- if (v2 > v1)
+ if (v2 > v1)
or {don't encourage turning for no gain}((v2 = v1) and (not Me^.dX.isNegative)) then
begin
ap.Angle:= 1;
valueResult:= v2
end
- else
+ else
begin
ap.Angle:= -1;
valueResult:= v1
end;
-
+
if valueResult <= 0 then
valueResult:= BadTurn;
@@ -882,8 +882,8 @@
y:= hwRound(Me^.Y);
// check left direction
- {first RateShove checks farthermost of two whip's AmmoShove attacks
- to encourage distant attacks (damaged hog is excluded from view of second
+ {first RateShove checks farthermost of two whip's AmmoShove attacks
+ to encourage distant attacks (damaged hog is excluded from view of second
RateShove call)}
v1:= RateShove(x - 13, y
, 30, 30, 25
@@ -901,18 +901,18 @@
, 30, 30, 25
, 1, -0.8, trackFall);
- if (v2 > v1)
+ if (v2 > v1)
or {don't encourage turning for no gain}((v2 = v1) and (not Me^.dX.isNegative)) then
begin
ap.Angle:= 1;
valueResult:= v2
end
- else
+ else
begin
ap.Angle:= -1;
valueResult:= v1
end;
-
+
if valueResult <= 0 then
valueResult:= BadTurn
else
@@ -931,13 +931,13 @@
ap.Time:= 0;
ap.Power:= 1;
- if Level = 1 then
+ if Level = 1 then
trackFall:= afTrackFall
else if Level = 2 then
trackFall:= 0
else
exit(BadTurn);
-
+
valueResult:= 0;
v:= 0;
@@ -958,16 +958,16 @@
ap.Angle:= DxDy2AttackAnglef(dx, -dy)
end;
-
+
if dx >= 0 then cx:= 0.45 else cx:= -0.45;
for i:= 0 to 512 div step - 2 do
begin
- valueResult:= valueResult +
+ valueResult:= valueResult +
RateShove(trunc(x), trunc(y)
, 30, 30, 25
, cx, -0.9, trackFall or afSetSkip);
-
+
x:= x + dx;
y:= y + dy;
end;
@@ -982,7 +982,7 @@
for i:= 1 to 512 div step - 2 do
begin
y:= y + dy;
- v:= v +
+ v:= v +
RateShove(tx, trunc(y)
, 30, 30, 25
, -cx, -0.9, trackFall or afSetSkip);
@@ -1015,7 +1015,7 @@
ap.Time:= 0;
ap.Power:= 1;
ap.Angle:= 0;
-
+
rate:= RateHammer(Me);
if rate = 0 then
rate:= BadTurn;
@@ -1106,8 +1106,8 @@
if Me^.Health <= 100 then
begin
maxTop := Targ.Y - cHHRadius * 2;
-
- while not TestColl(Targ.X, maxTop, cHHRadius) and (maxTop > topY + cHHRadius * 2 + 1) do
+
+ while (not TestColl(Targ.X, maxTop, cHHRadius)) and (maxTop > topY + cHHRadius * 2 + 1) do
dec(maxTop, cHHRadius*2);
if not TestColl(Targ.X, maxTop + cHHRadius, cHHRadius) then
begin
@@ -1125,7 +1125,7 @@
inc(failNum);
until not TestColl(bonuses.ar[i].X, bonuses.ar[i].Y - cHHRadius - bonuses.ar[i].Radius, cHHRadius)
or (failNum = bonuses.Count*2);
-
+
if failNum < bonuses.Count*2 then
begin
ap.AttackPutX := bonuses.ar[i].X;
@@ -1147,7 +1147,7 @@
begin
cakeStep(Gear);
v:= RateExplosion(Me, hwRound(Gear^.X), hwRound(Gear^.Y), cakeDmg * 2, afTrackFall);
- if v > ap.Power then
+ if v > ap.Power then
begin
ap.ExplX:= hwRound(Gear^.X);
ap.ExplY:= hwRound(Gear^.Y);
--- a/hedgewars/uAIMisc.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uAIMisc.pas Sun Jan 27 00:28:57 2013 +0100
@@ -49,7 +49,17 @@
X, Y: LongInt;
Radius: LongInt;
Score: LongInt;
- end;
+ end;
+
+Tbonuses = record
+ Count : Longword;
+ ar : array[0..Pred(MAXBONUS)] of TBonus;
+ end;
+
+Twalkbonuses = record
+ Count: Longword;
+ ar: array[0..Pred(MAXBONUS div 8)] of TBonus; // don't use too many
+ end;
procedure initModule;
procedure freeModule;
@@ -77,15 +87,9 @@
var ThinkingHH: PGear;
Targets: TTargets;
- bonuses: record
- Count: Longword;
- ar: array[0..Pred(MAXBONUS)] of TBonus;
- end;
+ bonuses: Tbonuses;
- walkbonuses: record
- Count: Longword;
- ar: array[0..Pred(MAXBONUS div 8)] of TBonus; // don't use too many
- end;
+ walkbonuses: Twalkbonuses;
const KillScore = 200;
var friendlyfactor: LongInt = 300;
@@ -353,7 +357,7 @@
y:= y + dY;
dY:= dY + cGravityf;
skipLandCheck:= skipLandCheck and (r <> 0) and (abs(eX-x) + abs(eY-y) < r) and ((abs(eX-x) < rCorner) or (abs(eY-y) < rCorner));
- if not skipLandCheck and TestCollWithLand(trunc(x), trunc(y), cHHRadius) then
+ if (not skipLandCheck) and TestCollWithLand(trunc(x), trunc(y), cHHRadius) then
begin
if 0.4 < dY then
begin
--- a/hedgewars/uAmmos.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uAmmos.pas Sun Jan 27 00:28:57 2013 +0100
@@ -257,7 +257,7 @@
Ammo^[Slot, ami]:= Ammo^[Slot, ami + 1];
Ammo^[Slot, ami + 1].Count:= 0
end;
- until not b;
+ until (not b);
AmmoMenuInvalidated:= true;
end;
--- a/hedgewars/uCaptions.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uCaptions.pas Sun Jan 27 00:28:57 2013 +0100
@@ -45,6 +45,8 @@
procedure AddCaption(s: shortstring; Color: Longword; Group: TCapGroup);
begin
if cOnlyStats then exit;
+ if Length(s) = 0 then
+ exit;
if Captions[Group].Text <> s then
begin
FreeTexture(Captions[Group].Tex);
--- a/hedgewars/uChat.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uChat.pas Sun Jan 27 00:28:57 2013 +0100
@@ -192,7 +192,7 @@
i:= MaxStrIndex
else
dec(i);
-
+
inc(cnt);
inc(t)
end;
@@ -216,14 +216,14 @@
x:= 0;
if (s[1] = '"') and (s[Length(s)] = '"')
then x:= 1
-
+
else if (s[1] = '''') and (s[Length(s)] = '''') then
x:= 2
-
+
else if (s[1] = '-') and (s[Length(s)] = '-') then
x:= 3;
-
-if not CurrentTeam^.ExtDriven and (x <> 0) then
+
+if (not CurrentTeam^.ExtDriven) and (x <> 0) then
for c:= 0 to Pred(TeamsCount) do
if (TeamsArray[c] = CurrentTeam) then
t:= c;
@@ -280,7 +280,7 @@
exit
end;
- for j:= Low(TChatCmd) to High(TChatCmd) do
+ for j:= Low(TChatCmd) to High(TChatCmd) do
if (s = ChatCommandz[j].ChatCmd) then
begin
ParseCommand(ChatCommandz[j].ProcedureCallChatCmd, true);
--- a/hedgewars/uCommandHandlers.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uCommandHandlers.pas Sun Jan 27 00:28:57 2013 +0100
@@ -36,7 +36,7 @@
procedure chGenCmd(var s: shortstring);
begin
case s[1] of
- 'R': if ReadyTimeLeft > 1 then
+ 'R': if ReadyTimeLeft > 1 then
begin
ReadyTimeLeft:= 1;
if not isExternalSource then
@@ -187,37 +187,37 @@
procedure chCurD_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
CursorMovementY:= 0;
end;
procedure chCurL_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
CursorMovementX:= -1;
end;
procedure chCurL_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
CursorMovementX:= 0;
end;
procedure chCurR_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
CursorMovementX:= 1;
end;
procedure chCurR_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
CursorMovementX:= 0;
end;
procedure chLeft_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not isExternalSource then
@@ -230,7 +230,7 @@
procedure chLeft_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not isExternalSource then
@@ -242,7 +242,7 @@
procedure chRight_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not isExternalSource then
@@ -255,7 +255,7 @@
procedure chRight_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not isExternalSource then
@@ -267,7 +267,7 @@
procedure chUp_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not isExternalSource then
@@ -280,7 +280,7 @@
procedure chUp_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not isExternalSource then
@@ -292,7 +292,7 @@
procedure chDown_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not isExternalSource then
@@ -305,7 +305,7 @@
procedure chDown_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not isExternalSource then
@@ -317,7 +317,7 @@
procedure chPrecise_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not isExternalSource then
@@ -330,7 +330,7 @@
procedure chPrecise_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
if not isExternalSource then
@@ -342,7 +342,7 @@
procedure chLJump(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not isExternalSource then
@@ -355,7 +355,7 @@
procedure chHJump(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not isExternalSource then
@@ -368,7 +368,7 @@
procedure chAttack_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
bShowFinger:= false;
@@ -388,7 +388,7 @@
procedure chAttack_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH then
exit;
with CurrentHedgehog^.Gear^ do
@@ -403,7 +403,7 @@
procedure chSwitch(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
if not isExternalSource then
@@ -415,9 +415,10 @@
end;
procedure chNextTurn(var s: shortstring);
-var gi: PGear;
+var i : Longword;
+ gi : PGear;
begin
- s:= s; // avoid compiler hint
+ s:=s; // avoid compiler hint
TryDo(AllInactive, '/nextturn called when not all gears are inactive', true);
@@ -480,7 +481,7 @@
with CurrentHedgehog^.Gear^ do
begin
Message:= Message or (gmSlot and InputMask);
- MsgParam:= slot;
+ MsgParam:= slot;
ScriptCall('onSlot', MsgParam);
end
end;
@@ -517,20 +518,20 @@
with CurrentHedgehog^.Gear^ do
begin
Message:= Message or (gmAnimate and InputMask);
- MsgParam:= byte(s[1]) ;
+ MsgParam:= byte(s[1]) ;
ScriptCall('onTaunt', MsgParam);
end
end;
procedure chPut(var s: shortstring);
begin
- s:= s; // avoid compiler hint
+ s:=s; // avoid compiler hint
doPut(0, 0, false);
end;
procedure chCapture(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
flagMakeCapture:= true
end;
@@ -581,7 +582,7 @@
procedure chAmmoMenu(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH then
bShowAmmoMenu:= true
else
@@ -606,19 +607,19 @@
procedure chVol_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
inc(cVolumeDelta, 3)
end;
procedure chVol_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
dec(cVolumeDelta, 3)
end;
procedure chFindhh(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if CheckNoTeamOrHH or isPaused then
exit;
@@ -640,7 +641,7 @@
procedure chPause(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if gameType <> gmtNet then
isPaused:= not isPaused;
@@ -652,7 +653,7 @@
procedure chRotateMask(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
if ((GameFlags and gfInvulnerable) = 0) then
cTagsMask:= cTagsMasks[cTagsMask]
else
@@ -661,34 +662,34 @@
procedure chSpeedup_p(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
SpeedStart:= RealTicks;
isSpeed:= true
end;
procedure chSpeedup_m(var s: shortstring);
begin
-s:= s; // avoid compiler hint
+s:=s; // avoid compiler hint
isSpeed:= false
end;
procedure chZoomIn(var s: shortstring);
begin
- s:= s; // avoid compiler hint
+ s:=s; // avoid compiler hint
if ZoomValue < cMinZoomLevel then
ZoomValue:= ZoomValue + cZoomDelta;
end;
procedure chZoomOut(var s: shortstring);
begin
- s:= s; // avoid compiler hint
+ s:=s; // avoid compiler hint
if ZoomValue > cMaxZoomLevel then
ZoomValue:= ZoomValue - cZoomDelta;
end;
procedure chZoomReset(var s: shortstring);
begin
- s:= s; // avoid compiler hint
+ s:=s; // avoid compiler hint
ZoomValue:= cDefaultZoomLevel;
end;
--- a/hedgewars/uConsts.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uConsts.pas Sun Jan 27 00:28:57 2013 +0100
@@ -93,7 +93,7 @@
// lfObject and lfBasic are only to be different *graphically* in all other ways they should be treated the same
lfBasic = $8000; // white
lfIndestructible = $4000; // red
- lfObject = $2000;
+ lfObject = $2000;
lfDamaged = $1000; //
lfIce = $0800; // blue
lfBouncy = $0400; // green
@@ -142,7 +142,7 @@
cBlowTorchC = 6;
cakeDmg = 75;
- cKeyMaxIndex = 1023;
+ cKeyMaxIndex = 1600;
cKbdMaxIndex = 65536;//need more room for the modifier keys
cFontBorder = 2;
@@ -228,11 +228,11 @@
cMaxSlotIndex = 9;
cMaxSlotAmmoIndex = 5;
-
+
// ai hints
aihUsualProcessing = $00000000;
aihDoesntMatter = $00000001;
-
+
// ammo properties
ammoprop_Timerable = $00000001;
ammoprop_Power = $00000002;
@@ -248,7 +248,7 @@
ammoprop_Utility = $00001000;
ammoprop_Effect = $00002000;
ammoprop_SetBounce = $00004000;
- ammoprop_NeedUpDown = $00008000;//Used by TouchInterface to show or hide up/down widgets
+ ammoprop_NeedUpDown = $00008000;//Used by TouchInterface to show or hide up/down widgets
ammoprop_OscAim = $00010000;
ammoprop_NoMoveAfter = $00020000;
ammoprop_Track = $00040000;
--- a/hedgewars/uCursor.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uCursor.pas Sun Jan 27 00:28:57 2013 +0100
@@ -11,6 +11,10 @@
uses SDLh, uVariables;
+{$IFDEF WEBGL}
+var offsetx, offsety : Integer;
+{$ENDIF}
+
procedure init;
begin
resetPosition();
@@ -23,16 +27,33 @@
procedure updatePosition;
var x, y: LongInt;
+{$IFDEF WEBGL}
+ tx, ty : LongInt;
+{$ENDIF}
begin
SDL_GetMouseState(@x, @y);
-
+
+{$IFDEF WEBGL}
+ tx := x;
+ ty := y;
+ x := x + offsetx;
+ y := y + offsety;
+{$ENDIF}
+
if(x <> cScreenWidth div 2) or (y <> cScreenHeight div 2) then
begin
handlePositionUpdate(x - cScreenWidth div 2, y - cScreenHeight div 2);
if cHasFocus then
+ begin
+ {$IFNDEF WEBGL}
SDL_WarpMouse(cScreenWidth div 2, cScreenHeight div 2);
- end
+ {$ELSE}
+ offsetx := cScreenWidth div 2 - tx;
+ offsety := cScreenHeight div 2 - ty;
+ {$ENDIF}
+ end;
+ end
end;
procedure handlePositionUpdate(x, y: LongInt);
--- a/hedgewars/uFloat.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uFloat.pas Sun Jan 27 00:28:57 2013 +0100
@@ -55,7 +55,7 @@
1: (QWordValue : QWord);
end;
{$ENDIF}
-
+
// Returns an hwFloat that represents the value of integer parameter i
function int2hwFloat (const i: LongInt) : hwFloat; inline;
function hwFloat2Float (const i: hwFloat) : extended; inline;
@@ -221,7 +221,7 @@
hwFloat2Float:= -hwFloat2Float;
end;
-{$IFNDEF WEB}
+{$IFNDEF WEBGL}
operator = (const z1, z2: hwFloat) z : boolean; inline;
begin
z:= (z1.isNegative = z2.isNegative) and (z1.QWordValue = z2.QWordValue);
@@ -301,7 +301,7 @@
b:= (z1.QWordValue > z2.QWordValue) <> z2.isNegative
end;
{$ENDIF}
-{$IFDEF WEB}
+{$IFDEF WEBGL}
(*
Mostly to be kind to JS as of 2012-08-27 where there is no int64/uint64. This may change though.
*)
--- a/hedgewars/uGame.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uGame.pas Sun Jan 27 00:28:57 2013 +0100
@@ -26,7 +26,7 @@
////////////////////
implementation
////////////////////
-uses uInputHandler, uTeams, uIO, uAI, uGears, uSound,
+uses uInputHandler, uTeams, uIO, uAI, uGears, uSound,
uVisualGears, uTypes, uVariables, uCommands, uConsts
{$IFDEF USE_TOUCH_INTERFACE}, uTouch{$ENDIF};
@@ -48,7 +48,7 @@
else if (GameType = gmtSave) or (fastUntilLag and (GameType = gmtNet)) then
Lag:= 2500;
- if (GameType = gmtDemo) then
+ if (GameType = gmtDemo) then
if isSpeed then
begin
i:= RealTicks-SpeedStart;
--- a/hedgewars/uGears.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uGears.pas Sun Jan 27 00:28:57 2013 +0100
@@ -54,7 +54,6 @@
function GearByUID(uid : Longword) : PGear;
procedure doStepDrowningGear(Gear: PGear);
-
implementation
uses uStore, uSound, uTeams, uRandom, uCollisions, uIO, uLandGraphics, {$IFDEF SDL13}uTouch,{$ENDIF}
uLocale, uAI, uAmmos, uStats, uVisualGears, uScript, GLunit, uVariables,
@@ -100,7 +99,7 @@
begin
if (not isInMultiShoot) then
inc(Gear^.Damage, Gear^.Karma);
- if (Gear^.Damage <> 0) and (not Gear^.Invulnerable) then
+ if ((Gear^.Damage <> 0) and (not Gear^.Invulnerable)) then
begin
CheckNoDamage:= false;
@@ -167,14 +166,14 @@
if (team^.Hedgehogs[i].Gear <> nil) and (not team^.Hedgehogs[i].King)
and (team^.Hedgehogs[i].Gear^.Health > team^.Hedgehogs[i].Gear^.Damage) then
flag:= true;
- if not flag then
+ if (not flag) then
begin
inc(tmp, 5);
if (GameFlags and gfResetHealth) <> 0 then
dec(Gear^.Hedgehog^.InitialHealth, 5)
end
end;
- if tmp > 0 then
+ if tmp > 0 then
begin
inc(Gear^.Damage, min(tmp, max(0,Gear^.Health - 1 - Gear^.Damage)));
HHHurt(Gear^.Hedgehog, dsPoison);
@@ -224,12 +223,12 @@
DeleteGear(curHandledGear)
else
begin
- if curHandledGear^.Message and gmRemoveFromList <> 0 then
+ if curHandledGear^.Message and gmRemoveFromList <> 0 then
begin
RemoveGearFromList(curHandledGear);
// since I can't think of any good reason this would ever be separate from a remove from list, going to keep it inside this block
if curHandledGear^.Message and gmAddToList <> 0 then InsertGearToList(curHandledGear);
- curHandledGear^.Message:= curHandledGear^.Message and (not (gmRemoveFromList or gmAddToList))
+ curHandledGear^.Message:= (curHandledGear^.Message and (not (gmRemoveFromList or gmAddToList)))
end;
if curHandledGear^.Active then
begin
@@ -258,13 +257,13 @@
if delay = 0 then
inc(step)
end;
-
+
stChDmg:
if CheckNoDamage then
inc(step)
else
step:= stDelay;
-
+
stSweep:
if SweepDirty then
begin
@@ -273,7 +272,7 @@
end
else
inc(step);
-
+
stTurnReact:
begin
if (not bBetweenTurns) and (not isInMultiShoot) then
@@ -284,7 +283,7 @@
else
inc(step, 2);
end;
-
+
stAfterDelay:
begin
if delay = 0 then
@@ -327,12 +326,12 @@
if cHealthDecrease <> 0 then
begin
SuddenDeathDmg:= true;
-
+
// flash
ScreenFade:= sfFromWhite;
ScreenFadeValue:= sfMax;
ScreenFadeSpeed:= 1;
-
+
ChangeToSDClouds;
ChangeToSDFlakes;
glClearColor(SDSkyColor.r * (SDTint/255) / 255, SDSkyColor.g * (SDTint/255) / 255, SDSkyColor.b * (SDTint/255) / 255, 0.99);
@@ -344,7 +343,7 @@
StopMusic //No SDMusic for now
//ChangeMusic(SDMusic)
end
- else if (TotalRounds < cSuddenDTurns) and (not isInMultiShoot) then
+ else if ((TotalRounds < cSuddenDTurns) and (not isInMultiShoot)) then
begin
i:= cSuddenDTurns - TotalRounds;
s:= inttostr(i);
@@ -367,7 +366,7 @@
end;
stSpawn:
begin
- if not isInMultiShoot then
+ if (not isInMultiShoot) then
SpawnBoxOfSmth;
inc(step)
end;
@@ -417,7 +416,7 @@
CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State or gstHHChooseTarget;
isCursorVisible := true
end;
- CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State and (not gstAttacked);
+ CurrentHedgehog^.Gear^.State:= (CurrentHedgehog^.Gear^.State and (not gstAttacked));
end;
if delay2 = 0 then
begin
@@ -541,7 +540,7 @@
end;
t:= t^.NextGear
end;
-
+
if ((GameFlags and gfResetWeps) <> 0) and (not PlacingHogs) then
ResetWeapons;
@@ -610,6 +609,7 @@
var i,rx, ry: Longword;
rdx, rdy: hwFloat;
Gear: PGear;
+ temp: Longword;
begin
AddGear(0, 0, gtATStartGame, 0, _0, _0, 2000);
@@ -712,7 +712,7 @@
t^.dX:= t^.dX + Gear^.dX * dmg * _0_01 + SignAs(cHHKick, Gear^.dX);
t^.dY:= t^.dY + Gear^.dY * dmg * _0_01;
t^.State:= t^.State or gstMoving;
- if t^.Kind = gtKnife then t^.State:= t^.State and (not gstCollision);
+ if t^.Kind = gtKnife then t^.State:= (t^.State and (not gstCollision));
t^.Active:= true;
FollowGear:= t
end
@@ -770,7 +770,7 @@
if (Gear^.State and gstNoDamage) = 0 then
begin
- if (Ammo^.Kind = gtDEagleShot) or (Ammo^.Kind = gtSniperRifleShot) then
+ if (Ammo^.Kind = gtDEagleShot) or (Ammo^.Kind = gtSniperRifleShot) then
begin
VGear := AddVisualGear(hwround(Ammo^.X), hwround(Ammo^.Y), vgtBulletHit);
if VGear <> nil then
@@ -820,10 +820,10 @@
end
else
Gear^.State:= Gear^.State or gstWinner;
- if (Gear^.Kind = gtExplosives) and (Ammo^.Kind = gtBlowtorch) then
+ if (Gear^.Kind = gtExplosives) and (Ammo^.Kind = gtBlowtorch) then
begin
if (Ammo^.Hedgehog^.Gear <> nil) then
- Ammo^.Hedgehog^.Gear^.State:= Ammo^.Hedgehog^.Gear^.State and (not gstNotKickable);
+ Ammo^.Hedgehog^.Gear^.State:= (Ammo^.Hedgehog^.Gear^.State and (not gstNotKickable));
ApplyDamage(Gear, Ammo^.Hedgehog, tmpDmg * 100, dsUnknown); // crank up damage for explosives + blowtorch
end;
@@ -843,17 +843,17 @@
Gear^.Active:= true;
DeleteCI(Gear);
Gear^.State:= Gear^.State or gstMoving;
- if Gear^.Kind = gtKnife then Gear^.State:= Gear^.State and (not gstCollision);
+ if Gear^.Kind = gtKnife then Gear^.State:= (Gear^.State and (not gstCollision));
// move the gear upwards a bit to throw it over tiny obstacles at start
if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) then
begin
- if not (TestCollisionXwithXYShift(Gear, _0, -3, hwSign(Gear^.dX))
+ if (not (TestCollisionXwithXYShift(Gear, _0, -3, hwSign(Gear^.dX)))
or (TestCollisionYwithGear(Gear, -1) <> 0)) then
Gear^.Y:= Gear^.Y - _1;
- if not (TestCollisionXwithXYShift(Gear, _0, -2, hwSign(Gear^.dX))
+ if (not (TestCollisionXwithXYShift(Gear, _0, -2, hwSign(Gear^.dX)))
or (TestCollisionYwithGear(Gear, -1) <> 0)) then
Gear^.Y:= Gear^.Y - _1;
- if not (TestCollisionXwithXYShift(Gear, _0, -1, hwSign(Gear^.dX))
+ if (not (TestCollisionXwithXYShift(Gear, _0, -1, hwSign(Gear^.dX)))
or (TestCollisionYwithGear(Gear, -1) <> 0)) then
Gear^.Y:= Gear^.Y - _1;
end
@@ -944,9 +944,9 @@
s:= 0;
SetLength(GearsNearArray, s);
t := GearsList;
- while t <> nil do
+ while t <> nil do
begin
- if (t^.Kind = Kind)
+ if (t^.Kind = Kind)
and ((X - t^.X)*(X - t^.X) + (Y - t^.Y)*(Y-t^.Y) < int2hwFloat(r)) then
begin
inc(s);
@@ -967,7 +967,7 @@
while t <> nil do
begin
if (t^.Kind = gtHedgehog) and (t^.Y < Ammo^.Y) then
- if not (hwSqr(Ammo^.X - t^.X) + hwSqr(Ammo^.Y - t^.Y - int2hwFloat(cHHRadius)) * 2 > _2) then
+ if (not (hwSqr(Ammo^.X - t^.X) + hwSqr(Ammo^.Y - t^.Y - int2hwFloat(cHHRadius)) * 2 > _2)) then
begin
ApplyDamage(t, 5);
t^.dX:= t^.dX + (t^.X - Ammo^.X) * _0_02;
@@ -1038,7 +1038,7 @@
FollowGear := AddGear(x, y, gtCase, 0, _0, _0, 0);
cCaseFactor := 0;
FollowGear^.Pos := posCaseDummy;
-
+
if explode then
FollowGear^.Pos := FollowGear^.Pos + posCaseExplode;
if poison then
@@ -1232,7 +1232,7 @@
procedure chSkip(var s: shortstring);
begin
s:= s; // avoid compiler hint
-if not isExternalSource then
+if (not isExternalSource) then
SendIPC(_S',');
uStats.Skipped;
skipFlag:= true
@@ -1277,7 +1277,7 @@
// if team matches current hedgehog team, default to current hedgehog
if (i = 0) and (CurrentHedgehog <> nil) and (CurrentHedgehog^.Team = TeamsArray[t]) then
hh:= CurrentHedgehog
- else
+ else
begin
// otherwise use the first living hog or the hog amongs the remaining ones indicated by i
j:= 0;
@@ -1293,7 +1293,7 @@
inc(j)
end
end;
- if hh <> nil then
+ if hh <> nil then
begin
Gear:= AddVisualGear(0, 0, vgtSpeechBubble);
if Gear <> nil then
--- a/hedgewars/uGearsHedgehog.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uGearsHedgehog.pas Sun Jan 27 00:28:57 2013 +0100
@@ -23,17 +23,17 @@
uses uTypes;
procedure doStepHedgehog(Gear: PGear);
-procedure AfterAttack;
-procedure HedgehogStep(Gear: PGear);
-procedure doStepHedgehogMoving(Gear: PGear);
-procedure HedgehogChAngle(HHGear: PGear);
+procedure AfterAttack;
+procedure HedgehogStep(Gear: PGear);
+procedure doStepHedgehogMoving(Gear: PGear);
+procedure HedgehogChAngle(HHGear: PGear);
procedure PickUp(HH, Gear: PGear);
procedure AddPickup(HH: THedgehog; ammo: TAmmoType; cnt, X, Y: LongWord);
implementation
-uses uConsts, uVariables, uFloat, uAmmos, uSound, uCaptions,
+uses uConsts, uVariables, uFloat, uAmmos, uSound, uCaptions,
uCommands, uLocale, uUtils, uVisualGears, uStats, uIO, uScript,
- uGearsList, uGears, uCollisions, uRandom, uStore, uTeams,
+ uGearsList, uGears, uCollisions, uRandom, uStore, uTeams,
uGearsUtils;
var GHStepTicks: LongWord = 0;
@@ -66,7 +66,7 @@
MultiShootAttacks:= 0;
HHGear^.Message:= HHGear^.Message and (not (gmLJump or gmHJump));
-
+
if Ammoz[CurAmmoType].Slot = slot then
begin
i:= 0;
@@ -81,8 +81,8 @@
end;
until (i = 1) or ((Ammo^[slot, ammoidx].Count > 0)
and (Team^.Clan^.TurnNumber > Ammoz[Ammo^[slot, ammoidx].AmmoType].SkipTurns))
-
- end
+
+ end
else
begin
i:= 0;
@@ -105,7 +105,7 @@
LoadHedgehogHat(HHGear^.Hedgehog^, Hat);
end;
// Try again in the next slot
- if CurAmmoType = prevAmmo then
+ if CurAmmoType = prevAmmo then
begin
if slot >= cMaxSlotIndex then slot:= 0 else inc(slot);
HHGear^.MsgParam:= slot;
@@ -204,7 +204,7 @@
if ((State and gstHHDriven) <> 0) and ((State and (gstAttacked or gstHHChooseTarget)) = 0) and (((State and gstMoving) = 0)
or (Power > 0)
or (CurAmmoType = amTeleport)
- or
+ or
// Allow attacks while moving on ammo with AltAttack
((CurAmmoGear <> nil) and ((Ammoz[CurAmmoGear^.AmmoType].Ammo.Propz and ammoprop_AltAttack) <> 0))
or ((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AttackInMove) <> 0))
@@ -250,7 +250,7 @@
and ((Gear^.Message and gmLJump) <> 0)
and ((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AltUse) <> 0) then
begin
- newDx:= dX;
+ newDx:= dX;
newDy:= dY;
altUse:= true
end
@@ -278,15 +278,15 @@
amRope: newGear:= AddGear(hwRound(lx), hwRound(ly), gtRope, 0, xx, yy, 0);
amMine: newGear:= AddGear(hwRound(lx) + hwSign(dX) * 7, hwRound(ly), gtMine, gstWait, SignAs(_0_02, dX), _0, 3000);
amSMine: newGear:= AddGear(hwRound(lx), hwRound(ly), gtSMine, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor, 0);
- amKnife: begin
+ amKnife: begin
newGear:= AddGear(hwRound(lx), hwRound(ly), gtKnife, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor, 0);
- newGear^.State:= newGear^.State or gstMoving;
+ newGear^.State:= newGear^.State or gstMoving;
newGear^.Radius:= 6 // temporarily shrink so it doesn't instantly embed in the ground
end;
amDEagle: newGear:= AddGear(hwRound(lx + xx * cHHRadius), hwRound(ly + yy * cHHRadius), gtDEagleShot, 0, xx * _0_5, yy * _0_5, 0);
amSineGun: newGear:= AddGear(hwRound(lx + xx * cHHRadius), hwRound(ly + yy * cHHRadius), gtSineGunShot, 0, xx * _0_5, yy * _0_5, 0);
amPortalGun: begin
- newGear:= AddGear(hwRound(lx + xx * cHHRadius), hwRound(ly + yy * cHHRadius), gtPortal, 0, xx * _0_6, yy * _0_6,
+ newGear:= AddGear(hwRound(lx + xx * cHHRadius), hwRound(ly + yy * cHHRadius), gtPortal, 0, xx * _0_6, yy * _0_6,
// set selected color
CurWeapon^.Pos);
end;
@@ -346,7 +346,7 @@
cGravity:= cMaxWindSpeed;
cGravityf:= 0.00025
end;
- amExtraDamage: begin
+ amExtraDamage: begin
PlaySound(sndHellishImpact4);
cDamageModifier:= _1_5
end;
@@ -383,11 +383,11 @@
newGear^.dX:= newDx / newGear^.Density;
newGear^.dY:= newDY / newGear^.Density
end;
-
+
case CurAmmoType of
- amGrenade, amMolotov,
- amClusterBomb, amGasBomb,
- amBazooka, amSnowball,
+ amGrenade, amMolotov,
+ amClusterBomb, amGasBomb,
+ amBazooka, amSnowball,
amBee, amSMine,
amMortar, amWatermelon,
amHellishBomb, amDrill: FollowGear:= newGear;
@@ -408,7 +408,7 @@
amTardis, amPiano,
amIceGun: CurAmmoGear:= newGear;
end;
-
+
if ((CurAmmoType = amMine) or (CurAmmoType = amSMine)) and (GameFlags and gfInfAttack <> 0) then
newGear^.FlightTime:= GameTicks + 1000
else if CurAmmoType = amDrill then
@@ -432,7 +432,7 @@
newGear^.Elasticity:= newGear^.Elasticity * elastic
else if elastic > _1 then
newGear^.Elasticity:= _1 - ((_1-newGear^.Elasticity) / elastic);
-(* Experimented with friction modifier. Didn't seem helpful
+(* Experimented with friction modifier. Didn't seem helpful
fric:= int2hwfloat(CurWeapon^.Bounciness) / _250;
if fric < _1 then newGear^.Friction:= newGear^.Friction * fric
else if fric > _1 then newGear^.Friction:= _1 - ((_1-newGear^.Friction) / fric)*)
@@ -468,7 +468,7 @@
AfterAttack;
end
end
- else
+ else
Message:= Message and (not gmAttack);
end;
TargetPoint.X := NoPointX;
@@ -488,13 +488,13 @@
if (Ammoz[a].Ammo.Propz and ammoprop_Effect) = 0 then
begin
Inc(MultiShootAttacks);
-
+
if (Ammoz[a].Ammo.NumPerTurn >= MultiShootAttacks) then
begin
s:= inttostr(Ammoz[a].Ammo.NumPerTurn - MultiShootAttacks + 1);
AddCaption(format(trmsg[sidRemaining], s), cWhiteColor, capgrpAmmostate);
end;
-
+
if (Ammoz[a].Ammo.NumPerTurn >= MultiShootAttacks)
or ((GameFlags and gfMultiWeapon) <> 0) then
begin
@@ -509,7 +509,7 @@
TagTurnTimeLeft:= TurnTimeLeft;
TurnTimeLeft:=(Ammoz[a].TimeAfterTurn * cGetAwayTime) div 100;
end;
- if ((Ammoz[a].Ammo.Propz and ammoprop_NoRoundEnd) = 0) and (HHGear <> nil) then
+ if ((Ammoz[a].Ammo.Propz and ammoprop_NoRoundEnd) = 0) and (HHGear <> nil) then
HHGear^.State:= HHGear^.State or gstAttacked;
if (Ammoz[a].Ammo.Propz and ammoprop_NoRoundEnd) <> 0 then
ApplyAmmoChanges(CurrentHedgehog^)
@@ -537,7 +537,7 @@
dec(Gear^.Timer);
if (Gear^.Timer mod frametime) = 0 then
inc(Gear^.Pos)
- end
+ end
else if Gear^.Timer = 1 then
begin
Gear^.State:= Gear^.State or gstNoDamage;
@@ -545,7 +545,7 @@
AddGear(hwRound(Gear^.X), hwRound(Gear^.Y), gtGrave, 0, _0, _0, 0)^.Hedgehog:= Gear^.Hedgehog;
DeleteGear(Gear);
SetAllToActive
- end
+ end
else // Gear^.Timer = 0
begin
AllInactive:= false;
@@ -598,7 +598,7 @@
if cnt <> 0 then AddAmmo(HH, ammo, cnt)
else AddAmmo(HH, ammo);
- if (not (HH.Team^.ExtDriven
+ if (not (HH.Team^.ExtDriven
or (HH.BotLevel > 0)))
or (HH.Team^.Clan^.ClanIndex = LocalClan)
or (GameType = gmtDemo) then
@@ -636,7 +636,7 @@
posCaseUtility,
posCaseAmmo: begin
PlaySound(sndShotgunReload);
- if Gear^.AmmoType <> amNothing then
+ if Gear^.AmmoType <> amNothing then
begin
AddPickup(HH^.Hedgehog^, Gear^.AmmoType, Gear^.Power, hwRound(Gear^.X), hwRound(Gear^.Y));
end
@@ -644,7 +644,7 @@
begin
// Add spawning here...
AddRandomness(GameTicks);
-
+
gi := GearsList;
while gi <> nil do
begin
@@ -759,7 +759,7 @@
if (Gear^.Message and gmLeft )<>0 then
Gear^.dX:= -cLittle else
if (Gear^.Message and gmRight )<>0 then
- Gear^.dX:= cLittle
+ Gear^.dX:= cLittle
else exit;
StepSoundTimer:= cHHStepTicks;
@@ -826,7 +826,7 @@
Gear^.dY:= _0;
Gear^.State:= Gear^.State or gstMoving;
if (CurrentHedgehog^.Gear = Gear)
- and (hwSqr(Gear^.dX) + hwSqr(Gear^.dY) > _0_003) then
+ and (hwSqr(Gear^.dX) + hwSqr(Gear^.dY) > _0_003) then
begin
// TODO: why so aggressive at setting FollowGear when falling?
FollowGear:= Gear;
@@ -842,7 +842,7 @@
or ((Gear^.dY.QWordValue + Gear^.dX.QWordValue) > _0_55.QWordValue))) then
Gear^.dX := Gear^.dX + cWindSpeed / Gear^.Density
end
- end
+ end
else
begin
land:= TestCollisionYwithGear(Gear, 1);
@@ -899,7 +899,7 @@
Gear^.X:= Gear^.X + Gear^.dX;
Gear^.dX:= Gear^.dX * _0_93;
Gear^.Y:= Gear^.Y - _2
- end
+ end
else
if not TestCollisionXwithXYShift(Gear, int2hwFloat(hwSign(Gear^.dX)) - Gear^.dX, -3, hwSign(Gear^.dX)) then
begin
@@ -963,7 +963,7 @@
// ARTILLERY but not being moved by explosions
Gear^.X:= Gear^.X + Gear^.dX;
Gear^.Y:= Gear^.Y + Gear^.dY;
- if (not Gear^.dY.isNegative) and (not TestCollisionYKick(Gear, 1))
+ if (not Gear^.dY.isNegative) and (not TestCollisionYKick(Gear, 1))
and TestCollisionYwithXYShift(Gear, 0, 1, 1) then
begin
CheckHHDamage(Gear);
@@ -1003,7 +1003,7 @@
if isInMultiShoot then
HHGear^.Message:= 0;
-if ((Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_Utility) <> 0) and isInMultiShoot then
+if ((Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_Utility) <> 0) and isInMultiShoot then
AllInactive:= true
else if not isInMultiShoot then
AllInactive:= false;
@@ -1057,7 +1057,7 @@
or ((HHGear^.State and gstAttacking) <> 0)) then
Attack(HHGear) // should be before others to avoid desync with '/put' msg and changing weapon msgs
else
-else
+else
with Hedgehog^ do
if ((Ammoz[CurAmmoGear^.AmmoType].Ammo.Propz and ammoprop_AltAttack) <> 0)
and ((HHGear^.Message and gmLJump) <> 0)
@@ -1122,7 +1122,7 @@
exit
end;
- if not isInMultiShoot and (Hedgehog^.Gear <> nil) then
+ if (not isInMultiShoot) and (Hedgehog^.Gear <> nil) then
begin
if GHStepTicks > 0 then
dec(GHStepTicks);
@@ -1163,7 +1163,7 @@
begin
ResurrectHedgehog(Gear);
end
- else
+ else
begin
Gear^.State:= (Gear^.State or gstHHDeath) and (not gstAnimation);
Gear^.doStep:= @doStepHedgehogDead;
@@ -1208,9 +1208,9 @@
procedure doStepHedgehog(Gear: PGear);
(*
var x,y,tx,ty: LongInt;
- tdX, tdY, slope: hwFloat;
+ tdX, tdY, slope: hwFloat;
land: Word; *)
-var slope: hwFloat;
+var slope: hwFloat;
begin
CheckSum:= CheckSum xor Gear^.Hedgehog^.BotLevel;
if (Gear^.Message and gmDestroy) <> 0 then
--- a/hedgewars/uGearsList.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uGearsList.pas Sun Jan 27 00:28:57 2013 +0100
@@ -36,7 +36,7 @@
uGearsRender, uGearsUtils, uDebug;
const
- GearKindAmmoTypeMap : array [TGearType] of TAmmoType = (
+ GearKindAmmoTypeMap : array [TGearType] of TAmmoType = (
(* gtFlame *) amNothing
(* gtHedgehog *) , amNothing
(* gtMine *) , amMine
@@ -158,8 +158,10 @@
var gear: PGear;
begin
inc(GCounter);
+
AddFileLog('AddGear: #' + inttostr(GCounter) + ' (' + inttostr(x) + ',' + inttostr(y) + '), d(' + floattostr(dX) + ',' + floattostr(dY) + ') type = ' + EnumToStr(Kind));
+
New(gear);
FillChar(gear^, sizeof(TGear), 0);
gear^.X:= int2hwFloat(X);
@@ -181,7 +183,7 @@
gear^.AmmoType:= GearKindAmmoTypeMap[Kind];
gear^.CollisionMask:= $FFFF;
-if CurrentHedgehog <> nil then
+if CurrentHedgehog <> nil then
begin
gear^.Hedgehog:= CurrentHedgehog;
if (CurrentHedgehog^.Gear <> nil) and (hwRound(CurrentHedgehog^.Gear^.X) = X) and (hwRound(CurrentHedgehog^.Gear^.Y) = Y) then
@@ -192,7 +194,7 @@
gear^.Z:= cHHZ+1
else gear^.Z:= cUsualZ;
-
+
case Kind of
gtGrenade,
gtClusterBomb,
@@ -602,7 +604,7 @@
begin
t:= max(Gear^.Damage, Gear^.Health);
Gear^.Damage:= t;
- if ((not SuddenDeathDmg and (WaterOpacity < $FF)) or (SuddenDeathDmg and (WaterOpacity < $FF)))
+ if (((not SuddenDeathDmg) and (WaterOpacity < $FF)) or (SuddenDeathDmg and (WaterOpacity < $FF)))
and (hwRound(Gear^.Y) < cWaterLine + 256) then
spawnHealthTagForHH(Gear, t);
end;
@@ -645,7 +647,7 @@
if (CurrentHedgehog <> nil) and (CurrentHedgehog^.Effects[heResurrectable] <> 0) and
//(Gear^.Hedgehog^.Effects[heResurrectable] = 0) then
(Gear^.Hedgehog^.Team^.Clan <> CurrentHedgehog^.Team^.Clan) then
- with CurrentHedgehog^ do
+ with CurrentHedgehog^ do
begin
inc(Team^.stats.AIKills);
FreeTexture(Team^.AIKillsTex);
--- a/hedgewars/uGearsRender.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uGearsRender.pas Sun Jan 27 00:28:57 2013 +0100
@@ -23,18 +23,21 @@
interface
uses uTypes, uConsts, GLunit, uFloat, SDLh;
+type
+ Tar = record
+ X, Y: hwFloat;
+ dLen: hwFloat;
+ b : boolean;
+ end;
+ TRopePoints = record
+ Count : Longword;
+ HookAngle : GLfloat;
+ ar : array[0..MAXROPEPOINTS] of Tar;
+ rounded : array[0..MAXROPEPOINTS + 2] of TVertex2f;
+ end;
procedure RenderGear(Gear: PGear; x, y: LongInt);
-var RopePoints: record
- Count: Longword;
- HookAngle: GLfloat;
- ar: array[0..MAXROPEPOINTS] of record
- X, Y: hwFloat;
- dLen: hwFloat;
- b: boolean;
- end;
- rounded: array[0..MAXROPEPOINTS + 2] of TVertex2f;
- end;
+var RopePoints: TRopePoints;
implementation
uses uRender, uUtils, uVariables, uAmmos, Math, uVisualGears;
@@ -90,6 +93,7 @@
if (X1 = X2) and (Y1 = Y2) then
begin
//OutError('WARNING: zero length rope line!', false);
+ DrawRopeLine := 0;
exit
end;
eX:= 0;
@@ -107,7 +111,7 @@
end
else sX:= dX;
- if (dY > 0) then
+ if (dY > 0) then
sY:= 1
else
if (dY < 0) then
@@ -115,7 +119,7 @@
sY:= -1;
dY:= -dY
end
- else
+ else
sY:= dY;
if (dX > dY) then
@@ -348,8 +352,8 @@
// draw crosshair
CrosshairX := Round(hwRound(Gear^.X) + dx * 80 + GetLaunchX(HH^.CurAmmoType, sign * m, Gear^.Angle));
CrosshairY := Round(hwRound(Gear^.Y) + dy * 80 + GetLaunchY(HH^.CurAmmoType, Gear^.Angle));
-
-
+
+
DrawTextureRotated(HH^.Team^.CrosshairTex,
12, 12, CrosshairX + WorldDx, CrosshairY + WorldDy, 0,
sign * (Gear^.Angle * 180.0) / cMaxAngle);
@@ -624,13 +628,13 @@
amShotgun: DrawSpriteRotated(sprHandShotgun, hx, hy, sign, aangle);
amDEagle: DrawSpriteRotated(sprHandDEagle, hx, hy, sign, aangle);
amSineGun: DrawSpriteRotatedF(sprHandSinegun, hx, hy, 73 + (sign * LongInt(RealTicks div 73)) mod 8, sign, aangle);
-
+
amPortalGun:
if (CurWeapon^.Timer and 2) <> 0 then // Add a new Hedgehog value instead of abusing timer?
DrawSpriteRotatedF(sprPortalGun, hx, hy, 0, sign, aangle)
else
DrawSpriteRotatedF(sprPortalGun, hx, hy, 1+CurWeapon^.Pos, sign, aangle);
-
+
amSniperRifle: DrawSpriteRotatedF(sprSniperRifle, hx, hy, 0, sign, aangle);
amBlowTorch: DrawSpriteRotated(sprHandBlowTorch, hx, hy, sign, aangle);
amCake: DrawSpriteRotated(sprHandCake, hx, hy, sign, aangle);
@@ -646,7 +650,7 @@
amKnife: DrawSpriteRotatedF(sprHandKnife, hx, hy, 0, sign, aangle);
amSeduction: begin
DrawSpriteRotated(sprHandSeduction, hx, hy, sign, aangle);
- DrawCircle(ox, oy, 248, 4, $FF, $00, $00, $AA);
+ DrawCircle(ox, oy, 248, 4, $FF, $00, $00, $AA);
//Tint($FF, $0, $0, $AA);
//DrawTexture(ox - 240, oy - 240, SpritesData[sprVampiric].Texture, 10);
//Tint($FF, $FF, $FF, $FF);
@@ -939,8 +943,8 @@
if Gear^.Target.X <> NoPointX then
if Gear^.AmmoType = amBee then
DrawSpriteRotatedF(sprTargetBee, Gear^.Target.X + WorldDx, Gear^.Target.Y + WorldDy, 0, 0, (RealTicks shr 3) mod 360)
- else if Gear^.AmmoType = amIceGun then
- //DrawSprite(sprSnowDust, Gear^.Target.X + WorldDx, Gear^.Target.Y + WorldDy, (RealTicks shr 2) mod 8)
+ else if Gear^.AmmoType = amIceGun then
+ //DrawSprite(sprSnowDust, Gear^.Target.X + WorldDx, Gear^.Target.Y + WorldDy, (RealTicks shr 2) mod 8)
//DrawTextureRotatedF(SpritesData[sprSnowDust].Texture, 1, 0, 0, Gear^.Target.X + WorldDx, Gear^.Target.Y + WorldDy, (RealTicks shr 2) mod 8, 1, 22, 22, (RealTicks shr 3) mod 360)
DrawTextureRotatedF(SpritesData[sprSnowDust].Texture, 1/(1+(RealTicks shr 8) mod 5), 0, 0, Gear^.Target.X + WorldDx, Gear^.Target.Y + WorldDy, (RealTicks shr 2) mod 8, 1, 22, 22, (RealTicks shr 3) mod 360)
else
@@ -950,7 +954,7 @@
gtGrenade: DrawSpriteRotated(sprBomb, x, y, 0, Gear^.DirAngle);
gtSnowball: DrawSpriteRotated(sprSnowball, x, y, 0, Gear^.DirAngle);
gtGasBomb: DrawSpriteRotated(sprCheese, x, y, 0, Gear^.DirAngle);
-
+
gtMolotov: if (Gear^.State and gstDrowning) = 0 then
DrawSpriteRotatedF(sprMolotov, x, y, (RealTicks div 125) mod 8, hwSign(Gear^.dX), Gear^.DirAngle * hwSign(Gear^.dX))
else DrawSprite(sprMolotov, x, y, 8);
@@ -994,20 +998,20 @@
gtBee: DrawSpriteRotatedF(sprBee, x, y, (GameTicks shr 5) mod 2, 0, DxDy2Angle(Gear^.dY, Gear^.dX));
gtPickHammer: DrawSprite(sprPHammer, x - 16, y - 50 + LongInt(((GameTicks shr 5) and 1) * 2), 0);
gtRope: DrawRope(Gear);
-
+
gtMine: if (((Gear^.State and gstAttacking) = 0)or((Gear^.Timer and $3FF) < 420)) and (Gear^.Health <> 0) then
DrawSpriteRotated(sprMineOff, x, y, 0, Gear^.DirAngle)
else if Gear^.Health <> 0 then
DrawSpriteRotated(sprMineOn, x, y, 0, Gear^.DirAngle)
else DrawSpriteRotated(sprMineDead, x, y, 0, Gear^.DirAngle);
-
+
gtSMine: if (((Gear^.State and gstAttacking) = 0)or((Gear^.Timer and $3FF) < 420)) and (Gear^.Health <> 0) then
DrawSpriteRotated(sprSMineOff, x, y, 0, Gear^.DirAngle)
else if Gear^.Health <> 0 then
DrawSpriteRotated(sprSMineOn, x, y, 0, Gear^.DirAngle)
else DrawSpriteRotated(sprMineDead, x, y, 0, Gear^.DirAngle);
gtKnife: DrawSpriteRotatedF(sprKnife, x, y, 0, hwSign(Gear^.dX), Gear^.DirAngle);
-
+
gtCase: begin
if Gear^.Timer > 1000 then
begin
@@ -1091,7 +1095,7 @@
DrawSpriteRotatedF(sprCakeDown, x, y, 5 - Gear^.Pos, hwSign(Gear^.dX), Gear^.DirAngle * hwSign(Gear^.dX) + 90);
gtSeduction: if Gear^.Pos >= 14 then
DrawSprite(sprSeduction, x - 16, y - 16, 0);
-
+
gtWatermelon: DrawSpriteRotatedF(sprWatermelon, x, y, 0, 0, Gear^.DirAngle);
gtMelonPiece: DrawSpriteRotatedF(sprWatermelon, x, y, 1, 0, Gear^.DirAngle);
gtHellishBomb: DrawSpriteRotated(sprHellishBomb, x, y, 0, Gear^.DirAngle);
@@ -1159,9 +1163,9 @@
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,
+ Tint((ExplosionBorderColor shr RShift) and $FF,
+ (ExplosionBorderColor shr GShift) and $FF,
+ (ExplosionBorderColor shr BShift) and $FF,
$FF);
// Needs a nicer white texture to tint
DrawTextureRotatedF(SpritesData[sprSnowDust].Texture, 1, 0, 0, x, y, 0, 1, 8, 8, Gear^.DirAngle);
@@ -1173,7 +1177,7 @@
begin
if isInLag and (Gear^.FlightTime < 256) then
inc(Gear^.FlightTime, 8)
- else if not isInLag and (Gear^.FlightTime > 0) then
+ else if (not isInLag) and (Gear^.FlightTime > 0) then
dec(Gear^.FlightTime, 8);
if Gear^.FlightTime > 0 then
Tint($FF, $FF, $FF, $FF-min(255,Gear^.FlightTime));
@@ -1191,7 +1195,7 @@
begin
if Gear^.Pos = 2 then
Tint(Gear^.Hedgehog^.Team^.Clan^.Color shl 8 or $FF)
- else
+ else
Tint(Gear^.Hedgehog^.Team^.Clan^.Color shl 8 or max($00, round(Gear^.Power * (1-abs(0.5 - (GameTicks mod 2000) / 2000)))));
DrawSprite(sprTardis, x-24, y-63,0);
if Gear^.Pos = 2 then
--- a/hedgewars/uGearsUtils.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uGearsUtils.pas Sun Jan 27 00:28:57 2013 +0100
@@ -23,7 +23,7 @@
uses uTypes;
procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword); inline;
-procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord);
+procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord);
function ModifyDamage(dmg: Longword; Gear: PGear): Longword;
procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
@@ -233,7 +233,7 @@
end;
end
end;
- if ((GameFlags and gfKarma) <> 0) and
+ if ((GameFlags and gfKarma) <> 0) and
((GameFlags and gfInvulnerable) = 0)
and (not CurrentHedgehog^.Gear^.Invulnerable) then
begin // this cannot just use Damage or it interrupts shotgun and gets you called stupid
@@ -241,13 +241,13 @@
CurrentHedgehog^.Gear^.LastDamage := CurrentHedgehog;
spawnHealthTagForHH(CurrentHedgehog^.Gear, tmpDmg);
end;
- uStats.HedgehogDamaged(Gear, AttackerHog, Damage, false);
+ uStats.HedgehogDamaged(Gear, AttackerHog, Damage, false);
end;
end else
//else if Gear^.Kind <> gtStructure then // not gtHedgehog nor gtStructure
Gear^.Hedgehog:= AttackerHog;
inc(Gear^.Damage, Damage);
-
+
ScriptCall('onGearDamage', Gear^.UID, Damage);
end;
@@ -260,7 +260,7 @@
AllInactive:= false;
HHGear^.Active:= true;
end;
-
+
procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource);
begin
if (Source = dsFall) or (Source = dsExplosion) then
@@ -284,7 +284,7 @@
end;
procedure CheckHHDamage(Gear: PGear);
-var
+var
dmg: Longword;
i: LongWord;
particle: PVisualGear;
@@ -320,7 +320,7 @@
procedure CalcRotationDirAngle(Gear: PGear);
-var
+var
dAngle: real;
begin
// Frac/Round to be kind to JS as of 2012-08-27 where there is yet no int64/uint64
@@ -338,7 +338,7 @@
end;
function CheckGearDrowning(Gear: PGear): boolean;
-var
+var
skipSpeed, skipAngle, skipDecay: hwFloat;
i, maxDrops, X, Y: LongInt;
vdX, vdY: real;
@@ -401,14 +401,14 @@
else
Gear^.doStep := @doStepDrowningGear;
if Gear^.Kind = gtFlake then
- exit // skip splashes
+ exit // skip splashes
end;
if ((not isSubmersible) and (Y < cWaterLine + 64 + Gear^.Radius))
or (isSubmersible and (Y < cWaterLine + 2 + Gear^.Radius) and ((CurAmmoGear^.Pos = 0)
and (CurAmmoGear^.dY < _0_01))) then
if Gear^.Density * Gear^.dY > _1 then
PlaySound(sndSplash)
- else if Gear^.Density * Gear^.dY > _0_5 then
+ else if Gear^.Density * Gear^.dY > _0_5 then
PlaySound(sndSkip)
else
PlaySound(sndDroplet2);
@@ -420,7 +420,7 @@
and (CurAmmoGear^.dY < _0_01)))) then
begin
splash:= AddVisualGear(X, cWaterLine, vgtSplash);
- if splash <> nil then
+ if splash <> nil then
with splash^ do
begin
Scale:= hwFloat2Float(Gear^.Density / _3 * Gear^.dY);
@@ -443,12 +443,12 @@
dY := dY - vdY / 5;
if splash <> nil then
begin
- if splash^.Scale > 1 then
+ if splash^.Scale > 1 then
begin
dX:= dX * power(splash^.Scale,0.3333); // tone down the droplet height further
dY:= dY * power(splash^.Scale, 0.3333)
end
- else
+ else
begin
dX:= dX * splash^.Scale;
dY:= dY * splash^.Scale
@@ -482,7 +482,7 @@
gear^.Hedgehog^.Effects[hePoisoned] := 0;
if (CurrentHedgehog^.Effects[heResurrectable] = 0) or ((CurrentHedgehog^.Effects[heResurrectable] <> 0)
and (Gear^.Hedgehog^.Team^.Clan <> CurrentHedgehog^.Team^.Clan)) then
- with CurrentHedgehog^ do
+ with CurrentHedgehog^ do
begin
inc(Team^.stats.AIKills);
FreeTexture(Team^.AIKillsTex);
@@ -499,7 +499,7 @@
sparkles^.Tint:= tempTeam^.Clan^.Color shl 8 or $FF;
//sparkles^.Angle:= random(360);
end;
- FindPlace(gear, false, 0, LAND_WIDTH, true);
+ FindPlace(gear, false, 0, LAND_WIDTH, true);
if gear <> nil then
begin
AddVisualGear(hwRound(gear^.X), hwRound(gear^.Y), vgtExplosion);
@@ -557,6 +557,7 @@
y, sy: LongInt;
ar: array[0..1023] of TPoint;
ar2: array[0..2047] of TPoint;
+ temp: TPoint;
cnt, cnt2: Longword;
delta: LongInt;
ignoreNearObjects, ignoreOverlap, tryAgain: boolean;
@@ -579,7 +580,7 @@
repeat
inc(y, 2);
until (y >= cWaterLine) or
- (not ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) = 0)) or
+ ((not ignoreOverlap) and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) = 0)) or
(ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FF00) = 0));
sy:= y;
@@ -587,8 +588,8 @@
repeat
inc(y);
until (y >= cWaterLine) or
- (not ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) <> 0)) or
- (ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FF00) <> 0));
+ ((not ignoreOverlap) and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FFFF) <> 0)) or
+ (ignoreOverlap and (CountNonZeroz(x, y, Gear^.Radius - 1, 1, $FF00) <> 0));
if (y - sy > Gear^.Radius * 2)
and (((Gear^.Kind = gtExplosives)
@@ -613,12 +614,15 @@
end;
if cnt > 0 then
- with ar[GetRandom(cnt)] do
+ begin
+ temp := ar[GetRandom(cnt)];
+ with temp do
begin
ar2[cnt2].x:= x;
ar2[cnt2].y:= y;
inc(cnt2)
- end
+ end
+ end
until (x + Delta > Right);
dec(Delta, 60)
@@ -632,12 +636,15 @@
end;
if cnt2 > 0 then
- with ar2[GetRandom(cnt2)] do
+ begin
+ temp := ar2[GetRandom(cnt2)];
+ with temp do
begin
Gear^.X:= int2hwFloat(x);
Gear^.Y:= int2hwFloat(y);
AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
end
+ end
else
begin
OutError('Can''t find place for Gear', false);
@@ -683,7 +690,7 @@
if TestCollisionX(Gear, hwSign(Gear^.dX))
or TestCollisionY(Gear, hwSign(Gear^.dY)) then
Gear^.State := Gear^.State or gstCollision
- else
+ else
Gear^.State := Gear^.State and (not gstCollision)
end;
--- a/hedgewars/uIO.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uIO.pas Sun Jan 27 00:28:57 2013 +0100
@@ -20,7 +20,7 @@
unit uIO;
interface
-uses SDLh, uTypes;
+uses SDLh, uTypes, uMisc;
procedure initModule;
procedure freeModule;
@@ -117,6 +117,7 @@
procedure ParseIPCCommand(s: shortstring);
var loTicks: Word;
begin
+
case s[1] of
'!': begin AddFileLog('Ping? Pong!'); isPonged:= true; end;
'?': SendIPC(_S'!');
@@ -172,10 +173,11 @@
end;
procedure LoadRecordFromFile(fileName: shortstring);
-var f: file;
- ss: shortstring = '';
- i: LongInt;
- s: shortstring;
+var f : File;
+ ss : shortstring = '';
+ i : LongInt;
+ s : shortstring;
+ t, tt : string;
begin
// set RDNLY on file open
@@ -183,7 +185,6 @@
{$I-}
assign(f, fileName);
reset(f, 1);
-
tryDo(IOResult = 0, 'Error opening file ' + fileName, true);
i:= 0; // avoid compiler hints
@@ -191,13 +192,13 @@
repeat
BlockRead(f, s[1], 255 - Length(ss), i);
if i > 0 then
- begin
+ begin
s[0]:= char(i);
ss:= ss + s;
while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
begin
ParseIPCCommand(copy(ss, 2, byte(ss[1])));
- Delete(ss, 1, Succ(byte(ss[1])))
+ Delete(ss, 1, Succ(byte(ss[1])));
end
end
until i = 0;
@@ -222,11 +223,12 @@
SendEmptyPacketTicks:= 0;
if s[0]>#251 then
s[0]:= #251;
-
+
SDLNet_Write16(GameTicks, @s[Succ(byte(s[0]))]);
AddFileLog('[IPC out] '+ s[1]);
inc(s[0], 2);
- SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])))
+ SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])));
+ //log('SendIPC');
end
end;
@@ -382,7 +384,7 @@
if CheckNoTeamOrHH or isPaused then
exit;
bShowFinger:= false;
-if not CurrentTeam^.ExtDriven and bShowAmmoMenu then
+if (not CurrentTeam^.ExtDriven) and bShowAmmoMenu then
begin
bSelected:= true;
exit
@@ -432,9 +434,10 @@
lastcmd:= nil;
isPonged:= false;
SocketString:= '';
-
+
hiTicks:= 0;
SendEmptyPacketTicks:= 0;
+
end;
procedure freeModule;
@@ -443,6 +446,7 @@
SDLNet_FreeSocketSet(fds);
SDLNet_TCP_Close(IPCSock);
SDLNet_Quit();
+
end;
end.
--- a/hedgewars/uInputHandler.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uInputHandler.pas Sun Jan 27 00:28:57 2013 +0100
@@ -55,7 +55,7 @@
LALT = $0800;
RALT = $1000;
LCTRL = $2000;
- RCTRL = $4000;
+ RCTRL = $4000;
var tkbd: array[0..cKbdMaxIndex] of boolean;
quitKeyCode, closeKeyCode: Byte;
@@ -91,12 +91,12 @@
(*
procedure MaskModifier(var code: LongInt; Modifier: LongWord);
begin
- if(Modifier and KMOD_LSHIFT) <> 0 then code:= code or LSHIFT;
- if(Modifier and KMOD_RSHIFT) <> 0 then code:= code or LSHIFT;
- if(Modifier and KMOD_LALT) <> 0 then code:= code or LALT;
- if(Modifier and KMOD_RALT) <> 0 then code:= code or LALT;
- if(Modifier and KMOD_LCTRL) <> 0 then code:= code or LCTRL;
- if(Modifier and KMOD_RCTRL) <> 0 then code:= code or LCTRL;
+ if(Modifier and KMOD_LSHIFT) <> 0 then code:= code or LSHIFT;
+ if(Modifier and KMOD_RSHIFT) <> 0 then code:= code or LSHIFT;
+ if(Modifier and KMOD_LALT) <> 0 then code:= code or LALT;
+ if(Modifier and KMOD_RALT) <> 0 then code:= code or LALT;
+ if(Modifier and KMOD_LCTRL) <> 0 then code:= code or LCTRL;
+ if(Modifier and KMOD_RCTRL) <> 0 then code:= code or LCTRL;
end;
*)
procedure MaskModifier(Modifier: shortstring; var code: LongInt);
@@ -112,7 +112,7 @@
SplitByChar(Modifier, mod_, ':');//remove the first mod: part
Modifier:= mod_;
for i:= 0 to ModifierCount do
- begin
+ begin
mod_:= '';
SplitByChar(Modifier, mod_, ':');
if (Modifier = 'lshift') then code:= code or LSHIFT;
@@ -233,7 +233,7 @@
s:= shortstring(sdl_getkeyname(i));
//WriteLnToConsole('uInputHandler - ' + IntToStr(i) + ': ' + s + ' ' + IntToStr(cKeyMaxIndex));
if s = 'unknown key' then KeyNames[i]:= ''
- else
+ else
begin
for t:= 1 to Length(s) do
if s[t] = ' ' then
@@ -393,10 +393,10 @@
if ControllerNumAxes[j] > 20 then
ControllerNumAxes[j]:= 20;
//if ControllerNumBalls[j] > 20 then ControllerNumBalls[j]:= 20;
-
+
if ControllerNumHats[j] > 20 then
ControllerNumHats[j]:= 20;
-
+
if ControllerNumButtons[j] > 20 then
ControllerNumButtons[j]:= 20;
--- a/hedgewars/uLand.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uLand.pas Sun Jan 27 00:28:57 2013 +0100
@@ -37,7 +37,7 @@
procedure ResizeLand(width, height: LongWord);
var potW, potH: LongInt;
-begin
+begin
potW:= toPowerOf2(width);
potH:= toPowerOf2(height);
if (potW <> LAND_WIDTH) or (potH <> LAND_HEIGHT) then
@@ -240,6 +240,7 @@
rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
topY:= LAND_HEIGHT - playHeight;
+
// HACK: force to only cavern even if a cavern map is invertable if cTemplateFilter = 4 ?
if (cTemplateFilter = 4)
or (Template.canInvert and (getrandom(2) = 0))
@@ -339,7 +340,7 @@
SDL_FreeSurface(tmpsurf);
for x:= leftX+2 to rightX-2 do
for y:= topY+2 to LAND_HEIGHT-3 do
- if (Land[y, x] = 0) and
+ if (Land[y, x] = 0) and
(((Land[y, x-1] = lfBasic) and ((Land[y+1,x] = lfBasic)) or (Land[y-1,x] = lfBasic)) or
((Land[y, x+1] = lfBasic) and ((Land[y-1,x] = lfBasic) or (Land[y+1,x] = lfBasic)))) then
begin
@@ -347,16 +348,16 @@
begin
if (Land[y, x-1] = lfBasic) and (LandPixels[y, x-1] and AMask <> 0) then
LandPixels[y, x]:= LandPixels[y, x-1]
-
+
else if (Land[y, x+1] = lfBasic) and (LandPixels[y, x+1] and AMask <> 0) then
LandPixels[y, x]:= LandPixels[y, x+1]
-
+
else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1, x] and AMask <> 0) then
LandPixels[y, x]:= LandPixels[y-1, x]
-
+
else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1, x] and AMask <> 0) then
LandPixels[y, x]:= LandPixels[y+1, x];
-
+
if (((LandPixels[y,x] and AMask) shr AShift) > 10) then
LandPixels[y,x]:= (LandPixels[y,x] and (not AMask)) or (128 shl AShift)
end;
@@ -371,25 +372,25 @@
((Land[y-1, x] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or
((Land[y+1, x] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic)) or
((Land[y-1, x] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic))) then
-
+
begin
-
+
if (cReducedQuality and rqBlurryLand) = 0 then
-
+
begin
-
+
if (Land[y, x-1] = lfBasic) and (LandPixels[y,x-1] and AMask <> 0) then
LandPixels[y, x]:= LandPixels[y, x-1]
-
+
else if (Land[y, x+1] = lfBasic) and (LandPixels[y,x+1] and AMask <> 0) then
LandPixels[y, x]:= LandPixels[y, x+1]
-
+
else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1,x] and AMask <> 0) then
LandPixels[y, x]:= LandPixels[y+1, x]
-
+
else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1,x] and AMask <> 0) then
LandPixels[y, x]:= LandPixels[y-1, x];
-
+
if (((LandPixels[y,x] and AMask) shr AShift) > 10) then
LandPixels[y,x]:= (LandPixels[y,x] and (not AMask)) or (64 shl AShift)
end;
@@ -487,7 +488,7 @@
for x:= 0 to Pred(tmpsurf^.w) do
begin
// this an if instead of masking colours to avoid confusing map creators
- if ((AMask and p^[x]) = 0) then
+ if ((AMask and p^[x]) = 0) then
Land[cpY + y, cpX + x]:= 0
else if p^[x] = $FFFFFFFF then // white
Land[cpY + y, cpX + x]:= lfObject
@@ -552,9 +553,11 @@
LAND_HEIGHT - tmpsurf^.h,
tmpsurf^.w,
tmpsurf);
+
SDL_FreeSurface(tmpsurf);
LoadMask;
+
end;
procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
@@ -619,7 +622,6 @@
MakeFortsMap;
AddProgress;
-
// check for land near top
c:= 0;
if (GameFlags and gfBorder) <> 0 then
@@ -692,7 +694,7 @@
if (GameFlags and gfForts = 0) and (maskOnly or (cPathz[ptMapCurrent] = '')) then
AddObjects
-
+
else
AddProgress();
@@ -748,7 +750,7 @@
rw:= rh*2;
end;
if rh < rw div 2 then rh:= rw * 2;
-
+
ox:= (rw-LAND_WIDTH) div 2;
oy:= rh-LAND_HEIGHT;
@@ -764,7 +766,7 @@
cbit:= bit * 8;
for yy:= y * lh to y * lh + 7 do
for xx:= x * lw + cbit to x * lw + cbit + 7 do
- if ((yy-oy) and LAND_HEIGHT_MASK = 0) and ((xx-ox) and LAND_WIDTH_MASK = 0)
+ if ((yy-oy) and LAND_HEIGHT_MASK = 0) and ((xx-ox) and LAND_WIDTH_MASK = 0)
and (Land[yy-oy, xx-ox] <> 0) then
inc(t);
if t > 8 then
@@ -787,8 +789,10 @@
var adler, i: LongInt;
begin
adler:= 1;
- for i:= 0 to LAND_HEIGHT-1 do
+ for i:= 0 to LAND_HEIGHT-1 do
+ begin
adler:= Adler32Update(adler, @Land[i,0], LAND_WIDTH);
+ end;
s:= 'M' + IntToStr(adler) + cScriptName;
chLandCheck(s);
--- a/hedgewars/uLandGenMaze.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uLandGenMaze.pas Sun Jan 27 00:28:57 2013 +0100
@@ -14,6 +14,10 @@
DIR_S: direction = (x: 0; y: 1);
DIR_W: direction = (x: -1; y: 0);
+{xymeng : make all dynamic arrays static }
+const max_num_cells_x = 4096 div 128;
+ max_num_cells_y = 4096 div 128;
+ max_num_steps = 3;
operator = (const a, b: direction) c: Boolean;
begin
@@ -25,28 +29,43 @@
large_cell_size = 256;
braidness = 10;
-var x, y: LongInt;
- cellsize: LongInt; //selected by the user in the gui
- seen_cells_x, seen_cells_y: LongInt; //number of cells that can be visited by the generator, that is every second cell in x and y direction. the cells between there are walls that will be removed when we move from one cell to another
- num_edges_x, num_edges_y: LongInt; //number of resulting edges that need to be vertexificated
- num_cells_x, num_cells_y: LongInt; //actual number of cells, depending on cell size
- seen_list: array of array of LongInt;
- xwalls: array of array of Boolean;
- ywalls: array of array of Boolean;
- x_edge_list: array of array of Boolean;
- y_edge_list: array of array of Boolean;
- maze: array of array of Boolean;
- pa: TPixAr;
- num_vertices: LongInt;
- off_y: LongInt;
- num_steps: LongInt;
- current_step: LongInt;
- step_done: array of Boolean;
- done: Boolean;
- last_cell: array of record x, y: LongInt; end;
- came_from: array of array of record x, y: LongInt; end;
+type
+ cell_t = record x,y : LongInt
+ end;
+
+var x, y : LongInt;
+ cellsize : LongInt; //selected by the user in the gui
+ seen_cells_x, seen_cells_y : LongInt; //number of cells that can be visited by the generator, that is every second cell in x and y direction. the cells between there are walls that will be removed when we move from one cell to another
+ num_edges_x, num_edges_y : LongInt; //number of resulting edges that need to be vertexificated
+ num_cells_x, num_cells_y : LongInt; //actual number of cells, depending on cell size
+
+
+ seen_list : array of array of LongInt;
+ xwalls : array of array of Boolean;
+ ywalls : array of array of Boolean;
+ x_edge_list : array of array of Boolean;
+ y_edge_list : array of array of Boolean;
+ maze : array of array of Boolean;
+
+ pa : TPixAr;
+ num_vertices : LongInt;
+ off_y : LongInt;
+ num_steps : LongInt;
+ current_step : LongInt;
+
+ step_done : array of Boolean;
+
+ done : Boolean;
+
+{ last_cell : array 0..3 of record x, y :LongInt ; end;
+ came_from : array of array of record x, y: LongInt; end;
+ came_from_pos : array of LongInt;
+}
+ last_cell : array of cell_t;
+ came_from : array of array of cell_t;
came_from_pos: array of LongInt;
- maze_inverted: Boolean;
+
+ maze_inverted : Boolean;
function when_seen(x: LongInt; y: LongInt): LongInt;
begin
@@ -102,7 +121,7 @@
begin
//we have already seen the target cell, decide if we should remove the wall anyway
//(or put a wall there if maze_inverted, but we are not doing that right now)
- if not maze_inverted and (GetRandom(braidness) = 0) then
+ if (not maze_inverted) and (GetRandom(braidness) = 0) then
//or just warn that inverted+braid+indestructible terrain != good idea
begin
case dir.x of
@@ -178,7 +197,7 @@
came_from_pos[current_step] := came_from_pos[current_step] - 1;
if came_from_pos[current_step] >= 0 then
- see_cell
+ see_cell()
else
step_done[current_step] := true;
@@ -336,14 +355,18 @@
SetLength(last_cell, num_steps);
SetLength(came_from_pos, num_steps);
SetLength(came_from, num_steps, num_cells_x*num_cells_y);
+
done := false;
for current_step := 0 to num_steps - 1 do
+begin
step_done[current_step] := false;
came_from_pos[current_step] := 0;
-
+end;
+
current_step := 0;
+
SetLength(seen_list, seen_cells_x, seen_cells_y);
SetLength(xwalls, seen_cells_x, seen_cells_y - 1);
SetLength(ywalls, seen_cells_x - 1, seen_cells_y);
@@ -351,6 +374,7 @@
SetLength(y_edge_list, num_cells_x, num_edges_y);
SetLength(maze, num_cells_x, num_cells_y);
+
num_vertices := 0;
playHeight := num_cells_y * cellsize;
--- a/hedgewars/uLandGraphics.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uLandGraphics.pas Sun Jan 27 00:28:57 2013 +0100
@@ -208,7 +208,7 @@
t:= y + dy;
if (t and LAND_HEIGHT_MASK) = 0 then
for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then
+ if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[t, i]:= 0
else
@@ -217,7 +217,7 @@
t:= y - dy;
if (t and LAND_HEIGHT_MASK) = 0 then
for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then
+ if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[t, i]:= 0
else
@@ -226,7 +226,7 @@
t:= y + dx;
if (t and LAND_HEIGHT_MASK) = 0 then
for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then
+ if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[t, i]:= 0
else
@@ -235,7 +235,7 @@
t:= y - dx;
if (t and LAND_HEIGHT_MASK) = 0 then
for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do
- if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then
+ if ((Land[t, i] and lfIndestructible) = 0) and ((not disableLandBack) or (Land[t, i] > 255)) then
if (cReducedQuality and rqBlurryLand) = 0 then
LandPixels[t, i]:= 0
else
--- a/hedgewars/uLandObjects.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uLandObjects.pas Sun Jan 27 00:28:57 2013 +0100
@@ -68,11 +68,13 @@
ThemeObjects: TThemeObjects;
SprayObjects: TSprayObjects;
+
+
procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
begin
BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, 0);
end;
-
+
procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; extraFlags: Word);
var p: PLongwordArray;
x, y: Longword;
@@ -102,7 +104,7 @@
LandPixels[cpY + y, cpX + x]:= p^[x];
end
else
- if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
+ if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
if ((Land[cpY + y, cpX + x] and $FF00) = 0) and ((p^[x] and AMask) <> 0) then
@@ -201,7 +203,7 @@
inc(x2, 2);
k:= CountNonZeroz(x2, y)
until (x2 >= (rightX-150)) or (k = 0) or (k = 16) or (x2 > i) or (x2 - x1 >= 768);
-
+
if (x2 < (rightX - 150)) and (k = 16) and (x2 - x1 > 250) and (x2 - x1 < 768)
and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then
break;
@@ -218,7 +220,7 @@
while rr.x < x2 do
begin
// For testing only. Intent is to flag this on objects with masks, or use it for an ice ray gun
- if (Theme = 'Snow') or (Theme = 'Christmas') then
+ if (Theme = 'Snow') or (Theme = 'Christmas') then
BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf, lfIce)
else
BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, tmpsurf^.w), tmpsurf);
@@ -393,9 +395,9 @@
procedure CheckRect(Width, Height, x, y, w, h: LongWord);
begin
- if (x + w > Width) then
+ if (x + w > Width) then
OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
- if (y + h > Height) then
+ if (y + h > Height) then
OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
end;
@@ -493,7 +495,7 @@
c2.g:= t;
c2.b:= t
end;
- ExplosionBorderColor:= (c2.r shl RShift) or (c2.g shl GShift) or (c2.b shl BShift) or AMask;
+ ExplosionBorderColor:= (c2.r shl RShift) or (c2.g shl GShift) or (c2.b shl BShift) or AMask;
end
else if key = 'water-top' then
begin
--- a/hedgewars/uLandOutline.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uLandOutline.pas Sun Jan 27 00:28:57 2013 +0100
@@ -99,9 +99,9 @@
i:= 0;
with pa do
while i < LongInt(Count) - 1 do
- if (ar[i + 1].X = NTPX) then
+ if (ar[i + 1].X = NTPX) then
inc(i, 2)
- else
+ else
begin
DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color);
inc(i)
@@ -130,7 +130,7 @@
begin
Vx:= _0;
Vy:= _0
- end
+ end
else
begin
d2:= _1 / d2;
@@ -237,7 +237,7 @@
CheckIntersect:= false
else if (c2 < 0) or (c2 > dm) then
CheckIntersect:= false;
- end
+ end
else
begin
if (c1 > 0) or (c1 < dm) then
--- a/hedgewars/uLandTemplates.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uLandTemplates.pas Sun Jan 27 00:28:57 2013 +0100
@@ -24,20 +24,20 @@
const NTPX = Low(SmallInt);
-type TPointArray = array[0..64] of TSDL_Rect;
- PPointArray = ^TPointArray;
+type TPointArray = array[0..64] of TSDL_Rect;
+ PPointArray = ^TPointArray;
TEdgeTemplate = record
- BasePoints: PPointArray;
- BasePointsCount: Longword;
- FillPoints: PPointArray;
- FillPointsCount: Longword;
- BezierizeCount: Longword;
- RandPassesCount: Longword;
- TemplateHeight, TemplateWidth: Longword;
- canMirror, canFlip, isNegative, canInvert: boolean;
- hasGirders: boolean;
- MaxHedgeHogs: Longword;
- end;
+ BasePoints : PPointArray;
+ BasePointsCount : Longword;
+ FillPoints : PPointArray;
+ FillPointsCount : Longword;
+ BezierizeCount : Longword;
+ RandPassesCount : Longword;
+ TemplateHeight, TemplateWidth : Longword;
+ canMirror, canFlip, isNegative, canInvert : boolean;
+ hasGirders : boolean;
+ MaxHedgeHogs : Longword;
+ end;
///////////////////////// ORIGINAL SET //////////////////////////////
/// Area expanded to 2848x1424 at Tiys request to move out border ///
/////////////////////////////////////////////////////////////////////
@@ -63,9 +63,9 @@
(x: 2134; y: 1424; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template0FPoints: array[0..0] of TPoint =
+ Template0FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template1Points: array[0..15] of TSDL_Rect =
@@ -87,9 +87,9 @@
(x: 1860; y: 1424; w: 25; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template1FPoints: array[0..0] of TPoint =
+ Template1FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template2Points: array[0..21] of TSDL_Rect =
@@ -117,9 +117,9 @@
(x: 2004; y: 1424; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template2FPoints: array[0..0] of TPoint =
+ Template2FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template3Points: array[0..16] of TSDL_Rect =
@@ -142,9 +142,9 @@
(x: 1834; y: 622; w: 254; h: 116),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template3FPoints: array[0..0] of TPoint =
+ Template3FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template4Points: array[0..22] of TSDL_Rect =
@@ -173,9 +173,9 @@
(x: 2150; y: 552; w: 86; h: 220),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template4FPoints: array[0..0] of TPoint =
+ Template4FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template5Points: array[0..15] of TSDL_Rect =
@@ -197,9 +197,9 @@
(x: 2012; y: 1424; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template5FPoints: array[0..0] of TPoint =
+ Template5FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template6Points: array[0..13] of TSDL_Rect =
@@ -219,9 +219,9 @@
(x: 2046; y: 1420; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template6FPoints: array[0..0] of TPoint =
+ Template6FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template7Points: array[0..5] of TSDL_Rect =
@@ -233,9 +233,9 @@
(x: 1830; y: 1424; w: 454; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template7FPoints: array[0..0] of TPoint =
+ Template7FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
@@ -262,9 +262,9 @@
(x: 2030; y: 1424; w: 20; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template8FPoints: array[0..0] of TPoint =
+ Template8FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template9Points: array[0..31] of TSDL_Rect =
@@ -302,9 +302,9 @@
(x: 2080; y: 1424; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template9FPoints: array[0..0] of TPoint =
+ Template9FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template10Points: array[0..13] of TSDL_Rect =
@@ -324,9 +324,9 @@
(x: 2182; y: 1424; w: 2; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template10FPoints: array[0..0] of TPoint =
+ Template10FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template11Points: array[0..9] of TSDL_Rect =
@@ -342,9 +342,9 @@
(x: 1984; y: 1424; w: 136; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template11FPoints: array[0..0] of TPoint =
+ Template11FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template12Points: array[0..13] of TSDL_Rect =
@@ -364,9 +364,9 @@
(x: 2088; y: 1424; w: 176; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template12FPoints: array[0..0] of TPoint =
+ Template12FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template13Points: array[0..15] of TSDL_Rect =
@@ -388,9 +388,9 @@
(x: 1844; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template13FPoints: array[0..0] of TPoint =
+ Template13FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template14Points: array[0..13] of TSDL_Rect =
@@ -410,9 +410,9 @@
(x: 2008; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template14FPoints: array[0..0] of TPoint =
+ Template14FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template15Points: array[0..23] of TSDL_Rect =
@@ -442,9 +442,9 @@
(x: 2056; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template15FPoints: array[0..0] of TPoint =
+ Template15FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template16Points: array[0..28] of TSDL_Rect =
@@ -479,9 +479,9 @@
(x: 2098; y: 1424; w: 52; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template16FPoints: array[0..0] of TPoint =
+ Template16FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template17Points: array[0..13] of TSDL_Rect =
@@ -501,9 +501,9 @@
(x: 1998; y: 1424; w: 42; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template17FPoints: array[0..0] of TPoint =
+ Template17FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 1023; Y: 0)
+ (X: 1023; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
//////////////////// MIXING AND MATCHING ORIGINAL //////////////////////////////////////
const Template18Points: array[0..32] of TSDL_Rect =
@@ -542,9 +542,9 @@
(x: 3598; y: 1424; w: 42; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template18FPoints: array[0..0] of TPoint =
+ Template18FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template19Points: array[0..44] of TSDL_Rect =
@@ -595,9 +595,9 @@
(x: 3398; y: 1424; w: 52; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template19FPoints: array[0..0] of TPoint =
+ Template19FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template20Points: array[0..45] of TSDL_Rect =
@@ -649,9 +649,9 @@
(x: 3456; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template20FPoints: array[0..0] of TPoint =
+ Template20FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template21Points: array[0..30] of TSDL_Rect =
@@ -688,9 +688,9 @@
(x: 3258; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template21FPoints: array[0..0] of TPoint =
+ Template21FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template22Points: array[0..38] of TSDL_Rect =
@@ -735,9 +735,9 @@
(x: 3244; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template22FPoints: array[0..0] of TPoint =
+ Template22FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template23Points: array[0..29] of TSDL_Rect =
@@ -773,9 +773,9 @@
(x: 3438; y: 1424; w: 176; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template23FPoints: array[0..0] of TPoint =
+ Template23FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template24Points: array[0..23] of TSDL_Rect =
@@ -805,9 +805,9 @@
(x: 3346; y: 1420; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template24FPoints: array[0..0] of TPoint =
+ Template24FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template25Points: array[0..19] of TSDL_Rect =
@@ -833,9 +833,9 @@
(x: 3532; y: 1424; w: 2; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template25FPoints: array[0..0] of TPoint =
+ Template25FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
@@ -894,9 +894,9 @@
(x: 3480; y: 1424; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template26FPoints: array[0..0] of TPoint =
+ Template26FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template27Points: array[0..42] of TSDL_Rect =
@@ -945,9 +945,9 @@
(x: 3556; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template27FPoints: array[0..0] of TPoint =
+ Template27FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template28Points: array[0..29] of TSDL_Rect =
@@ -983,9 +983,9 @@
(x: 3308; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template28FPoints: array[0..0] of TPoint =
+ Template28FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template29Points: array[0..37] of TSDL_Rect =
@@ -1029,9 +1029,9 @@
(x: 3094; y: 1424; w: 2; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template29FPoints: array[0..0] of TPoint =
+ Template29FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template30Points: array[0..30] of TSDL_Rect =
@@ -1068,9 +1068,9 @@
(x: 3288; y: 1424; w: 176; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template30FPoints: array[0..0] of TPoint =
+ Template30FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template31Points: array[0..32] of TSDL_Rect =
@@ -1109,9 +1109,9 @@
(x: 3584; y: 1424; w: 136; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template31FPoints: array[0..0] of TPoint =
+ Template31FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template32Points: array[0..29] of TSDL_Rect =
@@ -1147,9 +1147,9 @@
(x: 3682; y: 1424; w: 2; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template32FPoints: array[0..0] of TPoint =
+ Template32FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template33Points: array[0..45] of TSDL_Rect =
@@ -1201,9 +1201,9 @@
(x: 3480; y: 1424; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template33FPoints: array[0..0] of TPoint =
+ Template33FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template34Points: array[0..25] of TSDL_Rect =
@@ -1235,9 +1235,9 @@
(x: 3230; y: 1424; w: 20; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template34FPoints: array[0..0] of TPoint =
+ Template34FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template35Points: array[0..48] of TSDL_Rect =
@@ -1292,9 +1292,9 @@
(x: 3498; y: 1424; w: 52; h: 2),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template35FPoints: array[0..0] of TPoint =
+ Template35FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
///////////////////////// CAVERNS ///////////////////////////////////
@@ -1320,9 +1320,9 @@
(x: 576; y: 976; w: 16; h: 28),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template36FPoints: array[0..0] of TPoint =
+ Template36FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
////////////////////////////// ... Silly ... ////////////////////////////////
/// Ok. Tiy does not care for these. Perhaps they could be saved.
@@ -1361,9 +1361,9 @@
(x: 2250; y: 1200; w: 25; h: 25),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template37FPoints: array[0..0] of TPoint =
+ Template37FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
// attempt to make a series of moderate hills/valleys - was before I really figured out the whole probabilities thing
const Template38Points: array[0..16] of TSDL_Rect =
@@ -1386,9 +1386,9 @@
(x: 3700; y: 2100; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template38FPoints: array[0..0] of TPoint =
+ Template38FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
// 8 tiny islands
@@ -1435,9 +1435,9 @@
(x: 1430; y: 520; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template39FPoints: array[0..0] of TPoint =
+ Template39FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 512; Y: 0)
+ (X: 512; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
const Template40Points: array[0..7] of TSDL_Rect =
(
@@ -1450,9 +1450,9 @@
(x: 900; y: 1050; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template40FPoints: array[0..0] of TPoint =
+ Template40FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 512; Y: 0)
+ (X: 512; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
// Many islands
const Template41Points: array[0..86] of TSDL_Rect =
@@ -1545,9 +1545,9 @@
(x: 4050; y: 125; w: 50; h: 75),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template41FPoints: array[0..0] of TPoint =
+ Template41FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 2047; Y: 0)
+ (X: 2047; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
// 2 tiny islands
const Template42Points: array[0..13] of TSDL_Rect =
@@ -1567,9 +1567,9 @@
(x: 1430; y: 520; w: 1; h: 1),
(x: NTPX; y: 0; w: 1; h: 1)
);
- Template42FPoints: array[0..0] of TPoint =
+ Template42FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 512; Y: 0)
+ (X: 512; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
// Many islands
const Template43Points: array[0..173] of TSDL_Rect =
@@ -1749,9 +1749,9 @@
(x: 4050; y:2173; w: 50; h: 75),
(x: NTPX; y:2048; w: 1; h: 1)
);
- Template43FPoints: array[0..0] of TPoint =
+ Template43FPoints: array[0..{$IFDEF PAS2C}1{$ELSE}0{$ENDIF}] of TPoint =
(
- (X: 4095; Y: 0)
+ (X: 4095; Y: 0){$IFDEF PAS2C},(X:0;Y:9){$ENDIF}
);
// 3 large caverns
@@ -1775,12 +1775,12 @@
);
Template44FPoints: array[0..5] of TSDL_Rect =
(
- (X: 1; Y: 90; w: 0; h: 0),
- (X: 1; Y: 500; w: 0; h: 0),
- (X:4095; Y: 500; w: 0; h: 0),
- (X: 1; Y:1200; w: 0; h: 0),
- (X:4095; Y:1200; w: 0; h: 0),
- (X: 1; Y:2010; w: 0; h: 0)
+ (x: 1; y: 90; w: 0; h: 0),
+ (x: 1; y: 500; w: 0; h: 0),
+ (x:4095; y: 500; w: 0; h: 0),
+ (x: 1; y:1200; w: 0; h: 0),
+ (x:4095; y:1200; w: 0; h: 0),
+ (x: 1; y:2010; w: 0; h: 0)
);
// large caverns with an island
@@ -1801,9 +1801,9 @@
);
Template45FPoints: array[0..2] of TSDL_Rect =
(
- (X: 1; Y: 1; w: 0; h: 0),
- (X: 1; Y:2047; w: 0; h: 0),
- (X:1005; Y: 805; w: 0; h: 0)
+ (x: 1; y: 1; w: 0; h: 0),
+ (x: 1; y:2047; w: 0; h: 0),
+ (x:1005; y: 805; w: 0; h: 0)
);
////////////////////////////////////////////////////////////////////////
@@ -1812,7 +1812,7 @@
(BasePoints: @Template0Points;
BasePointsCount: Succ(High(Template0Points));
FillPoints: @Template0FPoints;
- FillPointsCount: Succ(High(Template0FPoints));
+ FillPointsCount: Succ(High(Template0FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 8;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1823,7 +1823,7 @@
(BasePoints: @Template1Points;
BasePointsCount: Succ(High(Template1Points));
FillPoints: @Template1FPoints;
- FillPointsCount: Succ(High(Template1FPoints));
+ FillPointsCount: Succ(High(Template1FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 7;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1834,7 +1834,7 @@
(BasePoints: @Template2Points;
BasePointsCount: Succ(High(Template2Points));
FillPoints: @Template2FPoints;
- FillPointsCount: Succ(High(Template2FPoints));
+ FillPointsCount: Succ(High(Template2FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 6;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1845,7 +1845,7 @@
(BasePoints: @Template3Points;
BasePointsCount: Succ(High(Template3Points));
FillPoints: @Template3FPoints;
- FillPointsCount: Succ(High(Template3FPoints));
+ FillPointsCount: Succ(High(Template3FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 4;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1856,7 +1856,7 @@
(BasePoints: @Template4Points;
BasePointsCount: Succ(High(Template4Points));
FillPoints: @Template4FPoints;
- FillPointsCount: Succ(High(Template4FPoints));
+ FillPointsCount: Succ(High(Template4FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 4;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1867,7 +1867,7 @@
(BasePoints: @Template5Points;
BasePointsCount: Succ(High(Template5Points));
FillPoints: @Template5FPoints;
- FillPointsCount: Succ(High(Template5FPoints));
+ FillPointsCount: Succ(High(Template5FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 8;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1878,7 +1878,7 @@
(BasePoints: @Template6Points;
BasePointsCount: Succ(High(Template6Points));
FillPoints: @Template6FPoints;
- FillPointsCount: Succ(High(Template6FPoints));
+ FillPointsCount: Succ(High(Template6FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 5;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1889,7 +1889,7 @@
(BasePoints: @Template7Points;
BasePointsCount: Succ(High(Template7Points));
FillPoints: @Template7FPoints;
- FillPointsCount: Succ(High(Template7FPoints));
+ FillPointsCount: Succ(High(Template7FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 4;
RandPassesCount: 4;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1900,7 +1900,7 @@
(BasePoints: @Template8Points;
BasePointsCount: Succ(High(Template8Points));
FillPoints: @Template8FPoints;
- FillPointsCount: Succ(High(Template8FPoints));
+ FillPointsCount: Succ(High(Template8FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 7;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1911,7 +1911,7 @@
(BasePoints: @Template9Points;
BasePointsCount: Succ(High(Template9Points));
FillPoints: @Template9FPoints;
- FillPointsCount: Succ(High(Template9FPoints));
+ FillPointsCount: Succ(High(Template9FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 1;
RandPassesCount: 5;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1922,7 +1922,7 @@
(BasePoints: @Template10Points;
BasePointsCount: Succ(High(Template10Points));
FillPoints: @Template10FPoints;
- FillPointsCount: Succ(High(Template10FPoints));
+ FillPointsCount: Succ(High(Template10FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 6;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1933,7 +1933,7 @@
(BasePoints: @Template11Points;
BasePointsCount: Succ(High(Template11Points));
FillPoints: @Template11FPoints;
- FillPointsCount: Succ(High(Template11FPoints));
+ FillPointsCount: Succ(High(Template11FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 1;
RandPassesCount: 8;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1944,7 +1944,7 @@
(BasePoints: @Template12Points;
BasePointsCount: Succ(High(Template12Points));
FillPoints: @Template12FPoints;
- FillPointsCount: Succ(High(Template12FPoints));
+ FillPointsCount: Succ(High(Template12FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 8;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1955,7 +1955,7 @@
(BasePoints: @Template13Points;
BasePointsCount: Succ(High(Template13Points));
FillPoints: @Template13FPoints;
- FillPointsCount: Succ(High(Template13FPoints));
+ FillPointsCount: Succ(High(Template13FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 5;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1966,7 +1966,7 @@
(BasePoints: @Template14Points;
BasePointsCount: Succ(High(Template14Points));
FillPoints: @Template14FPoints;
- FillPointsCount: Succ(High(Template14FPoints));
+ FillPointsCount: Succ(High(Template14FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 7;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1977,7 +1977,7 @@
(BasePoints: @Template15Points;
BasePointsCount: Succ(High(Template15Points));
FillPoints: @Template15FPoints;
- FillPointsCount: Succ(High(Template15FPoints));
+ FillPointsCount: Succ(High(Template15FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 6;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1988,7 +1988,7 @@
(BasePoints: @Template16Points;
BasePointsCount: Succ(High(Template16Points));
FillPoints: @Template16FPoints;
- FillPointsCount: Succ(High(Template16FPoints));
+ FillPointsCount: Succ(High(Template16FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 6;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -1999,7 +1999,7 @@
(BasePoints: @Template17Points;
BasePointsCount: Succ(High(Template17Points));
FillPoints: @Template17FPoints;
- FillPointsCount: Succ(High(Template17FPoints));
+ FillPointsCount: Succ(High(Template17FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 7;
TemplateHeight: 1424; TemplateWidth: 2848;
@@ -2010,7 +2010,7 @@
(BasePoints: @Template18Points;
BasePointsCount: Succ(High(Template18Points));
FillPoints: @Template18FPoints;
- FillPointsCount: Succ(High(Template18FPoints));
+ FillPointsCount: Succ(High(Template18FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 8;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2021,7 +2021,7 @@
(BasePoints: @Template19Points;
BasePointsCount: Succ(High(Template19Points));
FillPoints: @Template19FPoints;
- FillPointsCount: Succ(High(Template19FPoints));
+ FillPointsCount: Succ(High(Template19FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 7;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2032,7 +2032,7 @@
(BasePoints: @Template20Points;
BasePointsCount: Succ(High(Template20Points));
FillPoints: @Template20FPoints;
- FillPointsCount: Succ(High(Template20FPoints));
+ FillPointsCount: Succ(High(Template20FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 6;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2043,7 +2043,7 @@
(BasePoints: @Template21Points;
BasePointsCount: Succ(High(Template21Points));
FillPoints: @Template21FPoints;
- FillPointsCount: Succ(High(Template21FPoints));
+ FillPointsCount: Succ(High(Template21FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 4;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2054,7 +2054,7 @@
(BasePoints: @Template22Points;
BasePointsCount: Succ(High(Template22Points));
FillPoints: @Template22FPoints;
- FillPointsCount: Succ(High(Template22FPoints));
+ FillPointsCount: Succ(High(Template22FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 4;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2065,7 +2065,7 @@
(BasePoints: @Template23Points;
BasePointsCount: Succ(High(Template23Points));
FillPoints: @Template23FPoints;
- FillPointsCount: Succ(High(Template23FPoints));
+ FillPointsCount: Succ(High(Template23FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 8;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2076,7 +2076,7 @@
(BasePoints: @Template24Points;
BasePointsCount: Succ(High(Template24Points));
FillPoints: @Template24FPoints;
- FillPointsCount: Succ(High(Template24FPoints));
+ FillPointsCount: Succ(High(Template24FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 5;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2087,7 +2087,7 @@
(BasePoints: @Template25Points;
BasePointsCount: Succ(High(Template25Points));
FillPoints: @Template25FPoints;
- FillPointsCount: Succ(High(Template25FPoints));
+ FillPointsCount: Succ(High(Template25FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 4;
RandPassesCount: 4;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2098,7 +2098,7 @@
(BasePoints: @Template26Points;
BasePointsCount: Succ(High(Template26Points));
FillPoints: @Template26FPoints;
- FillPointsCount: Succ(High(Template26FPoints));
+ FillPointsCount: Succ(High(Template26FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 7;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2109,7 +2109,7 @@
(BasePoints: @Template27Points;
BasePointsCount: Succ(High(Template27Points));
FillPoints: @Template27FPoints;
- FillPointsCount: Succ(High(Template27FPoints));
+ FillPointsCount: Succ(High(Template27FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 1;
RandPassesCount: 5;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2120,7 +2120,7 @@
(BasePoints: @Template28Points;
BasePointsCount: Succ(High(Template28Points));
FillPoints: @Template28FPoints;
- FillPointsCount: Succ(High(Template28FPoints));
+ FillPointsCount: Succ(High(Template28FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 6;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2131,7 +2131,7 @@
(BasePoints: @Template29Points;
BasePointsCount: Succ(High(Template29Points));
FillPoints: @Template29FPoints;
- FillPointsCount: Succ(High(Template29FPoints));
+ FillPointsCount: Succ(High(Template29FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 1;
RandPassesCount: 8;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2142,7 +2142,7 @@
(BasePoints: @Template30Points;
BasePointsCount: Succ(High(Template30Points));
FillPoints: @Template30FPoints;
- FillPointsCount: Succ(High(Template30FPoints));
+ FillPointsCount: Succ(High(Template30FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 8;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2153,7 +2153,7 @@
(BasePoints: @Template31Points;
BasePointsCount: Succ(High(Template31Points));
FillPoints: @Template31FPoints;
- FillPointsCount: Succ(High(Template31FPoints));
+ FillPointsCount: Succ(High(Template31FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 5;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2164,7 +2164,7 @@
(BasePoints: @Template32Points;
BasePointsCount: Succ(High(Template32Points));
FillPoints: @Template32FPoints;
- FillPointsCount: Succ(High(Template32FPoints));
+ FillPointsCount: Succ(High(Template32FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 7;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2175,7 +2175,7 @@
(BasePoints: @Template33Points;
BasePointsCount: Succ(High(Template33Points));
FillPoints: @Template33FPoints;
- FillPointsCount: Succ(High(Template33FPoints));
+ FillPointsCount: Succ(High(Template33FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 6;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2186,7 +2186,7 @@
(BasePoints: @Template34Points;
BasePointsCount: Succ(High(Template34Points));
FillPoints: @Template34FPoints;
- FillPointsCount: Succ(High(Template34FPoints));
+ FillPointsCount: Succ(High(Template34FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 6;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2197,7 +2197,7 @@
(BasePoints: @Template35Points;
BasePointsCount: Succ(High(Template35Points));
FillPoints: @Template35FPoints;
- FillPointsCount: Succ(High(Template35FPoints));
+ FillPointsCount: Succ(High(Template35FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 7;
TemplateHeight: 1424; TemplateWidth: 3900;
@@ -2208,7 +2208,7 @@
(BasePoints: @Template36Points;
BasePointsCount: Succ(High(Template36Points));
FillPoints: @Template36FPoints;
- FillPointsCount: Succ(High(Template36FPoints));
+ FillPointsCount: Succ(High(Template36FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 4;
RandPassesCount: 12;
TemplateHeight: 1024; TemplateWidth: 4096;
@@ -2219,7 +2219,7 @@
(BasePoints: @Template37Points;
BasePointsCount: Succ(High(Template37Points));
FillPoints: @Template37FPoints;
- FillPointsCount: Succ(High(Template37FPoints));
+ FillPointsCount: Succ(High(Template37FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 3;
TemplateHeight: 2048; TemplateWidth: 4096;
@@ -2230,7 +2230,7 @@
(BasePoints: @Template38Points;
BasePointsCount: Succ(High(Template38Points));
FillPoints: @Template38FPoints;
- FillPointsCount: Succ(High(Template38FPoints));
+ FillPointsCount: Succ(High(Template38FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 4;
RandPassesCount: 4;
TemplateHeight: 2048; TemplateWidth: 4096;
@@ -2241,7 +2241,7 @@
(BasePoints: @Template39Points;
BasePointsCount: Succ(High(Template39Points));
FillPoints: @Template39FPoints;
- FillPointsCount: Succ(High(Template39FPoints));
+ FillPointsCount: Succ(High(Template39FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 3;
TemplateHeight: 512; TemplateWidth: 1536;
@@ -2252,7 +2252,7 @@
(BasePoints: @Template40Points;
BasePointsCount: Succ(High(Template40Points));
FillPoints: @Template40FPoints;
- FillPointsCount: Succ(High(Template40FPoints));
+ FillPointsCount: Succ(High(Template40FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 3;
TemplateHeight: 1024; TemplateWidth: 1024;
@@ -2263,7 +2263,7 @@
(BasePoints: @Template41Points;
BasePointsCount: Succ(High(Template41Points));
FillPoints: @Template41FPoints;
- FillPointsCount: Succ(High(Template41FPoints));
+ FillPointsCount: Succ(High(Template41FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 9;
TemplateHeight: 2048; TemplateWidth: 4096;
@@ -2274,7 +2274,7 @@
(BasePoints: @Template42Points;
BasePointsCount: Succ(High(Template42Points));
FillPoints: @Template42FPoints;
- FillPointsCount: Succ(High(Template42FPoints));
+ FillPointsCount: Succ(High(Template42FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 3;
RandPassesCount: 3;
TemplateHeight: 512; TemplateWidth: 1536;
@@ -2285,7 +2285,7 @@
(BasePoints: @Template43Points;
BasePointsCount: Succ(High(Template43Points));
FillPoints: @Template43FPoints;
- FillPointsCount: Succ(High(Template43FPoints));
+ FillPointsCount: Succ(High(Template43FPoints)){$IFDEF PAS2C}-1{$ENDIF};
BezierizeCount: 2;
RandPassesCount: 9;
TemplateHeight: 4096; TemplateWidth: 4096;
--- a/hedgewars/uLandTexture.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uLandTexture.pas Sun Jan 27 00:28:57 2013 +0100
@@ -39,10 +39,11 @@
tex: PTexture;
end;
-var LandTextures: array of array of TLandRecord;
- tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
- LANDTEXARW: LongWord;
- LANDTEXARH: LongWord;
+var
+ LandTextures : array of array of TLandRecord;
+ tmpPixels : array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
+ LANDTEXARW : LongWord;
+ LANDTEXARH : LongWord;
function Pixels(x, y: Longword): Pointer;
var ty: Longword;
@@ -198,7 +199,6 @@
LANDTEXARW:= (LAND_WIDTH div TEXSIZE) div 2;
LANDTEXARH:= (LAND_HEIGHT div TEXSIZE) div 2;
end;
-
SetLength(LandTextures, LANDTEXARW, LANDTEXARH);
end;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uMatrix.pas Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,268 @@
+(*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; version 2 of the License
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+ *)
+
+{$INCLUDE "options.inc"}
+
+unit uMatrix;
+
+interface
+
+uses uTypes {$IFNDEF PAS2C}, gl{$ENDIF};
+
+const
+ MATRIX_MODELVIEW:Integer = 0;
+ MATRIX_PROJECTION:Integer = 1;
+
+procedure MatrixLoadIdentity(out Result: TMatrix4x4f);
+procedure MatrixMultiply(out Result: TMatrix4x4f; const lhs, rhs: TMatrix4x4f);
+
+procedure hglMatrixMode(t: Integer);
+procedure hglLoadIdentity();
+procedure hglPushMatrix();
+procedure hglPopMatrix();
+procedure hglMVP(var res : TMatrix4x4f);
+procedure hglScalef(x: GLfloat; y: GLfloat; z: GLfloat);
+procedure hglTranslatef(x: GLfloat; y: GLfloat; z: GLfloat);
+procedure hglRotatef(a:GLfloat; x:GLfloat; y:GLfloat; z:GLfloat);
+procedure initModule();
+procedure freeModule();
+
+implementation
+
+const
+ MATRIX_STACK_SIZE = 10;
+
+type
+ TMatrixStack = record
+ top:Integer;
+ stack: array[0..9] of TMatrix4x4f;
+ end;
+var
+ MatrixStacks : array[0..1] of TMatrixStack;
+ CurMatrix: integer;
+
+procedure MatrixLoadIdentity(out Result: TMatrix4x4f);
+begin
+ Result[0,0]:= 1.0; Result[1,0]:=0.0; Result[2,0]:=0.0; Result[3,0]:=0.0;
+ Result[0,1]:= 0.0; Result[1,1]:=1.0; Result[2,1]:=0.0; Result[3,1]:=0.0;
+ Result[0,2]:= 0.0; Result[1,2]:=0.0; Result[2,2]:=1.0; Result[3,2]:=0.0;
+ Result[0,3]:= 0.0; Result[1,3]:=0.0; Result[2,3]:=0.0; Result[3,3]:=1.0;
+end;
+
+procedure hglMatrixMode(t: Integer);
+begin
+ CurMatrix := t;
+end;
+
+procedure hglLoadIdentity();
+begin
+ MatrixLoadIdentity(MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top]);
+end;
+
+procedure hglScalef(x: GLfloat; y: GLfloat; z: GLfloat);
+var
+ m:TMatrix4x4f;
+ t:TMatrix4x4f;
+begin
+ m[0,0]:=x;m[1,0]:=0;m[2,0]:=0;m[3,0]:=0;
+ m[0,1]:=0;m[1,1]:=y;m[2,1]:=0;m[3,1]:=0;
+ m[0,2]:=0;m[1,2]:=0;m[2,2]:=z;m[3,2]:=0;
+ m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;
+
+ MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);
+ MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;
+end;
+
+procedure hglTranslatef(x: GLfloat; y: GLfloat; z: GLfloat);
+var
+ m:TMatrix4x4f;
+ t:TMatrix4x4f;
+begin
+ m[0,0]:=1;m[1,0]:=0;m[2,0]:=0;m[3,0]:=x;
+ m[0,1]:=0;m[1,1]:=1;m[2,1]:=0;m[3,1]:=y;
+ m[0,2]:=0;m[1,2]:=0;m[2,2]:=1;m[3,2]:=z;
+ m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;
+
+ MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);
+ MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;
+end;
+
+procedure hglRotatef(a:GLfloat; x:GLfloat; y:GLfloat; z:GLfloat);
+var
+ m:TMatrix4x4f;
+ t:TMatrix4x4f;
+ c:GLfloat;
+ s:GLfloat;
+ xn, yn, zn:GLfloat;
+ l:GLfloat;
+begin
+ a:=a * 3.14159265368 / 180;
+ c:=cos(a);
+ s:=sin(a);
+
+ l := 1.0 / sqrt(x * x + y * y + z * z);
+ xn := x * l;
+ yn := y * l;
+ zn := z * l;
+
+ m[0,0]:=c + xn * xn * (1 - c);
+ m[1,0]:=xn * yn * (1 - c) - zn * s;
+ m[2,0]:=xn * zn * (1 - c) + yn * s;
+ m[3,0]:=0;
+
+
+ m[0,1]:=yn * xn * (1 - c) + zn * s;
+ m[1,1]:=c + yn * yn * (1 - c);
+ m[2,1]:=yn * zn * (1 - c) - xn * s;
+ m[3,1]:=0;
+
+ m[0,2]:=zn * xn * (1 - c) - yn * s;
+ m[1,2]:=zn * yn * (1 - c) + xn * s;
+ m[2,2]:=c + zn * zn * (1 - c);
+ m[3,2]:=0;
+
+ m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;
+
+ MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);
+ MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;
+end;
+
+procedure hglMVP(var res: TMatrix4x4f);
+begin
+ MatrixMultiply(res,
+ MatrixStacks[MATRIX_PROJECTION].stack[MatrixStacks[MATRIX_PROJECTION].top],
+ MatrixStacks[MATRIX_MODELVIEW].stack[MatrixStacks[MATRIX_MODELVIEW].top]);
+end;
+
+procedure hglPushMatrix();
+var
+ t: Integer;
+begin
+ t := MatrixStacks[CurMatrix].top;
+ MatrixStacks[CurMatrix].stack[t + 1] := MatrixStacks[CurMatrix].stack[t];
+ inc(t);
+ MatrixStacks[CurMatrix].top := t;
+end;
+
+procedure hglPopMatrix();
+var
+ t: Integer;
+begin
+ t := MatrixStacks[CurMatrix].top;
+ dec(t);
+ MatrixStacks[CurMatrix].top := t;
+end;
+
+procedure initModule();
+begin
+ MatrixStacks[MATRIX_MODELVIEW].top := 0;
+ MatrixStacks[MATRIX_Projection].top := 0;
+ MatrixLoadIdentity(MatrixStacks[MATRIX_MODELVIEW].stack[0]);
+ MatrixLoadIdentity(MatrixStacks[MATRIX_PROJECTION].stack[0]);
+end;
+
+procedure freeModule();
+begin
+end;
+
+procedure MatrixMultiply(out Result: TMatrix4x4f; const lhs, rhs: TMatrix4x4f);
+var
+ test: TMatrix4x4f;
+ i, j: Integer;
+ error: boolean;
+begin
+ Result[0,0]:=lhs[0,0]*rhs[0,0] + lhs[1,0]*rhs[0,1] + lhs[2,0]*rhs[0,2] + lhs[3,0]*rhs[0,3];
+ Result[0,1]:=lhs[0,1]*rhs[0,0] + lhs[1,1]*rhs[0,1] + lhs[2,1]*rhs[0,2] + lhs[3,1]*rhs[0,3];
+ Result[0,2]:=lhs[0,2]*rhs[0,0] + lhs[1,2]*rhs[0,1] + lhs[2,2]*rhs[0,2] + lhs[3,2]*rhs[0,3];
+ Result[0,3]:=lhs[0,3]*rhs[0,0] + lhs[1,3]*rhs[0,1] + lhs[2,3]*rhs[0,2] + lhs[3,3]*rhs[0,3];
+
+ Result[1,0]:=lhs[0,0]*rhs[1,0] + lhs[1,0]*rhs[1,1] + lhs[2,0]*rhs[1,2] + lhs[3,0]*rhs[1,3];
+ Result[1,1]:=lhs[0,1]*rhs[1,0] + lhs[1,1]*rhs[1,1] + lhs[2,1]*rhs[1,2] + lhs[3,1]*rhs[1,3];
+ Result[1,2]:=lhs[0,2]*rhs[1,0] + lhs[1,2]*rhs[1,1] + lhs[2,2]*rhs[1,2] + lhs[3,2]*rhs[1,3];
+ Result[1,3]:=lhs[0,3]*rhs[1,0] + lhs[1,3]*rhs[1,1] + lhs[2,3]*rhs[1,2] + lhs[3,3]*rhs[1,3];
+
+ Result[2,0]:=lhs[0,0]*rhs[2,0] + lhs[1,0]*rhs[2,1] + lhs[2,0]*rhs[2,2] + lhs[3,0]*rhs[2,3];
+ Result[2,1]:=lhs[0,1]*rhs[2,0] + lhs[1,1]*rhs[2,1] + lhs[2,1]*rhs[2,2] + lhs[3,1]*rhs[2,3];
+ Result[2,2]:=lhs[0,2]*rhs[2,0] + lhs[1,2]*rhs[2,1] + lhs[2,2]*rhs[2,2] + lhs[3,2]*rhs[2,3];
+ Result[2,3]:=lhs[0,3]*rhs[2,0] + lhs[1,3]*rhs[2,1] + lhs[2,3]*rhs[2,2] + lhs[3,3]*rhs[2,3];
+
+ Result[3,0]:=lhs[0,0]*rhs[3,0] + lhs[1,0]*rhs[3,1] + lhs[2,0]*rhs[3,2] + lhs[3,0]*rhs[3,3];
+ Result[3,1]:=lhs[0,1]*rhs[3,0] + lhs[1,1]*rhs[3,1] + lhs[2,1]*rhs[3,2] + lhs[3,1]*rhs[3,3];
+ Result[3,2]:=lhs[0,2]*rhs[3,0] + lhs[1,2]*rhs[3,1] + lhs[2,2]*rhs[3,2] + lhs[3,2]*rhs[3,3];
+ Result[3,3]:=lhs[0,3]*rhs[3,0] + lhs[1,3]*rhs[3,1] + lhs[2,3]*rhs[3,2] + lhs[3,3]*rhs[3,3];
+
+{
+ Result[0,0]:=lhs[0,0]*rhs[0,0] + lhs[1,0]*rhs[0,1] + lhs[2,0]*rhs[0,2] + lhs[3,0]*rhs[0,3];
+ Result[0,1]:=lhs[0,0]*rhs[1,0] + lhs[1,0]*rhs[1,1] + lhs[2,0]*rhs[1,2] + lhs[3,0]*rhs[1,3];
+ Result[0,2]:=lhs[0,0]*rhs[2,0] + lhs[1,0]*rhs[2,1] + lhs[2,0]*rhs[2,2] + lhs[3,0]*rhs[2,3];
+ Result[0,3]:=lhs[0,0]*rhs[3,0] + lhs[1,0]*rhs[3,1] + lhs[2,0]*rhs[3,2] + lhs[3,0]*rhs[3,3];
+
+ Result[1,0]:=lhs[0,1]*rhs[0,0] + lhs[1,1]*rhs[0,1] + lhs[2,1]*rhs[0,2] + lhs[3,1]*rhs[0,3];
+ Result[1,1]:=lhs[0,1]*rhs[1,0] + lhs[1,1]*rhs[1,1] + lhs[2,1]*rhs[1,2] + lhs[3,1]*rhs[1,3];
+ Result[1,2]:=lhs[0,1]*rhs[2,0] + lhs[1,1]*rhs[2,1] + lhs[2,1]*rhs[2,2] + lhs[3,1]*rhs[2,3];
+ Result[1,3]:=lhs[0,1]*rhs[3,0] + lhs[1,1]*rhs[3,1] + lhs[2,1]*rhs[3,2] + lhs[3,1]*rhs[3,3];
+
+ Result[2,0]:=lhs[0,2]*rhs[0,0] + lhs[1,2]*rhs[0,1] + lhs[2,2]*rhs[0,2] + lhs[3,2]*rhs[0,3];
+ Result[2,1]:=lhs[0,2]*rhs[1,0] + lhs[1,2]*rhs[1,1] + lhs[2,2]*rhs[1,2] + lhs[3,2]*rhs[1,3];
+ Result[2,2]:=lhs[0,2]*rhs[2,0] + lhs[1,2]*rhs[2,1] + lhs[2,2]*rhs[2,2] + lhs[3,2]*rhs[2,3];
+ Result[2,3]:=lhs[0,2]*rhs[3,0] + lhs[1,2]*rhs[3,1] + lhs[2,2]*rhs[3,2] + lhs[3,2]*rhs[3,3];
+
+ Result[3,0]:=lhs[0,3]*rhs[0,0] + lhs[1,3]*rhs[0,1] + lhs[2,3]*rhs[0,2] + lhs[3,3]*rhs[0,3];
+ Result[3,1]:=lhs[0,3]*rhs[1,0] + lhs[1,3]*rhs[1,1] + lhs[2,3]*rhs[1,2] + lhs[3,3]*rhs[1,3];
+ Result[3,2]:=lhs[0,3]*rhs[2,0] + lhs[1,3]*rhs[2,1] + lhs[2,3]*rhs[2,2] + lhs[3,3]*rhs[2,3];
+ Result[3,3]:=lhs[0,3]*rhs[3,0] + lhs[1,3]*rhs[3,1] + lhs[2,3]*rhs[3,2] + lhs[3,3]*rhs[3,3];
+}
+
+ {$IFNDEF PAS2C}
+ glPushMatrix;
+ glLoadMatrixf(@lhs[0, 0]);
+ glMultMatrixf(@rhs[0, 0]);
+ glGetFloatv(GL_MODELVIEW_MATRIX, @test[0, 0]);
+ glPopMatrix;
+
+ error:=false;
+ for i:=0 to 3 do
+ for j:=0 to 3 do
+ if Abs(test[i, j] - Result[i, j]) > 0.000001 then
+ error:=true;
+
+ if error then
+ begin
+ writeln('shall:');
+ for i:=0 to 3 do
+ begin
+ for j:=0 to 3 do
+ write(test[i, j]);
+ writeln;
+ end;
+
+ writeln('is:');
+ for i:=0 to 3 do
+ begin
+ for j:=0 to 3 do
+ write(Result[i, j]);
+ writeln;
+ end;
+ halt(0);
+ end;
+ {$ENDIF}
+
+end;
+
+
+end.
--- a/hedgewars/uMisc.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uMisc.pas Sun Jan 27 00:28:57 2013 +0100
@@ -49,7 +49,7 @@
size: QWord;
end;
-var conversionFormat: PSDL_PixelFormat;
+var conversionFormat : PSDL_PixelFormat;
procedure movecursor(dx, dy: LongInt);
var x, y: LongInt;
@@ -68,7 +68,7 @@
var i: LongInt;
png_ptr: ^png_struct;
info_ptr: ^png_info;
- f: file;
+ f: File;
image: PScreenshot;
begin
image:= PScreenshot(screenshot);
@@ -141,6 +141,7 @@
);
image: PScreenshot;
size: QWord;
+ writeResult:LongInt;
begin
image:= PScreenshot(screenshot);
@@ -168,8 +169,8 @@
Rewrite(f, 1);
if IOResult = 0 then
begin
- BlockWrite(f, head, sizeof(head));
- BlockWrite(f, image^.buffer^, size);
+ BlockWrite(f, head, sizeof(head), writeResult);
+ BlockWrite(f, image^.buffer^, size, writeResult);
Close(f);
end
else
@@ -275,6 +276,7 @@
var convertedSurf: PSDL_Surface;
begin
doSurfaceConversion:= tmpsurf;
+{$IFNDEF WEBGL}
if ((tmpsurf^.format^.bitsperpixel = 32) and (tmpsurf^.format^.rshift > tmpsurf^.format^.bshift)) or
(tmpsurf^.format^.bitsperpixel = 24) then
begin
@@ -282,6 +284,7 @@
SDL_FreeSurface(tmpsurf);
doSurfaceConversion:= convertedSurf;
end;
+{$ENDIF}
end;
{$IFDEF SDL13}
@@ -314,4 +317,4 @@
SDL_FreeFormat(conversionFormat);
end;
-end.
+end.
--- a/hedgewars/uPhysFSLayer.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uPhysFSLayer.pas Sun Jan 27 00:28:57 2013 +0100
@@ -39,12 +39,15 @@
function physfsReader(L: Plua_State; f: PFSFile; sz: Psize_t) : PChar; cdecl; external PhysfsLibName;
procedure physfsReaderSetBuffer(buf: pointer); cdecl; external PhysfsLibName;
+{$IFNDEF PAS2C}
+//apparently pas2c doesn't render the functions below if it finds 'implementation' first
implementation
uses uUtils, uVariables, sysutils;
+{$ENDIF}
-function PHYSFS_init(argv0: PChar) : LongInt; cdecl; external PhysfsLibName;
-function PHYSFS_deinit() : LongInt; cdecl; external PhysfsLibName;
-function PHYSFSRWOPS_openRead(fname: PChar): PSDL_RWops; cdecl ; external PhysfsLibName;
+function PHYSFS_init(argv: PChar): LongInt; cdecl; external PhysfsLibName;
+function PHYSFS_deinit: LongInt; cdecl; external PhysfsLibName;
+function PHYSFSRWOPS_openRead(fname: PChar): PSDL_RWops; cdecl; external PhysfsLibName;
function PHYSFSRWOPS_openWrite(fname: PChar): PSDL_RWops; cdecl; external PhysfsLibName;
function PHYSFS_mount(newDir, mountPoint: PChar; appendToPath: LongBool) : LongInt; cdecl; external PhysfsLibName;
@@ -54,7 +57,14 @@
function PHYSFS_close(f: PFSFile): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_exists(fname: PChar): LongBool; cdecl; external PhysfsLibName;
-procedure hedgewarsMountPackages(); cdecl; external PhysfsLibName;
+procedure hedgewarsMountPackages; cdecl; external PhysfsLibName;
+
+{$IFDEF PAS2C}
+implementation
+uses uUtils, uVariables;
+{$ENDIF}
+
+(*****************************************************************)
function rwopsOpenRead(fname: shortstring): PSDL_RWops;
begin
@@ -118,7 +128,7 @@
b[0]:= #0
end
end;
-
+
s:= s + b
end;
--- a/hedgewars/uRandom.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uRandom.pas Sun Jan 27 00:28:57 2013 +0100
@@ -31,7 +31,7 @@
uses uFloat;
procedure SetRandomSeed(Seed: shortstring); // Sets the seed that should be used for generating pseudo-random values.
-function GetRandomf: hwFloat; overload; // Returns a pseudo-random hwFloat.
+function GetRandomf: hwFloat; // Returns a pseudo-random hwFloat.
function GetRandom(m: LongWord): LongWord; overload; inline; // Returns a positive pseudo-random integer smaller than m.
procedure AddRandomness(r: LongWord); inline;
function rndSign(num: hwFloat): hwFloat; // Returns num with a random chance of having a inverted sign.
@@ -45,10 +45,11 @@
procedure AddRandomness(r: LongWord); inline;
begin
n:= (n + 1) and $3F;
-cirbuf[n]:= cirbuf[n] xor r
+ cirbuf[n]:= cirbuf[n] xor r;
end;
function GetNext: Longword; inline;
+var s : string;
begin
n:= (n + 1) and $3F;
cirbuf[n]:=
@@ -56,7 +57,8 @@
cirbuf[(n + 9) and $3F]) {n - 55 mod 64}
and $7FFFFFFF; {mod 2^31}
-GetNext:= cirbuf[n]
+ GetNext:= cirbuf[n];
+ str(GetNext, s);
end;
procedure SetRandomSeed(Seed: shortstring);
@@ -74,7 +76,7 @@
cirbuf[i]:= $A98765 + 68; // odd number
for i:= 0 to 1023 do
- GetNext
+ GetNext;
end;
function GetRandomf: hwFloat;
@@ -84,7 +86,7 @@
GetRandomf.QWordValue:= GetNext
end;
-function GetRandom(m: LongWord): LongWord; inline;
+function GetRandom(m: LongWord): LongWord; overload; inline;
begin
GetNext;
GetRandom:= GetNext mod m
--- a/hedgewars/uRender.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uRender.pas Sun Jan 27 00:28:57 2013 +0100
@@ -17,12 +17,13 @@
*)
{$INCLUDE "options.inc"}
+{$IF GLunit = GL}{$DEFINE GLunit:=GL,GLext}{$ENDIF}
unit uRender;
interface
-uses SDLh, uTypes, GLunit, uConsts;
+uses SDLh, uTypes, GLunit, uConsts, uStore, uMatrix;
procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt);
procedure DrawSprite (Sprite: TSprite; X, Y, FrameX, FrameY: LongInt);
@@ -51,7 +52,6 @@
procedure Tint (r, g, b, a: Byte); inline;
procedure Tint (c: Longword); inline;
-
implementation
uses uVariables;
@@ -74,7 +74,7 @@
begin
DrawTextureFromRect(X, Y, r^.w, r^.h, r, SourceTexture)
end;
-
+{
procedure DrawTextureFromRect(X, Y, W, H: LongInt; r: PSDL_Rect; SourceTexture: PTexture);
var rr: TSDL_Rect;
_l, _r, _t, _b: real;
@@ -121,6 +121,63 @@
glVertexPointer(2, GL_FLOAT, 0, @VertexBuffer[0]);
glTexCoordPointer(2, GL_FLOAT, 0, @TextureBuffer[0]);
+glDrawArrays(GL_TRIANGLE_FAN, 0, High(VertexBuffer) - Low(VertexBuffer) + 1);
+end;
+}
+
+procedure DrawTextureFromRect(X, Y, W, H: LongInt; r: PSDL_Rect; SourceTexture: PTexture);
+var
+ rr: TSDL_Rect;
+ VertexBuffer, TextureBuffer: array [0..3] of TVertex2f;
+ //VertexBuffer, TextureBuffer: TVertexRect;
+ _l, _r, _t, _b: GLfloat;
+begin
+if (SourceTexture^.h = 0) or (SourceTexture^.w = 0) then
+ exit;
+
+// do not draw anything outside the visible screen space (first check fixes some sprite drawing, e.g. hedgehogs)
+if (abs(X) > W) and ((abs(X + W / 2) - W / 2) > cScreenWidth / cScaleFactor) then
+ exit;
+if (abs(Y) > H) and ((abs(Y + H / 2 - (0.5 * cScreenHeight)) - H / 2) > cScreenHeight / cScaleFactor) then
+ exit;
+
+rr.x:= X;
+rr.y:= Y;
+rr.w:= W;
+rr.h:= H;
+
+_l:= r^.x / SourceTexture^.w * SourceTexture^.rx;
+_r:= (r^.x + r^.w) / SourceTexture^.w * SourceTexture^.rx;
+_t:= r^.y / SourceTexture^.h * SourceTexture^.ry;
+_b:= (r^.y + r^.h) / SourceTexture^.h * SourceTexture^.ry;
+
+glBindTexture(GL_TEXTURE_2D, SourceTexture^.id);
+
+VertexBuffer[0].X:= X;
+VertexBuffer[0].Y:= Y;
+VertexBuffer[1].X:= rr.w + X;
+VertexBuffer[1].Y:= Y;
+VertexBuffer[2].X:= rr.w + X;
+VertexBuffer[2].Y:= rr.h + Y;
+VertexBuffer[3].X:= X;
+VertexBuffer[3].Y:= rr.h + Y;
+
+TextureBuffer[0].X:= _l;
+TextureBuffer[0].Y:= _t;
+TextureBuffer[1].X:= _r;
+TextureBuffer[1].Y:= _t;
+TextureBuffer[2].X:= _r;
+TextureBuffer[2].Y:= _b;
+TextureBuffer[3].X:= _l;
+TextureBuffer[3].Y:= _b;
+
+SetVertexPointer(@VertexBuffer[0], Length(VertexBuffer));
+SetTexCoordPointer(@TextureBuffer[0], Length(VertexBuffer));
+
+{$IFDEF GL2}
+UpdateModelviewProjection;
+{$ENDIF}
+
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(VertexBuffer));
end;
@@ -132,17 +189,30 @@
procedure DrawTexture(X, Y: LongInt; Texture: PTexture; Scale: GLfloat);
begin
+{$IFDEF GL2}
+hglPushMatrix;
+hglTranslatef(X, Y, 0);
+hglScalef(Scale, Scale, 1);
+{$ELSE}
glPushMatrix;
glTranslatef(X, Y, 0);
glScalef(Scale, Scale, 1);
+{$ENDIF}
glBindTexture(GL_TEXTURE_2D, Texture^.id);
-glVertexPointer(2, GL_FLOAT, 0, @Texture^.vb);
-glTexCoordPointer(2, GL_FLOAT, 0, @Texture^.tb);
+SetVertexPointer(@Texture^.vb, Length(Texture^.vb));
+SetTexCoordPointer(@Texture^.tb, Length(Texture^.vb));
+
+{$IFDEF GL2}
+UpdateModelviewProjection;
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(Texture^.vb));
+hglPopMatrix;
+{$ELSE}
+glDrawArrays(GL_TRIANGLE_FAN, 0, Length(Texture^.vb));
+glPopMatrix;
+{$ENDIF}
-glPopMatrix
end;
procedure DrawTextureF(Texture: PTexture; Scale: GLfloat; X, Y, Frame, Dir, w, h: LongInt);
@@ -161,14 +231,25 @@
if (abs(Y) > H) and ((abs(Y + OffsetY - (0.5 * cScreenHeight)) - W / 2) * cScaleFactor > cScreenHeight) then
exit;
+{$IFDEF GL2}
+hglPushMatrix;
+hglTranslatef(X, Y, 0);
+{$ELSE}
glPushMatrix;
glTranslatef(X, Y, 0);
+{$ENDIF}
+
if Dir = 0 then Dir:= 1;
+{$IFDEF GL2}
+hglRotatef(Angle, 0, 0, Dir);
+hglTranslatef(Dir*OffsetX, OffsetY, 0);
+hglScalef(Scale, Scale, 1);
+{$ELSE}
glRotatef(Angle, 0, 0, Dir);
-
glTranslatef(Dir*OffsetX, OffsetY, 0);
glScalef(Scale, Scale, 1);
+{$ENDIF}
// Any reason for this call? And why only in t direction, not s?
//glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
@@ -203,11 +284,21 @@
TextureBuffer[3].X:= fl;
TextureBuffer[3].Y:= fb;
-glVertexPointer(2, GL_FLOAT, 0, @VertexBuffer[0]);
-glTexCoordPointer(2, GL_FLOAT, 0, @TextureBuffer[0]);
+SetVertexPointer(@VertexBuffer[0], Length(VertexBuffer));
+SetTexCoordPointer(@TextureBuffer[0], Length(VertexBuffer));
+
+{$IFDEF GL2}
+UpdateModelviewProjection;
+{$ENDIF}
+
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(VertexBuffer));
-glPopMatrix
+{$IFDEF GL2}
+hglPopMatrix;
+{$ELSE}
+glPopMatrix;
+{$ENDIF}
+
end;
procedure DrawSpriteRotated(Sprite: TSprite; X, Y, Dir: LongInt; Angle: real);
@@ -220,19 +311,42 @@
procedure DrawSpriteRotatedF(Sprite: TSprite; X, Y, Frame, Dir: LongInt; Angle: real);
begin
+
+{$IFDEF GL2}
+hglPushMatrix;
+hglTranslatef(X, Y, 0);
+{$ELSE}
glPushMatrix;
glTranslatef(X, Y, 0);
+{$ENDIF}
if Dir < 0 then
+{$IFDEF GL2}
+ hglRotatef(Angle, 0, 0, -1)
+{$ELSE}
glRotatef(Angle, 0, 0, -1)
+{$ENDIF}
else
+{$IFDEF GL2}
+ hglRotatef(Angle, 0, 0, 1);
+{$ELSE}
glRotatef(Angle, 0, 0, 1);
+{$ENDIF}
if Dir < 0 then
+{$IFDEF GL2}
+ hglScalef(-1.0, 1.0, 1.0);
+{$ELSE}
glScalef(-1.0, 1.0, 1.0);
+{$ENDIF}
DrawSprite(Sprite, -SpritesData[Sprite].Width div 2, -SpritesData[Sprite].Height div 2, Frame);
-glPopMatrix
+{$IFDEF GL2}
+hglPopMatrix;
+{$ELSE}
+glPopMatrix;
+{$ENDIF}
+
end;
procedure DrawTextureRotated(Texture: PTexture; hw, hh, X, Y, Dir: LongInt; Angle: real);
@@ -244,17 +358,29 @@
if (abs(Y) > 2 * hh) and ((abs(Y - 0.5 * cScreenHeight) - hh) > cScreenHeight / cScaleFactor) then
exit;
+{$IFDEF GL2}
+hglPushMatrix;
+hglTranslatef(X, Y, 0);
+{$ELSE}
glPushMatrix;
glTranslatef(X, Y, 0);
+{$ENDIF}
if Dir < 0 then
begin
hw:= - hw;
+{$IFDEF GL2}
+ hglRotatef(Angle, 0, 0, -1);
+{$ELSE}
glRotatef(Angle, 0, 0, -1);
+{$ENDIF}
end
else
- glRotatef(Angle, 0, 0, 1);
-
+{$IFDEF GL2}
+ hglRotatef(Angle, 0, 0, 1);
+{$ELSE}
+ glRotatef(Angle, 0, 0, 1);
+{$ENDIF}
glBindTexture(GL_TEXTURE_2D, Texture^.id);
@@ -267,11 +393,21 @@
VertexBuffer[3].X:= -hw;
VertexBuffer[3].Y:= hh;
-glVertexPointer(2, GL_FLOAT, 0, @VertexBuffer[0]);
-glTexCoordPointer(2, GL_FLOAT, 0, @Texture^.tb);
+SetVertexPointer(@VertexBuffer[0], Length(VertexBuffer));
+SetTexCoordPointer(@Texture^.tb, Length(VertexBuffer));
+
+{$IFDEF GL2}
+UpdateModelviewProjection;
+{$ENDIF}
+
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(VertexBuffer));
-glPopMatrix
+{$IFDEF GL2}
+hglPopMatrix;
+{$ELSE}
+glPopMatrix;
+{$ENDIF}
+
end;
procedure DrawSprite(Sprite: TSprite; X, Y, Frame: LongInt);
@@ -330,10 +466,11 @@
end;
procedure DrawLine(X0, Y0, X1, Y1, Width: Single; r, g, b, a: Byte);
-var VertexBuffer: array [0..3] of TVertex2f;
+var VertexBuffer: array [0..1] of TVertex2f;
begin
+ glEnable(GL_LINE_SMOOTH);
+{$IFNDEF GL2}
glDisable(GL_TEXTURE_2D);
- glEnable(GL_LINE_SMOOTH);
glPushMatrix;
glTranslatef(WorldDx, WorldDy, 0);
@@ -345,13 +482,37 @@
VertexBuffer[1].X:= X1;
VertexBuffer[1].Y:= Y1;
- glVertexPointer(2, GL_FLOAT, 0, @VertexBuffer[0]);
+ SetVertexPointer(@VertexBuffer[0], Length(VertexBuffer));
glDrawArrays(GL_LINES, 0, Length(VertexBuffer));
Tint($FF, $FF, $FF, $FF);
-
+
glPopMatrix;
-
+
glEnable(GL_TEXTURE_2D);
+
+{$ELSE}
+ EnableTexture(False);
+
+ hglPushMatrix;
+ hglTranslatef(WorldDx, WorldDy, 0);
+ glLineWidth(Width);
+
+ UpdateModelviewProjection;
+
+ Tint(r, g, b, a);
+ VertexBuffer[0].X:= X0;
+ VertexBuffer[0].Y:= Y0;
+ VertexBuffer[1].X:= X1;
+ VertexBuffer[1].Y:= Y1;
+
+ SetVertexPointer(@VertexBuffer[0], Length(VertexBuffer));
+ glDrawArrays(GL_LINES, 0, Length(VertexBuffer));
+ Tint($FF, $FF, $FF, $FF);
+
+ hglPopMatrix;
+ EnableTexture(True);
+
+{$ENDIF}
glDisable(GL_LINE_SMOOTH);
end;
@@ -359,12 +520,17 @@
var VertexBuffer: array [0..3] of TVertex2f;
begin
// do not draw anything outside the visible screen space (first check fixes some sprite drawing, e.g. hedgehogs)
+
if (abs(r.x) > r.w) and ((abs(r.x + r.w / 2) - r.w / 2) * cScaleFactor > cScreenWidth) then
exit;
if (abs(r.y) > r.h) and ((abs(r.y + r.h / 2 - (0.5 * cScreenHeight)) - r.h / 2) * cScaleFactor > cScreenHeight) then
exit;
+{$IFDEF GL2}
+EnableTexture(False);
+{$ELSE}
glDisable(GL_TEXTURE_2D);
+{$ENDIF}
Tint($00, $00, $00, $80);
@@ -377,21 +543,27 @@
VertexBuffer[3].X:= r.x;
VertexBuffer[3].Y:= r.y + r.h;
-glVertexPointer(2, GL_FLOAT, 0, @VertexBuffer[0]);
+SetVertexPointer(@VertexBuffer[0], Length(VertexBuffer));
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(VertexBuffer));
Tint($FF, $FF, $FF, $FF);
+
+{$IFDEF GL2}
+EnableTexture(True);
+{$ELSE}
glEnable(GL_TEXTURE_2D)
+{$ENDIF}
+
end;
-procedure DrawCircle(X, Y, Radius, Width: LongInt; r, g, b, a: Byte);
+procedure DrawCircle(X, Y, Radius, Width: LongInt; r, g, b, a: Byte);
begin
Tint(r, g, b, a);
- DrawCircle(X, Y, Radius, Width);
+ DrawCircle(X, Y, Radius, Width);
Tint($FF, $FF, $FF, $FF);
end;
-procedure DrawCircle(X, Y, Radius, Width: LongInt);
+procedure DrawCircle(X, Y, Radius, Width: LongInt);
var
i: LongInt;
CircleVertex: array [0..59] of TVertex2f;
@@ -400,6 +572,9 @@
CircleVertex[i].X := X + Radius*cos(i*pi/30);
CircleVertex[i].Y := Y + Radius*sin(i*pi/30);
end;
+
+{$IFNDEF GL2}
+
glDisable(GL_TEXTURE_2D);
glEnable(GL_LINE_SMOOTH);
glPushMatrix;
@@ -409,6 +584,18 @@
glPopMatrix;
glEnable(GL_TEXTURE_2D);
glDisable(GL_LINE_SMOOTH);
+
+{$ELSE}
+ EnableTexture(False);
+ glEnable(GL_LINE_SMOOTH);
+ hglPushMatrix;
+ glLineWidth(Width);
+ SetVertexPointer(@CircleVertex[0], 60);
+ glDrawArrays(GL_LINE_LOOP, 0, 60);
+ hglPopMatrix;
+ EnableTexture(True);
+ glDisable(GL_LINE_SMOOTH);
+{$ENDIF}
end;
@@ -441,10 +628,15 @@
r:= (Step + 1) * 32 / HHTexture^.w
end;
-
+{$IFDEF GL2}
+ hglPushMatrix();
+ hglTranslatef(X, Y, 0);
+ hglRotatef(Angle, 0, 0, 1);
+{$ELSE}
glPushMatrix();
glTranslatef(X, Y, 0);
glRotatef(Angle, 0, 0, 1);
+{$ENDIF}
glBindTexture(GL_TEXTURE_2D, HHTexture^.id);
@@ -457,11 +649,20 @@
TextureBuffer[3].X:= l;
TextureBuffer[3].Y:= b;
- glVertexPointer(2, GL_FLOAT, 0, @VertexBuffer[0]);
- glTexCoordPointer(2, GL_FLOAT, 0, @TextureBuffer[0]);
+ SetVertexPointer(@VertexBuffer[0], Length(VertexBuffer));
+ SetTexCoordPointer(@TextureBuffer[0], Length(VertexBuffer));
+
+{$IFDEF GL2}
+ UpdateModelviewProjection;
+{$ENDIF}
+
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(VertexBuffer));
- glPopMatrix
+{$IFDEF GL2}
+ hglPopMatrix;
+{$ELSE}
+ glPopMatrix;
+{$ENDIF}
end;
procedure DrawScreenWidget(widget: POnScreenWidget);
@@ -475,9 +676,9 @@
if RealTicks > (fadeAnimStart + FADE_ANIM_TIME) then
fadeAnimStart:= 0
else
- if show then
+ if show then
alpha:= Byte(trunc((RealTicks - fadeAnimStart)/FADE_ANIM_TIME * $FF))
- else
+ else
alpha:= Byte($FF - trunc((RealTicks - fadeAnimStart)/FADE_ANIM_TIME * $FF));
end;
@@ -507,12 +708,14 @@
end;
{$ELSE}
begin
-widget:= widget; // avoid hint
+{widget:= widget; // avoid hint}
{$ENDIF}
end;
procedure Tint(r, g, b, a: Byte); inline;
-var nc, tw: Longword;
+var
+ nc, tw: Longword;
+ scale:Real = 1.0/255.0;
begin
nc:= (a shl 24) or (b shl 16) or (g shl 8) or r;
@@ -529,7 +732,12 @@
b:= tw
end;
+ {$IFDEF GL2}
+ glUniform4f(uMainTintLocation, r*scale, g*scale, b*scale, a*scale);
+ //glColor4ub(r, g, b, a);
+ {$ELSE}
glColor4ub(r, g, b, a);
+ {$ENDIF}
lastTint:= nc;
end;
@@ -538,4 +746,5 @@
Tint(((c shr 24) and $FF), ((c shr 16) and $FF), (c shr 8) and $FF, (c and $FF))
end;
+
end.
--- a/hedgewars/uRenderUtils.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uRenderUtils.pas Sun Jan 27 00:28:57 2013 +0100
@@ -68,7 +68,7 @@
r.y:= rect^.y + 2;
r.w:= rect^.w - 2;
r.h:= rect^.h - 4;
- SDL_FillRect(Surface, @r, FillColor)
+ SDL_FillRect(Surface, @r, FillColor);
end;
(*
function WriteInRoundRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: ansistring): TSDL_Rect;
@@ -115,6 +115,7 @@
pixels: PLongWordArray;
begin
TryDo(Surface^.format^.BytesPerPixel = 4, 'flipSurface failed, expecting 32 bit surface', true);
+ SDL_LockSurface(Surface);
pixels:= Surface^.pixels;
if Vertical then
for y := 0 to (Surface^.h div 2) - 1 do
@@ -136,6 +137,7 @@
pixels^[i]:= pixels^[j];
pixels^[j]:= tmpPixel;
end;
+ SDL_UnlockSurface(Surface);
end;
procedure copyToXY(src, dest: PSDL_Surface; destX, destY: LongInt); inline;
@@ -150,6 +152,10 @@
begin
maxDest:= (dest^.pitch div 4) * dest^.h;
maxSrc:= (src^.pitch div 4) * src^.h;
+
+ SDL_LockSurface(src);
+ SDL_LockSurface(dest);
+
srcPixels:= src^.pixels;
destPixels:= dest^.pixels;
@@ -169,6 +175,9 @@
destPixels^[i]:= SDL_MapRGBA(dest^.format, r0, g0, b0, a0);
end;
end;
+
+ SDL_UnlockSurface(src);
+ SDL_UnlockSurface(dest);
end;
procedure DrawSprite2Surf(sprite: TSprite; dest: PSDL_Surface; x,y: LongInt); inline;
@@ -199,6 +208,9 @@
begin
//max:= (dest^.pitch div 4) * dest^.h;
yMax:= dest^.pitch div 4;
+
+ SDL_LockSurface(dest);
+
destPixels:= dest^.pixels;
dx:= abs(x1-x0);
@@ -225,7 +237,8 @@
err:= err + dx;
y0:=y0+sy
end;
- end;
+ end;
+ SDL_UnlockSurface(dest);
end;
procedure copyRotatedSurface(src, dest: PSDL_Surface); // this is necessary since width/height are read only in SDL, apparently
@@ -235,6 +248,9 @@
TryDo(src^.format^.BytesPerPixel = 4, 'rotateSurface failed, expecting 32 bit surface', true);
TryDo(dest^.format^.BytesPerPixel = 4, 'rotateSurface failed, expecting 32 bit surface', true);
+ SDL_LockSurface(src);
+ SDL_LockSurface(dest);
+
srcPixels:= src^.pixels;
destPixels:= dest^.pixels;
@@ -246,6 +262,10 @@
destPixels^[j]:= srcPixels^[i];
inc(j)
end;
+
+ SDL_UnlockSurface(src);
+ SDL_UnlockSurface(dest);
+
end;
function RenderStringTex(s: ansistring; Color: Longword; font: THWFont): PTexture;
@@ -282,11 +302,11 @@
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
- case SpeechType of
+ case SpeechType of
1: begin;
edge:= sprSpeechEdge;
corner:= sprSpeechCorner;
@@ -326,7 +346,7 @@
begin
w:= 0;
i:= round(Sqrt(length(s)) * 2);
- s:= WrapText(s, #1, chars, i);
+ // s:= WrapText(s, #1, chars, i);
pos:= 1; prevpos:= 0; line:= 0;
// Find the longest line for the purposes of centring the text. Font dependant.
while pos <= length(s) do
@@ -463,6 +483,7 @@
SDL_FreeSurface(rotatedEdge);
SDL_FreeSurface(finalSurface);
+
end;
end.
--- a/hedgewars/uScript.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uScript.pas Sun Jan 27 00:28:57 2013 +0100
@@ -81,7 +81,7 @@
uTextures,
uLandGraphics,
SDLh,
- SysUtils,
+ SysUtils,
uIO,
uPhysFSLayer
;
@@ -112,7 +112,7 @@
function lc_band(L: PLua_State): LongInt; Cdecl;
begin
- if lua_gettop(L) <> 2 then
+ if lua_gettop(L) <> 2 then
begin
LuaError('Lua: Wrong number of parameters passed to band!');
lua_pushnil(L);
@@ -124,7 +124,7 @@
function lc_bor(L: PLua_State): LongInt; Cdecl;
begin
- if lua_gettop(L) <> 2 then
+ if lua_gettop(L) <> 2 then
begin
LuaError('Lua: Wrong number of parameters passed to bor!');
lua_pushnil(L);
@@ -136,19 +136,19 @@
function lc_bnot(L: PLua_State): LongInt; Cdecl;
begin
- if lua_gettop(L) <> 1 then
+ if lua_gettop(L) <> 1 then
begin
LuaError('Lua: Wrong number of parameters passed to bnot!');
lua_pushnil(L);
end
else
- lua_pushinteger(L, not lua_tointeger(L, 1));
+ lua_pushinteger(L, (not lua_tointeger(L, 1)));
lc_bnot := 1;
end;
function lc_div(L: PLua_State): LongInt; Cdecl;
begin
- if lua_gettop(L) <> 2 then
+ if lua_gettop(L) <> 2 then
begin
LuaError('Lua: Wrong number of parameters passed to div!');
lua_pushnil(L);
@@ -303,7 +303,7 @@
HealthCrate, lua_toboolean(L, 3), lua_toboolean(L, 4));
lua_pushinteger(L, gear^.uid);
end;
- lc_spawnfakehealthcrate := 1;
+ lc_spawnfakehealthcrate := 1;
end;
function lc_spawnfakeammocrate(L: PLua_State): LongInt; Cdecl;
@@ -332,7 +332,7 @@
lua_pushnil(L);
end
else
- begin
+ begin
gear := SpawnFakeCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2),
UtilityCrate, lua_toboolean(L, 3), lua_toboolean(L, 4));
lua_pushinteger(L, gear^.uid);
@@ -361,7 +361,7 @@
else
lua_pushnil(L);
end;
- lc_spawnhealthcrate := 1;
+ lc_spawnhealthcrate := 1;
end;
function lc_spawnammocrate(L: PLua_State): LongInt; Cdecl;
@@ -374,7 +374,7 @@
end
else
begin
- if (lua_gettop(L) = 3) then
+ if (lua_gettop(L) = 3) then
gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), AmmoCrate, lua_tointeger(L, 3), 0)
else gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), AmmoCrate, lua_tointeger(L, 3), lua_tointeger(L, 4));
if gear <> nil then
@@ -470,7 +470,7 @@
c:= lua_toboolean(L, 5);
vg:= AddVisualGear(x, y, vgt, s, c);
- if vg <> nil then
+ if vg <> nil then
begin
lastVisualGearByUID:= vg;
lua_pushinteger(L, vg^.uid)
@@ -794,7 +794,7 @@
for j:= 0 to 7 do
begin
hh:= team^.Hedgehogs[j];
- if (hh.Gear <> nil) or (hh.GearHidden <> nil) then
+ if (hh.Gear <> nil) or (hh.GearHidden <> nil) then
begin
FreeTexture(hh.NameTagTex);
hh.NameTagTex:= RenderStringTex(hh.Name, clan^.Color, fnt16);
@@ -1053,7 +1053,7 @@
prevgear^.Z := cHHZ;
prevgear^.Message:= prevgear^.Message or gmRemoveFromList or gmAddToList;
end;
-
+
SwitchCurrentHedgehog(gear^.Hedgehog);
CurrentTeam:= CurrentHedgehog^.Team;
@@ -1076,7 +1076,7 @@
if (gear <> nil) and (gear^.Hedgehog <> nil) then
AddAmmoAmount(gear^.Hedgehog^, TAmmoType(lua_tointeger(L, 2)), lua_tointeger(L,3) );
end else
-
+
if lua_gettop(L) = 2 then
begin
gear:= GearByUID(lua_tointeger(L, 1));
@@ -1114,7 +1114,7 @@
if (lua_gettop(L) = 2) then
begin
gear:= GearByUID(lua_tointeger(L, 1));
- if (gear <> nil) and (gear^.Hedgehog <> nil) then
+ if (gear <> nil) and (gear^.Hedgehog <> nil) then
begin
ammo:= GetAmmoEntry(gear^.Hedgehog^, TAmmoType(lua_tointeger(L, 2)));
if ammo^.AmmoType = amNothing then
@@ -1124,7 +1124,7 @@
end
else lua_pushinteger(L, 0)
end
- else
+ else
begin
LuaError('Lua: Wrong number of parameters passed to GetAmmoCount!');
lua_pushnil(L)
@@ -1147,7 +1147,7 @@
gear^.Health:= lua_tointeger(L, 2);
if (gear^.Kind = gtHedgehog) and (gear^.Hedgehog <> nil) then
- begin
+ begin
RenderHealth(gear^.Hedgehog^);
RecountTeamHealth(gear^.Hedgehog^.Team)
end;
@@ -1280,7 +1280,9 @@
function lc_endgame(L : Plua_State) : LongInt; Cdecl;
begin
+ {$IFNDEF PAS2C}
L:= L; // avoid compiler hint
+ {$ENDIF}
GameState:= gsExit;
lc_endgame:= 0
end;
@@ -1969,7 +1971,7 @@
if StoreCnt-1 < k then AddAmmoStore;
inc(k)
end
-else
+else
for i:= 0 to Pred(TeamsCount) do
begin
for j:= 0 to Pred(TeamsArray[i]^.HedgehogsNumber) do
@@ -2021,7 +2023,7 @@
exit;
f:= pfsOpenRead(s);
-if f = nil then
+if f = nil then
exit;
physfsReaderSetBuffer(@buf);
@@ -2070,7 +2072,7 @@
procedure ScriptCall(fname : shortstring);
begin
-if not ScriptLoaded or (not ScriptExists(fname)) then
+if (not ScriptLoaded) or (not ScriptExists(fname)) then
exit;
SetGlobals;
lua_getglobal(luaState, Str2PChar(fname));
@@ -2121,7 +2123,7 @@
function ScriptCall(fname : shortstring; par1, par2, par3, par4 : LongInt) : LongInt;
begin
-if not ScriptLoaded or (not ScriptExists(fname)) then
+if (not ScriptLoaded) or (not ScriptExists(fname)) then
exit;
SetGlobals;
lua_getglobal(luaState, Str2PChar(fname));
@@ -2218,7 +2220,7 @@
AddAmmoStore;
TeamsArray[i]^.Hedgehogs[j].AmmoStore:= StoreCnt - 1
end
-else
+else
for i:= 0 to Pred(TeamsCount) do
begin
if ScriptExists('onNewAmmoStore') then
--- a/hedgewars/uSound.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uSound.pas Sun Jan 27 00:28:57 2013 +0100
@@ -311,7 +311,7 @@
WriteLnToConsole(msgOK);
Mix_AllocateChannels(Succ(chanTPU));
- ChangeVolume(cInitVolume);
+ ChangeVolume(cInitVolume);
end;
procedure ResetSound;
@@ -448,7 +448,7 @@
i:= 0;
while (i<High(VoiceList)) and (VoiceList[i].snd = sndNone) do
inc(i);
-
+
if (VoiceList[i].snd <> sndNone) then
begin
LastVoice.snd:= VoiceList[i].snd;
--- a/hedgewars/uStore.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uStore.pas Sun Jan 27 00:28:57 2013 +0100
@@ -55,6 +55,17 @@
procedure WarpMouse(x, y: Word); inline;
procedure SwapBuffers; {$IFDEF USE_VIDEO_RECORDING}cdecl{$ELSE}inline{$ENDIF};
+{$IFDEF GL2}
+procedure UpdateModelviewProjection;
+procedure EnableTexture(enable:Boolean);
+{$ENDIF}
+
+procedure SetTexCoordPointer(p: Pointer;n: Integer);
+procedure SetVertexPointer(p: Pointer;n: Integer);
+procedure SetColorPointer(p: Pointer;n: Integer);
+procedure BeginWater;
+procedure EndWater;
+
implementation
uses uMisc, uConsole, uVariables, uUtils, uTextures, uRender, uRenderUtils, uCommands
, uPhysFSLayer
@@ -75,7 +86,18 @@
numsquares : LongInt;
ProgrTex: PTexture;
-const
+{$IFDEF GL2}
+ shaderMain: GLuint;
+ shaderWater: GLuint;
+
+ // attributes
+{$ENDIF}
+
+{$IFDEF WEBGL}
+ OpenGLSetupedBefore : boolean;
+{$ENDIF}
+
+const
cHHFileName = 'Hedgehog';
cCHFileName = 'Crosshair';
@@ -201,7 +223,7 @@
foundBot:= true;
// initially was going to do the highest botlevel of the team, but for now, just apply if entire team has same bot level
if maxLevel = -1 then maxLevel:= BotLevel
- else if (maxLevel > 0) and (maxLevel <> BotLevel) then maxLevel:= 0;
+ else if (maxLevel > 0) and (maxLevel <> BotLevel) then maxLevel:= 0;
//if (maxLevel > 0) and (BotLevel < maxLevel) then maxLevel:= BotLevel
end
else if Gear <> nil then maxLevel:= 0;
@@ -209,7 +231,7 @@
if foundBot then
begin
// disabled the plain flag - I think it looks ok even w/ full bars obscuring CPU
- //if (maxLevel > 0) and (maxLevel < 3) then Flag:= 'cpu_plain' else
+ //if (maxLevel > 0) and (maxLevel < 3) then Flag:= 'cpu_plain' else
Flag:= 'cpu'
end
else if (Flag = 'cpu') or (Flag = 'cpu_plain') then
@@ -219,10 +241,10 @@
TryDo(flagsurf <> nil, 'Failed to load flag "' + Flag + '" as well as the default flag', true);
case maxLevel of
- 1: copyToXY(SpritesData[sprBotlevels].Surface, flagsurf, 0, 0);
- 2: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 5, 2, 17, 13, 5, 2);
- 3: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 9, 5, 13, 10, 9, 5);
- 4: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 13, 9, 9, 6, 13, 9);
+ 1: copyToXY(SpritesData[sprBotlevels].Surface, flagsurf, 0, 0);
+ 2: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 5, 2, 17, 13, 5, 2);
+ 3: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 9, 5, 13, 10, 9, 5);
+ 4: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 13, 9, 9, 6, 13, 9);
5: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 17, 11, 5, 4, 17, 11)
end;
@@ -313,7 +335,7 @@
i, imflags: LongInt;
begin
AddFileLog('StoreLoad()');
-
+WriteLnToConsole('Entering StoreLoad');
if not reload then
for fi:= Low(THWFont) to High(THWFont) do
with Fontz[fi] do
@@ -384,7 +406,7 @@
if not reload then
begin
{$IFDEF USE_CONTEXT_RESTORE}
- Surface:= tmpsurf
+ Surface:= tmpsurf
{$ELSE}
if saveSurf then
Surface:= tmpsurf
@@ -442,6 +464,8 @@
if not reload then
AddProgress;
IMG_Quit();
+
+WriteLnToConsole('Leaving StoreLoad');
end;
{$IF DEFINED(USE_S3D_RENDERING) OR DEFINED(USE_VIDEO_RECORDING)}
@@ -666,6 +690,8 @@
function glLoadExtension(extension : shortstring) : boolean;
begin
+//TODO: pas2c doesn't handle {$IF (GLunit = gles11) OR DEFINED(PAS2C)}
+{$IFNDEF PAS2C}
{$IF GLunit = gles11}
// FreePascal doesnt come with OpenGL ES 1.1 Extension headers
extension:= extension; // avoid hint
@@ -678,6 +704,7 @@
else
AddFileLog('OpenGL - "' + extension + '" failed to load');
{$ENDIF}
+{$ENDIF}
end;
procedure SetupOpenGLAttributes;
@@ -700,12 +727,117 @@
SDL_GL_SetAttribute(SDL_GL_ACCELERATED_VISUAL, 1); // try to prefer hardware rendering
end;
+{$IFDEF GL2}
+function CompileShader(shaderFile: string; shaderType: GLenum): GLuint;
+var
+ shader: GLuint;
+ f: Textfile;
+ source, line: AnsiString;
+ sourceA: Pchar;
+ lengthA: GLint;
+ compileResult: GLint;
+ logLength: GLint;
+ log: PChar;
+begin
+ Assign(f, PathPrefix + cPathz[ptShaders] + '/' + shaderFile);
+ filemode:= 0; // readonly
+ Reset(f);
+ if IOResult <> 0 then
+ begin
+ AddFileLog('Unable to load ' + shaderFile);
+ halt(-1);
+ end;
+
+ source:='';
+ while not eof(f) do
+ begin
+ ReadLn(f, line);
+ source:= source + line + #10;
+ end;
+
+ Close(f);
+
+ WriteLnToConsole('Compiling shader: ' + PathPrefix + cPathz[ptShaders] + '/' + shaderFile);
+
+ sourceA:=PChar(source);
+ lengthA:=Length(source);
+
+ shader:=glCreateShader(shaderType);
+ glShaderSource(shader, 1, @sourceA, @lengthA);
+ glCompileShader(shader);
+ glGetShaderiv(shader, GL_COMPILE_STATUS, @compileResult);
+ glGetShaderiv(shader, GL_INFO_LOG_LENGTH, @logLength);
+
+ if logLength > 1 then
+ begin
+ log := GetMem(logLength);
+ glGetShaderInfoLog(shader, logLength, nil, log);
+ WriteLnToConsole('========== Compiler log ==========');
+ WriteLnToConsole(shortstring(log));
+ WriteLnToConsole('===================================');
+ FreeMem(log, logLength);
+ end;
+
+ if compileResult <> GL_TRUE then
+ begin
+ WriteLnToConsole('Shader compilation failed, halting');
+ halt(-1);
+ end;
+
+ CompileShader:= shader;
+end;
+
+function CompileProgram(shaderName: string): GLuint;
+var
+ program_: GLuint;
+ vs, fs: GLuint;
+ linkResult: GLint;
+ logLength: GLint;
+ log: PChar;
+begin
+ program_:= glCreateProgram();
+ vs:= CompileShader(shaderName + '.vs', GL_VERTEX_SHADER);
+ fs:= CompileShader(shaderName + '.fs', GL_FRAGMENT_SHADER);
+ glAttachShader(program_, vs);
+ glAttachShader(program_, fs);
+
+ glBindAttribLocation(program_, aVertex, PChar('vertex'));
+ glBindAttribLocation(program_, aTexCoord, PChar('texcoord'));
+ glBindAttribLocation(program_, aColor, PChar('color'));
+
+ glLinkProgram(program_);
+ glDeleteShader(vs);
+ glDeleteShader(fs);
+
+ glGetProgramiv(program_, GL_LINK_STATUS, @linkResult);
+ glGetProgramiv(program_, GL_INFO_LOG_LENGTH, @logLength);
+
+ if logLength > 1 then
+ begin
+ log := GetMem(logLength);
+ glGetProgramInfoLog(program_, logLength, nil, log);
+ WriteLnToConsole('========== Compiler log ==========');
+ WriteLnToConsole(shortstring(log));
+ WriteLnToConsole('===================================');
+ FreeMem(log, logLength);
+ end;
+
+ if linkResult <> GL_TRUE then
+ begin
+ WriteLnToConsole('Linking program failed, halting');
+ halt(-1);
+ end;
+
+ CompileProgram:= program_;
+end;
+
+{$ENDIF}
+
procedure SetupOpenGL;
//var vendor: shortstring = '';
var buf: array[byte] of char;
-{$IFDEF USE_VIDEO_RECORDING}
- AuxBufNum: LongInt;
-{$ENDIF}
+{$IFDEF PAS2C}err: GLenum;{$ENDIF}
+{$IFDEF USE_VIDEO_RECORDING}AuxBufNum: LongInt;{$ENDIF}
tmpstr: AnsiString;
tmpint: LongInt;
tmpn: LongInt;
@@ -713,6 +845,19 @@
buf[0]:= char(0); // avoid compiler hint
AddFileLog('Setting up OpenGL (using driver: ' + shortstring(SDL_VideoDriverName(buf, sizeof(buf))) + ')');
+{$IFDEF WEBGL}
+ if OpenGLSetupedBefore then
+ begin
+ glViewport(0, 0, cScreenWidth, cScreenHeight);
+ hglMatrixMode(MATRIX_MODELVIEW);
+ hglLoadIdentity();
+ hglScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
+ hglTranslatef(0, -cScreenHeight / 2, 0);
+ exit;
+ end
+ OpenGLSetupedBefore := true;
+{$ENDIF}
+
{$IFDEF SDL13}
// this function creates an opengles1.1 context by default on mobile devices
// unless you un-comment this two attributes
@@ -733,11 +878,12 @@
end
else if (MaxTextureSize < 1024) and (MaxTextureSize >= 512) then
begin
- cReducedQuality := cReducedQuality or rqNoBackground;
+ cReducedQuality := cReducedQuality or rqNoBackground;
AddFileLog('Texture size too small for backgrounds, disabling.');
end;
-(* // find out which gpu we are using (for extension compatibility maybe?)
+(*
+ // find out which gpu we are using (for extension compatibility maybe?)
{$IFDEF IPHONEOS}
vendor:= vendor; // avoid hint
cGPUVendor:= gvApple;
@@ -764,8 +910,12 @@
glGetIntegerv(GL_AUX_BUFFERS, @AuxBufNum);
AddFileLog(' |----- Number of auxiliary buffers: ' + inttostr(AuxBufNum));
{$ENDIF}
+{$IFDEF PAS2C}
+
+ // doesn't seem to print >256 chars
+ AddFileLogRaw(PChar(glGetString(GL_EXTENSIONS)));
+{$ELSE}
AddFileLog(' \----- Extensions: ');
-{$IFNDEF PAS2C}
// fetch extentions and store them in string
tmpstr := StrPas(PChar(glGetString(GL_EXTENSIONS)));
tmpn := WordCount(tmpstr, [' ']);
@@ -783,9 +933,6 @@
tmpint := tmpint + 3;
end;
until (tmpint > tmpn);
-{$ELSE}
- // doesn't seem to print >256 chars
- AddFileLogRaw(PChar(glGetString(GL_EXTENSIONS)));
{$ENDIF}
AddFileLog('');
@@ -814,8 +961,41 @@
end;
{$ENDIF}
-{$IFDEF USE_S3D_RENDERING}
- if (cStereoMode = smHorizontal) or (cStereoMode = smVertical) then
+{$IFDEF GL2}
+
+{$IFDEF PAS2C}
+ err := glewInit();
+ if err <> GLEW_OK then
+ begin
+ WriteLnToConsole('Failed to initialize GLEW.');
+ halt;
+ end;
+{$ENDIF}
+
+{$IFNDEF PAS2C}
+ if not Load_GL_VERSION_2_0 then
+ halt;
+{$ENDIF}
+
+ shaderWater:= CompileProgram('water');
+ glUseProgram(shaderWater);
+ glUniform1i(glGetUniformLocation(shaderWater, pchar('tex0')), 0);
+ uWaterMVPLocation:= glGetUniformLocation(shaderWater, pchar('mvp'));
+
+ shaderMain:= CompileProgram('default');
+ glUseProgram(shaderMain);
+ glUniform1i(glGetUniformLocation(shaderMain, pchar('tex0')), 0);
+ uMainMVPLocation:= glGetUniformLocation(shaderMain, pchar('mvp'));
+ uMainTintLocation:= glGetUniformLocation(shaderMain, pchar('tint'));
+
+ uCurrentMVPLocation:= uMainMVPLocation;
+
+ Tint(255, 255, 255, 255);
+ UpdateModelviewProjection;
+{$ENDIF}
+
+{$IFNDEF USE_S3D_RENDERING}
+ if (cStereoMode = smHorizontal) or (cStereoMode = smVertical) or (cStereoMode = smAFR) then
begin
// prepare left and right frame buffers and associated textures
if glLoadExtension('GL_EXT_framebuffer_object') then
@@ -831,18 +1011,31 @@
end;
{$ENDIF}
- // set view port to whole window
- glViewport(0, 0, cScreenWidth, cScreenHeight);
+// set view port to whole window
+glViewport(0, 0, cScreenWidth, cScreenHeight);
+{$IFDEF GL2}
+ uMatrix.initModule;
+ hglMatrixMode(MATRIX_MODELVIEW);
+ // prepare default translation/scaling
+ hglLoadIdentity();
+ hglScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
+ hglTranslatef(0, -cScreenHeight / 2, 0);
+
+ EnableTexture(True);
+
+ glEnableVertexAttribArray(aVertex);
+ glEnableVertexAttribArray(aTexCoord);
+ glGenBuffers(1, @vBuffer);
+ glGenBuffers(1, @tBuffer);
+ glGenBuffers(1, @cBuffer);
+{$ELSE}
glMatrixMode(GL_MODELVIEW);
// prepare default translation/scaling
glLoadIdentity();
glScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
glTranslatef(0, -cScreenHeight / 2, 0);
- // enable alpha blending
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
// disable/lower perspective correction (will not need it anyway)
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST);
// disable dithering
@@ -851,8 +1044,92 @@
glEnable(GL_TEXTURE_2D);
glEnableClientState(GL_VERTEX_ARRAY);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
+{$ENDIF}
+
+ // enable alpha blending
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ // disable/lower perspective correction (will not need it anyway)
end;
+{$IFDEF GL2}
+procedure EnableTexture(enable:Boolean);
+begin
+ if enable then
+ glUniform1i(glGetUniformLocation(shaderMain, pchar('enableTexture')), 1)
+ else
+ glUniform1i(glGetUniformLocation(shaderMain, pchar('enableTexture')), 0);
+end;
+{$ENDIF}
+
+procedure SetTexCoordPointer(p: Pointer; n: Integer);
+begin
+ {$IFDEF GL2}
+ glBindBuffer(GL_ARRAY_BUFFER, tBuffer);
+ glBufferData(GL_ARRAY_BUFFER, sizeof(GLfloat) * n * 2, p, GL_STATIC_DRAW);
+ glEnableVertexAttribArray(aTexCoord);
+ glVertexAttribPointer(aTexCoord, 2, GL_FLOAT, GL_FALSE, 0, pointer(0));
+ {$ELSE}
+ glTexCoordPointer(2, GL_FLOAT, 0, p);
+ {$ENDIF}
+end;
+
+procedure SetVertexPointer(p: Pointer; n: Integer);
+begin
+ {$IFDEF GL2}
+ glBindBuffer(GL_ARRAY_BUFFER, vBuffer);
+ glBufferData(GL_ARRAY_BUFFER, sizeof(GLfloat) * n * 2, p, GL_STATIC_DRAW);
+ glEnableVertexAttribArray(aVertex);
+ glVertexAttribPointer(aVertex, 2, GL_FLOAT, GL_FALSE, 0, pointer(0));
+ {$ELSE}
+ glVertexPointer(2, GL_FLOAT, 0, p);
+ {$ENDIF}
+end;
+
+procedure SetColorPointer(p: Pointer; n: Integer);
+begin
+ {$IFDEF GL2}
+ glBindBuffer(GL_ARRAY_BUFFER, cBuffer);
+ glBufferData(GL_ARRAY_BUFFER, n * 4, p, GL_STATIC_DRAW);
+ glEnableVertexAttribArray(aColor);
+ glVertexAttribPointer(aColor, 4, GL_UNSIGNED_BYTE, GL_TRUE, 0, pointer(0));
+ {$ELSE}
+ glColorPointer(4, GL_UNSIGNED_BYTE, 0, p);
+ {$ENDIF}
+end;
+
+{$IFDEF GL2}
+procedure UpdateModelviewProjection;
+var
+ mvp: TMatrix4x4f;
+begin
+ //MatrixMultiply(mvp, mProjection, mModelview);
+ hglMVP(mvp);
+ glUniformMatrix4fv(uCurrentMVPLocation, 1, GL_FALSE, @mvp[0, 0]);
+end;
+{$ENDIF}
+
+(*
+procedure UpdateProjection;
+var
+ s: GLfloat;
+begin
+ s:=cScaleFactor;
+ mProjection[0,0]:= s/cScreenWidth; mProjection[0,1]:= 0.0; mProjection[0,2]:=0.0; mProjection[0,3]:= 0.0;
+ mProjection[1,0]:= 0.0; mProjection[1,1]:= -s/cScreenHeight; mProjection[1,2]:=0.0; mProjection[1,3]:= 0.0;
+ mProjection[2,0]:= 0.0; mProjection[2,1]:= 0.0; mProjection[2,2]:=1.0; mProjection[2,3]:= 0.0;
+ mProjection[3,0]:= cStereoDepth; mProjection[3,1]:= s/2; mProjection[3,2]:=0.0; mProjection[3,3]:= 1.0;
+
+ {$IFDEF GL2}
+ UpdateModelviewProjection;
+ {$ELSE}
+ glMatrixMode(GL_PROJECTION);
+ glLoadMatrixf(@mProjection[0, 0]);
+ glMatrixMode(GL_MODELVIEW);
+ {$ENDIF}
+end;
+*)
+
procedure SetScale(f: GLfloat);
begin
// leave immediately if scale factor did not change
@@ -860,18 +1137,62 @@
exit;
if f = cDefaultZoomLevel then
- glPopMatrix // "return" to default scaling
+{$IFDEF GL2}
+ hglPopMatrix // "return" to default scaling
+{$ELSE}
+ glPopMatrix
+{$ENDIF}
else // other scaling
begin
+{$IFDEF GL2}
+ hglPushMatrix; // save default scaling
+ hglLoadIdentity;
+ hglScalef(f / cScreenWidth, -f / cScreenHeight, 1.0);
+ hglTranslatef(0, -cScreenHeight / 2, 0);
+{$ELSE}
glPushMatrix; // save default scaling
glLoadIdentity;
glScalef(f / cScreenWidth, -f / cScreenHeight, 1.0);
glTranslatef(0, -cScreenHeight / 2, 0);
+{$ENDIF}
end;
cScaleFactor:= f;
+
+{$IFDEF GL2}
+ UpdateModelviewProjection;
+{$ENDIF}
end;
+procedure BeginWater;
+begin
+ {$IFDEF GL2}
+ glUseProgram(shaderWater);
+ uCurrentMVPLocation:=uWaterMVPLocation;
+ UpdateModelviewProjection;
+ glDisableVertexAttribArray(aTexCoord);
+ glEnableVertexAttribArray(aColor);
+ {$ELSE}
+ glDisableClientState(GL_TEXTURE_COORD_ARRAY);
+ glEnableClientState(GL_COLOR_ARRAY);
+ {$ENDIF}
+end;
+
+procedure EndWater;
+begin
+ {$IFDEF GL2}
+ glUseProgram(shaderMain);
+ uCurrentMVPLocation:=uMainMVPLocation;
+ UpdateModelviewProjection;
+ glDisableVertexAttribArray(aColor);
+ glEnableVertexAttribArray(aTexCoord);
+ {$ELSE}
+ glDisableClientState(GL_COLOR_ARRAY);
+ glEnableClientState(GL_TEXTURE_COORD_ARRAY);
+ {$ENDIF}
+end;
+
+
////////////////////////////////////////////////////////////////////////////////
procedure AddProgress;
var r: TSDL_Rect;
@@ -891,7 +1212,7 @@
with mobileRecord do
if GameLoading <> nil then
GameLoading();
-
+
end;
TryDo(ProgrTex <> nil, 'Error - Progress Texure is nil!', true);
@@ -909,6 +1230,7 @@
DrawTextureFromRect( -squaresize div 2, (cScreenHeight - squaresize) shr 1, @r, ProgrTex);
SwapBuffers;
+
inc(Step);
end;
@@ -1201,10 +1523,12 @@
//uTextures.freeModule; //DEBUG ONLY
{$ENDIF}
AddFileLog('Freeing old primary surface...');
- {$IFNDEF SDL13}
+ {$IFNDEF SDL13}
+ {$IFNDEF WEBGL}
SDL_FreeSurface(SDLPrimSurface);
SDLPrimSurface:= nil;
{$ENDIF}
+ {$ENDIF}
{$ENDIF}
end;
@@ -1257,13 +1581,14 @@
{$ENDIF}
SetupOpenGL();
+
if reinit then
begin
// clean the window from any previous content
glClear(GL_COLOR_BUFFER_BIT);
if SuddenDeathDmg then
glClearColor(SDSkyColor.r * (SDTint/255) / 255, SDSkyColor.g * (SDTint/255) / 255, SDSkyColor.b * (SDTint/255) / 255, 0.99)
- else if ((cReducedQuality and rqNoBackground) = 0) then
+ else if ((cReducedQuality and rqNoBackground) = 0) then
glClearColor(SkyColor.r / 255, SkyColor.g / 255, SkyColor.b / 255, 0.99)
else
glClearColor(RQSkyColor.r / 255, RQSkyColor.g / 255, RQSkyColor.b / 255, 0.99);
@@ -1288,6 +1613,10 @@
ProgrTex:= nil;
SupportNPOTT:= false;
+{$IFDEF WEBGL}
+ OpenGLSetupedBefore := false;
+{$ENDIF}
+
// init all ammo name texture pointers
for ai:= Low(TAmmoType) to High(TAmmoType) do
begin
@@ -1306,6 +1635,13 @@
procedure freeModule;
begin
+{$IFDEF GL2}
+ glDeleteProgram(shaderMain);
+ glDeleteProgram(shaderWater);
+ glDeleteBuffers(1, @vBuffer);
+ glDeleteBuffers(1, @tBuffer);
+ glDeleteBuffers(1, @cBuffer);
+{$ENDIF}
StoreRelease(false);
TTF_Quit();
{$IFDEF SDL13}
--- a/hedgewars/uTeams.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uTeams.pas Sun Jan 27 00:28:57 2013 +0100
@@ -96,7 +96,7 @@
if (Gear <> nil) then
Gear^.State:= gstWinner;
if Flawless then
- AddVoice(sndFlawless, Teams[0]^.voicepack)
+ AddVoice(sndFlawless, Teams[0]^.voicepack)
else
AddVoice(sndVictory, Teams[0]^.voicepack);
@@ -573,8 +573,9 @@
end;
procedure chBind(var id: shortstring);
-var KeyName, Modifier, tmp: shortstring;
- b: LongInt;
+var KeyName, Modifier, tmp : shortstring;
+ b : LongInt;
+ i : Integer;
begin
KeyName:= '';
Modifier:= '';
@@ -582,7 +583,9 @@
if CurrentTeam = nil then
exit;
-if(Pos('mod:', id) <> 0)then
+i := Pos('mod:', id);
+
+if(i <> 0)then
begin
tmp:= '';
SplitBySpace(id, tmp);
--- a/hedgewars/uTouch.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uTouch.pas Sun Jan 27 00:28:57 2013 +0100
@@ -76,20 +76,20 @@
xTouchClick,yTouchClick : LongInt;
timeSinceClick : Longword;
- //Pinch to zoom
+ //Pinch to zoom
pinchSize : LongInt;
baseZoomValue: GLFloat;
//aiming
aimingCrosshair: boolean;
- aimingUp, aimingDown: boolean;
+ aimingUp, aimingDown: boolean;
targetAngle: LongInt;
buttonsDown: Longword;
targetting, targetted: boolean; //true when targetting an airstrike or the like
procedure onTouchDown(x,y: Longword; pointerId: TSDL_FingerId);
-var
+var
finger: PTouch_Data;
begin
{$IFDEF USE_TOUCH_INTERFACE}
@@ -161,7 +161,7 @@
ParseTeamCommand('/timer ' + inttostr((GetCurAmmoEntry(CurrentHedgeHog^)^.Timer div 1000) mod 5 + 1));
end;
exit;
- end;
+ end;
dec(buttonsDown);//no buttonsDown, undo the inc() above
if buttonsDown = 0 then
begin
@@ -201,8 +201,8 @@
end;
exit //todo change into switch rather than ugly ifs
end;
-
-if aimingCrosshair then
+
+if aimingCrosshair then
begin
aim(finger^);
exit
@@ -252,10 +252,10 @@
if (buttonsDown > 0) and (widget <> nil) then
begin
dec(buttonsDown);
-
+
if widget = @arrowLeft then
ParseTeamCommand('-left');
-
+
if widget = @arrowRight then
ParseTeamCommand('-right');
@@ -267,7 +267,7 @@
if widget = @fireButton then
ParseTeamCommand('-attack');
-
+
if widget = @utilityWidget then
if (CurrentHedgehog <> nil)then
if(Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_NeedTarget <> 0)then
@@ -279,10 +279,10 @@
ParseTeamCommand('switch')
else WriteLnToConsole(inttostr(ord(Ammoz[CurrentHedgehog^.CurAmmoType].NameId)) + ' ' + inttostr(ord(sidSwitch)));
end;
-
+
if targetting then
AddCaption('Press the target button to mark the target', cWhiteColor, capgrpAmmoInfo);
-
+
deleteFinger(pointerId);
{$ENDIF}
end;
@@ -309,8 +309,8 @@
//if (RealTicks - timeSinceClick < 300) and (sqrt(sqr(finger.X-xTouchClick) + sqr(finger.Y-yTouchClick)) < 30) then
// begin
// onTouchDoubleClick(finger);
-// timeSinceClick:= 0;//we make an assumption there won't be an 'click' in the first 300 ticks(milliseconds)
-// exit;
+// timeSinceClick:= 0;//we make an assumption there won't be an 'click' in the first 300 ticks(milliseconds)
+// exit;
// end;
xTouchClick:= finger.x;
@@ -318,12 +318,12 @@
timeSinceClick:= RealTicks;
if bShowAmmoMenu then
- begin
+ begin
if isOnRect(AmmoRect, finger) then
begin
CursorPoint.X:= finger.x;
CursorPoint.Y:= finger.y;
- ParseTeamCommand('put');
+ ParseTeamCommand('put');
end
else
bShowAmmoMenu:= false;
@@ -339,28 +339,28 @@
if isOnWidget(jumpWidget, finger) then
begin
- ParseTeamCommand('hjump');
+ ParseTeamCommand('hjump');
exit;
end;
{$ENDIF}
end;
function addFinger(x,y: Longword; id: TSDL_FingerId): PTouch_Data;
-var
+var
xCursor, yCursor, index : LongInt;
begin
//Check array sizes
- if length(fingers) < Integer(pointerCount) then
+ if length(fingers) < Integer(pointerCount) then
begin
setLength(fingers, length(fingers)*2);
for index := length(fingers) div 2 to length(fingers) do
fingers[index].id := nilFingerId;
end;
-
-
+
+
xCursor := convertToCursorX(x);
yCursor := convertToCursorY(y);
-
+
//on removing fingers, all fingers are moved to the left
//with dynamic arrays being zero based, the new position of the finger is the old pointerCount
fingers[pointerCount].id := id;
@@ -372,7 +372,7 @@
fingers[pointerCount].dy := 0;
fingers[pointerCount].timeSinceDown:= RealTicks;
fingers[pointerCount].pressedWidget:= nil;
-
+
addFinger:= @fingers[pointerCount];
inc(pointerCount);
end;
@@ -391,22 +391,22 @@
var
index : Longword;
begin
-
+
dec(pointerCount);
for index := 0 to pointerCount do
begin
if fingers[index].id = id then
begin
-
- //put the last finger into the spot of the finger to be removed,
+
+ //put the last finger into the spot of the finger to be removed,
//so that all fingers are packed to the far left
if pointerCount <> index then
begin
- fingers[index].id := fingers[pointerCount].id;
- fingers[index].x := fingers[pointerCount].x;
- fingers[index].y := fingers[pointerCount].y;
- fingers[index].historicalX := fingers[pointerCount].historicalX;
- fingers[index].historicalY := fingers[pointerCount].historicalY;
+ fingers[index].id := fingers[pointerCount].id;
+ fingers[index].x := fingers[pointerCount].x;
+ fingers[index].y := fingers[pointerCount].y;
+ fingers[index].historicalX := fingers[pointerCount].historicalX;
+ fingers[index].historicalY := fingers[pointerCount].historicalY;
fingers[index].timeSinceDown := fingers[pointerCount].timeSinceDown;
fingers[pointerCount].id := nilFingerId;
@@ -430,12 +430,12 @@
var
deltaAngle: LongInt;
begin
-invertCursor := not(bShowAmmoMenu or targetting);
+invertCursor := not(bShowAmmoMenu or targetting);
if aimingCrosshair then
if CurrentHedgehog^.Gear <> nil then
begin
deltaAngle:= CurrentHedgehog^.Gear^.Angle - targetAngle;
- if (deltaAngle > -5) and (deltaAngle < 5) then
+ if (deltaAngle > -5) and (deltaAngle < 5) then
begin
if(aimingUp)then
begin
@@ -475,10 +475,10 @@
aimingUp:= true;
ParseTeamCommand('+up');
end;
- end;
+ end;
end;
end
- else
+ else
begin
if aimingUp then
begin
@@ -498,7 +498,7 @@
index: LongWord;
begin
for index := 0 to High(fingers) do
- if fingers[index].id = id then
+ if fingers[index].id = id then
begin
findFinger := @fingers[index];
break;
@@ -506,7 +506,7 @@
end;
procedure aim(finger: TTouch_Data);
-var
+var
hogX, hogY, touchX, touchY, deltaX, deltaY: LongInt;
begin
if CurrentHedgehog^.Gear <> nil then
@@ -519,7 +519,7 @@
convertToWorldCoord(touchX, touchY, finger);
deltaX := abs(TouchX-HogX);
deltaY := TouchY-HogY;
-
+
targetAngle:= (Round(DeltaY / sqrt(sqr(deltaX) + sqr(deltaY)) * 2048) + 2048) div 2;
end; //if CurrentHedgehog^.Gear <> nil
end;
@@ -579,9 +579,9 @@
procedure convertToWorldCoord(var x,y: LongInt; finger: TTouch_Data);
begin
-//if x <> nil then
+//if x <> nil then
x := finger.x-WorldDx;
-//if y <> nil then
+//if y <> nil then
y := (cScreenHeight - finger.y)-WorldDy;
end;
@@ -637,7 +637,7 @@
buttonsDown:= 0;
setLength(fingers, 4);
- for index := 0 to High(fingers) do
+ for index := 0 to High(fingers) do
fingers[index].id := nilFingerId;
rectSize:= round(baseRectSize * mobileRecord.getScreenDPI());
--- a/hedgewars/uTypes.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uTypes.pas Sun Jan 27 00:28:57 2013 +0100
@@ -44,7 +44,8 @@
// Different files are stored in different folders, this enumeration is used to tell which folder to use
TPathType = (ptNone, ptData, ptGraphics, ptThemes, ptCurrTheme, ptTeams, ptMaps,
ptMapCurrent, ptDemos, ptSounds, ptGraves, ptFonts, ptForts,
- ptLocale, ptAmmoMenu, ptHedgehog, ptVoices, ptHats, ptFlags, ptMissionMaps, ptSuddenDeath, ptButtons);
+ ptLocale, ptAmmoMenu, ptHedgehog, ptVoices, ptHats, ptFlags, ptMissionMaps, ptSuddenDeath, ptButtons,
+ ptShaders);
// Available sprites for displaying stuff
TSprite = (sprWater, sprCloud, sprBomb, sprBigDigit, sprFrame,
@@ -200,6 +201,8 @@
X, Y: GLint;
end;
+ TMatrix4x4f = array[0..3, 0..3] of GLfloat;
+
PTexture = ^TTexture;
TTexture = record
id: GLuint;
@@ -390,21 +393,21 @@
TClan = record
Color: Longword;
Teams: array[0..Pred(cMaxTeams)] of PTeam;
- TeamsNumber: Longword;
+ TeamsNumber: LongInt;{xymeng, org:LongWord}
TagTeamIndex: Longword;
CurrTeam: LongWord;
ClanHealth: LongInt;
ClanIndex: LongInt;
- TurnNumber: LongWord;
+ TurnNumber: LongInt;{xymeng, org:LongWord}
Flawless: boolean;
end;
cdeclPtr = procedure; cdecl;
cdeclIntPtr = procedure(num: LongInt); cdecl;
- functionDoublePtr = function: Double;
+ funcDoublePtr = function: Double;
TMobileRecord = record
- getScreenDPI: functionDoublePtr;
+ getScreenDPI: funcDoublePtr;
PerformRumble: cdeclIntPtr;
GameLoading: cdeclPtr;
GameLoaded: cdeclPtr;
@@ -427,7 +430,7 @@
TMsgStrId = (sidStartFight, sidDraw, sidWinner, sidVolume, sidPaused,
sidConfirm, sidSuddenDeath, sidRemaining, sidFuel, sidSync,
- sidNoEndTurn, sidNotYetAvailable, sidRoundSD, sidRoundsSD, sidReady,
+ sidNoEndTurn, sidNotYetAvailable, sidRoundSD, sidRoundsSD, sidReady,
sidBounce1, sidBounce2, sidBounce3, sidBounce4, sidBounce5, sidBounce,
sidMute);
@@ -438,14 +441,16 @@
TGoalStrId = (gidCaption, gidSubCaption, gidForts, gidLowGravity, gidInvulnerable,
gidVampiric, gidKarma, gidKing, gidPlaceHog, gidArtillery,
- gidSolidLand, gidSharedAmmo, gidMineTimer, gidNoMineTimer,
- gidRandomMineTimer, gidDamageModifier, gidResetHealth, gidAISurvival,
+ gidSolidLand, gidSharedAmmo, gidMineTimer, gidNoMineTimer,
+ gidRandomMineTimer, gidDamageModifier, gidResetHealth, gidAISurvival,
gidInfAttack, gidResetWeps, gidPerHogAmmo, gidTagTeam);
+
TLandArray = packed array of array of LongWord;
TCollisionArray = packed array of array of Word;
+ TDirtyTag = packed array of array of byte;
+
TPreview = packed array[0..127, 0..31] of byte;
- TDirtyTag = packed array of array of byte;
PWidgetMovement = ^TWidgetMovement;
TWidgetMovement = record
--- a/hedgewars/uUtils.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uUtils.pas Sun Jan 27 00:28:57 2013 +0100
@@ -25,16 +25,19 @@
procedure SplitBySpace(var a, b: shortstring);
procedure SplitByChar(var a, b: shortstring; c: char);
-procedure SplitByChar(var a, b: ansistring; c: char);
{$IFNDEF PAS2C}
+procedure SplitByChar(var a, b: ansistring; c: char);
+{$ENDIF}
+
+//{$IFNDEF PAS2C}
function EnumToStr(const en : TGearType) : shortstring; overload;
function EnumToStr(const en : TVisualGearType) : shortstring; overload;
function EnumToStr(const en : TSound) : shortstring; overload;
function EnumToStr(const en : TAmmoType) : shortstring; overload;
function EnumToStr(const en : THogEffect) : shortstring; overload;
function EnumToStr(const en : TCapGroup) : shortstring; overload;
-{$ENDIF}
+//{$ENDIF}
function Min(a, b: LongInt): LongInt; inline;
function Max(a, b: LongInt): LongInt; inline;
@@ -97,7 +100,7 @@
logMutex: TRTLCriticalSection; // mutex for debug file
{$ENDIF}
{$ENDIF}
-var CharArray: array[byte] of Char;
+var CharArray: array[0..255] of Char;
procedure SplitBySpace(var a,b: shortstring);
begin
@@ -116,11 +119,15 @@
Inc(a[t], 32);
b:= copy(a, i + 1, Length(a) - i);
a[0]:= char(Pred(i))
+ {$IFDEF PAS2C}
+ a[i] := 0;
+ {$ENDIF}
end
else
b:= '';
end;
+{$IFNDEF PAS2C}
procedure SplitByChar(var a, b: ansistring; c: char);
var i: LongInt;
begin
@@ -130,9 +137,10 @@
b:= copy(a, i + 1, Length(a) - i);
setlength(a, Pred(i));
end else b:= '';
-end;
+end; { SplitByChar }
+{$ENDIF}
-{$IFNDEF PAS2C}
+//{$IFNDEF PAS2C}
function EnumToStr(const en : TGearType) : shortstring; overload;
begin
EnumToStr:= GetEnumName(TypeInfo(TGearType), ord(en))
@@ -161,7 +169,7 @@
begin
EnumToStr := GetEnumName(TypeInfo(TCapGroup), ord(en))
end;
-{$ENDIF}
+//{$ENDIF}
function Min(a, b: LongInt): LongInt;
begin
@@ -286,10 +294,14 @@
function Str2PChar(const s: shortstring): PChar;
+var i :Integer ;
begin
-CharArray:= s;
+ for i:= 1 to Length(s) do
+ begin
+ CharArray[i - 1] := s[i];
+ end;
CharArray[Length(s)]:= #0;
-Str2PChar:= @CharArray
+ Str2PChar:= @(CharArray[0]);
end;
@@ -308,16 +320,21 @@
procedure AddFileLog(s: shortstring);
begin
-s:= s;
+// s:= s;
+{$IFNDEF WEBGL}
{$IFDEF DEBUGFILE}
+
{$IFDEF USE_VIDEO_RECORDING}
EnterCriticalSection(logMutex);
{$ENDIF}
writeln(f, inttostr(GameTicks) + ': ' + s);
flush(f);
+
{$IFDEF USE_VIDEO_RECORDING}
LeaveCriticalSection(logMutex);
{$ENDIF}
+
+{$ENDIF}
{$ENDIF}
end;
@@ -366,7 +383,7 @@
((#$AC00 <= u) and (u <= #$D7AF)) or // Hangul Syllables
((#$F900 <= u) and (u <= #$FAFF)) or // CJK Compatibility Ideographs
((#$FE30 <= u) and (u <= #$FE4F))) // CJK Compatibility Forms
- then
+ then
begin
CheckCJKFont:= THWFont( ord(font) + ((ord(High(THWFont))+1) div 2) );
exit;
--- a/hedgewars/uVariables.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uVariables.pas Sun Jan 27 00:28:57 2013 +0100
@@ -21,7 +21,7 @@
unit uVariables;
interface
-uses SDLh, uTypes, uFloat, GLunit, uConsts, Math, uUtils;
+uses SDLh, uTypes, uFloat, GLunit, uConsts, Math, uUtils, uMatrix;
var
/////// init flags ///////
@@ -77,7 +77,7 @@
CheckSum : LongWord;
CampaignVariable: shortstring;
- GameTicks : LongWord;
+ GameTicks : LongInt; {xymeng:originally LongWord}
GameState : TGameState;
GameType : TGameType;
InputMask : LongWord;
@@ -159,7 +159,7 @@
cArtillery : boolean;
WeaponTooltipTex: PTexture;
AmmoMenuInvalidated: boolean;
- AmmoRect : TSDL_Rect;
+ AmmoRect : TSDL_Rect;
HHTexture : PTexture;
cMaxZoomLevel : real;
cMinZoomLevel : real;
@@ -195,7 +195,7 @@
LuaGoals : shortstring;
- LuaTemplateNumber : LongWord;
+ LuaTemplateNumber : LongInt; {org: LongWord}
LastVoice : TVoice = ( snd: sndNone; voicepack: nil );
@@ -236,9 +236,11 @@
'/Graphics/Flags', // ptFlags
'/Missions/Maps', // ptMissionMaps
'/Graphics/SuddenDeath', // ptSuddenDeath
- '/Graphics/Buttons' // ptButton
+ '/Graphics/Buttons', // ptButton
+ '/Shaders' // ptShaders
);
+var
Fontz: array[THWFont] of THHFont = (
(Handle: nil;
Height: 12;
@@ -694,7 +696,7 @@
TimeAfterTurn: Longword;
minAngle, maxAngle: Longword;
isDamaging: boolean;
- SkipTurns: Longword;
+ SkipTurns: LongInt; {xymeng, orinally: LongWord}
PosCount: Longword;
PosSprite: TSprite;
ejectX, ejectY: Longint;
@@ -727,9 +729,9 @@
NameTex: nil;
Probability: 0;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Timerable or
- ammoprop_Power or
- ammoprop_AltUse or
+ Ammo: (Propz: ammoprop_Timerable or
+ ammoprop_Power or
+ ammoprop_AltUse or
ammoprop_SetBounce or
ammoprop_NeedUpDown;
Count: AMMO_INFINITE;
@@ -755,9 +757,9 @@
NameTex: nil;
Probability: 100;
NumberInCase: 3;
- Ammo: (Propz: ammoprop_Timerable or
- ammoprop_Power or
- ammoprop_AltUse or
+ Ammo: (Propz: ammoprop_Timerable or
+ ammoprop_Power or
+ ammoprop_AltUse or
ammoprop_SetBounce or
ammoprop_NeedUpDown;
Count: 5;
@@ -783,7 +785,7 @@
NameTex: nil;
Probability: 0;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Power or
+ Ammo: (Propz: ammoprop_Power or
ammoprop_AltUse or
ammoprop_NeedUpDown;
Count: AMMO_INFINITE;
@@ -809,8 +811,8 @@
NameTex: nil;
Probability: 100;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Power or
- ammoprop_NeedTarget or
+ Ammo: (Propz: ammoprop_Power or
+ ammoprop_NeedTarget or
ammoprop_DontHold or
ammoprop_NeedUpDown;
Count: 2;
@@ -861,9 +863,9 @@
NameTex: nil;
Probability: 0;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_ForwMsgs or
- ammoprop_AttackInMove or
- ammoprop_NoCrosshair or
+ Ammo: (Propz: ammoprop_ForwMsgs or
+ ammoprop_AttackInMove or
+ ammoprop_NoCrosshair or
ammoprop_DontHold;
Count: 2;
NumPerTurn: 0;
@@ -888,7 +890,7 @@
NameTex: nil;
Probability: 0;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_NoCrosshair or
+ Ammo: (Propz: ammoprop_NoCrosshair or
ammoprop_DontHold;
Count: AMMO_INFINITE;
NumPerTurn: 0;
@@ -942,10 +944,10 @@
NameTex: nil;
Probability: 100;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_NoCrosshair or
- ammoprop_AttackInMove or
- ammoprop_DontHold or
- ammoprop_AltUse or
+ Ammo: (Propz: ammoprop_NoCrosshair or
+ ammoprop_AttackInMove or
+ ammoprop_DontHold or
+ ammoprop_AltUse or
ammoprop_SetBounce;
Count: 2;
NumPerTurn: 0;
@@ -994,9 +996,9 @@
NameTex: nil;
Probability: 100;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_NoCrosshair or
- ammoprop_AttackInMove or
- ammoprop_DontHold or
+ Ammo: (Propz: ammoprop_NoCrosshair or
+ ammoprop_AttackInMove or
+ ammoprop_DontHold or
ammoprop_AltUse;
Count: 1;
NumPerTurn: 0;
@@ -1021,8 +1023,8 @@
NameTex: nil;
Probability: 0;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_NoCrosshair or
- ammoprop_ForwMsgs or
+ Ammo: (Propz: ammoprop_NoCrosshair or
+ ammoprop_ForwMsgs or
ammoprop_AttackInMove;
Count: AMMO_INFINITE;
NumPerTurn: 0;
@@ -1317,8 +1319,8 @@
NameTex: nil;
Probability: 100;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_ForwMsgs or
- ammoprop_DontHold or
+ Ammo: (Propz: ammoprop_ForwMsgs or
+ ammoprop_DontHold or
ammoprop_NeedUpDown or
ammoprop_AttackInMove;
Count: 1;
@@ -1344,8 +1346,8 @@
NameTex: nil;
Probability: 100;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_ForwMsgs or
- ammoprop_NoCrosshair or
+ Ammo: (Propz: ammoprop_ForwMsgs or
+ ammoprop_NoCrosshair or
ammoprop_DontHold or
ammoprop_Track;
Count: 1;
@@ -1371,7 +1373,7 @@
NameTex: nil;
Probability: 100;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_ForwMsgs or
+ Ammo: (Propz: ammoprop_ForwMsgs or
ammoprop_DontHold or
ammoprop_NoCrosshair;
Count: 1;
@@ -1397,8 +1399,8 @@
NameTex: nil;
Probability: 400;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Timerable or
- ammoprop_Power or
+ Ammo: (Propz: ammoprop_Timerable or
+ ammoprop_Power or
ammoprop_NeedUpDown or
ammoprop_AltUse;
Count: 0;
@@ -1424,7 +1426,7 @@
NameTex: nil;
Probability: 400;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Power or
+ Ammo: (Propz: ammoprop_Power or
ammoprop_NeedUpDown or
ammoprop_AltUse;
Count: 0;
@@ -1478,7 +1480,7 @@
NameTex: nil;
Probability: 300;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Power or
+ Ammo: (Propz: ammoprop_Power or
ammoprop_NeedUpDown or
ammoprop_AltUse;
Count: AMMO_INFINITE;
@@ -1504,7 +1506,7 @@
NameTex: nil;
Probability: 400;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_ForwMsgs or
+ Ammo: (Propz: ammoprop_ForwMsgs or
ammoprop_NeedUpDown or
ammoprop_DontHold;
Count: AMMO_INFINITE;
@@ -1732,7 +1734,7 @@
NameTex: nil;
Probability: 20;
NumberInCase: 2;
- Ammo: (Propz: ammoprop_NeedUpDown or
+ Ammo: (Propz: ammoprop_NeedUpDown or
ammoprop_OscAim or
ammoprop_NoMoveAfter;
Count: 2;
@@ -1789,7 +1791,7 @@
NameTex: nil;
Probability: 0;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Power or
+ Ammo: (Propz: ammoprop_Power or
ammoprop_NeedUpDown or
ammoprop_AltUse;
Count: AMMO_INFINITE;
@@ -1898,9 +1900,9 @@
NameTex: nil;
Probability: 0;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Timerable or
- ammoprop_Power or
- ammoprop_AltUse or
+ Ammo: (Propz: ammoprop_Timerable or
+ ammoprop_Power or
+ ammoprop_AltUse or
ammoprop_NeedUpDown or
ammoprop_SetBounce;
Count: AMMO_INFINITE;
@@ -1951,7 +1953,7 @@
NameTex: nil;
Probability: 20;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_ForwMsgs or
+ Ammo: (Propz: ammoprop_ForwMsgs or
ammoprop_NeedUpDown or
ammoprop_DontHold;
Count: 1;
@@ -2082,7 +2084,7 @@
NameTex: nil;
Probability: 0;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_Power or
+ Ammo: (Propz: ammoprop_Power or
ammoprop_AltUse or
ammoprop_NoRoundEnd;
Count: 2;
@@ -2100,7 +2102,7 @@
SkipTurns: 0;
PosCount: 1;
PosSprite: sprWater;
- ejectX: 0;
+ ejectX: 0;
ejectY: 0),
// Tardis
@@ -2130,7 +2132,7 @@
ejectX: 0;
ejectY: 0),
-// Structure
+// Structure
{
(NameId: sidStructure;
NameTex: nil;
@@ -2158,7 +2160,7 @@
ejectX: 0;
ejectY: 0),
}
-
+
// Land Gun
(NameId: sidLandGun;
NameTex: nil;
@@ -2188,7 +2190,7 @@
NameTex: nil;
Probability: 20;
NumberInCase: 1;
- Ammo: (Propz: ammoprop_ForwMsgs or
+ Ammo: (Propz: ammoprop_ForwMsgs or
ammoprop_NeedUpDown or
ammoprop_DontHold;
Count: 1;
@@ -2287,6 +2289,7 @@
SyncTexture,
ConfirmTexture: PTexture;
cScaleFactor: GLfloat;
+ cStereoDepth: GLfloat;
SupportNPOTT: Boolean;
Step: LongInt;
MissionIcons: PSDL_Surface;
@@ -2310,6 +2313,23 @@
lastTurnChecksum : Longword;
+ mModelview: TMatrix4x4f;
+ mProjection: TMatrix4x4f;
+ vBuffer: GLuint; // vertex buffer
+ tBuffer: GLuint; // texture coords buffer
+ cBuffer: GLuint; // color buffer
+
+ uCurrentMVPLocation: GLint;
+
+ uMainMVPLocation: GLint;
+ uMainTintLocation: GLint;
+
+ uWaterMVPLocation: GLint;
+
+ aVertex: GLint;
+ aTexCoord: GLint;
+ aColor: GLint;
+
var trammo: array[TAmmoStrId] of ansistring; // name of the weapon
trammoc: array[TAmmoStrId] of ansistring; // caption of the weapon
trammod: array[TAmmoStrId] of ansistring; // description of the weapon
@@ -2493,7 +2513,7 @@
cHasFocus := true;
cInactDelay := 100;
ReadyTimeLeft := 0;
-
+
disableLandBack := false;
ScreenFade := sfNone;
@@ -2532,6 +2552,13 @@
cMapName:= '';
LuaTemplateNumber:= 0;
+ cStereoDepth := 0;
+
+// MatrixLoadIdentity(mModelview);
+// MatrixLoadIdentity(mProjection);
+ aVertex:= 0;
+ aTexCoord:= 1;
+ aColor:= 2;
mobileRecord.getScreenDPI:= @getScreenDPI; //TODO: define external function.
{$IFDEF IPHONEOS}
--- a/hedgewars/uVisualGears.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uVisualGears.pas Sun Jan 27 00:28:57 2013 +0100
@@ -55,7 +55,7 @@
implementation
uses uSound, uVariables, uTextures, uRender, Math, uRenderUtils, uStore, uUtils;
-const
+const
cExplFrameTicks = 110;
//cSmokeZ = 499;
var VGCounter: LongWord;
@@ -85,7 +85,7 @@
// ==================================================================
// ==================================================================
-const doStepHandlers: array[TVisualGearType] of TVGearStepProcedure =
+const vdoStepHandlers: array[TVisualGearType] of TVGearStepProcedure =
(
@doStepFlake,
@doStepCloud,
@@ -154,7 +154,7 @@
vgtEvilTrace,
vgtNote,
vgtSmoothWindBar])) then
-
+
exit;
inc(VGCounter);
@@ -163,7 +163,7 @@
gear^.X:= real(X);
gear^.Y:= real(Y);
gear^.Kind := Kind;
-gear^.doStep:= doStepHandlers[Kind];
+gear^.doStep:= vdoStepHandlers[Kind];
gear^.State:= 0;
gear^.Tint:= $FFFFFFFF;
gear^.uid:= VGCounter;
@@ -368,7 +368,7 @@
if random(2) = 0 then
dx := -dx;
end;
- vgtNote:
+ vgtNote:
begin
dx:= 0.005 * (random(15) + 10);
dy:= -0.001 * (random(40) + 20);
@@ -385,7 +385,7 @@
Frame:= 7;
Angle:= 0;
end;
-vgtSmoothWindBar:
+vgtSmoothWindBar:
begin
Angle:= hwFloat2Float(cMaxWindSpeed)*2 / 1440; // seems rate below is supposed to change wind bar at 1px per 10ms. Max time, 1440ms. This tries to match the rate of change
Tag:= hwRound(cWindSpeed * 72 / cMaxWindSpeed);
@@ -411,7 +411,7 @@
case Gear^.Kind of
vgtFlake: if cFlattenFlakes then
gear^.Layer:= 0
- else if random(3) = 0 then
+ else if random(3) = 0 then
begin
gear^.Scale:= 0.5;
gear^.Layer:= 0 // 33% - far back
@@ -702,9 +702,9 @@
DrawTextureCentered(round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Tex);
end;
vgtSmallDamageTag: DrawTextureCentered(round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Tex);
- vgtHealthTag: if Gear^.Tex <> nil then
+ vgtHealthTag: if Gear^.Tex <> nil then
begin
- if Gear^.Frame = 0 then
+ if Gear^.Frame = 0 then
DrawTextureCentered(round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Tex)
else
begin
@@ -712,11 +712,11 @@
if Gear^.Angle = 0 then
DrawTexture(round(Gear^.X), round(Gear^.Y), Gear^.Tex)
else
- DrawTexture(round(Gear^.X), round(Gear^.Y), Gear^.Tex, Gear^.Angle);
+ DrawTexture(round(Gear^.X), round(Gear^.Y), Gear^.Tex, Gear^.Angle);
SetScale(zoom)
end
end;
- vgtStraightShot: begin
+ vgtStraightShot: begin
if Gear^.dX < 0 then
i:= -1
else
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uWeb.pas Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,174 @@
+
+// defines functions used for web port
+
+unit uWeb;
+interface
+
+type
+ TResourceList = record
+ count : Integer;
+ files : array[0..500] of shortstring;
+ end;
+
+function generateResourceList:TResourceList;
+
+implementation
+
+uses uConsts, uVariables, uTypes;
+
+function readThemeCfg:TResourceList; forward;
+
+function generateResourceList:TResourceList;
+var
+ cfgRes : TResourceList;
+ i,j : Integer;
+ t, t2 : shortstring;
+ si : TSprite;
+ res : TResourceList;
+
+begin
+
+ res.count := 0;
+
+ for i:= 0 to Pred(TeamsCount) do
+ with TeamsArray[i]^ do
+ begin
+ Str(i, t);
+
+ res.files[res.count] := UserPathz[ptGraves] + '/' + GraveName;
+ res.files[res.count + 1] := UserPathz[ptForts] + '/' + FortName;
+ res.files[res.count + 2] := UserPathz[ptGraphics] + '/' + FortName;
+ res.files[res.count + 3] := UserPathz[ptFlags] + '/' + flag;
+
+ inc(res.count, 4);
+
+ end;
+
+ for si:= Low(TSprite) to High(TSprite) do
+ with SpritesData[si] do
+ begin
+ Str(si, t);
+ res.files[res.count] := UserPathz[Path] + '/' + FileName;
+ res.files[res.count + 1] := UserPathz[AltPath] + '/' + FileName;
+ inc(res.count, 2);
+
+ end;
+
+ for i:= 0 to Pred(ClansCount) do
+ with CLansArray[i]^ do
+ begin
+ for j:= 0 to Pred(TeamsNumber) do
+ begin
+ with Teams[j]^ do
+ begin
+ Str(i, t);
+ Str(j, t2);
+ res.files[res.count] := UserPathz[ptForts] + '/' + FortName;
+ inc(res.count);
+
+ end;
+ end;
+ end;
+
+ cfgRes := readThemeCfg();
+
+ for i:= 0 to Pred(cfgRes.count) do
+ begin
+ res.files[res.count] := cfgRes.files[i];
+ inc(res.count);
+ end;
+
+ res.files[res.count] := UserPathz[ptFlags] + '/cpu';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptFlags] + '/hedgewars';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptGraphics] + '/' + cHHFileName;
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptGraphics] + '/Girder';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptCurrTheme] + '/LandTex';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptCurrTheme] + '/LandBackTex';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptCurrTheme] + '/Girder';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptCurrTheme] + '/Border';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptMapCurrent] + '/mask';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptMapCurrent] + '/map';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptGraphics] + '/missions';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptGraphics] + '/Progress';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptGraves] + '/Statue';
+ inc(res.count);
+
+ res.files[res.count] := UserPathz[ptGraphics] + '/' + cCHFileName;
+ inc(res.count);
+
+ generateResourceList:=res;
+end;
+
+function readThemeCfg : TResourceList;
+var
+s,key : shortstring;
+f : TextFile;
+i: Integer;
+res : TResourceList;
+begin
+ s:=Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;
+
+ Assign(f, s);
+ {$I-}
+
+ filemode := 0;
+ Reset(f);
+
+ res.count := 0;
+
+ while not eof(f) do
+ begin
+ Readln(f, s);
+
+ if Length(s) = 0 then
+ continue;
+ if s[1] = ';' then
+ continue;
+
+ i:= Pos('=', s);
+ key:= Trim(Copy(s, 1, Pred(i)));
+ Delete(s, 1, i);
+
+ if (key = 'object') or (key = 'spray') then
+ begin
+ i:=Pos(',', s);
+
+ res.files[res.count] := Pathz[ptCurrTheme] + '/' + Trim(Copy(s, 1, Pred(i)));
+ res.files[res.count + 1] := Pathz[ptGraphics] + '/' + Trim(Copy(s, 1, Pred(i)));
+ inc(res.count, 2);
+
+ end;
+
+ end;
+
+ close(f);
+ {$I+}
+
+ readThemeCfg := res;
+end;
+
+end.
--- a/hedgewars/uWorld.pas Sun Jan 27 00:01:26 2013 +0100
+++ b/hedgewars/uWorld.pas Sun Jan 27 00:28:57 2013 +0100
@@ -60,9 +60,12 @@
, uCaptions
, uCursor
, uCommands
-{$IFDEF USE_VIDEO_RECORDING}
+{$IFDEF USE_VIDEO_RECORDING}
, uVideoRec
-{$ENDIF}
+{$ENDIF}
+{$IFDEF GL2}
+ , uMatrix
+{$ENDIF}
;
var cWaveWidth, cWaveHeight: LongInt;
@@ -440,14 +443,14 @@
AmmoRect.w:= (BORDERSIZE*2) + (SlotsNumX * AMSlotSize) + (SlotsNumX-1);
AmmoRect.h:= (BORDERSIZE*2) + (SlotsNumY * AMSlotSize) + (SlotsNumY-1);
amSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, AmmoRect.w, AmmoRect.h, 32, RMask, GMask, BMask, AMask);
-
+
AMRect.x:= BORDERSIZE;
AMRect.y:= BORDERSIZE;
AMRect.w:= AmmoRect.w - (BORDERSIZE*2);
AMRect.h:= AmmoRect.h - (BORDERSIZE*2);
SDL_FillRect(amSurface, @AMRect, SDL_MapRGB(amSurface^.format, 0,0,0));
-
+
x:= AMRect.x;
y:= AMRect.y;
for i:= 0 to cMaxSlotIndex do
@@ -481,25 +484,25 @@
AMFrame:= LongInt(Ammo^[i,t].AmmoType) - 1;
if STurns >= 0 then //weapon not usable yet, draw grayed out with turns remaining
begin
- DrawSpriteFrame2Surf(sprAMAmmosBW, amSurface, x + AMSlotPadding,
+ DrawSpriteFrame2Surf(sprAMAmmosBW, amSurface, x + AMSlotPadding,
y + AMSlotPadding, AMFrame);
if STurns < 100 then
- DrawSpriteFrame2Surf(sprTurnsLeft, amSurface,
- x + AMSlotSize-16,
+ DrawSpriteFrame2Surf(sprTurnsLeft, amSurface,
+ x + AMSlotSize-16,
y + AMSlotSize + 1 - 16, STurns);
end
else //draw colored version
begin
- DrawSpriteFrame2Surf(sprAMAmmos, amSurface, x + AMSlotPadding,
+ DrawSpriteFrame2Surf(sprAMAmmos, amSurface, x + AMSlotPadding,
y + AMSlotPadding, AMFrame);
end;
{$IFDEF USE_LANDSCAPE_AMMOMENU}
- inc(y, AMSlotSize + 1); //the plus one is for the border
+ inc(y, AMSlotSize + 1); //the plus one is for the border
{$ELSE}
- inc(x, AMSlotSize + 1);
+ inc(x, AMSlotSize + 1);
{$ENDIF}
- end;
- end;
+ end;
+ end;
{$IFDEF USE_LANDSCAPE_AMMOMENU}
inc(x, AMSlotSize + 1);
{$ELSE}
@@ -508,7 +511,7 @@
end;
for i:= 1 to SlotsNumX -1 do
-DrawLine2Surf(amSurface, i * (AMSlotSize+1)+1, BORDERSIZE, i * (AMSlotSize+1)+1, AMRect.h + BORDERSIZE - AMSlotSize - 2,160,160,160);
+DrawLine2Surf(amSurface, i * (AMSlotSize+1)+1, BORDERSIZE, i * (AMSlotSize+1)+1, AMRect.h + BORDERSIZE - AMSlotSize - 2,160,160,160);
for i:= 1 to SlotsNumY -1 do
DrawLine2Surf(amSurface, BORDERSIZE, i * (AMSlotSize+1)+1, AMRect.w + BORDERSIZE, i * (AMSlotSize+1)+1,160,160,160);
@@ -553,8 +556,8 @@
exit
end;
-//Init the menu
-if(AmmoMenuInvalidated) then
+//Init the menu
+if(AmmoMenuInvalidated) then
begin
AmmoMenuInvalidated:= false;
FreeTexture(AmmoMenuTex);
@@ -610,7 +613,7 @@
begin
AMShiftX:= Round(AMShiftTargetX * (1 - AMAnimState));
AMShiftY:= Round(AMShiftTargetY * (1 - AMAnimState));
- if (AMAnimType and AMTypeMaskAlpha) <> 0 then
+ if (AMAnimType and AMTypeMaskAlpha) <> 0 then
Tint($FF, $ff, $ff, Round($ff * AMAnimState));
end
else
@@ -635,10 +638,10 @@
begin
AMShiftX:= Round(AMShiftTargetX * AMAnimState);
AMShiftY:= Round(AMShiftTargetY * AMAnimState);
- if (AMAnimType and AMTypeMaskAlpha) <> 0 then
+ if (AMAnimType and AMTypeMaskAlpha) <> 0 then
Tint($FF, $ff, $ff, Round($ff * (1-AMAnimState)));
end
- else
+ else
begin
AMShiftX:= AMShiftTargetX;
AMShiftY:= AMShiftTargetY;
@@ -647,10 +650,10 @@
AMState:= AMHidden;
end;
end;
-
+
DrawTexture(AmmoRect.x + AMShiftX, AmmoRect.y + AMShiftY, AmmoMenuTex);
-if ((AMState = AMHiding) or (AMState = AMShowingUp)) and ((AMAnimType and AMTypeMaskAlpha) <> 0 )then
+if ((AMState = AMHiding) or (AMState = AMShowingUp)) and ((AMAnimType and AMTypeMaskAlpha) <> 0 )then
Tint($FF, $ff, $ff, $ff);
Pos:= -1;
@@ -671,15 +674,15 @@
begin
if (CursorPoint.Y <= (cScreenHeight - AmmoRect.y) - ( g * (AMSlotSize+1))) and
(CursorPoint.Y > (cScreenHeight - AmmoRect.y) - ((g+1) * (AMSlotSize+1))) and
- (CursorPoint.X > AmmoRect.x + ( c * (AMSlotSize+1))) and
+ (CursorPoint.X > AmmoRect.x + ( c * (AMSlotSize+1))) and
(CursorPoint.X <= AmmoRect.x + ((c+1) * (AMSlotSize+1))) then
begin
Slot:= i;
Pos:= t;
STurns:= Ammoz[Ammo^[i, t].AmmoType].SkipTurns - CurrentTeam^.Clan^.TurnNumber;
if (STurns < 0) and (AMShiftX = 0) and (AMShiftY = 0) then
- DrawSprite(sprAMSlot,
- AmmoRect.x + BORDERSIZE + (c * (AMSlotSize+1)) + AMSlotPadding,
+ DrawSprite(sprAMSlot,
+ AmmoRect.x + BORDERSIZE + (c * (AMSlotSize+1)) + AMSlotPadding,
AmmoRect.y + BORDERSIZE + (g * (AMSlotSize+1)) + AMSlotPadding -1, 0);
end;
inc(g);
@@ -701,15 +704,15 @@
begin
if (CursorPoint.Y <= (cScreenHeight - AmmoRect.y) - ( c * (AMSlotSize+1))) and
(CursorPoint.Y > (cScreenHeight - AmmoRect.y) - ((c+1) * (AMSlotSize+1))) and
- (CursorPoint.X > AmmoRect.x + ( g * (AMSlotSize+1))) and
+ (CursorPoint.X > AmmoRect.x + ( g * (AMSlotSize+1))) and
(CursorPoint.X <= AmmoRect.x + ((g+1) * (AMSlotSize+1))) then
begin
Slot:= i;
Pos:= t;
STurns:= Ammoz[Ammo^[i, t].AmmoType].SkipTurns - CurrentTeam^.Clan^.TurnNumber;
if (STurns < 0) and (AMShiftX = 0) and (AMShiftY = 0) then
- DrawSprite(sprAMSlot,
- AmmoRect.x + BORDERSIZE + (g * (AMSlotSize+1)) + AMSlotPadding,
+ DrawSprite(sprAMSlot,
+ AmmoRect.x + BORDERSIZE + (g * (AMSlotSize+1)) + AMSlotPadding,
AmmoRect.y + BORDERSIZE + (c * (AMSlotSize+1)) + AMSlotPadding -1, 0);
end;
inc(g);
@@ -744,7 +747,7 @@
{$IFDEF USE_TOUCH_INTERFACE}//show the aiming buttons + animation
if (Ammo^[Slot, Pos].Propz and ammoprop_NeedUpDown) <> 0 then
begin
- if not(arrowUp.show) then
+ if (not arrowUp.show) then
begin
animateWidget(@arrowUp, true, true);
animateWidget(@arrowDown, true, true);
@@ -767,7 +770,7 @@
if (WeaponTooltipTex <> nil) and (AMShiftX = 0) and (AMShiftY = 0) then
{$IFDEF USE_LANDSCAPE_AMMOMENU}
- if not isPhone() then
+ if (not isPhone()) then
ShowWeaponTooltip(-WeaponTooltipTex^.w div 2, AmmoRect.y - WeaponTooltipTex^.h - AMSlotSize);
{$ELSE}
ShowWeaponTooltip(AmmoRect.x - WeaponTooltipTex^.w - 3, Min(AmmoRect.y + 1, cScreenHeight - WeaponTooltipTex^.h - 40));
@@ -781,9 +784,9 @@
end;
procedure DrawWater(Alpha: byte; OffsetY: LongInt);
-var VertexBuffer: array [0..3] of TVertex2f;
- r: TSDL_Rect;
- lw, lh: GLfloat;
+var VertexBuffer : array [0..3] of TVertex2f;
+ r : TSDL_Rect;
+ lw, lh : GLfloat;
begin
if SuddenDeathDmg then
begin
@@ -820,6 +823,7 @@
VertexBuffer[3].X:= -lw;
VertexBuffer[3].Y:= lh;
+{$IFNDEF GL2}
glDisableClientState(GL_TEXTURE_COORD_ARRAY);
glEnableClientState(GL_COLOR_ARRAY);
if SuddenDeathDmg then
@@ -833,8 +837,29 @@
glDisableClientState(GL_COLOR_ARRAY);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
+
+{$ELSE}
+ UpdateModelviewProjection;
+
+ BeginWater;
+ if SuddenDeathDmg then
+ SetColorPointer(@SDWaterColorArray[0], 4)
+ else
+ SetColorPointer(@WaterColorArray[0], 4);
+
+ SetVertexPointer(@VertexBuffer[0], 4);
+
+ glDrawArrays(GL_TRIANGLE_FAN, 0, 4);
+
+ EndWater;
+{$ENDIF}
+
+ {$IFNDEF GL2}
glColor4ub($FF, $FF, $FF, $FF); // must not be Tint() as color array seems to stay active and color reset is required
+ {$ENDIF}
+ {$IFNDEF WEBGL}
glEnable(GL_TEXTURE_2D);
+ {$ENDIF}
end;
end;
@@ -888,8 +913,13 @@
TextureBuffer[3].Y:= TextureBuffer[2].Y;
-glVertexPointer(2, GL_FLOAT, 0, @VertexBuffer[0]);
-glTexCoordPointer(2, GL_FLOAT, 0, @TextureBuffer[0]);
+SetVertexPointer(@VertexBuffer[0], Length(VertexBuffer));
+SetTexCoordPointer(@TextureBuffer[0], Length(VertexBuffer));
+
+{$IFDEF GL2}
+UpdateModelviewProjection;
+{$ENDIF}
+
glDrawArrays(GL_TRIANGLE_FAN, 0, Length(VertexBuffer));
Tint($FF, $FF, $FF, $FF);
@@ -1101,12 +1131,19 @@
else if rm = rmLeftEye then
d:= -d;
stereoDepth:= stereoDepth + d;
+
+ {$IFDEF GL2}
+ hglMatrixMode(MATRIX_PROJECTION);
+ hglTranslatef(d, 0, 0);
+ hglMatrixMode(MATRIX_MODELVIEW);
+ {$ELSE}
glMatrixMode(GL_PROJECTION);
glTranslatef(d, 0, 0);
glMatrixMode(GL_MODELVIEW);
+ {$ENDIF}
{$ENDIF}
end;
-
+
procedure ResetDepth(rm: TRenderMode);
begin
{$IFNDEF USE_S3D_RENDERING}
@@ -1115,13 +1152,19 @@
{$ELSE}
if rm = rmDefault then
exit;
+ {$IFDEF GL2}
+ hglMatrixMode(MATRIX_PROJECTION);
+ hglTranslatef(-stereoDepth, 0, 0);
+ hglMatrixMode(MATRIX_MODELVIEW);
+ {$ELSE}
glMatrixMode(GL_PROJECTION);
glTranslatef(-stereoDepth, 0, 0);
glMatrixMode(GL_MODELVIEW);
- stereoDepth:= 0;
+ {$ENDIF}
+ cStereoDepth:= 0;
{$ENDIF}
end;
-
+
procedure DrawWorldStereo(Lag: LongInt; RM: TRenderMode);
var i, t, h: LongInt;
r: TSDL_Rect;
@@ -1159,7 +1202,7 @@
if (cReducedQuality and rq2DWater) = 0 then
begin
// Waves
- DrawWater(255, SkyOffset);
+ DrawWater(255, SkyOffset);
ChangeDepth(RM, -cStereo_Water_distant);
DrawWaves( 1, 0 - WorldDx div 32, - cWaveHeight + offsetY div 35, 64);
ChangeDepth(RM, -cStereo_Water_distant);
@@ -1178,6 +1221,30 @@
DrawWater(255, 0);
+(*
+// Attack bar
+ if CurrentTeam <> nil then
+ case AttackBar of
+ //1: begin
+ //r:= StuffPoz[sPowerBar];
+ //{$WARNINGS OFF}
+ //r.w:= (CurrentHedgehog^.Gear^.Power * 256) div cPowerDivisor;
+ //{$WARNINGS ON}
+ //DrawSpriteFromRect(r, cScreenWidth - 272, cScreenHeight - 48, 16, 0, Surface);
+ //end;
+ 2: with CurrentHedgehog^ do
+ begin
+ tdx:= hwSign(Gear^.dX) * Sin(Gear^.Angle * Pi / cMaxAngle);
+ tdy:= - Cos(Gear^.Angle * Pi / cMaxAngle);
+ for i:= (Gear^.Power * 24) div cPowerDivisor downto 0 do
+ DrawSprite(sprPower,
+ hwRound(Gear^.X) + GetLaunchX(CurAmmoType, hwSign(Gear^.dX), Gear^.Angle) + LongInt(round(WorldDx + tdx * (24 + i * 2))) - 16,
+ hwRound(Gear^.Y) + GetLaunchY(CurAmmoType, Gear^.Angle) + LongInt(round(WorldDy + tdy * (24 + i * 2))) - 16,
+ i)
+ end
+ end;
+*)
+
DrawVisualGears(1);
DrawGears;
DrawVisualGears(6);
@@ -1252,7 +1319,7 @@
i:= Succ(Pred(ReadyTimeLeft) div 1000)
else
i:= Succ(Pred(TurnTimeLeft) div 1000);
-
+
if i>99 then
t:= 112
else if i>9 then
@@ -1323,7 +1390,7 @@
r.w:= 3;
DrawTextureFromRect(TeamHealthBarWidth + 16, cScreenHeight + DrawHealthY + smallScreenOffset, @r, HealthTex);
- if not highlight and (not hasGone) then
+ if (not highlight) and (not hasGone) then
for i:= 0 to cMaxHHIndex do
if Hedgehogs[i].Gear <> nil then
begin
@@ -1359,7 +1426,7 @@
r.w:= TeamHealthBarWidth + 1;
r.h:= HealthTex^.h - 4;
DrawTextureFromRect(16, cScreenHeight + DrawHealthY + smallScreenOffset + 2, @r, HealthTex);
- if not hasGone and (TeamHealth > 1) then
+ if (not hasGone) and (TeamHealth > 1) then
begin
Tint(Clan^.Color shl 8 or $FF);
for i:= 0 to cMaxHHIndex do
@@ -1425,14 +1492,14 @@
AMAnimStartTime:= RealTicks - (AMAnimDuration - (RealTicks - AMAnimStartTime));
AMState:= AMShowingUp;
end;
-if not(bShowAmmoMenu) and ((AMstate = AMShowing) or (AMState = AMShowingUp)) then
+if (not bShowAmmoMenu) and ((AMstate = AMShowing) or (AMState = AMShowingUp)) then
begin
if (AMState = AMShowing) then
AMAnimStartTime:= RealTicks
else
AMAnimStartTime:= RealTicks - (AMAnimDuration - (RealTicks - AMAnimStartTime));
AMState:= AMHiding;
- end;
+ end;
if bShowAmmoMenu or (AMState = AMHiding) then
ShowAmmoMenu;
@@ -1444,12 +1511,13 @@
// Chat
DrawChat;
+
// various captions
if fastUntilLag then
DrawTextureCentered(0, (cScreenHeight shr 1), SyncTexture);
if isPaused then
DrawTextureCentered(0, (cScreenHeight shr 1), PauseTexture);
-if not isFirstFrame and (missionTimer <> 0) or isPaused or fastUntilLag or (GameState = gsConfirm) then
+if (not isFirstFrame) and (missionTimer <> 0) or isPaused or fastUntilLag or (GameState = gsConfirm) then
begin
if (ReadyTimeLeft = 0) and (missionTimer > 0) then
dec(missionTimer, Lag);
@@ -1485,8 +1553,8 @@
if t < 10 then
s:= '0' + s;
s:= inttostr(i div 60) + ':' + s;
-
-
+
+
tmpSurface:= TTF_RenderUTF8_Blended(Fontz[fnt16].Handle, Str2PChar(s), cWhiteColorChannels);
tmpSurface:= doSurfaceConversion(tmpSurface);
FreeTexture(timeTexture);
@@ -1536,7 +1604,7 @@
if ScreenFade <> sfNone then
begin
- if not isFirstFrame then
+ if (not isFirstFrame) then
case ScreenFade of
sfToBlack, sfToWhite: if ScreenFadeValue + Lag * ScreenFadeSpeed < sfMax then
inc(ScreenFadeValue, Lag * ScreenFadeSpeed)
@@ -1566,11 +1634,11 @@
glDisable(GL_TEXTURE_2D);
glVertexPointer(2, GL_FLOAT, 0, @VertexBuffer[0]);
- glDrawArrays(GL_TRIANGLE_FAN, 0, Length(VertexBuffer));
+ glDrawArrays(GL_TRIANGLE_FAN, 0, High(VertexBuffer) - Low(VertexBuffer) + 1);
glEnable(GL_TEXTURE_2D);
Tint($FF, $FF, $FF, $FF);
- if not isFirstFrame and ((ScreenFadeValue = 0) or (ScreenFadeValue = sfMax)) then
+ if (not isFirstFrame) and ((ScreenFadeValue = 0) or (ScreenFadeValue = sfMax)) then
ScreenFade:= sfNone
end
end;
@@ -1591,7 +1659,7 @@
DrawTexture( -(cScreenWidth shr 1) + 50, 20, recTexture);
// draw red circle
- glDisable(GL_TEXTURE_2D);
+ glDisable(GL_TEXTURE_2D);
Tint($FF, $00, $00, Byte(Round(127*(1 + sin(SDL_GetTicks()*0.007)))));
glBegin(GL_POLYGON);
for i:= 0 to 20 do
@@ -1630,7 +1698,7 @@
// Cursor
if isCursorVisible then
begin
- if not bShowAmmoMenu then
+ if (not bShowAmmoMenu) then
begin
if not CurrentTeam^.ExtDriven then TargetCursorPoint:= CursorPoint;
with CurrentHedgehog^ do
@@ -1646,6 +1714,7 @@
DrawSprite(sprArrow, TargetCursorPoint.X, cScreenHeight - TargetCursorPoint.Y, (RealTicks shr 6) mod 8)
end
end;
+
isFirstFrame:= false
end;
@@ -1659,7 +1728,7 @@
uCursor.updatePosition();
{$ENDIF}
z:= round(200/zoom);
-if not PlacingHogs and (FollowGear <> nil) and (not isCursorVisible) and (not bShowAmmoMenu) and (not fastUntilLag) and autoCameraOn then
+if (not PlacingHogs) and (FollowGear <> nil) and (not isCursorVisible) and (not bShowAmmoMenu) and (not fastUntilLag) and autoCameraOn then
if ((abs(CursorPoint.X - prevPoint.X) + abs(CursorPoint.Y - prevpoint.Y)) > 4) then
begin
FollowGear:= nil;
@@ -1700,7 +1769,7 @@
{$ENDIF}
{$ENDIF}
- if CursorPoint.X < AmmoRect.x + amNumOffsetX + 3 then//check left
+ if CursorPoint.X < AmmoRect.x + amNumOffsetX + 3 then//check left
CursorPoint.X:= AmmoRect.x + amNumOffsetX + 3;
if CursorPoint.X > AmmoRect.x + AmmoRect.w - 3 then//check right
CursorPoint.X:= AmmoRect.x + AmmoRect.w - 3;
@@ -1829,10 +1898,10 @@
{$IFDEF USE_VIDEO_RECORDING}
// do not change volume during prerecording as it will affect sound in video file
-if not flagPrerecording then
+if (not flagPrerecording) then
{$ENDIF}
begin
- if not cHasFocus then DampenAudio()
+ if (not cHasFocus) then DampenAudio()
else UndampenAudio();
end;
end;
@@ -1848,7 +1917,7 @@
begin
utilityWidget.sprite:= sprTimerButton;
animateWidget(@utilityWidget, true, true);
- end
+ end
else if (Ammoz[ammoType].Ammo.Propz and ammoprop_NeedTarget) <> 0 then
begin
utilityWidget.sprite:= sprTargetButton;
@@ -1872,7 +1941,7 @@
begin
show:= showWidget;
if fade then fadeAnimStart:= RealTicks;
-
+
with moveAnim do
begin
animate:= true;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/videorec/avwrapper.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,509 @@
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; version 2 of the License
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdint.h>
+#include <string.h>
+#include <stdarg.h>
+#include "libavformat/avformat.h"
+#include "libavutil/mathematics.h"
+
+#ifndef AVIO_FLAG_WRITE
+#define AVIO_FLAG_WRITE AVIO_WRONLY
+#endif
+
+static AVFormatContext* g_pContainer;
+static AVOutputFormat* g_pFormat;
+static AVStream* g_pAStream;
+static AVStream* g_pVStream;
+static AVFrame* g_pAFrame;
+static AVFrame* g_pVFrame;
+static AVCodec* g_pACodec;
+static AVCodec* g_pVCodec;
+static AVCodecContext* g_pAudio;
+static AVCodecContext* g_pVideo;
+
+static int g_Width, g_Height;
+static uint32_t g_Frequency, g_Channels;
+static int g_VQuality;
+static AVRational g_Framerate;
+
+static FILE* g_pSoundFile;
+static int16_t* g_pSamples;
+static int g_NumSamples;
+
+
+#if LIBAVCODEC_VERSION_MAJOR < 54
+#define OUTBUFFER_SIZE 200000
+static uint8_t g_OutBuffer[OUTBUFFER_SIZE];
+#endif
+
+// pointer to function from hwengine (uUtils.pas)
+static void (*AddFileLogRaw)(const char* pString);
+
+static void FatalError(const char* pFmt, ...)
+{
+ char Buffer[1024];
+ va_list VaArgs;
+
+ va_start(VaArgs, pFmt);
+ vsnprintf(Buffer, 1024, pFmt, VaArgs);
+ va_end(VaArgs);
+
+ AddFileLogRaw("Error in av-wrapper: ");
+ AddFileLogRaw(Buffer);
+ AddFileLogRaw("\n");
+ exit(1);
+}
+
+// Function to be called from libav for logging.
+// Note: libav can call LogCallback from different threads
+// (there is mutex in AddFileLogRaw).
+static void LogCallback(void* p, int Level, const char* pFmt, va_list VaArgs)
+{
+ char Buffer[1024];
+
+ vsnprintf(Buffer, 1024, pFmt, VaArgs);
+ AddFileLogRaw(Buffer);
+}
+
+static void Log(const char* pFmt, ...)
+{
+ char Buffer[1024];
+ va_list VaArgs;
+
+ va_start(VaArgs, pFmt);
+ vsnprintf(Buffer, 1024, pFmt, VaArgs);
+ va_end(VaArgs);
+
+ AddFileLogRaw(Buffer);
+}
+
+static void AddAudioStream()
+{
+#if LIBAVFORMAT_VERSION_MAJOR >= 53
+ g_pAStream = avformat_new_stream(g_pContainer, g_pACodec);
+#else
+ g_pAStream = av_new_stream(g_pContainer, 1);
+#endif
+ if(!g_pAStream)
+ {
+ Log("Could not allocate audio stream\n");
+ return;
+ }
+ g_pAStream->id = 1;
+
+ g_pAudio = g_pAStream->codec;
+
+ avcodec_get_context_defaults3(g_pAudio, g_pACodec);
+ g_pAudio->codec_id = g_pACodec->id;
+
+ // put parameters
+ g_pAudio->sample_fmt = AV_SAMPLE_FMT_S16;
+ g_pAudio->sample_rate = g_Frequency;
+ g_pAudio->channels = g_Channels;
+
+ // set quality
+ g_pAudio->bit_rate = 160000;
+
+ // for codecs that support variable bitrate use it, it should be better
+ g_pAudio->flags |= CODEC_FLAG_QSCALE;
+ g_pAudio->global_quality = 1*FF_QP2LAMBDA;
+
+ // some formats want stream headers to be separate
+ if (g_pFormat->flags & AVFMT_GLOBALHEADER)
+ g_pAudio->flags |= CODEC_FLAG_GLOBAL_HEADER;
+
+ // open it
+#if LIBAVCODEC_VERSION_MAJOR >= 53
+ if (avcodec_open2(g_pAudio, g_pACodec, NULL) < 0)
+#else
+ if (avcodec_open(g_pAudio, g_pACodec) < 0)
+#endif
+ {
+ Log("Could not open audio codec %s\n", g_pACodec->long_name);
+ return;
+ }
+
+#if LIBAVCODEC_VERSION_MAJOR >= 54
+ if (g_pACodec->capabilities & CODEC_CAP_VARIABLE_FRAME_SIZE)
+#else
+ if (g_pAudio->frame_size == 0)
+#endif
+ g_NumSamples = 4096;
+ else
+ g_NumSamples = g_pAudio->frame_size;
+ g_pSamples = (int16_t*)av_malloc(g_NumSamples*g_Channels*sizeof(int16_t));
+ g_pAFrame = avcodec_alloc_frame();
+ if (!g_pAFrame)
+ {
+ Log("Could not allocate frame\n");
+ return;
+ }
+}
+
+// returns non-zero if there is more sound
+static int WriteAudioFrame()
+{
+ if (!g_pAStream)
+ return 0;
+
+ AVPacket Packet = { 0 };
+ av_init_packet(&Packet);
+
+ int NumSamples = fread(g_pSamples, 2*g_Channels, g_NumSamples, g_pSoundFile);
+
+#if LIBAVCODEC_VERSION_MAJOR >= 53
+ AVFrame* pFrame = NULL;
+ if (NumSamples > 0)
+ {
+ g_pAFrame->nb_samples = NumSamples;
+ avcodec_fill_audio_frame(g_pAFrame, g_Channels, AV_SAMPLE_FMT_S16,
+ (uint8_t*)g_pSamples, NumSamples*2*g_Channels, 1);
+ pFrame = g_pAFrame;
+ }
+ // when NumSamples == 0 we still need to call encode_audio2 to flush
+ int got_packet;
+ if (avcodec_encode_audio2(g_pAudio, &Packet, pFrame, &got_packet) != 0)
+ FatalError("avcodec_encode_audio2 failed");
+ if (!got_packet)
+ return 0;
+#else
+ if (NumSamples == 0)
+ return 0;
+ int BufferSize = OUTBUFFER_SIZE;
+ if (g_pAudio->frame_size == 0)
+ BufferSize = NumSamples*g_Channels*2;
+ Packet.size = avcodec_encode_audio(g_pAudio, g_OutBuffer, BufferSize, g_pSamples);
+ if (Packet.size == 0)
+ return 1;
+ if (g_pAudio->coded_frame && g_pAudio->coded_frame->pts != AV_NOPTS_VALUE)
+ Packet.pts = av_rescale_q(g_pAudio->coded_frame->pts, g_pAudio->time_base, g_pAStream->time_base);
+ Packet.flags |= AV_PKT_FLAG_KEY;
+ Packet.data = g_OutBuffer;
+#endif
+
+ // Write the compressed frame to the media file.
+ Packet.stream_index = g_pAStream->index;
+ if (av_interleaved_write_frame(g_pContainer, &Packet) != 0)
+ FatalError("Error while writing audio frame");
+ return 1;
+}
+
+// add a video output stream
+static void AddVideoStream()
+{
+#if LIBAVFORMAT_VERSION_MAJOR >= 53
+ g_pVStream = avformat_new_stream(g_pContainer, g_pVCodec);
+#else
+ g_pVStream = av_new_stream(g_pContainer, 0);
+#endif
+ if (!g_pVStream)
+ FatalError("Could not allocate video stream");
+
+ g_pVideo = g_pVStream->codec;
+
+ avcodec_get_context_defaults3(g_pVideo, g_pVCodec);
+ g_pVideo->codec_id = g_pVCodec->id;
+
+ // put parameters
+ // resolution must be a multiple of two
+ g_pVideo->width = g_Width & ~1; // make even (dimensions should be even)
+ g_pVideo->height = g_Height & ~1; // make even
+ /* time base: this is the fundamental unit of time (in seconds) in terms
+ of which frame timestamps are represented. for fixed-fps content,
+ timebase should be 1/framerate and timestamp increments should be
+ identically 1. */
+ g_pVideo->time_base.den = g_Framerate.num;
+ g_pVideo->time_base.num = g_Framerate.den;
+ //g_pVideo->gop_size = 12; /* emit one intra frame every twelve frames at most */
+ g_pVideo->pix_fmt = PIX_FMT_YUV420P;
+
+ // set quality
+ if (g_VQuality > 100)
+ g_pVideo->bit_rate = g_VQuality;
+ else
+ {
+ g_pVideo->flags |= CODEC_FLAG_QSCALE;
+ g_pVideo->global_quality = g_VQuality*FF_QP2LAMBDA;
+ }
+
+ // some formats want stream headers to be separate
+ if (g_pFormat->flags & AVFMT_GLOBALHEADER)
+ g_pVideo->flags |= CODEC_FLAG_GLOBAL_HEADER;
+
+#if LIBAVCODEC_VERSION_MAJOR < 53
+ // for some versions of ffmpeg x264 options must be set explicitly
+ if (strcmp(g_pVCodec->name, "libx264") == 0)
+ {
+ g_pVideo->coder_type = FF_CODER_TYPE_AC;
+ g_pVideo->flags |= CODEC_FLAG_LOOP_FILTER;
+ g_pVideo->crf = 23;
+ g_pVideo->thread_count = 3;
+ g_pVideo->me_cmp = FF_CMP_CHROMA;
+ g_pVideo->partitions = X264_PART_I8X8 | X264_PART_I4X4 | X264_PART_P8X8 | X264_PART_B8X8;
+ g_pVideo->me_method = ME_HEX;
+ g_pVideo->me_subpel_quality = 7;
+ g_pVideo->me_range = 16;
+ g_pVideo->gop_size = 250;
+ g_pVideo->keyint_min = 25;
+ g_pVideo->scenechange_threshold = 40;
+ g_pVideo->i_quant_factor = 0.71;
+ g_pVideo->b_frame_strategy = 1;
+ g_pVideo->qcompress = 0.6;
+ g_pVideo->qmin = 10;
+ g_pVideo->qmax = 51;
+ g_pVideo->max_qdiff = 4;
+ g_pVideo->max_b_frames = 3;
+ g_pVideo->refs = 3;
+ g_pVideo->directpred = 1;
+ g_pVideo->trellis = 1;
+ g_pVideo->flags2 = CODEC_FLAG2_BPYRAMID | CODEC_FLAG2_MIXED_REFS | CODEC_FLAG2_WPRED | CODEC_FLAG2_8X8DCT | CODEC_FLAG2_FASTPSKIP;
+ g_pVideo->weighted_p_pred = 2;
+ }
+#endif
+
+ // open the codec
+#if LIBAVCODEC_VERSION_MAJOR >= 53
+ AVDictionary* pDict = NULL;
+ if (strcmp(g_pVCodec->name, "libx264") == 0)
+ av_dict_set(&pDict, "preset", "medium", 0);
+
+ if (avcodec_open2(g_pVideo, g_pVCodec, &pDict) < 0)
+#else
+ if (avcodec_open(g_pVideo, g_pVCodec) < 0)
+#endif
+ FatalError("Could not open video codec %s", g_pVCodec->long_name);
+
+ g_pVFrame = avcodec_alloc_frame();
+ if (!g_pVFrame)
+ FatalError("Could not allocate frame");
+
+ g_pVFrame->linesize[0] = g_Width;
+ g_pVFrame->linesize[1] = g_Width/2;
+ g_pVFrame->linesize[2] = g_Width/2;
+ g_pVFrame->linesize[3] = 0;
+}
+
+static int WriteFrame(AVFrame* pFrame)
+{
+ double AudioTime, VideoTime;
+
+ // write interleaved audio frame
+ if (g_pAStream)
+ {
+ VideoTime = (double)g_pVStream->pts.val*g_pVStream->time_base.num/g_pVStream->time_base.den;
+ do
+ AudioTime = (double)g_pAStream->pts.val*g_pAStream->time_base.num/g_pAStream->time_base.den;
+ while (AudioTime < VideoTime && WriteAudioFrame());
+ }
+
+ if (!g_pVStream)
+ return 0;
+
+ AVPacket Packet;
+ av_init_packet(&Packet);
+ Packet.data = NULL;
+ Packet.size = 0;
+
+ g_pVFrame->pts++;
+ if (g_pFormat->flags & AVFMT_RAWPICTURE)
+ {
+ /* raw video case. The API will change slightly in the near
+ future for that. */
+ Packet.flags |= AV_PKT_FLAG_KEY;
+ Packet.stream_index = g_pVStream->index;
+ Packet.data = (uint8_t*)pFrame;
+ Packet.size = sizeof(AVPicture);
+
+ if (av_interleaved_write_frame(g_pContainer, &Packet) != 0)
+ FatalError("Error while writing video frame");
+ return 0;
+ }
+ else
+ {
+#if LIBAVCODEC_VERSION_MAJOR >= 54
+ int got_packet;
+ if (avcodec_encode_video2(g_pVideo, &Packet, pFrame, &got_packet) < 0)
+ FatalError("avcodec_encode_video2 failed");
+ if (!got_packet)
+ return 0;
+
+ if (Packet.pts != AV_NOPTS_VALUE)
+ Packet.pts = av_rescale_q(Packet.pts, g_pVideo->time_base, g_pVStream->time_base);
+ if (Packet.dts != AV_NOPTS_VALUE)
+ Packet.dts = av_rescale_q(Packet.dts, g_pVideo->time_base, g_pVStream->time_base);
+#else
+ Packet.size = avcodec_encode_video(g_pVideo, g_OutBuffer, OUTBUFFER_SIZE, pFrame);
+ if (Packet.size < 0)
+ FatalError("avcodec_encode_video failed");
+ if (Packet.size == 0)
+ return 0;
+
+ if( g_pVideo->coded_frame->pts != AV_NOPTS_VALUE)
+ Packet.pts = av_rescale_q(g_pVideo->coded_frame->pts, g_pVideo->time_base, g_pVStream->time_base);
+ if( g_pVideo->coded_frame->key_frame )
+ Packet.flags |= AV_PKT_FLAG_KEY;
+ Packet.data = g_OutBuffer;
+#endif
+ // write the compressed frame in the media file
+ Packet.stream_index = g_pVStream->index;
+ if (av_interleaved_write_frame(g_pContainer, &Packet) != 0)
+ FatalError("Error while writing video frame");
+
+ return 1;
+ }
+}
+
+void AVWrapper_WriteFrame(uint8_t* pY, uint8_t* pCb, uint8_t* pCr)
+{
+ g_pVFrame->data[0] = pY;
+ g_pVFrame->data[1] = pCb;
+ g_pVFrame->data[2] = pCr;
+ WriteFrame(g_pVFrame);
+}
+
+void AVWrapper_Init(
+ void (*pAddFileLogRaw)(const char*),
+ const char* pFilename,
+ const char* pDesc,
+ const char* pSoundFile,
+ const char* pFormatName,
+ const char* pVCodecName,
+ const char* pACodecName,
+ int Width, int Height,
+ int FramerateNum, int FramerateDen,
+ int VQuality)
+{
+ AddFileLogRaw = pAddFileLogRaw;
+ av_log_set_callback( &LogCallback );
+
+ g_Width = Width;
+ g_Height = Height;
+ g_Framerate.num = FramerateNum;
+ g_Framerate.den = FramerateDen;
+ g_VQuality = VQuality;
+
+ // initialize libav and register all codecs and formats
+ av_register_all();
+
+ // find format
+ g_pFormat = av_guess_format(pFormatName, NULL, NULL);
+ if (!g_pFormat)
+ FatalError("Format \"%s\" was not found", pFormatName);
+
+ // allocate the output media context
+ g_pContainer = avformat_alloc_context();
+ if (!g_pContainer)
+ FatalError("Could not allocate output context");
+
+ g_pContainer->oformat = g_pFormat;
+
+ // store description of file
+ av_dict_set(&g_pContainer->metadata, "comment", pDesc, 0);
+
+ // append extesnion to filename
+ char ext[16];
+ strncpy(ext, g_pFormat->extensions, 16);
+ ext[15] = 0;
+ ext[strcspn(ext,",")] = 0;
+ snprintf(g_pContainer->filename, sizeof(g_pContainer->filename), "%s.%s", pFilename, ext);
+
+ // find codecs
+ g_pVCodec = avcodec_find_encoder_by_name(pVCodecName);
+ g_pACodec = avcodec_find_encoder_by_name(pACodecName);
+
+ // add audio and video stream to container
+ g_pVStream = NULL;
+ g_pAStream = NULL;
+
+ if (g_pVCodec)
+ AddVideoStream();
+ else
+ Log("Video codec \"%s\" was not found; video will be ignored.\n", pVCodecName);
+
+ if (g_pACodec)
+ {
+ g_pSoundFile = fopen(pSoundFile, "rb");
+ if (g_pSoundFile)
+ {
+ fread(&g_Frequency, 4, 1, g_pSoundFile);
+ fread(&g_Channels, 4, 1, g_pSoundFile);
+ AddAudioStream();
+ }
+ else
+ Log("Could not open %s\n", pSoundFile);
+ }
+ else
+ Log("Audio codec \"%s\" was not found; audio will be ignored.\n", pACodecName);
+
+ if (!g_pAStream && !g_pVStream)
+ FatalError("No video, no audio, aborting...");
+
+ // write format info to log
+ av_dump_format(g_pContainer, 0, g_pContainer->filename, 1);
+
+ // open the output file, if needed
+ if (!(g_pFormat->flags & AVFMT_NOFILE))
+ {
+ if (avio_open(&g_pContainer->pb, g_pContainer->filename, AVIO_FLAG_WRITE) < 0)
+ FatalError("Could not open output file (%s)", g_pContainer->filename);
+ }
+
+ // write the stream header, if any
+ avformat_write_header(g_pContainer, NULL);
+
+ g_pVFrame->pts = -1;
+}
+
+void AVWrapper_Close()
+{
+ // output buffered frames
+ if (g_pVCodec->capabilities & CODEC_CAP_DELAY)
+ while( WriteFrame(NULL) );
+ // output any remaining audio
+ while( WriteAudioFrame() );
+
+ // write the trailer, if any.
+ av_write_trailer(g_pContainer);
+
+ // close the output file
+ if (!(g_pFormat->flags & AVFMT_NOFILE))
+ avio_close(g_pContainer->pb);
+
+ // free everything
+ if (g_pVStream)
+ {
+ avcodec_close(g_pVideo);
+ av_free(g_pVideo);
+ av_free(g_pVStream);
+ av_free(g_pVFrame);
+ }
+ if (g_pAStream)
+ {
+ avcodec_close(g_pAudio);
+ av_free(g_pAudio);
+ av_free(g_pAStream);
+ av_free(g_pAFrame);
+ av_free(g_pSamples);
+ fclose(g_pSoundFile);
+ }
+
+ av_free(g_pContainer);
+}
--- a/misc/liblua/CMakeLists.txt Sun Jan 27 00:01:26 2013 +0100
+++ b/misc/liblua/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -1,5 +1,7 @@
#this file is included only when system Lua library is not found
+#TODO: when NOPASCAL=1 it should use clang here too
+
file(GLOB lua_src *.c *.h)
if(WIN32)
--- a/misc/libopenalbridge/CMakeLists.txt Sun Jan 27 00:01:26 2013 +0100
+++ b/misc/libopenalbridge/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -15,14 +15,14 @@
#visualstudio and windows in general don't like static linking, so we're building the library in shared mode
if(WIN32)
#workaround for visualstudio (wants headers in the source list)
- set(openal_src *.h ${openal_src})
+ set(openal_src *.h ${openal_src})
#deps for the shared library
- link_libraries(${VORBISFILE_LIBRARY})
- link_libraries(${VORBIS_LIBRARY})
- link_libraries(${OGG_LIBRARY})
- link_libraries(${OPENAL_LIBRARY})
+ link_libraries(${VORBISFILE_LIBRARY})
+ link_libraries(${VORBIS_LIBRARY})
+ link_libraries(${OGG_LIBRARY})
+ link_libraries(${OPENAL_LIBRARY})
#build a shared library
- set (build_type SHARED)
+ set (build_type SHARED)
endif()
#compiles and links actual library
@@ -30,13 +30,13 @@
if(WIN32)
if(MSVC)
- set_target_properties(openalbridge PROPERTIES LINK_FLAGS /DEF:openalbridge.def)
+ set_target_properties(openalbridge PROPERTIES LINK_FLAGS /DEF:openalbridge.def)
endif(MSVC)
#install it in the executable directory
- install(TARGETS openalbridge DESTINATION bin)
+ install(TARGETS openalbridge DESTINATION bin)
endif(WIN32)
#type make openalbridge_test to get a small executable test
-add_executable(openalbridge_test "${hedgewars_SOURCE_DIR}/misc/libopenalbridge/tester.c")
+add_executable(openalbridge_test "${CMAKE_SOURCE_DIR}/misc/libopenalbridge/tester.c")
target_link_libraries(openalbridge_test openalbridge ${OPENAL_LIBRARY} ${OGGVORBIS_LIBRARIES})
--- a/project_files/Android-build/CMakeLists.txt Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/Android-build/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -26,7 +26,7 @@
endif()
if(IS_DIRECTORY "${ANDROID_NDK}")
- message(STATUS "Detected the android NDK directory at: " ${ANDROID_NDK})
+ message(STATUS "Detected the android NDK directory at: " ${ANDROID_NDK})
else ()
message(FATAL_ERROR "Couldn't detect the Android NDK directory")
endif()
@@ -39,7 +39,7 @@
endif()
if(IS_DIRECTORY "${ANDROID_NDK_TOOLCHAINDIR}")
- message(STATUS "Detected the Android NDK toolchain at: ${ANDROID_NDK_TOOLCHAINDIR}")
+ message(STATUS "Detected the Android NDK toolchain at: ${ANDROID_NDK_TOOLCHAINDIR}")
else ()
message(FATAL_ERROR "Couldn't detect the Android NDK toolchain directory: ${ANDROID_NDK_TOOLCHAINDIR}")
endif()
@@ -52,7 +52,7 @@
endif()
if( IS_DIRECTORY "${ANDROID_SDK}")
- message(STATUS "Detected the android SDK directory at: " ${ANDROID_SDK})
+ message(STATUS "Detected the android SDK directory at: " ${ANDROID_SDK})
else ()
message(FATAL_ERROR "Couldn't detect the Android SDK directory")
endif()
@@ -60,13 +60,13 @@
if( NOT FPC_DIR)
find_program(FPC_DIR ppcrossarm)
get_filename_component(FPC_DIR "${FPC_DIR}" PATH)
- if(IS_DIRECTORY "${FPC_DIR}")
- set(FPC_DIR "${FPC_DIR}" CACHE PATH "Path to fpc dir used in the android port" FORCE)
+ if(IS_DIRECTORY "${FPC_DIR}")
+ set(FPC_DIR "${FPC_DIR}" CACHE PATH "Path to fpc dir used in the android port" FORCE)
endif()
endif()
if( IS_DIRECTORY "${FPC_DIR}")
- message(STATUS "Detected the FreePascal directory at: " "${FPC_DIR}")
+ message(STATUS "Detected the FreePascal directory at: " "${FPC_DIR}")
else ()
message(FATAL_ERROR "Couldn't detect the FreePascal directory")
endif()
--- a/project_files/frontlib/hwconsts.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/hwconsts.h Sun Jan 27 00:28:57 2013 +0100
@@ -1,118 +1,118 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
- * Copyright (c) 2012 Simeon Maxein <smaxein@googlemail.com>
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; version 2 of the License
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
- */
-
-/**
- * This file contains important constants which might need to be changed to adapt to
- * changes in the engine or protocols.
- *
- * It also contains getter functions for some constants (in particular for constants
- * that are important for the layout of data structures), so that client code can
- * query the constants that the library was built with.
- */
-
-#ifndef HWCONSTS_H_
-#define HWCONSTS_H_
-
-#include <inttypes.h>
-#include <stddef.h>
-#include <stdbool.h>
-
-#define HEDGEHOGS_PER_TEAM 8
-#define DEFAULT_HEDGEHOG_COUNT 4
-#define DEFAULT_COLOR_INDEX 0
-
-#define NETGAME_DEFAULT_PORT 46631
-#define PROTOCOL_VERSION 42
-#define MIN_SERVER_VERSION 1
-
-//! Used for sending scripts to the engine
-#define MULTIPLAYER_SCRIPT_PATH "Scripts/Multiplayer/"
-
-#define WEAPONS_COUNT 56
-
-// TODO allow frontend to override these?
-/*! A merge of mikade/bugq colours w/ a bit of channel feedback */
-#define HW_TEAMCOLOR_ARRAY { UINT32_C(0xffff0204), /*! red */ \
- UINT32_C(0xff4980c1), /*! blue */ \
- UINT32_C(0xff1de6ba), /*! teal */ \
- UINT32_C(0xffb541ef), /*! purple */ \
- UINT32_C(0xffe55bb0), /*! pink */ \
- UINT32_C(0xff20bf00), /*! green */ \
- UINT32_C(0xfffe8b0e), /*! orange */ \
- UINT32_C(0xff5f3605), /*! brown */ \
- UINT32_C(0xffffff01), /*! yellow */ \
- /*! add new colors here */ \
- 0 } /*! Keep this 0 at the end */
-
-extern const size_t flib_teamcolor_count;
-extern const uint32_t flib_teamcolors[];
-
-/**
- * Returns the team color (ARGB) corresponding to the color index (0 if index out of bounds)
- */
-uint32_t flib_get_teamcolor(int colorIndex);
-
-/**
- * Returns the number of team colors (i.e. the length of the flib_teamcolors array)
- */
-int flib_get_teamcolor_count();
-
-/**
- * Returns the HEDGEHOGS_PER_TEAM constant
- */
-int flib_get_hedgehogs_per_team();
-
-/**
- * Returns the WEAPONS_COUNT constant
- */
-int flib_get_weapons_count();
-
-/*!
- * These structs define the meaning of values in the flib_scheme struct, i.e. their correspondence to
- * ini settings, engine commands and positions in the network protocol (the last is encoded in the
- * order of settings/mods).
- */
-typedef struct {
- const char *name; //!< A name identifying this setting (used as key in the schemes file)
- const char *engineCommand; //!< The command needed to send the setting to the engine. May be null if the setting is not sent to the engine (for the "health" setting)
- const bool maxMeansInfinity; //!< If true, send a very high number to the engine if the setting is equal to its maximum
- const bool times1000; //!< If true (for time-based settings), multiply the setting by 1000 before sending it to the engine.
- const int min; //!< The smallest allowed value
- const int max; //!< The highest allowed value
- const int def; //!< The default value
-} flib_metascheme_setting;
-
-typedef struct {
- const char *name; //!< A name identifying this mod (used as key in the schemes file)
- const int bitmaskIndex; //!< Mods are sent to the engine in a single integer, this field describes which bit of that integer is used
- //! for this particular mod.
-} flib_metascheme_mod;
-
-typedef struct {
- const int settingCount;
- const int modCount;
- const flib_metascheme_setting *settings;
- const flib_metascheme_mod *mods;
-} flib_metascheme;
-
-extern const flib_metascheme flib_meta;
-
-const flib_metascheme *flib_get_metascheme();
-
-#endif
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
+ * Copyright (c) 2012 Simeon Maxein <smaxein@googlemail.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; version 2 of the License
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+ */
+
+/**
+ * This file contains important constants which might need to be changed to adapt to
+ * changes in the engine or protocols.
+ *
+ * It also contains getter functions for some constants (in particular for constants
+ * that are important for the layout of data structures), so that client code can
+ * query the constants that the library was built with.
+ */
+
+#ifndef HWCONSTS_H_
+#define HWCONSTS_H_
+
+#include <inttypes.h>
+#include <stddef.h>
+#include <stdbool.h>
+
+#define HEDGEHOGS_PER_TEAM 8
+#define DEFAULT_HEDGEHOG_COUNT 4
+#define DEFAULT_COLOR_INDEX 0
+
+#define NETGAME_DEFAULT_PORT 46631
+#define PROTOCOL_VERSION 42
+#define MIN_SERVER_VERSION 1
+
+//! Used for sending scripts to the engine
+#define MULTIPLAYER_SCRIPT_PATH "Scripts/Multiplayer/"
+
+#define WEAPONS_COUNT 56
+
+// TODO allow frontend to override these?
+/*! A merge of mikade/bugq colours w/ a bit of channel feedback */
+#define HW_TEAMCOLOR_ARRAY { UINT32_C(0xffff0204), /*! red */ \
+ UINT32_C(0xff4980c1), /*! blue */ \
+ UINT32_C(0xff1de6ba), /*! teal */ \
+ UINT32_C(0xffb541ef), /*! purple */ \
+ UINT32_C(0xffe55bb0), /*! pink */ \
+ UINT32_C(0xff20bf00), /*! green */ \
+ UINT32_C(0xfffe8b0e), /*! orange */ \
+ UINT32_C(0xff5f3605), /*! brown */ \
+ UINT32_C(0xffffff01), /*! yellow */ \
+ /*! add new colors here */ \
+ 0 } /*! Keep this 0 at the end */
+
+extern const size_t flib_teamcolor_count;
+extern const uint32_t flib_teamcolors[];
+
+/**
+ * Returns the team color (ARGB) corresponding to the color index (0 if index out of bounds)
+ */
+uint32_t flib_get_teamcolor(int colorIndex);
+
+/**
+ * Returns the number of team colors (i.e. the length of the flib_teamcolors array)
+ */
+int flib_get_teamcolor_count();
+
+/**
+ * Returns the HEDGEHOGS_PER_TEAM constant
+ */
+int flib_get_hedgehogs_per_team();
+
+/**
+ * Returns the WEAPONS_COUNT constant
+ */
+int flib_get_weapons_count();
+
+/*!
+ * These structs define the meaning of values in the flib_scheme struct, i.e. their correspondence to
+ * ini settings, engine commands and positions in the network protocol (the last is encoded in the
+ * order of settings/mods).
+ */
+typedef struct {
+ const char *name; //!< A name identifying this setting (used as key in the schemes file)
+ const char *engineCommand; //!< The command needed to send the setting to the engine. May be null if the setting is not sent to the engine (for the "health" setting)
+ const bool maxMeansInfinity; //!< If true, send a very high number to the engine if the setting is equal to its maximum
+ const bool times1000; //!< If true (for time-based settings), multiply the setting by 1000 before sending it to the engine.
+ const int min; //!< The smallest allowed value
+ const int max; //!< The highest allowed value
+ const int def; //!< The default value
+} flib_metascheme_setting;
+
+typedef struct {
+ const char *name; //!< A name identifying this mod (used as key in the schemes file)
+ const int bitmaskIndex; //!< Mods are sent to the engine in a single integer, this field describes which bit of that integer is used
+ //! for this particular mod.
+} flib_metascheme_mod;
+
+typedef struct {
+ const int settingCount;
+ const int modCount;
+ const flib_metascheme_setting *settings;
+ const flib_metascheme_mod *mods;
+} flib_metascheme;
+
+extern const flib_metascheme flib_meta;
+
+const flib_metascheme *flib_get_metascheme();
+
+#endif
--- a/project_files/frontlib/md5/md5.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/md5/md5.h Sun Jan 27 00:28:57 2013 +0100
@@ -27,7 +27,7 @@
This code implements the MD5 Algorithm defined in RFC 1321, whose
text is available at
- http://www.ietf.org/rfc/rfc1321.txt
+ http://www.ietf.org/rfc/rfc1321.txt
The code is derived from the text of the RFC, including the test suite
(section A.5) but excluding the rest of Appendix A. It does not include
any code or documentation that is identified in the RFC as being
@@ -38,12 +38,12 @@
that follows (in reverse chronological order):
2002-04-13 lpd Removed support for non-ANSI compilers; removed
- references to Ghostscript; clarified derivation from RFC 1321;
- now handles byte order either statically or dynamically.
+ references to Ghostscript; clarified derivation from RFC 1321;
+ now handles byte order either statically or dynamically.
1999-11-04 lpd Edited comments slightly for automatic TOC extraction.
1999-10-18 lpd Fixed typo in header comment (ansi2knr rather than md5);
- added conditionalization for C++ compilation from Martin
- Purschke <purschke@bnl.gov>.
+ added conditionalization for C++ compilation from Martin
+ Purschke <purschke@bnl.gov>.
1999-05-03 lpd Original version.
*/
@@ -65,13 +65,13 @@
/*! Define the state of the MD5 Algorithm. */
typedef struct md5_state_s {
- md5_word_t count[2]; /*! message length in bits, lsw first */
- md5_word_t abcd[4]; /*! digest buffer */
- md5_byte_t buf[64]; /*! accumulate block */
+ md5_word_t count[2]; /*! message length in bits, lsw first */
+ md5_word_t abcd[4]; /*! digest buffer */
+ md5_byte_t buf[64]; /*! accumulate block */
} md5_state_t;
#ifdef __cplusplus
-extern "C"
+extern "C"
{
#endif
--- a/project_files/frontlib/model/gamesetup.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/model/gamesetup.h Sun Jan 27 00:28:57 2013 +0100
@@ -1,47 +1,47 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- */
-
-/**
- * A complete game configuration that contains all settings the engine needs to start a
- * local or networked game.
- */
-
-#ifndef MODEL_GAMESETUP_H_
-#define MODEL_GAMESETUP_H_
-
-#include "scheme.h"
-#include "weapon.h"
-#include "map.h"
-#include "teamlist.h"
-
-typedef struct {
- char *style; //!< e.g. "Capture the Flag"
- flib_scheme *gamescheme;
- flib_map *map;
- flib_teamlist *teamlist;
-} flib_gamesetup;
-
-void flib_gamesetup_destroy(flib_gamesetup *gamesetup);
-
-/**
- * Deep-copy of the flib_gamesetup.
- */
-flib_gamesetup *flib_gamesetup_copy(const flib_gamesetup *gamesetup);
-
-#endif
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ */
+
+/**
+ * A complete game configuration that contains all settings the engine needs to start a
+ * local or networked game.
+ */
+
+#ifndef MODEL_GAMESETUP_H_
+#define MODEL_GAMESETUP_H_
+
+#include "scheme.h"
+#include "weapon.h"
+#include "map.h"
+#include "teamlist.h"
+
+typedef struct {
+ char *style; //!< e.g. "Capture the Flag"
+ flib_scheme *gamescheme;
+ flib_map *map;
+ flib_teamlist *teamlist;
+} flib_gamesetup;
+
+void flib_gamesetup_destroy(flib_gamesetup *gamesetup);
+
+/**
+ * Deep-copy of the flib_gamesetup.
+ */
+flib_gamesetup *flib_gamesetup_copy(const flib_gamesetup *gamesetup);
+
+#endif
--- a/project_files/frontlib/model/map.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/model/map.h Sun Jan 27 00:28:57 2013 +0100
@@ -1,114 +1,114 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- */
-
-#ifndef MODEL_MAP_H_
-#define MODEL_MAP_H_
-
-#include <stddef.h>
-#include <stdint.h>
-#include <stdbool.h>
-
-#define MAPGEN_REGULAR 0
-#define MAPGEN_MAZE 1
-#define MAPGEN_DRAWN 2
-#define MAPGEN_NAMED 3
-
-#define TEMPLATEFILTER_ALL 0
-#define TEMPLATEFILTER_SMALL 1
-#define TEMPLATEFILTER_MEDIUM 2
-#define TEMPLATEFILTER_LARGE 3
-#define TEMPLATEFILTER_CAVERN 4
-#define TEMPLATEFILTER_WACKY 5
-
-#define MAZE_SIZE_SMALL_TUNNELS 0
-#define MAZE_SIZE_MEDIUM_TUNNELS 1
-#define MAZE_SIZE_LARGE_TUNNELS 2
-#define MAZE_SIZE_SMALL_ISLANDS 3
-#define MAZE_SIZE_MEDIUM_ISLANDS 4
-#define MAZE_SIZE_LARGE_ISLANDS 5
-
-/**
- * Data structure for defining a map. This contains the whole recipe to
- * exactly recreate a particular map.
- *
- * The required fields depend on the map generator, see the comments
- * at the struct for details.
- */
-typedef struct {
- int mapgen; //!< Always one of the MAPGEN_ constants
- char *name; //!< The name of the map for MAPGEN_NAMED (e.g. "Cogs"), otherwise one of "+rnd+", "+maze+" or "+drawn+".
- char *seed; //!< Used for all maps. This is a random seed for all (non-AI) entropy in the round. Typically a random UUID, but can be any string.
- char *theme; //!< Used for all maps. This is the name of a directory in Data/Themes (e.g. "Beach")
- uint8_t *drawData; //!< Used for MAPGEN_DRAWN
- size_t drawDataSize; //!< Used for MAPGEN_DRAWN
- int templateFilter; //!< Used for MAPGEN_REGULAR. One of the TEMPLATEFILTER_xxx constants.
- int mazeSize; //!< Used for MAPGEN_MAZE. One of the MAZE_SIZE_xxx constants.
-} flib_map;
-
-/**
- * Create a generated map. theme should be the name of a
- * directory in "Themes" and templateFilter should be one of the
- * TEMPLATEFILTER_* constants, but this is not checked before
- * passing it to the engine.
- *
- * Use flib_map_destroy to free the returned object.
- * No NULL parameters allowed, returns NULL on failure.
- */
-flib_map *flib_map_create_regular(const char *seed, const char *theme, int templateFilter);
-
-/**
- * Create a generated maze-type map. theme should be the name of a
- * directory in "Themes" and mazeSize should be one of the
- * MAZE_SIZE_* constants, but this is not checked before
- * passing it to the engine.
- *
- * Use flib_map_destroy to free the returned object.
- * No NULL parameters allowed, returns NULL on failure.
- */
-flib_map *flib_map_create_maze(const char *seed, const char *theme, int mazeSize);
-
-/**
- * Create a map from the Maps-Directory. name should be the name of a
- * directory in "Maps", but this is not checked before
- * passing it to the engine. If this is a mission, the corresponding
- * script is used automatically.
- *
- * Use flib_map_destroy to free the returned object.
- * No NULL parameters allowed, returns NULL on failure.
- */
-flib_map *flib_map_create_named(const char *seed, const char *name);
-
-/**
- * Create a hand-drawn map. Use flib_map_destroy to free the returned object.
- * No NULL parameters allowed, returns NULL on failure.
- */
-flib_map *flib_map_create_drawn(const char *seed, const char *theme, const uint8_t *drawData, size_t drawDataSize);
-
-/**
- * Create a deep copy of the map. Returns NULL on failure or if NULL was passed.
- */
-flib_map *flib_map_copy(const flib_map *map);
-
-/**
- * Decrease the reference count of the object and free it if this was the last reference.
- */
-void flib_map_destroy(flib_map *map);
-
-
-#endif
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ */
+
+#ifndef MODEL_MAP_H_
+#define MODEL_MAP_H_
+
+#include <stddef.h>
+#include <stdint.h>
+#include <stdbool.h>
+
+#define MAPGEN_REGULAR 0
+#define MAPGEN_MAZE 1
+#define MAPGEN_DRAWN 2
+#define MAPGEN_NAMED 3
+
+#define TEMPLATEFILTER_ALL 0
+#define TEMPLATEFILTER_SMALL 1
+#define TEMPLATEFILTER_MEDIUM 2
+#define TEMPLATEFILTER_LARGE 3
+#define TEMPLATEFILTER_CAVERN 4
+#define TEMPLATEFILTER_WACKY 5
+
+#define MAZE_SIZE_SMALL_TUNNELS 0
+#define MAZE_SIZE_MEDIUM_TUNNELS 1
+#define MAZE_SIZE_LARGE_TUNNELS 2
+#define MAZE_SIZE_SMALL_ISLANDS 3
+#define MAZE_SIZE_MEDIUM_ISLANDS 4
+#define MAZE_SIZE_LARGE_ISLANDS 5
+
+/**
+ * Data structure for defining a map. This contains the whole recipe to
+ * exactly recreate a particular map.
+ *
+ * The required fields depend on the map generator, see the comments
+ * at the struct for details.
+ */
+typedef struct {
+ int mapgen; //!< Always one of the MAPGEN_ constants
+ char *name; //!< The name of the map for MAPGEN_NAMED (e.g. "Cogs"), otherwise one of "+rnd+", "+maze+" or "+drawn+".
+ char *seed; //!< Used for all maps. This is a random seed for all (non-AI) entropy in the round. Typically a random UUID, but can be any string.
+ char *theme; //!< Used for all maps. This is the name of a directory in Data/Themes (e.g. "Beach")
+ uint8_t *drawData; //!< Used for MAPGEN_DRAWN
+ size_t drawDataSize; //!< Used for MAPGEN_DRAWN
+ int templateFilter; //!< Used for MAPGEN_REGULAR. One of the TEMPLATEFILTER_xxx constants.
+ int mazeSize; //!< Used for MAPGEN_MAZE. One of the MAZE_SIZE_xxx constants.
+} flib_map;
+
+/**
+ * Create a generated map. theme should be the name of a
+ * directory in "Themes" and templateFilter should be one of the
+ * TEMPLATEFILTER_* constants, but this is not checked before
+ * passing it to the engine.
+ *
+ * Use flib_map_destroy to free the returned object.
+ * No NULL parameters allowed, returns NULL on failure.
+ */
+flib_map *flib_map_create_regular(const char *seed, const char *theme, int templateFilter);
+
+/**
+ * Create a generated maze-type map. theme should be the name of a
+ * directory in "Themes" and mazeSize should be one of the
+ * MAZE_SIZE_* constants, but this is not checked before
+ * passing it to the engine.
+ *
+ * Use flib_map_destroy to free the returned object.
+ * No NULL parameters allowed, returns NULL on failure.
+ */
+flib_map *flib_map_create_maze(const char *seed, const char *theme, int mazeSize);
+
+/**
+ * Create a map from the Maps-Directory. name should be the name of a
+ * directory in "Maps", but this is not checked before
+ * passing it to the engine. If this is a mission, the corresponding
+ * script is used automatically.
+ *
+ * Use flib_map_destroy to free the returned object.
+ * No NULL parameters allowed, returns NULL on failure.
+ */
+flib_map *flib_map_create_named(const char *seed, const char *name);
+
+/**
+ * Create a hand-drawn map. Use flib_map_destroy to free the returned object.
+ * No NULL parameters allowed, returns NULL on failure.
+ */
+flib_map *flib_map_create_drawn(const char *seed, const char *theme, const uint8_t *drawData, size_t drawDataSize);
+
+/**
+ * Create a deep copy of the map. Returns NULL on failure or if NULL was passed.
+ */
+flib_map *flib_map_copy(const flib_map *map);
+
+/**
+ * Decrease the reference count of the object and free it if this was the last reference.
+ */
+void flib_map_destroy(flib_map *map);
+
+
+#endif
--- a/project_files/frontlib/model/mapcfg.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/model/mapcfg.h Sun Jan 27 00:28:57 2013 +0100
@@ -1,38 +1,38 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- */
-
-/*!
- * Data structure and functions for accessing the map.cfg of named maps.
- */
-
-#ifndef MAPCFG_H_
-#define MAPCFG_H_
-
-typedef struct {
- char theme[256];
- int hogLimit;
-} flib_mapcfg;
-
-/**
- * Read the map configuration for the map with this name.
- * The dataDirPath must end in a path separator.
- */
-int flib_mapcfg_read(const char *dataDirPath, const char *mapname, flib_mapcfg *out);
-
-#endif /* MAPCFG_H_ */
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ */
+
+/*!
+ * Data structure and functions for accessing the map.cfg of named maps.
+ */
+
+#ifndef MAPCFG_H_
+#define MAPCFG_H_
+
+typedef struct {
+ char theme[256];
+ int hogLimit;
+} flib_mapcfg;
+
+/**
+ * Read the map configuration for the map with this name.
+ * The dataDirPath must end in a path separator.
+ */
+int flib_mapcfg_read(const char *dataDirPath, const char *mapname, flib_mapcfg *out);
+
+#endif /* MAPCFG_H_ */
--- a/project_files/frontlib/model/room.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/model/room.h Sun Jan 27 00:28:57 2013 +0100
@@ -1,42 +1,42 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- */
-
-/**
- * Models the room information for the lobby roomlist.
- */
-
-#ifndef ROOM_H_
-#define ROOM_H_
-
-#include <stdbool.h>
-
-typedef struct {
- bool inProgress; //!< true if the game is running
- char *name;
- int playerCount;
- int teamCount;
- char *owner;
- char *map; //!< This is either a map name, or one of +rnd+, +maze+ or +drawn+.
- char *scheme;
- char *weapons;
-} flib_room;
-
-void flib_room_destroy();
-
-#endif
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ */
+
+/**
+ * Models the room information for the lobby roomlist.
+ */
+
+#ifndef ROOM_H_
+#define ROOM_H_
+
+#include <stdbool.h>
+
+typedef struct {
+ bool inProgress; //!< true if the game is running
+ char *name;
+ int playerCount;
+ int teamCount;
+ char *owner;
+ char *map; //!< This is either a map name, or one of +rnd+, +maze+ or +drawn+.
+ char *scheme;
+ char *weapons;
+} flib_room;
+
+void flib_room_destroy();
+
+#endif
--- a/project_files/frontlib/model/team.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/model/team.h Sun Jan 27 00:28:57 2013 +0100
@@ -1,130 +1,130 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- */
-
-/**
- * This file defines a data structure for a hedgewars team.
- *
- * Teams are used in several different contexts in Hedgewars, and some of these require
- * extra information about teams. For example, the weaponset is important
- * to the engine, but not for ini reading/writing, and with the team statistics it is the
- * other way around. To keep things simple, the data structure can hold all information
- * used in any context. On the downside, that means we can't use static typing to ensure
- * that team information is "complete" for a particular purpose.
- */
-#ifndef TEAM_H_
-#define TEAM_H_
-
-
-#include "weapon.h"
-#include "../hwconsts.h"
-
-#include <stdbool.h>
-#include <stdint.h>
-
-#define TEAM_DEFAULT_HEALTH 100
-
-/**
- * Struct representing a single keybinding.
- */
-typedef struct {
- char *action;
- char *binding;
-} flib_binding;
-
-typedef struct {
- char *name;
- char *hat; //!< e.g. hair_yellow; References a .png file in Data/Graphics/Hats
-
- //! Statistics. They are irrelevant for the engine or server,
- //! but provided for ini reading/writing by the frontend.
- int rounds;
- int kills;
- int deaths;
- int suicides;
-
- int difficulty; //!< 0 = human, 1 = most difficult bot ... 5 = least difficult bot (somewhat counterintuitive)
-
- //! Transient setting used in game setup
- int initialHealth;
- flib_weaponset *weaponset;
-} flib_hog;
-
-typedef struct {
- flib_hog hogs[HEDGEHOGS_PER_TEAM];
- char *name;
- char *grave; //!< e.g. "Bone"; References a .png file in Data/Graphics/Graves
- char *fort; //!< e.g. "Castle"; References a series of files in Data/Forts
- char *voicepack; //!< e.g. "Classic"; References a directory in Data/Sounds/voices
- char *flag; //!< e.g. "hedgewars"; References a .png file in Data/Graphics/Flags
-
- flib_binding *bindings;
- int bindingCount;
-
- //! Statistics. They are irrelevant for the engine or server,
- //! but provided for ini reading/writing by the frontend.
- int rounds;
- int wins;
- int campaignProgress;
-
- //! Transient settings used in game setup
- int colorIndex; //!< Index into a color table
- int hogsInGame; //!< The number of hogs that will actually play
- bool remoteDriven; //!< true for non-local teams in a network game
- char *ownerName; //!< Username of the owner of a team in a network game
-} flib_team;
-
-/**
- * Free all memory associated with the team
- */
-void flib_team_destroy(flib_team *team);
-
-/**
- * Loads a team, returns NULL on error. Destroy this team using flib_team_destroy.
- * This will not fill in the fields marked as "transient" in the structs above.
- */
-flib_team *flib_team_from_ini(const char *filename);
-
-/**
- * Write the team to an ini file. Attempts to retain extra ini settings
- * that were already present. Note that not all fields of a team struct
- * are stored in the ini, some are only used intermittently to store
- * information about a team in the context of a game.
- *
- * The flib_team can handle "difficulty" on a per-hog basis, but it
- * is only written per-team in the team file. The difficulty of the
- * first hog is used for the entire team when writing.
- */
-int flib_team_to_ini(const char *filename, const flib_team *team);
-
-/**
- * Set the same weaponset for every hog in the team
- */
-int flib_team_set_weaponset(flib_team *team, const flib_weaponset *set);
-
-/**
- * Set the same initial health for every hog.
- */
-void flib_team_set_health(flib_team *team, int health);
-
-/**
- * Create a deep copy of a team. Returns NULL on failure.
- */
-flib_team *flib_team_copy(const flib_team *team);
-
-#endif /* TEAM_H_ */
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ */
+
+/**
+ * This file defines a data structure for a hedgewars team.
+ *
+ * Teams are used in several different contexts in Hedgewars, and some of these require
+ * extra information about teams. For example, the weaponset is important
+ * to the engine, but not for ini reading/writing, and with the team statistics it is the
+ * other way around. To keep things simple, the data structure can hold all information
+ * used in any context. On the downside, that means we can't use static typing to ensure
+ * that team information is "complete" for a particular purpose.
+ */
+#ifndef TEAM_H_
+#define TEAM_H_
+
+
+#include "weapon.h"
+#include "../hwconsts.h"
+
+#include <stdbool.h>
+#include <stdint.h>
+
+#define TEAM_DEFAULT_HEALTH 100
+
+/**
+ * Struct representing a single keybinding.
+ */
+typedef struct {
+ char *action;
+ char *binding;
+} flib_binding;
+
+typedef struct {
+ char *name;
+ char *hat; //!< e.g. hair_yellow; References a .png file in Data/Graphics/Hats
+
+ //! Statistics. They are irrelevant for the engine or server,
+ //! but provided for ini reading/writing by the frontend.
+ int rounds;
+ int kills;
+ int deaths;
+ int suicides;
+
+ int difficulty; //!< 0 = human, 1 = most difficult bot ... 5 = least difficult bot (somewhat counterintuitive)
+
+ //! Transient setting used in game setup
+ int initialHealth;
+ flib_weaponset *weaponset;
+} flib_hog;
+
+typedef struct {
+ flib_hog hogs[HEDGEHOGS_PER_TEAM];
+ char *name;
+ char *grave; //!< e.g. "Bone"; References a .png file in Data/Graphics/Graves
+ char *fort; //!< e.g. "Castle"; References a series of files in Data/Forts
+ char *voicepack; //!< e.g. "Classic"; References a directory in Data/Sounds/voices
+ char *flag; //!< e.g. "hedgewars"; References a .png file in Data/Graphics/Flags
+
+ flib_binding *bindings;
+ int bindingCount;
+
+ //! Statistics. They are irrelevant for the engine or server,
+ //! but provided for ini reading/writing by the frontend.
+ int rounds;
+ int wins;
+ int campaignProgress;
+
+ //! Transient settings used in game setup
+ int colorIndex; //!< Index into a color table
+ int hogsInGame; //!< The number of hogs that will actually play
+ bool remoteDriven; //!< true for non-local teams in a network game
+ char *ownerName; //!< Username of the owner of a team in a network game
+} flib_team;
+
+/**
+ * Free all memory associated with the team
+ */
+void flib_team_destroy(flib_team *team);
+
+/**
+ * Loads a team, returns NULL on error. Destroy this team using flib_team_destroy.
+ * This will not fill in the fields marked as "transient" in the structs above.
+ */
+flib_team *flib_team_from_ini(const char *filename);
+
+/**
+ * Write the team to an ini file. Attempts to retain extra ini settings
+ * that were already present. Note that not all fields of a team struct
+ * are stored in the ini, some are only used intermittently to store
+ * information about a team in the context of a game.
+ *
+ * The flib_team can handle "difficulty" on a per-hog basis, but it
+ * is only written per-team in the team file. The difficulty of the
+ * first hog is used for the entire team when writing.
+ */
+int flib_team_to_ini(const char *filename, const flib_team *team);
+
+/**
+ * Set the same weaponset for every hog in the team
+ */
+int flib_team_set_weaponset(flib_team *team, const flib_weaponset *set);
+
+/**
+ * Set the same initial health for every hog.
+ */
+void flib_team_set_health(flib_team *team, int health);
+
+/**
+ * Create a deep copy of a team. Returns NULL on failure.
+ */
+flib_team *flib_team_copy(const flib_team *team);
+
+#endif /* TEAM_H_ */
--- a/project_files/frontlib/net/netconn.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/net/netconn.h Sun Jan 27 00:28:57 2013 +0100
@@ -1,654 +1,654 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- */
-
-/**
- * This file contains functions for communicating with a Hedgewars server to chat, prepare and play
- * rounds of Hedgewars.
- *
- * To use this, first create a netconn object by calling flib_netconn_create. This will start the
- * connection to the game server (which might fail right away, the function returns null then). You
- * should also register your callback functions right at the start to ensure you don't miss any
- * callbacks.
- *
- * In order to allow the netconn to run, you should regularly call flib_netconn_tick(), which
- * performs network I/O and calls your callbacks on interesting events.
- *
- * When the connection is closed, you will receive the onDisconnect callback. This is the signal to
- * destroy the netconn and stop calling tick().
- *
- * The connection process lasts from the time you create the netconn until you receive the
- * onConnected callback (or onDisconnected in case something goes wrong). During that time, you
- * might receive the onNickTaken and onPasswordRequest callbacks; see their description for more
- * information on how to handle them. You could also receive other callbacks during connecting (e.g.
- * about the room list), but it should be safe to ignore them.
- *
- * Once you are connected, you are in the lobby, and you can enter rooms and leave them again. The
- * room and lobby states have different protocols, so many commands only work in either one or the
- * other. If you are in a room you might also be in a game, but most of the functions behave the
- * same ingame as in a room.
- *
- * The state changes from lobby to room when the server tells you that you just entered one, which
- * will also trigger the onEnterRoom callback. This usually happens in reply to either a joinRoom,
- * createRoom or playerFollow command.
- *
- * The state changes back to lobby when the room is dissolved, when you are kicked from the room, or
- * when you actively leave the room using flib_netconn_send_leaveRoom. The first two events will
- * trigger the onLeaveRoom callback.
- */
-
-#ifndef NETCONN_H_
-#define NETCONN_H_
-
-#include "../model/gamesetup.h"
-#include "../model/scheme.h"
-#include "../model/room.h"
-
-#include <stddef.h>
-#include <stdint.h>
-#include <stdbool.h>
-
-#define NETCONN_STATE_CONNECTING 0
-#define NETCONN_STATE_LOBBY 1
-#define NETCONN_STATE_ROOM 2
-#define NETCONN_STATE_DISCONNECTED 10
-
-#define NETCONN_DISCONNECT_NORMAL 0 //!< The connection was closed normally
-#define NETCONN_DISCONNECT_SERVER_TOO_OLD 1 //!< The server has a lower protocol version than we do
-#define NETCONN_DISCONNECT_AUTH_FAILED 2 //!< You sent a password with flib_netconn_send_password that was not accepted
-#define NETCONN_DISCONNECT_CONNLOST 3 //!< The network connection was lost
-#define NETCONN_DISCONNECT_INTERNAL_ERROR 100 //!< Something went wrong in frontlib itself
-
-#define NETCONN_ROOMLEAVE_ABANDONED 0 //!< The room was closed because the chief left
-#define NETCONN_ROOMLEAVE_KICKED 1 //!< You have been kicked from the room
-
-#define NETCONN_MSG_TYPE_PLAYERINFO 0 //!< A response to flib_netconn_send_playerInfo
-#define NETCONN_MSG_TYPE_SERVERMESSAGE 1 //!< The welcome message when connecting to the lobby
-#define NETCONN_MSG_TYPE_WARNING 2 //!< A general warning message
-#define NETCONN_MSG_TYPE_ERROR 3 //!< A general error message
-
-#define NETCONN_MAPCHANGE_FULL 0
-#define NETCONN_MAPCHANGE_MAP 1
-#define NETCONN_MAPCHANGE_MAPGEN 2
-#define NETCONN_MAPCHANGE_DRAWNMAP 3
-#define NETCONN_MAPCHANGE_MAZE_SIZE 4
-#define NETCONN_MAPCHANGE_TEMPLATE 5
-#define NETCONN_MAPCHANGE_THEME 6
-#define NETCONN_MAPCHANGE_SEED 7
-
-typedef struct _flib_netconn flib_netconn;
-
-/**
- * Create a new netplay connection with these parameters.
- * The path to the data directory must end with a path delimiter (e.g. C:\Games\Hedgewars\Data\)
- */
-flib_netconn *flib_netconn_create(const char *playerName, const char *dataDirPath, const char *host, int port);
-void flib_netconn_destroy(flib_netconn *conn);
-
-/**
- * Perform I/O operations and call callbacks if something interesting happens.
- * Should be called regularly.
- */
-void flib_netconn_tick(flib_netconn *conn);
-
-/**
- * Are you currently the owner of this room? The return value only makes sense in
- * NETCONN_STATE_ROOM and NETCONN_STATE_INGAME states.
- */
-bool flib_netconn_is_chief(flib_netconn *conn);
-
-/**
- * Returns the playername. This is *probably* the one provided on creation, but if that name was
- * already taken, a different one could have been set by the onNickTaken callback or its default
- * implementation.
- */
-const char *flib_netconn_get_playername(flib_netconn *conn);
-
-/**
- * Generate a game setup from the current room state.
- * Returns NULL if the room state does not contain enough information for a complete game setup,
- * or if an error occurs.
- *
- * The new gamesetup must be destroyed with flib_gamesetup_destroy().
- */
-flib_gamesetup *flib_netconn_create_gamesetup(flib_netconn *conn);
-
-
-
-
-// Send functions needed when connecting and disconnecting
-
- /**
- * Request a different nickname.
- * This function only makes sense in reaction to an onNickTaken callback, because the netconn
- * automatically requests the nickname you provide on creation, and once the server accepts the
- * nickname it can no longer be changed.
- */
- int flib_netconn_send_nick(flib_netconn *conn, const char *nick);
-
- /**
- * Send the password in reply to a password request.
- * If the server does not accept the password, you will be disconnected
- * (NETCONN_DISCONNECT_AUTH_FAILED)
- */
- int flib_netconn_send_password(flib_netconn *conn, const char *passwd);
-
- /**
- * Tell the server that you want to leave. If successful, the server will disconnect you.
- */
- int flib_netconn_send_quit(flib_netconn *conn, const char *quitmsg);
-
-
-// Send functions that make sense both in the lobby and in rooms
-
- /**
- * Send a chat message. This message is either sent to the lobby or the room, depending on
- * whether you are in a room at the moment. The message is not echoed back to you.
- */
- int flib_netconn_send_chat(flib_netconn *conn, const char *chat);
-
- /**
- * Kick a player. This has different meanings in the lobby and in a room;
- * In the lobby, it will kick the player from the server, and you need to be a server admin to
- * do it. In a room, it will kick the player from the room, and you need to be room chief.
- */
- int flib_netconn_send_kick(flib_netconn *conn, const char *playerName);
-
- /**
- * Request information about a player (e.g. current room, version, partial IP). If the action
- * succeeds, you will receive an onMessage callback with NETCONN_MSG_TYPE_PLAYERINFO containing
- * the requested information.
- */
- int flib_netconn_send_playerInfo(flib_netconn *conn, const char *playerName);
-
-
-// Send functions that only make sense in the lobby
-
- /**
- * Request an update of the room list. Only makes sense when in lobby state.
- * If the action succeeds, you will receive an onRoomlist callback containing the current room
- * data.
- */
- int flib_netconn_send_request_roomlist(flib_netconn *conn);
-
- /**
- * Join a room as guest (not chief). Only makes sense when in lobby state. If the action
- * succeeds, you will receive an onEnterRoom callback with chief=false followed by other
- * callbacks with current room information.
- */
- int flib_netconn_send_joinRoom(flib_netconn *conn, const char *room);
-
- /**
- * Follow a player. Only valid in the lobby. If the player is in a room (or in a game), this
- * command is analogous to calling flib_netconn_send_joinRoom with that room.
- */
- int flib_netconn_send_playerFollow(flib_netconn *conn, const char *playerName);
-
- /**
- * Create and join a new room. Only makes sense when in lobby state. If the action succeeds,
- * you will receive an onEnterRoom callback with chief=true.
- */
- int flib_netconn_send_createRoom(flib_netconn *conn, const char *room);
-
- /**
- * Ban a player. The scope of this ban depends on whether you are in a room or in the lobby.
- * In a room, you need to be the room chief, and the ban will apply to the room only. In the
- * lobby, you need to be server admin to ban someone, and the ban applies to the entire server.
- */
- int flib_netconn_send_ban(flib_netconn *conn, const char *playerName);
-
- /**
- * Does something administrator-y. At any rate you need to be an administrator and in the lobby
- * to use this command.
- */
- int flib_netconn_send_clearAccountsCache(flib_netconn *conn);
-
- /**
- * Sets a server variable to the indicated value. Only makes sense if you are server admin and
- * in the lobby. Known variables are MOTD_NEW, MOTD_OLD and LATEST_PROTO. MOTD_OLD is shown to
- * players with older protocol versions, to inform them that they might want to update.
- */
- int flib_netconn_send_setServerVar(flib_netconn *conn, const char *name, const char *value);
-
- /**
- * Queries all server variables. Only makes sense if you are server admin and in the lobby.
- * If the action succeeds, you will receive several onServerVar callbacks with the
- * current values of all server variables.
- */
- int flib_netconn_send_getServerVars(flib_netconn *conn);
-
-
-// Send functions that only make sense in a room
-
- /**
- * Leave the room for the lobby. Only makes sense in room state. msg can be NULL if you don't
- * want to send a message. The server always accepts a part command, so once you send it off,
- * you can just assume that you are back in the lobby.
- */
- int flib_netconn_send_leaveRoom(flib_netconn *conn, const char *msg);
-
- /**
- * Change your "ready" status in the room. Only makes sense when in room state. If the action
- * succeeds, you will receive an onClientFlags callback containing the change.
- */
- int flib_netconn_send_toggleReady(flib_netconn *conn);
-
- /**
- * Add a team to the current room. Apart from the "fixed" team information, this also includes
- * the color, but not the number of hogs. Only makes sense when in room state. If the action
- * succeeds, you will receive an onTeamAccepted callback with the name of the team.
- *
- * Notes: Technically, sending a color here is the only way for a non-chief to set the color of
- * her own team. The server remembers this color and even generates a separate teamColor message
- * to inform everyone of it. However, at the moment the frontends generally override this color
- * with one they choose themselves in order to deal with unfortunate behavior of the QtFrontend,
- * which always sends color index 0 when adding a team but thinks that the team has a random
- * color. The chief always sends a new color in order to bring the QtFrontend back into sync.
- */
- int flib_netconn_send_addTeam(flib_netconn *conn, const flib_team *team);
-
- /**
- * Remove the team with the name teamname. Only makes sense when in room state.
- * The server does not send a reply on success.
- */
- int flib_netconn_send_removeTeam(flib_netconn *conn, const char *teamname);
-
-
-// Send functions that only make sense in a room and if you are room chief
-
- /**
- * Rename the current room. Only makes sense in room state and if you are chief. If the action
- * succeeds, you (and everyone else on the server) will receive an onRoomUpdate message
- * containing the change.
- */
- int flib_netconn_send_renameRoom(flib_netconn *conn, const char *roomName);
-
- /**
- * Set the number of hogs for a team. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_teamHogCount(flib_netconn *conn, const char *teamname, int hogcount);
-
- /**
- * Set the teamcolor of a team. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_teamColor(flib_netconn *conn, const char *teamname, int colorIndex);
-
- /**
- * Set the weaponset for the room. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_weaponset(flib_netconn *conn, const flib_weaponset *weaponset);
-
- /**
- * Set the map for the room. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_map(flib_netconn *conn, const flib_map *map);
-
- /**
- * Set the mapname. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_mapName(flib_netconn *conn, const char *mapName);
-
- /**
- * Set the map generator (regular, maze, drawn, named). Only makes sense in room state and if
- * you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_mapGen(flib_netconn *conn, int mapGen);
-
- /**
- * Set the map template for regular maps. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_mapTemplate(flib_netconn *conn, int templateFilter);
-
- /**
- * Set the maze template (maze size) for mazes. Only makes sense in room state and if you are
- * chief. The server does not send a reply.
- */
- int flib_netconn_send_mapMazeSize(flib_netconn *conn, int mazeSize);
-
- /**
- * Set the seed for the map. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_mapSeed(flib_netconn *conn, const char *seed);
-
- /**
- * Set the theme for the map. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_mapTheme(flib_netconn *conn, const char *theme);
-
- /**
- * Set the draw data for the drawn map. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_mapDrawdata(flib_netconn *conn, const uint8_t *drawData, size_t size);
-
- /**
- * Set the script (game style). Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_script(flib_netconn *conn, const char *scriptName);
-
- /**
- * Set the scheme. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_scheme(flib_netconn *conn, const flib_scheme *scheme);
-
- /**
- * Signal that you want to start the game. Only makes sense in room state and if you are chief.
- * The server will check whether all players are ready and whether it believes the setup makes
- * sense (e.g. more than one clan). If the server is satisfied, you will receive an onRunGame
- * callback (all other clients in the room are notified the same way). Otherwise the server
- * might answer with a warning, or might not answer at all.
- */
- int flib_netconn_send_startGame(flib_netconn *conn);
-
- /**
- * Allow/forbid players to join the room. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_toggleRestrictJoins(flib_netconn *conn);
-
- /**
- * Allow/forbid adding teams to the room. Only makes sense in room state and if you are chief.
- * The server does not send a reply.
- */
- int flib_netconn_send_toggleRestrictTeams(flib_netconn *conn);
-
-
-// Send functions that are only needed for running a game
-
- /**
- * Send a teamchat message, forwarded from the engine. Only makes sense ingame.
- * The server does not send a reply. In contrast to a Chat message, the server
- * automatically converts this into an engine message and passes it on to the other
- * clients.
- */
- int flib_netconn_send_teamchat(flib_netconn *conn, const char *msg);
-
- /**
- * Send an engine message. Only makes sense when ingame. In a networked game, you have to pass
- * all the engine messages from the engine here, and they will be spread to all other clients
- * in the game to keep the game in sync.
- */
- int flib_netconn_send_engineMessage(flib_netconn *conn, const uint8_t *message, size_t size);
-
- /**
- * Inform the server that the round has ended. Call this when the engine has disconnected,
- * passing 1 if the round ended normally, 0 otherwise.
- */
- int flib_netconn_send_roundfinished(flib_netconn *conn, bool withoutError);
-
-
-
-
-
-// Callbacks that are important for connecting/disconnecting
-
- /**
- * onNickTaken is called when connecting to the server, if it turns out that there is already a
- * player with the same nick.
- * In order to proceed, a new nickname needs to be sent to the server using
- * flib_netconn_send_nick() (or of course you can bail out and send a QUIT).
- * If you don't set a callback, the netconn will automatically react by generating a new name.
- */
- void flib_netconn_onNickTaken(flib_netconn *conn, void (*callback)(void *context, const char *nick), void* context);
-
- /**
- * When connecting with a registered nickname, the server will ask for a password before
- * admitting you in. This callback is called when that happens. As a reaction, you can send the
- * password using flib_netconn_send_password. If you don't register a callback, the default
- * behavior is to just quit in a way that will cause a disconnect with
- * NETCONN_DISCONNECT_AUTH_FAILED.
- *
- * You can't just choose a new nickname when you receive this callback, because at that point
- * the server has already accepted your nick.
- */
- void flib_netconn_onPasswordRequest(flib_netconn *conn, void (*callback)(void *context, const char *nick), void* context);
-
- /**
- * This is called when the server has accepted our nickname (and possibly password) and we have
- * entered the lobby.
- */
- void flib_netconn_onConnected(flib_netconn *conn, void (*callback)(void *context), void* context);
-
- /**
- * This is always the last callback (unless the netconn is destroyed early), and the netconn
- * should be destroyed when it is received. The reason for the disconnect is passed as one of
- * the NETCONN_DISCONNECT_ constants. Sometimes a message is included as well, but that
- * parameter might also be NULL.
- */
- void flib_netconn_onDisconnected(flib_netconn *conn, void (*callback)(void *context, int reason, const char *message), void* context);
-
-
-// Callbacks that make sense in most situations
-
- /**
- * Callback for several informational messages that should be displayed to the user
- * (e.g. in the chat window), but do not require a reaction. If a game is running, you might
- * want to redirect some of these messages to the engine as well so the user will see them.
- */
- void flib_netconn_onMessage(flib_netconn *conn, void (*callback)(void *context, int msgtype, const char *msg), void* context);
-
- /**
- * We received a chat message. Where this message belongs depends on the current state
- * (lobby/room). If a game is running the message should be passed to the engine.
- */
- void flib_netconn_onChat(flib_netconn *conn, void (*callback)(void *context, const char *nick, const char *msg), void* context);
-
- /**
- * Callbacks for incremental room list updates. They will fire whenever these events occur,
- * even before you first query the actual roomlist - so be sure not to blindly reference your
- * room list in these callbacks. The server currently only sends updates when a room changes
- * its name, so in order to update other room information you need to query the roomlist again
- * (see send_request_roomlist / onRoomlist).
- */
- void flib_netconn_onRoomAdd(flib_netconn *conn, void (*callback)(void *context, const flib_room *room), void* context);
- void flib_netconn_onRoomDelete(flib_netconn *conn, void (*callback)(void *context, const char *name), void* context);
- void flib_netconn_onRoomUpdate(flib_netconn *conn, void (*callback)(void *context, const char *oldName, const flib_room *room), void* context);
-
- /**
- * Callbacks for players joining or leaving the lobby. In contrast to the roomlist updates, you
- * will get a JOIN callback for every player already on the server when you join (and there is
- * no direct way to query the current playerlist)
- *
- * NOTE: partMessage may be NULL.
- */
- void flib_netconn_onLobbyJoin(flib_netconn *conn, void (*callback)(void *context, const char *nick), void* context);
- void flib_netconn_onLobbyLeave(flib_netconn *conn, void (*callback)(void *context, const char *nick, const char *partMessage), void* context);
-
- /**
- * This is called when the server informs us that one or more flags associated with a
- * player/client have changed.
- *
- * nick is the name of the player, flags is a string containing one character for each modified
- * flag (see below), and newFlagState signals whether the flags should be set to true or false.
- *
- * Some of these flags are important for protocol purposes (especially if they are set for you)
- * while others are just informational. Also, some flags are only relevant for players who are
- * in the same room as you, and the server will not inform you if they change for others.
- *
- * These are the currently known/used flags:
- * a: Server admin. Always updated.
- * h: Room chief. Updated when in the same room.
- * r: Ready to play. Updated when in the same room.
- * u: Registered user. Always updated.
- *
- * The server tells us the 'a' and 'u' flags for all players when we first join the lobby, and
- * also tells us the 'r' and 'h' flags when we join or create a room. It assumes that all flags
- * are initially false, so it will typically only tell you to set certain flags to true when
- * transmitting the initial states. Reset the 'h' and 'r' flags to false when leaving a room,
- * or when entering room state, to arrive at the right state for each player.
- *
- * The room chief state of yourself is particularly important because it determines whether you
- * can modify settings of the current room. Generally, when you create a room you start out
- * being room chief, and when you join an existing room you are not. However, if the original
- * chief leaves a room, the server can choose a new chief, and if that happens the chief flag
- * will be transferred to someone else.
- */
- void flib_netconn_onClientFlags(flib_netconn *conn, void (*callback)(void *context, const char *nick, const char *flags, bool newFlagState), void *context);
-
-// Callbacks that happen only in response to specific requests
-
- /**
- * Response to flib_netconn_send_request_roomlist().
- * The rooms array contains the current state of all rooms on the server.
- */
- void flib_netconn_onRoomlist(flib_netconn *conn, void (*callback)(void *context, const flib_room **rooms, int roomCount), void* context);
-
- /**
- * Response to flib_netconn_send_joinRoom, flib_netconn_send_playerFollow or
- * flib_netconn_send_createRoom.
- *
- * You just left the lobby and entered a room.
- * If chief is true, you can and should send a full configuration for the room now. This
- * consists of ammo, scheme, script and map, where map apparently has to come last.
- */
- void flib_netconn_onEnterRoom(flib_netconn *conn, void (*callback)(void *context, bool chief), void *context);
-
- /**
- * Response to flib_netconn_send_addTeam.
- * The server might reject your team for several reasons, e.g. because it has the same name as
- * an existing team, or because the room chief restricted adding new teams. If the team is
- * accepted by the server, this callback is fired.
- *
- * If you are the room chief, you are expected to provide the hog count for your own team now
- * using flib_netconn_send_teamHogCount. The color of the team is already set to the one you
- * provided in addTeam.
- */
- void flib_netconn_onTeamAccepted(flib_netconn *conn, void (*callback)(void *context, const char *team), void *context);
-
- /**
- * When you query the server vars with flib_netconn_send_getServerVars (only works as admin),
- * the server replies with a list of them. This callback is called for each entry in that list.
- */
- void flib_netconn_onServerVar(flib_netconn *conn, void (*callback)(void *context, const char *name, const char *value), void *context);
-
-
-// Callbacks that are only relevant in a room
-
- /**
- * You just left a room and entered the lobby again.
- * reason is one of the NETCONN_ROOMLEAVE_ constants (usually a kick).
- * This will not be called when you actively leave a room using PART.
- * Don't confuse with onRoomLeave, which indicates that *someone else* left the room.
- */
- void flib_netconn_onLeaveRoom(flib_netconn *conn, void (*callback)(void *context, int reason, const char *message), void *context);
-
- /**
- * Someone joined or left the room you are currently in.
- * Analogous to onLobbyJoin/leave, you will receive the join callback for all players that are
- * already in the room when you join, including for yourself (this is actually how it is
- * determined that you joined a room).
- *
- * However, you will *not* receive onRoomLeave messages for everyone when you leave the room.
- */
- void flib_netconn_onRoomJoin(flib_netconn *conn, void (*callback)(void *context, const char *nick), void* context);
- void flib_netconn_onRoomLeave(flib_netconn *conn, void (*callback)(void *context, const char *nick, const char *partMessage), void* context);
-
- /**
- * A new team was added to the room. The person who adds a team does NOT receive this callback
- * (he gets onTeamAccepted instead).
- *
- * The team does not contain bindings, stats, weaponset, color or the number of hogs (but it is
- * assumed to be the default of 4).
- *
- * If you receive this message and you are the room chief, you may want to send a color and hog
- * count for this team using flib_netconn_send_teamHogCount / teamColor for QtFrontend
- * compatibility.
- *
- * The server currently sends another message with the color of the team to the same recipients
- * as this teamAdd message, which will trigger an onTeamColorChanged callback. See the
- * description of flib_netconn_send_addTeam for more information.
- */
- void flib_netconn_onTeamAdd(flib_netconn *conn, void (*callback)(void *context, const flib_team *team), void *context);
-
- /**
- * A team was removed from the room. The person who removed the team will not receive this
- * callback.
- */
- void flib_netconn_onTeamDelete(flib_netconn *conn, void (*callback)(void *context, const char *teamname), void *context);
-
- /**
- * The number of hogs in a team has been changed by the room chief. If you are the chief and
- * change the number of hogs yourself, you will not receive this callback.
- */
- void flib_netconn_onHogCountChanged(flib_netconn *conn, void (*callback)(void *context, const char *teamName, int hogs), void *context);
-
- /**
- * The color of a team has been set or changed. The client who set or changed the color will
- * not receive this callback.
- *
- * Normally, only the chief can change the color of a team. However, this message is also
- * generated when a team is added, so you can receive it even as chief.
- */
- void flib_netconn_onTeamColorChanged(flib_netconn *conn, void (*callback)(void *context, const char *teamName, int colorIndex), void *context);
-
- /**
- * The room chief has changed the game scheme (or you just joined a room).
- * You will not receive this callback if you changed the scheme yourself.
- */
- void flib_netconn_onSchemeChanged(flib_netconn *conn, void (*callback)(void *context, const flib_scheme *scheme), void *context);
-
- /**
- * The room chief has changed the map (or you just joined a room). Only non-chiefs receive these
- * messages.
- *
- * To reduce the number of callback functions, the netconn keeps track of the current map
- * settings and always passes the entire current map config, but informs the callee about what
- * has changed (see the NETCONN_MAPCHANGE_ constants).
- *
- * Caution: Due to the way the protocol works, the map might not be complete at this point if it
- * is a hand-drawn map, because the "full" map config does not include the drawn map data.
- */
- void flib_netconn_onMapChanged(flib_netconn *conn, void (*callback)(void *context, const flib_map *map, int changetype), void *context);
-
- /**
- * The room chief has changed the game style (or you just joined a room). If you are the chief
- * and change the style yourself, you will not receive this callback.
- */
- void flib_netconn_onScriptChanged(flib_netconn *conn, void (*callback)(void *context, const char *script), void *context);
-
- /**
- * The room chief has changed the weaponset (or you just joined a room). If you are the chief
- * and change the weaponset yourself, you will not receive this callback.
- */
- void flib_netconn_onWeaponsetChanged(flib_netconn *conn, void (*callback)(void *context, const flib_weaponset *weaponset), void *context);
-
- /**
- * The game is starting. Fire up the engine and join in!
- * You can let the netconn generate the right game setup using flib_netconn_create_gamesetup
- */
- void flib_netconn_onRunGame(flib_netconn *conn, void (*callback)(void *context), void *context);
-
- /**
- * You are in a room, a game is in progress, and the server is sending you the new input for the
- * engine to keep up to date with the current happenings. Pass it on to the engine using
- * flib_gameconn_send_enginemsg.
- */
- void flib_netconn_onEngineMessage(flib_netconn *conn, void (*callback)(void *context, const uint8_t *message, size_t size), void *context);
-
-#endif
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ */
+
+/**
+ * This file contains functions for communicating with a Hedgewars server to chat, prepare and play
+ * rounds of Hedgewars.
+ *
+ * To use this, first create a netconn object by calling flib_netconn_create. This will start the
+ * connection to the game server (which might fail right away, the function returns null then). You
+ * should also register your callback functions right at the start to ensure you don't miss any
+ * callbacks.
+ *
+ * In order to allow the netconn to run, you should regularly call flib_netconn_tick(), which
+ * performs network I/O and calls your callbacks on interesting events.
+ *
+ * When the connection is closed, you will receive the onDisconnect callback. This is the signal to
+ * destroy the netconn and stop calling tick().
+ *
+ * The connection process lasts from the time you create the netconn until you receive the
+ * onConnected callback (or onDisconnected in case something goes wrong). During that time, you
+ * might receive the onNickTaken and onPasswordRequest callbacks; see their description for more
+ * information on how to handle them. You could also receive other callbacks during connecting (e.g.
+ * about the room list), but it should be safe to ignore them.
+ *
+ * Once you are connected, you are in the lobby, and you can enter rooms and leave them again. The
+ * room and lobby states have different protocols, so many commands only work in either one or the
+ * other. If you are in a room you might also be in a game, but most of the functions behave the
+ * same ingame as in a room.
+ *
+ * The state changes from lobby to room when the server tells you that you just entered one, which
+ * will also trigger the onEnterRoom callback. This usually happens in reply to either a joinRoom,
+ * createRoom or playerFollow command.
+ *
+ * The state changes back to lobby when the room is dissolved, when you are kicked from the room, or
+ * when you actively leave the room using flib_netconn_send_leaveRoom. The first two events will
+ * trigger the onLeaveRoom callback.
+ */
+
+#ifndef NETCONN_H_
+#define NETCONN_H_
+
+#include "../model/gamesetup.h"
+#include "../model/scheme.h"
+#include "../model/room.h"
+
+#include <stddef.h>
+#include <stdint.h>
+#include <stdbool.h>
+
+#define NETCONN_STATE_CONNECTING 0
+#define NETCONN_STATE_LOBBY 1
+#define NETCONN_STATE_ROOM 2
+#define NETCONN_STATE_DISCONNECTED 10
+
+#define NETCONN_DISCONNECT_NORMAL 0 //!< The connection was closed normally
+#define NETCONN_DISCONNECT_SERVER_TOO_OLD 1 //!< The server has a lower protocol version than we do
+#define NETCONN_DISCONNECT_AUTH_FAILED 2 //!< You sent a password with flib_netconn_send_password that was not accepted
+#define NETCONN_DISCONNECT_CONNLOST 3 //!< The network connection was lost
+#define NETCONN_DISCONNECT_INTERNAL_ERROR 100 //!< Something went wrong in frontlib itself
+
+#define NETCONN_ROOMLEAVE_ABANDONED 0 //!< The room was closed because the chief left
+#define NETCONN_ROOMLEAVE_KICKED 1 //!< You have been kicked from the room
+
+#define NETCONN_MSG_TYPE_PLAYERINFO 0 //!< A response to flib_netconn_send_playerInfo
+#define NETCONN_MSG_TYPE_SERVERMESSAGE 1 //!< The welcome message when connecting to the lobby
+#define NETCONN_MSG_TYPE_WARNING 2 //!< A general warning message
+#define NETCONN_MSG_TYPE_ERROR 3 //!< A general error message
+
+#define NETCONN_MAPCHANGE_FULL 0
+#define NETCONN_MAPCHANGE_MAP 1
+#define NETCONN_MAPCHANGE_MAPGEN 2
+#define NETCONN_MAPCHANGE_DRAWNMAP 3
+#define NETCONN_MAPCHANGE_MAZE_SIZE 4
+#define NETCONN_MAPCHANGE_TEMPLATE 5
+#define NETCONN_MAPCHANGE_THEME 6
+#define NETCONN_MAPCHANGE_SEED 7
+
+typedef struct _flib_netconn flib_netconn;
+
+/**
+ * Create a new netplay connection with these parameters.
+ * The path to the data directory must end with a path delimiter (e.g. C:\Games\Hedgewars\Data\)
+ */
+flib_netconn *flib_netconn_create(const char *playerName, const char *dataDirPath, const char *host, int port);
+void flib_netconn_destroy(flib_netconn *conn);
+
+/**
+ * Perform I/O operations and call callbacks if something interesting happens.
+ * Should be called regularly.
+ */
+void flib_netconn_tick(flib_netconn *conn);
+
+/**
+ * Are you currently the owner of this room? The return value only makes sense in
+ * NETCONN_STATE_ROOM and NETCONN_STATE_INGAME states.
+ */
+bool flib_netconn_is_chief(flib_netconn *conn);
+
+/**
+ * Returns the playername. This is *probably* the one provided on creation, but if that name was
+ * already taken, a different one could have been set by the onNickTaken callback or its default
+ * implementation.
+ */
+const char *flib_netconn_get_playername(flib_netconn *conn);
+
+/**
+ * Generate a game setup from the current room state.
+ * Returns NULL if the room state does not contain enough information for a complete game setup,
+ * or if an error occurs.
+ *
+ * The new gamesetup must be destroyed with flib_gamesetup_destroy().
+ */
+flib_gamesetup *flib_netconn_create_gamesetup(flib_netconn *conn);
+
+
+
+
+// Send functions needed when connecting and disconnecting
+
+ /**
+ * Request a different nickname.
+ * This function only makes sense in reaction to an onNickTaken callback, because the netconn
+ * automatically requests the nickname you provide on creation, and once the server accepts the
+ * nickname it can no longer be changed.
+ */
+ int flib_netconn_send_nick(flib_netconn *conn, const char *nick);
+
+ /**
+ * Send the password in reply to a password request.
+ * If the server does not accept the password, you will be disconnected
+ * (NETCONN_DISCONNECT_AUTH_FAILED)
+ */
+ int flib_netconn_send_password(flib_netconn *conn, const char *passwd);
+
+ /**
+ * Tell the server that you want to leave. If successful, the server will disconnect you.
+ */
+ int flib_netconn_send_quit(flib_netconn *conn, const char *quitmsg);
+
+
+// Send functions that make sense both in the lobby and in rooms
+
+ /**
+ * Send a chat message. This message is either sent to the lobby or the room, depending on
+ * whether you are in a room at the moment. The message is not echoed back to you.
+ */
+ int flib_netconn_send_chat(flib_netconn *conn, const char *chat);
+
+ /**
+ * Kick a player. This has different meanings in the lobby and in a room;
+ * In the lobby, it will kick the player from the server, and you need to be a server admin to
+ * do it. In a room, it will kick the player from the room, and you need to be room chief.
+ */
+ int flib_netconn_send_kick(flib_netconn *conn, const char *playerName);
+
+ /**
+ * Request information about a player (e.g. current room, version, partial IP). If the action
+ * succeeds, you will receive an onMessage callback with NETCONN_MSG_TYPE_PLAYERINFO containing
+ * the requested information.
+ */
+ int flib_netconn_send_playerInfo(flib_netconn *conn, const char *playerName);
+
+
+// Send functions that only make sense in the lobby
+
+ /**
+ * Request an update of the room list. Only makes sense when in lobby state.
+ * If the action succeeds, you will receive an onRoomlist callback containing the current room
+ * data.
+ */
+ int flib_netconn_send_request_roomlist(flib_netconn *conn);
+
+ /**
+ * Join a room as guest (not chief). Only makes sense when in lobby state. If the action
+ * succeeds, you will receive an onEnterRoom callback with chief=false followed by other
+ * callbacks with current room information.
+ */
+ int flib_netconn_send_joinRoom(flib_netconn *conn, const char *room);
+
+ /**
+ * Follow a player. Only valid in the lobby. If the player is in a room (or in a game), this
+ * command is analogous to calling flib_netconn_send_joinRoom with that room.
+ */
+ int flib_netconn_send_playerFollow(flib_netconn *conn, const char *playerName);
+
+ /**
+ * Create and join a new room. Only makes sense when in lobby state. If the action succeeds,
+ * you will receive an onEnterRoom callback with chief=true.
+ */
+ int flib_netconn_send_createRoom(flib_netconn *conn, const char *room);
+
+ /**
+ * Ban a player. The scope of this ban depends on whether you are in a room or in the lobby.
+ * In a room, you need to be the room chief, and the ban will apply to the room only. In the
+ * lobby, you need to be server admin to ban someone, and the ban applies to the entire server.
+ */
+ int flib_netconn_send_ban(flib_netconn *conn, const char *playerName);
+
+ /**
+ * Does something administrator-y. At any rate you need to be an administrator and in the lobby
+ * to use this command.
+ */
+ int flib_netconn_send_clearAccountsCache(flib_netconn *conn);
+
+ /**
+ * Sets a server variable to the indicated value. Only makes sense if you are server admin and
+ * in the lobby. Known variables are MOTD_NEW, MOTD_OLD and LATEST_PROTO. MOTD_OLD is shown to
+ * players with older protocol versions, to inform them that they might want to update.
+ */
+ int flib_netconn_send_setServerVar(flib_netconn *conn, const char *name, const char *value);
+
+ /**
+ * Queries all server variables. Only makes sense if you are server admin and in the lobby.
+ * If the action succeeds, you will receive several onServerVar callbacks with the
+ * current values of all server variables.
+ */
+ int flib_netconn_send_getServerVars(flib_netconn *conn);
+
+
+// Send functions that only make sense in a room
+
+ /**
+ * Leave the room for the lobby. Only makes sense in room state. msg can be NULL if you don't
+ * want to send a message. The server always accepts a part command, so once you send it off,
+ * you can just assume that you are back in the lobby.
+ */
+ int flib_netconn_send_leaveRoom(flib_netconn *conn, const char *msg);
+
+ /**
+ * Change your "ready" status in the room. Only makes sense when in room state. If the action
+ * succeeds, you will receive an onClientFlags callback containing the change.
+ */
+ int flib_netconn_send_toggleReady(flib_netconn *conn);
+
+ /**
+ * Add a team to the current room. Apart from the "fixed" team information, this also includes
+ * the color, but not the number of hogs. Only makes sense when in room state. If the action
+ * succeeds, you will receive an onTeamAccepted callback with the name of the team.
+ *
+ * Notes: Technically, sending a color here is the only way for a non-chief to set the color of
+ * her own team. The server remembers this color and even generates a separate teamColor message
+ * to inform everyone of it. However, at the moment the frontends generally override this color
+ * with one they choose themselves in order to deal with unfortunate behavior of the QtFrontend,
+ * which always sends color index 0 when adding a team but thinks that the team has a random
+ * color. The chief always sends a new color in order to bring the QtFrontend back into sync.
+ */
+ int flib_netconn_send_addTeam(flib_netconn *conn, const flib_team *team);
+
+ /**
+ * Remove the team with the name teamname. Only makes sense when in room state.
+ * The server does not send a reply on success.
+ */
+ int flib_netconn_send_removeTeam(flib_netconn *conn, const char *teamname);
+
+
+// Send functions that only make sense in a room and if you are room chief
+
+ /**
+ * Rename the current room. Only makes sense in room state and if you are chief. If the action
+ * succeeds, you (and everyone else on the server) will receive an onRoomUpdate message
+ * containing the change.
+ */
+ int flib_netconn_send_renameRoom(flib_netconn *conn, const char *roomName);
+
+ /**
+ * Set the number of hogs for a team. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_teamHogCount(flib_netconn *conn, const char *teamname, int hogcount);
+
+ /**
+ * Set the teamcolor of a team. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_teamColor(flib_netconn *conn, const char *teamname, int colorIndex);
+
+ /**
+ * Set the weaponset for the room. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_weaponset(flib_netconn *conn, const flib_weaponset *weaponset);
+
+ /**
+ * Set the map for the room. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_map(flib_netconn *conn, const flib_map *map);
+
+ /**
+ * Set the mapname. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_mapName(flib_netconn *conn, const char *mapName);
+
+ /**
+ * Set the map generator (regular, maze, drawn, named). Only makes sense in room state and if
+ * you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_mapGen(flib_netconn *conn, int mapGen);
+
+ /**
+ * Set the map template for regular maps. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_mapTemplate(flib_netconn *conn, int templateFilter);
+
+ /**
+ * Set the maze template (maze size) for mazes. Only makes sense in room state and if you are
+ * chief. The server does not send a reply.
+ */
+ int flib_netconn_send_mapMazeSize(flib_netconn *conn, int mazeSize);
+
+ /**
+ * Set the seed for the map. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_mapSeed(flib_netconn *conn, const char *seed);
+
+ /**
+ * Set the theme for the map. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_mapTheme(flib_netconn *conn, const char *theme);
+
+ /**
+ * Set the draw data for the drawn map. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_mapDrawdata(flib_netconn *conn, const uint8_t *drawData, size_t size);
+
+ /**
+ * Set the script (game style). Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_script(flib_netconn *conn, const char *scriptName);
+
+ /**
+ * Set the scheme. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_scheme(flib_netconn *conn, const flib_scheme *scheme);
+
+ /**
+ * Signal that you want to start the game. Only makes sense in room state and if you are chief.
+ * The server will check whether all players are ready and whether it believes the setup makes
+ * sense (e.g. more than one clan). If the server is satisfied, you will receive an onRunGame
+ * callback (all other clients in the room are notified the same way). Otherwise the server
+ * might answer with a warning, or might not answer at all.
+ */
+ int flib_netconn_send_startGame(flib_netconn *conn);
+
+ /**
+ * Allow/forbid players to join the room. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_toggleRestrictJoins(flib_netconn *conn);
+
+ /**
+ * Allow/forbid adding teams to the room. Only makes sense in room state and if you are chief.
+ * The server does not send a reply.
+ */
+ int flib_netconn_send_toggleRestrictTeams(flib_netconn *conn);
+
+
+// Send functions that are only needed for running a game
+
+ /**
+ * Send a teamchat message, forwarded from the engine. Only makes sense ingame.
+ * The server does not send a reply. In contrast to a Chat message, the server
+ * automatically converts this into an engine message and passes it on to the other
+ * clients.
+ */
+ int flib_netconn_send_teamchat(flib_netconn *conn, const char *msg);
+
+ /**
+ * Send an engine message. Only makes sense when ingame. In a networked game, you have to pass
+ * all the engine messages from the engine here, and they will be spread to all other clients
+ * in the game to keep the game in sync.
+ */
+ int flib_netconn_send_engineMessage(flib_netconn *conn, const uint8_t *message, size_t size);
+
+ /**
+ * Inform the server that the round has ended. Call this when the engine has disconnected,
+ * passing 1 if the round ended normally, 0 otherwise.
+ */
+ int flib_netconn_send_roundfinished(flib_netconn *conn, bool withoutError);
+
+
+
+
+
+// Callbacks that are important for connecting/disconnecting
+
+ /**
+ * onNickTaken is called when connecting to the server, if it turns out that there is already a
+ * player with the same nick.
+ * In order to proceed, a new nickname needs to be sent to the server using
+ * flib_netconn_send_nick() (or of course you can bail out and send a QUIT).
+ * If you don't set a callback, the netconn will automatically react by generating a new name.
+ */
+ void flib_netconn_onNickTaken(flib_netconn *conn, void (*callback)(void *context, const char *nick), void* context);
+
+ /**
+ * When connecting with a registered nickname, the server will ask for a password before
+ * admitting you in. This callback is called when that happens. As a reaction, you can send the
+ * password using flib_netconn_send_password. If you don't register a callback, the default
+ * behavior is to just quit in a way that will cause a disconnect with
+ * NETCONN_DISCONNECT_AUTH_FAILED.
+ *
+ * You can't just choose a new nickname when you receive this callback, because at that point
+ * the server has already accepted your nick.
+ */
+ void flib_netconn_onPasswordRequest(flib_netconn *conn, void (*callback)(void *context, const char *nick), void* context);
+
+ /**
+ * This is called when the server has accepted our nickname (and possibly password) and we have
+ * entered the lobby.
+ */
+ void flib_netconn_onConnected(flib_netconn *conn, void (*callback)(void *context), void* context);
+
+ /**
+ * This is always the last callback (unless the netconn is destroyed early), and the netconn
+ * should be destroyed when it is received. The reason for the disconnect is passed as one of
+ * the NETCONN_DISCONNECT_ constants. Sometimes a message is included as well, but that
+ * parameter might also be NULL.
+ */
+ void flib_netconn_onDisconnected(flib_netconn *conn, void (*callback)(void *context, int reason, const char *message), void* context);
+
+
+// Callbacks that make sense in most situations
+
+ /**
+ * Callback for several informational messages that should be displayed to the user
+ * (e.g. in the chat window), but do not require a reaction. If a game is running, you might
+ * want to redirect some of these messages to the engine as well so the user will see them.
+ */
+ void flib_netconn_onMessage(flib_netconn *conn, void (*callback)(void *context, int msgtype, const char *msg), void* context);
+
+ /**
+ * We received a chat message. Where this message belongs depends on the current state
+ * (lobby/room). If a game is running the message should be passed to the engine.
+ */
+ void flib_netconn_onChat(flib_netconn *conn, void (*callback)(void *context, const char *nick, const char *msg), void* context);
+
+ /**
+ * Callbacks for incremental room list updates. They will fire whenever these events occur,
+ * even before you first query the actual roomlist - so be sure not to blindly reference your
+ * room list in these callbacks. The server currently only sends updates when a room changes
+ * its name, so in order to update other room information you need to query the roomlist again
+ * (see send_request_roomlist / onRoomlist).
+ */
+ void flib_netconn_onRoomAdd(flib_netconn *conn, void (*callback)(void *context, const flib_room *room), void* context);
+ void flib_netconn_onRoomDelete(flib_netconn *conn, void (*callback)(void *context, const char *name), void* context);
+ void flib_netconn_onRoomUpdate(flib_netconn *conn, void (*callback)(void *context, const char *oldName, const flib_room *room), void* context);
+
+ /**
+ * Callbacks for players joining or leaving the lobby. In contrast to the roomlist updates, you
+ * will get a JOIN callback for every player already on the server when you join (and there is
+ * no direct way to query the current playerlist)
+ *
+ * NOTE: partMessage may be NULL.
+ */
+ void flib_netconn_onLobbyJoin(flib_netconn *conn, void (*callback)(void *context, const char *nick), void* context);
+ void flib_netconn_onLobbyLeave(flib_netconn *conn, void (*callback)(void *context, const char *nick, const char *partMessage), void* context);
+
+ /**
+ * This is called when the server informs us that one or more flags associated with a
+ * player/client have changed.
+ *
+ * nick is the name of the player, flags is a string containing one character for each modified
+ * flag (see below), and newFlagState signals whether the flags should be set to true or false.
+ *
+ * Some of these flags are important for protocol purposes (especially if they are set for you)
+ * while others are just informational. Also, some flags are only relevant for players who are
+ * in the same room as you, and the server will not inform you if they change for others.
+ *
+ * These are the currently known/used flags:
+ * a: Server admin. Always updated.
+ * h: Room chief. Updated when in the same room.
+ * r: Ready to play. Updated when in the same room.
+ * u: Registered user. Always updated.
+ *
+ * The server tells us the 'a' and 'u' flags for all players when we first join the lobby, and
+ * also tells us the 'r' and 'h' flags when we join or create a room. It assumes that all flags
+ * are initially false, so it will typically only tell you to set certain flags to true when
+ * transmitting the initial states. Reset the 'h' and 'r' flags to false when leaving a room,
+ * or when entering room state, to arrive at the right state for each player.
+ *
+ * The room chief state of yourself is particularly important because it determines whether you
+ * can modify settings of the current room. Generally, when you create a room you start out
+ * being room chief, and when you join an existing room you are not. However, if the original
+ * chief leaves a room, the server can choose a new chief, and if that happens the chief flag
+ * will be transferred to someone else.
+ */
+ void flib_netconn_onClientFlags(flib_netconn *conn, void (*callback)(void *context, const char *nick, const char *flags, bool newFlagState), void *context);
+
+// Callbacks that happen only in response to specific requests
+
+ /**
+ * Response to flib_netconn_send_request_roomlist().
+ * The rooms array contains the current state of all rooms on the server.
+ */
+ void flib_netconn_onRoomlist(flib_netconn *conn, void (*callback)(void *context, const flib_room **rooms, int roomCount), void* context);
+
+ /**
+ * Response to flib_netconn_send_joinRoom, flib_netconn_send_playerFollow or
+ * flib_netconn_send_createRoom.
+ *
+ * You just left the lobby and entered a room.
+ * If chief is true, you can and should send a full configuration for the room now. This
+ * consists of ammo, scheme, script and map, where map apparently has to come last.
+ */
+ void flib_netconn_onEnterRoom(flib_netconn *conn, void (*callback)(void *context, bool chief), void *context);
+
+ /**
+ * Response to flib_netconn_send_addTeam.
+ * The server might reject your team for several reasons, e.g. because it has the same name as
+ * an existing team, or because the room chief restricted adding new teams. If the team is
+ * accepted by the server, this callback is fired.
+ *
+ * If you are the room chief, you are expected to provide the hog count for your own team now
+ * using flib_netconn_send_teamHogCount. The color of the team is already set to the one you
+ * provided in addTeam.
+ */
+ void flib_netconn_onTeamAccepted(flib_netconn *conn, void (*callback)(void *context, const char *team), void *context);
+
+ /**
+ * When you query the server vars with flib_netconn_send_getServerVars (only works as admin),
+ * the server replies with a list of them. This callback is called for each entry in that list.
+ */
+ void flib_netconn_onServerVar(flib_netconn *conn, void (*callback)(void *context, const char *name, const char *value), void *context);
+
+
+// Callbacks that are only relevant in a room
+
+ /**
+ * You just left a room and entered the lobby again.
+ * reason is one of the NETCONN_ROOMLEAVE_ constants (usually a kick).
+ * This will not be called when you actively leave a room using PART.
+ * Don't confuse with onRoomLeave, which indicates that *someone else* left the room.
+ */
+ void flib_netconn_onLeaveRoom(flib_netconn *conn, void (*callback)(void *context, int reason, const char *message), void *context);
+
+ /**
+ * Someone joined or left the room you are currently in.
+ * Analogous to onLobbyJoin/leave, you will receive the join callback for all players that are
+ * already in the room when you join, including for yourself (this is actually how it is
+ * determined that you joined a room).
+ *
+ * However, you will *not* receive onRoomLeave messages for everyone when you leave the room.
+ */
+ void flib_netconn_onRoomJoin(flib_netconn *conn, void (*callback)(void *context, const char *nick), void* context);
+ void flib_netconn_onRoomLeave(flib_netconn *conn, void (*callback)(void *context, const char *nick, const char *partMessage), void* context);
+
+ /**
+ * A new team was added to the room. The person who adds a team does NOT receive this callback
+ * (he gets onTeamAccepted instead).
+ *
+ * The team does not contain bindings, stats, weaponset, color or the number of hogs (but it is
+ * assumed to be the default of 4).
+ *
+ * If you receive this message and you are the room chief, you may want to send a color and hog
+ * count for this team using flib_netconn_send_teamHogCount / teamColor for QtFrontend
+ * compatibility.
+ *
+ * The server currently sends another message with the color of the team to the same recipients
+ * as this teamAdd message, which will trigger an onTeamColorChanged callback. See the
+ * description of flib_netconn_send_addTeam for more information.
+ */
+ void flib_netconn_onTeamAdd(flib_netconn *conn, void (*callback)(void *context, const flib_team *team), void *context);
+
+ /**
+ * A team was removed from the room. The person who removed the team will not receive this
+ * callback.
+ */
+ void flib_netconn_onTeamDelete(flib_netconn *conn, void (*callback)(void *context, const char *teamname), void *context);
+
+ /**
+ * The number of hogs in a team has been changed by the room chief. If you are the chief and
+ * change the number of hogs yourself, you will not receive this callback.
+ */
+ void flib_netconn_onHogCountChanged(flib_netconn *conn, void (*callback)(void *context, const char *teamName, int hogs), void *context);
+
+ /**
+ * The color of a team has been set or changed. The client who set or changed the color will
+ * not receive this callback.
+ *
+ * Normally, only the chief can change the color of a team. However, this message is also
+ * generated when a team is added, so you can receive it even as chief.
+ */
+ void flib_netconn_onTeamColorChanged(flib_netconn *conn, void (*callback)(void *context, const char *teamName, int colorIndex), void *context);
+
+ /**
+ * The room chief has changed the game scheme (or you just joined a room).
+ * You will not receive this callback if you changed the scheme yourself.
+ */
+ void flib_netconn_onSchemeChanged(flib_netconn *conn, void (*callback)(void *context, const flib_scheme *scheme), void *context);
+
+ /**
+ * The room chief has changed the map (or you just joined a room). Only non-chiefs receive these
+ * messages.
+ *
+ * To reduce the number of callback functions, the netconn keeps track of the current map
+ * settings and always passes the entire current map config, but informs the callee about what
+ * has changed (see the NETCONN_MAPCHANGE_ constants).
+ *
+ * Caution: Due to the way the protocol works, the map might not be complete at this point if it
+ * is a hand-drawn map, because the "full" map config does not include the drawn map data.
+ */
+ void flib_netconn_onMapChanged(flib_netconn *conn, void (*callback)(void *context, const flib_map *map, int changetype), void *context);
+
+ /**
+ * The room chief has changed the game style (or you just joined a room). If you are the chief
+ * and change the style yourself, you will not receive this callback.
+ */
+ void flib_netconn_onScriptChanged(flib_netconn *conn, void (*callback)(void *context, const char *script), void *context);
+
+ /**
+ * The room chief has changed the weaponset (or you just joined a room). If you are the chief
+ * and change the weaponset yourself, you will not receive this callback.
+ */
+ void flib_netconn_onWeaponsetChanged(flib_netconn *conn, void (*callback)(void *context, const flib_weaponset *weaponset), void *context);
+
+ /**
+ * The game is starting. Fire up the engine and join in!
+ * You can let the netconn generate the right game setup using flib_netconn_create_gamesetup
+ */
+ void flib_netconn_onRunGame(flib_netconn *conn, void (*callback)(void *context), void *context);
+
+ /**
+ * You are in a room, a game is in progress, and the server is sending you the new input for the
+ * engine to keep up to date with the current happenings. Pass it on to the engine using
+ * flib_gameconn_send_enginemsg.
+ */
+ void flib_netconn_onEngineMessage(flib_netconn *conn, void (*callback)(void *context, const uint8_t *message, size_t size), void *context);
+
+#endif
--- a/project_files/frontlib/net/netconn_internal.h Sun Jan 27 00:01:26 2013 +0100
+++ b/project_files/frontlib/net/netconn_internal.h Sun Jan 27 00:28:57 2013 +0100
@@ -1,151 +1,151 @@
-/*
- * Hedgewars, a free turn based strategy game
- * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- */
-
-/**
- * Common definitions needed by netconn functions, to allow splitting them into several files.
- */
-
-#ifndef NETCONN_INTERNAL_H_
-#define NETCONN_INTERNAL_H_
-
-#include "netconn.h"
-#include "netbase.h"
-#include "../model/map.h"
-#include "../model/team.h"
-#include "../model/weapon.h"
-#include "../model/room.h"
-
-#include <stdbool.h>
-#include <stdint.h>
-#include <stddef.h>
-
-struct _flib_netconn {
- flib_netbase *netBase;
- char *playerName;
- char *dataDirPath;
-
- int netconnState; //!< One of the NETCONN_STATE constants
-
- bool isChief; //!< Player can modify the current room
- flib_map *map;
- flib_teamlist pendingTeamlist;
- flib_teamlist teamlist;
- flib_scheme *scheme;
- char *style;
- flib_weaponset *weaponset;
-
- void (*onMessageCb)(void *context, int msgtype, const char *msg);
- void *onMessageCtx;
-
- void (*onConnectedCb)(void *context);
- void *onConnectedCtx;
-
- void (*onDisconnectedCb)(void *context, int reason, const char *message);
- void *onDisconnectedCtx;
-
- void (*onRoomlistCb)(void *context, const flib_room **rooms, int roomCount);
- void *onRoomlistCtx;
-
- void (*onRoomAddCb)(void *context, const flib_room *room);
- void *onRoomAddCtx;
-
- void (*onRoomDeleteCb)(void *context, const char *name);
- void *onRoomDeleteCtx;
-
- void (*onRoomUpdateCb)(void *context, const char *oldName, const flib_room *room);
- void *onRoomUpdateCtx;
-
- void (*onClientFlagsCb)(void *context, const char *nick, const char *flags, bool newFlagState);
- void *onClientFlagsCtx;
-
- void (*onChatCb)(void *context, const char *nick, const char *msg);
- void *onChatCtx;
-
- void (*onLobbyJoinCb)(void *context, const char *nick);
- void *onLobbyJoinCtx;
-
- void (*onLobbyLeaveCb)(void *context, const char *nick, const char *partMessage);
- void *onLobbyLeaveCtx;
-
- void (*onRoomJoinCb)(void *context, const char *nick);
- void *onRoomJoinCtx;
-
- void (*onRoomLeaveCb)(void *context, const char *nick, const char *partMessage);
- void *onRoomLeaveCtx;
-
- void (*onNickTakenCb)(void *context, const char *nick);
- void *onNickTakenCtx;
-
- void (*onPasswordRequestCb)(void *context, const char *nick);
- void *onPasswordRequestCtx;
-
- void (*onEnterRoomCb)(void *context, bool chief);
- void *onEnterRoomCtx;
-
- void (*onLeaveRoomCb)(void *context, int reason, const char *message);
- void *onLeaveRoomCtx;
-
- void (*onTeamAddCb)(void *context, const flib_team *team);
- void *onTeamAddCtx;
-
- void (*onTeamDeleteCb)(void *context, const char *teamname);
- void *onTeamDeleteCtx;
-
- void (*onRunGameCb)(void *context);
- void *onRunGameCtx;
-
- void (*onTeamAcceptedCb)(void *context, const char *teamName);
- void *onTeamAcceptedCtx;
-
- void (*onHogCountChangedCb)(void *context, const char *teamName, int hogs);
- void *onHogCountChangedCtx;
-
- void (*onTeamColorChangedCb)(void *context, const char *teamName, int colorIndex);
- void *onTeamColorChangedCtx;
-
- void (*onEngineMessageCb)(void *context, const uint8_t *message, size_t size);
- void *onEngineMessageCtx;
-
- void (*onSchemeChangedCb)(void *context, const flib_scheme *scheme);
- void *onSchemeChangedCtx;
-
- void (*onMapChangedCb)(void *context, const flib_map *map, int changetype);
- void *onMapChangedCtx;
-
- void (*onScriptChangedCb)(void *context, const char *script);
- void *onScriptChangedCtx;
-
- void (*onWeaponsetChangedCb)(void *context, const flib_weaponset *weaponset);
- void *onWeaponsetChangedCtx;
-
- void (*onServerVarCb)(void *context, const char *name, const char *value);
- void *onServerVarCtx;
-
- bool running;
- bool destroyRequested;
-};
-
-void netconn_clearCallbacks(flib_netconn *conn);
-void netconn_leaveRoom(flib_netconn *conn);
-void netconn_setMap(flib_netconn *conn, const flib_map *map);
-void netconn_setWeaponset(flib_netconn *conn, const flib_weaponset *weaponset);
-void netconn_setScript(flib_netconn *conn, const char *script);
-void netconn_setScheme(flib_netconn *conn, const flib_scheme *scheme);
-
-#endif
+/*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (C) 2012 Simeon Maxein <smaxein@googlemail.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ */
+
+/**
+ * Common definitions needed by netconn functions, to allow splitting them into several files.
+ */
+
+#ifndef NETCONN_INTERNAL_H_
+#define NETCONN_INTERNAL_H_
+
+#include "netconn.h"
+#include "netbase.h"
+#include "../model/map.h"
+#include "../model/team.h"
+#include "../model/weapon.h"
+#include "../model/room.h"
+
+#include <stdbool.h>
+#include <stdint.h>
+#include <stddef.h>
+
+struct _flib_netconn {
+ flib_netbase *netBase;
+ char *playerName;
+ char *dataDirPath;
+
+ int netconnState; //!< One of the NETCONN_STATE constants
+
+ bool isChief; //!< Player can modify the current room
+ flib_map *map;
+ flib_teamlist pendingTeamlist;
+ flib_teamlist teamlist;
+ flib_scheme *scheme;
+ char *style;
+ flib_weaponset *weaponset;
+
+ void (*onMessageCb)(void *context, int msgtype, const char *msg);
+ void *onMessageCtx;
+
+ void (*onConnectedCb)(void *context);
+ void *onConnectedCtx;
+
+ void (*onDisconnectedCb)(void *context, int reason, const char *message);
+ void *onDisconnectedCtx;
+
+ void (*onRoomlistCb)(void *context, const flib_room **rooms, int roomCount);
+ void *onRoomlistCtx;
+
+ void (*onRoomAddCb)(void *context, const flib_room *room);
+ void *onRoomAddCtx;
+
+ void (*onRoomDeleteCb)(void *context, const char *name);
+ void *onRoomDeleteCtx;
+
+ void (*onRoomUpdateCb)(void *context, const char *oldName, const flib_room *room);
+ void *onRoomUpdateCtx;
+
+ void (*onClientFlagsCb)(void *context, const char *nick, const char *flags, bool newFlagState);
+ void *onClientFlagsCtx;
+
+ void (*onChatCb)(void *context, const char *nick, const char *msg);
+ void *onChatCtx;
+
+ void (*onLobbyJoinCb)(void *context, const char *nick);
+ void *onLobbyJoinCtx;
+
+ void (*onLobbyLeaveCb)(void *context, const char *nick, const char *partMessage);
+ void *onLobbyLeaveCtx;
+
+ void (*onRoomJoinCb)(void *context, const char *nick);
+ void *onRoomJoinCtx;
+
+ void (*onRoomLeaveCb)(void *context, const char *nick, const char *partMessage);
+ void *onRoomLeaveCtx;
+
+ void (*onNickTakenCb)(void *context, const char *nick);
+ void *onNickTakenCtx;
+
+ void (*onPasswordRequestCb)(void *context, const char *nick);
+ void *onPasswordRequestCtx;
+
+ void (*onEnterRoomCb)(void *context, bool chief);
+ void *onEnterRoomCtx;
+
+ void (*onLeaveRoomCb)(void *context, int reason, const char *message);
+ void *onLeaveRoomCtx;
+
+ void (*onTeamAddCb)(void *context, const flib_team *team);
+ void *onTeamAddCtx;
+
+ void (*onTeamDeleteCb)(void *context, const char *teamname);
+ void *onTeamDeleteCtx;
+
+ void (*onRunGameCb)(void *context);
+ void *onRunGameCtx;
+
+ void (*onTeamAcceptedCb)(void *context, const char *teamName);
+ void *onTeamAcceptedCtx;
+
+ void (*onHogCountChangedCb)(void *context, const char *teamName, int hogs);
+ void *onHogCountChangedCtx;
+
+ void (*onTeamColorChangedCb)(void *context, const char *teamName, int colorIndex);
+ void *onTeamColorChangedCtx;
+
+ void (*onEngineMessageCb)(void *context, const uint8_t *message, size_t size);
+ void *onEngineMessageCtx;
+
+ void (*onSchemeChangedCb)(void *context, const flib_scheme *scheme);
+ void *onSchemeChangedCtx;
+
+ void (*onMapChangedCb)(void *context, const flib_map *map, int changetype);
+ void *onMapChangedCtx;
+
+ void (*onScriptChangedCb)(void *context, const char *script);
+ void *onScriptChangedCtx;
+
+ void (*onWeaponsetChangedCb)(void *context, const flib_weaponset *weaponset);
+ void *onWeaponsetChangedCtx;
+
+ void (*onServerVarCb)(void *context, const char *name, const char *value);
+ void *onServerVarCtx;
+
+ bool running;
+ bool destroyRequested;
+};
+
+void netconn_clearCallbacks(flib_netconn *conn);
+void netconn_leaveRoom(flib_netconn *conn);
+void netconn_setMap(flib_netconn *conn, const flib_map *map);
+void netconn_setWeaponset(flib_netconn *conn, const flib_weaponset *weaponset);
+void netconn_setScript(flib_netconn *conn, const char *script);
+void netconn_setScheme(flib_netconn *conn, const flib_scheme *scheme);
+
+#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,80 @@
+#the usual set of dependencies
+find_package(OpenGL REQUIRED)
+find_package(GLEW REQUIRED)
+find_package(SDL REQUIRED)
+find_package(SDL_mixer REQUIRED)
+find_package(SDL_net REQUIRED)
+find_package(SDL_image REQUIRED)
+find_package(SDL_ttf REQUIRED)
+
+#compile our rtl implementation
+add_subdirectory(rtl)
+include_directories("${GLEW_INCLUDE_PATH}")
+include_directories("${CMAKE_CURRENT_SOURCE_DIR}/rtl")
+
+configure_file(${CMAKE_SOURCE_DIR}/hedgewars/config.inc.in ${CMAKE_CURRENT_BINARY_DIR}/config.inc)
+
+#get the list of pas files that are going to be converted and compiled
+file(GLOB engine_sources_pas "${CMAKE_SOURCE_DIR}/hedgewars/*.pas")
+#TODO: temporary until cmake can configure itself accordingly
+list(REMOVE_ITEM engine_sources_pas "${CMAKE_SOURCE_DIR}/hedgewars/uWeb.pas")
+list(REMOVE_ITEM engine_sources_pas "${CMAKE_SOURCE_DIR}/hedgewars/uVideoRec.pas")
+list(REMOVE_ITEM engine_sources_pas "${CMAKE_SOURCE_DIR}/hedgewars/uTouch.pas")
+list(REMOVE_ITEM engine_sources_pas "${CMAKE_SOURCE_DIR}/hedgewars/PNGh.pas")
+list(REMOVE_ITEM engine_sources_pas "${CMAKE_SOURCE_DIR}/hedgewars/pas2cSystem.pas")
+list(REMOVE_ITEM engine_sources_pas "${CMAKE_SOURCE_DIR}/hedgewars/pas2cRedo.pas")
+list(REMOVE_ITEM engine_sources_pas "${CMAKE_SOURCE_DIR}/hedgewars/hwLibrary.pas")
+
+foreach(sourcefile ${engine_sources_pas})
+ get_filename_component(sourcename ${sourcefile} NAME_WE) #drops .pas
+ set(engine_sources "${CMAKE_CURRENT_BINARY_DIR}/${sourcename}.c" ${engine_sources})
+endforeach()
+
+#invoke pas2c on our pas files
+add_custom_command(OUTPUT ${engine_sources}
+ COMMAND "${EXECUTABLE_OUTPUT_PATH}/pas2c${CMAKE_EXECUTABLE_SUFFIX}"
+ ARGS -n "hwengine"
+ -i "${CMAKE_SOURCE_DIR}/hedgewars"
+ -o "${CMAKE_CURRENT_BINARY_DIR}"
+ -a "${CMAKE_CURRENT_BINARY_DIR}"
+ DEPENDS pas2c
+ )
+add_custom_target(engine_c DEPENDS ${engine_sources})
+
+
+#compile the c files
+add_executable(hwengine WIN32 ${engine_sources})
+
+target_link_libraries(hwengine fpcrtl
+ ${LUA_LIBRARY}
+ ${OPENGL_LIBRARY}
+ ${SDL_LIBRARY}
+ ${SDLMIXER_LIBRARY}
+ ${SDLNET_LIBRARY}
+ ${SDLIMAGE_LIBRARY}
+ ${SDLTTF_LIBRARY}
+ #TODO: add other libraries
+ )
+
+#TODO: move this away in its proper findxxx.cmake
+if(APPLE)
+ #let's look for the installed sdlmain file; if it is not found, let's build our own
+ find_package(SDL REQUIRED)
+ #remove the ";-framework Cocoa" from the SDL_LIBRARY variable
+ string(REGEX REPLACE "(.*);-.*" "\\1" sdl_dir "${SDL_LIBRARY}")
+ #find libsdmain.a
+ find_file(SDLMAIN_LIB libSDLMain.a PATHS ${sdl_dir}/Resources/)
+
+ if(SDLMAIN_LIB MATCHES "SDLMAIN_LIB-NOTFOUND")
+ include_directories(${SDL_INCLUDE_DIR})
+ add_library (SDLmain STATIC ${CMAKE_SOURCE_DIR}/hedgewars/sdlmain_osx/SDLMain.m)
+ #add a dependency to the hwengine target
+ set(SDLMAIN_LIB "${LIBRARY_OUTPUT_PATH}/libSDLmain.a")
+ endif()
+
+ target_link_libraries(hwengine ${SDLMAIN_LIB})
+endif(APPLE)
+
+
+install(PROGRAMS "${EXECUTABLE_OUTPUT_PATH}/hwengine${CMAKE_EXECUTABLE_SUFFIX}" DESTINATION ${target_binary_install_dir})
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,16 @@
+
+include_directories(${GLEW_INCLUDE_PATH})
+
+file(GLOB fpcrtl_src *.c)
+
+add_library(fpcrtl ${fpcrtl_src})
+
+#if(WEBGL)
+# set_target_properties(fpcrtl PROPERTIES PREFIX "em")
+# set_target_properties(fpcrtl PROPERTIES SUFFIX ".bc")
+#endif(WEBGL)
+
+
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/GL.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,8 @@
+#pragma once
+
+#ifdef __APPLE__
+#include <OpenGL/gl.h>
+#else
+#include "GL/gl.h"
+#endif
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/Math.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,4 @@
+#pragma once
+
+#include <math.h>
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/SysUtils.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,41 @@
+#ifndef _FPCRTL_SYSUTILS_H_
+#define _FPCRTL_SYSUTILS_H_
+
+#include "Types.h"
+
+// EFFECTS: return the current date time in pascal notation
+// http://www.merlyn.demon.co.uk/del-prgg.htm#TDT
+TDateTime fpcrtl_now();
+#define now fpcrtl_now
+#define Now fpcrtl_now
+
+// EFFECTS: return the current time
+// http://www.merlyn.demon.co.uk/del-prgg.htm#TDT
+TDateTime fpcrtl_time();
+
+
+// EFFECTS: return the current date
+// http://www.merlyn.demon.co.uk/del-prgg.htm#TDT
+TDateTime fpcrtl_date();
+#define date fpcrtl_date
+#define Date fpcrtl_date
+
+// EFFECTS: Trim strips blank characters (spaces) at the beginning and end of S
+// and returns the resulting string. Only #32 characters are stripped.
+// If the string contains only spaces, an empty string is returned.
+string255 fpcrtl_trim(string255 s);
+#define trim fpcrtl_trim
+#define Trim fpcrtl_trim
+
+Integer fpcrtl_strToInt(string255 s);
+#define StrToInt fpcrtl_strToInt
+#define strToInt fpcrtl_strToInt
+
+string255 fpcrtl_extractFileName(string255 f);
+#define fpcrtl_ExtractFileName fpcrtl_extractFileName
+
+string255 fpcrtl_strPas(PChar);
+#define fpcrtl_StrPas fpcrtl_strPas
+
+
+#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/Types.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,39 @@
+#ifndef _TYPES_H_
+#define _TYPES_H_
+
+#include "pas2c.h"
+
+/*
+ * Not very useful currently
+ */
+
+typedef double TDate;
+typedef double TTime;
+typedef double TDateTime;
+typedef string255 TMonthNameArray[13];
+typedef string255 TWeekNameArray[8];
+
+typedef struct {
+ Byte CurrencyFormat;
+ Byte NegCurrFormat;
+ Char ThousandSeparator;
+ Char DecimalSeparator;
+ Byte CurrencyDecimals;
+ Char DateSeparator;
+ Char TimeSeparator;
+ Char ListSeparator;
+ string255 CurrencyString;
+ string255 ShortDateFormat;
+ string255 LongDateFormat;
+ string255 TimeAMString;
+ string255 TimePMString;
+ string255 ShortTimeFormat;
+ string255 LongTimeFormat;
+ TMonthNameArray ShortMonthNames;
+ TMonthNameArray LongMonthNames;
+ TWeekNameArray ShortDayNames;
+ TWeekNameArray LongDayNames;
+ Word TwoDigitYearCenturyWindow;
+}TFormatSettings;
+
+#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/fileio.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,226 @@
+/*
+ * XXX: assume all files are text files
+ */
+
+#include "misc.h"
+#include "fileio.h"
+#include <string.h>
+#include <stdlib.h>
+#include <assert.h>
+#include <sys/stat.h>
+
+io_result_t IOResult;
+int FileMode;
+
+static void init(File f) {
+ f->fp = NULL;
+ f->eof = 0;
+ f->mode = NULL;
+ f->record_len = 0;
+}
+
+void fpcrtl_assign__vars(File *f, string255 name) {
+ FIX_STRING(name);
+ *f = (File) malloc(sizeof(file_wrapper_t));
+ strcpy((*f)->file_name, name.str);
+ init(*f);
+}
+
+void fpcrtl_reset1(File f) {
+ f->fp = fopen(f->file_name, "r");
+ if (!f->fp) {
+ IOResult = IO_ERROR_DUMMY;
+ printf("Failed to open %s\n", f->file_name);
+ return;
+ } else {
+#ifdef FPCRTL_DEBUG
+ printf("Opened %s\n", f->file_name);
+#endif
+ }
+ IOResult = IO_NO_ERROR;
+ f->mode = "r";
+}
+
+void fpcrtl_reset2(File f, int l) {
+ f->eof = 0;
+ f->fp = fopen(f->file_name, "rb");
+ if (!f->fp) {
+ IOResult = IO_ERROR_DUMMY;
+ printf("Failed to open %s\n", f->file_name);
+ return;
+ }
+ IOResult = IO_NO_ERROR;
+ f->mode = "rb";
+ f->record_len = l;
+}
+
+void __attribute__((overloadable)) fpcrtl_rewrite(File f) {
+ f->fp = fopen(f->file_name, "w+");
+ if (!f->fp) {
+ IOResult = IO_ERROR_DUMMY;
+ return;
+ }
+ IOResult = IO_NO_ERROR;
+ f->mode = "w+";
+}
+
+void __attribute__((overloadable)) fpcrtl_rewrite(File f, Integer l) {
+ IOResult = IO_NO_ERROR;
+ fpcrtl_rewrite(f);
+ if (f->fp) {
+ f->record_len = l;
+ }
+}
+
+void fpcrtl_close(File f) {
+ IOResult = IO_NO_ERROR;
+ fclose(f->fp);
+ free(f);
+}
+
+boolean fpcrtl_eof(File f) {
+ IOResult = IO_NO_ERROR;
+ if (f->eof || f->fp == NULL || feof(f->fp)) {
+ return true;
+ } else {
+ return false;
+ }
+}
+
+void __attribute__((overloadable)) fpcrtl_readLn(File f) {
+ IOResult = IO_NO_ERROR;
+ char line[256];
+ if (fgets(line, sizeof(line), f->fp) == NULL) {
+ f->eof = 1;
+ }
+ if (feof(f->fp)) {
+ f->eof = 1;
+ }
+}
+
+void __attribute__((overloadable)) fpcrtl_readLn__vars(File f, Integer *i) {
+ string255 s;
+
+ if (feof(f->fp)) {
+ f->eof = 1;
+ return;
+ }
+
+ fpcrtl_readLn__vars(f, &s);
+
+ *i = atoi(s.str);
+}
+
+void __attribute__((overloadable)) fpcrtl_readLn__vars(File f, LongWord *i) {
+ string255 s;
+
+ if (feof(f->fp)) {
+ f->eof = 1;
+ return;
+ }
+
+ fpcrtl_readLn__vars(f, &s);
+
+ *i = atoi(s.str);
+}
+
+void __attribute__((overloadable)) fpcrtl_readLn__vars(File f, string255 *s) {
+
+ if (fgets(s->str, 255, f->fp) == NULL) {
+
+ s->len = 0;
+ s->str[0] = 0;
+
+ f->eof = 1;
+ return;
+ }
+
+ if (feof(f->fp)) {
+ s->len = 0;
+ f->eof = 1;
+ return;
+ }
+
+ IOResult = IO_NO_ERROR;
+
+ s->len = strlen(s->str);
+ if ((s->len > 0) && (s->str[s->len - 1] == '\n')) {
+ s->str[s->len - 1] = 0;
+ s->len--;
+ }
+}
+
+void __attribute__((overloadable)) fpcrtl_write(File f, string255 s) {
+ FIX_STRING(s);
+ fprintf(f->fp, "%s", s.str);
+}
+
+void __attribute__((overloadable)) fpcrtl_write(FILE *f, string255 s) {
+ FIX_STRING(s);
+ fprintf(f, "%s", s.str);
+}
+
+void __attribute__((overloadable)) fpcrtl_writeLn(File f, string255 s) {
+ FIX_STRING(s);
+ fprintf(f->fp, "%s\n", s.str);
+}
+
+void __attribute__((overloadable)) fpcrtl_writeLn(FILE *f, string255 s) {
+ FIX_STRING(s);
+ fprintf(f, "%s\n", s.str);
+}
+
+void fpcrtl_blockRead__vars(File f, void *buf, Integer count, Integer *result) {
+ assert(f->record_len > 0);
+ *result = fread(buf, f->record_len, count, f->fp);
+}
+
+/*
+ * XXX: dummy blockWrite
+ */
+void fpcrtl_blockWrite__vars(File f, const void *buf, Integer count,
+ Integer *result) {
+ assert(0);
+}
+
+bool fpcrtl_directoryExists(string255 dir) {
+
+ struct stat st;
+ FIX_STRING(dir);
+
+ IOResult = IO_NO_ERROR;
+
+#ifdef FPCRTL_DEBUG
+ printf("Warning: directoryExists is called. This may not work when compiled to js.\n");
+#endif
+
+ if (stat(dir.str, &st) == 0) {
+ return true;
+ }
+
+ return false;
+}
+
+bool fpcrtl_fileExists(string255 filename) {
+
+ FIX_STRING(filename);
+
+ IOResult = IO_NO_ERROR;
+
+ FILE *fp = fopen(filename.str, "r");
+ if (fp) {
+ fclose(fp);
+ return true;
+ }
+ return false;
+}
+
+void __attribute__((overloadable)) fpcrtl_flush(Text f) {
+ printf("flush not implemented\n");
+ assert(0);
+}
+
+void __attribute__((overloadable)) fpcrtl_flush(FILE *f) {
+ fflush(f);
+}
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/fileio.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,78 @@
+#ifndef FILEIO_H_
+#define FILEIO_H_
+
+#include <stdio.h>
+#include "Types.h"
+#include "misc.h"
+
+extern int FileMode;
+
+typedef enum{
+ IO_NO_ERROR = 0,
+ IO_ERROR_DUMMY = 1
+}io_result_t;
+
+extern io_result_t IOResult;
+
+typedef struct{
+ FILE *fp;
+ const char* mode;
+ char file_name[256];
+ int eof;
+ int record_len;
+}file_wrapper_t;
+
+typedef file_wrapper_t* File;
+typedef File Text;
+typedef Text TextFile;
+
+void __attribute__((overloadable)) fpcrtl_readLn(File f);
+#define fpcrtl_readLn1(f) fpcrtl_readLn(f)
+
+void __attribute__((overloadable)) fpcrtl_readLn__vars(File f, Integer *i);
+void __attribute__((overloadable)) fpcrtl_readLn__vars(File f, LongWord *i);
+void __attribute__((overloadable)) fpcrtl_readLn__vars(File f, string255 *s);
+#define fpcrtl_readLn2(f, t) fpcrtl_readLn__vars(f, &(t))
+
+#define fpcrtl_readLn(...) macro_dispatcher(fpcrtl_readLn, __VA_ARGS__)(__VA_ARGS__)
+
+
+void fpcrtl_blockRead__vars(File f, void *buf, Integer count, Integer *result);
+#define fpcrtl_blockRead(f, buf, count, result) fpcrtl_blockRead__vars(f, &(buf), count, &(result))
+#define fpcrtl_BlockRead fpcrtl_blockRead
+
+#define fpcrtl_assign(f, name) fpcrtl_assign__vars(&f, name)
+void fpcrtl_assign__vars(File *f, string255 name);
+
+boolean fpcrtl_eof(File f);
+
+void fpcrtl_reset1(File f);
+void fpcrtl_reset2(File f, Integer l);
+#define fpcrtl_reset1(f) fpcrtl_reset1(f)
+#define fpcrtl_reset2(f, l) fpcrtl_reset2(f, l)
+#define fpcrtl_reset(...) macro_dispatcher(fpcrtl_reset, __VA_ARGS__)(__VA_ARGS__)
+
+void fpcrtl_close(File f);
+
+void __attribute__((overloadable)) fpcrtl_rewrite(File f);
+void __attribute__((overloadable)) fpcrtl_rewrite(File f, Integer l);
+
+void __attribute__((overloadable)) fpcrtl_flush(Text f);
+void __attribute__((overloadable)) fpcrtl_flush(FILE *f);
+
+void __attribute__((overloadable)) fpcrtl_write(File f, string255 s);
+void __attribute__((overloadable)) fpcrtl_write(FILE *f, string255 s);
+void __attribute__((overloadable)) fpcrtl_writeLn(File f, string255 s);
+void __attribute__((overloadable)) fpcrtl_writeLn(FILE *f, string255 s);
+
+void fpcrtl_blockWrite__vars(File f, const void *buf, Integer count, Integer *result);
+#define fpcrtl_blockWrite(f, buf, count, result) fpcrtl_blockWrite__vars(f, &(buf), count, &(result))
+#define fpcrtl_BlockWrite fpcrtl_blockWrite
+
+bool fpcrtl_directoryExists(string255 dir);
+#define fpcrtl_DirectoryExists fpcrtl_directoryExists
+
+bool fpcrtl_fileExists(string255 filename);
+#define fpcrtl_FileExists fpcrtl_fileExists
+
+#endif /* FILEIO_H_ */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/fpcrtl.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,192 @@
+#ifndef _FPCRTL_H_
+#define _FPCRTL_H_
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <math.h>
+
+#include "SysUtils.h"
+#include "system.h"
+#include "misc.h"
+#include "fileio.h"
+#include "pmath.h"
+
+#ifndef EMSCRIPTEN
+#if __APPLE__
+#define main SDL_main
+#endif
+#include "GL/glew.h"
+#endif
+
+#define fpcrtl_memcpy memcpy
+
+#define luapas_lua_gettop lua_gettop
+#define luapas_lua_close lua_close
+#define luapas_lua_createtable lua_createtable
+#define luapas_lua_error lua_error
+#define luapas_lua_gc lua_gc
+#define luapas_lua_getfield lua_getfield
+#define luapas_lua_objlen lua_objlen
+#define luapas_lua_call lua_call
+#define luapas_lua_pcall lua_pcall
+#define luapas_lua_pushboolean lua_pushboolean
+#define luapas_lua_pushcclosure lua_pushcclosure
+#define luapas_lua_pushinteger lua_pushinteger
+#define luapas_lua_pushnil lua_pushnil
+#define luapas_lua_pushnumber lua_pushnumber
+#define luapas_lua_pushlstring lua_pushlstring
+#define luapas_lua_pushstring lua_pushstring
+#define luapas_lua_pushvalue lua_pushvalue
+#define luapas_lua_rawgeti lua_rawgeti
+#define luapas_lua_setfield lua_setfield
+#define luapas_lua_settop lua_settop
+#define luapas_lua_toboolean lua_toboolean
+#define luapas_lua_tointeger lua_tointeger
+#define luapas_lua_tolstring lua_tolstring
+#define luapas_lua_tonumber lua_tonumber
+#define luapas_lua_type lua_type
+#define luapas_lua_typename lua_typename
+#define luapas_luaL_argerror luaL_argerror
+#define luapas_luaL_checkinteger luaL_checkinteger
+#define luapas_luaL_checklstring luaL_checklstring
+#define luapas_luaL_loadfile luaL_loadfile
+#define luapas_luaL_loadstring luaL_loadstring
+#define luapas_luaL_newstate luaL_newstate
+#define luapas_luaL_optinteger luaL_optinteger
+#define luapas_luaL_optlstring luaL_optlstring
+#define luapas_luaL_prepbuffer luaL_prepbuffer
+#define luapas_luaL_ref luaL_ref
+#define luapas_luaL_unref luaL_unref
+#define luapas_luaopen_base luaopen_base
+#define luapas_luaopen_math luaopen_math
+#define luapas_luaopen_string luaopen_string
+#define luapas_luaopen_table luaopen_table
+
+#define sdlh_IMG_Load IMG_Load
+
+#ifndef EMSCRIPTEN
+#define sdlh_Mix_AllocateChannels Mix_AllocateChannels
+#define sdlh_Mix_CloseAudio Mix_CloseAudio
+#define sdlh_Mix_FadeInChannelTimed Mix_FadeInChannelTimed
+#define sdlh_Mix_FadeInMusic Mix_FadeInMusic
+#define sdlh_Mix_FadeOutChannel Mix_FadeOutChannel
+#define sdlh_Mix_FreeChunk Mix_FreeChunk
+#define sdlh_Mix_FreeMusic Mix_FreeMusic
+#define sdlh_Mix_HaltChannel Mix_HaltChannel
+#define sdlh_Mix_HaltMusic Mix_HaltMusic
+#define sdlh_Mix_LoadMUS Mix_LoadMUS
+#define sdlh_Mix_LoadWAV_RW Mix_LoadWAV_RW
+#define sdlh_Mix_OpenAudio Mix_OpenAudio
+#define sdlh_Mix_PauseMusic Mix_PauseMusic
+#define sdlh_Mix_PlayChannelTimed Mix_PlayChannelTimed
+#define sdlh_Mix_Playing Mix_Playing
+#define sdlh_Mix_ResumeMusic Mix_ResumeMusic
+#define sdlh_Mix_Volume Mix_Volume
+#define sdlh_Mix_VolumeMusic Mix_VolumeMusic
+#else
+#define sdlh_Mix_AllocateChannels stub_Mix_AllocateChannels
+#define sdlh_Mix_CloseAudio stub_Mix_CloseAudio
+#define sdlh_Mix_FadeInChannelTimed stub_Mix_FadeInChannelTimed
+#define sdlh_Mix_FadeInMusic stub_Mix_FadeInMusic
+#define sdlh_Mix_FadeOutChannel stub_Mix_FadeOutChannel
+#define sdlh_Mix_FreeChunk stub_Mix_FreeChunk
+#define sdlh_Mix_FreeMusic stub_Mix_FreeMusic
+#define sdlh_Mix_HaltChannel stub_Mix_HaltChannel
+#define sdlh_Mix_HaltMusic stub_Mix_HaltMusic
+#define sdlh_Mix_LoadMUS stub_Mix_LoadMUS
+#define sdlh_Mix_LoadWAV_RW stub_Mix_LoadWAV_RW
+#define sdlh_Mix_OpenAudio stub_Mix_OpenAudio
+#define sdlh_Mix_PauseMusic stub_Mix_PauseMusic
+#define sdlh_Mix_PlayChannelTimed stub_Mix_PlayChannelTimed
+#define sdlh_Mix_Playing stub_Mix_Playing
+#define sdlh_Mix_ResumeMusic stub_Mix_ResumeMusic
+#define sdlh_Mix_Volume stub_Mix_Volume
+#define sdlh_Mix_VolumeMusic stub_Mix_VolumeMusic
+#endif
+
+#define sdlh_SDL_ConvertSurface SDL_ConvertSurface
+#define sdlh_SDL_CreateRGBSurface SDL_CreateRGBSurface
+#define sdlh_SDL_CreateThread SDL_CreateThread
+#define sdlh_SDL_Delay SDL_Delay
+#define sdlh_SDL_EnableKeyRepeat SDL_EnableKeyRepeat
+#define sdlh_SDL_EnableUNICODE SDL_EnableUNICODE
+#define sdlh_SDL_FillRect SDL_FillRect
+#define sdlh_SDL_FreeSurface SDL_FreeSurface
+#define sdlh_SDL_GetError SDL_GetError
+#define sdlh_SDL_GetKeyName SDL_GetKeyName
+#define sdlh_SDL_GetKeyState SDL_GetKeyState
+#define sdlh_SDL_GetMouseState SDL_GetMouseState
+#define sdlh_SDL_GetRGBA SDL_GetRGBA
+#define sdlh_SDL_GetTicks SDL_GetTicks
+#define sdlh_SDL_GL_SetAttribute SDL_GL_SetAttribute
+#define sdlh_SDL_GL_SwapBuffers SDL_GL_SwapBuffers
+#define sdlh_SDL_Init SDL_Init
+#define sdlh_SDL_InitSubSystem SDL_InitSubSystem
+#define sdlh_SDL_JoystickClose SDL_JoystickClose
+#define sdlh_SDL_JoystickEventState SDL_JoystickEventState
+#define sdlh_SDL_JoystickName SDL_JoystickName
+#define sdlh_SDL_JoystickNumAxes SDL_JoystickNumAxes
+#define sdlh_SDL_JoystickNumButtons SDL_JoystickNumButtons
+#define sdlh_SDL_JoystickNumHats SDL_JoystickNumHats
+#define sdlh_SDL_JoystickOpen SDL_JoystickOpen
+#define sdlh_SDL_LockSurface SDL_LockSurface
+#define sdlh_SDL_MapRGB SDL_MapRGB
+#define sdlh_SDL_MapRGBA SDL_MapRGBA
+#define sdlh_SDL_NumJoysticks SDL_NumJoysticks
+#define sdlh_SDL_PeepEvents SDL_PeepEvents
+#define sdlh_SDL_PumpEvents SDL_PumpEvents
+#define sdlh_SDL_Quit SDL_Quit
+#define sdlh_SDL_RWFromFile SDL_RWFromFile
+#define sdlh_SDL_SetColorKey SDL_SetColorKey
+#define sdlh_SDL_SetVideoMode SDL_SetVideoMode
+#ifndef EMSCRIPTEN
+#define sdlh_SDL_ShowCursor SDL_ShowCursor
+#else
+#define sdlh_SDL_ShowCursor SDL_ShowCursor_patch
+#endif
+#define sdlh_SDL_UnlockSurface SDL_UnlockSurface
+#define sdlh_SDL_UpperBlit SDL_UpperBlit
+#define sdlh_SDL_VideoDriverName SDL_VideoDriverName
+#define sdlh_SDL_WarpMouse SDL_WarpMouse
+#define sdlh_SDL_WM_SetCaption SDL_WM_SetCaption
+#define sdlh_SDL_WM_SetIcon SDL_WM_SetIcon
+#define sdlh_SDLNet_AddSocket SDLNet_AddSocket
+#define sdlh_SDLNet_AllocSocketSet SDLNet_AllocSocketSet
+#define sdlh_SDLNet_CheckSockets SDLNet_CheckSockets
+#define sdlh_SDLNet_FreeSocketSet SDLNet_FreeSocketSet
+#define sdlh_SDLNet_Init SDLNet_Init
+#define sdlh_SDLNet_Quit SDLNet_Quit
+#define sdlh_SDLNet_ResolveHost SDLNet_ResolveHost
+#define sdlh_SDLNet_TCP_Close SDLNet_TCP_Close
+#define sdlh_SDLNet_TCP_Open SDLNet_TCP_Open
+#define sdlh_SDLNet_TCP_Recv SDLNet_TCP_Recv
+#define sdlh_SDLNet_TCP_Send SDLNet_TCP_Send
+#define sdlh_TTF_Init TTF_Init
+#define sdlh_TTF_OpenFont TTF_OpenFont
+#define sdlh_TTF_Quit TTF_Quit
+#define sdlh_TTF_RenderUTF8_Blended TTF_RenderUTF8_Blended
+#define sdlh_TTF_RenderUTF8_Solid TTF_RenderUTF8_Solid
+#define sdlh_TTF_SetFontStyle TTF_SetFontStyle
+#define sdlh_TTF_SizeUTF8 TTF_SizeUTF8
+
+#define _strconcat fpcrtl_strconcat
+#define _strappend fpcrtl_strappend
+#define _strprepend fpcrtl_strprepend
+#define _strcompare fpcrtl_strcompare
+#define _strncompare fpcrtl_strncompare
+#define _strcomparec fpcrtl_strcomparec
+#define _chrconcat fpcrtl_chrconcat
+#define _pchar fpcrtl_pchar
+
+// hooks are implemented in javascript
+void start_hook(void);
+void mainloop_hook(void);
+void clear_filelist_hook(void);
+void add_file_hook(const char* ptr);
+void idb_loader_hook();
+void showcursor_hook();
+void hidecursor_hook();
+void drawworld_init_hook();
+#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/misc.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,168 @@
+#include "misc.h"
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+#include <assert.h>
+
+char strbuf[512];
+
+void fpcrtl_assert(int i)
+{
+ if(!i){
+ assert(0);
+ }
+}
+
+// EFFECTS: return the nearest integer of the given number
+int fpcrtl_round(double number)
+{
+ return (number >= 0) ? (int)(number + 0.5) : (int)(number - 0.5);
+}
+
+void fpcrtl_printf(const char* format, ...)
+{
+#ifdef FPCRTL_DEBUG
+ va_list args;
+ va_start (args, format);
+ vprintf (format, args);
+ va_end (args);
+#endif
+}
+
+//
+//void fpcrtl_check_string(string255 str)
+//{
+//#ifdef FPCRTL_DEBUG
+// int len = strlen(str.str);
+// if(len != str.len){
+// printf("String %s internal inconsistency error. Length should be %d but actually is %d.\n", str.str, len, str.len);
+// }
+// //assert(len == str.len);
+//#endif
+//}
+
+string255 fpcrtl_strconcat(string255 str1, string255 str2)
+{
+ //printf("str1 = %d, %d\n", str1.len, strlen(str1.str));
+ //printf("str2 = %d, %d\n", str2.len, strlen(str2.str));
+
+#ifdef FPCRTL_DEBUG
+ if(str1.len + (int)(str2.len) > 255){
+ printf("String overflow\n");
+ printf("str1(%d): %s\nstr2(%d): %s\n", str1.len, str1.str, str2.len, str2.str);
+ printf("String will be truncated.\n");
+
+ strbuf[0] = 0;
+ strcpy(strbuf, str1.str);
+ strcat(strbuf, str2.str);
+ memcpy(str1.str, strbuf, 255);
+ str1.str[254] = 0;
+
+ return str1;
+ }
+#endif
+
+ memcpy(&(str1.str[str1.len]), str2.str, str2.len);
+ str1.str[str1.len + str2.len] = 0;
+ str1.len += str2.len;
+
+ return str1;
+}
+
+string255 fpcrtl_strappend(string255 s, char c)
+{
+ s.str[s.len] = c;
+ s.str[s.len + 1] = 0;
+ s.len ++;
+
+ return s;
+}
+
+string255 fpcrtl_strprepend(char c, string255 s)
+{
+ FIX_STRING(s);
+
+ memmove(s.str + 1, s.str, s.len + 1); // also move '/0'
+ s.str[0] = c;
+ s.len++;
+
+ return s;
+}
+
+string255 fpcrtl_chrconcat(char a, char b)
+{
+ string255 result;
+
+ result.len = 2;
+ result.str[0] = a;
+ result.str[1] = b;
+ result.str[2] = 0;
+
+ return result;
+}
+
+bool fpcrtl_strcompare(string255 str1, string255 str2)
+{
+ //printf("str1 = %d, %d\n", str1.len, strlen(str1.str));
+ //printf("str2 = %d, %d\n", str2.len, strlen(str2.str));
+ FIX_STRING(str1);
+ FIX_STRING(str2);
+
+ if(strcmp(str1.str, str2.str) == 0){
+ return true;
+ }
+
+ return false;
+}
+
+bool fpcrtl_strcomparec(string255 a, char b)
+{
+ FIX_STRING(a);
+
+ if(a.len == 1 && a.str[0] == b){
+ return true;
+ }
+
+ return false;
+}
+
+bool fpcrtl_strncompare(string255 a, string255 b)
+{
+ return !fpcrtl_strcompare(a, b);
+}
+
+//char* fpcrtl_pchar(string255 s)
+//{
+// return s.str;
+//}
+
+string255 fpcrtl_pchar2str(char *s)
+{
+ string255 result;
+ int t = strlen(s);
+
+ if(t > 255){
+ printf("pchar2str, length > 255\n");
+ assert(0);
+ }
+
+ result.len = t;
+ memcpy(result.str, s, t);
+ result.str[t] = 0;
+
+ return result;
+}
+
+string255 fpcrtl_make_string(const char* s) {
+ string255 result;
+ strcpy(result.str, s);
+ result.len = strlen(s);
+ return result;
+}
+
+#ifdef EMSCRIPTEN
+GLenum glewInit()
+{
+ return GLEW_OK;
+}
+#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/misc.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,58 @@
+#ifndef _FPCRTL_MISC_H_
+#define _FPCRTL_MISC_H_
+
+#include "pas2c.h"
+#include <assert.h>
+#include <stdbool.h>
+
+#ifdef EMSCRIPTEN
+#include <GL/gl.h>
+#else
+#include <GL/glew.h>
+#endif
+
+#define VA_NUM_ARGS(...) VA_NUM_ARGS_IMPL(__VA_ARGS__, 5,4,3,2,1)
+#define VA_NUM_ARGS_IMPL(_1,_2,_3,_4,_5,N,...) N
+
+#define macro_dispatcher(func, ...) macro_dispatcher_(func, VA_NUM_ARGS(__VA_ARGS__))
+#define macro_dispatcher_(func, nargs) macro_dispatcher__(func, nargs)
+#define macro_dispatcher__(func, nargs) func ## nargs
+
+#define FPCRTL_DEBUG
+
+#define FIX_STRING(s) (s.str[s.len] = 0)
+
+//#define fpcrtl_check_string(s) do{ if(strlen((s).str) != (s).len){ \
+// printf("String %s internal inconsistency error. Length should be %d but actually is %d.\n", (s).str, strlen((s).str), (s).len); \
+// assert(0);\
+// }}while(0)
+
+void fpcrtl_assert(int);
+void fpcrtl_print_trace (void);
+
+int fpcrtl_round(double number);
+void fpcrtl_printf(const char* format, ...);
+
+string255 fpcrtl_make_string(const char* s);
+
+string255 fpcrtl_strconcat(string255 str1, string255 str2);
+string255 fpcrtl_strappend(string255 s, char c);
+string255 fpcrtl_strprepend(char c, string255 s);
+string255 fpcrtl_chrconcat(char a, char b);
+
+// return true if str1 == str2
+bool fpcrtl_strcompare(string255 str1, string255 str2);
+bool fpcrtl_strcomparec(string255 a, char b);
+bool fpcrtl_strncompare(string255 a, string255 b);
+
+#define fpcrtl__pchar(s) ((s).str)
+string255 fpcrtl_pchar2str(char *s);
+
+#define fpcrtl_TypeInfo sizeof // dummy
+
+#ifdef EMSCRIPTEN
+#define GLEW_OK 1
+GLenum glewInit();
+#endif
+
+#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/pas2c.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,80 @@
+#pragma once
+
+#include <stddef.h>
+#include <stdint.h>
+#include <stdbool.h>
+#include <wchar.h>
+#include <math.h>
+
+#define MAX_PARAMS 64
+
+typedef union string255_
+ {
+ struct {
+ char s[257];
+ };
+ struct {
+ unsigned char len;
+ char str[256];
+ };
+ } string255;
+typedef struct string192_
+ {
+ char s[193];
+ } string192;
+typedef struct string31_
+ {
+ char s[32];
+ } string31;
+typedef struct string15_
+ {
+ char s[16];
+ } string15;
+
+typedef string255 shortstring;
+typedef string255 ansistring;
+
+typedef uint8_t Byte;
+typedef int8_t ShortInt;
+typedef uint16_t Word;
+typedef int16_t SmallInt;
+typedef uint32_t LongWord;
+typedef int32_t LongInt;
+typedef uint64_t QWord;
+typedef int64_t Int64;
+typedef LongWord Cardinal;
+
+typedef LongInt Integer;
+typedef float extended;
+typedef float real;
+typedef float single;
+
+typedef bool boolean;
+typedef int LongBool;
+
+typedef void * pointer;
+typedef Byte * PByte;
+typedef char * PChar;
+typedef LongInt * PLongInt;
+typedef LongWord * PLongWord;
+typedef Integer * PInteger;
+typedef int PtrInt;
+typedef wchar_t widechar;
+typedef wchar_t* PWideChar;
+typedef char Char;
+typedef LongInt SizeInt;
+typedef char ** PPChar;
+typedef Word* PWord;
+
+string255 _strconcat(string255 a, string255 b);
+string255 _strappend(string255 s, char c);
+string255 _strprepend(char c, string255 s);
+string255 _chrconcat(char a, char b);
+bool _strcompare(string255 a, string255 b);
+bool _strcomparec(string255 a, char b);
+bool _strncompare(string255 a, string255 b);
+
+
+#define STRINIT(a) {.len = sizeof(a) - 1, .str = a}
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/pmath.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,49 @@
+#include "pmath.h"
+#include <stdlib.h>
+#include <math.h>
+
+/*
+ * power raises base to the power power.
+ * This is equivalent to exp(power*ln(base)). Therefore base should be non-negative.
+ */
+float fpcrtl_power(float base, float exponent)
+{
+ return exp(exponent * log(base));
+}
+
+/* Currently the games only uses sign of an integer */
+int fpcrtl_signi(int x)
+{
+ if(x > 0){
+ return 1;
+ }
+ else if(x < 0){
+ return -1;
+ }
+ else{
+ return 0;
+ }
+}
+
+float fpcrtl_csc(float x)
+{
+ return 1 / sin(x);
+}
+
+float __attribute__((overloadable)) fpcrtl_abs(float x)
+{
+ return fabs(x);
+}
+double __attribute__((overloadable)) fpcrtl_abs(double x)
+{
+ return fabs(x);
+}
+int __attribute__((overloadable)) fpcrtl_abs(int x)
+{
+ return abs(x);
+}
+
+int64_t __attribute__((overloadable)) fpcrtl_abs(int64_t x)
+{
+ return x < 0 ? -x : x;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/pmath.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,24 @@
+#ifndef PMATH_H_
+#define PMATH_H_
+
+#include <stdint.h>
+#include <math.h>
+
+#define fpcrtl_min(a, b) ((a) < (b) ? (a) : (b))
+#define fpcrtl_max(a, b) ((a) > (b) ? (a) : (b))
+
+float fpcrtl_power(float base, float exponent);
+
+/* Currently the games only uses sign of an integer */
+int fpcrtl_signi(int x);
+
+float fpcrtl_csc(float x);
+
+#define fpcrtl_arctan2(y, x) atan2(y, x)
+
+float __attribute__((overloadable)) fpcrtl_abs(float x);
+double __attribute__((overloadable)) fpcrtl_abs(double x);
+int __attribute__((overloadable)) fpcrtl_abs(int x);
+int64_t __attribute__((overloadable)) fpcrtl_abs(int64_t x);
+
+#endif /* PMATH_H_ */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/system.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,284 @@
+#include "system.h"
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <wchar.h>
+
+#ifndef M_PI
+// some math.h do not have M_PI macros
+# define M_PI 3.14159265358979323846 /* pi */
+# define M_PI_2 1.57079632679489661923 /* pi/2 */
+# define M_PI_4 0.78539816339744830962 /* pi/4 */
+# define M_PIl 3.1415926535897932384626433832795029L /* pi */
+# define M_PI_2l 1.5707963267948966192313216916397514L /* pi/2 */
+# define M_PI_4l 0.7853981633974483096156608458198757L /* pi/4 */
+#endif
+
+double pi = M_PI;
+
+int paramCount;
+string255 params[MAX_PARAMS];
+
+string255 fpcrtl_copy(string255 s, Integer index, Integer count) {
+ string255 result = STRINIT("");
+
+ if (count < 1) {
+ return result;
+ }
+
+ if (index < 1) {
+ index = 1;
+ }
+
+ if (index > s.len) {
+ return result;
+ }
+
+ if (index + count > s.len + 1) {
+ count = s.len + 1 - index;
+ }
+
+ memcpy(result.str, s.str + index - 1, count);
+
+ result.str[count] = 0;
+ result.len = count;
+
+ return result;
+}
+
+void fpcrtl_delete__vars(string255 *s, SizeInt index, SizeInt count) {
+ // number of chars to be move
+ int num_move;
+ int new_length;
+
+ string255 temp = *s;
+
+ if (index < 1) {
+ // in fpc, if index < 1, the string won't be modified
+ return;
+ }
+
+ if(index > s->len){
+ return;
+ }
+
+ if (count > s->len - index + 1) {
+ s->str[index - 1] = 0;
+ s->len = index - 1;
+ return;
+ }
+
+ num_move = s->len - index + 1 - count;
+ new_length = s->len - count;
+
+ memmove(s->str + index - 1, temp.str + index - 1 + count, num_move);
+ s->str[new_length] = 0;
+
+ s->len = new_length;
+
+}
+
+string255 fpcrtl_floatToStr(double n) {
+ string255 t;
+ sprintf(t.str, "%f", n);
+ t.len = strlen(t.str);
+
+ return t;
+}
+
+void fpcrtl_move__vars(void *src, void *dst, SizeInt count) {
+ memmove(dst, src, count);
+}
+
+Integer __attribute__((overloadable)) fpcrtl_pos(Char c, string255 str) {
+ string255 t;
+ t.len = 1;
+ t.str[0] = c;
+ t.str[1] = 0;
+ return fpcrtl_pos(t, str);
+}
+
+Integer __attribute__((overloadable)) fpcrtl_pos(string255 substr, string255 str) {
+
+ char* p;
+
+ FIX_STRING(substr);
+ FIX_STRING(str);
+
+ if (str.len == 0) {
+ return 0;
+ }
+
+ if (substr.len == 0) {
+ return 0;
+ }
+
+ str.str[str.len] = 0;
+ substr.str[substr.len] = 0;
+
+ p = strstr(str.str, substr.str);
+
+ if (p == NULL) {
+ return 0;
+ }
+
+ return strlen(str.str) - strlen(p) + 1;
+}
+
+Integer fpcrtl_length(string255 s) {
+ return s.len;
+}
+
+string255 fpcrtl_lowerCase(string255 s) {
+ int i;
+
+ for (i = 0; i < s.len; i++) {
+ if (s.str[i] >= 'A' && s.str[i] <= 'Z') {
+ s.str[i] += 'a' - 'A';
+ }
+ }
+
+ return s;
+}
+
+void fpcrtl_fillChar__vars(void *x, SizeInt count, Byte value) {
+ memset(x, value, count);
+}
+
+void fpcrtl_new__vars(void **p, int size) {
+ *p = malloc(size);
+}
+
+Integer fpcrtl_trunc(extended n) {
+ return (int) n;
+}
+
+LongInt str_to_int(char *src)
+{
+ int i;
+ int len = strlen(src);
+ char *end;
+ for(i = 0; i < len; i++)
+ {
+ if(src[i] == '$'){
+ // hex
+ return strtol(src + i + 1, &end, 16);
+ }
+ }
+
+ // decimal
+ return atoi(src);
+}
+void __attribute__((overloadable)) fpcrtl_val__vars(string255 s, LongInt *a,
+ LongInt *c) {
+ *c = 0; // no error
+ FIX_STRING(s);
+ *a = str_to_int(s.str);
+}
+
+void __attribute__((overloadable)) fpcrtl_val__vars(string255 s, Byte *a,
+ LongInt *c) {
+ *c = 0; // no error
+ FIX_STRING(s);
+ *a = str_to_int(s.str);
+}
+
+void __attribute__((overloadable)) fpcrtl_val__vars(string255 s, LongWord *a,
+ LongInt *c) {
+ *c = 0; // no error
+ FIX_STRING(s);
+ *a = str_to_int(s.str);
+}
+
+LongInt fpcrtl_random(LongInt l) {
+ return (LongInt) (rand() / (double) RAND_MAX * l);
+}
+
+void __attribute__((overloadable)) fpcrtl_str__vars(float x, string255 *s) {
+ sprintf(s->str, "%f", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(double x, string255 *s) {
+ sprintf(s->str, "%f", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(uint8_t x, string255 *s) {
+ sprintf(s->str, "%u", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(int8_t x, string255 *s) {
+ sprintf(s->str, "%d", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(uint16_t x, string255 *s) {
+ sprintf(s->str, "%u", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(int16_t x, string255 *s) {
+ sprintf(s->str, "%d", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(uint32_t x, string255 *s) {
+ sprintf(s->str, "%u", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(int32_t x, string255 *s) {
+ sprintf(s->str, "%d", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(uint64_t x, string255 *s) {
+ sprintf(s->str, "%llu", x);
+ s->len = strlen(s->str);
+}
+void __attribute__((overloadable)) fpcrtl_str__vars(int64_t x, string255 *s) {
+ sprintf(s->str, "%lld", x);
+ s->len = strlen(s->str);
+}
+
+/*
+ * XXX No protection currently!
+ */
+void fpcrtl_interlockedIncrement__vars(int *i) {
+ (*i)++;
+}
+
+void fpcrtl_interlockedDecrement__vars(int *i) {
+ (*i)--;
+}
+
+/*
+ * This function should be called when entering main
+ */
+void fpcrtl_init(int argc, char** argv) {
+ int i;
+ paramCount = argc;
+
+ printf("ARGC = %d\n", paramCount);
+
+ for (i = 0; i < argc; i++) {
+ if (strlen(argv[i]) > 255) {
+ assert(0);
+ }
+ strcpy(params[i].str, argv[i]);
+ params[i].len = strlen(params[i].str);
+ }
+
+}
+
+int fpcrtl_paramCount() {
+ return paramCount - 1; // ignore the first one
+}
+
+string255 fpcrtl_paramStr(int i) {
+ return params[i];
+}
+
+int fpcrtl_UTF8ToUnicode(PWideChar dest, PChar src, SizeInt maxLen) {
+ //return swprintf(dest, maxLen, L"%hs", "src"); //doesn't work in emscripten
+ return 0;
+}
+
+uint32_t __attribute__((overloadable)) fpcrtl_lo(uint64_t i) {
+ return (i & 0xFFFFFFFF);
+}
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/system.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,169 @@
+#ifndef SYSTEM_H_
+#define SYSTEM_H_
+
+#include <time.h>
+#include "Types.h"
+#include "misc.h"
+
+extern double pi;
+
+typedef TDate* PDate;
+
+// dimension info for dynamic arrays
+typedef struct {
+ int dim;
+ int a[4]; // at most 4
+} fpcrtl_dimension_t;
+
+/*
+ * Copy returns a string which is a copy if the Count characters in S, starting at position Index.
+ * If Count is larger than the length of the string S, the result is truncated.
+ * If Index is larger than the length of the string S, then an empty string is returned.
+ * Index is 1-based.
+ */
+string255 fpcrtl_copy(string255 s, Integer Index, Integer Count);
+
+/*
+ * Delete removes Count characters from string S, starting at position Index.
+ * All characters after the deleted characters are shifted Count positions to the left,
+ * and the length of the string is adjusted.
+ */
+#define fpcrtl_delete(s, index, count) fpcrtl_delete__vars(&(s), index, count)
+void fpcrtl_delete__vars(string255 *s, SizeInt index, SizeInt count);
+
+string255 fpcrtl_floatToStr(double n);
+
+/*
+ * Move data from one location in memory to another
+ */
+void fpcrtl_move__vars(void *src, void *dst, SizeInt count);
+#define fpcrtl_move(src, dst, count) fpcrtl_move__vars(&(src), &(dst), count);
+#define fpcrtl_Move fpcrtl_move
+
+Integer __attribute__((overloadable)) fpcrtl_pos(Char c, string255 str);
+Integer __attribute__((overloadable)) fpcrtl_pos(string255 substr, string255 str);
+
+Integer fpcrtl_length(string255 s);
+#define fpcrtl_Length fpcrtl_length
+
+#define fpcrtl_sqr(x) ((x) * (x))
+
+#define fpcrtl_odd(x) ((x) % 2 != 0 ? true : false)
+
+#define fpcrtl_StrLen strlen
+
+#define SizeOf sizeof
+
+string255 fpcrtl_lowerCase(string255 s);
+#define fpcrtl_LowerCase fpcrtl_lowerCase
+
+void fpcrtl_fillChar__vars(void *x, SizeInt count, Byte value);
+#define fpcrtl_fillChar(x, count, value) fpcrtl_fillChar__vars(&(x), count, value)
+#define fpcrtl_FillChar fpcrtl_fillChar
+
+void fpcrtl_new__vars(void **p, int size);
+#define fpcrtl_new(a) fpcrtl_new__vars((void **)&(a), sizeof(*(a)))
+
+#define fpcrtl_dispose free
+
+#define fpcrtl_freeMem(p, size) free(p)
+#define fpcrtl_FreeMem(p, size) free(p)
+
+#define fpcrtl_getMem(size) malloc(size)
+#define fpcrtl_GetMem fpcrtl_getMem
+
+#define fpcrtl_assigned(p) ((p) != NULL)
+#define fpcrtl_Assigned fpcrtl_assigned
+
+Integer fpcrtl_trunc(extended n);
+
+#define fpcrtl_val(s, a, c) fpcrtl_val__vars(s, &(a), &(c))
+void __attribute__((overloadable)) fpcrtl_val__vars(string255 s, LongInt *a, LongInt *c);
+void __attribute__((overloadable)) fpcrtl_val__vars(string255 s, Byte *a, LongInt *c);
+void __attribute__((overloadable)) fpcrtl_val__vars(string255 s, LongWord *a, LongInt *c);
+
+#define fpcrtl_randomize() srand(time(NULL))
+
+/*
+ * Random returns a random number larger or equal to 0 and strictly less than L
+ */
+LongInt fpcrtl_random(LongInt l);
+
+string255 fpcrtl_paramStr(LongInt);
+#define fpcrtl_ParamStr fpcrtl_paramStr
+
+/*
+ * Str returns a string which represents the value of X. X can be any numerical type.
+ */
+#define fpcrtl_str(x, s) fpcrtl_str__vars(x, &(s))
+void __attribute__((overloadable)) fpcrtl_str__vars(float x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(double x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(uint8_t x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(int8_t x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(uint16_t x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(int16_t x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(uint32_t x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(int32_t x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(uint64_t x, string255 *s);
+void __attribute__((overloadable)) fpcrtl_str__vars(int64_t x, string255 *s);
+
+void fpcrtl_interlockedIncrement__vars(int *i);
+void fpcrtl_interlockedDecrement__vars(int *i);
+
+#define fpcrtl_interlockedIncrement(i) fpcrtl_interlockedIncrement__vars(&(i))
+#define fpcrtl_interlockedDecrement(i) fpcrtl_interlockedDecrement__vars(&(i))
+
+#define fpcrtl_InterlockedIncrement fpcrtl_interlockedIncrement
+#define fpcrtl_InterlockedDecrement fpcrtl_interlockedDecrement
+
+void fpcrtl_init(int argc, char** argv);
+
+int fpcrtl_paramCount();
+#define fpcrtl_ParamCount fpcrtl_paramCount
+
+string255 fpcrtl_paramStr(int i);
+#define fpcrtl_ParamStr fpcrtl_paramStr
+
+int fpcrtl_UTF8ToUnicode(PWideChar dest, PChar src, SizeInt maxLen);
+
+#define fpcrtl_halt(t) assert(0)
+
+#define fpcrtl_Load_GL_VERSION_2_0() 1
+
+uint32_t __attribute__((overloadable)) fpcrtl_lo(uint64_t);
+#define fpcrtl_Lo fpcrtl_lo
+
+#define __SET_LENGTH2(arr, d, b) do{\
+ d.dim = 1;\
+ arr = realloc(arr, b * sizeof(typeof(*arr)));\
+ d.a[0] = b;\
+ }while(0)
+
+#define SET_LENGTH2(arr, b) __SET_LENGTH2(arr, arr##_dimension_info, (b))
+
+#define __SET_LENGTH3(arr, d, b, c) do{\
+ d.dim = 2;\
+ for (int i = 0; i < d.a[0]; i++) {\
+ arr[i] = realloc(arr[i], c * sizeof(typeof(**arr)));\
+ }\
+ if (d.a[0] > b) {\
+ for (int i = b; i < d.a[0]; i++) {\
+ free(arr[i]);\
+ }\
+ arr = realloc(arr, b * sizeof(typeof(*arr)));\
+ } else if (d.a[0] < b) {\
+ arr = realloc(arr, b * sizeof(typeof(*arr)));\
+ for (int i = d.a[0]; i < b; i++) {\
+ arr[i] = malloc(c * sizeof(typeof(**arr)));\
+ memset(arr[i], 0, c * sizeof(typeof(**arr)));\
+ }\
+ }\
+ d.a[0] = b;\
+ d.a[1] = c;\
+ }while(0)
+
+#define SET_LENGTH3(arr, b, c) __SET_LENGTH3(arr, arr##_dimension_info, (b), (c))
+
+#define fpcrtl_SetLength(...) macro_dispatcher(SET_LENGTH, __VA_ARGS__)(__VA_ARGS__)
+
+#endif /* SYSTEM_H_ */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/sysutils.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,178 @@
+#include "SysUtils.h"
+
+#include <time.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "system.h"
+#include "misc.h"
+
+TDateTime fpcrtl_date()
+{
+ const int num_days_between_1900_1980 = 29220;
+
+ struct tm ref_date;
+ struct tm cur_date;
+ time_t local_time;
+ time_t ref_time, cur_time;
+
+ double timeDiff;
+ double day_time_frac; //fraction that represents the time in one day
+ int num_seconds;
+ int numDays;
+
+ // unix epoch doesn't work, choose Jan 1st 1980 instead
+ ref_date.tm_year = 80;
+ ref_date.tm_mon = 0;
+ ref_date.tm_mday = 1;
+ ref_date.tm_hour = 0;
+ ref_date.tm_min = 0;
+ ref_date.tm_sec = 0;
+ ref_date.tm_isdst = 0;
+ ref_date.tm_wday = 0; // ignored
+ ref_date.tm_yday = 0; // ignored
+
+ local_time = time(NULL);
+ cur_date = *localtime(&local_time);
+
+ cur_date.tm_hour = 0;
+ cur_date.tm_min = 0;
+ cur_date.tm_sec = 0;
+
+ ref_time = mktime(&ref_date);
+ cur_time = mktime(&cur_date);
+
+ timeDiff = difftime(cur_time, ref_time);
+ numDays = fpcrtl_round(timeDiff / 3600 / 24) + num_days_between_1900_1980 + 1;
+
+ fpcrtl_printf("[date] tim diff: %f\n", timeDiff);
+ fpcrtl_printf("[date] num days between 1980 and today: %d\n", fpcrtl_round(timeDiff/3600/24));
+ fpcrtl_printf("[date] current date: %s\n", asctime(&cur_date));
+ fpcrtl_printf("[date] reference date: %s\n", asctime(&ref_date));
+ fpcrtl_printf("[date] num days: %d\n", numDays);
+
+ return numDays;
+}
+
+TDateTime fpcrtl_time()
+{
+ struct tm cur_date;
+ time_t local_time;
+ time_t cur_time;
+
+ double day_time_frac; //fraction that represents the time in one day
+ int num_seconds;
+
+ local_time = time(NULL);
+ cur_date = *localtime(&local_time);
+
+ num_seconds = cur_date.tm_hour * 3600 + cur_date.tm_min * 60 + cur_date.tm_sec;
+ day_time_frac = num_seconds / 3600.0 / 24.0;
+
+ fpcrtl_printf("%f\n", day_time_frac);
+
+ return day_time_frac;
+}
+
+TDateTime fpcrtl_now()
+{
+ return fpcrtl_date() + fpcrtl_time();
+}
+
+/*
+ * XXX: dummy
+ */
+string255 fpcrtl_formatDateTime(string255 FormatStr, TDateTime DateTime)
+{
+ string255 result = STRINIT("2012 01-01");
+ return result;
+}
+
+string255 fpcrtl_trim(string255 s)
+{
+ int left, right;
+
+ if(s.len == 0){
+ return s;
+ }
+
+ for(left = 0; left < s.len; left++)
+ {
+ if(s.str[left] != ' '){
+ break;
+ }
+ }
+
+ for(right = s.len - 1; right >= 0; right--)
+ {
+ if(s.str[right] != ' '){
+ break;
+ }
+ }
+
+ if(left > right){
+ s.len = 0;
+ s.str[0] = 0;
+ return s;
+ }
+
+ s.len = right - left + 1;
+ memmove(s.str, s.str + left, s.len);
+
+ s.str[s.len] = 0;
+
+ return s;
+}
+
+Integer fpcrtl_strToInt(string255 s)
+{
+ s.str[s.len] = 0;
+ return atoi(s.str);
+}
+
+//function ExtractFileName(const FileName: string): string;
+//var
+// i : longint;
+// EndSep : Set of Char;
+//begin
+// I := Length(FileName);
+// EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
+// while (I > 0) and not (FileName[I] in EndSep) do
+// Dec(I);
+// Result := Copy(FileName, I + 1, MaxInt);
+//end;
+
+string255 fpcrtl_extractFileName(string255 f)
+{
+ const char sep[] = {'\\', '/', ':'};
+ LongInt i,j;
+
+ i = f.len - 1;
+ while(i >= 0){
+ for(j = 0; j < sizeof(sep); j++){
+ if(f.str[i] == sep[j]){
+ goto FPCRTL_EXTRACTFILENAME_END;
+ }
+ }
+ i--;
+ }
+FPCRTL_EXTRACTFILENAME_END:
+ return fpcrtl_copy(f, i + 2, 256);
+}
+
+string255 fpcrtl_strPas(PChar p)
+{
+ string255 s;
+ int l = strlen(p);
+
+ if(l > 255){
+ printf("strPas: source string length > 255\n");
+ assert(0);
+ }
+
+ s.len = l;
+ strcpy(s.str, p);
+
+ return s;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/tests/check_check.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,23 @@
+#include <check.h>
+#include <stdlib.h>
+#include "check_check.h"
+
+int main(void)
+{
+ int number_failed;
+
+ Suite *s1 = system_suite();
+ Suite *s2 = misc_suite();
+ Suite *s3 = sysutils_suite();
+ Suite *s4 = fileio_suite();
+
+ SRunner *sr = srunner_create(s1);
+ srunner_add_suite(sr, s2);
+ srunner_add_suite(sr, s3);
+ srunner_add_suite(sr, s4);
+
+ srunner_run_all(sr, CK_NORMAL);
+ number_failed = srunner_ntests_failed(sr);
+ srunner_free(sr);
+ return (number_failed == 0) ? EXIT_SUCCESS : EXIT_FAILURE;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/tests/check_check.h Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,9 @@
+#ifndef _CHECK_CHECK_H_
+#define _CHECK_CHECK_H_
+
+Suite *system_suite();
+Suite *misc_suite();
+Suite *sysutils_suite();
+Suite *fileio_suite();
+
+#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/tests/check_fileio.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,103 @@
+#include <check.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include "check_check.h"
+#include "../src/fpcrtl.h"
+
+typedef struct __TResourceList
+{
+ Integer count;
+ string255 files[500 + 1];
+} TResourceList;
+
+string255 t = STRINIT("test");
+string255 Pathz[1] =
+{ STRINIT("../../") };
+int ptCurrTheme = 0;
+string255 cThemeCFGFilename = STRINIT("theme.cfg");
+const string255 __str79 = STRINIT("object");
+string255 c1 = STRINIT("=");
+string255 c2 = STRINIT("\x2c");
+string255 c3 = STRINIT("\x2f");
+
+static string255 make_string(const char* str)
+{
+ string255 s;
+ s.len = strlen(str);
+ memcpy(s.str, str, s.len + 1);
+ return s;
+}
+
+TResourceList readThemeCfg_0()
+{
+ TResourceList readthemecfg_result;
+ string255 s;
+ string255 key;
+ TextFile f;
+ Integer i;
+ TResourceList res;
+
+ s = _strconcat(_strappend(Pathz[ptCurrTheme], '\x2f'), cThemeCFGFilename);
+ //umisc_log(s);
+
+ fpcrtl_assign(f, s);
+
+ FileMode = 0;
+ fpcrtl_reset(f);
+
+ res.count = 0;
+ while (!(fpcrtl_eof(f)))
+ {
+ fpcrtl_readLnS(f, s);
+ if ((fpcrtl_Length(s)) == (0))
+ {
+ continue;
+ }
+ if ((s.s[1]) == ('\x3b'))
+ {
+ continue;
+ }
+ i = fpcrtl_pos('\x3d', s);
+ key = fpcrtl_trim(fpcrtl_copy(s, 1, i - 1));
+ fpcrtl_delete(s, 1, i);
+ if (_strcompare(key, __str79))
+ {
+ i = fpcrtl_pos('\x2c', s);
+ res.files[res.count] = _strconcat(
+ _strappend(Pathz[ptCurrTheme], '\x2f'),
+ fpcrtl_trim(fpcrtl_copy(s, 1, i - 1)));
+ ++res.count;
+ //umisc_log(fpcrtl_trim(fpcrtl_copy(s, 1, i - 1)));
+ }
+ }
+ fpcrtl_close(f);
+ readthemecfg_result = res;
+ return readthemecfg_result;
+}
+
+START_TEST(test_readthemecfg)
+ {
+ int i;
+ TResourceList result;
+
+ printf("-----Entering test readthemecfg-----\n");
+ result = readThemeCfg_0();
+ for (i = 0; i < result.count; i++)
+ {
+ printf("%s\n", result.files[i].str);
+ }
+ printf("-----Leaving test readthemecfg-----\n");
+ }END_TEST
+
+Suite* fileio_suite(void)
+{
+ Suite *s = suite_create("fileio");
+
+ TCase *tc_core = tcase_create("Core");
+
+ tcase_add_test(tc_core, test_readthemecfg);
+
+ suite_add_tcase(s, tc_core);
+
+ return s;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/tests/check_misc.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,88 @@
+#include <check.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include "check_check.h"
+#include "../src/misc.h"
+
+static string255 make_string(const char* str)
+{
+ string255 s;
+ s.len = strlen(str);
+ memcpy(s.str, str, s.len + 1);
+ return s;
+}
+
+START_TEST(test_strconcat)
+{
+ string255 t;
+ t = fpcrtl_strconcat(make_string(""), make_string(""));
+ fail_if(strcmp(t.str, ""), "strconcat(\"\", \"\")");
+
+ t = fpcrtl_strconcat(make_string(""), make_string("a"));
+ fail_if(strcmp(t.str, "a"), "strconcat(\"\", \"a\")");
+
+ t = fpcrtl_strconcat(make_string("a"), make_string(""));
+ fail_if(strcmp(t.str, "a"), "strconcat(\"a\", \"\")");
+
+ t = fpcrtl_strconcat(make_string("ab"), make_string(""));
+ fail_if(strcmp(t.str, "ab"), "strconcat(\"ab\", \"\")");
+
+ t = fpcrtl_strconcat(make_string("ab"), make_string("cd"));
+ fail_if(strcmp(t.str, "abcd"), "strconcat(\"ab\", \"cd\")");
+}
+END_TEST
+
+START_TEST (test_strappend)
+{
+ string255 t;
+
+ t = fpcrtl_strappend(make_string(""), 'c');
+ fail_if(strcmp(t.str, "c"), "strappend(\"\", 'c')");
+
+ t = fpcrtl_strappend(make_string("ab"), 'c');
+ fail_if(strcmp(t.str, "abc"), "strappend(\"ab\", 'c')");
+}
+END_TEST
+
+START_TEST (test_strprepend)
+{
+ string255 t;
+
+ t = fpcrtl_strprepend('c', make_string(""));
+ fail_if(strcmp(t.str, "c"), "strprepend('c', \"\")");
+
+ t = fpcrtl_strprepend('c', make_string("ab"));
+ fail_if(strcmp(t.str, "cab"), "strprepend('c', \"ab\")");
+}
+END_TEST
+
+START_TEST (test_strcompare)
+{
+ fail_unless(fpcrtl_strcompare(make_string(""), make_string("")), "strcompare(\"\", \"\")");
+ fail_unless(fpcrtl_strcompare(make_string("a"), make_string("a")), "strcompare(\"a\", \"a\"");
+ fail_unless(!fpcrtl_strcompare(make_string("a"), make_string("b")), "strcompare(\"a\", \"b\")");
+ fail_unless(!fpcrtl_strcompare(make_string("a"), make_string("ab")), "strcompare(\"a\", \"ab\")");
+
+ fail_unless(fpcrtl_strcomparec(make_string(" "), ' '), "strcomparec(\" \", ' ')");
+ fail_unless(fpcrtl_strcomparec(make_string("a"), 'a'), "strcomparec(\"a\", 'a')");
+ fail_unless(!fpcrtl_strcomparec(make_string(" "), ' '), "strcomparec(\" \", ' '");
+ fail_unless(!fpcrtl_strcomparec(make_string(""), ' '), "strcomparec(\"\", ' ')");
+
+}
+END_TEST
+
+Suite* misc_suite(void)
+{
+ Suite *s = suite_create("misc");
+
+ TCase *tc_core = tcase_create("Core");
+
+ tcase_add_test(tc_core, test_strconcat);
+ tcase_add_test(tc_core, test_strappend);
+ tcase_add_test(tc_core, test_strprepend);
+ tcase_add_test(tc_core, test_strcompare);
+
+ suite_add_tcase(s, tc_core);
+
+ return s;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/tests/check_system.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,251 @@
+#include <check.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include "check_check.h"
+#include "../src/system.h"
+
+void check_string(string255 str)
+{
+ fail_unless(strlen(str.str) == str.len, "String internal inconsistency error");
+}
+
+static string255 make_string(const char* str)
+{
+ string255 s;
+ s.len = strlen(str);
+ memcpy(s.str, str, s.len + 1);
+ return s;
+}
+
+START_TEST (test_copy)
+ {
+ string255 s = STRINIT("1234567");
+ string255 t;
+
+ t = fpcrtl_copy(s, 1, 1);
+ fail_if(strcmp(t.str, "1"), "Test copy fail 1");
+
+ t = fpcrtl_copy(s, 7, 1);
+ fail_if(strcmp(t.str, "7"), "Test copy fail 2");
+
+ t = fpcrtl_copy(s, 8, 1);
+ fail_if(t.len != 0, "Test copy fail 3");
+
+ t = fpcrtl_copy(s, 8, 100);
+ fail_if(t.len != 0, "Test copy fail 4");
+ check_string(t);
+
+ t = fpcrtl_copy(s, 0, 100);
+ fail_if(strcmp(t.str, "1234567"), "Test copy fail 5");
+
+ t = fpcrtl_copy(s, 0, 5);
+ fail_if(strcmp(t.str, "12345"), "Test copy fail 6");
+
+ t = fpcrtl_copy(s, 4, 100);
+ fail_if(strcmp(t.str, "4567"), "Test copy fail 7");
+
+ t = fpcrtl_copy(s, 4, 2);
+ fail_if(strcmp(t.str, "45"), "Test copy fail 8");
+ }END_TEST
+
+START_TEST (test_delete)
+ {
+ string255 s = STRINIT("1234567");
+ string255 s2 = STRINIT("1234567");
+ string255 s3 = STRINIT("1234567");
+
+ fpcrtl_delete(s, 0, 10);
+ fail_if(strcmp(s.str, "1234567"), "delete(\"1234567\", 0, 10)");
+ check_string(s);
+
+ fpcrtl_delete(s, 1, 1);
+ fail_if(strcmp(s.str, "234567"), "delete(\"1234567\", 1, 1)");
+ check_string(s);
+
+ fpcrtl_delete(s, 1, 100);
+ fail_if(strcmp(s.str, ""), "delete(\"234567\", 1, 100)");
+ check_string(s);
+
+ fpcrtl_delete(s2, 3, 2);
+ fail_if(strcmp(s2.str, "12567"), "delete(\"1234567\", 3, 2)");
+ check_string(s2);
+
+ fpcrtl_delete(s3, 3, 100);
+ fail_if(strcmp(s3.str, "12"), "delete(\"1234567\", 3, 100)");
+ check_string(s3);
+
+ }
+END_TEST
+
+START_TEST (test_FloatToStr)
+ {
+ double s = 1.2345;
+ string255 t = fpcrtl_floatToStr(s);
+ printf("-----Entering test floatToStr-----\n");
+ printf("FloatToStr(%f) = %s\n", s, t.str);
+ printf("-----Leaving test floatToStr-----\n");
+ }
+END_TEST
+
+START_TEST (test_random)
+ {
+ fpcrtl_randomize();
+ printf("-----Entering test random-----\n");
+ printf("random(5000) = %d\n", fpcrtl_random(5000));
+ printf("random(1) = %d\n", fpcrtl_random(1));
+ printf("random(2) = %d\n", fpcrtl_random(2));
+ printf("-----Leaving test random-----\n");
+
+ }
+END_TEST
+
+START_TEST (test_posS)
+ {
+ string255 substr1 = STRINIT("123");
+ string255 str1 = STRINIT("12345");
+
+ string255 substr2 = STRINIT("45");
+ string255 str2 = STRINIT("12345");
+
+ string255 substr3 = STRINIT("");
+ string255 str3 = STRINIT("12345");
+
+ string255 substr4 = STRINIT("123");
+ string255 str4 = STRINIT("");
+
+ string255 substr5 = STRINIT("123");
+ string255 str5 = STRINIT("456");
+
+ fail_unless(fpcrtl_posS(substr1, str1) == 1, "pos(123, 12345)");
+ fail_unless(fpcrtl_posS(substr2, str2) == 4, "pos(45, 12345)");
+ fail_unless(fpcrtl_posS(substr3, str3) == 0, "pos(, 12345)");
+ fail_unless(fpcrtl_posS(substr4, str4) == 0, "pos(123, )");
+ fail_unless(fpcrtl_posS(substr5, str5) == 0, "pos(123, 456)");
+ }
+END_TEST
+
+START_TEST (test_trunc)
+ {
+ fail_unless(fpcrtl_trunc(123.456) == 123, "trunc(123.456)");
+ fail_unless(fpcrtl_trunc(-123.456) == -123, "trunc(-123.456)");
+ fail_unless(fpcrtl_trunc(12.3456) == 12, "trunc(12.3456)");
+ fail_unless(fpcrtl_trunc(-12.3456) == -12, "trunc(-12.3456)");
+ }
+END_TEST
+
+START_TEST (test_odd)
+{
+ fail_unless(fpcrtl_odd(123) != 0, "odd(123)");
+ fail_unless(fpcrtl_odd(124) == 0, "odd(124)");
+ fail_unless(fpcrtl_odd(0) == 0, "odd(0)");
+ fail_unless(fpcrtl_odd(-1) != 0, "odd(-1)");
+ fail_unless(fpcrtl_odd(-2) == 0, "odd(-2)");
+}
+END_TEST
+
+START_TEST (test_sqr)
+{
+ fail_unless(fpcrtl_sqr(0) == 0, "sqr(0)");
+ fail_unless(fpcrtl_sqr(5) == 25, "sqr(5)");
+ fail_unless(fpcrtl_sqr(-5) == 25, "sqr(-5)");
+}
+END_TEST
+
+START_TEST (test_lowercase)
+{
+ string255 s1 = STRINIT("");
+ string255 s2 = STRINIT("a");
+ string255 s3 = STRINIT("abc");
+ string255 t;
+
+ t = fpcrtl_lowerCase(make_string(""));
+ fail_if(strcmp(t.str, s1.str), "lowerCase(\"\")");
+
+ t = fpcrtl_lowerCase(make_string("a"));
+ fail_if(strcmp(t.str, s2.str), "lowerCase(\"a\")");
+
+ t = fpcrtl_lowerCase(make_string("A"));
+ fail_if(strcmp(t.str, s2.str), "lowerCase(\"A\")");
+
+ t = fpcrtl_lowerCase(make_string("AbC"));
+ fail_if(strcmp(t.str, s3.str), "lowerCase(\"AbC\")");
+
+ t = fpcrtl_lowerCase(make_string("abc"));
+ fail_if(strcmp(t.str, s3.str), "lowerCase(\"abc\")");
+}
+END_TEST
+
+START_TEST (test_str)
+{
+ int8_t a1 = -8;
+ uint8_t a2 = 8;
+ int16_t a3 = -13;
+ uint16_t a4 = 13;
+ int32_t a5 = -19;
+ uint32_t a6 = 22;
+ int64_t a7 = -199999999999999;
+ uint64_t a8 = 200000000000000;
+
+ float a9 = 12345.6789;
+ double a10 = -9876.54321;
+
+ string255 s;
+
+ printf("-----Entering test str-----\n");
+
+ fpcrtl_str(a1, s);
+ printf("%d == %s\n", a1, s.str);
+
+ fpcrtl_str(a2, s);
+ printf("%u == %s\n", a2, s.str);
+
+ fpcrtl_str(a3, s);
+ printf("%d == %s\n", a3, s.str);
+
+ fpcrtl_str(a4, s);
+ printf("%u == %s\n", a4, s.str);
+
+ fpcrtl_str(a5, s);
+ printf("%d == %s\n", a5, s.str);
+
+ fpcrtl_str(a6, s);
+ printf("%u == %s\n", a6, s.str);
+
+ fpcrtl_str(a7, s);
+ printf("%lld == %s\n", a7, s.str);
+
+ fpcrtl_str(a8, s);
+ printf("%llu == %s\n", a8, s.str);
+
+ fpcrtl_str(a9, s);
+ printf("%f == %s\n", a9, s.str);
+
+ fpcrtl_str(a10, s);
+ printf("%f == %s\n", a10, s.str);
+
+ printf("-----Leaving test str------\n");
+}
+END_TEST
+
+Suite* system_suite(void)
+{
+ Suite *s = suite_create("system");
+
+ TCase *tc_core = tcase_create("Core");
+
+ tcase_add_test(tc_core, test_copy);
+ tcase_add_test(tc_core, test_FloatToStr);
+ tcase_add_test(tc_core, test_random);
+ tcase_add_test(tc_core, test_posS);
+ tcase_add_test(tc_core, test_trunc);
+ tcase_add_test(tc_core, test_delete);
+ tcase_add_test(tc_core, test_odd);
+ tcase_add_test(tc_core, test_sqr);
+ tcase_add_test(tc_core, test_lowercase);
+ tcase_add_test(tc_core, test_str);
+
+ suite_add_tcase(s, tc_core);
+
+ return s;
+}
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/tests/check_sysutils.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,80 @@
+#include <check.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include "check_check.h"
+#include "../src/sysutils.h"
+
+static string255 make_string(const char* str)
+{
+ string255 s;
+ s.len = strlen(str);
+ memcpy(s.str, str, s.len + 1);
+ return s;
+}
+
+static int is_string_equal(string255 s1, string255 s2)
+{
+ return (s1.len == s2.len) && (strcmp(s1.str, s2.str) == 0);
+}
+
+START_TEST (test_trim)
+{
+ string255 t;
+
+ t = fpcrtl_trim(make_string(""));
+ fail_if(strcmp(t.str, ""), "trim(\"\")");
+
+ t = fpcrtl_trim(make_string("ab"));
+ fail_if(strcmp(t.str, "ab"), "trim(\"ab\")");
+
+ t = fpcrtl_trim(make_string(" "));
+ fail_if(strcmp(t.str, ""), "trim(\" \")");
+
+ t = fpcrtl_trim(make_string(" "));
+ fail_if(strcmp(t.str, ""), "trim(\" \")");
+
+ t = fpcrtl_trim(make_string(" ab"));
+ fail_if(strcmp(t.str, "ab"), "trim(\" ab\")");
+
+ t = fpcrtl_trim(make_string("ab "));
+ fail_if(strcmp(t.str, "ab"), "trim(\"ab \")");
+
+ t = fpcrtl_trim(make_string(" ab "));
+ fail_if(strcmp(t.str, "ab"), "trim(\" ab \")");
+
+}
+END_TEST
+
+START_TEST (test_strToInt)
+{
+ fail_unless(fpcrtl_strToInt(make_string("123")) == 123, "strToInt(\"123\")");
+ fail_unless(fpcrtl_strToInt(make_string("0")) == 0, "strToInt(\"0\")");
+ fail_unless(fpcrtl_strToInt(make_string("-123")) == -123, "strToInt(\"-123\")");
+}
+END_TEST
+
+START_TEST (test_extractFileName)
+{
+ fail_unless(is_string_equal(fpcrtl_extractFileName(make_string("abc")), make_string("abc")), "extractFileName(\"abc\")");
+ fail_unless(is_string_equal(fpcrtl_extractFileName(make_string("a:abc")), make_string("abc")), "extractFileName(\"a:abc\")");
+ fail_unless(is_string_equal(fpcrtl_extractFileName(make_string("/abc")), make_string("abc")), "extractFileName(\"/abc\")");
+ fail_unless(is_string_equal(fpcrtl_extractFileName(make_string("\\abc")), make_string("abc")), "extractFileName(\"\\abc\")");
+ fail_unless(is_string_equal(fpcrtl_extractFileName(make_string("/usr/bin/abc")), make_string("abc")), "extractFileName(\"/usr/bin/abc\")");
+ fail_unless(is_string_equal(fpcrtl_extractFileName(make_string("c:\\def\\abc")), make_string("abc")), "extractFileName(\"c:\\def\\abc\")");
+}
+END_TEST
+
+Suite* sysutils_suite(void)
+{
+ Suite *s = suite_create("sysutils");
+
+ TCase *tc_core = tcase_create("Core");
+
+ tcase_add_test(tc_core, test_trim);
+ tcase_add_test(tc_core, test_strToInt);
+ tcase_add_test(tc_core, test_extractFileName);
+
+ suite_add_tcase(s, tc_core);
+
+ return s;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/tests/fileio_test.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,59 @@
+
+#include "pas2c.h"
+
+#include "fpcrtl.h"
+
+char Pathz[1][128] = {"./"};
+int ptCurrTheme = 0;
+cThemeCFGFilename = "theme.cfg";
+const string255 __str79 = STRINIT("object");
+
+typedef struct __TResourceList {
+ Integer count;
+ string255 files[500 + 1];
+} TResourceList;
+
+TResourceList readThemeCfg_0()
+{
+ TResourceList readthemecfg_result;
+ string255 s;
+ string255 key;
+ TextFile f;
+ Integer i;
+ TResourceList result;
+ s = _strconcat(_strappend(Pathz[ptCurrTheme], '\x2f'), cThemeCFGFilename);
+
+ assign(f, s);
+ FileMode = 0;
+ reset(f);
+ result.count = 0;
+ while(!eof(f))
+ {
+ readLnS(f, s);
+ if((Length(s)) == (0))
+ {
+ continue;
+ }
+ if((s.s[1]) == ('\x3b'))
+ {
+ continue;
+ }
+ i = pos('\x3d', s);
+ key = trim(copy(s, 1, i - 1));
+ delete(s, 1, i);
+ if(_strcompare(key, __str79))
+ {
+ i = pos('\x2c', s);
+ result.files[result.count] = _strconcat(_strappend(Pathz[ptCurrTheme], '\x2f'), trim(copy(s, 1, i - 1)));
+ ++result.count;
+ }
+ }
+ close(f);
+ readthemecfg_result = result;
+ return readthemecfg_result;
+};
+
+int main(int argc, char** argv)
+{
+ readThemeCfg_0();
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/project_files/hwc/rtl/tests/main.c Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,84 @@
+
+//#include <stdio.h>
+//#include "fpcrtl.h"
+//#include "fileio.h"
+//
+//string255 t = STRINIT("test");
+//string255 Pathz[1] = {STRINIT(".")};
+////int ptCurrTheme = 0;
+//string255 cThemeCFGFilename = STRINIT("theme.cfg");
+//const string255 __str79 = STRINIT("object");
+//string255 c1 = STRINIT("=");
+//string255 c2 = STRINIT("\x2c");
+//string255 c3 = STRINIT("\x2f");
+//
+//typedef struct __TResourceList {
+// Integer count;
+// string255 files[500 + 1];
+//} TResourceList;
+//
+//TResourceList readThemeCfg_0()
+//{
+// TResourceList readthemecfg_result;
+// string255 s;
+// string255 key;
+// TextFile f;
+// Integer i;
+// TResourceList result;
+//
+// int t = 0;
+//
+// s = _strconcat(_strappend(Pathz[ptCurrTheme], '\x2f'), cThemeCFGFilename);
+//
+// assign(&f, s);
+//
+// reset(&f);
+//
+// if(f.fp == NULL){
+// readthemecfg_result.count = 0;
+// return readthemecfg_result;
+// }
+//
+// result.count = 0;
+// while(!eof(&f))
+// {
+// readLnS(&f, &s);
+//
+// if((Length(s)) == (0))
+// {
+// continue;
+// }
+// if((s.s[1]) == ('\x3b'))
+// {
+// continue;
+// }
+//
+// i = pos(c1, s);
+//
+// key = fpcrtl_trim(fpcrtl_copy(s, 1, i - 1));
+//
+// fpcrtl_delete(&s, 1, i);
+//
+// if(_strcompare(key, __str79))
+// {
+// i = pos(c2, s);
+// result.files[result.count] = _strconcat(_strappend(Pathz[ptCurrTheme], '\x2f'), trim(copy(s, 1, i - 1)));
+// ++result.count;
+// }
+// }
+//
+// close(&f);
+// readthemecfg_result = result;
+// return readthemecfg_result;
+//}
+//
+int main(int argc, char** argv)
+{
+ int i;
+
+// TResourceList result = readThemeCfg_0();
+// for(i = 0; i < result.count; i++){
+// printf("%s\n", result.files[i].str);
+// }
+
+}
--- a/share/hedgewars/Data/CMakeLists.txt Sun Jan 27 00:01:26 2013 +0100
+++ b/share/hedgewars/Data/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -1,3 +1,7 @@
foreach(dir "Fonts" "Forts" "Graphics" "Locale" "Maps" "Music" "Sounds" "Themes" "Missions" "Names" "misc" "Scripts")
- add_subdirectory(${dir})
+ add_subdirectory(${dir})
endforeach(dir)
+
+if(${GL2})
+ add_subdirectory(Shaders)
+endif(${GL2})
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/share/hedgewars/Data/Shaders/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,7 @@
+file(GLOB vertshaders *.vs)
+file(GLOB fragshaders *.fs)
+
+install(FILES
+ ${vertshaders}
+ ${fragshaders}
+ DESTINATION ${SHAREPATH}Data/Shaders)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/share/hedgewars/Data/Shaders/default.fs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,15 @@
+uniform sampler2D tex0;
+uniform vec4 tint;
+uniform bool enableTexture;
+
+varying vec2 tex;
+
+
+void main()
+{
+ if(enableTexture){
+ gl_FragColor = texture2D(tex0, tex) * tint;
+ }else{
+ gl_FragColor = tint;
+ }
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/share/hedgewars/Data/Shaders/default.vs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,16 @@
+
+
+attribute vec2 vertex;
+attribute vec2 texcoord;
+attribute vec4 colors;
+
+varying vec2 tex;
+
+uniform mat4 mvp;
+
+void main()
+{
+ vec4 p = mvp * vec4(vertex, 0.0, 1.0);
+ gl_Position = p;
+ tex = texcoord;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/share/hedgewars/Data/Shaders/water.fs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,8 @@
+
+varying vec4 vcolor;
+
+
+void main()
+{
+ gl_FragColor = vcolor;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/share/hedgewars/Data/Shaders/water.vs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,15 @@
+
+
+attribute vec2 vertex;
+attribute vec4 color;
+
+varying vec4 vcolor;
+
+uniform mat4 mvp;
+
+void main()
+{
+ vec4 p = mvp * vec4(vertex, 0.0, 1.0);
+ gl_Position = p;
+ vcolor = color;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/share/hedgewars/Data/misc/hwengine.desktop Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,26 @@
+[Desktop Entry]
+Type=Application
+Version=1.0
+Encoding=UTF-8
+Name=Hedgewars Engine
+GenericName=Hedgewars engine, for playback of saves and demos
+GenericName[de]=Hedgewars engine, für die Wiedergabe von gespeicherten Spielen und Demos
+GenericName[es]=Motor del juego Hedgewars, reproduce demos y partidas guardadas
+GenericName[fr]=Moteur graphique d'Hedgewars, pour revoir les parties enregistrées et de démonstration.
+GenericName[it]=Motore grafico di Hedgewars, riproduce le demo e riprende le partite salvate
+GenericName[ko]=헤즈와즈 게임 엔진, 데모 와 저장한 게임을 재생함
+GenericName[pl]=Silnik gry Hedgewars do odtwarzania dem i zapisów gier
+GenericName[pt]=Motor de jogo Hedgewars, para reprodução de jogos guardados e demos
+GenericName[ru]=Движок Hedgewars для проигрывания сохранённых игр и демок
+GenericName[sk]=Engine hry Hedgewars, pre prehrávanie uložených hier a demo súborov
+GenericName[cs]=Engine hry Hedgewars pro přehrávání uložených her a ukázkových souborů
+GenericName[sv]=Hedgewarsmotorn, för att öppna demo- och sparfiler
+GenericName[da]=Kæmpende Pindsvin
+Icon=hedgewars.png
+Exec=/usr/local/bin/hwengine /usr/local/share//hedgewars/Data %f
+Path=/tmp
+Terminal=false
+StartupNotify=false
+NoDisplay=true
+Categories=Application;Game;StrategyGame;
+MimeType=application/x-hedgewars-demo;application/x-hedgewars-save
--- a/tools/PascalBasics.hs Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,70 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-module PascalBasics where
-
-import Text.Parsec.Combinator
-import Text.Parsec.Char
-import Text.Parsec.Prim
-import Text.Parsec.Token
-import Text.Parsec.Language
-import Data.Char
-
-builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"]
-
-pascalLanguageDef
- = emptyDef
- { commentStart = "(*"
- , commentEnd = "*)"
- , commentLine = "//"
- , nestedComments = False
- , identStart = letter <|> oneOf "_"
- , identLetter = alphaNum <|> oneOf "_"
- , reservedNames = [
- "begin", "end", "program", "unit", "interface"
- , "implementation", "and", "or", "xor", "shl"
- , "shr", "while", "do", "repeat", "until", "case", "of"
- , "type", "var", "const", "out", "array", "packed"
- , "procedure", "function", "with", "for", "to"
- , "downto", "div", "mod", "record", "set", "nil"
- , "cdecl", "external", "if", "then", "else"
- ] -- ++ builtin
- , reservedOpNames= []
- , caseSensitive = False
- }
-
-preprocessorSwitch :: Stream s m Char => ParsecT s u m String
-preprocessorSwitch = do
- try $ string "{$"
- s <- manyTill (noneOf "\n") $ char '}'
- return s
-
-caseInsensitiveString s = do
- mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s
- return s
-
-pas = patch $ makeTokenParser pascalLanguageDef
- where
- patch tp = tp {stringLiteral = stringL}
-
-comment = choice [
- char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}')
- , (try $ string "(*") >> manyTill anyChar (try $ string "*)")
- , (try $ string "//") >> manyTill anyChar (try newline)
- ]
-
-comments = do
- spaces
- skipMany $ do
- preprocessorSwitch <|> comment
- spaces
-
-stringL = do
- (char '\'')
- s <- (many $ noneOf "'")
- (char '\'')
- ss <- many $ do
- (char '\'')
- s' <- (many $ noneOf "'")
- (char '\'')
- return $ '\'' : s'
- comments
- return $ concat (s:ss)
--- a/tools/PascalParser.hs Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,659 +0,0 @@
-module PascalParser where
-
-import Text.Parsec
-import Text.Parsec.Char
-import Text.Parsec.Token
-import Text.Parsec.Language
-import Text.Parsec.Expr
-import Text.Parsec.Prim
-import Text.Parsec.Combinator
-import Text.Parsec.String
-import Control.Monad
-import Data.Maybe
-import Data.Char
-
-import PascalBasics
-import PascalUnitSyntaxTree
-
-knownTypes = ["shortstring", "ansistring", "char", "byte"]
-
-pascalUnit = do
- comments
- u <- choice [program, unit, systemUnit, redoUnit]
- comments
- return u
-
-iD = do
- i <- liftM (flip Identifier BTUnknown) (identifier pas)
- comments
- return i
-
-unit = do
- string "unit" >> comments
- name <- iD
- semi pas
- comments
- int <- interface
- impl <- implementation
- comments
- return $ Unit name int impl Nothing Nothing
-
-
-reference = buildExpressionParser table term <?> "reference"
- where
- term = comments >> choice [
- parens pas (liftM RefExpression expression >>= postfixes) >>= postfixes
- , try $ typeCast >>= postfixes
- , char '@' >> liftM Address reference >>= postfixes
- , liftM SimpleReference iD >>= postfixes
- ] <?> "simple reference"
-
- table = [
- ]
-
- postfixes r = many postfix >>= return . foldl (flip ($)) r
- postfix = choice [
- parens pas (option [] parameters) >>= return . FunCall
- , char '^' >> return Dereference
- , (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement
- , (char '.' >> notFollowedBy (char '.')) >> liftM (flip RecordField) reference
- ]
-
- typeCast = do
- t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
- e <- parens pas expression
- comments
- return $ TypeCast (Identifier t BTUnknown) e
-
-varsDecl1 = varsParser sepEndBy1
-varsDecl = varsParser sepEndBy
-varsParser m endsWithSemi = do
- vs <- m (aVarDecl endsWithSemi) (semi pas)
- return vs
-
-aVarDecl endsWithSemi = do
- isVar <- liftM (== Just "var") $
- if not endsWithSemi then
- optionMaybe $ choice [
- try $ string "var"
- , try $ string "const"
- , try $ string "out"
- ]
- else
- return Nothing
- comments
- ids <- do
- i <- (commaSep1 pas) $ (try iD <?> "variable declaration")
- char ':'
- return i
- comments
- t <- typeDecl <?> "variable type declaration"
- comments
- init <- option Nothing $ do
- char '='
- comments
- e <- initExpression
- comments
- return (Just e)
- return $ VarDeclaration isVar False (ids, t) init
-
-
-constsDecl = do
- vs <- many1 (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i)
- comments
- return vs
- where
- aConstDecl = do
- comments
- i <- iD
- t <- optionMaybe $ do
- char ':'
- comments
- t <- typeDecl
- comments
- return t
- char '='
- comments
- e <- initExpression
- comments
- return $ VarDeclaration False (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e)
-
-typeDecl = choice [
- char '^' >> typeDecl >>= return . PointerTo
- , try (string "shortstring") >> return (String 255)
- , try (string "string") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
- , try (string "ansistring") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
- , arrayDecl
- , recordDecl
- , setDecl
- , functionType
- , sequenceDecl >>= return . Sequence
- , try iD >>= return . SimpleType
- , rangeDecl >>= return . RangeType
- ] <?> "type declaration"
- where
- arrayDecl = do
- try $ do
- optional $ (try $ string "packed") >> comments
- string "array"
- comments
- r <- option [] $ do
- char '['
- r <- commaSep pas rangeDecl
- char ']'
- comments
- return r
- string "of"
- comments
- t <- typeDecl
- if null r then
- return $ ArrayDecl Nothing t
- else
- return $ foldr (\a b -> ArrayDecl (Just a) b) (ArrayDecl (Just $ head r) t) (tail r)
- recordDecl = do
- try $ do
- optional $ (try $ string "packed") >> comments
- string "record"
- comments
- vs <- varsDecl True
- union <- optionMaybe $ do
- string "case"
- comments
- iD
- comments
- string "of"
- comments
- many unionCase
- string "end"
- return $ RecordType vs union
- setDecl = do
- try $ string "set" >> space
- comments
- string "of"
- comments
- liftM Set typeDecl
- unionCase = do
- try $ commaSep pas $ (iD >> return ()) <|> (integer pas >> return ())
- char ':'
- comments
- u <- parens pas $ varsDecl True
- char ';'
- comments
- return u
- sequenceDecl = (parens pas) $ (commaSep pas) (iD >>= \i -> optional (spaces >> char '=' >> spaces >> integer pas) >> return i)
- functionType = do
- fp <- try (string "function") <|> try (string "procedure")
- comments
- vs <- option [] $ parens pas $ varsDecl False
- comments
- ret <- if (fp == "function") then do
- char ':'
- comments
- ret <- typeDecl
- comments
- return ret
- else
- return VoidType
- optional $ try $ char ';' >> comments >> string "cdecl"
- comments
- return $ FunctionType ret vs
-
-typesDecl = many (aTypeDecl >>= \t -> comments >> return t)
- where
- aTypeDecl = do
- i <- try $ do
- i <- iD <?> "type declaration"
- comments
- char '='
- return i
- comments
- t <- typeDecl
- comments
- semi pas
- comments
- return $ TypeDeclaration i t
-
-rangeDecl = choice [
- try $ rangeft
- , iD >>= return . Range
- ] <?> "range declaration"
- where
- rangeft = do
- e1 <- initExpression
- string ".."
- e2 <- initExpression
- return $ RangeFromTo e1 e2
-
-typeVarDeclaration isImpl = (liftM concat . many . choice) [
- varSection,
- constSection,
- typeSection,
- funcDecl,
- operatorDecl
- ]
- where
- varSection = do
- try $ string "var"
- comments
- v <- varsDecl1 True <?> "variable declaration"
- comments
- return v
-
- constSection = do
- try $ string "const"
- comments
- c <- constsDecl <?> "const declaration"
- comments
- return c
-
- typeSection = do
- try $ string "type"
- comments
- t <- typesDecl <?> "type declaration"
- comments
- return t
-
- operatorDecl = do
- try $ string "operator"
- comments
- i <- manyTill anyChar space
- comments
- vs <- parens pas $ varsDecl False
- comments
- rid <- iD
- comments
- char ':'
- comments
- ret <- typeDecl
- comments
- return ret
- char ';'
- comments
- forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
- inline <- liftM (any (== "inline;")) $ many functionDecorator
- b <- if isImpl && (not forward) then
- liftM Just functionBody
- else
- return Nothing
- return $ [OperatorDeclaration i rid inline ret vs b]
-
-
- funcDecl = do
- fp <- try (string "function") <|> try (string "procedure")
- comments
- i <- iD
- vs <- option [] $ parens pas $ varsDecl False
- comments
- ret <- if (fp == "function") then do
- char ':'
- comments
- ret <- typeDecl
- comments
- return ret
- else
- return VoidType
- char ';'
- comments
- forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
- inline <- liftM (any (== "inline;")) $ many functionDecorator
- b <- if isImpl && (not forward) then
- liftM Just functionBody
- else
- return Nothing
- return $ [FunctionDeclaration i inline ret vs b]
-
- functionDecorator = do
- d <- choice [
- try $ string "inline;"
- , try $ caseInsensitiveString "cdecl;"
- , try $ string "overload;"
- , try $ string "export;"
- , try $ string "varargs;"
- , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
- ]
- comments
- return d
-
-
-program = do
- string "program"
- comments
- name <- iD
- (char ';')
- comments
- comments
- u <- uses
- comments
- tv <- typeVarDeclaration True
- comments
- p <- phrase
- comments
- char '.'
- comments
- return $ Program name (Implementation u (TypesAndVars tv)) p
-
-interface = do
- string "interface"
- comments
- u <- uses
- comments
- tv <- typeVarDeclaration False
- comments
- return $ Interface u (TypesAndVars tv)
-
-implementation = do
- string "implementation"
- comments
- u <- uses
- comments
- tv <- typeVarDeclaration True
- string "end."
- comments
- return $ Implementation u (TypesAndVars tv)
-
-expression = do
- buildExpressionParser table term <?> "expression"
- where
- term = comments >> choice [
- builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n BTUnknown))
- , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e)
- , brackets pas (commaSep pas iD) >>= return . SetExpression
- , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
- , float pas >>= return . FloatLiteral . show
- , try $ integer pas >>= return . NumberLiteral . show
- , try (string "_S" >> stringLiteral pas) >>= return . StringLiteral
- , try (string "_P" >> stringLiteral pas) >>= return . PCharLiteral
- , stringLiteral pas >>= return . strOrChar
- , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c)
- , char '#' >> many digit >>= \c -> comments >> return (CharCode c)
- , char '$' >> many hexDigit >>= \h -> comments >> return (HexNumber h)
- --, char '-' >> expression >>= return . PrefixOp "-"
- , char '-' >> reference >>= return . PrefixOp "-" . Reference
- , (try $ string "not" >> notFollowedBy comments) >> unexpected "'not'"
- , try $ string "nil" >> return Null
- , reference >>= return . Reference
- ] <?> "simple expression"
-
- table = [
- [ Prefix (try (string "not") >> return (PrefixOp "not"))
- , Prefix (try (char '-') >> return (PrefixOp "-"))]
- ,
- [ Infix (char '*' >> return (BinOp "*")) AssocLeft
- , Infix (char '/' >> return (BinOp "/")) AssocLeft
- , Infix (try (string "div") >> return (BinOp "div")) AssocLeft
- , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft
- , Infix (try (string "in") >> return (BinOp "in")) AssocNone
- , Infix (try $ string "and" >> return (BinOp "and")) AssocLeft
- , Infix (try $ string "shl" >> return (BinOp "shl")) AssocLeft
- , Infix (try $ string "shr" >> return (BinOp "shr")) AssocLeft
- ]
- , [ Infix (char '+' >> return (BinOp "+")) AssocLeft
- , Infix (char '-' >> return (BinOp "-")) AssocLeft
- , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
- , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
- ]
- , [ Infix (try (string "<>") >> return (BinOp "<>")) AssocNone
- , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone
- , Infix (try (string ">=") >> return (BinOp ">=")) AssocNone
- , Infix (char '<' >> return (BinOp "<")) AssocNone
- , Infix (char '>' >> return (BinOp ">")) AssocNone
- ]
- {-, [ Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone
- , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone
- ]
- , [
- Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
- , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
- ]-}
- , [
- Infix (char '=' >> return (BinOp "=")) AssocNone
- ]
- ]
- strOrChar [a] = CharCode . show . ord $ a
- strOrChar a = StringLiteral a
-
-phrasesBlock = do
- try $ string "begin"
- comments
- p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum)
- comments
- return $ Phrases p
-
-phrase = do
- o <- choice [
- phrasesBlock
- , ifBlock
- , whileCycle
- , repeatCycle
- , switchCase
- , withBlock
- , forCycle
- , (try $ reference >>= \r -> string ":=" >> return r) >>= \r -> comments >> expression >>= return . Assignment r
- , builtInFunction expression >>= \(n, e) -> return $ BuiltInFunctionCall e (SimpleReference (Identifier n BTUnknown))
- , procCall
- , char ';' >> comments >> return NOP
- ]
- optional $ char ';'
- comments
- return o
-
-ifBlock = do
- try $ string "if" >> notFollowedBy (alphaNum <|> char '_')
- comments
- e <- expression
- comments
- string "then"
- comments
- o1 <- phrase
- comments
- o2 <- optionMaybe $ do
- try $ string "else" >> space
- comments
- o <- option NOP phrase
- comments
- return o
- return $ IfThenElse e o1 o2
-
-whileCycle = do
- try $ string "while"
- comments
- e <- expression
- comments
- string "do"
- comments
- o <- phrase
- return $ WhileCycle e o
-
-withBlock = do
- try $ string "with" >> space
- comments
- rs <- (commaSep1 pas) reference
- comments
- string "do"
- comments
- o <- phrase
- return $ foldr WithBlock o rs
-
-repeatCycle = do
- try $ string "repeat" >> space
- comments
- o <- many phrase
- string "until"
- comments
- e <- expression
- comments
- return $ RepeatCycle e o
-
-forCycle = do
- try $ string "for" >> space
- comments
- i <- iD
- comments
- string ":="
- comments
- e1 <- expression
- comments
- up <- liftM (== Just "to") $
- optionMaybe $ choice [
- try $ string "to"
- , try $ string "downto"
- ]
- --choice [string "to", string "downto"]
- comments
- e2 <- expression
- comments
- string "do"
- comments
- p <- phrase
- comments
- return $ ForCycle i e1 e2 p up
-
-switchCase = do
- try $ string "case"
- comments
- e <- expression
- comments
- string "of"
- comments
- cs <- many1 aCase
- o2 <- optionMaybe $ do
- try $ string "else" >> notFollowedBy alphaNum
- comments
- o <- many phrase
- comments
- return o
- string "end"
- comments
- return $ SwitchCase e cs o2
- where
- aCase = do
- e <- (commaSep pas) $ (liftM InitRange rangeDecl <|> initExpression)
- comments
- char ':'
- comments
- p <- phrase
- comments
- return (e, p)
-
-procCall = do
- r <- reference
- p <- option [] $ (parens pas) parameters
- return $ ProcCall r p
-
-parameters = (commaSep pas) expression <?> "parameters"
-
-functionBody = do
- tv <- typeVarDeclaration True
- comments
- p <- phrasesBlock
- char ';'
- comments
- return (TypesAndVars tv, p)
-
-uses = liftM Uses (option [] u)
- where
- u = do
- string "uses"
- comments
- u <- (iD >>= \i -> comments >> return i) `sepBy1` (char ',' >> comments)
- char ';'
- comments
- return u
-
-initExpression = buildExpressionParser table term <?> "initialization expression"
- where
- term = comments >> choice [
- liftM (uncurry BuiltInFunction) $ builtInFunction initExpression
- , try $ brackets pas (commaSep pas $ initExpression) >>= return . InitSet
- , try $ parens pas (commaSep pas $ initExpression) >>= \ia -> when (null $ tail ia) mzero >> return (InitArray ia)
- , try $ parens pas (sepEndBy recField (char ';' >> comments)) >>= return . InitRecord
- , parens pas initExpression
- , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i
- , try $ float pas >>= return . InitFloat . show
- , try $ integer pas >>= return . InitNumber . show
- , stringLiteral pas >>= return . InitString
- , char '#' >> many digit >>= \c -> comments >> return (InitChar c)
- , char '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h)
- , char '@' >> initExpression >>= \c -> comments >> return (InitAddress c)
- , try $ string "nil" >> return InitNull
- , itypeCast
- , iD >>= return . InitReference
- ]
-
- recField = do
- i <- iD
- spaces
- char ':'
- spaces
- e <- initExpression
- spaces
- return (i ,e)
-
- table = [
- [
- Prefix (char '-' >> return (InitPrefixOp "-"))
- ,Prefix (try (string "not") >> return (InitPrefixOp "not"))
- ]
- , [ Infix (char '*' >> return (InitBinOp "*")) AssocLeft
- , Infix (char '/' >> return (InitBinOp "/")) AssocLeft
- , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft
- , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft
- , Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
- , Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
- , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
- ]
- , [ Infix (char '+' >> return (InitBinOp "+")) AssocLeft
- , Infix (char '-' >> return (InitBinOp "-")) AssocLeft
- , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
- , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
- ]
- , [ Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone
- , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone
- , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone
- , Infix (char '<' >> return (InitBinOp "<")) AssocNone
- , Infix (char '>' >> return (InitBinOp ">")) AssocNone
- , Infix (char '=' >> return (InitBinOp "=")) AssocNone
- ]
- {--, [ Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
- , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
- , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
- ]
- , [ Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
- , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
- ]--}
- --, [Prefix (try (string "not") >> return (InitPrefixOp "not"))]
- ]
-
- itypeCast = do
- t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
- i <- parens pas initExpression
- comments
- return $ InitTypeCast (Identifier t BTUnknown) i
-
-builtInFunction e = do
- name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
- spaces
- exprs <- option [] $ parens pas $ option [] $ commaSep1 pas $ e
- spaces
- return (name, exprs)
-
-systemUnit = do
- string "system;"
- comments
- string "type"
- comments
- t <- typesDecl
- string "var"
- v <- varsDecl True
- return $ System (t ++ v)
-
-redoUnit = do
- string "redo;"
- comments
- string "type"
- comments
- t <- typesDecl
- string "var"
- v <- varsDecl True
- return $ Redo (t ++ v)
-
--- a/tools/PascalPreprocessor.hs Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,134 +0,0 @@
-module PascalPreprocessor where
-
-import Text.Parsec
-import Control.Monad.IO.Class
-import Control.Monad
-import System.IO
-import qualified Data.Map as Map
-import Data.Char
-
-
--- comments are removed
-comment = choice [
- char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
- , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
- , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
- ]
-
-initDefines = Map.fromList [
- ("FPC", "")
- , ("PAS2C", "")
- , ("ENDIAN_LITTLE", "")
- ]
-
-preprocess :: String -> IO String
-preprocess fn = do
- r <- runParserT (preprocessFile fn) (initDefines, [True]) "" ""
- case r of
- (Left a) -> do
- hPutStrLn stderr (show a)
- return ""
- (Right a) -> return a
-
- where
- preprocessFile fn = do
- f <- liftIO (readFile fn)
- setInput f
- preprocessor
-
- preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
-
- preprocessor = chainr codeBlock (return (++)) ""
-
- codeBlock = do
- s <- choice [
- switch
- , comment
- , char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
- , identifier >>= replace
- , noneOf "{" >>= \a -> return [a]
- ]
- (_, ok) <- getState
- return $ if and ok then s else ""
-
- --otherChar c = c `notElem` "{/('_" && not (isAlphaNum c)
- identifier = do
- c <- letter <|> oneOf "_"
- s <- many (alphaNum <|> oneOf "_")
- return $ c:s
-
- switch = do
- try $ string "{$"
- s <- choice [
- include
- , ifdef
- , if'
- , elseSwitch
- , endIf
- , define
- , unknown
- ]
- return s
-
- include = do
- try $ string "INCLUDE"
- spaces
- (char '"')
- fn <- many1 $ noneOf "\"\n"
- char '"'
- spaces
- char '}'
- f <- liftIO (readFile fn `catch` error ("File not found: " ++ fn))
- c <- getInput
- setInput $ f ++ c
- return ""
-
- ifdef = do
- s <- try (string "IFDEF") <|> try (string "IFNDEF")
- let f = if s == "IFNDEF" then not else id
-
- spaces
- d <- identifier
- spaces
- char '}'
-
- updateState $ \(m, b) ->
- (m, (f $ d `Map.member` m) : b)
-
- return ""
-
- if' = do
- s <- try (string "IF" >> notFollowedBy alphaNum)
-
- manyTill anyChar (char '}')
- --char '}'
-
- updateState $ \(m, b) ->
- (m, False : b)
-
- return ""
-
- elseSwitch = do
- try $ string "ELSE}"
- updateState $ \(m, b:bs) -> (m, (not b):bs)
- return ""
- endIf = do
- try $ string "ENDIF}"
- updateState $ \(m, b:bs) -> (m, bs)
- return ""
- define = do
- try $ string "DEFINE"
- spaces
- i <- identifier
- d <- ((string ":=" >> return ()) <|> spaces) >> many (noneOf "}")
- char '}'
- updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b)
- return ""
- replace s = do
- (m, _) <- getState
- return $ Map.findWithDefault s s m
-
- unknown = do
- fn <- many1 $ noneOf "}\n"
- char '}'
- return $ "{$" ++ fn ++ "}"
--- a/tools/PascalUnitSyntaxTree.hs Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,119 +0,0 @@
-module PascalUnitSyntaxTree where
-
-import Data.Maybe
-import Data.Char
-
-data PascalUnit =
- Program Identifier Implementation Phrase
- | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
- | System [TypeVarDeclaration]
- | Redo [TypeVarDeclaration]
- deriving Show
-data Interface = Interface Uses TypesAndVars
- deriving Show
-data Implementation = Implementation Uses TypesAndVars
- deriving Show
-data Identifier = Identifier String BaseType
- deriving Show
-data TypesAndVars = TypesAndVars [TypeVarDeclaration]
- deriving Show
-data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
- | VarDeclaration Bool Bool ([Identifier], TypeDecl) (Maybe InitExpression)
- | FunctionDeclaration Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
- | OperatorDeclaration String Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
- deriving Show
-data TypeDecl = SimpleType Identifier
- | RangeType Range
- | Sequence [Identifier]
- | ArrayDecl (Maybe Range) TypeDecl
- | RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
- | PointerTo TypeDecl
- | String Integer
- | Set TypeDecl
- | FunctionType TypeDecl [TypeVarDeclaration]
- | DeriveType InitExpression
- | VoidType
- | VarParamType TypeDecl -- this is a hack
- deriving Show
-data Range = Range Identifier
- | RangeFromTo InitExpression InitExpression
- | RangeInfinite
- deriving Show
-data Initialize = Initialize String
- deriving Show
-data Finalize = Finalize String
- deriving Show
-data Uses = Uses [Identifier]
- deriving Show
-data Phrase = ProcCall Reference [Expression]
- | IfThenElse Expression Phrase (Maybe Phrase)
- | WhileCycle Expression Phrase
- | RepeatCycle Expression [Phrase]
- | ForCycle Identifier Expression Expression Phrase Bool -- The last Boolean indicates wether it's up or down counting
- | WithBlock Reference Phrase
- | Phrases [Phrase]
- | SwitchCase Expression [([InitExpression], Phrase)] (Maybe [Phrase])
- | Assignment Reference Expression
- | BuiltInFunctionCall [Expression] Reference
- | NOP
- deriving Show
-data Expression = Expression String
- | BuiltInFunCall [Expression] Reference
- | PrefixOp String Expression
- | PostfixOp String Expression
- | BinOp String Expression Expression
- | StringLiteral String
- | PCharLiteral String
- | CharCode String
- | HexCharCode String
- | NumberLiteral String
- | FloatLiteral String
- | HexNumber String
- | Reference Reference
- | SetExpression [Identifier]
- | Null
- deriving Show
-data Reference = ArrayElement [Expression] Reference
- | FunCall [Expression] Reference
- | TypeCast Identifier Expression
- | SimpleReference Identifier
- | Dereference Reference
- | RecordField Reference Reference
- | Address Reference
- | RefExpression Expression
- deriving Show
-data InitExpression = InitBinOp String InitExpression InitExpression
- | InitPrefixOp String InitExpression
- | InitReference Identifier
- | InitArray [InitExpression]
- | InitRecord [(Identifier, InitExpression)]
- | InitFloat String
- | InitNumber String
- | InitHexNumber String
- | InitString String
- | InitChar String
- | BuiltInFunction String [InitExpression]
- | InitSet [InitExpression]
- | InitAddress InitExpression
- | InitNull
- | InitRange Range
- | InitTypeCast Identifier InitExpression
- deriving Show
-
-data BaseType = BTUnknown
- | BTChar
- | BTString
- | BTInt
- | BTBool
- | BTFloat
- | BTRecord String [(String, BaseType)]
- | BTArray Range BaseType BaseType
- | BTFunction Bool Int BaseType
- | BTPointerTo BaseType
- | BTUnresolved String
- | BTSet BaseType
- | BTEnum [String]
- | BTVoid
- | BTUnit
- | BTVarParam BaseType
- deriving Show
--- a/tools/pas2c.hs Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1086 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-module Pas2C where
-
-import Text.PrettyPrint.HughesPJ
-import Data.Maybe
-import Data.Char
-import Text.Parsec.Prim hiding (State)
-import Control.Monad.State
-import System.IO
-import System.Directory
-import Control.Monad.IO.Class
-import PascalPreprocessor
-import Control.Exception
-import System.IO.Error
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import Data.List (find)
-import Numeric
-
-import PascalParser(pascalUnit)
-import PascalUnitSyntaxTree
-
-
-data InsertOption =
- IOInsert
- | IOInsertWithType Doc
- | IOLookup
- | IOLookupLast
- | IOLookupFunction Int
- | IODeferred
-
-data Record = Record
- {
- lcaseId :: String,
- baseType :: BaseType,
- typeDecl :: Doc
- }
- deriving Show
-type Records = Map.Map String [Record]
-data RenderState = RenderState
- {
- currentScope :: Records,
- lastIdentifier :: String,
- lastType :: BaseType,
- lastIdTypeDecl :: Doc,
- stringConsts :: [(String, String)],
- uniqCounter :: Int,
- toMangle :: Set.Set String,
- currentUnit :: String,
- currentFunctionResult :: String,
- namespaces :: Map.Map String Records
- }
-
-rec2Records = map (\(a, b) -> Record a b empty)
-
-emptyState = RenderState Map.empty "" BTUnknown empty [] 0 Set.empty "" ""
-
-getUniq :: State RenderState Int
-getUniq = do
- i <- gets uniqCounter
- modify(\s -> s{uniqCounter = uniqCounter s + 1})
- return i
-
-addStringConst :: String -> State RenderState Doc
-addStringConst str = do
- strs <- gets stringConsts
- let a = find ((==) str . snd) strs
- if isJust a then
- do
- modify (\s -> s{lastType = BTString})
- return . text . fst . fromJust $ a
- else
- do
- i <- getUniq
- let sn = "__str" ++ show i
- modify (\s -> s{lastType = BTString, stringConsts = (sn, str) : strs})
- return $ text sn
-
-escapeStr :: String -> String
-escapeStr = foldr escapeChar []
-
-escapeChar :: Char -> ShowS
-escapeChar '"' s = "\\\"" ++ s
-escapeChar '\\' s = "\\\\" ++ s
-escapeChar a s = a : s
-
-strInit :: String -> Doc
-strInit a = text "STRINIT" <> parens (doubleQuotes (text $ escapeStr a))
-
-renderStringConsts :: State RenderState Doc
-renderStringConsts = liftM (vcat . map (\(a, b) -> text "static const string255" <+> (text a) <+> text "=" <+> strInit b <> semi))
- $ gets stringConsts
-
-docToLower :: Doc -> Doc
-docToLower = text . map toLower . render
-
-pas2C :: String -> IO ()
-pas2C fn = do
- setCurrentDirectory "../hedgewars/"
- s <- flip execStateT initState $ f fn
- renderCFiles s
- where
- printLn = liftIO . hPutStrLn stdout
- print = liftIO . hPutStr stdout
- initState = Map.empty
- f :: String -> StateT (Map.Map String PascalUnit) IO ()
- f fileName = do
- processed <- gets $ Map.member fileName
- unless processed $ do
- print ("Preprocessing '" ++ fileName ++ ".pas'... ")
- fc' <- liftIO
- $ tryJust (guard . isDoesNotExistError)
- $ preprocess (fileName ++ ".pas")
- case fc' of
- (Left a) -> do
- modify (Map.insert fileName (System []))
- printLn "doesn't exist"
- (Right fc) -> do
- print "ok, parsing... "
- let ptree = parse pascalUnit fileName fc
- case ptree of
- (Left a) -> do
- liftIO $ writeFile "preprocess.out" fc
- printLn $ show a ++ "\nsee preprocess.out for preprocessed source"
- fail "stop"
- (Right a) -> do
- printLn "ok"
- modify (Map.insert fileName a)
- mapM_ f (usesFiles a)
-
-
-renderCFiles :: Map.Map String PascalUnit -> IO ()
-renderCFiles units = do
- let u = Map.toList units
- let nss = Map.map (toNamespace nss) units
- --hPutStrLn stderr $ "Units: " ++ (show . Map.keys . Map.filter (not . Map.null) $ nss)
- --writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss
- mapM_ (toCFiles nss) u
- where
- toNamespace :: Map.Map String Records -> PascalUnit -> Records
- toNamespace nss (System tvs) =
- currentScope $ execState f (emptyState nss)
- where
- f = do
- checkDuplicateFunDecls tvs
- mapM_ (tvar2C True False True False) tvs
- toNamespace nss (Redo tvs) = -- functions that are re-implemented, add prefix to all of them
- currentScope $ execState f (emptyState nss){currentUnit = "fpcrtl_"}
- where
- f = do
- checkDuplicateFunDecls tvs
- mapM_ (tvar2C True False True False) tvs
- toNamespace _ (Program {}) = Map.empty
- toNamespace nss (Unit (Identifier i _) interface _ _ _) =
- currentScope $ execState (interface2C interface True) (emptyState nss){currentUnit = map toLower i ++ "_"}
-
-
-withState' :: (RenderState -> RenderState) -> State RenderState a -> State RenderState a
-withState' f sf = do
- st <- liftM f get
- let (a, s) = runState sf st
- modify(\st -> st{
- lastType = lastType s
- , uniqCounter = uniqCounter s
- , stringConsts = stringConsts s
- })
- return a
-
-withLastIdNamespace f = do
- li <- gets lastIdentifier
- nss <- gets namespaces
- withState' (\st -> st{currentScope = fromMaybe Map.empty $ Map.lookup li (namespaces st)}) f
-
-withRecordNamespace :: String -> [Record] -> State RenderState Doc -> State RenderState Doc
-withRecordNamespace _ [] = error "withRecordNamespace: empty record"
-withRecordNamespace prefix recs = withState' f
- where
- f st = st{currentScope = Map.unionWith un records (currentScope st), currentUnit = ""}
- records = Map.fromList $ map (\(Record a b d) -> (map toLower a, [Record (prefix ++ a) b d])) recs
- un [a] b = a : b
-
-toCFiles :: Map.Map String Records -> (String, PascalUnit) -> IO ()
-toCFiles _ (_, System _) = return ()
-toCFiles _ (_, Redo _) = return ()
-toCFiles ns p@(fn, pu) = do
- hPutStrLn stdout $ "Rendering '" ++ fn ++ "'..."
- toCFiles' p
- where
- toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p
- toCFiles' (fn, (Unit unitId@(Identifier i _) interface implementation _ _)) = do
- let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface True) initialState{currentUnit = map toLower i ++ "_"}
- (a', s') = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface False) initialState{currentUnit = map toLower i ++ "_"}
- writeFile (fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text ""))
- writeFile (fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation
- initialState = emptyState ns
-
- render2C :: RenderState -> State RenderState Doc -> String
- render2C a = render . ($+$ empty) . flip evalState a
-
-
-usesFiles :: PascalUnit -> [String]
-usesFiles (Program _ (Implementation uses _) _) = ["pas2cSystem", "pas2cRedo"] ++ uses2List uses
-usesFiles (Unit _ (Interface uses1 _) (Implementation uses2 _) _ _) = ["pas2cSystem", "pas2cRedo"] ++ uses2List uses1 ++ uses2List uses2
-usesFiles (System {}) = []
-usesFiles (Redo {}) = []
-
-pascal2C :: PascalUnit -> State RenderState Doc
-pascal2C (Unit _ interface implementation init fin) =
- liftM2 ($+$) (interface2C interface True) (implementation2C implementation)
-
-pascal2C (Program _ implementation mainFunction) = do
- impl <- implementation2C implementation
- [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" BTInt) False (SimpleType $ Identifier "int" BTInt) [VarDeclaration False False ([Identifier "argc" BTInt], SimpleType (Identifier "Integer" BTInt)) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction)))
- return $ impl $+$ main
-
-
--- the second bool indicates whether do normal interface translation or generate variable declarations
--- that will be inserted into implementation files
-interface2C :: Interface -> Bool -> State RenderState Doc
-interface2C (Interface uses tvars) True = do
- u <- uses2C uses
- tv <- typesAndVars2C True True True tvars
- r <- renderStringConsts
- return (u $+$ r $+$ tv)
-interface2C (Interface uses tvars) False = do
- u <- uses2C uses
- tv <- typesAndVars2C True False False tvars
- r <- renderStringConsts
- return tv
-
-implementation2C :: Implementation -> State RenderState Doc
-implementation2C (Implementation uses tvars) = do
- u <- uses2C uses
- tv <- typesAndVars2C True False True tvars
- r <- renderStringConsts
- return (u $+$ r $+$ tv)
-
-checkDuplicateFunDecls :: [TypeVarDeclaration] -> State RenderState ()
-checkDuplicateFunDecls tvs =
- modify $ \s -> s{toMangle = Map.keysSet . Map.filter (> 1) . foldr ins initMap $ tvs}
- where
- initMap = Map.empty
- --initMap = Map.fromList [("reset", 2)]
- ins (FunctionDeclaration (Identifier i _) _ _ _ _) m = Map.insertWith (+) (map toLower i) 1 m
- ins _ m = m
-
--- the second bool indicates whether declare variable as extern or not
--- the third bool indicates whether include types or not
-
-typesAndVars2C :: Bool -> Bool -> Bool -> TypesAndVars -> State RenderState Doc
-typesAndVars2C b externVar includeType(TypesAndVars ts) = do
- checkDuplicateFunDecls ts
- liftM (vcat . map (<> semi) . concat) $ mapM (tvar2C b externVar includeType False) ts
-
-setBaseType :: BaseType -> Identifier -> Identifier
-setBaseType bt (Identifier i _) = Identifier i bt
-
-uses2C :: Uses -> State RenderState Doc
-uses2C uses@(Uses unitIds) = do
-
- mapM_ injectNamespace (Identifier "pas2cSystem" undefined : unitIds)
- mapM_ injectNamespace (Identifier "pas2cRedo" undefined : unitIds)
- mapM_ (id2C IOInsert . setBaseType BTUnit) unitIds
- return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses
- where
- injectNamespace (Identifier i _) = do
- getNS <- gets (flip Map.lookup . namespaces)
- modify (\s -> s{currentScope = Map.unionWith (++) (fromMaybe Map.empty (getNS i)) $ currentScope s})
-
-uses2List :: Uses -> [String]
-uses2List (Uses ids) = map (\(Identifier i _) -> i) ids
-
-
-setLastIdValues vv = (\s -> s{lastType = baseType vv, lastIdentifier = lcaseId vv, lastIdTypeDecl = typeDecl vv})
-
-id2C :: InsertOption -> Identifier -> State RenderState Doc
-id2C IOInsert i = id2C (IOInsertWithType empty) i
-id2C (IOInsertWithType d) (Identifier i t) = do
- ns <- gets currentScope
- tom <- gets (Set.member n . toMangle)
- cu <- gets currentUnit
- let (i', t') = case (t, tom) of
- (BTFunction _ p _, True) -> (cu ++ i ++ ('_' : show p), t)
- (BTFunction _ _ _, _) -> (cu ++ i, t)
- (BTVarParam t', _) -> ('(' : '*' : i ++ ")" , t')
- _ -> (i, t)
- modify (\s -> s{currentScope = Map.insertWith (++) n [Record i' t' d] (currentScope s), lastIdentifier = n})
- return $ text i'
- where
- n = map toLower i
-
-id2C IOLookup i = id2CLookup head i
-id2C IOLookupLast i = id2CLookup last i
-id2C (IOLookupFunction params) (Identifier i t) = do
- let i' = map toLower i
- v <- gets $ Map.lookup i' . currentScope
- lt <- gets lastType
- if isNothing v then
- error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt ++ "\nwith num of params = " ++ show params ++ "\n" ++ show v
- else
- let vv = fromMaybe (head $ fromJust v) . find checkParam $ fromJust v in
- modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
- where
- checkParam (Record _ (BTFunction _ p _) _) = p == params
- checkParam _ = False
-id2C IODeferred (Identifier i t) = do
- let i' = map toLower i
- v <- gets $ Map.lookup i' . currentScope
- if (isNothing v) then
- modify (\s -> s{lastType = BTUnknown, lastIdentifier = i}) >> return (text i)
- else
- let vv = head $ fromJust v in modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
-
-id2CLookup :: ([Record] -> Record) -> Identifier -> State RenderState Doc
-id2CLookup f (Identifier i t) = do
- let i' = map toLower i
- v <- gets $ Map.lookup i' . currentScope
- lt <- gets lastType
- if isNothing v then
- error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt
- else
- let vv = f $ fromJust v in modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
-
-
-id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc
-id2CTyped = id2CTyped2 Nothing
-
-id2CTyped2 :: Maybe Doc -> TypeDecl -> Identifier -> State RenderState Doc
-id2CTyped2 md t (Identifier i _) = do
- tb <- resolveType t
- case (t, tb) of
- (_, BTUnknown) -> do
- error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t
- (SimpleType {}, BTRecord _ r) -> do
- ts <- type2C t
- id2C (IOInsertWithType $ ts empty) (Identifier i (BTRecord (render $ ts empty) r))
- (_, BTRecord _ r) -> do
- ts <- type2C t
- id2C (IOInsertWithType $ ts empty) (Identifier i (BTRecord i r))
- _ -> case md of
- Nothing -> id2C IOInsert (Identifier i tb)
- Just ts -> id2C (IOInsertWithType ts) (Identifier i tb)
-
-
-resolveType :: TypeDecl -> State RenderState BaseType
-resolveType st@(SimpleType (Identifier i _)) = do
- let i' = map toLower i
- v <- gets $ Map.lookup i' . currentScope
- if isJust v then return . baseType . head $ fromJust v else return $ f i'
- where
- f "integer" = BTInt
- f "pointer" = BTPointerTo BTVoid
- f "boolean" = BTBool
- f "float" = BTFloat
- f "char" = BTChar
- f "string" = BTString
- f _ = error $ "Unknown system type: " ++ show st
-resolveType (PointerTo (SimpleType (Identifier i _))) = return . BTPointerTo $ BTUnresolved (map toLower i)
-resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
-resolveType (RecordType tv mtvs) = do
- tvs <- mapM f (concat $ tv : fromMaybe [] mtvs)
- return . BTRecord "" . concat $ tvs
- where
- f :: TypeVarDeclaration -> State RenderState [(String, BaseType)]
- f (VarDeclaration _ _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
-resolveType (ArrayDecl (Just i) t) = do
- t' <- resolveType t
- return $ BTArray i BTInt t'
-resolveType (ArrayDecl Nothing t) = liftM (BTArray RangeInfinite BTInt) $ resolveType t
-resolveType (FunctionType t a) = liftM (BTFunction False (length a)) $ resolveType t
-resolveType (DeriveType (InitHexNumber _)) = return BTInt
-resolveType (DeriveType (InitNumber _)) = return BTInt
-resolveType (DeriveType (InitFloat _)) = return BTFloat
-resolveType (DeriveType (InitString _)) = return BTString
-resolveType (DeriveType (InitBinOp {})) = return BTInt
-resolveType (DeriveType (InitPrefixOp _ e)) = initExpr2C e >> gets lastType
-resolveType (DeriveType (BuiltInFunction{})) = return BTInt
-resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
-resolveType (DeriveType _) = return BTUnknown
-resolveType (String _) = return BTString
-resolveType VoidType = return BTVoid
-resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
-resolveType (RangeType _) = return $ BTVoid
-resolveType (Set t) = liftM BTSet $ resolveType t
-resolveType (VarParamType t) = liftM BTVarParam $ resolveType t
-
-
-resolve :: String -> BaseType -> State RenderState BaseType
-resolve s (BTUnresolved t) = do
- v <- gets $ Map.lookup t . currentScope
- if isJust v then
- resolve s . baseType . head . fromJust $ v
- else
- error $ "Unknown type " ++ show t ++ "\n" ++ s
-resolve _ t = return t
-
-fromPointer :: String -> BaseType -> State RenderState BaseType
-fromPointer s (BTPointerTo t) = resolve s t
-fromPointer s t = do
- error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s
-
-
-functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False False True True) params
-
-numberOfDeclarations :: [TypeVarDeclaration] -> Int
-numberOfDeclarations = sum . map cnt
- where
- cnt (VarDeclaration _ _ (ids, _) _) = length ids
- cnt _ = 1
-
-hasPassByReference :: [TypeVarDeclaration] -> Bool
-hasPassByReference = or . map isVar
- where
- isVar (VarDeclaration v _ (_, _) _) = v
- isVar _ = error $ "hasPassByReference called not on function parameters"
-
-toIsVarList :: [TypeVarDeclaration] -> [Bool]
-toIsVarList = concatMap isVar
- where
- isVar (VarDeclaration v _ (p, _) _) = replicate (length p) v
- isVar _ = error $ "toIsVarList called not on function parameters"
-
-
-funWithVarsToDefine :: String -> [TypeVarDeclaration] -> Doc
-funWithVarsToDefine n params = text "#define" <+> text n <> parens abc <+> text (n ++ "__vars") <> parens cparams
- where
- abc = hcat . punctuate comma . map (char . fst) $ ps
- cparams = hcat . punctuate comma . map (\(c, v) -> if v then char '&' <> parens (char c) else char c) $ ps
- ps = zip ['a'..] (toIsVarList params)
-
-fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc]
-fun2C _ _ (FunctionDeclaration name inline returnType params Nothing) = do
- t <- type2C returnType
- t'<- gets lastType
- p <- withState' id $ functionParams2C params
- n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name
- let decor = if inline then text "inline" else empty
- if hasVars then
- return [funWithVarsToDefine n params $+$ decor <+> t empty <+> text (n ++ "__vars") <> parens p]
- else
- return [decor <+> t empty <+> text n <> parens p]
- where
- hasVars = hasPassByReference params
-
-
-fun2C True rv (FunctionDeclaration name@(Identifier i _) inline returnType params (Just (tvars, phrase))) = do
- let res = docToLower $ text rv <> text "_result"
- t <- type2C returnType
- t'<- gets lastType
-
- notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope
-
- n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name
-
- let isVoid = case returnType of
- VoidType -> True
- _ -> False
-
- (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [Record (render res) t' empty] $ currentScope st
- , currentFunctionResult = if isVoid then [] else render res}) $ do
- p <- functionParams2C params
- ph <- liftM2 ($+$) (typesAndVars2C False False True tvars) (phrase2C' phrase)
- return (p, ph)
-
- let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
- let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty
- let decor = if inline then text "inline" else empty
- return [
- define
- $+$
- --(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$
- decor <+> t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p
- $+$
- text "{"
- $+$
- nest 4 phrasesBlock
- $+$
- text "}"]
- where
- phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p
- phrase2C' p = phrase2C p
- un [a] b = a : b
- hasVars = hasPassByReference params
-
-fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _ _) = error $ "nested functions not allowed: " ++ name
-fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv
-
--- the second bool indicates whether declare variable as extern or not
--- the third bool indicates whether include types or not
--- the fourth bool indicates whether ignore initialization or not (basically for dynamic arrays since we cannot do initialization in function params)
-tvar2C :: Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc]
-tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _) = do
- t <- fun2C b name f
- if includeType then return t else return []
-tvar2C _ _ includeType _ td@(TypeDeclaration i' t) = do
- i <- id2CTyped t i'
- tp <- type2C t
- return $ if includeType then [text "typedef" <+> tp i] else []
-
-tvar2C _ _ _ _ (VarDeclaration True _ (ids, t) Nothing) = do
- t' <- liftM ((empty <+>) . ) $ type2C t
- liftM (map(\i -> t' i)) $ mapM (id2CTyped2 (Just $ t' empty) (VarParamType t)) ids
-
-tvar2C _ externVar includeType ignoreInit (VarDeclaration _ isConst (ids, t) mInitExpr) = do
- t' <- liftM (((if isConst then text "static const" else if externVar
- then text "extern"
- else empty)
- <+>) . ) $ type2C t
- ie <- initExpr mInitExpr
- lt <- gets lastType
- case (isConst, lt, ids, mInitExpr) of
- (True, BTInt, [i], Just _) -> do
- i' <- id2CTyped t i
- return $ if includeType then [text "enum" <> braces (i' <+> ie)] else []
- (True, BTFloat, [i], Just e) -> do
- i' <- id2CTyped t i
- ie <- initExpr2C e
- return $ if includeType then [text "#define" <+> i' <+> parens ie <> text "\n"] else []
- (_, BTFunction{}, _, Nothing) -> liftM (map(\i -> t' i)) $ mapM (id2CTyped t) ids
- (_, BTArray r _ _, [i], _) -> do
- i' <- id2CTyped t i
- ie' <- return $ case (r, mInitExpr, ignoreInit) of
- (RangeInfinite, Nothing, False) -> text "= NULL" -- force dynamic array to be initialized as NULL if not initialized at all
- (_, _, _) -> ie
- result <- liftM (map(\i -> varDeclDecision isConst includeType (t' i) ie')) $ mapM (id2CTyped t) ids
- case (r, ignoreInit) of
- (RangeInfinite, False) ->
- -- if the array is dynamic, add dimension info to it
- return $ [dimDecl] ++ result
- where
- arrayDimStr = show $ arrayDimension t
- arrayDimInitExp = text ("={" ++ ".dim = " ++ arrayDimStr ++ ", .a = {0, 0, 0, 0}}")
- dimDecl = varDeclDecision isConst includeType (text "fpcrtl_dimension_t" <+> i' <> text "_dimension_info") arrayDimInitExp
-
- (_, _) -> return result
-
- _ -> liftM (map(\i -> varDeclDecision isConst includeType (t' i) ie)) $ mapM (id2CTyped2 (Just $ t' empty) t) ids
- where
- initExpr Nothing = return $ empty
- initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e)
- varDeclDecision True True varStr expStr = varStr <+> expStr
- varDeclDecision False True varStr expStr = if externVar then varStr else varStr <+> expStr
- varDeclDecision False False varStr expStr = varStr <+> expStr
- varDeclDecision True False varStr expStr = empty
- arrayDimension a = case a of
- ArrayDecl Nothing t -> let a = arrayDimension t in if a > 3 then error "Dynamic array with dimension > 4 is not supported." else 1 + arrayDimension t
- ArrayDecl _ _ -> error "Mixed dynamic array and static array are not supported."
- _ -> 0
-
-tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do
- r <- op2CTyped op (extractTypes params)
- fun2C f i (FunctionDeclaration r inline ret params body)
-
-
-op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier
-op2CTyped op t = do
- t' <- liftM (render . hcat . punctuate (char '_') . map (\t -> t empty)) $ mapM type2C t
- bt <- gets lastType
- return $ Identifier (t' ++ "_op_" ++ opStr) bt
- where
- opStr = case op of
- "+" -> "add"
- "-" -> "sub"
- "*" -> "mul"
- "/" -> "div"
- "/(float)" -> "div"
- "=" -> "eq"
- "<" -> "lt"
- ">" -> "gt"
- "<>" -> "neq"
- _ -> error $ "op2CTyped: unknown op '" ++ op ++ "'"
-
-extractTypes :: [TypeVarDeclaration] -> [TypeDecl]
-extractTypes = concatMap f
- where
- f (VarDeclaration _ _ (ids, t) _) = replicate (length ids) t
- f a = error $ "extractTypes: can't extract from " ++ show a
-
-initExpr2C, initExpr2C' :: InitExpression -> State RenderState Doc
-initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values
-initExpr2C a = initExpr2C' a
-initExpr2C' InitNull = return $ text "NULL"
-initExpr2C' (InitAddress expr) = do
- ie <- initExpr2C' expr
- lt <- gets lastType
- case lt of
- BTFunction True _ _ -> return $ text "&" <> ie <> text "__vars"
- _ -> return $ text "&" <> ie
-initExpr2C' (InitPrefixOp op expr) = liftM (text (op2C op) <>) (initExpr2C' expr)
-initExpr2C' (InitBinOp op expr1 expr2) = do
- e1 <- initExpr2C' expr1
- e2 <- initExpr2C' expr2
- return $ parens $ e1 <+> text (op2C op) <+> e2
-initExpr2C' (InitNumber s) = return $ text s
-initExpr2C' (InitFloat s) = return $ text s
-initExpr2C' (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)
-initExpr2C' (InitString [a]) = return . quotes $ text [a]
-initExpr2C' (InitString s) = return $ strInit s
-initExpr2C' (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
-initExpr2C' (InitReference i) = id2C IOLookup i
-initExpr2C' (InitRecord fields) = do
- (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields
- return $ lbrace $+$ (nest 4 . vcat . punctuate comma $ fs) $+$ rbrace
-initExpr2C' (InitArray [value]) = initExpr2C value
-initExpr2C' r@(InitRange (Range i@(Identifier i' _))) = do
- id2C IOLookup i
- t <- gets lastType
- case t of
- BTEnum s -> return . int $ length s
- BTInt -> case i' of
- "byte" -> return $ int 256
- _ -> error $ "InitRange identifier: " ++ i'
- _ -> error $ "InitRange: " ++ show r
-initExpr2C' (InitRange (RangeFromTo (InitNumber "0") r)) = initExpr2C $ BuiltInFunction "succ" [r]
-initExpr2C' (InitRange (RangeFromTo (InitChar "0") (InitChar r))) = initExpr2C $ BuiltInFunction "succ" [InitNumber r]
-initExpr2C' (InitRange a) = error $ show a --return $ text "<<range>>"
-initExpr2C' (InitSet []) = return $ text "0"
-initExpr2C' (InitSet a) = return $ text "<<set>>"
-initExpr2C' (BuiltInFunction "low" [InitReference e]) = return $
- case e of
- (Identifier "LongInt" _) -> int (-2^31)
- (Identifier "SmallInt" _) -> int (-2^15)
- _ -> error $ "BuiltInFunction 'low': " ++ show e
-initExpr2C' (BuiltInFunction "high" [e]) = do
- initExpr2C e
- t <- gets lastType
- case t of
- (BTArray i _ _) -> initExpr2C' $ BuiltInFunction "pred" [InitRange i]
- a -> error $ "BuiltInFunction 'high': " ++ show a
-initExpr2C' (BuiltInFunction "succ" [BuiltInFunction "pred" [e]]) = initExpr2C' e
-initExpr2C' (BuiltInFunction "pred" [BuiltInFunction "succ" [e]]) = initExpr2C' e
-initExpr2C' (BuiltInFunction "succ" [e]) = liftM (<> text " + 1") $ initExpr2C' e
-initExpr2C' (BuiltInFunction "pred" [e]) = liftM (<> text " - 1") $ initExpr2C' e
-initExpr2C' b@(BuiltInFunction _ _) = error $ show b
-initExpr2C' a = error $ "initExpr2C: don't know how to render " ++ show a
-
-
-range2C :: InitExpression -> State RenderState [Doc]
-range2C (InitString [a]) = return [quotes $ text [a]]
-range2C (InitRange (Range i)) = liftM (flip (:) []) $ id2C IOLookup i
-range2C (InitRange (RangeFromTo (InitString [a]) (InitString [b]))) = return $ map (\i -> quotes $ text [i]) [a..b]
-range2C a = liftM (flip (:) []) $ initExpr2C a
-
-baseType2C :: String -> BaseType -> Doc
-baseType2C _ BTFloat = text "float"
-baseType2C _ BTBool = text "bool"
-baseType2C _ BTString = text "string255"
-baseType2C s a = error $ "baseType2C: " ++ show a ++ "\n" ++ s
-
-type2C :: TypeDecl -> State RenderState (Doc -> Doc)
-type2C (SimpleType i) = liftM (\i a -> i <+> a) $ id2C IOLookup i
-type2C t = do
- r <- type2C' t
- rt <- resolveType t
- modify (\st -> st{lastType = rt})
- return r
- where
- type2C' VoidType = return (text "void" <+>)
- type2C' (String l) = return (text "string255" <+>)--return (text ("string" ++ show l) <+>)
- type2C' (PointerTo (SimpleType i)) = do
- i' <- id2C IODeferred i
- lt <- gets lastType
- case lt of
- BTRecord _ _ -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
- BTUnknown -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
- _ -> return $ \a -> i' <+> text "*" <+> a
- type2C' (PointerTo t) = liftM (\t a -> t (parens $ text "*" <> a)) $ type2C t
- type2C' (RecordType tvs union) = do
- t <- withState' f $ mapM (tvar2C False False True False) tvs
- u <- unions
- return $ \i -> text "struct __" <> i <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i
- where
- f s = s{currentUnit = ""}
- unions = case union of
- Nothing -> return empty
- Just a -> do
- structs <- mapM struct2C a
- return $ text "union" $+$ braces (nest 4 $ vcat structs) <> semi
- struct2C tvs = do
- t <- withState' f $ mapM (tvar2C False False True False) tvs
- return $ text "struct" $+$ braces (nest 4 (vcat . map (<> semi) . concat $ t)) <> semi
- type2C' (RangeType r) = return (text "int" <+>)
- type2C' (Sequence ids) = do
- is <- mapM (id2C IOInsert . setBaseType bt) ids
- return (text "enum" <+> (braces . vcat . punctuate comma . map (\(a, b) -> a <+> equals <+> text "0x" <> text (showHex b "")) $ zip is [0..]) <+>)
- where
- bt = BTEnum $ map (\(Identifier i _) -> map toLower i) ids
- type2C' (ArrayDecl Nothing t) = type2C (PointerTo t)
- type2C' (ArrayDecl (Just r) t) = do
- t' <- type2C t
- lt <- gets lastType
- ft <- case lt of
- -- BTFunction {} -> type2C (PointerTo t)
- _ -> return t'
- r' <- initExpr2C (InitRange r)
- return $ \i -> ft i <> brackets r'
- type2C' (Set t) = return (text "<<set>>" <+>)
- type2C' (FunctionType returnType params) = do
- t <- type2C returnType
- p <- withState' id $ functionParams2C params
- return (\i -> (t empty <> (parens $ text "*" <> i) <> parens p))
- type2C' (DeriveType (InitBinOp _ _ i)) = type2C' (DeriveType i)
- type2C' (DeriveType (InitPrefixOp _ i)) = type2C' (DeriveType i)
- type2C' (DeriveType (InitNumber _)) = return (text "int" <+>)
- type2C' (DeriveType (InitHexNumber _)) = return (text "int" <+>)
- type2C' (DeriveType (InitFloat _)) = return (text "float" <+>)
- type2C' (DeriveType (BuiltInFunction {})) = return (text "int" <+>)
- type2C' (DeriveType (InitString {})) = return (text "string255" <+>)
- type2C' (DeriveType r@(InitReference {})) = do
- initExpr2C r
- t <- gets lastType
- return (baseType2C (show r) t <+>)
- type2C' (DeriveType a) = error $ "Can't derive type from " ++ show a
-
-phrase2C :: Phrase -> State RenderState Doc
-phrase2C (Phrases p) = do
- ps <- mapM phrase2C p
- return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}"
-phrase2C (ProcCall f@(FunCall {}) []) = liftM (<> semi) $ ref2C f
-phrase2C (ProcCall ref []) = liftM (<> semi) $ ref2CF ref
-phrase2C (ProcCall ref params) = error $ "ProcCall"{-do
- r <- ref2C ref
- ps <- mapM expr2C params
- return $ r <> parens (hsep . punctuate (char ',') $ ps) <> semi -}
-phrase2C (IfThenElse (expr) phrase1 mphrase2) = do
- e <- expr2C expr
- p1 <- (phrase2C . wrapPhrase) phrase1
- el <- elsePart
- return $
- text "if" <> parens e $+$ p1 $+$ el
- where
- elsePart | isNothing mphrase2 = return $ empty
- | otherwise = liftM (text "else" $$) $ (phrase2C . wrapPhrase) (fromJust mphrase2)
-phrase2C (Assignment ref expr) = do
- r <- ref2C ref
- t <- gets lastType
- case (t, expr) of
- (BTFunction {}, (Reference r')) -> do
- e <- ref2C r'
- return $ r <+> text "=" <+> e <> semi
- (BTString, _) -> do
- e <- expr2C expr
- lt <- gets lastType
- case lt of
- -- assume pointer to char for simplicity
- BTPointerTo _ -> do
- e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2str" BTUnknown))
- return $ r <+> text "=" <+> e <> semi
- BTString -> do
- e <- expr2C expr
- return $ r <+> text "=" <+> e <> semi
- _ -> error $ "Assignment to string from " ++ show lt
- (BTArray _ _ _, _) -> do
- case expr of
- Reference er -> do
- exprRef <- ref2C er
- exprT <- gets lastType
- case exprT of
- BTArray RangeInfinite _ _ ->
- return $ text "FIXME: assign a dynamic array to an array"
- BTArray _ _ _ -> phrase2C $
- ProcCall (FunCall
- [
- Reference $ ref
- , Reference $ RefExpression expr
- , Reference $ FunCall [expr] (SimpleReference (Identifier "sizeof" BTUnknown))
- ]
- (SimpleReference (Identifier "memcpy" BTUnknown))
- ) []
- _ -> return $ text "FIXME: assign a non-specific value to an array"
-
- _ -> return $ text "FIXME: dynamic array assignment 2"
- _ -> do
- e <- expr2C expr
- return $ r <+> text "=" <+> e <> semi
-phrase2C (WhileCycle expr phrase) = do
- e <- expr2C expr
- p <- phrase2C $ wrapPhrase phrase
- return $ text "while" <> parens e $$ p
-phrase2C (SwitchCase expr cases mphrase) = do
- e <- expr2C expr
- cs <- mapM case2C cases
- d <- dflt
- return $
- text "switch" <> parens e $+$ braces (nest 4 . vcat $ cs ++ d)
- where
- case2C :: ([InitExpression], Phrase) -> State RenderState Doc
- case2C (e, p) = do
- ies <- mapM range2C e
- ph <- phrase2C p
- return $
- vcat (map (\i -> text "case" <+> i <> colon) . concat $ ies) <> nest 4 (ph $+$ text "break;")
- dflt | isNothing mphrase = return [text "default: break;"] -- avoid compiler warning
- | otherwise = do
- ph <- mapM phrase2C $ fromJust mphrase
- return [text "default:" <+> nest 4 (vcat ph)]
-
-phrase2C wb@(WithBlock ref p) = do
- r <- ref2C ref
- t <- gets lastType
- case t of
- (BTRecord _ rs) -> withRecordNamespace (render r ++ ".") (rec2Records rs) $ phrase2C $ wrapPhrase p
- a -> do
- error $ "'with' block referencing non-record type " ++ show a ++ "\n" ++ show wb
-phrase2C (ForCycle i' e1' e2' p up) = do
- i <- id2C IOLookup i'
- iType <- gets lastIdTypeDecl
- e1 <- expr2C e1'
- e2 <- expr2C e2'
- let inc = if up then "inc" else "dec"
- let add = if up then "+ 1" else "- 1"
- let iEnd = i <> text "__end__"
- ph <- phrase2C . appendPhrase (BuiltInFunctionCall [Reference $ SimpleReference i'] (SimpleReference (Identifier inc BTUnknown))) $ wrapPhrase p
- return . braces $
- i <+> text "=" <+> e1 <> semi
- $$
- iType <+> iEnd <+> text "=" <+> e2 <> semi
- $$
- text "if" <+> (parens $ i <+> text "<=" <+> iEnd) <+> text "do" <+> ph <+>
- text "while" <> parens (i <+> text "!=" <+> iEnd <+> text add) <> semi
- where
- appendPhrase p (Phrases ps) = Phrases $ ps ++ [p]
-phrase2C (RepeatCycle e' p') = do
- e <- expr2C e'
- p <- phrase2C (Phrases p')
- return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi
-phrase2C NOP = return $ text ";"
-
-phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = do
- f <- gets currentFunctionResult
- if null f then
- return $ text "return" <> semi
- else
- return $ text "return" <+> text f <> semi
-phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi
-phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> semi
-phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <+> e <> semi) $ expr2C e
-phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "dec" BTUnknown))) = liftM (\e -> text "--" <> e <> semi) $ expr2C e
-phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "dec" BTUnknown))) = liftM2 (\a b -> a <> text " -= " <> b <> semi) (expr2C e1) (expr2C e2)
-phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "inc" BTUnknown))) = liftM (\e -> text "++" <> e <> semi) $ expr2C e
-phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "inc" BTUnknown))) = liftM2 (\a b -> a <+> text "+=" <+> b <> semi) (expr2C e1) (expr2C e2)
-phrase2C a = error $ "phrase2C: " ++ show a
-
-wrapPhrase p@(Phrases _) = p
-wrapPhrase p = Phrases [p]
-
-expr2C :: Expression -> State RenderState Doc
-expr2C (Expression s) = return $ text s
-expr2C b@(BinOp op expr1 expr2) = do
- e1 <- expr2C expr1
- t1 <- gets lastType
- e2 <- expr2C expr2
- t2 <- gets lastType
- case (op2C op, t1, t2) of
- ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction False 2 BTString))
- ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction False 2 BTString))
- ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction False 2 BTString))
- ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction False 2 BTString))
- ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction False 2 BTBool))
- ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction False 2 BTBool))
- ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction False 2 BTBool))
- ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2
- ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2
- (_, BTRecord t1 _, BTRecord t2 _) -> do
- i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier t2 undefined)]
- ref2C $ FunCall [expr1, expr2] (SimpleReference i)
- (_, BTRecord t1 _, BTInt) -> do
- -- aw, "LongInt" here is hwengine-specific hack
- i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier "LongInt" undefined)]
- ref2C $ FunCall [expr1, expr2] (SimpleReference i)
- ("in", _, _) ->
- case expr2 of
- SetExpression set -> do
- ids <- mapM (id2C IOLookup) set
- modify(\s -> s{lastType = BTBool})
- return . parens . hcat . punctuate (text " || ") . map (\i -> parens $ e1 <+> text "==" <+> i) $ ids
- _ -> error "'in' against not set expression"
- (o, _, _) | o `elem` boolOps -> do
- modify(\s -> s{lastType = BTBool})
- return $ parens e1 <+> text o <+> parens e2
- | otherwise -> do
- o' <- return $ case o of
- "/(float)" -> text "/(float)" -- pascal returns real value
- _ -> text o
- e1' <- return $ case (o, t1, t2) of
- ("-", BTInt, BTInt) -> parens $ text "(int64_t)" <+> parens e1
- _ -> parens e1
- e2' <- return $ case (o, t1, t2) of
- ("-", BTInt, BTInt) -> parens $ text "(int64_t)" <+> parens e2
- _ -> parens e2
- return $ e1' <+> o' <+> e2'
- where
- boolOps = ["==", "!=", "<", ">", "<=", ">="]
-expr2C (NumberLiteral s) = do
- modify(\s -> s{lastType = BTInt})
- return $ text s
-expr2C (FloatLiteral s) = return $ text s
-expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)
-{-expr2C (StringLiteral [a]) = do
- modify(\s -> s{lastType = BTChar})
- return . quotes . text $ escape a
- where
- escape '\'' = "\\\'"
- escape a = [a]-}
-expr2C (StringLiteral s) = addStringConst s
-expr2C (PCharLiteral s) = return . doubleQuotes $ text s
-expr2C (Reference ref) = ref2CF ref
-expr2C (PrefixOp op expr) = do
- e <- expr2C expr
- lt <- gets lastType
- case lt of
- BTRecord t _ -> do
- i <- op2CTyped op [SimpleType (Identifier t undefined)]
- ref2C $ FunCall [expr] (SimpleReference i)
- BTBool -> do
- o <- return $ case op of
- "not" -> text "!"
- _ -> text (op2C op)
- return $ o <> parens e
- _ -> return $ text (op2C op) <> parens e
-expr2C Null = return $ text "NULL"
-expr2C (CharCode a) = do
- modify(\s -> s{lastType = BTChar})
- return $ quotes $ text "\\x" <> text (showHex (read a) "")
-expr2C (HexCharCode a) = if length a <= 2 then return $ quotes $ text "\\x" <> text (map toLower a) else expr2C $ HexNumber a
-expr2C (SetExpression ids) = mapM (id2C IOLookup) ids >>= return . parens . hcat . punctuate (text " | ")
-
-expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "low" _))) = do
- e' <- liftM (map toLower . render) $ expr2C e
- lt <- gets lastType
- case lt of
- BTEnum a -> return $ int 0
- BTInt -> case e' of
- "longint" -> return $ int (-2147483648)
- BTArray {} -> return $ int 0
- _ -> error $ "BuiltInFunCall 'low' from " ++ show e ++ "\ntype: " ++ show lt
-expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "high" _))) = do
- e' <- liftM (map toLower . render) $ expr2C e
- lt <- gets lastType
- case lt of
- BTEnum a -> return . int $ length a - 1
- BTInt -> case e' of
- "longint" -> return $ int (2147483647)
- BTString -> return $ int 255
- BTArray (RangeFromTo _ n) _ _ -> initExpr2C n
- _ -> error $ "BuiltInFunCall 'high' from " ++ show e ++ "\ntype: " ++ show lt
-expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "ord" _))) = liftM parens $ expr2C e
-expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "succ" _))) = liftM (<> text " + 1") $ expr2C e
-expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "pred" _))) = liftM (<> text " - (int64_t)1") $ expr2C e
-expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "length" _))) = do
- e' <- expr2C e
- lt <- gets lastType
- modify (\s -> s{lastType = BTInt})
- case lt of
- BTString -> return $ text "fpcrtl_Length" <> parens e'
- BTArray RangeInfinite _ _ -> error $ "length() called on variable size array " ++ show e'
- BTArray (RangeFromTo _ n) _ _ -> initExpr2C (BuiltInFunction "succ" [n])
- _ -> error $ "length() called on " ++ show lt
-expr2C (BuiltInFunCall params ref) = do
- r <- ref2C ref
- t <- gets lastType
- ps <- mapM expr2C params
- case t of
- BTFunction _ _ t' -> do
- modify (\s -> s{lastType = t'})
- _ -> error $ "BuiltInFunCall lastType: " ++ show t
- return $
- r <> parens (hsep . punctuate (char ',') $ ps)
-expr2C a = error $ "Don't know how to render " ++ show a
-
-ref2CF :: Reference -> State RenderState Doc
-ref2CF (SimpleReference name) = do
- i <- id2C IOLookup name
- t <- gets lastType
- case t of
- BTFunction _ _ rt -> do
- modify(\s -> s{lastType = rt})
- return $ i <> parens empty --xymeng: removed parens
- _ -> return $ i
-ref2CF r@(RecordField (SimpleReference _) (SimpleReference _)) = do
- i <- ref2C r
- t <- gets lastType
- case t of
- BTFunction _ _ rt -> do
- modify(\s -> s{lastType = rt})
- return $ i <> parens empty
- _ -> return $ i
-ref2CF r = ref2C r
-
-ref2C :: Reference -> State RenderState Doc
--- rewrite into proper form
-ref2C (RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2)
-ref2C (RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2)
-ref2C (RecordField ref1 (RecordField ref2 ref3)) = ref2C $ RecordField (RecordField ref1 ref2) ref3
-ref2C (RecordField ref1 (FunCall params ref2)) = ref2C $ FunCall params (RecordField ref1 ref2)
-ref2C (ArrayElement (a:b:xs) ref) = ref2C $ ArrayElement (b:xs) (ArrayElement [a] ref)
--- conversion routines
-ref2C ae@(ArrayElement [expr] ref) = do
- e <- expr2C expr
- r <- ref2C ref
- t <- gets lastType
- case t of
- (BTArray _ _ t') -> modify (\st -> st{lastType = t'})
--- (BTFunctionReturn _ (BTArray _ _ t')) -> modify (\st -> st{lastType = t'})
--- (BTFunctionReturn _ (BTString)) -> modify (\st -> st{lastType = BTChar})
- (BTString) -> modify (\st -> st{lastType = BTChar})
- (BTPointerTo t) -> do
- t'' <- fromPointer (show t) =<< gets lastType
- case t'' of
- BTChar -> modify (\st -> st{lastType = BTChar})
- a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae
- a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae
- case t of
- BTString -> return $ r <> text ".s" <> brackets e
- _ -> return $ r <> brackets e
-ref2C (SimpleReference name) = id2C IOLookup name
-ref2C rf@(RecordField (Dereference ref1) ref2) = do
- r1 <- ref2C ref1
- t <- fromPointer (show ref1) =<< gets lastType
- r2 <- case t of
- BTRecord _ rs -> withRecordNamespace "" (rec2Records rs) $ ref2C ref2
- BTUnit -> error "What??"
- a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
- return $
- r1 <> text "->" <> r2
-ref2C rf@(RecordField ref1 ref2) = do
- r1 <- ref2C ref1
- t <- gets lastType
- case t of
- BTRecord _ rs -> do
- r2 <- withRecordNamespace "" (rec2Records rs) $ ref2C ref2
- return $ r1 <> text "." <> r2
- BTUnit -> withLastIdNamespace $ ref2C ref2
- a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
-ref2C d@(Dereference ref) = do
- r <- ref2C ref
- t <- fromPointer (show d) =<< gets lastType
- modify (\st -> st{lastType = t})
- return $ (parens $ text "*" <> r)
-ref2C f@(FunCall params ref) = do
- r <- fref2C ref
- t <- gets lastType
- case t of
- BTFunction _ _ t' -> do
- ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
- modify (\s -> s{lastType = t'})
- return $ r <> ps
- _ -> case (ref, params) of
- (SimpleReference i, [p]) -> ref2C $ TypeCast i p
- _ -> error $ "ref2C FunCall erroneous type cast detected: " ++ show f ++ "\nType detected: " ++ show t
- where
- fref2C (SimpleReference name) = id2C (IOLookupFunction $ length params) name
- fref2C a = ref2C a
-
-ref2C (Address ref) = do
- r <- ref2C ref
- lt <- gets lastType
- case lt of
- BTFunction True _ _ -> return $ text "&" <> parens (r <> text "__vars")
- _ -> return $ text "&" <> parens r
-ref2C (TypeCast t'@(Identifier i _) expr) = do
- lt <- expr2C expr >> gets lastType
- case (map toLower i, lt) of
- ("pchar", BTString) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar))
- ("shortstring", BTPointerTo _) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "pchar2str" $ BTString))
- (a, _) -> do
- e <- expr2C expr
- t <- id2C IOLookup t'
- return . parens $ parens t <> e
-ref2C (RefExpression expr) = expr2C expr
-
-
-op2C :: String -> String
-op2C "or" = "|"
-op2C "and" = "&"
-op2C "not" = "~"
-op2C "xor" = "^"
-op2C "div" = "/"
-op2C "mod" = "%"
-op2C "shl" = "<<"
-op2C "shr" = ">>"
-op2C "<>" = "!="
-op2C "=" = "=="
-op2C "/" = "/(float)"
-op2C a = a
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/pas2c/CMakeLists.txt Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,29 @@
+set(pas2c_sources
+ Main.hs
+ PascalBasics.hs
+ PascalParser.hs
+ PascalPreprocessor.hs
+ PascalUnitSyntaxTree.hs
+ Pas2C.hs
+ )
+
+set(pas2c_main ${CMAKE_SOURCE_DIR}/tools/pas2c/Main.hs)
+
+set(ghc_flags
+ --make ${pas2c_main}
+ -i${CMAKE_SOURCE_DIR}/tools/pas2c/
+ -o ${EXECUTABLE_OUTPUT_PATH}/pas2c${CMAKE_EXECUTABLE_SUFFIX}
+ -odir ${CMAKE_CURRENT_BINARY_DIR}
+ -hidir ${CMAKE_CURRENT_BINARY_DIR}
+ ${haskell_flags}
+ )
+
+add_custom_command(OUTPUT "${EXECUTABLE_OUTPUT_PATH}/pas2c${CMAKE_EXECUTABLE_SUFFIX}"
+ COMMAND "${ghc_executable}"
+ ARGS ${ghc_flags}
+ MAIN_DEPENDENCY ${hwserv_main}
+ DEPENDS ${hwserver_sources}
+ )
+
+add_custom_target(pas2c ALL DEPENDS "${EXECUTABLE_OUTPUT_PATH}/pas2c${CMAKE_EXECUTABLE_SUFFIX}")
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/pas2c/Main.hs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,56 @@
+module Main( main ) where
+
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
+import System.IO
+import Data.Maybe( fromMaybe )
+import Pas2C
+
+main = do
+ args <- getArgs
+ if length args == 0
+ then do
+ name <- getProgName
+ hPutStrLn stderr $ usageInfo header options
+ exitFailure
+ else do
+ case getOpt RequireOrder options args of
+ (flags, [], []) ->
+ if length args == 8 then do
+ hPutStrLn stdout $ "--------Pas2C Config--------"
+ hPutStrLn stdout $ "Main module: " ++ (args !! 1)
+ hPutStrLn stdout $ "Input path : " ++ (args !! 3)
+ hPutStrLn stdout $ "Output path: " ++ (args !! 5)
+ hPutStrLn stdout $ "Altern path: " ++ (args !! 7)
+ hPutStrLn stdout $ "----------------------------"
+ pas2C (args !! 1) ((args !! 3)++"/") ((args !! 5)++"/") ((args !! 7)++"/")
+ hPutStrLn stdout $ "----------------------------"
+ else do
+ if length args == 6 then do
+ hPutStrLn stdout $ "--------Pas2C Config--------"
+ hPutStrLn stdout $ "Main module: " ++ (args !! 1)
+ hPutStrLn stdout $ "Input path : " ++ (args !! 3)
+ hPutStrLn stdout $ "Output path: " ++ (args !! 5)
+ hPutStrLn stdout $ "Altern path: " ++ "./"
+ hPutStrLn stdout $ "----------------------------"
+ pas2C (args !! 1) ((args !! 3)++"/") ((args !! 5)++"/") "./"
+ hPutStrLn stdout $ "----------------------------"
+ else do
+ error $ usageInfo header options
+ (_, nonOpts, []) -> error $ "unrecognized arguments: " ++ unwords nonOpts
+ (_, _, msgs) -> error $ usageInfo header options
+ where header = "Freepascal to C conversion! Please use -n -i -o -a options in this order.\n"
+
+
+data Flag = HelpMessage | Name String | Input String | Output String | Alternate String
+
+options :: [OptDescr Flag]
+options = [
+ Option ['h'] ["help"] (NoArg HelpMessage) "print this help message",
+ Option ['n'] ["name"] (ReqArg Name "MAIN") "name of the main Pascal module",
+ Option ['i'] ["input"] (ReqArg Input "DIR") "input directory, where .pas files will be read",
+ Option ['o'] ["output"] (ReqArg Output "DIR") "output directory, where .c/.h files will be written",
+ Option ['a'] ["alternate"] (ReqArg Alternate "DIR") "alternate input directory, for out of source builds"
+ ]
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/pas2c/Pas2C.hs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,1172 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Pas2C where
+
+import Text.PrettyPrint.HughesPJ
+import Data.Maybe
+import Data.Char
+import Text.Parsec.Prim hiding (State)
+import Control.Monad.State
+import System.IO
+import System.Directory
+import Control.Monad.IO.Class
+import PascalPreprocessor
+import Control.Exception
+import System.IO.Error
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.List (find)
+import Numeric
+
+import PascalParser(pascalUnit)
+import PascalUnitSyntaxTree
+
+
+data InsertOption =
+ IOInsert
+ | IOInsertWithType Doc
+ | IOLookup
+ | IOLookupLast
+ | IOLookupFunction Int
+ | IODeferred
+
+data Record = Record
+ {
+ lcaseId :: String,
+ baseType :: BaseType,
+ typeDecl :: Doc
+ }
+ deriving Show
+type Records = Map.Map String [Record]
+data RenderState = RenderState
+ {
+ currentScope :: Records,
+ lastIdentifier :: String,
+ lastType :: BaseType,
+ isFunctionType :: Bool, -- set to true if the current function parameter is functiontype
+ lastIdTypeDecl :: Doc,
+ stringConsts :: [(String, String)],
+ uniqCounter :: Int,
+ toMangle :: Set.Set String,
+ enums :: [(String, [String])], -- store all declared enums
+ currentUnit :: String,
+ currentFunctionResult :: String,
+ namespaces :: Map.Map String Records
+ }
+
+rec2Records = map (\(a, b) -> Record a b empty)
+
+emptyState = RenderState Map.empty "" BTUnknown False empty [] 0 Set.empty [] "" ""
+
+getUniq :: State RenderState Int
+getUniq = do
+ i <- gets uniqCounter
+ modify(\s -> s{uniqCounter = uniqCounter s + 1})
+ return i
+
+addStringConst :: String -> State RenderState Doc
+addStringConst str = do
+ strs <- gets stringConsts
+ let a = find ((==) str . snd) strs
+ if isJust a then
+ do
+ modify (\s -> s{lastType = BTString})
+ return . text . fst . fromJust $ a
+ else
+ do
+ i <- getUniq
+ let sn = "__str" ++ show i
+ modify (\s -> s{lastType = BTString, stringConsts = (sn, str) : strs})
+ return $ text sn
+
+escapeStr :: String -> String
+escapeStr = foldr escapeChar []
+
+escapeChar :: Char -> ShowS
+escapeChar '"' s = "\\\"" ++ s
+escapeChar '\\' s = "\\\\" ++ s
+escapeChar a s = a : s
+
+strInit :: String -> Doc
+strInit a = text "STRINIT" <> parens (doubleQuotes (text $ escapeStr a))
+
+renderStringConsts :: State RenderState Doc
+renderStringConsts = liftM (vcat . map (\(a, b) -> text "static const string255" <+> (text a) <+> text "=" <+> strInit b <> semi))
+ $ gets stringConsts
+
+docToLower :: Doc -> Doc
+docToLower = text . map toLower . render
+
+pas2C :: String -> String -> String -> String -> IO ()
+pas2C fn inputPath outputPath alternateInputPath = do
+ s <- flip execStateT initState $ f fn
+ renderCFiles s outputPath
+ where
+ printLn = liftIO . hPutStrLn stdout
+ print = liftIO . hPutStr stdout
+ initState = Map.empty
+ f :: String -> StateT (Map.Map String PascalUnit) IO ()
+ f fileName = do
+ processed <- gets $ Map.member fileName
+ unless processed $ do
+ print ("Preprocessing '" ++ fileName ++ ".pas'... ")
+ fc' <- liftIO
+ $ tryJust (guard . isDoesNotExistError)
+ $ preprocess inputPath alternateInputPath (fileName ++ ".pas")
+ case fc' of
+ (Left a) -> do
+ modify (Map.insert fileName (System []))
+ printLn "doesn't exist"
+ (Right fc) -> do
+ print "ok, parsing... "
+ let ptree = parse pascalUnit fileName fc
+ case ptree of
+ (Left a) -> do
+ liftIO $ writeFile (outputPath ++ "preprocess.out") fc
+ printLn $ show a ++ "\nsee preprocess.out for preprocessed source"
+ fail "stop"
+ (Right a) -> do
+ printLn "ok"
+ modify (Map.insert fileName a)
+ mapM_ f (usesFiles a)
+
+
+renderCFiles :: Map.Map String PascalUnit -> String -> IO ()
+renderCFiles units outputPath = do
+ let u = Map.toList units
+ let nss = Map.map (toNamespace nss) units
+ --hPutStrLn stderr $ "Units: " ++ (show . Map.keys . Map.filter (not . Map.null) $ nss)
+ --writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss
+ mapM_ (toCFiles outputPath nss) u
+ where
+ toNamespace :: Map.Map String Records -> PascalUnit -> Records
+ toNamespace nss (System tvs) =
+ currentScope $ execState f (emptyState nss)
+ where
+ f = do
+ checkDuplicateFunDecls tvs
+ mapM_ (tvar2C True False True False) tvs
+ toNamespace nss (Redo tvs) = -- functions that are re-implemented, add prefix to all of them
+ currentScope $ execState f (emptyState nss){currentUnit = "fpcrtl_"}
+ where
+ f = do
+ checkDuplicateFunDecls tvs
+ mapM_ (tvar2C True False True False) tvs
+ toNamespace _ (Program {}) = Map.empty
+ toNamespace nss (Unit (Identifier i _) interface _ _ _) =
+ currentScope $ execState (interface2C interface True) (emptyState nss){currentUnit = map toLower i ++ "_"}
+
+withState' :: (RenderState -> RenderState) -> State RenderState a -> State RenderState a
+withState' f sf = do
+ st <- liftM f get
+ let (a, s) = runState sf st
+ modify(\st -> st{
+ lastType = lastType s
+ , uniqCounter = uniqCounter s
+ , stringConsts = stringConsts s
+ })
+ return a
+
+withLastIdNamespace f = do
+ li <- gets lastIdentifier
+ nss <- gets namespaces
+ withState' (\st -> st{currentScope = fromMaybe Map.empty $ Map.lookup li (namespaces st)}) f
+
+withRecordNamespace :: String -> [Record] -> State RenderState Doc -> State RenderState Doc
+withRecordNamespace _ [] = error "withRecordNamespace: empty record"
+withRecordNamespace prefix recs = withState' f
+ where
+ f st = st{currentScope = Map.unionWith un records (currentScope st), currentUnit = ""}
+ records = Map.fromList $ map (\(Record a b d) -> (map toLower a, [Record (prefix ++ a) b d])) recs
+ un [a] b = a : b
+
+toCFiles :: String -> Map.Map String Records -> (String, PascalUnit) -> IO ()
+toCFiles _ _ (_, System _) = return ()
+toCFiles _ _ (_, Redo _) = return ()
+toCFiles outputPath ns p@(fn, pu) = do
+ hPutStrLn stdout $ "Rendering '" ++ fn ++ "'..."
+ toCFiles' p
+ where
+ toCFiles' (fn, p@(Program {})) = writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p
+ toCFiles' (fn, (Unit unitId@(Identifier i _) interface implementation _ _)) = do
+ let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface True) initialState{currentUnit = map toLower i ++ "_"}
+ (a', s') = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface False) initialState{currentUnit = map toLower i ++ "_"}
+ enumDecl = (renderEnum2Strs (enums s) False)
+ enumImpl = (renderEnum2Strs (enums s) True)
+ writeFile (outputPath ++ fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text "")) ++ "\n" ++ enumDecl
+ writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation ++ "\n" ++ enumImpl
+ initialState = emptyState ns
+
+ render2C :: RenderState -> State RenderState Doc -> String
+ render2C st p =
+ let (a, s) = runState p st in
+ render a
+
+renderEnum2Strs :: [(String, [String])] -> Bool -> String
+renderEnum2Strs enums implement =
+ render $ foldl ($+$) empty $ map (\en -> let d = decl (fst en) in if implement then d $+$ enum2strBlock (snd en) else d <> semi) enums
+ where
+ decl id = text "string255 __attribute__((overloadable)) fpcrtl_GetEnumName" <> parens (text "int dummy, const" <+> text id <+> text "enumvar")
+ enum2strBlock en =
+ text "{"
+ $+$
+ (nest 4 $
+ text "switch(enumvar){"
+ $+$
+ (foldl ($+$) empty $ map (\e -> text "case" <+> text e <> colon $+$ (nest 4 $ text "return fpcrtl_make_string" <> (parens $ doubleQuotes $ text e) <> semi $+$ text "break;")) en)
+ $+$
+ text "default: assert(0);"
+ $+$
+ (nest 4 $ text "return fpcrtl_make_string(\"nonsense\");")
+ $+$
+ text "}"
+ )
+ $+$
+ text "}"
+
+usesFiles :: PascalUnit -> [String]
+usesFiles (Program _ (Implementation uses _) _) = ["pas2cSystem", "pas2cRedo"] ++ uses2List uses
+usesFiles (Unit _ (Interface uses1 _) (Implementation uses2 _) _ _) = ["pas2cSystem", "pas2cRedo"] ++ uses2List uses1 ++ uses2List uses2
+usesFiles (System {}) = []
+usesFiles (Redo {}) = []
+
+pascal2C :: PascalUnit -> State RenderState Doc
+pascal2C (Unit _ interface implementation init fin) =
+ liftM2 ($+$) (interface2C interface True) (implementation2C implementation)
+
+pascal2C (Program _ implementation mainFunction) = do
+ impl <- implementation2C implementation
+ [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" (BTInt True)) False False (SimpleType $ Identifier "int" (BTInt True)) [VarDeclaration False False ([Identifier "argc" (BTInt True)], SimpleType (Identifier "Integer" (BTInt True))) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction)))
+
+ return $ impl $+$ main
+
+
+-- the second bool indicates whether do normal interface translation or generate variable declarations
+-- that will be inserted into implementation files
+interface2C :: Interface -> Bool -> State RenderState Doc
+interface2C (Interface uses tvars) True = do
+ u <- uses2C uses
+ tv <- typesAndVars2C True True True tvars
+ r <- renderStringConsts
+ return (u $+$ r $+$ tv)
+interface2C (Interface uses tvars) False = do
+ u <- uses2C uses
+ tv <- typesAndVars2C True False False tvars
+ r <- renderStringConsts
+ return tv
+
+implementation2C :: Implementation -> State RenderState Doc
+implementation2C (Implementation uses tvars) = do
+ u <- uses2C uses
+ tv <- typesAndVars2C True False True tvars
+ r <- renderStringConsts
+ return (u $+$ r $+$ tv)
+
+checkDuplicateFunDecls :: [TypeVarDeclaration] -> State RenderState ()
+checkDuplicateFunDecls tvs =
+ modify $ \s -> s{toMangle = Map.keysSet . Map.filter (> 1) . foldr ins initMap $ tvs}
+ where
+ initMap = Map.empty
+ --initMap = Map.fromList [("reset", 2)]
+ ins (FunctionDeclaration (Identifier i _) _ _ _ _ _) m = Map.insertWith (+) (map toLower i) 1 m
+ ins _ m = m
+
+-- the second bool indicates whether declare variable as extern or not
+-- the third bool indicates whether include types or not
+
+typesAndVars2C :: Bool -> Bool -> Bool -> TypesAndVars -> State RenderState Doc
+typesAndVars2C b externVar includeType(TypesAndVars ts) = do
+ checkDuplicateFunDecls ts
+ liftM (vcat . map (<> semi) . concat) $ mapM (tvar2C b externVar includeType False) ts
+
+setBaseType :: BaseType -> Identifier -> Identifier
+setBaseType bt (Identifier i _) = Identifier i bt
+
+uses2C :: Uses -> State RenderState Doc
+uses2C uses@(Uses unitIds) = do
+
+ mapM_ injectNamespace (Identifier "pas2cSystem" undefined : unitIds)
+ mapM_ injectNamespace (Identifier "pas2cRedo" undefined : unitIds)
+ mapM_ (id2C IOInsert . setBaseType BTUnit) unitIds
+ return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses
+ where
+ injectNamespace (Identifier i _) = do
+ getNS <- gets (flip Map.lookup . namespaces)
+ modify (\s -> s{currentScope = Map.unionWith (++) (fromMaybe Map.empty (getNS i)) $ currentScope s})
+
+uses2List :: Uses -> [String]
+uses2List (Uses ids) = map (\(Identifier i _) -> i) ids
+
+
+setLastIdValues vv = (\s -> s{lastType = baseType vv, lastIdentifier = lcaseId vv, lastIdTypeDecl = typeDecl vv})
+
+id2C :: InsertOption -> Identifier -> State RenderState Doc
+id2C IOInsert i = id2C (IOInsertWithType empty) i
+id2C (IOInsertWithType d) (Identifier i t) = do
+ ns <- gets currentScope
+ tom <- gets (Set.member n . toMangle)
+ cu <- gets currentUnit
+ let (i', t') = case (t, tom) of
+ (BTFunction _ p _, True) -> (cu ++ i ++ ('_' : show (length p)), t)
+ (BTFunction _ _ _, _) -> (cu ++ i, t)
+ (BTVarParam t', _) -> ('(' : '*' : i ++ ")" , t')
+ _ -> (i, t)
+ modify (\s -> s{currentScope = Map.insertWith (++) n [Record i' t' d] (currentScope s), lastIdentifier = n})
+ return $ text i'
+ where
+ n = map toLower i
+
+id2C IOLookup i = id2CLookup head i
+id2C IOLookupLast i = id2CLookup last i
+id2C (IOLookupFunction params) (Identifier i t) = do
+ let i' = map toLower i
+ v <- gets $ Map.lookup i' . currentScope
+ lt <- gets lastType
+ if isNothing v then
+ error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt ++ "\nwith num of params = " ++ show params ++ "\n" ++ show v
+ else
+ let vv = fromMaybe (head $ fromJust v) . find checkParam $ fromJust v in
+ modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
+ where
+ checkParam (Record _ (BTFunction _ p _) _) = (length p) == params
+ checkParam _ = False
+id2C IODeferred (Identifier i t) = do
+ let i' = map toLower i
+ v <- gets $ Map.lookup i' . currentScope
+ if (isNothing v) then
+ modify (\s -> s{lastType = BTUnknown, lastIdentifier = i}) >> return (text i)
+ else
+ let vv = head $ fromJust v in modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
+
+id2CLookup :: ([Record] -> Record) -> Identifier -> State RenderState Doc
+id2CLookup f (Identifier i t) = do
+ let i' = map toLower i
+ v <- gets $ Map.lookup i' . currentScope
+ lt <- gets lastType
+ if isNothing v then
+ error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt
+ else
+ let vv = f $ fromJust v in modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
+
+
+
+id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc
+id2CTyped = id2CTyped2 Nothing
+
+id2CTyped2 :: Maybe Doc -> TypeDecl -> Identifier -> State RenderState Doc
+id2CTyped2 md t (Identifier i _) = do
+ tb <- resolveType t
+ case (t, tb) of
+ (_, BTUnknown) -> do
+ error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t
+ (SimpleType {}, BTRecord _ r) -> do
+ ts <- type2C t
+ id2C (IOInsertWithType $ ts empty) (Identifier i (BTRecord (render $ ts empty) r))
+ (_, BTRecord _ r) -> do
+ ts <- type2C t
+ id2C (IOInsertWithType $ ts empty) (Identifier i (BTRecord i r))
+ _ -> case md of
+ Nothing -> id2C IOInsert (Identifier i tb)
+ Just ts -> id2C (IOInsertWithType ts) (Identifier i tb)
+
+typeVarDecl2BaseType :: [TypeVarDeclaration] -> State RenderState [(Bool, BaseType)]
+typeVarDecl2BaseType d = do
+ st <- get
+ result <- sequence $ concat $ map resolveType' d
+ put st -- restore state (not sure if necessary)
+ return result
+ where
+ resolveType' :: TypeVarDeclaration -> [State RenderState (Bool, BaseType)]
+ resolveType' (VarDeclaration isVar _ (ids, t) _) = replicate (length ids) (resolveTypeHelper' (resolveType t) isVar)
+ resolveType' _ = error "typeVarDecl2BaseType: not a VarDeclaration"
+ resolveTypeHelper' :: State RenderState BaseType -> Bool -> State RenderState (Bool, BaseType)
+ resolveTypeHelper' st b = do
+ bt <- st
+ return (b, bt)
+
+resolveType :: TypeDecl -> State RenderState BaseType
+resolveType st@(SimpleType (Identifier i _)) = do
+ let i' = map toLower i
+ v <- gets $ Map.lookup i' . currentScope
+ if isJust v then return . baseType . head $ fromJust v else return $ f i'
+ where
+ f "uinteger" = BTInt False
+ f "integer" = BTInt True
+ f "pointer" = BTPointerTo BTVoid
+ f "boolean" = BTBool
+ f "float" = BTFloat
+ f "char" = BTChar
+ f "string" = BTString
+ f _ = error $ "Unknown system type: " ++ show st
+resolveType (PointerTo (SimpleType (Identifier i _))) = return . BTPointerTo $ BTUnresolved (map toLower i)
+resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
+resolveType (RecordType tv mtvs) = do
+ tvs <- mapM f (concat $ tv : fromMaybe [] mtvs)
+ return . BTRecord "" . concat $ tvs
+ where
+ f :: TypeVarDeclaration -> State RenderState [(String, BaseType)]
+ f (VarDeclaration _ _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
+resolveType (ArrayDecl (Just i) t) = do
+ t' <- resolveType t
+ return $ BTArray i (BTInt True) t'
+resolveType (ArrayDecl Nothing t) = liftM (BTArray RangeInfinite (BTInt True)) $ resolveType t
+resolveType (FunctionType t a) = do
+ bts <- typeVarDecl2BaseType a
+ liftM (BTFunction False bts) $ resolveType t
+resolveType (DeriveType (InitHexNumber _)) = return (BTInt True)
+resolveType (DeriveType (InitNumber _)) = return (BTInt True)
+resolveType (DeriveType (InitFloat _)) = return BTFloat
+resolveType (DeriveType (InitString _)) = return BTString
+resolveType (DeriveType (InitBinOp {})) = return (BTInt True)
+resolveType (DeriveType (InitPrefixOp _ e)) = initExpr2C e >> gets lastType
+resolveType (DeriveType (BuiltInFunction{})) = return (BTInt True)
+resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
+resolveType (DeriveType _) = return BTUnknown
+resolveType (String _) = return BTString
+resolveType VoidType = return BTVoid
+resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
+resolveType (RangeType _) = return $ BTVoid
+resolveType (Set t) = liftM BTSet $ resolveType t
+resolveType (VarParamType t) = liftM BTVarParam $ resolveType t
+
+
+resolve :: String -> BaseType -> State RenderState BaseType
+resolve s (BTUnresolved t) = do
+ v <- gets $ Map.lookup t . currentScope
+ if isJust v then
+ resolve s . baseType . head . fromJust $ v
+ else
+ error $ "Unknown type " ++ show t ++ "\n" ++ s
+resolve _ t = return t
+
+fromPointer :: String -> BaseType -> State RenderState BaseType
+fromPointer s (BTPointerTo t) = resolve s t
+fromPointer s t = do
+ error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s
+
+
+functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False False True True) params
+
+numberOfDeclarations :: [TypeVarDeclaration] -> Int
+numberOfDeclarations = sum . map cnt
+ where
+ cnt (VarDeclaration _ _ (ids, _) _) = length ids
+ cnt _ = 1
+
+hasPassByReference :: [TypeVarDeclaration] -> Bool
+hasPassByReference = or . map isVar
+ where
+ isVar (VarDeclaration v _ (_, _) _) = v
+ isVar _ = error $ "hasPassByReference called not on function parameters"
+
+toIsVarList :: [TypeVarDeclaration] -> [Bool]
+toIsVarList = concatMap isVar
+ where
+ isVar (VarDeclaration v _ (p, _) _) = replicate (length p) v
+ isVar _ = error $ "toIsVarList called not on function parameters"
+
+
+funWithVarsToDefine :: String -> [TypeVarDeclaration] -> Doc
+funWithVarsToDefine n params = text "#define" <+> text n <> parens abc <+> text (n ++ "__vars") <> parens cparams
+ where
+ abc = hcat . punctuate comma . map (char . fst) $ ps
+ cparams = hcat . punctuate comma . map (\(c, v) -> if v then char '&' <> parens (char c) else char c) $ ps
+ ps = zip ['a'..] (toIsVarList params)
+
+fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc]
+fun2C _ _ (FunctionDeclaration name inline overload returnType params Nothing) = do
+ t <- type2C returnType
+ t'<- gets lastType
+ bts <- typeVarDecl2BaseType params
+ p <- withState' id $ functionParams2C params
+ n <- liftM render . id2C IOInsert $ setBaseType (BTFunction False bts t') name
+ let decor = if overload then text "__attribute__((overloadable))" else empty
+ return [t empty <+> decor <+> text n <> parens p]
+
+fun2C True rv (FunctionDeclaration name@(Identifier i bt) inline overload returnType params (Just (tvars, phrase))) = do
+ let isVoid = case returnType of
+ VoidType -> True
+ _ -> False
+
+ let res = docToLower $ text rv <> if isVoid then empty else text "_result"
+ t <- type2C returnType
+ t' <- gets lastType
+
+ bts <- typeVarDecl2BaseType params
+ cu <- gets currentUnit
+ notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope
+
+ n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars bts t') name
+ let resultId = if isVoid
+ then n -- void type doesn't have result, solving recursive procedure calls
+ else (render res)
+
+ (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [Record resultId (if isVoid then (BTFunction hasVars bts t') else t') empty] $ currentScope st
+ , currentFunctionResult = if isVoid then [] else render res}) $ do
+ p <- functionParams2C params
+ ph <- liftM2 ($+$) (typesAndVars2C False False True tvars) (phrase2C' phrase)
+ return (p, ph)
+
+ let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
+ let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty
+ let inlineDecor = if inline then case notDeclared of
+ True -> text "static inline"
+ False -> text "inline"
+ else empty
+ overloadDecor = if overload then text "__attribute__((overloadable))" else empty
+ return [
+ --define
+ -- $+$
+ --(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$
+ inlineDecor <+> t empty <+> overloadDecor <+> text n <> parens p
+ $+$
+ text "{"
+ $+$
+ nest 4 phrasesBlock
+ $+$
+ text "}"]
+ where
+ phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p
+ phrase2C' p = phrase2C p
+ un [a] b = a : b
+ hasVars = hasPassByReference params
+
+fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _ _ _) = error $ "nested functions not allowed: " ++ name
+fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv
+
+-- the second bool indicates whether declare variable as extern or not
+-- the third bool indicates whether include types or not
+-- the fourth bool indicates whether ignore initialization or not (basically for dynamic arrays since we cannot do initialization in function params)
+tvar2C :: Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc]
+tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _ _) = do
+ t <- fun2C b name f
+ if includeType then return t else return []
+tvar2C _ _ includeType _ td@(TypeDeclaration i' t) = do
+ i <- id2CTyped t i'
+ tp <- type2C t
+ let res = if includeType then [text "typedef" <+> tp i] else []
+ case t of
+ (Sequence ids) -> do
+ modify(\s -> s{enums = (render i, map (\(Identifier i _) -> i) ids) : enums s})
+ return res
+ _ -> return res
+
+tvar2C _ _ _ _ (VarDeclaration True _ (ids, t) Nothing) = do
+ t' <- liftM ((empty <+>) . ) $ type2C t
+ liftM (map(\i -> t' i)) $ mapM (id2CTyped2 (Just $ t' empty) (VarParamType t)) ids
+
+tvar2C _ externVar includeType ignoreInit (VarDeclaration _ isConst (ids, t) mInitExpr) = do
+ t' <- liftM (((if isConst then text "static const" else if externVar
+ then text "extern"
+ else empty)
+ <+>) . ) $ type2C t
+ ie <- initExpr mInitExpr
+ lt <- gets lastType
+ case (isConst, lt, ids, mInitExpr) of
+ (True, BTInt _, [i], Just _) -> do
+ i' <- id2CTyped t i
+ return $ if includeType then [text "enum" <> braces (i' <+> ie)] else []
+ (True, BTFloat, [i], Just e) -> do
+ i' <- id2CTyped t i
+ ie <- initExpr2C e
+ return $ if includeType then [text "#define" <+> i' <+> parens ie <> text "\n"] else []
+ (_, BTFunction{}, _, Nothing) -> liftM (map(\i -> t' i)) $ mapM (id2CTyped t) ids
+ (_, BTArray r _ _, [i], _) -> do
+ i' <- id2CTyped t i
+ ie' <- return $ case (r, mInitExpr, ignoreInit) of
+ (RangeInfinite, Nothing, False) -> text "= NULL" -- force dynamic array to be initialized as NULL if not initialized at all
+ (_, _, _) -> ie
+ result <- liftM (map(\i -> varDeclDecision isConst includeType (t' i) ie')) $ mapM (id2CTyped t) ids
+ case (r, ignoreInit) of
+ (RangeInfinite, False) ->
+ -- if the array is dynamic, add dimension info to it
+ return $ [dimDecl] ++ result
+ where
+ arrayDimStr = show $ arrayDimension t
+ arrayDimInitExp = text ("={" ++ ".dim = " ++ arrayDimStr ++ ", .a = {0, 0, 0, 0}}")
+ dimDecl = varDeclDecision isConst includeType (text "fpcrtl_dimension_t" <+> i' <> text "_dimension_info") arrayDimInitExp
+
+ (_, _) -> return result
+
+ _ -> liftM (map(\i -> varDeclDecision isConst includeType (t' i) ie)) $ mapM (id2CTyped2 (Just $ t' empty) t) ids
+ where
+ initExpr Nothing = return $ empty
+ initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e)
+ varDeclDecision True True varStr expStr = varStr <+> expStr
+ varDeclDecision False True varStr expStr = if externVar then varStr else varStr <+> expStr
+ varDeclDecision False False varStr expStr = varStr <+> expStr
+ varDeclDecision True False varStr expStr = empty
+ arrayDimension a = case a of
+ ArrayDecl Nothing t -> let a = arrayDimension t in if a > 3 then error "Dynamic array with dimension > 4 is not supported." else 1 + arrayDimension t
+ ArrayDecl _ _ -> error "Mixed dynamic array and static array are not supported."
+ _ -> 0
+
+tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do
+ r <- op2CTyped op (extractTypes params)
+ fun2C f i (FunctionDeclaration r inline False ret params body)
+
+
+op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier
+op2CTyped op t = do
+ t' <- liftM (render . hcat . punctuate (char '_') . map (\t -> t empty)) $ mapM type2C t
+ bt <- gets lastType
+ return $ Identifier (t' ++ "_op_" ++ opStr) bt
+ where
+ opStr = case op of
+ "+" -> "add"
+ "-" -> "sub"
+ "*" -> "mul"
+ "/" -> "div"
+ "/(float)" -> "div"
+ "=" -> "eq"
+ "<" -> "lt"
+ ">" -> "gt"
+ "<>" -> "neq"
+ _ -> error $ "op2CTyped: unknown op '" ++ op ++ "'"
+
+extractTypes :: [TypeVarDeclaration] -> [TypeDecl]
+extractTypes = concatMap f
+ where
+ f (VarDeclaration _ _ (ids, t) _) = replicate (length ids) t
+ f a = error $ "extractTypes: can't extract from " ++ show a
+
+initExpr2C, initExpr2C' :: InitExpression -> State RenderState Doc
+initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values
+initExpr2C a = initExpr2C' a
+initExpr2C' InitNull = return $ text "NULL"
+initExpr2C' (InitAddress expr) = do
+ ie <- initExpr2C' expr
+ lt <- gets lastType
+ case lt of
+ BTFunction True _ _ -> return $ text "&" <> ie -- <> text "__vars"
+ _ -> return $ text "&" <> ie
+initExpr2C' (InitPrefixOp op expr) = liftM (text (op2C op) <>) (initExpr2C' expr)
+initExpr2C' (InitBinOp op expr1 expr2) = do
+ e1 <- initExpr2C' expr1
+ e2 <- initExpr2C' expr2
+ return $ parens $ e1 <+> text (op2C op) <+> e2
+initExpr2C' (InitNumber s) = do
+ modify(\s -> s{lastType = (BTInt True)})
+ return $ text s
+initExpr2C' (InitFloat s) = return $ text s
+initExpr2C' (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)
+initExpr2C' (InitString [a]) = return . quotes $ text [a]
+initExpr2C' (InitString s) = return $ strInit s
+initExpr2C' (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
+initExpr2C' (InitReference i) = id2C IOLookup i
+initExpr2C' (InitRecord fields) = do
+ (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields
+ return $ lbrace $+$ (nest 4 . vcat . punctuate comma $ fs) $+$ rbrace
+initExpr2C' (InitArray [value]) = initExpr2C value
+initExpr2C' r@(InitRange (Range i@(Identifier i' _))) = do
+ id2C IOLookup i
+ t <- gets lastType
+ case t of
+ BTEnum s -> return . int $ length s
+ BTInt _ -> case i' of
+ "byte" -> return $ int 256
+ _ -> error $ "InitRange identifier: " ++ i'
+ _ -> error $ "InitRange: " ++ show r
+initExpr2C' (InitRange (RangeFromTo (InitNumber "0") r)) = initExpr2C $ BuiltInFunction "succ" [r]
+initExpr2C' (InitRange (RangeFromTo (InitChar "0") (InitChar r))) = initExpr2C $ BuiltInFunction "succ" [InitNumber r]
+initExpr2C' (InitRange a) = error $ show a --return $ text "<<range>>"
+initExpr2C' (InitSet []) = return $ text "0"
+initExpr2C' (InitSet a) = return $ text "<<set>>"
+initExpr2C' (BuiltInFunction "low" [InitReference e]) = return $
+ case e of
+ (Identifier "LongInt" _) -> int (-2^31)
+ (Identifier "SmallInt" _) -> int (-2^15)
+ _ -> error $ "BuiltInFunction 'low': " ++ show e
+initExpr2C' (BuiltInFunction "high" [e]) = do
+ initExpr2C e
+ t <- gets lastType
+ case t of
+ (BTArray i _ _) -> initExpr2C' $ BuiltInFunction "pred" [InitRange i]
+ a -> error $ "BuiltInFunction 'high': " ++ show a
+initExpr2C' (BuiltInFunction "succ" [BuiltInFunction "pred" [e]]) = initExpr2C' e
+initExpr2C' (BuiltInFunction "pred" [BuiltInFunction "succ" [e]]) = initExpr2C' e
+initExpr2C' (BuiltInFunction "succ" [e]) = liftM (<> text " + 1") $ initExpr2C' e
+initExpr2C' (BuiltInFunction "pred" [e]) = liftM (<> text " - 1") $ initExpr2C' e
+initExpr2C' b@(BuiltInFunction _ _) = error $ show b
+initExpr2C' a = error $ "initExpr2C: don't know how to render " ++ show a
+
+
+range2C :: InitExpression -> State RenderState [Doc]
+range2C (InitString [a]) = return [quotes $ text [a]]
+range2C (InitRange (Range i)) = liftM (flip (:) []) $ id2C IOLookup i
+range2C (InitRange (RangeFromTo (InitString [a]) (InitString [b]))) = return $ map (\i -> quotes $ text [i]) [a..b]
+range2C a = liftM (flip (:) []) $ initExpr2C a
+
+baseType2C :: String -> BaseType -> Doc
+baseType2C _ BTFloat = text "float"
+baseType2C _ BTBool = text "bool"
+baseType2C _ BTString = text "string255"
+baseType2C s a = error $ "baseType2C: " ++ show a ++ "\n" ++ s
+
+type2C :: TypeDecl -> State RenderState (Doc -> Doc)
+type2C (SimpleType i) = liftM (\i a -> i <+> a) $ id2C IOLookup i
+type2C t = do
+ r <- type2C' t
+ rt <- resolveType t
+ modify (\st -> st{lastType = rt})
+ return r
+ where
+ type2C' VoidType = return (text "void" <+>)
+ type2C' (String l) = return (text "string255" <+>)--return (text ("string" ++ show l) <+>)
+ type2C' (PointerTo (SimpleType i)) = do
+ i' <- id2C IODeferred i
+ lt <- gets lastType
+ case lt of
+ BTRecord _ _ -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
+ BTUnknown -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
+ _ -> return $ \a -> i' <+> text "*" <+> a
+ type2C' (PointerTo t) = liftM (\t a -> t (parens $ text "*" <> a)) $ type2C t
+ type2C' (RecordType tvs union) = do
+ t <- withState' f $ mapM (tvar2C False False True False) tvs
+ u <- unions
+ return $ \i -> text "struct __" <> i <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i
+ where
+ f s = s{currentUnit = ""}
+ unions = case union of
+ Nothing -> return empty
+ Just a -> do
+ structs <- mapM struct2C a
+ return $ text "union" $+$ braces (nest 4 $ vcat structs) <> semi
+ struct2C tvs = do
+ t <- withState' f $ mapM (tvar2C False False True False) tvs
+ return $ text "struct" $+$ braces (nest 4 (vcat . map (<> semi) . concat $ t)) <> semi
+ type2C' (RangeType r) = return (text "int" <+>)
+ type2C' (Sequence ids) = do
+ is <- mapM (id2C IOInsert . setBaseType bt) ids
+ return (text "enum" <+> (braces . vcat . punctuate comma . map (\(a, b) -> a <+> equals <+> text "0x" <> text (showHex b "")) $ zip is [0..]) <+>)
+ where
+ bt = BTEnum $ map (\(Identifier i _) -> map toLower i) ids
+ type2C' (ArrayDecl Nothing t) = type2C (PointerTo t)
+ type2C' (ArrayDecl (Just r) t) = do
+ t' <- type2C t
+ lt <- gets lastType
+ ft <- case lt of
+ -- BTFunction {} -> type2C (PointerTo t)
+ _ -> return t'
+ r' <- initExpr2C (InitRange r)
+ return $ \i -> ft i <> brackets r'
+ type2C' (Set t) = return (text "<<set>>" <+>)
+ type2C' (FunctionType returnType params) = do
+ t <- type2C returnType
+ p <- withState' id $ functionParams2C params
+ return (\i -> (t empty <> (parens $ text "*" <> i) <> parens p))
+ type2C' (DeriveType (InitBinOp _ _ i)) = type2C' (DeriveType i)
+ type2C' (DeriveType (InitPrefixOp _ i)) = type2C' (DeriveType i)
+ type2C' (DeriveType (InitNumber _)) = return (text "int" <+>)
+ type2C' (DeriveType (InitHexNumber _)) = return (text "int" <+>)
+ type2C' (DeriveType (InitFloat _)) = return (text "float" <+>)
+ type2C' (DeriveType (BuiltInFunction {})) = return (text "int" <+>)
+ type2C' (DeriveType (InitString {})) = return (text "string255" <+>)
+ type2C' (DeriveType r@(InitReference {})) = do
+ initExpr2C r
+ t <- gets lastType
+ return (baseType2C (show r) t <+>)
+ type2C' (DeriveType a) = error $ "Can't derive type from " ++ show a
+
+phrase2C :: Phrase -> State RenderState Doc
+phrase2C (Phrases p) = do
+ ps <- mapM phrase2C p
+ return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}"
+phrase2C (ProcCall f@(FunCall {}) []) = liftM (<> semi) $ ref2C f
+phrase2C (ProcCall ref []) = liftM (<> semi) $ ref2CF ref True
+phrase2C (ProcCall ref params) = error $ "ProcCall"{-do
+ r <- ref2C ref
+ ps <- mapM expr2C params
+ return $ r <> parens (hsep . punctuate (char ',') $ ps) <> semi -}
+phrase2C (IfThenElse (expr) phrase1 mphrase2) = do
+ e <- expr2C expr
+ p1 <- (phrase2C . wrapPhrase) phrase1
+ el <- elsePart
+ return $
+ text "if" <> parens e $+$ p1 $+$ el
+ where
+ elsePart | isNothing mphrase2 = return $ empty
+ | otherwise = liftM (text "else" $$) $ (phrase2C . wrapPhrase) (fromJust mphrase2)
+phrase2C (Assignment ref expr) = do
+ r <- ref2C ref
+ t <- gets lastType
+ case (t, expr) of
+ (BTFunction {}, (Reference r')) -> do
+ e <- ref2C r'
+ return $ r <+> text "=" <+> e <> semi
+ (BTString, _) -> do
+ e <- expr2C expr
+ lt <- gets lastType
+ case lt of
+ -- assume pointer to char for simplicity
+ BTPointerTo _ -> do
+ e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2str" BTUnknown))
+ return $ r <+> text "=" <+> e <> semi
+ BTString -> do
+ e <- expr2C expr
+ return $ r <+> text "=" <+> e <> semi
+ _ -> error $ "Assignment to string from " ++ show lt
+ (BTArray _ _ _, _) -> do
+ case expr of
+ Reference er -> do
+ exprRef <- ref2C er
+ exprT <- gets lastType
+ case exprT of
+ BTArray RangeInfinite _ _ ->
+ return $ text "FIXME: assign a dynamic array to an array"
+ BTArray _ _ _ -> phrase2C $
+ ProcCall (FunCall
+ [
+ Reference $ ref
+ , Reference $ RefExpression expr
+ , Reference $ FunCall [expr] (SimpleReference (Identifier "sizeof" BTUnknown))
+ ]
+ (SimpleReference (Identifier "memcpy" BTUnknown))
+ ) []
+ _ -> return $ text "FIXME: assign a non-specific value to an array"
+
+ _ -> return $ text "FIXME: dynamic array assignment 2"
+ _ -> do
+ e <- expr2C expr
+ return $ r <+> text "=" <+> e <> semi
+phrase2C (WhileCycle expr phrase) = do
+ e <- expr2C expr
+ p <- phrase2C $ wrapPhrase phrase
+ return $ text "while" <> parens e $$ p
+phrase2C (SwitchCase expr cases mphrase) = do
+ e <- expr2C expr
+ cs <- mapM case2C cases
+ d <- dflt
+ return $
+ text "switch" <> parens e $+$ braces (nest 4 . vcat $ cs ++ d)
+ where
+ case2C :: ([InitExpression], Phrase) -> State RenderState Doc
+ case2C (e, p) = do
+ ies <- mapM range2C e
+ ph <- phrase2C p
+ return $
+ vcat (map (\i -> text "case" <+> i <> colon) . concat $ ies) <> nest 4 (ph $+$ text "break;")
+ dflt | isNothing mphrase = return [text "default: break;"] -- avoid compiler warning
+ | otherwise = do
+ ph <- mapM phrase2C $ fromJust mphrase
+ return [text "default:" <+> nest 4 (vcat ph)]
+
+phrase2C wb@(WithBlock ref p) = do
+ r <- ref2C ref
+ t <- gets lastType
+ case t of
+ (BTRecord _ rs) -> withRecordNamespace (render r ++ ".") (rec2Records rs) $ phrase2C $ wrapPhrase p
+ a -> do
+ error $ "'with' block referencing non-record type " ++ show a ++ "\n" ++ show wb
+phrase2C (ForCycle i' e1' e2' p up) = do
+ i <- id2C IOLookup i'
+ iType <- gets lastIdTypeDecl
+ e1 <- expr2C e1'
+ e2 <- expr2C e2'
+ let inc = if up then "inc" else "dec"
+ let add = if up then "+ 1" else "- 1"
+ let iEnd = i <> text "__end__"
+ ph <- phrase2C . appendPhrase (BuiltInFunctionCall [Reference $ SimpleReference i'] (SimpleReference (Identifier inc BTUnknown))) $ wrapPhrase p
+ return . braces $
+ i <+> text "=" <+> e1 <> semi
+ $$
+ iType <+> iEnd <+> text "=" <+> e2 <> semi
+ $$
+ text "if" <+> (parens $ i <+> text (if up then "<=" else ">=") <+> iEnd) <+> text "do" <+> ph <+>
+ text "while" <> parens (i <+> text "!=" <+> iEnd <+> text add) <> semi
+ where
+ appendPhrase p (Phrases ps) = Phrases $ ps ++ [p]
+phrase2C (RepeatCycle e' p') = do
+ e <- expr2C e'
+ p <- phrase2C (Phrases p')
+ return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi
+
+phrase2C NOP = return $ text ";"
+
+phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = do
+ f <- gets currentFunctionResult
+ if null f then
+ return $ text "return" <> semi
+ else
+ return $ text "return" <+> text f <> semi
+phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi
+phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> semi
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <+> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "dec" BTUnknown))) = liftM (\e -> text "--" <> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "dec" BTUnknown))) = liftM2 (\a b -> a <> text " -= " <> b <> semi) (expr2C e1) (expr2C e2)
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "inc" BTUnknown))) = liftM (\e -> text "++" <> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "inc" BTUnknown))) = liftM2 (\a b -> a <+> text "+=" <+> b <> semi) (expr2C e1) (expr2C e2)
+phrase2C a = error $ "phrase2C: " ++ show a
+
+wrapPhrase p@(Phrases _) = p
+wrapPhrase p = Phrases [p]
+
+expr2C :: Expression -> State RenderState Doc
+expr2C (Expression s) = return $ text s
+expr2C b@(BinOp op expr1 expr2) = do
+ e1 <- expr2C expr1
+ t1 <- gets lastType
+ e2 <- expr2C expr2
+ t2 <- gets lastType
+ case (op2C op, t1, t2) of
+ ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction False [(False, t1), (False, t2)] BTString))
+ ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction False [(False, t1), (False, t2)] BTString))
+ ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction False [(False, t1), (False, t2)] BTString))
+ ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction False [(False, t1), (False, t2)] BTString))
+ ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction False [(False, t1), (False, t2)] BTBool))
+
+ -- for function/procedure comparision
+ ("==", BTVoid, _) -> procCompare expr1 expr2 "=="
+ ("==", BTFunction _ _ _, _) -> procCompare expr1 expr2 "=="
+
+ ("!=", BTVoid, _) -> procCompare expr1 expr2 "!="
+ ("!=", BTFunction _ _ _, _) -> procCompare expr1 expr2 "!="
+
+ ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction False [(False, t1), (False, t2)] BTBool))
+ ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction False [(False, t1), (False, t2)] BTBool))
+ ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2
+ ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2
+ (_, BTRecord t1 _, BTRecord t2 _) -> do
+ i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier t2 undefined)]
+ ref2C $ FunCall [expr1, expr2] (SimpleReference i)
+ (_, BTRecord t1 _, BTInt _) -> do
+ -- aw, "LongInt" here is hwengine-specific hack
+ i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier "LongInt" undefined)]
+ ref2C $ FunCall [expr1, expr2] (SimpleReference i)
+ ("in", _, _) ->
+ case expr2 of
+ SetExpression set -> do
+ ids <- mapM (id2C IOLookup) set
+ modify(\s -> s{lastType = BTBool})
+ return . parens . hcat . punctuate (text " || ") . map (\i -> parens $ e1 <+> text "==" <+> i) $ ids
+ _ -> error "'in' against not set expression"
+ (o, _, _) | o `elem` boolOps -> do
+ modify(\s -> s{lastType = BTBool})
+ return $ parens e1 <+> text o <+> parens e2
+ | otherwise -> do
+ o' <- return $ case o of
+ "/(float)" -> text "/(float)" -- pascal returns real value
+ _ -> text o
+ e1' <- return $ case (o, t1, t2) of
+ ("-", BTInt False, BTInt False) -> parens $ text "(int64_t)" <+> parens e1
+ _ -> parens e1
+ e2' <- return $ case (o, t1, t2) of
+ ("-", BTInt False, BTInt False) -> parens $ text "(int64_t)" <+> parens e2
+ _ -> parens e2
+ return $ e1' <+> o' <+> e2'
+ where
+ boolOps = ["==", "!=", "<", ">", "<=", ">="]
+ procCompare expr1 expr2 op =
+ case (expr1, expr2) of
+ (Reference r1, Reference r2) -> do
+ id1 <- ref2C r1
+ id2 <- ref2C r2
+ return $ (parens id1) <+> text op <+> (parens id2)
+ (_, _) -> error $ "Two non reference type vars are compared but they have type of BTVoid or BTFunction\n" ++ show expr1 ++ "\n" ++ show expr2
+
+expr2C (NumberLiteral s) = do
+ modify(\s -> s{lastType = BTInt True})
+ return $ text s
+expr2C (FloatLiteral s) = return $ text s
+expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)
+{-expr2C (StringLiteral [a]) = do
+ modify(\s -> s{lastType = BTChar})
+ return . quotes . text $ escape a
+ where
+ escape '\'' = "\\\'"
+ escape a = [a]-}
+expr2C (StringLiteral s) = addStringConst s
+expr2C (PCharLiteral s) = return . doubleQuotes $ text s
+expr2C (Reference ref) = do
+ isfunc <- gets isFunctionType
+ modify(\s -> s{isFunctionType = False}) -- reset
+ if isfunc then ref2CF ref False else ref2CF ref True
+expr2C (PrefixOp op expr) = do
+ e <- expr2C expr
+ lt <- gets lastType
+ case lt of
+ BTRecord t _ -> do
+ i <- op2CTyped op [SimpleType (Identifier t undefined)]
+ ref2C $ FunCall [expr] (SimpleReference i)
+ BTBool -> do
+ o <- return $ case op of
+ "not" -> text "!"
+ _ -> text (op2C op)
+ return $ o <> parens e
+ _ -> return $ text (op2C op) <> parens e
+expr2C Null = return $ text "NULL"
+expr2C (CharCode a) = do
+ modify(\s -> s{lastType = BTChar})
+ return $ quotes $ text "\\x" <> text (showHex (read a) "")
+expr2C (HexCharCode a) = if length a <= 2 then return $ quotes $ text "\\x" <> text (map toLower a) else expr2C $ HexNumber a
+expr2C (SetExpression ids) = mapM (id2C IOLookup) ids >>= return . parens . hcat . punctuate (text " | ")
+
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "low" _))) = do
+ e' <- liftM (map toLower . render) $ expr2C e
+ lt <- gets lastType
+ case lt of
+ BTEnum a -> return $ int 0
+ BTInt _ -> case e' of
+ "longint" -> return $ int (-2147483648)
+ BTArray {} -> return $ int 0
+ _ -> error $ "BuiltInFunCall 'low' from " ++ show e ++ "\ntype: " ++ show lt
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "high" _))) = do
+ e' <- liftM (map toLower . render) $ expr2C e
+ lt <- gets lastType
+ case lt of
+ BTEnum a -> return . int $ length a - 1
+ BTInt _ -> case e' of
+ "longint" -> return $ int (2147483647)
+ BTString -> return $ int 255
+ BTArray (RangeFromTo _ n) _ _ -> initExpr2C n
+ _ -> error $ "BuiltInFunCall 'high' from " ++ show e ++ "\ntype: " ++ show lt
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "ord" _))) = liftM parens $ expr2C e
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "succ" _))) = liftM (<> text " + 1") $ expr2C e
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "pred" _))) = do
+ e'<- expr2C e
+ return $ text "(int)" <> parens e' <> text " - 1"
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "length" _))) = do
+ e' <- expr2C e
+ lt <- gets lastType
+ modify (\s -> s{lastType = BTInt True})
+ case lt of
+ BTString -> return $ text "fpcrtl_Length" <> parens e'
+ BTArray RangeInfinite _ _ -> error $ "length() called on variable size array " ++ show e'
+ BTArray (RangeFromTo _ n) _ _ -> initExpr2C (BuiltInFunction "succ" [n])
+ _ -> error $ "length() called on " ++ show lt
+expr2C (BuiltInFunCall params ref) = do
+ r <- ref2C ref
+ t <- gets lastType
+ ps <- mapM expr2C params
+ case t of
+ BTFunction _ _ t' -> do
+ modify (\s -> s{lastType = t'})
+ _ -> error $ "BuiltInFunCall lastType: " ++ show t
+ return $
+ r <> parens (hsep . punctuate (char ',') $ ps)
+expr2C a = error $ "Don't know how to render " ++ show a
+
+ref2CF :: Reference -> Bool -> State RenderState Doc
+ref2CF (SimpleReference name) addParens = do
+ i <- id2C IOLookup name
+ t <- gets lastType
+ case t of
+ BTFunction _ _ rt -> do
+ modify(\s -> s{lastType = rt})
+ return $ if addParens then i <> parens empty else i --xymeng: removed parens
+ _ -> return $ i
+ref2CF r@(RecordField (SimpleReference _) (SimpleReference _)) addParens = do
+ i <- ref2C r
+ t <- gets lastType
+ case t of
+ BTFunction _ _ rt -> do
+ modify(\s -> s{lastType = rt})
+ return $ if addParens then i <> parens empty else i
+ _ -> return $ i
+ref2CF r _ = ref2C r
+
+ref2C :: Reference -> State RenderState Doc
+-- rewrite into proper form
+ref2C (RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2)
+ref2C (RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2)
+ref2C (RecordField ref1 (RecordField ref2 ref3)) = ref2C $ RecordField (RecordField ref1 ref2) ref3
+ref2C (RecordField ref1 (FunCall params ref2)) = ref2C $ FunCall params (RecordField ref1 ref2)
+ref2C (ArrayElement (a:b:xs) ref) = ref2C $ ArrayElement (b:xs) (ArrayElement [a] ref)
+-- conversion routines
+ref2C ae@(ArrayElement [expr] ref) = do
+ e <- expr2C expr
+ r <- ref2C ref
+ t <- gets lastType
+ case t of
+ (BTArray _ _ t') -> modify (\st -> st{lastType = t'})
+-- (BTFunctionReturn _ (BTArray _ _ t')) -> modify (\st -> st{lastType = t'})
+-- (BTFunctionReturn _ (BTString)) -> modify (\st -> st{lastType = BTChar})
+ (BTString) -> modify (\st -> st{lastType = BTChar})
+ (BTPointerTo t) -> do
+ t'' <- fromPointer (show t) =<< gets lastType
+ case t'' of
+ BTChar -> modify (\st -> st{lastType = BTChar})
+ a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae
+ a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae
+ case t of
+ BTString -> return $ r <> text ".s" <> brackets e
+ _ -> return $ r <> brackets e
+ref2C (SimpleReference name) = id2C IOLookup name
+ref2C rf@(RecordField (Dereference ref1) ref2) = do
+ r1 <- ref2C ref1
+ t <- fromPointer (show ref1) =<< gets lastType
+ r2 <- case t of
+ BTRecord _ rs -> withRecordNamespace "" (rec2Records rs) $ ref2C ref2
+ BTUnit -> error "What??"
+ a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
+ return $
+ r1 <> text "->" <> r2
+ref2C rf@(RecordField ref1 ref2) = do
+ r1 <- ref2C ref1
+ t <- gets lastType
+ case t of
+ BTRecord _ rs -> do
+ r2 <- withRecordNamespace "" (rec2Records rs) $ ref2C ref2
+ return $ r1 <> text "." <> r2
+ BTUnit -> withLastIdNamespace $ ref2C ref2
+ a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf
+ref2C d@(Dereference ref) = do
+ r <- ref2C ref
+ t <- fromPointer (show d) =<< gets lastType
+ modify (\st -> st{lastType = t})
+ return $ (parens $ text "*" <> r)
+ref2C f@(FunCall params ref) = do
+ r <- fref2C ref
+ t <- gets lastType
+ case t of
+ BTFunction _ bts t' -> do
+ ps <- liftM (parens . hsep . punctuate (char ',')) $
+ if (length params) == (length bts) -- hot fix for pas2cSystem and pas2cRedo functions since they don't have params
+ then
+ mapM expr2CHelper (zip params bts)
+ else mapM expr2C params
+ modify (\s -> s{lastType = t'})
+ return $ r <> ps
+ _ -> case (ref, params) of
+ (SimpleReference i, [p]) -> ref2C $ TypeCast i p
+ _ -> error $ "ref2C FunCall erroneous type cast detected: " ++ show f ++ "\nType detected: " ++ show t ++ "\n" ++ show ref ++ "\n" ++ show params ++ "\n" ++ show t
+ where
+ fref2C (SimpleReference name) = id2C (IOLookupFunction $ length params) name
+ fref2C a = ref2C a
+ expr2CHelper :: (Expression, (Bool, BaseType)) -> State RenderState Doc
+ expr2CHelper (e, (_, BTFunction _ _ _)) = do
+ modify (\s -> s{isFunctionType = True})
+ expr2C e
+ expr2CHelper (e, (isVar, _)) = if isVar then liftM (((<>) $ text "&") . parens) $ (expr2C e) else expr2C e
+
+ref2C (Address ref) = do
+ r <- ref2C ref
+ lt <- gets lastType
+ case lt of
+ BTFunction True _ _ -> return $ text "&" <> parens r
+ _ -> return $ text "&" <> parens r
+ref2C (TypeCast t'@(Identifier i _) expr) = do
+ lt <- expr2C expr >> gets lastType
+ case (map toLower i, lt) of
+ ("pchar", BTString) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar))
+ ("shortstring", BTPointerTo _) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "pchar2str" $ BTString))
+ (a, _) -> do
+ e <- expr2C expr
+ t <- id2C IOLookup t'
+ return . parens $ parens t <> e
+ref2C (RefExpression expr) = expr2C expr
+
+
+op2C :: String -> String
+op2C "or" = "|"
+op2C "and" = "&"
+op2C "not" = "~"
+op2C "xor" = "^"
+op2C "div" = "/"
+op2C "mod" = "%"
+op2C "shl" = "<<"
+op2C "shr" = ">>"
+op2C "<>" = "!="
+op2C "=" = "=="
+op2C "/" = "/(float)"
+op2C a = a
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/pas2c/PascalBasics.hs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,70 @@
+{-# LANGUAGE FlexibleContexts #-}
+module PascalBasics where
+
+import Text.Parsec.Combinator
+import Text.Parsec.Char
+import Text.Parsec.Prim
+import Text.Parsec.Token
+import Text.Parsec.Language
+import Data.Char
+
+builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"]
+
+pascalLanguageDef
+ = emptyDef
+ { commentStart = "(*"
+ , commentEnd = "*)"
+ , commentLine = "//"
+ , nestedComments = False
+ , identStart = letter <|> oneOf "_"
+ , identLetter = alphaNum <|> oneOf "_"
+ , opLetter = letter
+ , reservedNames = [
+ "begin", "end", "program", "unit", "interface"
+ , "implementation", "and", "or", "xor", "shl"
+ , "shr", "while", "do", "repeat", "until", "case", "of"
+ , "type", "var", "const", "out", "array", "packed"
+ , "procedure", "function", "with", "for", "to"
+ , "downto", "div", "mod", "record", "set", "nil"
+ , "cdecl", "external", "if", "then", "else"
+ ] -- ++ builtin
+ , caseSensitive = False
+ }
+
+preprocessorSwitch :: Stream s m Char => ParsecT s u m String
+preprocessorSwitch = do
+ try $ string "{$"
+ s <- manyTill (noneOf "\n") $ char '}'
+ return s
+
+caseInsensitiveString s = do
+ mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s
+ return s
+
+pas = patch $ makeTokenParser pascalLanguageDef
+ where
+ patch tp = tp {stringLiteral = stringL}
+
+comment = choice [
+ char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}')
+ , (try $ string "(*") >> manyTill anyChar (try $ string "*)")
+ , (try $ string "//") >> manyTill anyChar (try newline)
+ ]
+
+comments = do
+ spaces
+ skipMany $ do
+ preprocessorSwitch <|> comment
+ spaces
+
+stringL = do
+ (char '\'')
+ s <- (many $ noneOf "'")
+ (char '\'')
+ ss <- many $ do
+ (char '\'')
+ s' <- (many $ noneOf "'")
+ (char '\'')
+ return $ '\'' : s'
+ comments
+ return $ concat (s:ss)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/pas2c/PascalParser.hs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,672 @@
+module PascalParser where
+
+import Text.Parsec
+import Text.Parsec.Char
+import Text.Parsec.Token
+import Text.Parsec.Language
+import Text.Parsec.Expr
+import Text.Parsec.Prim
+import Text.Parsec.Combinator
+import Text.Parsec.String
+import Control.Monad
+import Data.Maybe
+import Data.Char
+
+import PascalBasics
+import PascalUnitSyntaxTree
+
+knownTypes = ["shortstring", "ansistring", "char", "byte"]
+
+pascalUnit = do
+ comments
+ u <- choice [program, unit, systemUnit, redoUnit]
+ comments
+ return u
+
+iD = do
+ i <- liftM (flip Identifier BTUnknown) (identifier pas)
+ comments
+ return i
+
+unit = do
+ string "unit" >> comments
+ name <- iD
+ semi pas
+ comments
+ int <- interface
+ impl <- implementation
+ comments
+ return $ Unit name int impl Nothing Nothing
+
+
+reference = buildExpressionParser table term <?> "reference"
+ where
+ term = comments >> choice [
+ parens pas (liftM RefExpression expression >>= postfixes) >>= postfixes
+ , try $ typeCast >>= postfixes
+ , char '@' >> liftM Address reference >>= postfixes
+ , liftM SimpleReference iD >>= postfixes
+ ] <?> "simple reference"
+
+ table = [
+ ]
+
+ postfixes r = many postfix >>= return . foldl (flip ($)) r
+ postfix = choice [
+ parens pas (option [] parameters) >>= return . FunCall
+ , char '^' >> return Dereference
+ , (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement
+ , (char '.' >> notFollowedBy (char '.')) >> liftM (flip RecordField) reference
+ ]
+
+ typeCast = do
+ t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
+ e <- parens pas expression
+ comments
+ return $ TypeCast (Identifier t BTUnknown) e
+
+varsDecl1 = varsParser sepEndBy1
+varsDecl = varsParser sepEndBy
+varsParser m endsWithSemi = do
+ vs <- m (aVarDecl endsWithSemi) (semi pas)
+ return vs
+
+aVarDecl endsWithSemi = do
+ isVar <- liftM (== Just "var") $
+ if not endsWithSemi then
+ optionMaybe $ choice [
+ try $ string "var"
+ , try $ string "const"
+ , try $ string "out"
+ ]
+ else
+ return Nothing
+ comments
+ ids <- do
+ i <- (commaSep1 pas) $ (try iD <?> "variable declaration")
+ char ':'
+ return i
+ comments
+ t <- typeDecl <?> "variable type declaration"
+ comments
+ init <- option Nothing $ do
+ char '='
+ comments
+ e <- initExpression
+ comments
+ return (Just e)
+ return $ VarDeclaration isVar False (ids, t) init
+
+
+constsDecl = do
+ vs <- many1 (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i)
+ comments
+ return vs
+ where
+ aConstDecl = do
+ comments
+ i <- iD
+ t <- optionMaybe $ do
+ char ':'
+ comments
+ t <- typeDecl
+ comments
+ return t
+ char '='
+ comments
+ e <- initExpression
+ comments
+ return $ VarDeclaration False (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e)
+
+typeDecl = choice [
+ char '^' >> typeDecl >>= return . PointerTo
+ , try (string "shortstring") >> return (String 255)
+ , try (string "string") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
+ , try (string "ansistring") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
+ , arrayDecl
+ , recordDecl
+ , setDecl
+ , functionType
+ , sequenceDecl >>= return . Sequence
+ , try iD >>= return . SimpleType
+ , rangeDecl >>= return . RangeType
+ ] <?> "type declaration"
+ where
+ arrayDecl = do
+ try $ do
+ optional $ (try $ string "packed") >> comments
+ string "array"
+ comments
+ r <- option [] $ do
+ char '['
+ r <- commaSep pas rangeDecl
+ char ']'
+ comments
+ return r
+ string "of"
+ comments
+ t <- typeDecl
+ if null r then
+ return $ ArrayDecl Nothing t
+ else
+ return $ foldr (\a b -> ArrayDecl (Just a) b) (ArrayDecl (Just $ head r) t) (tail r)
+ recordDecl = do
+ try $ do
+ optional $ (try $ string "packed") >> comments
+ string "record"
+ comments
+ vs <- varsDecl True
+ union <- optionMaybe $ do
+ string "case"
+ comments
+ iD
+ comments
+ string "of"
+ comments
+ many unionCase
+ string "end"
+ return $ RecordType vs union
+ setDecl = do
+ try $ string "set" >> space
+ comments
+ string "of"
+ comments
+ liftM Set typeDecl
+ unionCase = do
+ try $ commaSep pas $ (iD >> return ()) <|> (integer pas >> return ())
+ char ':'
+ comments
+ u <- parens pas $ varsDecl True
+ char ';'
+ comments
+ return u
+ sequenceDecl = (parens pas) $ (commaSep pas) (iD >>= \i -> optional (spaces >> char '=' >> spaces >> integer pas) >> return i)
+ functionType = do
+ fp <- try (string "function") <|> try (string "procedure")
+ comments
+ vs <- option [] $ parens pas $ varsDecl False
+ comments
+ ret <- if (fp == "function") then do
+ char ':'
+ comments
+ ret <- typeDecl
+ comments
+ return ret
+ else
+ return VoidType
+ optional $ try $ char ';' >> comments >> string "cdecl"
+ comments
+ return $ FunctionType ret vs
+
+typesDecl = many (aTypeDecl >>= \t -> comments >> return t)
+ where
+ aTypeDecl = do
+ i <- try $ do
+ i <- iD <?> "type declaration"
+ comments
+ char '='
+ return i
+ comments
+ t <- typeDecl
+ comments
+ semi pas
+ comments
+ return $ TypeDeclaration i t
+
+rangeDecl = choice [
+ try $ rangeft
+ , iD >>= return . Range
+ ] <?> "range declaration"
+ where
+ rangeft = do
+ e1 <- initExpression
+ string ".."
+ e2 <- initExpression
+ return $ RangeFromTo e1 e2
+
+typeVarDeclaration isImpl = (liftM concat . many . choice) [
+ varSection,
+ constSection,
+ typeSection,
+ funcDecl,
+ operatorDecl
+ ]
+ where
+
+ fixInit v = concat $ map (\x -> case x of
+ VarDeclaration a b (ids, t) c ->
+ let typeId = (Identifier ((\(Identifier i _) -> i) (head ids) ++ "_tt") BTUnknown) in
+ let res = [TypeDeclaration typeId t, VarDeclaration a b (ids, (SimpleType typeId)) c] in
+ case t of
+ RecordType _ _ -> res -- create a separated type declaration
+ ArrayDecl _ _ -> res
+ _ -> [x]
+ _ -> error ("checkInit:\n" ++ (show v))) v
+
+ varSection = do
+ try $ string "var"
+ comments
+ v <- varsDecl1 True <?> "variable declaration"
+ comments
+ return $ fixInit v
+
+ constSection = do
+ try $ string "const"
+ comments
+ c <- constsDecl <?> "const declaration"
+ comments
+ return $ fixInit c
+
+ typeSection = do
+ try $ string "type"
+ comments
+ t <- typesDecl <?> "type declaration"
+ comments
+ return t
+
+ operatorDecl = do
+ try $ string "operator"
+ comments
+ i <- manyTill anyChar space
+ comments
+ vs <- parens pas $ varsDecl False
+ comments
+ rid <- iD
+ comments
+ char ':'
+ comments
+ ret <- typeDecl
+ comments
+ return ret
+ char ';'
+ comments
+ forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
+ inline <- liftM (any (== "inline;")) $ many functionDecorator
+ b <- if isImpl && (not forward) then
+ liftM Just functionBody
+ else
+ return Nothing
+ return $ [OperatorDeclaration i rid inline ret vs b]
+
+
+ funcDecl = do
+ fp <- try (string "function") <|> try (string "procedure")
+ comments
+ i <- iD
+ vs <- option [] $ parens pas $ varsDecl False
+ comments
+ ret <- if (fp == "function") then do
+ char ':'
+ comments
+ ret <- typeDecl
+ comments
+ return ret
+ else
+ return VoidType
+ char ';'
+ comments
+ forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
+ decorators <- many functionDecorator
+ let inline = any (== "inline;") decorators
+ overload = any (== "overload;") decorators
+ b <- if isImpl && (not forward) then
+ liftM Just functionBody
+ else
+ return Nothing
+ return $ [FunctionDeclaration i inline overload ret vs b]
+
+ functionDecorator = do
+ d <- choice [
+ try $ string "inline;"
+ , try $ caseInsensitiveString "cdecl;"
+ , try $ string "overload;"
+ , try $ string "export;"
+ , try $ string "varargs;"
+ , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
+ ]
+ comments
+ return d
+
+
+program = do
+ string "program"
+ comments
+ name <- iD
+ (char ';')
+ comments
+ comments
+ u <- uses
+ comments
+ tv <- typeVarDeclaration True
+ comments
+ p <- phrase
+ comments
+ char '.'
+ comments
+ return $ Program name (Implementation u (TypesAndVars tv)) p
+
+interface = do
+ string "interface"
+ comments
+ u <- uses
+ comments
+ tv <- typeVarDeclaration False
+ comments
+ return $ Interface u (TypesAndVars tv)
+
+implementation = do
+ string "implementation"
+ comments
+ u <- uses
+ comments
+ tv <- typeVarDeclaration True
+ string "end."
+ comments
+ return $ Implementation u (TypesAndVars tv)
+
+expression = do
+ buildExpressionParser table term <?> "expression"
+ where
+ term = comments >> choice [
+ builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n BTUnknown))
+ , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e)
+ , brackets pas (commaSep pas iD) >>= return . SetExpression
+ , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
+ , float pas >>= return . FloatLiteral . show
+ , try $ integer pas >>= return . NumberLiteral . show
+ , try (string "_S" >> stringLiteral pas) >>= return . StringLiteral
+ , try (string "_P" >> stringLiteral pas) >>= return . PCharLiteral
+ , stringLiteral pas >>= return . strOrChar
+ , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c)
+ , char '#' >> many digit >>= \c -> comments >> return (CharCode c)
+ , char '$' >> many hexDigit >>= \h -> comments >> return (HexNumber h)
+ --, char '-' >> expression >>= return . PrefixOp "-"
+ , char '-' >> reference >>= return . PrefixOp "-" . Reference
+ , (try $ string "not" >> notFollowedBy comments) >> unexpected "'not'"
+ , try $ string "nil" >> return Null
+ , reference >>= return . Reference
+ ] <?> "simple expression"
+
+ table = [
+ [ Prefix (reservedOp pas "not">> return (PrefixOp "not"))
+ , Prefix (try (char '-') >> return (PrefixOp "-"))]
+ ,
+ [ Infix (char '*' >> return (BinOp "*")) AssocLeft
+ , Infix (char '/' >> return (BinOp "/")) AssocLeft
+ , Infix (try (string "div") >> return (BinOp "div")) AssocLeft
+ , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft
+ , Infix (try (string "in") >> return (BinOp "in")) AssocNone
+ , Infix (try $ string "and" >> return (BinOp "and")) AssocLeft
+ , Infix (try $ string "shl" >> return (BinOp "shl")) AssocLeft
+ , Infix (try $ string "shr" >> return (BinOp "shr")) AssocLeft
+ ]
+ , [ Infix (char '+' >> return (BinOp "+")) AssocLeft
+ , Infix (char '-' >> return (BinOp "-")) AssocLeft
+ , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
+ , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
+ ]
+ , [ Infix (try (string "<>") >> return (BinOp "<>")) AssocNone
+ , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone
+ , Infix (try (string ">=") >> return (BinOp ">=")) AssocNone
+ , Infix (char '<' >> return (BinOp "<")) AssocNone
+ , Infix (char '>' >> return (BinOp ">")) AssocNone
+ ]
+ {-, [ Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone
+ , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone
+ ]
+ , [
+ Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
+ , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
+ ]-}
+ , [
+ Infix (char '=' >> return (BinOp "=")) AssocNone
+ ]
+ ]
+ strOrChar [a] = CharCode . show . ord $ a
+ strOrChar a = StringLiteral a
+
+phrasesBlock = do
+ try $ string "begin"
+ comments
+ p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum)
+ comments
+ return $ Phrases p
+
+phrase = do
+ o <- choice [
+ phrasesBlock
+ , ifBlock
+ , whileCycle
+ , repeatCycle
+ , switchCase
+ , withBlock
+ , forCycle
+ , (try $ reference >>= \r -> string ":=" >> return r) >>= \r -> comments >> expression >>= return . Assignment r
+ , builtInFunction expression >>= \(n, e) -> return $ BuiltInFunctionCall e (SimpleReference (Identifier n BTUnknown))
+ , procCall
+ , char ';' >> comments >> return NOP
+ ]
+ optional $ char ';'
+ comments
+ return o
+
+ifBlock = do
+ try $ string "if" >> notFollowedBy (alphaNum <|> char '_')
+ comments
+ e <- expression
+ comments
+ string "then"
+ comments
+ o1 <- phrase
+ comments
+ o2 <- optionMaybe $ do
+ try $ string "else" >> space
+ comments
+ o <- option NOP phrase
+ comments
+ return o
+ return $ IfThenElse e o1 o2
+
+whileCycle = do
+ try $ string "while"
+ comments
+ e <- expression
+ comments
+ string "do"
+ comments
+ o <- phrase
+ return $ WhileCycle e o
+
+withBlock = do
+ try $ string "with" >> space
+ comments
+ rs <- (commaSep1 pas) reference
+ comments
+ string "do"
+ comments
+ o <- phrase
+ return $ foldr WithBlock o rs
+
+repeatCycle = do
+ try $ string "repeat" >> space
+ comments
+ o <- many phrase
+ string "until"
+ comments
+ e <- expression
+ comments
+ return $ RepeatCycle e o
+
+forCycle = do
+ try $ string "for" >> space
+ comments
+ i <- iD
+ comments
+ string ":="
+ comments
+ e1 <- expression
+ comments
+ up <- liftM (== Just "to") $
+ optionMaybe $ choice [
+ try $ string "to"
+ , try $ string "downto"
+ ]
+ --choice [string "to", string "downto"]
+ comments
+ e2 <- expression
+ comments
+ string "do"
+ comments
+ p <- phrase
+ comments
+ return $ ForCycle i e1 e2 p up
+
+switchCase = do
+ try $ string "case"
+ comments
+ e <- expression
+ comments
+ string "of"
+ comments
+ cs <- many1 aCase
+ o2 <- optionMaybe $ do
+ try $ string "else" >> notFollowedBy alphaNum
+ comments
+ o <- many phrase
+ comments
+ return o
+ string "end"
+ comments
+ return $ SwitchCase e cs o2
+ where
+ aCase = do
+ e <- (commaSep pas) $ (liftM InitRange rangeDecl <|> initExpression)
+ comments
+ char ':'
+ comments
+ p <- phrase
+ comments
+ return (e, p)
+
+procCall = do
+ r <- reference
+ p <- option [] $ (parens pas) parameters
+ return $ ProcCall r p
+
+parameters = (commaSep pas) expression <?> "parameters"
+
+functionBody = do
+ tv <- typeVarDeclaration True
+ comments
+ p <- phrasesBlock
+ char ';'
+ comments
+ return (TypesAndVars tv, p)
+
+uses = liftM Uses (option [] u)
+ where
+ u = do
+ string "uses"
+ comments
+ u <- (iD >>= \i -> comments >> return i) `sepBy1` (char ',' >> comments)
+ char ';'
+ comments
+ return u
+
+initExpression = buildExpressionParser table term <?> "initialization expression"
+ where
+ term = comments >> choice [
+ liftM (uncurry BuiltInFunction) $ builtInFunction initExpression
+ , try $ brackets pas (commaSep pas $ initExpression) >>= return . InitSet
+ , try $ parens pas (commaSep pas $ initExpression) >>= \ia -> when (null $ tail ia) mzero >> return (InitArray ia)
+ , try $ parens pas (sepEndBy recField (char ';' >> comments)) >>= return . InitRecord
+ , parens pas initExpression
+ , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i
+ , try $ float pas >>= return . InitFloat . show
+ , try $ integer pas >>= return . InitNumber . show
+ , stringLiteral pas >>= return . InitString
+ , char '#' >> many digit >>= \c -> comments >> return (InitChar c)
+ , char '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h)
+ , char '@' >> initExpression >>= \c -> comments >> return (InitAddress c)
+ , try $ string "nil" >> return InitNull
+ , itypeCast
+ , iD >>= return . InitReference
+ ]
+
+ recField = do
+ i <- iD
+ spaces
+ char ':'
+ spaces
+ e <- initExpression
+ spaces
+ return (i ,e)
+
+ table = [
+ [
+ Prefix (char '-' >> return (InitPrefixOp "-"))
+ ,Prefix (try (string "not") >> return (InitPrefixOp "not"))
+ ]
+ , [ Infix (char '*' >> return (InitBinOp "*")) AssocLeft
+ , Infix (char '/' >> return (InitBinOp "/")) AssocLeft
+ , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft
+ , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft
+ , Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
+ , Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
+ , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
+ ]
+ , [ Infix (char '+' >> return (InitBinOp "+")) AssocLeft
+ , Infix (char '-' >> return (InitBinOp "-")) AssocLeft
+ , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
+ , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
+ ]
+ , [ Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone
+ , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone
+ , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone
+ , Infix (char '<' >> return (InitBinOp "<")) AssocNone
+ , Infix (char '>' >> return (InitBinOp ">")) AssocNone
+ , Infix (char '=' >> return (InitBinOp "=")) AssocNone
+ ]
+ {--, [ Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
+ , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
+ , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
+ ]
+ , [ Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
+ , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
+ ]--}
+ --, [Prefix (try (string "not") >> return (InitPrefixOp "not"))]
+ ]
+
+ itypeCast = do
+ t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
+ i <- parens pas initExpression
+ comments
+ return $ InitTypeCast (Identifier t BTUnknown) i
+
+builtInFunction e = do
+ name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
+ spaces
+ exprs <- option [] $ parens pas $ option [] $ commaSep1 pas $ e
+ spaces
+ return (name, exprs)
+
+systemUnit = do
+ string "system;"
+ comments
+ string "type"
+ comments
+ t <- typesDecl
+ string "var"
+ v <- varsDecl True
+ return $ System (t ++ v)
+
+redoUnit = do
+ string "redo;"
+ comments
+ string "type"
+ comments
+ t <- typesDecl
+ string "var"
+ v <- varsDecl True
+ return $ Redo (t ++ v)
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/pas2c/PascalPreprocessor.hs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,137 @@
+module PascalPreprocessor where
+
+import Text.Parsec
+import Control.Monad.IO.Class
+import Control.Monad
+import System.IO
+import qualified Data.Map as Map
+import Data.Char
+
+
+-- comments are removed
+comment = choice [
+ char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
+ , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
+ , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
+ ]
+
+
+initDefines = Map.fromList [
+ ("FPC", "")
+ , ("PAS2C", "")
+-- , ("WEBGL", "")
+-- , ("AI_MAINTHREAD", "")
+ , ("ENDIAN_LITTLE", "")
+ ]
+
+preprocess :: String -> String -> String -> IO String
+preprocess inputPath alternateInputPath fn = do
+ r <- runParserT (preprocessFile (inputPath ++ fn)) (initDefines, [True]) "" ""
+ case r of
+ (Left a) -> do
+ hPutStrLn stderr (show a)
+ return ""
+ (Right a) -> return a
+
+ where
+ preprocessFile fn = do
+ f <- liftIO (readFile fn)
+ setInput f
+ preprocessor
+
+ preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
+
+ preprocessor = chainr codeBlock (return (++)) ""
+
+ codeBlock = do
+ s <- choice [
+ switch
+ , comment
+ , char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
+ , identifier >>= replace
+ , noneOf "{" >>= \a -> return [a]
+ ]
+ (_, ok) <- getState
+ return $ if and ok then s else ""
+
+ --otherChar c = c `notElem` "{/('_" && not (isAlphaNum c)
+ identifier = do
+ c <- letter <|> oneOf "_"
+ s <- many (alphaNum <|> oneOf "_")
+ return $ c:s
+
+ switch = do
+ try $ string "{$"
+ s <- choice [
+ include
+ , ifdef
+ , if'
+ , elseSwitch
+ , endIf
+ , define
+ , unknown
+ ]
+ return s
+
+ include = do
+ try $ string "INCLUDE"
+ spaces
+ (char '"')
+ fn <- many1 $ noneOf "\"\n"
+ char '"'
+ spaces
+ char '}'
+ f <- liftIO (readFile (inputPath ++ fn) `catch` (\exc -> readFile (alternateInputPath ++ fn) `catch` error ("File not found: " ++ fn)))
+ c <- getInput
+ setInput $ f ++ c
+ return ""
+
+ ifdef = do
+ s <- try (string "IFDEF") <|> try (string "IFNDEF")
+ let f = if s == "IFNDEF" then not else id
+
+ spaces
+ d <- identifier
+ spaces
+ char '}'
+
+ updateState $ \(m, b) ->
+ (m, (f $ d `Map.member` m) : b)
+
+ return ""
+
+ if' = do
+ s <- try (string "IF" >> notFollowedBy alphaNum)
+
+ manyTill anyChar (char '}')
+ --char '}'
+
+ updateState $ \(m, b) ->
+ (m, False : b)
+
+ return ""
+
+ elseSwitch = do
+ try $ string "ELSE}"
+ updateState $ \(m, b:bs) -> (m, (not b):bs)
+ return ""
+ endIf = do
+ try $ string "ENDIF}"
+ updateState $ \(m, b:bs) -> (m, bs)
+ return ""
+ define = do
+ try $ string "DEFINE"
+ spaces
+ i <- identifier
+ d <- ((string ":=" >> return ()) <|> spaces) >> many (noneOf "}")
+ char '}'
+ updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b)
+ return ""
+ replace s = do
+ (m, _) <- getState
+ return $ Map.findWithDefault s s m
+
+ unknown = do
+ fn <- many1 $ noneOf "}\n"
+ char '}'
+ return $ "{$" ++ fn ++ "}"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/pas2c/PascalUnitSyntaxTree.hs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,119 @@
+module PascalUnitSyntaxTree where
+
+import Data.Maybe
+import Data.Char
+
+data PascalUnit =
+ Program Identifier Implementation Phrase
+ | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
+ | System [TypeVarDeclaration]
+ | Redo [TypeVarDeclaration]
+ deriving Show
+data Interface = Interface Uses TypesAndVars
+ deriving Show
+data Implementation = Implementation Uses TypesAndVars
+ deriving Show
+data Identifier = Identifier String BaseType
+ deriving Show
+data TypesAndVars = TypesAndVars [TypeVarDeclaration]
+ deriving Show
+data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
+ | VarDeclaration Bool Bool ([Identifier], TypeDecl) (Maybe InitExpression)
+ | FunctionDeclaration Identifier Bool Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
+ | OperatorDeclaration String Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
+ deriving Show
+data TypeDecl = SimpleType Identifier
+ | RangeType Range
+ | Sequence [Identifier]
+ | ArrayDecl (Maybe Range) TypeDecl
+ | RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
+ | PointerTo TypeDecl
+ | String Integer
+ | Set TypeDecl
+ | FunctionType TypeDecl [TypeVarDeclaration]
+ | DeriveType InitExpression
+ | VoidType
+ | VarParamType TypeDecl -- this is a hack
+ deriving Show
+data Range = Range Identifier
+ | RangeFromTo InitExpression InitExpression
+ | RangeInfinite
+ deriving Show
+data Initialize = Initialize String
+ deriving Show
+data Finalize = Finalize String
+ deriving Show
+data Uses = Uses [Identifier]
+ deriving Show
+data Phrase = ProcCall Reference [Expression]
+ | IfThenElse Expression Phrase (Maybe Phrase)
+ | WhileCycle Expression Phrase
+ | RepeatCycle Expression [Phrase]
+ | ForCycle Identifier Expression Expression Phrase Bool -- The last Boolean indicates wether it's up or down counting
+ | WithBlock Reference Phrase
+ | Phrases [Phrase]
+ | SwitchCase Expression [([InitExpression], Phrase)] (Maybe [Phrase])
+ | Assignment Reference Expression
+ | BuiltInFunctionCall [Expression] Reference
+ | NOP
+ deriving Show
+data Expression = Expression String
+ | BuiltInFunCall [Expression] Reference
+ | PrefixOp String Expression
+ | PostfixOp String Expression
+ | BinOp String Expression Expression
+ | StringLiteral String
+ | PCharLiteral String
+ | CharCode String
+ | HexCharCode String
+ | NumberLiteral String
+ | FloatLiteral String
+ | HexNumber String
+ | Reference Reference
+ | SetExpression [Identifier]
+ | Null
+ deriving Show
+data Reference = ArrayElement [Expression] Reference
+ | FunCall [Expression] Reference
+ | TypeCast Identifier Expression
+ | SimpleReference Identifier
+ | Dereference Reference
+ | RecordField Reference Reference
+ | Address Reference
+ | RefExpression Expression
+ deriving Show
+data InitExpression = InitBinOp String InitExpression InitExpression
+ | InitPrefixOp String InitExpression
+ | InitReference Identifier
+ | InitArray [InitExpression]
+ | InitRecord [(Identifier, InitExpression)]
+ | InitFloat String
+ | InitNumber String
+ | InitHexNumber String
+ | InitString String
+ | InitChar String
+ | BuiltInFunction String [InitExpression]
+ | InitSet [InitExpression]
+ | InitAddress InitExpression
+ | InitNull
+ | InitRange Range
+ | InitTypeCast Identifier InitExpression
+ deriving Show
+
+data BaseType = BTUnknown
+ | BTChar
+ | BTString
+ | BTInt Bool -- second param indicates whether signed or not
+ | BTBool
+ | BTFloat
+ | BTRecord String [(String, BaseType)]
+ | BTArray Range BaseType BaseType
+ | BTFunction Bool [(Bool, BaseType)] BaseType -- (Bool, BaseType), Bool indiciates whether var or not
+ | BTPointerTo BaseType
+ | BTUnresolved String
+ | BTSet BaseType
+ | BTEnum [String]
+ | BTVoid
+ | BTUnit
+ | BTVarParam BaseType
+ deriving Show
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/pas2c/unitCycles.hs Sun Jan 27 00:28:57 2013 +0100
@@ -0,0 +1,46 @@
+module Main where
+
+import PascalParser
+import System
+import Control.Monad
+import Data.Either
+import Data.List
+import Data.Graph
+import Data.Maybe
+
+unident :: Identificator -> String
+unident (Identificator s) = s
+
+extractUnits :: PascalUnit -> (String, [String])
+extractUnits (Program (Identificator name) (Implementation (Uses idents) _ _) _) = ("program " ++ name, map unident idents)
+extractUnits (Unit (Identificator name) (Interface (Uses idents1) _) (Implementation (Uses idents2) _ _) _ _) = (name, map unident $ idents1 ++ idents2)
+
+f :: [(String, [String])] -> String
+f = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b))
+ where
+ showSCC (AcyclicSCC v) = v
+ showSCC (CyclicSCC vs) = intercalate ", " vs
+
+myf :: [(String, [String])] -> String
+myf d = unlines . map (findCycle . fst) $ d
+ where
+ findCycle :: String -> String
+ findCycle searched = searched ++ ": " ++ (intercalate ", " $ fc searched [])
+ where
+ fc :: String -> [String] -> [String]
+ fc curSearch visited = let uses = curSearch `lookup` d; res = dropWhile null . map t $ fromJust uses in if isNothing uses || null res then [] else head res
+ where
+ t u =
+ if u == searched then
+ [u]
+ else
+ if u `elem` visited then
+ []
+ else
+ let chain = fc u (u:visited) in if null chain then [] else u:chain
+
+
+main = do
+ fileNames <- getArgs
+ files <- mapM readFile fileNames
+ putStrLn . myf . map extractUnits . rights . map parsePascalUnit $ files
--- a/tools/unitCycles.hs Sun Jan 27 00:01:26 2013 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,46 +0,0 @@
-module Main where
-
-import PascalParser
-import System
-import Control.Monad
-import Data.Either
-import Data.List
-import Data.Graph
-import Data.Maybe
-
-unident :: Identificator -> String
-unident (Identificator s) = s
-
-extractUnits :: PascalUnit -> (String, [String])
-extractUnits (Program (Identificator name) (Implementation (Uses idents) _ _) _) = ("program " ++ name, map unident idents)
-extractUnits (Unit (Identificator name) (Interface (Uses idents1) _) (Implementation (Uses idents2) _ _) _ _) = (name, map unident $ idents1 ++ idents2)
-
-f :: [(String, [String])] -> String
-f = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b))
- where
- showSCC (AcyclicSCC v) = v
- showSCC (CyclicSCC vs) = intercalate ", " vs
-
-myf :: [(String, [String])] -> String
-myf d = unlines . map (findCycle . fst) $ d
- where
- findCycle :: String -> String
- findCycle searched = searched ++ ": " ++ (intercalate ", " $ fc searched [])
- where
- fc :: String -> [String] -> [String]
- fc curSearch visited = let uses = curSearch `lookup` d; res = dropWhile null . map t $ fromJust uses in if isNothing uses || null res then [] else head res
- where
- t u =
- if u == searched then
- [u]
- else
- if u `elem` visited then
- []
- else
- let chain = fc u (u:visited) in if null chain then [] else u:chain
-
-
-main = do
- fileNames <- getArgs
- files <- mapM readFile fileNames
- putStrLn . myf . map extractUnits . rights . map parsePascalUnit $ files