# HG changeset patch # User koda # Date 1359242937 -3600 # Node ID 75db7bb8dce875c2d500bb0fe17fb9a1531ee3dd # Parent 46a9fde631f4004b94430bac85eb96391ee0874a# Parent 2debc9b9f917849acee64a0ceee9deb443041a22 update branch diff -r 2debc9b9f917 -r 75db7bb8dce8 .hgignore --- 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* diff -r 2debc9b9f917 -r 75db7bb8dce8 CMakeLists.txt --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/CMakeLists.txt --- 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() diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/game.cpp diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/gameuiconfig.cpp diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/gameuiconfig.h diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/hwform.cpp diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/hwform.h diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/net/newnetclient.cpp diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/net/newnetclient.h diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/ui/dialog/input_password.cpp diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/ui/page/pagemain.cpp diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/ui/page/pagevideos.cpp diff -r 2debc9b9f917 -r 75db7bb8dce8 QTfrontend/ui/widget/about.cpp diff -r 2debc9b9f917 -r 75db7bb8dce8 cmake_modules/FindClang.cmake --- /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}) diff -r 2debc9b9f917 -r 75db7bb8dce8 cmake_modules/FindGLEW.cmake --- /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 diff -r 2debc9b9f917 -r 75db7bb8dce8 gameServer/Actions.hs --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 gameServer/CMakeLists.txt --- 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} diff -r 2debc9b9f917 -r 75db7bb8dce8 gameServer/HWProtoInRoomState.hs --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 gameServer/hedgewars-server.cabal --- 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, diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/ArgParsers.inc --- 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, ''); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/CMakeLists.txt --- 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() diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/GL.h --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/GSHandlers.inc --- 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 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) diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/LuaPas.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/Math.h --- 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 - diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/SDLMain.h --- 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 - Non-NIB-Code & other changes: Max Horn - - Feel free to customize this file to suit your needs -*/ - -#ifndef _SDLMain_h_ -#define _SDLMain_h_ - -#import - -@interface SDLMain : NSObject -@end - -#endif /* _SDLMain_h_ */ diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/SDLMain.m --- 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 - Non-NIB-Code & other changes: Max Horn - - Feel free to customize this file to suit your needs -*/ - -#include "SDL.h" -#include "SDLMain.h" -#include /* for MAXPATHLEN */ -#include - -/* 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; -} - diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/SDLh.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/SysUtils.h diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/Types.h diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/VGSHandlers.inc --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/adler32.pas --- 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 - * - * 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 -#include -#include -#include -#include -#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); -} diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/hwengine.ico Binary file hedgewars/hwengine.ico has changed diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/hwengine.pas --- 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. diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/hwengine.rc --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/options.inc --- 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} diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/pas2c.h --- 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 -#include -#include -#include - -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); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/pas2cRedo.pas --- /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; + + diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/pas2cSystem.pas --- 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; + diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/res/hwengine.ico Binary file hedgewars/res/hwengine.ico has changed diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/res/hwengine.rc --- /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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/sdlmain_osx/SDLMain.h --- /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 + Non-NIB-Code & other changes: Max Horn + + Feel free to customize this file to suit your needs +*/ + +#ifndef _SDLMain_h_ +#define _SDLMain_h_ + +#import + +@interface SDLMain : NSObject +@end + +#endif /* _SDLMain_h_ */ diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/sdlmain_osx/SDLMain.m --- /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 + Non-NIB-Code & other changes: Max Horn + + Feel free to customize this file to suit your needs +*/ + +#include "SDL.h" +#include "SDLMain.h" +#include /* for MAXPATHLEN */ +#include + +/* 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; +} + diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uAI.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uAIAmmoTests.pas --- 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); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uAIMisc.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uAmmos.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uCaptions.pas --- 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); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uChat.pas --- 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); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uCommandHandlers.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uConsts.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uCursor.pas --- 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); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uFloat.pas --- 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. *) diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uGame.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uGears.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uGearsHedgehog.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uGearsList.pas --- 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); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uGearsRender.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uGearsUtils.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uIO.pas --- 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. diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uInputHandler.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uLand.pas --- 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); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uLandGenMaze.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uLandGraphics.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uLandObjects.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uLandOutline.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uLandTemplates.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uLandTexture.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uLocale.pas diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uMatrix.pas --- /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 + * + * 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. diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uMisc.pas --- 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. diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uPhysFSLayer.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uRandom.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uRender.pas --- 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. diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uRenderUtils.pas --- 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. diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uScript.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uSound.pas --- 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 sndNone) then begin LastVoice.snd:= VoiceList[i].snd; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uStats.pas diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uStore.pas --- 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} diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uTeams.pas --- 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); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uTouch.pas --- 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()); diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uTypes.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uUtils.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uVariables.pas --- 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} diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uVisualGears.pas --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uWeb.pas --- /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. diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/uWorld.pas --- 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; diff -r 2debc9b9f917 -r 75db7bb8dce8 hedgewars/videorec/avwrapper.c --- /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 + * + * 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 +#include +#include +#include +#include +#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); +} diff -r 2debc9b9f917 -r 75db7bb8dce8 misc/liblua/CMakeLists.txt --- 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) diff -r 2debc9b9f917 -r 75db7bb8dce8 misc/libopenalbridge/CMakeLists.txt --- 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}) diff -r 2debc9b9f917 -r 75db7bb8dce8 misc/physfs/CMakeLists.txt diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/Android-build/CMakeLists.txt --- 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() diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/hwconsts.h --- 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 - * Copyright (c) 2012 Simeon Maxein - * - * 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 -#include -#include - -#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 + * Copyright (c) 2012 Simeon Maxein + * + * 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 +#include +#include + +#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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/md5/md5.h --- 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 . + added conditionalization for C++ compilation from Martin + Purschke . 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/model/gamesetup.h --- 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 - * - * 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 + * + * 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/model/map.h --- 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 - * - * 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 -#include -#include - -#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 + * + * 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 +#include +#include + +#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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/model/mapcfg.h --- 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 - * - * 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 + * + * 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_ */ diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/model/room.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 - * - * 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 - -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 + * + * 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 + +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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/model/team.h --- 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 - * - * 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 -#include - -#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 + * + * 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 +#include + +#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_ */ diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/net/netconn.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 - * - * 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 -#include -#include - -#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 + * + * 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 +#include +#include + +#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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/frontlib/net/netconn_internal.h --- 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 - * - * 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 -#include -#include - -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 + * + * 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 +#include +#include + +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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/CMakeLists.txt --- /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}) + diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/CMakeLists.txt --- /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) + + + + + diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/GL.h --- /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 +#else +#include "GL/gl.h" +#endif + diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/Math.h --- /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 + diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/SysUtils.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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/Types.h --- /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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/fileio.c --- /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 +#include +#include +#include + +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); +} + diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/fileio.h --- /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 +#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_ */ diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/fpcrtl.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 +#include +#include +#include +#include + +#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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/misc.c --- /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 +#include +#include +#include + +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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/misc.h --- /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 +#include + +#ifdef EMSCRIPTEN +#include +#else +#include +#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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/pas2c.h --- /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 +#include +#include +#include +#include + +#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} + + diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/pmath.c --- /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 +#include + +/* + * 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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/pmath.h --- /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 +#include + +#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_ */ diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/system.c --- /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 +#include +#include +#include + +#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); +} + diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/system.h --- /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 +#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_ */ diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/sysutils.c --- /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 +#include +#include +#include + +#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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/tests/check_check.c --- /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 +#include +#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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/tests/check_check.h --- /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 diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/tests/check_fileio.c --- /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 +#include +#include +#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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/tests/check_misc.c --- /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 +#include +#include +#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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/tests/check_system.c --- /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 +#include +#include +#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; +} + diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/tests/check_sysutils.c --- /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 +#include +#include +#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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/tests/fileio_test.c --- /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(); +} diff -r 2debc9b9f917 -r 75db7bb8dce8 project_files/hwc/rtl/tests/main.c --- /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 +//#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); +// } + +} diff -r 2debc9b9f917 -r 75db7bb8dce8 share/CMakeLists.txt diff -r 2debc9b9f917 -r 75db7bb8dce8 share/hedgewars/Data/CMakeLists.txt --- 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}) diff -r 2debc9b9f917 -r 75db7bb8dce8 share/hedgewars/Data/Shaders/CMakeLists.txt --- /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) diff -r 2debc9b9f917 -r 75db7bb8dce8 share/hedgewars/Data/Shaders/default.fs --- /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; + } +} diff -r 2debc9b9f917 -r 75db7bb8dce8 share/hedgewars/Data/Shaders/default.vs --- /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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 share/hedgewars/Data/Shaders/water.fs --- /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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 share/hedgewars/Data/Shaders/water.vs --- /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; +} diff -r 2debc9b9f917 -r 75db7bb8dce8 share/hedgewars/Data/misc/hwengine.desktop --- /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 diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/PascalBasics.hs --- 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) diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/PascalParser.hs --- 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) - diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/PascalPreprocessor.hs --- 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 ++ "}" diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/PascalUnitSyntaxTree.hs --- 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 diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c.hs --- 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 "<>" -initExpr2C' (InitSet []) = return $ text "0" -initExpr2C' (InitSet a) = return $ text "<>" -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 "<>" <+>) - 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 - diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c/CMakeLists.txt --- /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}") + diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c/Main.hs --- /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" + ] + diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c/Pas2C.hs --- /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 "<>" +initExpr2C' (InitSet []) = return $ text "0" +initExpr2C' (InitSet a) = return $ text "<>" +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 "<>" <+>) + 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 + diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c/PascalBasics.hs --- /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) diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c/PascalParser.hs --- /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) + diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c/PascalPreprocessor.hs --- /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 ++ "}" diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c/PascalUnitSyntaxTree.hs --- /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 diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/pas2c/unitCycles.hs --- /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 diff -r 2debc9b9f917 -r 75db7bb8dce8 tools/unitCycles.hs --- 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