diff --git a/.github/workflows/README.md b/.github/workflows/README.md
new file mode 100644
index 0000000..704e5bc
--- /dev/null
+++ b/.github/workflows/README.md
@@ -0,0 +1,74 @@
+# GitHub Actions Workflows
+
+Tento adresář obsahuje CI/CD workflow pro automatické buildu aplikací pro všechny platformy.
+
+## Build Windows
+
+Workflow `build-windows.yml` automaticky kompiluje všechny aplikace pro Windows při:
+- Push do `main` nebo `master` branch
+- Pull request do `main` nebo `master` branch
+- Manuálním spuštění přes GitHub Actions tab
+
+## Build macOS
+
+Workflow `build-macos.yml` automaticky kompiluje všechny aplikace pro macOS (ARM64 i x86_64) při:
+- Push do `main` nebo `master` branch
+- Pull request do `main` nebo `master` branch
+- Manuálním spuštění přes GitHub Actions tab
+
+**Poznámka**: macOS buildy běží na dvou runnerech:
+- `macos-latest` - Apple Silicon (ARM64)
+- `macos-13` - Intel (x86_64)
+
+## Build Linux
+
+Workflow `build-linux.yml` automaticky kompiluje všechny aplikace pro Linux při:
+- Push do `main` nebo `master` branch
+- Pull request do `main` nebo `master` branch
+- Manuálním spuštění přes GitHub Actions tab
+
+### Jak to funguje:
+
+1. **Automatické spuštění**: Když pushneš změny do GitHubu, workflow se automaticky spustí
+2. **Windows runner**: GitHub poskytne virtuální Windows počítač
+3. **Instalace nástrojů**: Automaticky se nainstaluje Free Pascal Compiler a Lazarus IDE
+4. **Kompilace**: Všechny aplikace se zkompilují (client, launcher, server, extractor)
+5. **Artefakty**: Zkompilované `.exe` soubory jsou k dispozici ke stažení
+
+### Jak použít:
+
+1. **Pushni změny do GitHubu**:
+ ```bash
+ git add .
+ git commit -m "Update code"
+ git push
+ ```
+
+2. **Zkontroluj stav buildu**:
+ - Jdi na GitHub → tvůj repozitář
+ - Klikni na záložku "Actions"
+ - Uvidíš běžící nebo dokončené buildu
+
+3. **Stáhni artefakty**:
+ - Po dokončení buildu klikni na workflow run
+ - V sekci "Artifacts" klikni na příslušný artifact:
+ - `windows-binaries` - Windows `.exe` soubory
+ - `macos-arm64-binaries` - macOS ARM64 binárky
+ - `macos-x86_64-binaries` - macOS Intel binárky
+ - `linux-binaries` - Linux binárky
+ - Stáhneš ZIP soubor se všemi zkompilovanými soubory
+
+### Manuální spuštění:
+
+1. Jdi na GitHub → tvůj repozitář → záložka "Actions"
+2. Vyber workflow "Build Windows"
+3. Klikni na "Run workflow"
+4. Vyber branch a klikni "Run workflow"
+
+### Poznámky:
+
+- Build trvá obvykle 5-15 minut (závisí na platformě)
+- Artefakty jsou dostupné 30 dní
+- Pokud build selže, zkontroluj logy v sekci "Actions"
+- Všechny tři workflow (Windows, macOS, Linux) běží paralelně, takže dostaneš buildy pro všechny platformy najednou
+
diff --git a/.github/workflows/build-flyio.yml b/.github/workflows/build-flyio.yml
new file mode 100644
index 0000000..2184f08
--- /dev/null
+++ b/.github/workflows/build-flyio.yml
@@ -0,0 +1,157 @@
+name: Build and Release Fly.io Server
+
+# This workflow builds Docker image for Fly.io server and creates a release
+# Responds only to tags starting with "server-v" (e.g., server-v1.0.0)
+on:
+ workflow_dispatch: # Manual trigger
+ push:
+ tags:
+ - 'server-v*' # Triggers on tags starting with 'server-v' (e.g., server-v1.0.0)
+
+jobs:
+ build-and-release:
+ name: Build Docker Image and Create Release
+ runs-on: ubuntu-latest
+
+ steps:
+ # 1. Checkout code
+ - name: Checkout code
+ uses: actions/checkout@v4
+
+ # 2. Prepare data directory for Docker build
+ - name: Prepare data directory
+ run: |
+ # If flyio_server/data doesn't exist, use data from project root
+ if [ ! -d "flyio_server/data" ]; then
+ echo "flyio_server/data not found, using data from project root"
+ if [ -d "data" ]; then
+ mkdir -p flyio_server
+ cp -r data flyio_server/data
+ echo "✓ Copied data from project root to flyio_server/data"
+ echo "⚠️ WARNING: This image will be built with placeholder/empty data"
+ echo "⚠️ WARNING: Server deployed from this image will NOT work properly (no game maps)"
+ echo "⚠️ WARNING: Users must add game data using deploy_prebuilt.sh with actual game data"
+ else
+ echo "WARNING: Neither flyio_server/data nor data directory found"
+ echo "Creating empty data directory (server will NOT work properly)"
+ mkdir -p flyio_server/data
+ fi
+ else
+ echo "✓ flyio_server/data exists, using it"
+ # Check if it contains actual game data (has maps directory)
+ if [ -d "flyio_server/data/maps" ] && [ "$(ls -A flyio_server/data/maps 2>/dev/null)" ]; then
+ echo "✓ flyio_server/data contains game maps - image will be fully functional"
+ else
+ echo "⚠️ WARNING: flyio_server/data exists but appears to be empty/placeholder"
+ echo "⚠️ WARNING: Server deployed from this image will NOT work properly"
+ fi
+ fi
+
+ # 3. Setup Docker Buildx
+ - name: Set up Docker Buildx
+ uses: docker/setup-buildx-action@v3
+
+ # 4. Login to GitHub Container Registry
+ - name: Login to GitHub Container Registry
+ uses: docker/login-action@v3
+ with:
+ registry: ghcr.io
+ username: ${{ github.actor }}
+ password: ${{ secrets.GITHUB_TOKEN }}
+
+ # 5. Extract version from tag or use commit SHA
+ - name: Extract version
+ id: version
+ run: |
+ if [[ "${{ github.ref }}" == refs/tags/server-v* ]]; then
+ # Remove "server-" prefix from tag (server-v1.0.0 -> v1.0.0)
+ VERSION=${GITHUB_REF#refs/tags/server-}
+ else
+ VERSION="dev-${GITHUB_SHA::8}"
+ fi
+ echo "version=$VERSION" >> $GITHUB_OUTPUT
+ echo "tag=ghcr.io/${{ github.repository_owner }}/fpc-atomic-server:$VERSION" >> $GITHUB_OUTPUT
+ echo "tag_latest=ghcr.io/${{ github.repository_owner }}/fpc-atomic-server:latest" >> $GITHUB_OUTPUT
+ echo "Version: $VERSION"
+
+ # 6. Build Docker image
+ - name: Build Docker image
+ uses: docker/build-push-action@v5
+ with:
+ context: .
+ file: ./flyio_server/Dockerfile
+ push: true
+ tags: |
+ ${{ steps.version.outputs.tag }}
+ ${{ steps.version.outputs.tag_latest }}
+ cache-from: type=gha
+ cache-to: type=gha,mode=max
+
+ # 7. Create GitHub Release (only for server tags)
+ - name: Create Release
+ if: startsWith(github.ref, 'refs/tags/server-v')
+ uses: softprops/action-gh-release@v1
+ with:
+ name: Fly.io Server ${{ steps.version.outputs.version }}
+ body: |
+
+ ☁️ Cloud Server Release
+ This release contains files for build and deploy game server to [fly.io](https://fly.io)
+ ## FPC Atomic Server for Fly.io
+
+ ### 🚀 How to deploy to Fly.io (without Pascal compiler!)
+
+ **Easiest way - use the pre-built Docker image:**
+
+ 1. **Install Fly.io CLI:**
+ ```bash
+ curl -L https://fly.io/install.sh | sh
+ ```
+
+ 2. **Login:**
+ ```bash
+ flyctl auth login
+ ```
+
+ 3. **Create a new directory and download configuration:**
+ ```bash
+ mkdir fpc-atomic-server && cd fpc-atomic-server
+ curl -L https://github.com/${{ github.repository }}/releases/latest/download/fly.toml.example -o fly.toml
+ ```
+
+ 4. **Edit `fly.toml` - change the image path to your GitHub username (if you have a fork):**
+ ```toml
+ [build]
+ image = "ghcr.io/${{ github.repository_owner }}/fpc-atomic-server:latest"
+ ```
+
+ 5. **Deploy to Fly.io:**
+ ```bash
+ flyctl launch
+ ```
+
+ **Alternative - build from source code:**
+
+ If you want to build from source code, clone the repository and use `fly.toml` from the `flyio_server/` directory.
+
+ ### 📦 Docker Image
+
+ Image is available on GitHub Container Registry:
+ - `ghcr.io/${{ github.repository_owner }}/fpc-atomic-server:${{ steps.version.outputs.version }}`
+ - `ghcr.io/${{ github.repository_owner }}/fpc-atomic-server:latest`
+
+ ### 🔧 Configuration
+
+ - **Port:** 5521
+ - **Region:** Frankfurt (fra) - can be changed in `fly.toml`
+ - **Auto-shutdown:** 30 seconds of inactivity
+
+ ### 📝 Documentation
+
+ For more information, see [README.md](flyio_server/README.md)
+ draft: false
+ prerelease: false
+ files: |
+ flyio_server/README.md
+ flyio_server/fly.toml.example
+ flyio_server/Dockerfile
diff --git a/.github/workflows/build-linux.yml b/.github/workflows/build-linux.yml
new file mode 100644
index 0000000..b01c733
--- /dev/null
+++ b/.github/workflows/build-linux.yml
@@ -0,0 +1,369 @@
+name: Build Linux
+
+# Tento workflow se spustí při:
+# - Push do main/master branch
+# - Pull request do main/master branch
+# - Manuálně přes GitHub Actions tab
+on:
+ #push:
+ # branches: [ main, master ]
+ #pull_request:
+ # branches: [ main, master ]
+ workflow_dispatch: # Umožňuje manuální spuštění
+
+jobs:
+ build-linux:
+ name: Build for Linux
+ runs-on: ubuntu-latest # Použije Linux runner (Ubuntu)
+
+ steps:
+ # 1. Checkout kódu z repozitáře
+ - name: Checkout code
+ uses: actions/checkout@v4
+
+ # 2. Setup Free Pascal Compiler
+ - name: Setup Free Pascal Compiler
+ run: |
+ set -e # Exit on any error
+ sudo apt-get update
+ sudo apt-get install -y fpc fp-compiler
+
+ # Ověřit instalaci - použij -iV pro verzi bez potřeby source souboru
+ fpc -iV
+ echo "FPC version check completed"
+
+ # 3. Setup Lazarus IDE
+ - name: Setup Lazarus IDE
+ run: |
+ set -e # Exit on any error
+ sudo apt-get install -y lazarus lazarus-ide-gtk2
+
+ # Ověřit instalaci
+ lazbuild --version
+ echo "Lazarus version check completed"
+
+ # 4. Install system dependencies
+ - name: Install system dependencies
+ run: |
+ set -e # Exit on any error
+ # Install SDL2 development libraries
+ sudo apt-get install -y libsdl2-dev
+
+ # Install OpenSSL development libraries (for fphttpclient)
+ sudo apt-get install -y libssl-dev
+
+ # Install other build dependencies
+ sudo apt-get install -y build-essential
+
+ # 5. Download and install BASS library
+ - name: Download and install BASS library
+ run: |
+ set -e # Exit on any error
+ echo "Downloading BASS library for Linux..."
+ # BASS library needs to be downloaded from https://www.un4seen.com/
+ # For CI/CD, we'll try to download it or use a placeholder
+ # Note: The actual libbass.so needs to be provided by the user
+ # For now, we'll create a note that it needs to be installed
+
+ # Check for libbass.so in various locations
+ if [ -f "bin/libbass.so" ]; then
+ echo "Found libbass.so in bin/"
+ sudo cp bin/libbass.so /usr/lib/
+ sudo chmod 644 /usr/lib/libbass.so
+ elif [ -f "libbass.so" ]; then
+ echo "Found libbass.so in repository root"
+ sudo cp libbass.so /usr/lib/
+ sudo chmod 644 /usr/lib/libbass.so
+ elif [ -f "macos/bin/arm64/libbass.so" ]; then
+ echo "Found libbass.so in macos/bin/arm64/"
+ sudo cp macos/bin/arm64/libbass.so /usr/lib/
+ sudo chmod 644 /usr/lib/libbass.so
+ else
+ echo "ERROR: libbass.so not found in repository"
+ echo "BASS library needs to be in bin/libbass.so"
+ exit 1
+ fi
+
+ # Verify installation
+ if [ -f "/usr/lib/libbass.so" ]; then
+ echo "✓ libbass.so installed successfully"
+ ls -lh /usr/lib/libbass.so
+ # Verify it's a valid shared library
+ file /usr/lib/libbass.so
+ else
+ echo "ERROR: libbass.so not installed - build will fail"
+ exit 1
+ fi
+
+ # 6. Download and build LNet package
+ - name: Download and build LNet package
+ run: |
+ set -e # Exit on any error
+ echo "Downloading LNet from GitHub..."
+ # Use master branch (not main) - see https://github.com/PascalCorpsman/lnet
+ lnetUrl="https://github.com/PascalCorpsman/lnet/archive/refs/heads/master.zip"
+ lnetZip="/tmp/lnet.zip"
+ lnetDir="/tmp/lnet"
+
+ # Download LNet
+ echo "Downloading from: $lnetUrl"
+ curl -L -f -o "$lnetZip" "$lnetUrl" || {
+ echo "ERROR: Failed to download LNet (curl exit code: $?)"
+ echo "Trying alternative URL..."
+ # Try alternative URL format
+ lnetUrlAlt="https://github.com/PascalCorpsman/lnet/archive/master.zip"
+ curl -L -f -o "$lnetZip" "$lnetUrlAlt" || {
+ echo "ERROR: All download attempts failed"
+ exit 1
+ }
+ }
+ echo "LNet downloaded successfully"
+
+ # Extract LNet
+ echo "Extracting LNet..."
+ unzip -q "$lnetZip" -d "$lnetDir" || {
+ echo "ERROR: Failed to extract LNet"
+ exit 1
+ }
+
+ # Find the package files
+ lnetPackagePath=$(find "$lnetDir" -name "lnetvisual.lpk" | head -1)
+ if [ -z "$lnetPackagePath" ]; then
+ echo "ERROR: lnetvisual.lpk not found in downloaded archive"
+ exit 1
+ fi
+
+ lnetBasePath=$(find "$lnetDir" -name "lnetbase.lpk" | head -1)
+ if [ -z "$lnetBasePath" ]; then
+ echo "ERROR: lnetbase.lpk not found in downloaded archive"
+ exit 1
+ fi
+
+ echo "Found LNet packages:"
+ echo " Base: $lnetBasePath"
+ echo " Visual: $lnetPackagePath"
+
+ # Build base package first
+ echo "Building lnetbase.lpk..."
+ lazbuild --build "$lnetBasePath" || {
+ echo "WARNING: lnetbase.lpk build failed, but continuing..."
+ }
+
+ # Build visual package
+ echo "Building lnetvisual.lpk..."
+ lazbuild --build "$lnetPackagePath" || {
+ echo "WARNING: LNet package build failed"
+ }
+
+ # Copy LNet source files to expected location for search paths
+ echo "Copying LNet source files to macos/third_party..."
+ lnetSourceDir=$(find "$lnetDir" -type d -name "lnet-*" | head -1)
+ if [ -z "$lnetSourceDir" ]; then
+ echo "ERROR: LNet source directory not found"
+ exit 1
+ fi
+
+ targetLnetBaseDir="macos/third_party/lnet"
+ targetLnetSrcDir="macos/third_party/lnet_src"
+
+ # Create base directory structure
+ mkdir -p "$targetLnetBaseDir"
+ mkdir -p "$targetLnetSrcDir"
+
+ # Copy lib directory as subdirectory (search path expects macos/third_party/lnet/lib/)
+ if [ -d "$lnetSourceDir/lib" ]; then
+ targetLibDir="$targetLnetBaseDir/lib"
+ cp -r "$lnetSourceDir/lib" "$targetLibDir"
+ echo "Copied LNet lib directory to $targetLibDir"
+ # Verify lnet.pp exists at correct path
+ if [ -f "$targetLibDir/lnet.pp" ]; then
+ echo "✓ lnet.pp found at: $targetLibDir/lnet.pp"
+ else
+ echo "WARNING: lnet.pp not found at expected location"
+ echo "Contents of $targetLibDir:"
+ ls -la "$targetLibDir" | head -5
+ exit 1
+ fi
+ else
+ echo "ERROR: LNet lib directory not found at $lnetSourceDir/lib"
+ exit 1
+ fi
+
+ # Copy lazaruspackage directory (contains lclnet.pas and lnetcomponents.pas)
+ if [ -d "$lnetSourceDir/lazaruspackage" ]; then
+ cp -r "$lnetSourceDir/lazaruspackage" "$targetLnetSrcDir/"
+ echo "Copied LNet lazaruspackage to $targetLnetSrcDir"
+ else
+ echo "ERROR: LNet lazaruspackage directory not found at $lnetSourceDir/lazaruspackage"
+ exit 1
+ fi
+
+ # Verify key files are available at correct paths
+ lnetComponentsPath="$targetLnetSrcDir/lazaruspackage/lnetcomponents.pas"
+ lclnetPath="$targetLnetSrcDir/lazaruspackage/lclnet.pas"
+ lnetPath="$targetLnetBaseDir/lib/lnet.pp"
+
+ if [ -f "$lnetComponentsPath" ]; then
+ echo "✓ lnetcomponents.pas available at: $lnetComponentsPath"
+ else
+ echo "ERROR: lnetcomponents.pas not found at: $lnetComponentsPath"
+ exit 1
+ fi
+
+ if [ -f "$lclnetPath" ]; then
+ echo "✓ lclnet.pas available at: $lclnetPath"
+ else
+ echo "ERROR: lclnet.pas not found at: $lclnetPath"
+ exit 1
+ fi
+
+ if [ -f "$lnetPath" ]; then
+ echo "✓ lnet.pp available at: $lnetPath"
+ else
+ echo "ERROR: lnet.pp not found at: $lnetPath"
+ exit 1
+ fi
+
+ echo "All LNet files copied and verified successfully!"
+
+ # 7. Verify dependencies
+ - name: Verify dependencies
+ run: |
+ set -e # Exit on any error
+ echo "Verifying all required dependencies..."
+
+ # Check dglopengl.pas
+ if [ -f "units/dglOpenGL.pas" ]; then
+ echo "✓ dglOpenGL.pas found"
+ else
+ echo "ERROR: dglOpenGL.pas not found"
+ exit 1
+ fi
+
+ # Check bass.pas
+ if [ -f "units/bass.pas" ]; then
+ echo "✓ bass.pas found"
+ else
+ echo "ERROR: bass.pas not found"
+ exit 1
+ fi
+
+ # Check SDL2-for-Pascal
+ if [ -d "units/sdl2_for_pascal" ]; then
+ echo "✓ SDL2-for-Pascal found"
+ else
+ echo "ERROR: SDL2-for-Pascal not found"
+ exit 1
+ fi
+
+ # Check LNet source files
+ lnetComponentsFound=false
+ possibleLnetPaths=(
+ "macos/third_party/lnet_src/lazaruspackage/lnetcomponents.pas"
+ "/tmp/lnet/lnet-*/lazaruspackage/lnetcomponents.pas"
+ )
+
+ for path in "${possibleLnetPaths[@]}"; do
+ if [ -f "$path" ]; then
+ echo "✓ LNet source files found at: $path"
+ lnetComponentsFound=true
+ break
+ fi
+ done
+
+ if [ "$lnetComponentsFound" = false ]; then
+ echo "WARNING: LNet source files not found in expected locations"
+ echo "LNet was downloaded and built, should be available via compiled packages"
+ echo "Continuing anyway..."
+ fi
+
+ # Check LazOpenGLContext (should be in Lazarus IDE)
+ echo "✓ LazOpenGLContext should be part of Lazarus IDE (checked in RequiredPackages)"
+
+ # Note: synapse is not needed anymore (replaced with fphttpclient)
+ echo "Note: synapse is not required (replaced with fphttpclient)"
+
+ echo "All dependencies verified!"
+
+ # 8. Build Client
+ - name: Build Client
+ run: |
+ set -e # Exit on any error
+ cd client
+ lazbuild --build-mode=default fpc_atomic.lpi
+
+ # 9. Build Launcher
+ - name: Build Launcher
+ run: |
+ set -e # Exit on any error
+ cd launcher
+ lazbuild --build-mode=default atomic_launcher.lpi
+
+ # 10. Build Server
+ - name: Build Server
+ run: |
+ set -e # Exit on any error
+ cd server
+ lazbuild --build-mode=default atomic_server.lpi
+
+ # 11. Build CD Data Extractor
+ - name: Build CD Data Extractor
+ run: |
+ set -e # Exit on any error
+ cd cd_data_extractor_src
+ lazbuild --build-mode=default cd_data_extractor.lpi
+
+ # 12. Prepare artifacts
+ - name: Prepare artifacts
+ run: |
+ set -e # Exit on any error
+ mkdir -p linux/bin
+ echo "Looking for compiled binaries..."
+
+ # Binaries are compiled to the root directory (one level up from project folders)
+ binaries=(
+ "fpc_atomic"
+ "atomic_launcher"
+ "atomic_server"
+ "cd_data_extractor"
+ )
+
+ for bin in "${binaries[@]}"; do
+ if [ -f "$bin" ]; then
+ echo "Found: $bin"
+ mv "$bin" linux/bin/
+ else
+ echo "WARNING: $bin not found"
+ fi
+ done
+
+ # Copy Linux libraries if they exist
+ if [ -f "bin/libbass.so" ]; then
+ echo "Copying libbass.so to artifacts"
+ cp bin/libbass.so linux/bin/
+ fi
+
+ if [ -f "bin/libai.so" ]; then
+ echo "Copying libai.so to artifacts"
+ cp bin/libai.so linux/bin/
+ fi
+
+ # Copy data directory to artifacts
+ echo "Copying data directory..."
+ if [ -d "data" ]; then
+ cp -r data linux/bin/
+ echo "✓ data directory copied to linux/bin/data"
+ else
+ echo "WARNING: data directory not found"
+ fi
+
+ echo "Artifacts prepared. Contents of linux/bin:"
+ ls -lh linux/bin/
+
+ # 13. Upload artifacts (soubory ke stažení)
+ - name: Upload Linux binaries
+ uses: actions/upload-artifact@v4
+ with:
+ name: FPCAtomic-Linux
+ path: linux/bin/*
+ retention-days: 30 # Uchovat 30 dní
diff --git a/.github/workflows/build-macos.yml b/.github/workflows/build-macos.yml
new file mode 100644
index 0000000..ceea4a2
--- /dev/null
+++ b/.github/workflows/build-macos.yml
@@ -0,0 +1,154 @@
+name: Build macOS
+
+# Tento workflow se spustí pouze:
+# - Manuálně přes GitHub Actions tab
+# Automatické spuštění je zakomentováno
+on:
+ # push:
+ # branches: [ main, master ]
+ # pull_request:
+ # branches: [ main, master ]
+ workflow_dispatch: # Umožňuje manuální spuštění
+
+jobs:
+ build-macos-arm64:
+ name: Build for macOS (ARM64)
+ runs-on: macos-latest # Použije macOS runner (Apple Silicon)
+
+ steps:
+ # 1. Checkout kódu z repozitáře
+ - name: Checkout code
+ uses: actions/checkout@v4
+
+ # 2. Setup Free Pascal Compiler
+ - name: Setup Free Pascal Compiler
+ run: |
+ # Nainstalovat FPC přes Homebrew
+ brew install fpc
+
+ # Ověřit instalaci
+ fpc -v
+
+ # 3. Setup Lazarus IDE
+ - name: Setup Lazarus IDE
+ run: |
+ # Nainstalovat Lazarus přes Homebrew
+ brew install --cask lazarus
+
+ # Ověřit instalaci
+ lazbuild --version
+
+ # 4. Build Client
+ - name: Build Client (ARM64)
+ run: |
+ cd client
+ lazbuild --build-mode=macos_arm64 fpc_atomic.lpi
+
+ # 5. Build Launcher
+ - name: Build Launcher (ARM64)
+ run: |
+ cd launcher
+ lazbuild --build-mode=macos_arm64 atomic_launcher.lpi
+
+ # 6. Build Server
+ - name: Build Server (ARM64)
+ run: |
+ cd server
+ lazbuild --build-mode=macos_arm64 atomic_server.lpi
+
+ # 7. Build CD Data Extractor
+ - name: Build CD Data Extractor (ARM64)
+ run: |
+ cd cd_data_extractor_src
+ lazbuild --build-mode=macos_arm64 cd_data_extractor.lpi
+
+ # 8. Prepare artifacts
+ - name: Prepare artifacts
+ run: |
+ mkdir -p macos/bin/arm64
+ if [ -f "macos/bin/arm64/fpc_atomic" ]; then
+ echo "Client built successfully"
+ fi
+ if [ -f "macos/bin/arm64/atomic_launcher" ]; then
+ echo "Launcher built successfully"
+ fi
+ if [ -f "macos/bin/arm64/atomic_server" ]; then
+ echo "Server built successfully"
+ fi
+ if [ -f "macos/bin/arm64/cd_data_extractor" ]; then
+ echo "CD Data Extractor built successfully"
+ fi
+
+ # 9. Upload artifacts
+ - name: Upload macOS ARM64 binaries
+ uses: actions/upload-artifact@v4
+ with:
+ name: macos-arm64-binaries
+ path: macos/bin/arm64/*
+ retention-days: 30
+
+ build-macos-x86_64:
+ name: Build for macOS (x86_64)
+ runs-on: macos-13 # Použije macOS runner (Intel - starší verze, ale stále dostupná)
+
+ steps:
+ # 1. Checkout kódu z repozitáře
+ - name: Checkout code
+ uses: actions/checkout@v4
+
+ # 2. Setup Free Pascal Compiler
+ - name: Setup Free Pascal Compiler
+ run: |
+ brew install fpc
+
+ # Ověřit instalaci
+ fpc -v
+
+ # 3. Setup Lazarus IDE
+ - name: Setup Lazarus IDE
+ run: |
+ brew install --cask lazarus
+
+ # Ověřit instalaci
+ lazbuild --version
+
+ # 4. Build Client
+ - name: Build Client (x86_64)
+ run: |
+ cd client
+ lazbuild --build-mode=macos_x86_64 fpc_atomic.lpi
+
+ # 5. Build Launcher
+ - name: Build Launcher (x86_64)
+ run: |
+ cd launcher
+ lazbuild --build-mode=macos_x86_64 atomic_launcher.lpi
+
+ # 6. Build Server
+ - name: Build Server (x86_64)
+ run: |
+ cd server
+ lazbuild --build-mode=macos_x86_64 atomic_server.lpi
+
+ # 7. Build CD Data Extractor
+ - name: Build CD Data Extractor (x86_64)
+ run: |
+ cd cd_data_extractor_src
+ lazbuild --build-mode=macos_x86_64 cd_data_extractor.lpi
+
+ # 8. Prepare artifacts
+ - name: Prepare artifacts
+ run: |
+ mkdir -p macos/bin/x86_64
+ if [ -f "macos/bin/x86_64/fpc_atomic" ]; then
+ echo "Client built successfully"
+ fi
+
+ # 9. Upload artifacts
+ - name: Upload macOS x86_64 binaries
+ uses: actions/upload-artifact@v4
+ with:
+ name: macos-x86_64-binaries
+ path: macos/bin/x86_64/*
+ retention-days: 30
+
diff --git a/.github/workflows/build-windows.yml b/.github/workflows/build-windows.yml
new file mode 100644
index 0000000..8c45c7c
--- /dev/null
+++ b/.github/workflows/build-windows.yml
@@ -0,0 +1,599 @@
+name: Build Windows
+
+# Tento workflow se spustí při:
+# - Push do main/master branch
+# - Pull request do main/master branch
+# - Manuálně přes GitHub Actions tab
+on:
+ #push:
+ # branches: [ main, master ]
+ #pull_request:
+ # branches: [ main, master ]
+ workflow_dispatch: # Umožňuje manuální spuštění
+
+jobs:
+ build-windows:
+ name: Build for Windows
+ runs-on: windows-latest # Použije Windows runner (virtuální Windows počítač)
+
+ steps:
+ # 1. Checkout kódu z repozitáře
+ - name: Checkout code
+ uses: actions/checkout@v4
+
+ # 2. Setup Free Pascal Compiler
+ - name: Setup Free Pascal Compiler
+ run: |
+ $fpcVersion = "3.2.2"
+ $fpcInstaller = "$env:TEMP\fpc-installer.exe"
+
+ # Download FPC from SourceForge
+ # Chocolatey installs 32-bit only, but we need 64-bit for lazbuild
+ # Use the combined installer which includes both 32-bit and 64-bit
+ Write-Host "Downloading FPC 64-bit from SourceForge..."
+ $fpcUrl = "https://sourceforge.net/projects/freepascal/files/Win32/$fpcVersion/fpc-$fpcVersion.win32.and.win64.exe/download"
+
+ # Use curl with proper redirect handling
+ Write-Host "Downloading FPC installer from: $fpcUrl"
+ $ProgressPreference = 'SilentlyContinue'
+
+ # Try curl first
+ curl.exe -L --location-trusted -f -o $fpcInstaller $fpcUrl 2>&1 | Out-Null
+ if ($LASTEXITCODE -ne 0 -or -not (Test-Path $fpcInstaller)) {
+ Write-Host "curl failed, trying Invoke-WebRequest..."
+ try {
+ Invoke-WebRequest -Uri $fpcUrl -OutFile $fpcInstaller -UseBasicParsing -MaximumRedirection 10 -ErrorAction Stop
+ } catch {
+ Write-Host "ERROR: Download failed - $_"
+ Write-Host "Trying alternative URL..."
+ # Alternative: try the x86_64 specific installer
+ $fpcUrlAlt = "https://sourceforge.net/projects/freepascal/files/Win32/$fpcVersion/fpc-$fpcVersion.x86_64-win64.exe/download"
+ curl.exe -L --location-trusted -f -o $fpcInstaller $fpcUrlAlt 2>&1 | Out-Null
+ if ($LASTEXITCODE -ne 0 -or -not (Test-Path $fpcInstaller)) {
+ Write-Host "ERROR: All download attempts failed"
+ exit 1
+ }
+ }
+ }
+
+ # Verify file size (should be > 10MB)
+ $fileInfo = Get-Item $fpcInstaller
+ Write-Host "Downloaded file size: $($fileInfo.Length) bytes"
+ if ($fileInfo.Length -lt 10MB) {
+ Write-Host "ERROR: File too small, may be HTML error page"
+ Get-Content $fpcInstaller -TotalCount 10
+ exit 1
+ }
+
+ # Verify EXE header (MZ)
+ $fileBytes = [System.IO.File]::ReadAllBytes($fpcInstaller)
+ if ($fileBytes.Length -lt 2 -or $fileBytes[0] -ne 0x4D -or $fileBytes[1] -ne 0x5A) {
+ Write-Host "ERROR: Not a valid EXE file (missing MZ header)"
+ exit 1
+ }
+ Write-Host "File verified as valid EXE"
+
+ # Install FPC
+ Write-Host "Installing FPC..."
+ $fullInstallerPath = (Resolve-Path $fpcInstaller).Path
+
+ # Create setup.inf to ensure 64-bit is installed
+ $setupInfPath = "$env:TEMP\fpc_setup.inf"
+ $setupInfLines = @(
+ "[Setup]",
+ "Lang=default",
+ "Dir=C:\FPC",
+ "Group=Free Pascal",
+ "NoIcons=1",
+ "SetupType=full",
+ "Components=base,binutils,docs,ide,utils,make,demo,gdb,units,examples",
+ "Tasks="
+ )
+ $setupInfLines | Out-File -FilePath $setupInfPath -Encoding ASCII
+
+ # Install with setup.inf to ensure all components are installed
+ $installProcess = Start-Process -FilePath $fullInstallerPath -ArgumentList "/VERYSILENT /NORESTART /LOADINF=`"$setupInfPath`"" -Wait -PassThru -NoNewWindow
+ if ($installProcess.ExitCode -ne 0) {
+ Write-Host "ERROR: Installer exited with code $($installProcess.ExitCode)"
+ exit 1
+ }
+ Write-Host "FPC installer completed successfully"
+
+ # Wait a moment for installation to complete
+ Start-Sleep -Seconds 3
+
+ # Debug: List what was installed
+ Write-Host "Checking installation directory..."
+ if (Test-Path "C:\FPC") {
+ Write-Host "Contents of C:\FPC:"
+ Get-ChildItem "C:\FPC" -Recurse -Directory -Depth 2 | Select-Object -First 20 FullName
+ }
+
+ # Find FPC installation path - prioritize 64-bit for lazbuild
+ Write-Host "Searching for FPC installation (preferring 64-bit)..."
+
+ # First, try to find 64-bit version (needed for lazbuild)
+ $fpcPath64 = $null
+ $possiblePaths64 = @(
+ "C:\FPC\bin\x86_64-win64",
+ "C:\FPC\bin\win64",
+ "C:\FPC\$fpcVersion\bin\x86_64-win64",
+ "C:\FPC\$fpcVersion\bin\win64"
+ )
+
+ foreach ($path in $possiblePaths64) {
+ if (Test-Path $path) {
+ $ppcExe = Join-Path $path "ppcx64.exe"
+ if (Test-Path $ppcExe) {
+ Write-Host "Found FPC 64-bit at: $path"
+ $fpcPath64 = $path
+ break
+ }
+ }
+ }
+
+ # If 64-bit not found, search recursively
+ if (-not $fpcPath64) {
+ Write-Host "Searching for ppcx64.exe in C:\FPC..."
+ $ppc64Exe = Get-ChildItem -Path "C:\FPC" -Recurse -Filter "ppcx64.exe" -ErrorAction SilentlyContinue | Select-Object -First 1
+ if ($ppc64Exe) {
+ $fpcPath64 = $ppc64Exe.DirectoryName
+ Write-Host "Found FPC 64-bit compiler at: $fpcPath64"
+ }
+ }
+
+ # Fallback to 32-bit if 64-bit not available
+ $fpcPath = $fpcPath64
+ if (-not $fpcPath) {
+ Write-Host "64-bit FPC not found, trying 32-bit..."
+ $possiblePaths32 = @(
+ "C:\FPC\bin\i386-win32",
+ "C:\FPC\bin\win32",
+ "C:\FPC\$fpcVersion\bin\i386-win32",
+ "C:\FPC\$fpcVersion\bin\win32"
+ )
+
+ foreach ($path in $possiblePaths32) {
+ if (Test-Path $path) {
+ $ppcExe = Join-Path $path "ppc386.exe"
+ if (Test-Path $ppcExe) {
+ Write-Host "Found FPC 32-bit at: $path"
+ $fpcPath = $path
+ break
+ }
+ }
+ }
+
+ # Last resort: search for any fpc.exe or ppc*.exe
+ if (-not $fpcPath) {
+ $fpcExe = Get-ChildItem -Path "C:\FPC" -Recurse -Filter "fpc.exe" -ErrorAction SilentlyContinue | Select-Object -First 1
+ if ($fpcExe) {
+ $fpcPath = $fpcExe.DirectoryName
+ Write-Host "Found FPC executable at: $fpcPath"
+ }
+ }
+ }
+
+ if (-not $fpcPath) {
+ Write-Host "ERROR: Could not locate FPC installation"
+ Write-Host "Contents of C:\FPC\bin:"
+ if (Test-Path "C:\FPC\bin") {
+ Get-ChildItem "C:\FPC\bin" -Directory | Select-Object FullName
+ }
+ exit 1
+ }
+
+ # Add FPC to PATH
+ $env:PATH = "$fpcPath;$env:PATH"
+ echo "$fpcPath" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append
+ Write-Host "Added to PATH: $fpcPath"
+
+ # Verify installation - use -iV to get version without requiring source file
+ Write-Host "Verifying FPC installation..."
+ $fpcExePath = Join-Path $fpcPath "fpc.exe"
+ if (Test-Path $fpcExePath) {
+ & $fpcExePath -iV
+ if ($LASTEXITCODE -eq 0) {
+ Write-Host "FPC verified successfully"
+ } else {
+ Write-Host "WARNING: fpc -iV failed, but continuing..."
+ }
+ } else {
+ Write-Host "WARNING: fpc.exe not found, but compiler found at: $fpcPath"
+ }
+
+ # 3. Setup Lazarus IDE
+ - name: Setup Lazarus IDE
+ run: |
+ $lazarusVersion = "3.0"
+ $lazarusInstaller = "$env:TEMP\lazarus-installer.exe"
+
+ # Try Chocolatey first (if available)
+ Write-Host "Trying Chocolatey for Lazarus..."
+ choco install lazarus --version=$lazarusVersion -y --no-progress
+ if ($LASTEXITCODE -eq 0) {
+ Write-Host "Lazarus installed via Chocolatey"
+ # Refresh PATH to pick up Chocolatey installation
+ $env:Path = [System.Environment]::GetEnvironmentVariable("Path","Machine") + ";" + [System.Environment]::GetEnvironmentVariable("Path","User")
+
+ # Wait a moment for PATH to update
+ Start-Sleep -Seconds 2
+
+ # Try to find lazbuild in common locations
+ $lazbuildPath = $null
+ $possibleLazbuildPaths = @(
+ "C:\lazarus",
+ "C:\Program Files\Lazarus",
+ "C:\Program Files (x86)\Lazarus",
+ "$env:ProgramFiles\Lazarus",
+ "$env:ProgramFiles(x86)\Lazarus"
+ )
+
+ foreach ($path in $possibleLazbuildPaths) {
+ $lazbuildExe = Join-Path $path "lazbuild.exe"
+ if (Test-Path $lazbuildExe) {
+ Write-Host "Found lazbuild at: $lazbuildExe"
+ $lazbuildPath = $path
+ $env:PATH = "$path;$env:PATH"
+ echo "$path" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append
+ break
+ }
+ }
+
+ # If not found, search recursively
+ if (-not $lazbuildPath) {
+ Write-Host "Searching for lazbuild.exe recursively..."
+ $lazbuildExe = Get-ChildItem -Path "C:\" -Recurse -Filter "lazbuild.exe" -ErrorAction SilentlyContinue | Select-Object -First 1
+ if ($lazbuildExe) {
+ $lazbuildPath = $lazbuildExe.DirectoryName
+ Write-Host "Found lazbuild at: $lazbuildPath"
+ $env:PATH = "$lazbuildPath;$env:PATH"
+ echo "$lazbuildPath" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append
+ }
+ }
+
+ # Verify installation
+ if ($lazbuildPath) {
+ lazbuild --version
+ if ($LASTEXITCODE -eq 0) {
+ Write-Host "Lazarus verified successfully"
+ exit 0
+ }
+ } else {
+ Write-Host "WARNING: lazbuild not found after Chocolatey installation, will try SourceForge..."
+ }
+ }
+
+ # Fallback: Download from SourceForge
+ Write-Host "Chocolatey failed or Lazarus not found, downloading from SourceForge..."
+ $lazarusUrl = "https://sourceforge.net/projects/lazarus/files/Lazarus%20Windows%2064%20bits/Lazarus%20$lazarusVersion/lazarus-$lazarusVersion-fpc-3.2.2-win64.exe/download"
+
+ # Use curl with proper redirect handling
+ Write-Host "Downloading Lazarus installer..."
+ $ProgressPreference = 'SilentlyContinue'
+ curl.exe -L --location-trusted -f -o $lazarusInstaller $lazarusUrl
+ if ($LASTEXITCODE -ne 0 -or -not (Test-Path $lazarusInstaller)) {
+ Write-Host "ERROR: Download failed"
+ exit 1
+ }
+
+ # Verify file size (should be > 50MB)
+ $fileInfo = Get-Item $lazarusInstaller
+ Write-Host "Downloaded file size: $($fileInfo.Length) bytes"
+ if ($fileInfo.Length -lt 50MB) {
+ Write-Host "ERROR: File too small, may be HTML error page"
+ Get-Content $lazarusInstaller -TotalCount 10
+ exit 1
+ }
+
+ # Verify EXE header (MZ)
+ $fileBytes = [System.IO.File]::ReadAllBytes($lazarusInstaller)
+ if ($fileBytes.Length -lt 2 -or $fileBytes[0] -ne 0x4D -or $fileBytes[1] -ne 0x5A) {
+ Write-Host "ERROR: Not a valid EXE file (missing MZ header)"
+ exit 1
+ }
+ Write-Host "File verified as valid EXE"
+
+ # Install Lazarus
+ Write-Host "Installing Lazarus IDE..."
+ $fullInstallerPath = (Resolve-Path $lazarusInstaller).Path
+ $installProcess = Start-Process -FilePath $fullInstallerPath -ArgumentList "/VERYSILENT /NORESTART /DIR=C:\lazarus" -Wait -PassThru -NoNewWindow
+ if ($installProcess.ExitCode -ne 0) {
+ Write-Host "ERROR: Installer exited with code $($installProcess.ExitCode)"
+ exit 1
+ }
+
+ # Add Lazarus to PATH
+ $lazarusPath = "C:\lazarus"
+ if (-not (Test-Path $lazarusPath)) {
+ Write-Host "ERROR: Lazarus installation path not found: $lazarusPath"
+ exit 1
+ }
+ $env:PATH = "$lazarusPath;$env:PATH"
+ echo "$lazarusPath" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append
+
+ # Verify installation
+ Write-Host "Verifying Lazarus installation..."
+ lazbuild --version
+ if ($LASTEXITCODE -ne 0) {
+ Write-Host "ERROR: Lazarus verification failed"
+ exit 1
+ }
+
+ # 4. Download and build LNet package
+ - name: Download and build LNet package
+ run: |
+ Write-Host "Downloading LNet from GitHub..."
+ # Use master branch (not main) - see https://github.com/PascalCorpsman/lnet
+ $lnetUrl = "https://github.com/PascalCorpsman/lnet/archive/refs/heads/master.zip"
+ $lnetZip = "$env:TEMP\lnet.zip"
+ $lnetDir = "$env:TEMP\lnet"
+
+ # Download LNet
+ Write-Host "Downloading from: $lnetUrl"
+ $ProgressPreference = 'SilentlyContinue'
+ curl.exe -L --location-trusted -f -o $lnetZip $lnetUrl
+ if ($LASTEXITCODE -ne 0 -or -not (Test-Path $lnetZip)) {
+ Write-Host "ERROR: Failed to download LNet (curl exit code: $LASTEXITCODE)"
+ Write-Host "Trying alternative URL..."
+ # Try alternative URL format
+ $lnetUrlAlt = "https://github.com/PascalCorpsman/lnet/archive/master.zip"
+ curl.exe -L --location-trusted -f -o $lnetZip $lnetUrlAlt
+ if ($LASTEXITCODE -ne 0 -or -not (Test-Path $lnetZip)) {
+ Write-Host "ERROR: All download attempts failed"
+ exit 1
+ }
+ }
+ Write-Host "LNet downloaded successfully"
+
+ # Extract LNet
+ Write-Host "Extracting LNet..."
+ Expand-Archive -Path $lnetZip -DestinationPath $lnetDir -Force
+
+ # Find the package files
+ $lnetPackagePath = Get-ChildItem -Path $lnetDir -Recurse -Filter "lnetvisual.lpk" | Select-Object -First 1
+ if (-not $lnetPackagePath) {
+ Write-Host "ERROR: lnetvisual.lpk not found in downloaded archive"
+ exit 1
+ }
+
+ $lnetBasePath = Get-ChildItem -Path $lnetDir -Recurse -Filter "lnetbase.lpk" | Select-Object -First 1
+ if (-not $lnetBasePath) {
+ Write-Host "ERROR: lnetbase.lpk not found in downloaded archive"
+ exit 1
+ }
+
+ Write-Host "Found LNet packages:"
+ Write-Host " Base: $($lnetBasePath.FullName)"
+ Write-Host " Visual: $($lnetPackagePath.FullName)"
+
+ # Build base package first
+ Write-Host "Building lnetbase.lpk..."
+ lazbuild --build $lnetBasePath.FullName
+ if ($LASTEXITCODE -ne 0) {
+ Write-Host "WARNING: lnetbase.lpk build failed, but continuing..."
+ } else {
+ Write-Host "lnetbase.lpk built successfully"
+ }
+
+ # Build visual package
+ Write-Host "Building lnetvisual.lpk..."
+ lazbuild --build $lnetPackagePath.FullName
+ if ($LASTEXITCODE -eq 0) {
+ Write-Host "LNet package built successfully"
+ } else {
+ Write-Host "WARNING: LNet package build failed"
+ }
+
+ # Copy LNet source files to expected location for search paths
+ Write-Host "Copying LNet source files to macos/third_party..."
+ $lnetSourceDir = "$lnetDir\lnet-master"
+ $targetLnetBaseDir = "macos\third_party\lnet"
+ $targetLnetSrcDir = "macos\third_party\lnet_src"
+
+ # Create base directory structure
+ New-Item -ItemType Directory -Force -Path $targetLnetBaseDir | Out-Null
+ New-Item -ItemType Directory -Force -Path $targetLnetSrcDir | Out-Null
+
+ # Copy lib directory as subdirectory (search path expects macos/third_party/lnet/lib/)
+ if (Test-Path "$lnetSourceDir\lib") {
+ $targetLibDir = "$targetLnetBaseDir\lib"
+ Copy-Item -Path "$lnetSourceDir\lib" -Destination $targetLibDir -Recurse -Force
+ Write-Host "Copied LNet lib directory to $targetLibDir"
+ # Verify lnet.pp exists at correct path
+ if (Test-Path "$targetLibDir\lnet.pp") {
+ Write-Host "✓ lnet.pp found at: $targetLibDir\lnet.pp"
+ } else {
+ Write-Host "WARNING: lnet.pp not found at expected location"
+ Write-Host "Contents of ${targetLibDir}:"
+ Get-ChildItem -Path $targetLibDir -Filter "*.pp" | Select-Object -First 5 Name
+ exit 1
+ }
+ } else {
+ Write-Host "ERROR: LNet lib directory not found at $lnetSourceDir\lib"
+ exit 1
+ }
+
+ # Copy lazaruspackage directory (contains lclnet.pas and lnetcomponents.pas)
+ if (Test-Path "$lnetSourceDir\lazaruspackage") {
+ Copy-Item -Path "$lnetSourceDir\lazaruspackage" -Destination $targetLnetSrcDir -Recurse -Force
+ Write-Host "Copied LNet lazaruspackage to $targetLnetSrcDir"
+ } else {
+ Write-Host "ERROR: LNet lazaruspackage directory not found at $lnetSourceDir\lazaruspackage"
+ exit 1
+ }
+
+ # Verify key files are available at correct paths
+ $lnetComponentsPath = "$targetLnetSrcDir\lazaruspackage\lnetcomponents.pas"
+ $lclnetPath = "$targetLnetSrcDir\lazaruspackage\lclnet.pas"
+ $lnetPath = "$targetLnetBaseDir\lib\lnet.pp"
+
+ if (Test-Path $lnetComponentsPath) {
+ Write-Host "✓ lnetcomponents.pas available at: $lnetComponentsPath"
+ } else {
+ Write-Host "ERROR: lnetcomponents.pas not found at: $lnetComponentsPath"
+ exit 1
+ }
+
+ if (Test-Path $lclnetPath) {
+ Write-Host "✓ lclnet.pas available at: $lclnetPath"
+ } else {
+ Write-Host "ERROR: lclnet.pas not found at: $lclnetPath"
+ exit 1
+ }
+
+ if (Test-Path $lnetPath) {
+ Write-Host "✓ lnet.pp available at: $lnetPath"
+ } else {
+ Write-Host "ERROR: lnet.pp not found at: $lnetPath"
+ exit 1
+ }
+
+ Write-Host "All LNet files copied and verified successfully!"
+
+ # 5. Verify dependencies
+ - name: Verify dependencies
+ run: |
+ Write-Host "Verifying all required dependencies..."
+
+ # Check dglopengl.pas
+ if (Test-Path "units\dglOpenGL.pas") {
+ Write-Host "✓ dglOpenGL.pas found"
+ } else {
+ Write-Host "ERROR: dglOpenGL.pas not found"
+ exit 1
+ }
+
+ # Check bass.pas
+ if (Test-Path "units\bass.pas") {
+ Write-Host "✓ bass.pas found"
+ } else {
+ Write-Host "ERROR: bass.pas not found"
+ exit 1
+ }
+
+ # Check SDL2-for-Pascal
+ if (Test-Path "units\sdl2_for_pascal") {
+ Write-Host "✓ SDL2-for-Pascal found"
+ } else {
+ Write-Host "ERROR: SDL2-for-Pascal not found"
+ exit 1
+ }
+
+ # Check LNet source files (may be in downloaded archive or in repo)
+ $lnetComponentsFound = $false
+ $possibleLnetPaths = @(
+ "macos\third_party\lnet_src\lazaruspackage\lnetcomponents.pas",
+ "macos/third_party/lnet_src/lazaruspackage/lnetcomponents.pas",
+ "$env:TEMP\lnet\lnet-master\lazaruspackage\lnetcomponents.pas"
+ )
+
+ foreach ($path in $possibleLnetPaths) {
+ if (Test-Path $path) {
+ Write-Host "✓ LNet source files found at: $path"
+ $lnetComponentsFound = $true
+ break
+ }
+ }
+
+ if (-not $lnetComponentsFound) {
+ Write-Host "WARNING: LNet source files not found in expected locations"
+ Write-Host "LNet was downloaded and built, should be available via compiled packages"
+ Write-Host "Continuing anyway..."
+ }
+
+ # Check LazOpenGLContext (should be in Lazarus IDE)
+ Write-Host "✓ LazOpenGLContext should be part of Lazarus IDE (checked in RequiredPackages)"
+
+ # Note: synapse is not needed anymore (replaced with fphttpclient)
+ Write-Host "Note: synapse is not required (replaced with fphttpclient)"
+
+ Write-Host "All dependencies verified!"
+
+ # 6. Build Client
+ - name: Build Client
+ run: |
+ cd client
+ lazbuild --build-mode=default fpc_atomic.lpi
+ if ($LASTEXITCODE -ne 0) { exit 1 }
+
+ # 7. Build Launcher
+ - name: Build Launcher
+ run: |
+ cd launcher
+ lazbuild --build-mode=default atomic_launcher.lpi
+ if ($LASTEXITCODE -ne 0) { exit 1 }
+
+ # 8. Build Server
+ - name: Build Server
+ run: |
+ cd server
+ lazbuild --build-mode=default atomic_server.lpi
+ if ($LASTEXITCODE -ne 0) { exit 1 }
+
+ # 9. Build CD Data Extractor
+ - name: Build CD Data Extractor
+ run: |
+ cd cd_data_extractor_src
+ lazbuild --build-mode=default cd_data_extractor.lpi
+ if ($LASTEXITCODE -ne 0) { exit 1 }
+
+ # 10. Create artifacts directory
+ - name: Prepare artifacts
+ run: |
+ New-Item -ItemType Directory -Force -Path windows\bin
+ Write-Host "Looking for compiled binaries..."
+
+ # Binaries are compiled to the root directory (one level up from project folders)
+ $binaries = @(
+ "fpc_atomic.exe",
+ "atomic_launcher.exe",
+ "atomic_server.exe",
+ "cd_data_extractor.exe"
+ )
+
+ foreach ($bin in $binaries) {
+ if (Test-Path $bin) {
+ Write-Host "Found: $bin"
+ Move-Item $bin "windows\bin\" -Force
+ } else {
+ Write-Host "WARNING: $bin not found"
+ }
+ }
+
+ # Copy DLL files (ai.dll, bass.dll, SDL2.dll) to artifacts
+ Write-Host "Copying DLL files..."
+ $dllFiles = @(
+ "bin\ai.dll",
+ "bin\bass.dll",
+ "bin\SDL2.dll"
+ )
+
+ foreach ($dll in $dllFiles) {
+ if (Test-Path $dll) {
+ Write-Host "Found: $dll"
+ Copy-Item $dll "windows\bin\" -Force
+ } else {
+ Write-Host "WARNING: $dll not found"
+ }
+ }
+
+ # Copy data directory to artifacts
+ Write-Host "Copying data directory..."
+ if (Test-Path "data") {
+ Copy-Item -Path "data" -Destination "windows\bin\data" -Recurse -Force
+ Write-Host "✓ data directory copied to windows\bin\data"
+ } else {
+ Write-Host "WARNING: data directory not found"
+ }
+
+ Write-Host "Artifacts prepared. Contents of windows\bin:"
+ Get-ChildItem windows\bin\ | Format-Table
+
+ # 11. Upload artifacts (soubory ke stažení)
+ - name: Upload Windows binaries
+ uses: actions/upload-artifact@v4
+ with:
+ name: FPCAtomic-Windows
+ path: windows/bin/*
+ retention-days: 30 # Uchovat 30 dní
diff --git a/.github/workflows/create-game-release.yml b/.github/workflows/create-game-release.yml
new file mode 100644
index 0000000..55aa618
--- /dev/null
+++ b/.github/workflows/create-game-release.yml
@@ -0,0 +1,130 @@
+name: Create Game Release
+
+# This workflow creates a release with game builds for Windows and Linux
+# macOS builds are created locally, not via GitHub Actions
+# Responds only to tags starting with "v" (e.g., v1.0.0), but NOT "server-v*"
+on:
+ workflow_dispatch:
+ inputs:
+ version:
+ description: 'Version tag (e.g., v1.0.0)'
+ required: true
+ push:
+ tags:
+ - 'v*' # Triggers on tags starting with 'v' (e.g., v1.0.0)
+
+jobs:
+ create-release:
+ name: Create Game Release
+ runs-on: ubuntu-latest
+ # Don't run for server tags - they have their own workflow
+ if: ${{ !startsWith(github.ref, 'refs/tags/server-v') }}
+
+ steps:
+ - name: Checkout code
+ uses: actions/checkout@v4
+
+ - name: Extract version
+ id: version
+ run: |
+ if [[ "${{ github.event_name }}" == "workflow_dispatch" ]]; then
+ VERSION="${{ github.event.inputs.version }}"
+ elif [[ "${{ github.ref }}" == refs/tags/* ]]; then
+ VERSION=${GITHUB_REF#refs/tags/}
+ else
+ VERSION="dev-${GITHUB_SHA::8}"
+ fi
+ echo "version=$VERSION" >> $GITHUB_OUTPUT
+ echo "Version: $VERSION"
+
+ - name: Download Windows artifacts
+ uses: dawidd6/action-download-artifact@v3
+ continue-on-error: true
+ with:
+ workflow: build-windows.yml
+ name: FPCAtomic-Windows
+ path: release-assets/windows
+ github_token: ${{ secrets.GITHUB_TOKEN }}
+
+ - name: Download Linux artifacts
+ uses: dawidd6/action-download-artifact@v3
+ continue-on-error: true
+ with:
+ workflow: build-linux.yml
+ name: FPCAtomic-Linux
+ path: release-assets/linux
+ github_token: ${{ secrets.GITHUB_TOKEN }}
+
+ - name: Prepare release assets
+ run: |
+ mkdir -p release-assets
+ echo "Preparing release assets for ${{ steps.version.outputs.version }}"
+
+ # Check which platforms are available
+ if [ -d "release-assets/windows" ] && [ "$(ls -A release-assets/windows 2>/dev/null)" ]; then
+ echo "✓ Windows binaries found"
+ # Create ZIP for Windows
+ cd release-assets/windows
+ zip -r ../FPCAtomic-Windows-${{ steps.version.outputs.version }}.zip .
+ cd ../..
+ fi
+
+ if [ -d "release-assets/linux" ] && [ "$(ls -A release-assets/linux 2>/dev/null)" ]; then
+ echo "✓ Linux binaries found"
+ # Create tar.gz for Linux
+ cd release-assets/linux
+ tar -czf ../FPCAtomic-Linux-${{ steps.version.outputs.version }}.tar.gz .
+ cd ../..
+ fi
+
+ # List all prepared files
+ echo "Release assets prepared:"
+ ls -lh release-assets/*.{zip,tar.gz} 2>/dev/null || echo "⚠️ No archives found - make sure build workflows have run for this tag"
+
+ # If no artifacts found, create at least a placeholder
+ if [ ! -f "release-assets/FPCAtomic-Windows-${{ steps.version.outputs.version }}.zip" ] && \
+ [ ! -f "release-assets/FPCAtomic-Linux-${{ steps.version.outputs.version }}.tar.gz" ]; then
+ echo "⚠️ WARNING: No build artifacts found. Release will be created but without binaries."
+ echo "⚠️ WARNING: Make sure to run build workflows (build-windows.yml, build-linux.yml) first."
+ fi
+
+ - name: Create Release
+ if: startsWith(github.ref, 'refs/tags/v') || github.event_name == 'workflow_dispatch'
+ uses: softprops/action-gh-release@v1
+ with:
+ name: FPC Atomic ${{ steps.version.outputs.version }}
+ tag_name: ${{ steps.version.outputs.version }}
+ body: |
+ ## FPC Atomic ${{ steps.version.outputs.version }}
+
+ ### 🎮 Game Release
+
+ This release contains game binaries for Windows and Linux and macOS.
+ To play the game, you need to extract the original graphics from the game disc and provide them as requested by the game.
+
+ ### 📦 Available Downloads
+
+ - **Windows**: Download `FPCAtomic-Windows-${{ steps.version.outputs.version }}.zip` and extract to play
+ - **Linux**: Download `FPCAtomic-Linux-${{ steps.version.outputs.version }}.tar.gz` and extract to play
+ - **macOS**: macOS builds are created locally. See [macos/README_mac.md](../macos/README_mac.md) for build instructions.
+
+ ### 🚀 Installation
+
+ See the main [README.md](README.md) for installation instructions.
+
+ ### 📝 Notes
+
+ - For macOS, you may need to remove quarantine attributes running: `remove_quarantine.command`
+ - Linux users may need to install dependencies: `sudo apt-get install libssl-dev`
+ - Windows Defender may flag unsigned executables - this is normal for unsigned builds
+
+ ### 🔗 Related Releases
+
+ - **Fly.io Server**: See [server releases](https://github.com/${{ github.repository }}/releases) tagged with `server-v*` for cloud server deployment
+ draft: false
+ prerelease: false
+ files: |
+ release-assets/*.zip
+ release-assets/*.tar.gz
+ token: ${{ secrets.GITHUB_TOKEN }}
+
diff --git a/.gitignore b/.gitignore
index e1043a1..9f64561 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,16 @@
# Source: https://github.com/github/gitignore/blob/main/Global/Lazarus.gitignore
+# Exception: Required libraries in bin/ directory for CI/CD builds
+# These are downloaded from GitHub releases and needed for linking
+# Must be before the global *.dll, *.so rules
+!bin/libbass.so
+!bin/libai.so
+!bin/bass.dll
+!bin/ai.dll
+!bin/SDL2.dll
+!bin/Linux_sound_install_script.sh
+!bin/fpc_atomic.version
+
# Lazarus compiler-generated binaries (safe to delete)
*.exe
*.dll
@@ -27,12 +38,32 @@
backup/
*.bak
lib/
-release/
# Application bundle for Mac OS
*.app/
+# Full game data - for flyio server
+flyio_server/data/
+
# Atomic files
server/stats.txt
stats.txt
+.env
+macos/app_arm64/data
+macos/app_x86_64/data
+macos/app_universal/data
+bin/macos/
+data
+
+# DMG files for distribution
+releases/
+releases/*.dmg
+releases/*.temp.dmg
+
+# Notarization temporary files
+*.zip
+!*.lpi
+
+# Fly.io secrets (keep your own secrets private)
+# Note: fly.toml is now committed with placeholder, actual app name comes from .env
diff --git a/.vscode/tasks.json b/.vscode/tasks.json
new file mode 100644
index 0000000..dde5607
--- /dev/null
+++ b/.vscode/tasks.json
@@ -0,0 +1,13 @@
+{
+ "version": "2.0.0",
+ "tasks": [
+ {
+ "label": "Build with FPC",
+ "type": "shell",
+ "command": "fpc",
+ "args": ["-MObjFPC", "-Sh", "launcher/atomic_launcher.lpr"],
+ "group": "build",
+ "problemMatcher": []
+ }
+ ]
+}
\ No newline at end of file
diff --git a/README.md b/README.md
index 9fcd885..a74236e 100644
--- a/README.md
+++ b/README.md
@@ -1,13 +1,27 @@
# FPC Atomic
-Author : Uwe Schächterle (Corpsman)
-Homepage : https://www.Corpsman.de
-Source : https://github.com/PascalCorpsman/fpc_atomic
-Wiki : https://en.wikipedia.org/wiki/Atomic_Bomberman
+Author : Uwe Schächterle (Corpsman)
+Homepage : https://www.Corpsman.de
+Source : https://github.com/PascalCorpsman/fpc_atomic
+Wiki : https://en.wikipedia.org/wiki/Atomic_Bomberman
+
+MacOS version : Pavel Zvěřina
## Description
FPC Atomic is a complete reimplementation of the original Atomic Bomberman game (from 1997). This repository hosts only the source code, as the graphics and sounds are copyrighted by Interplay Productions. To play the game, you need to extract the original graphics from the game disc and provide them as requested by the game.
+## Differences from the original fork
+
+This version is a fork of the original FPC Atomic implementation by Uwe Schächterle (Corpsman). While maintaining compatibility with the original game mechanics, this fork focuses on:
+- Native build macOS (Apple Silicon and Intel)
+- Cross-platform game compatibility and native builds for all major platforms
+- Build and deploy game server on [fly.io](https://fly.io)
+- Modern deployment options (automated builds)
+- Enhanced user experience (better controller support, network optimizations)
+- Support of Game Controllers ()
+- Support for up to 4 players on a single computer (2 Keyboards, 2 Game Controllers)
+- Bug fixes and animation corrections
+
## Preview:
@@ -15,15 +29,13 @@ FPC Atomic is a complete reimplementation of the original Atomic Bomberman game
## What needs to be done to play the game?
-The steps shown here are only needed to be done once (for installation).
-
-
1. get the Atomic Bomberman CD-content (buy the game it is worth it!) and store it on your harddrive
1.1 if you want all animations download and merge the expansion pack from [here](https://www.oocities.org/timessquare/tower/4056/ani.html) or use this [direct download link](https://www.oocities.org/timessquare/tower/4056/download/ani.zip) link is broken use [new link](https://www.geocities.ws/mheid.geo/download/ani.zip)
1.2 extract the content of ani.zip into the CD-Content "/DATA/ANI" subfolder
-2. download the atomic_launcher from the latest release [here](https://github.com/PascalCorpsman/fpc_atomic/releases/latest) and store it on your harddisc
-
+
+2. download the files from the latest release [here](https://github.com/zverinapavel/fpc_atomic_macos/releases/latest) and store it on your harddisc
+
2.1 Linux users will need to
>
> chmod +x atomic_launcher
@@ -38,10 +50,11 @@ The steps shown here are only needed to be done once (for installation).
4.2 Click "start extraction"
5. read the [manual](MANUAL.md)
5.5 if you are a Linux user run the "Linux_sound_install_script.sh"
-6. start the game by executing "atomic_launcher" and enjoy
+6. start the game by executing "atomic_launcher" or "FPCAtomic" application and enjoy
## How do i get updates ?
-By using the launcher you can click the "check for update" feature to check wether there are updates available. If so, the launcher automatically asks you to download the updates.
+By using the launcher you can click the "check for update" feature to check wether there are updates available. If so, the launcher automatically asks you to download the updates.
+NOTE: This feature is not supported on MacOS
## Differences to the original
@@ -62,17 +75,50 @@ See the license.md file located at [license.md](license.md) for details about th
## What needs to be done to compile the code ?
+### General Requirements
+
1. Install Lazarus IDE from https://www.lazarus-ide.org/
2. Download dglopengl.pas from https://github.com/saschawillems/dglopengl and store it in the "units" folder
3. Download bass.pas from https://www.un4seen.com/ and store it in the "units" folder
- - Linux users: copy libbass.so to "/usr/lib/" or run "Linux_sound_install_script.sh"
- - Windows users: copy bass.dll from the bin folder into the repository root folder
-4. Download synapse from http://www.ararat.cz/synapse/doku.php/download and store it in a new subfolder "synapse"
-5. Install the following packages into the Lazarus IDE:
+4. Install the following packages into the Lazarus IDE:
- 'Lnet' from https://github.com/almindor/L-Net or the fixed version from https://github.com/PascalCorpsman/lnet
- 'LazOpenGLContext' (from the list of available packages inside the IDE)
-6. Download SDL2-Header from https://github.com/PascalCorpsman/SDL2-for-Pascal and store the content its "units" folder in a new subfolder "sdl2_for_pascal"
-7. Add the paths from 4. and 6. as searchpaths for all .lpi files (at least client, launcher and server) (in the IDE project -> settings -> compilersettings -> paths). Ignore the not resolvable searchpaths.
+5. Download SDL2-Header from https://github.com/PascalCorpsman/SDL2-for-Pascal and store the content its "units" folder in a new subfolder "sdl2_for_pascal"
+6. Add the paths from 5. as searchpaths for all .lpi files (at least client, launcher and server) (in the IDE project -> settings -> compilersettings -> paths). Ignore the not resolvable searchpaths.
+
+### Platform-Specific Instructions
+
+#### Linux
+- Copy libbass.so to "/usr/lib/" or run "Linux_sound_install_script.sh"
+
+#### Windows
+- Copy bass.dll from the bin folder into the repository root folder
+
+#### macOS
+
+**Installation (for end users):**
+
+1. Download the latest release from the [releases page](https://github.com/PascalCorpsman/fpc_atomic/releases/latest)
+2. Drag the FPCAtomic folder to your Applications folder
+3. Open the FPCAtomic folder and double-click `FPCAtomicLauncher.app` to start the launcher
+4. If the data directory is included, the game is ready to play!
+ - If not, click "Run CD data extractor", set the path to your Atomic Bomberman CD data, and click "Start extraction"
+5. If you copied the apps via AirDrop or downloaded them, you may need to:
+ - Double-click `remove_quarantine.command` to remove macOS quarantine
+ - This allows the apps to run without security warnings
+6. After extraction, you can launch the game from the launcher
+
+**System Requirements:**
+- macOS 11.0 (Big Sur) or later
+- For arm64 version: Apple Silicon Mac (M1/M2/M3 or later)
+- For x86_64 version: Intel Mac
+- For universal version: Any Mac (automatically uses the correct architecture)
+
+**Building from source:**
+- **See [macos/README_mac.md](macos/README_mac.md) for detailed macOS build instructions**
+- **Quick start:** `./macos/tools/build_all_arm64.command` (ARM64) or `./macos/tools/build_all_x86_64.command` (x86_64)
+- Copy libbass.dylib from the bass24-osx into macos/lib/arm64 and macos/lib/x86_64
+- For x86_64 builds, Rosetta Homebrew is required (installed automatically via `install_rosetta_homebrew.command`)
!! Attention !!
@@ -87,13 +133,31 @@ The AI that is delivered with this repository is more a try than a real AI, and
Read the manual section [Console commands](MANUAL.md#console-commands) to load and unload your ai without the need to restart the application.
+### Enhancements and bug fixies
+
+This fork includes significant improvements and new features:
+
+- **Multi-platform builds**: Added native builds for macOS (Apple Silicon and Intel)
+- **Resizable main window**: Main window of the game can be resized now
+- **Improved networking**: Network connection runs on a separate thread for better performance
+- **Cross-platform multiplayer**: Cross-play support between Windows, macOS, and Linux
+- **Cloud server support**: Server deployment on Fly.io for online multiplayer
+- **Enhanced controller support**: Improved joystick support with fine-tuned controls for both joystick and D-Pad
+- **Local multiplayer**: Support for up to 4 players on a single computer
+
+- **Network optimization**: Player movement prediction and extrapolation for smoother gameplay on low-quality networks
+- **Animation fixes**: Corrected "locked in" animations and fixed cornered animation bug (when bomberman is locked and cannot move)
+- **CI/CD automation**: GitHub Actions for automated builds (Windows, Linux, and Fly.io Docker server)
+
+
## External known sites which link to this repository
- https://osgameclones.com/atomic-bomberman/
- https://www.myabandonware.com/game/atomic-bomberman-bat
## Contributors
Idea : Interplay Productions
-Implementation : Uwe Schächterle
+Original Implementation : Uwe Schächterle (Corpsman)
+Enhanced Implementation & Cross-platform Support : Pavel Zverina
Graphics : Interplay Productions
Leveldesign : Interplay Productions
-Testing : Uwe Schächterle
+Testing : Uwe Schächterle, Pavel Zverina
diff --git a/ai/ai.lpi b/ai/ai.lpi
index 834203a..b2ac7c9 100644
--- a/ai/ai.lpi
+++ b/ai/ai.lpi
@@ -13,8 +13,48 @@
-
- -
-
-
- -
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- -
-
-
- -
-
-
- -
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+ -
+
+
+
+
+
diff --git a/cd_data_extractor_src/ucdextractor.pas b/cd_data_extractor_src/ucdextractor.pas
index a089de0..fca0a2b 100644
--- a/cd_data_extractor_src/ucdextractor.pas
+++ b/cd_data_extractor_src/ucdextractor.pas
@@ -12,6 +12,11 @@
(* source file of the project. *)
(* *)
(******************************************************************************)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
Unit ucdextractor;
{$MODE ObjFPC}{$H+}
@@ -478,11 +483,17 @@
Var
s: String;
Begin
+{$IFDEF Darwin}
+ // On macOS, check for FPCAtomic.app bundle
+ s := 'FPCAtomic.app';
+ result := DirectoryExists(IncludeTrailingPathDelimiter(aFolder) + s);
+{$ELSE}
s := 'fpc_atomic';
{$IFDEF Windows}
s := s + '.exe';
{$ENDIF}
result := FileExists(IncludeTrailingPathDelimiter(aFolder) + s);
+{$ENDIF}
End;
(*
@@ -512,6 +523,58 @@
* if match is not found result will be ''
*)
+(*
+ * Fixes ANI files that have leading whitespace by removing it and creating a corrected version
+ * Returns the path to the corrected file (or original if no fix was needed)
+ *)
+Function FixAniFileIfNeeded(Const AniFilename: String): String;
+Var
+ fs: TFileStream;
+ firstByte: Byte;
+ correctedFilename: String;
+ correctedStream: TFileStream;
+ buffer: Array[0..1023] Of Byte;
+ bytesRead: Integer;
+Begin
+ result := AniFilename;
+ If Not FileExists(AniFilename) Then Begin
+ exit;
+ End;
+ // Check if file starts with whitespace (0x20 = space)
+ fs := TFileStream.Create(AniFilename, fmOpenRead);
+ Try
+ If fs.Size < 11 Then Begin
+ exit; // File too small
+ End;
+ fs.Read(firstByte, 1);
+ If firstByte <> $20 Then Begin
+ exit; // No leading space, file is OK
+ End;
+ // File has leading space, create corrected version
+ correctedFilename := ChangeFileExt(AniFilename, '') + '-corrected' + ExtractFileExt(AniFilename);
+ If FileExists(correctedFilename) Then Begin
+ // Corrected file already exists, use it
+ result := correctedFilename;
+ exit;
+ End;
+ // Create corrected file (skip first byte)
+ fs.Position := 1; // Skip the leading space
+ correctedStream := TFileStream.Create(correctedFilename, fmCreate);
+ Try
+ While fs.Position < fs.Size Do Begin
+ bytesRead := fs.Read(buffer[0], SizeOf(buffer));
+ correctedStream.Write(buffer[0], bytesRead);
+ End;
+ AddLog(' Fixed ANI file (removed leading space): ' + ExtractFileName(AniFilename) + ' -> ' + ExtractFileName(correctedFilename));
+ result := correctedFilename;
+ Finally
+ correctedStream.Free;
+ End;
+ Finally
+ fs.Free;
+ End;
+End;
+
Function GetFileByMatch(Folder, Match: String): String;
Var
sl: TStringList;
@@ -573,6 +636,8 @@
AddLog(' Error: could not find: ' + Job.SourceAni);
exit;
End;
+ // Fix ANI file if it has leading whitespace
+ AniFilename := FixAniFileIfNeeded(AniFilename);
ani := TAniFile.Create();
If Not ani.LoadFromFile(AniFilename) Then Begin
ani.free;
diff --git a/cd_data_extractor_src/unit1.pas b/cd_data_extractor_src/unit1.pas
index 608ef1b..e4e6f9d 100644
--- a/cd_data_extractor_src/unit1.pas
+++ b/cd_data_extractor_src/unit1.pas
@@ -12,6 +12,11 @@
(* source file of the project. *)
(* *)
(******************************************************************************)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
Unit Unit1;
{$MODE objfpc}{$H+}
@@ -67,6 +72,8 @@
{ TForm1 }
Procedure TForm1.FormCreate(Sender: TObject);
+Var
+ defaultAtomicFolder: String;
Begin
IniPropStorage1.IniFileName := 'settings.ini';
(*
@@ -74,7 +81,30 @@
*)
caption := DefCaption;
label1.caption := ConcatRelativePath(ExtractFilePath(ParamStr(0)), IniPropStorage1.ReadString('CD-Root', ''));
- label2.caption := ConcatRelativePath(ExtractFilePath(ParamStr(0)), IniPropStorage1.ReadString('FPC-Atomic', ''));
+
+ // Set default FPC Atomic folder
+{$IFDEF Darwin}
+ // On macOS, set default to relative path ../../../ (three levels up from Contents/MacOS/)
+ // From: .../FPCAtomicLauncher.app/Contents/MacOS/
+ // To: .../app_arm64/
+ defaultAtomicFolder := IniPropStorage1.ReadString('FPC-Atomic', '');
+ If defaultAtomicFolder = '' Then Begin
+ // Use relative path ../../../ from the executable location
+ defaultAtomicFolder := '..' + PathDelim + '..' + PathDelim + '..' + PathDelim;
+ defaultAtomicFolder := ExcludeTrailingPathDelimiter(defaultAtomicFolder);
+ End;
+ label2.caption := ConcatRelativePath(ExtractFilePath(ParamStr(0)), defaultAtomicFolder);
+{$ELSE}
+ // On Windows/Linux, set default to the directory where the executable is located
+ defaultAtomicFolder := IniPropStorage1.ReadString('FPC-Atomic', '');
+ If defaultAtomicFolder = '' Then Begin
+ // Use the directory where the executable is located
+ defaultAtomicFolder := ExtractFilePath(ParamStr(0));
+ defaultAtomicFolder := ExcludeTrailingPathDelimiter(defaultAtomicFolder);
+ End;
+ label2.caption := ConcatRelativePath(ExtractFilePath(ParamStr(0)), defaultAtomicFolder);
+{$ENDIF}
+
memo1.clear;
Constraints.MinWidth := Width;
Constraints.MinHeight := Height;
@@ -109,9 +139,29 @@
End;
Procedure TForm1.Button4Click(Sender: TObject);
+Var
+ defaultDir: String;
Begin
// Set FPC Atomic Folder
SelectDirectoryDialog1.Title := button4.caption;
+{$IFDEF Darwin}
+ // On macOS, always set initial directory to two levels up (../../)
+ defaultDir := ExpandFileName(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + '..' + PathDelim + '..' + PathDelim);
+ defaultDir := ExcludeTrailingPathDelimiter(defaultDir);
+ If DirectoryExists(defaultDir) Then Begin
+ SelectDirectoryDialog1.InitialDir := defaultDir;
+ End
+ Else Begin
+ // Fallback to label2.caption if ../../ doesn't exist
+ If label2.caption <> '' Then Begin
+ SelectDirectoryDialog1.InitialDir := label2.caption;
+ End;
+ End;
+{$ELSE}
+ If label2.caption <> '' Then Begin
+ SelectDirectoryDialog1.InitialDir := label2.caption;
+ End;
+{$ENDIF}
If SelectDirectoryDialog1.Execute Then Begin
If CheckFPCAtomicFolder(SelectDirectoryDialog1.FileName) Then Begin
label2.Caption := SelectDirectoryDialog1.FileName;
@@ -121,7 +171,11 @@
End;
End
Else Begin
+{$IFDEF Darwin}
+ showmessage('Error, the folder should at least contain FPCAtomic.app');
+{$ELSE}
showmessage('Error, the folder should at least contain the executable for fpc_atomic');
+{$ENDIF}
End;
End;
End;
diff --git a/client/fpc_atomic.lpi b/client/fpc_atomic.lpi
index 104e26e..cd55e97 100644
--- a/client/fpc_atomic.lpi
+++ b/client/fpc_atomic.lpi
@@ -14,8 +14,56 @@
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -33,19 +81,16 @@
-
+
-
+
-
+
-
-
-
-
+
@@ -199,7 +244,7 @@
-
+
@@ -210,7 +255,7 @@
-
+
diff --git a/client/fpc_atomic.lpr b/client/fpc_atomic.lpr
index f4a7b46..6ee344c 100644
--- a/client/fpc_atomic.lpr
+++ b/client/fpc_atomic.lpr
@@ -12,6 +12,11 @@
(* source file of the project. *)
(* *)
(******************************************************************************)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
Program fpc_atomic;
{$MODE objfpc}{$H+}
@@ -21,7 +26,9 @@
cthreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
- Forms, Unit1, Unit18, uatomic, ukeyboarddialog, ukeygrabber;
+ Forms, Unit1, Unit18,
+ SysUtils
+ ;
Begin
// Do not Report if there is no error, that only confuses player..
diff --git a/client/uatomic.pas b/client/uatomic.pas
index 4a3c3d7..5160be3 100644
--- a/client/uatomic.pas
+++ b/client/uatomic.pas
@@ -1,476 +1,499 @@
-(******************************************************************************)
-(* *)
-(* Author : Uwe Schächterle (Corpsman) *)
-(* *)
-(* This file is part of FPC_Atomic *)
-(* *)
-(* See the file license.md, located under: *)
-(* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *)
-(* for details about the license. *)
-(* *)
-(* It is not allowed to change or remove this text from any *)
-(* source file of the project. *)
-(* *)
-(******************************************************************************)
-Unit uatomic;
-
-{$MODE ObjFPC}{$H+}
-
-{$I globaldefines.inc}
-
-Interface
-
-Uses
- Classes, SysUtils, uvectormath, uatomic_common
- , Graphics
- , uGraphics
- , uopengl_animation
- , uopengl_graphikengine
- ;
-
-Type
-
- TGameState = (
- gs_MainMenu, // Der Spieler ist im Hauptmenü
- gs_Gaming // Das Spiel läuft
- );
-
- tAtomicAnimation = (
- aaStandStill,
- aaWalk,
- aaKick, // Kicken
- aaPunch, // Weg schlagen (Roter Handschu)
- aaPup // Die Pupserkrankheit
- );
-
- TAnimation = Record
- Ani: TOpenGL_Animation;
- OffsetX, OffsetY: integer;
- End;
-
- TAnimations = Array Of TAnimation;
-
- { TAtomic }
-
- TAtomic = Class
- private
- fDieAnimations: TAnimations;
- fLockedInAnimations: TAnimations;
- fZenAnimations: TAnimations;
- fAnimations: Array[tAtomicAnimation] Of TAnimation;
- fShadowTex: TGraphikItem;
-
- public
- FlameEnd, FlameCross, FlameMiddle: TOpenGL_Animation;
- Bomb: TAnimation;
- Bomb_dud: TAnimation;
- Bomb_trigger: TAnimation;
- Bomb_Wobble: TAnimation;
-
- Constructor Create(); virtual;
- Destructor Destroy(); override;
- Function GetAnimTimeInMs(Anim: TRenderAnimation; Value: uint16): Integer;
- Function InitAsColor(path: String; aTargetColor: TRGB): Boolean;
-
- Procedure Render(Const Info: TAtomicInfo; Edge: Boolean);
- End;
-
- TAtomics = Array[0..length(PlayerColors) - 1] Of TAtomic;
-
-Implementation
-
-Uses
- math
- , dglOpenGL
- , IntfGraphics
- , fpImage
- ;
-
-Function LoadColorTabledImage(PNGImage: String; PlayerColor: TRGB): TBitmap;
-Var
- png: TPortableNetworkGraphic;
- bi: TBitmap;
- IntfImgi, IntfImgo: TLazIntfImage;
- i, j, k: Integer;
- ci, co: TFPColor;
- m, r, g, b: Integer;
- n: integer;
-Begin
- If Not FileExists(PNGImage) Then Begin
- result := Nil;
- exit;
- End;
- png := TPortableNetworkGraphic.Create;
- png.LoadFromFile(PNGImage);
- bi := TBitmap.create;
- bi.Assign(png);
- png.free;
- IntfImgi := TLazIntfImage.create(0, 0);
- IntfImgi.LoadFromBitmap(bi.Handle, Bi.MaskHandle);
- intfimgo := TLazIntfImage.create(0, 0);
- IntfImgo.LoadFromBitmap(bi.Handle, Bi.MaskHandle);
- For i := 0 To bi.width - 1 Do
- For j := 0 To bi.height - 1 Do Begin
- ci := IntfImgi.Colors[i, j];
- r := ci.red Shr 8;
- g := ci.green Shr 8;
- b := ci.blue Shr 8;
- If (g > r) And (g > b) Then Begin
- n := (r + b) Div 2;
- k := (g - n);
- r := n + (k * (PlayerColor.r)) Div 100;
- g := n + (k * (PlayerColor.g)) Div 100;
- b := n + (k * (PlayerColor.b)) Div 100;
- (*
- Tritt nur auf wenn die PlayerColor Werte > 100 haben
- *)
- m := max(r, max(g, b));
- If m > 255 Then Begin
- r := round(r * 255 / m);
- g := round(g * 255 / m);
- b := round(b * 255 / m);
- End;
- r := min(255, r);
- g := min(255, g);
- b := min(255, b);
- co.red := r Shl 8;
- co.green := g Shl 8;
- co.blue := b Shl 8;
- co.Alpha := 255 Shl 8;
- IntfImgo.Colors[i, j] := co;
- End
- Else Begin
- IntfImgo.Colors[i, j] := ci;
- End;
- End;
- result := TBitmap.create;
- result.LoadFromIntfImage(intfimgo);
- IntfImgi.free;
- IntfImgo.free;
- bi.free;
-End;
-
-{ TAtomic }
-
-Constructor TAtomic.Create;
-Begin
- Inherited Create();
-End;
-
-Destructor TAtomic.Destroy;
-Var
- ta: tAtomicAnimation;
- i: integer;
-Begin
- For i := 0 To high(fZenAnimations) Do Begin
- fZenAnimations[i].ani.Free;
- End;
- For i := 0 To high(fLockedInAnimations) Do Begin
- fLockedInAnimations[i].ani.Free;
- End;
- For i := 0 To high(fDieAnimations) Do Begin
- fDieAnimations[i].ani.Free;
- End;
-
- For ta In tAtomicAnimation Do Begin
- fAnimations[ta].ani.free;
- End;
- Bomb.ani.free;
- Bomb_dud.ani.free;
- Bomb_trigger.ani.free;
- Bomb_Wobble.ani.free;
- FlameCross.free;
- FlameMiddle.free;
- FlameEnd.free;
-End;
-
-Function TAtomic.GetAnimTimeInMs(Anim: TRenderAnimation; Value: uint16
- ): Integer;
-
-Var
- Ani: TOpenGL_Animation;
-Begin
- result := 0;
- ani := Nil;
- Case Anim Of
- raStandStill: ani := Nil;
- raWalk: ani := Nil;
- raKick: ani := fAnimations[aaKick].ani;
- raPunch: ani := fAnimations[aaPunch].ani;
- raPup: ani := fAnimations[aaPup].ani;
- raDie: Begin
- //ani := fDieAnimations[Value Mod length(fDieAnimations)].Ani;
- // Die Todesanimation ist ein Sonderfall, die darf nicht ablaufen, da nach der Animation der Atomic nicht mehr gerendert werden darf !
- result := AtomicDieTimeout * 2;
- End;
- raZen: ani := fZenAnimations[Value Mod length(fZenAnimations)].Ani;
- raLockedIn: ani := fLockedInAnimations[Value Mod length(fLockedInAnimations)].Ani;
- Else Begin
- Raise exception.Create('Error, missing implementation: TAtomic.GetAnimTimeInMs');
- End;
- End;
- If assigned(ani) Then Begin
- result := ani.Sprite[0].FrameCount * ani.Sprite[0].TimePerFrame;
- End;
-End;
-
-(*
- * Zumindest auf dem Windows Rechner ist das Langsammer als es durch den RAM zu schleifen ...
- *)
-{.$DEFINE useCaching}
-
-Function TAtomic.InitAsColor(path: String; aTargetColor: TRGB): Boolean;
-
- Function CreateAnimation(Filename: String; AngleOffset: Single; TimePerFrame, w, h, fpr, fpc, c: integer; Const RangeData: Array Of Integer): TOpenGL_Animation;
- Var
- B: TBitmap;
- s: TAniSprite;
- i: Integer;
- fn: String;
- Begin
- result := Nil;
- If Not FileExists(Filename) Then exit;
- fn := ExtractFileName(Filename) + ColorToString(RGBToColor(aTargetColor));
- (*
- * Alle Farbtabellen laden wir gepuffert, das ist beim 1. mal zwar langsamer, aber ab dann deutlisch schneller ;)
- *)
-{$IFDEF useCaching}
- fn := IncludeTrailingPathDelimiter(GetAppConfigDir(false)) + fn;
- If FileExists(fn) Then Begin
- b := TBitmap.Create;
- b.LoadFromFile(fn);
- End
- Else Begin
-{$ENDIF}
- b := LoadColorTabledImage(Filename, aTargetColor);
-{$IFDEF useCaching}
- If assigned(b) Then Begin
- If Not ForceDirectories(GetAppConfigDir(false)) Then exit;
- b.SaveToFile(fn);
- End
- Else Begin
- exit;
- End;
- End;
-{$ENDIF}
- result := TOpenGL_Animation.Create;
- result.AngleOffset := AngleOffset;
- For i := 0 To high(RangeData) Do Begin
- If i <> 0 Then result.AddRange(true); // Die Animation wird bereits mit einem Range erzeugt, also darf der 1. nicht generiert werden ;)
- s := Result.Sprite[i];
- If i = 0 Then Begin
- s.Bitmap := b;
- s.Derived := false;
- End
- Else Begin
- s.Bitmap := Nil;
- s.Derived := true;
- End;
- s.AlphaImage := true;
- s.AlphaMask := Nil;
- s.TimePerFrame := TimePerFrame;
- s.rect := rect(0, 0, b.Width, b.Height);
- s.Name := fn;
- s.Width := w;
- s.Height := h;
- s.FramesPerRow := fpr;
- s.FramesPerCol := fpc;
- s.FrameOffset := RangeData[i];
- s.FrameCount := c;
- Result.Sprite[i] := s;
- End;
- // Die OpenGL Daten dürfen erst erstellt werden, wenn alle Daten gültig drin sind
- For i := 0 To high(RangeData) Do Begin
- Result.CreateOpenGLData(i);
- End;
- //b.free; -- Wird vom Sprite gemacht !
- End;
-
- Function LoadDir(Dir: String; Var Animations: TAnimations): Boolean;
- Var
- sl: TStringList;
- w, h, tpf, fpc, fpr, i, c, rox, roy: integer;
- sa: TStringArray;
- Begin
- result := true;
- sl := TStringList.Create;
- sl.LoadFromFile(dir + 'files.txt');
- For i := 0 To sl.Count - 1 Do Begin
- If trim(sl[i]) = '' Then Continue;
- If pos('#', trim(sl[i])) = 1 Then Continue;
- sa := sl[i].Split(';');
- If length(sa) <> 9 Then exit(false);
- If Not FileExists(dir + sa[0]) Then Begin
- Log(format('Warning, can not load animation, file: %s does not exist', [dir + sa[0]]), llWarning);
- Continue; // Gibt es die eine Animation nicht, dann wird sie ignoriert
- End;
- tpf := strtointdef(sa[1], -1);
- If tpf = -1 Then exit(false);
- fpr := strtointdef(sa[2], -1);
- If fpr = -1 Then exit(false);
- fpc := strtointdef(sa[3], -1);
- If fpc = -1 Then exit(false);
- w := StrToIntDef(sa[4], -1);
- If w = -1 Then exit(false);
- h := StrToIntDef(sa[5], -1);
- If h = -1 Then exit(false);
- c := strtointdef(sa[6], -1);
- If c = -1 Then exit(false);
- rox := strtointdef(sa[7], 0);
- roy := strtointdef(sa[8], 0);
-
- setlength(Animations, high(Animations) + 2);
- Animations[high(Animations)].Ani := CreateAnimation(dir + sa[0], 0, tpf, w, h, fpr, fpc, c, [0]);
- Animations[high(Animations)].OffsetX := rox;
- Animations[high(Animations)].Offsety := roy;
-{$IFDEF Only1Directory}
- // Immer nur den ersten Eintrag laden, der Rest wird eingespart ;
- break;
-{$ENDIF}
- End;
- sl.free;
- If Length(Animations) = 0 Then result := false;
- End;
-
-Begin
- result := false;
- (*
- * Laden aller Texturen die ein Einzelner Spieler so haben kann
- *)
- fShadowTex := OpenGL_GraphikEngine.LoadAlphaGraphikItem(path + 'shadow.png', smClamp);
- fAnimations[aaWalk].Ani := CreateAnimation(path + 'walk.png', 45, 50, 110, 110, 15, 4, 15, [0, 15, 45, 30]);
- fAnimations[aaWalk].OffsetX := 55;
- fAnimations[aaWalk].OffsetY := 90;
- If Not assigned(fAnimations[aaWalk].Ani) Then exit;
-
- fAnimations[aaStandStill].ani := CreateAnimation(path + 'stand.png', 45, 100, 110, 110, 2, 2, 1, [0, 1, 3, 2]);
- fAnimations[aaStandStill].OffsetX := 55;
- fAnimations[aaStandStill].OffsetY := 90;
- If Not assigned(fAnimations[aaStandStill].ani) Then exit;
-
- fAnimations[aaKick].ani := CreateAnimation(path + 'kick.png', 45, 50, 50, 69, 10, 4, 10, [10, 0, 30, 20]);
- fAnimations[aaKick].OffsetX := 25;
- fAnimations[aaKick].OffsetY := 60;
- If Not assigned(fAnimations[aaKick].ani) Then exit;
-
- fAnimations[aaPunch].ani := CreateAnimation(path + 'punbomb.png', 45, 50, 110, 110, 10, 4, 10, [30, 10, 20, 0]);
- fAnimations[aaPunch].OffsetX := 55;
- fAnimations[aaPunch].OffsetY := 90;
- If Not assigned(fAnimations[aaPunch].ani) Then exit;
-
- fAnimations[aaPup].ani := CreateAnimation(path + 'pupbomb.png', 45, 50, 110, 110, 11, 4, 11, [11, 33, 0, 22]);
- fAnimations[aaPup].OffsetX := 55;
- fAnimations[aaPup].OffsetY := 90;
- If Not assigned(fAnimations[aaPup].ani) Then exit;
-
-
- Bomb.ani := CreateAnimation(path + 'bomb.png', 0, 50, 40, 37, 5, 4, 18, [0]);
- Bomb.OffsetX := -20;
- Bomb.OffsetY := -37 Div 2;
- If Not assigned(Bomb.ani) Then exit;
- Bomb_dud.ani := CreateAnimation(path + 'bomb_dud.png', 0, 750, 40, 40, 1, 2, 2, [0]);
- Bomb_dud.OffsetX := -20;
- Bomb_dud.OffsetY := -20;
- If Not assigned(Bomb_dud.ani) Then exit;
- Bomb_trigger.ani := CreateAnimation(path + 'bomb_trigger.png', 0, 50, 40, 40, 5, 4, 18, [0]);
- Bomb_trigger.OffsetX := -20;
- Bomb_trigger.OffsetY := -20;
- If Not assigned(Bomb_trigger.ani) Then exit;
- Bomb_Wobble.ani := CreateAnimation(path + 'bomb_wobble.png', 0, 75, 40, 37, 4, 3, 12, [0]);
- Bomb_Wobble.OffsetX := -20;
- Bomb_Wobble.OffsetY := -37 Div 2;
- If Not assigned(Bomb_Wobble.ani) Then exit;
- FlameCross := CreateAnimation(path + 'flame.png', 0, 50, 41, 37, 5, 9, 5, [0]);
- If Not assigned(FlameCross) Then exit;
- FlameMiddle := CreateAnimation(path + 'flame.png', 45, 50, 41, 37, 5, 9, 5, [40, 25, 35, 30]);
- If Not assigned(FlameMiddle) Then exit;
- FlameEnd := CreateAnimation(path + 'flame.png', 45, 50, 41, 37, 5, 9, 5, [20, 5, 10, 15]);
- If Not assigned(FlameEnd) Then exit;
- If Not LoadDir(Path + 'idle' + PathDelim, fZenAnimations) Then exit;
- If Not LoadDir(Path + 'locked_in' + PathDelim, fLockedInAnimations) Then exit;
- If Not LoadDir(Path + 'die' + PathDelim, fDieAnimations) Then exit;
-
- result := true;
-End;
-
-Procedure TAtomic.Render(Const Info: TAtomicInfo; Edge: Boolean);
-Const // TODO: Redundant zu uatomic_field !
- xOff = 20;
- yOff = 66;
-Var
- fAnimation: TAnimation;
- aDirection: Single;
-Begin
- aDirection := Info.Direction;
- glColor4f(1, 1, 1, 1);
- glPushMatrix;
- glAlphaFunc(GL_LESS, 0.5);
- glEnable(GL_ALPHA_TEST);
- // Anfahren der Spielerposition
- glTranslatef(info.Position.x * FieldBlockWidth + xOff, (info.Position.y + 0.25) * FieldBlockHeight + yOff, atomic_Layer);
-
- glPushMatrix;
-
- // Die Notwendige Animation
- If Info.Dying Then Begin
- // Das hier Triggert hoffentlich nur bei der ersten Steigenden Flanke
- fAnimation := fDieAnimations[Info.Value Mod length(fDieAnimations)];
- (*
- * Wenn die Animation abgelaufen ist -> Abschalten und warten bis das Spiel beendet ist.
- *)
- If info.Counter >= fAnimation.Ani.Sprite[0].TimePerFrame * fAnimation.Ani.Sprite[0].FrameCount Then Begin
- fAnimation.Ani := Nil;
- End;
- End
- Else Begin
- // Der Schatten
- RenderAlphaQuad(-fShadowTex.OrigHeight / 2, -fShadowTex.OrigWidth / 2, fShadowTex);
- // anhand der Info die Passende Animation wählen !
- Case Info.Animation Of
- raStandStill: fAnimation := fAnimations[aaStandStill];
- raWalk: fAnimation := fAnimations[aaWalk];
- raKick: fAnimation := fAnimations[aaKick];
- raPunch: fAnimation := fAnimations[aaPunch];
- raPup: fAnimation := fAnimations[aaPup];
- raDie: fAnimation := fDieAnimations[Info.Value Mod length(fDieAnimations)]; // Eigentlich müsste es diesen Fall gar nicht geben da info.Dieing ja gesetzt ist dabei ..
- raZen: fAnimation := fZenAnimations[Info.Value Mod length(fZenAnimations)];
- raLockedIn: fAnimation := fLockedInAnimations[Info.Value Mod length(fLockedInAnimations)];
- raTeleport: Begin
- // Die Idee, dass die Animation alle 50 ms um 90 Grad weiter dreht, denn dem Atomic soll schwindelig werden !
- fAnimation := fAnimations[aaWalk];
- aDirection := ((Info.Counter Mod 200) Div 50) * 90;
- Edge := True; // Der User soll immer das 1. Frame sehen, denn der Atomic steht ja wenn er sich dreht
- End;
- End;
- End;
- If assigned(fAnimation.Ani) Then Begin
- If Edge And (info.Animation <> raWalk) Then Begin
- fAnimation.Ani.ResetAnimation();
- End;
- glTranslatef(-fAnimation.OffsetX, -fAnimation.OffsetY, atomic_EPSILON);
- fAnimation.ani.Render(aDirection);
- End;
- glPopMatrix;
-
- gldisable(GL_ALPHA_TEST);
- glPopMatrix;
-
- (*
- * Zum Debuggen ein Punkt exakt da wo finfo.Position ist !
- * )
- glPushMatrix;
- glDisable(GL_DEPTH_TEST);
- glTranslatef(finfo.Position.x * FieldBlockWidth + xOff, finfo.Position.y * FieldBlockHeight + yOff, atomic_Layer);
- glPointSize(3);
- glBegin(GL_POINTS);
- glColor3f(1, 0, 0);
- glVertex2f(0, 0);
- glend();
- glPointSize(1);
- glEnable(GL_DEPTH_TEST);
- glPopMatrix;
- // Ende Debuggen *)
-End;
-
-End.
-
+(******************************************************************************)
+(* *)
+(* Author : Uwe Schächterle (Corpsman) *)
+(* *)
+(* This file is part of FPC_Atomic *)
+(* *)
+(* See the file license.md, located under: *)
+(* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *)
+(* for details about the license. *)
+(* *)
+(* It is not allowed to change or remove this text from any *)
+(* source file of the project. *)
+(* *)
+(******************************************************************************)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
+Unit uatomic;
+
+{$MODE ObjFPC}{$H+}
+
+{$I globaldefines.inc}
+
+Interface
+
+Uses
+ Classes, SysUtils, uvectormath, uatomic_common
+ , Graphics
+ , uGraphics
+ , uopengl_animation
+ , uopengl_graphikengine
+ ;
+
+Type
+
+ TGameState = (
+ gs_MainMenu, // Der Spieler ist im Hauptmenü
+ gs_Gaming // Das Spiel läuft
+ );
+
+ tAtomicAnimation = (
+ aaStandStill,
+ aaWalk,
+ aaKick, // Kicken
+ aaPunch, // Weg schlagen (Roter Handschu)
+ aaPup // Die Pupserkrankheit
+ );
+
+ TAnimation = Record
+ Ani: TOpenGL_Animation;
+ OffsetX, OffsetY: integer;
+ End;
+
+ TAnimations = Array Of TAnimation;
+
+ { TAtomic }
+
+ TAtomic = Class
+ private
+ fDieAnimations: TAnimations;
+ fLockedInAnimations: TAnimations;
+ fZenAnimations: TAnimations;
+ fAnimations: Array[tAtomicAnimation] Of TAnimation;
+ fShadowTex: TGraphikItem;
+
+ public
+ FlameEnd, FlameCross, FlameMiddle: TOpenGL_Animation;
+ Bomb: TAnimation;
+ Bomb_dud: TAnimation;
+ Bomb_trigger: TAnimation;
+ Bomb_Wobble: TAnimation;
+
+ Constructor Create(); virtual;
+ Destructor Destroy(); override;
+ Function GetAnimTimeInMs(Anim: TRenderAnimation; Value: uint16): Integer;
+ Function InitAsColor(path: String; aTargetColor: TRGB): Boolean;
+
+ Procedure Render(Const Info: TAtomicInfo; Edge: Boolean);
+ End;
+
+ TAtomics = Array[0..length(PlayerColors) - 1] Of TAtomic;
+
+Implementation
+
+Uses
+ math
+ , dglOpenGL
+ , IntfGraphics
+ , fpImage
+ ;
+
+Function LoadColorTabledImage(PNGImage: String; PlayerColor: TRGB): TBitmap;
+Var
+ png: TPortableNetworkGraphic;
+ bi: TBitmap;
+ IntfImgi, IntfImgo: TLazIntfImage;
+ i, j, k: Integer;
+ ci, co: TFPColor;
+ m, r, g, b: Integer;
+ n: integer;
+Begin
+ If Not FileExists(PNGImage) Then Begin
+ result := Nil;
+ exit;
+ End;
+ png := TPortableNetworkGraphic.Create;
+ png.LoadFromFile(PNGImage);
+ bi := TBitmap.create;
+ bi.Assign(png);
+ png.free;
+ IntfImgi := TLazIntfImage.create(0, 0);
+ IntfImgi.LoadFromBitmap(bi.Handle, Bi.MaskHandle);
+ intfimgo := TLazIntfImage.create(0, 0);
+ IntfImgo.LoadFromBitmap(bi.Handle, Bi.MaskHandle);
+ For i := 0 To bi.width - 1 Do
+ For j := 0 To bi.height - 1 Do Begin
+ ci := IntfImgi.Colors[i, j];
+ r := ci.red Shr 8;
+ g := ci.green Shr 8;
+ b := ci.blue Shr 8;
+ If (g > r) And (g > b) Then Begin
+ n := (r + b) Div 2;
+ k := (g - n);
+ r := n + (k * (PlayerColor.r)) Div 100;
+ g := n + (k * (PlayerColor.g)) Div 100;
+ b := n + (k * (PlayerColor.b)) Div 100;
+ (*
+ Tritt nur auf wenn die PlayerColor Werte > 100 haben
+ *)
+ m := max(r, max(g, b));
+ If m > 255 Then Begin
+ r := round(r * 255 / m);
+ g := round(g * 255 / m);
+ b := round(b * 255 / m);
+ End;
+ r := min(255, r);
+ g := min(255, g);
+ b := min(255, b);
+ co.red := r Shl 8;
+ co.green := g Shl 8;
+ co.blue := b Shl 8;
+ co.Alpha := 255 Shl 8;
+ IntfImgo.Colors[i, j] := co;
+ End
+ Else Begin
+ IntfImgo.Colors[i, j] := ci;
+ End;
+ End;
+ result := TBitmap.create;
+ result.LoadFromIntfImage(intfimgo);
+ IntfImgi.free;
+ IntfImgo.free;
+ bi.free;
+End;
+
+{ TAtomic }
+
+Constructor TAtomic.Create;
+Begin
+ Inherited Create();
+End;
+
+Destructor TAtomic.Destroy;
+Var
+ ta: tAtomicAnimation;
+ i: integer;
+Begin
+ For i := 0 To high(fZenAnimations) Do Begin
+ fZenAnimations[i].ani.Free;
+ End;
+ For i := 0 To high(fLockedInAnimations) Do Begin
+ fLockedInAnimations[i].ani.Free;
+ End;
+ For i := 0 To high(fDieAnimations) Do Begin
+ fDieAnimations[i].ani.Free;
+ End;
+
+ For ta In tAtomicAnimation Do Begin
+ fAnimations[ta].ani.free;
+ End;
+ Bomb.ani.free;
+ Bomb_dud.ani.free;
+ Bomb_trigger.ani.free;
+ Bomb_Wobble.ani.free;
+ FlameCross.free;
+ FlameMiddle.free;
+ FlameEnd.free;
+End;
+
+Function TAtomic.GetAnimTimeInMs(Anim: TRenderAnimation; Value: uint16
+ ): Integer;
+
+Var
+ Ani: TOpenGL_Animation;
+Begin
+ result := 0;
+ ani := Nil;
+ Case Anim Of
+ raStandStill: ani := Nil;
+ raWalk: ani := Nil;
+ raKick: ani := fAnimations[aaKick].ani;
+ raPunch: ani := fAnimations[aaPunch].ani;
+ raPup: ani := fAnimations[aaPup].ani;
+ raDie: Begin
+ //ani := fDieAnimations[Value Mod length(fDieAnimations)].Ani;
+ // Die Todesanimation ist ein Sonderfall, die darf nicht ablaufen, da nach der Animation der Atomic nicht mehr gerendert werden darf !
+ result := AtomicDieTimeout * 2;
+ End;
+ raZen: ani := fZenAnimations[Value Mod length(fZenAnimations)].Ani;
+ raLockedIn: ani := fLockedInAnimations[Value Mod length(fLockedInAnimations)].Ani;
+ Else Begin
+ Raise exception.Create('Error, missing implementation: TAtomic.GetAnimTimeInMs');
+ End;
+ End;
+ If assigned(ani) Then Begin
+ result := ani.Sprite[0].FrameCount * ani.Sprite[0].TimePerFrame;
+ End;
+End;
+
+(*
+ * Zumindest auf dem Windows Rechner ist das Langsammer als es durch den RAM zu schleifen ...
+ *)
+{.$DEFINE useCaching}
+
+Function TAtomic.InitAsColor(path: String; aTargetColor: TRGB): Boolean;
+
+ Function CreateAnimation(Filename: String; AngleOffset: Single; TimePerFrame, w, h, fpr, fpc, c: integer; Const RangeData: Array Of Integer): TOpenGL_Animation;
+ Var
+ B: TBitmap;
+ s: TAniSprite;
+ i: Integer;
+ fn: String;
+ Begin
+ result := Nil;
+ If Not FileExists(Filename) Then exit;
+ fn := ExtractFileName(Filename) + ColorToString(RGBToColor(aTargetColor));
+ (*
+ * Alle Farbtabellen laden wir gepuffert, das ist beim 1. mal zwar langsamer, aber ab dann deutlisch schneller ;)
+ *)
+{$IFDEF useCaching}
+ fn := IncludeTrailingPathDelimiter(GetAppConfigDir(false)) + fn;
+ If FileExists(fn) Then Begin
+ b := TBitmap.Create;
+ b.LoadFromFile(fn);
+ End
+ Else Begin
+{$ENDIF}
+ b := LoadColorTabledImage(Filename, aTargetColor);
+{$IFDEF useCaching}
+ If assigned(b) Then Begin
+ If Not ForceDirectories(GetAppConfigDir(false)) Then exit;
+ b.SaveToFile(fn);
+ End
+ Else Begin
+ exit;
+ End;
+ End;
+{$ENDIF}
+ result := TOpenGL_Animation.Create;
+ result.AngleOffset := AngleOffset;
+ For i := 0 To high(RangeData) Do Begin
+ If i <> 0 Then result.AddRange(true); // Die Animation wird bereits mit einem Range erzeugt, also darf der 1. nicht generiert werden ;)
+ s := Result.Sprite[i];
+ If i = 0 Then Begin
+ s.Bitmap := b;
+ s.Derived := false;
+ End
+ Else Begin
+ s.Bitmap := Nil;
+ s.Derived := true;
+ End;
+ s.AlphaImage := true;
+ s.AlphaMask := Nil;
+ s.TimePerFrame := TimePerFrame;
+ s.rect := rect(0, 0, b.Width, b.Height);
+ s.Name := fn;
+ s.Width := w;
+ s.Height := h;
+ s.FramesPerRow := fpr;
+ s.FramesPerCol := fpc;
+ s.FrameOffset := RangeData[i];
+ s.FrameCount := c;
+ Result.Sprite[i] := s;
+ End;
+ // Die OpenGL Daten dürfen erst erstellt werden, wenn alle Daten gültig drin sind
+ For i := 0 To high(RangeData) Do Begin
+ Result.CreateOpenGLData(i);
+ End;
+ //b.free; -- Wird vom Sprite gemacht !
+ End;
+
+ Function LoadDir(Dir: String; Var Animations: TAnimations): Boolean;
+ Var
+ sl: TStringList;
+ w, h, tpf, fpc, fpr, i, c, rox, roy: integer;
+ sa: TStringArray;
+ Begin
+ result := true;
+ sl := TStringList.Create;
+ sl.LoadFromFile(dir + 'files.txt');
+ For i := 0 To sl.Count - 1 Do Begin
+ If trim(sl[i]) = '' Then Continue;
+ If pos('#', trim(sl[i])) = 1 Then Continue;
+ sa := sl[i].Split(';');
+ If length(sa) <> 9 Then exit(false);
+ If Not FileExists(dir + sa[0]) Then Begin
+ Log(format('Warning, can not load animation, file: %s does not exist', [dir + sa[0]]), llWarning);
+ Continue; // Gibt es die eine Animation nicht, dann wird sie ignoriert
+ End;
+ tpf := strtointdef(sa[1], -1);
+ If tpf = -1 Then exit(false);
+ fpr := strtointdef(sa[2], -1);
+ If fpr = -1 Then exit(false);
+ fpc := strtointdef(sa[3], -1);
+ If fpc = -1 Then exit(false);
+ w := StrToIntDef(sa[4], -1);
+ If w = -1 Then exit(false);
+ h := StrToIntDef(sa[5], -1);
+ If h = -1 Then exit(false);
+ c := strtointdef(sa[6], -1);
+ If c = -1 Then exit(false);
+ rox := strtointdef(sa[7], 0);
+ roy := strtointdef(sa[8], 0);
+
+ setlength(Animations, high(Animations) + 2);
+ Animations[high(Animations)].Ani := CreateAnimation(dir + sa[0], 0, tpf, w, h, fpr, fpc, c, [0]);
+ Animations[high(Animations)].OffsetX := rox;
+ Animations[high(Animations)].Offsety := roy;
+{$IFDEF Only1Directory}
+ // Immer nur den ersten Eintrag laden, der Rest wird eingespart ;
+ break;
+{$ENDIF}
+ End;
+ sl.free;
+ If Length(Animations) = 0 Then result := false;
+ End;
+
+Begin
+ result := false;
+ (*
+ * Laden aller Texturen die ein Einzelner Spieler so haben kann
+ *)
+ fShadowTex := OpenGL_GraphikEngine.LoadAlphaGraphikItem(path + 'shadow.png', smClamp);
+ fAnimations[aaWalk].Ani := CreateAnimation(path + 'walk.png', 45, 50, 110, 110, 15, 4, 15, [0, 15, 45, 30]);
+ fAnimations[aaWalk].OffsetX := 55;
+ fAnimations[aaWalk].OffsetY := 90;
+ If Not assigned(fAnimations[aaWalk].Ani) Then exit;
+
+ fAnimations[aaStandStill].ani := CreateAnimation(path + 'stand.png', 45, 100, 110, 110, 2, 2, 1, [0, 1, 3, 2]);
+ fAnimations[aaStandStill].OffsetX := 55;
+ fAnimations[aaStandStill].OffsetY := 90;
+ If Not assigned(fAnimations[aaStandStill].ani) Then exit;
+
+ fAnimations[aaKick].ani := CreateAnimation(path + 'kick.png', 45, 50, 50, 69, 10, 4, 10, [10, 0, 30, 20]);
+ fAnimations[aaKick].OffsetX := 25;
+ fAnimations[aaKick].OffsetY := 60;
+ If Not assigned(fAnimations[aaKick].ani) Then exit;
+
+ fAnimations[aaPunch].ani := CreateAnimation(path + 'punbomb.png', 45, 50, 110, 110, 10, 4, 10, [30, 10, 20, 0]);
+ fAnimations[aaPunch].OffsetX := 55;
+ fAnimations[aaPunch].OffsetY := 90;
+ If Not assigned(fAnimations[aaPunch].ani) Then exit;
+
+ fAnimations[aaPup].ani := CreateAnimation(path + 'pupbomb.png', 45, 50, 110, 110, 11, 4, 11, [11, 33, 0, 22]);
+ fAnimations[aaPup].OffsetX := 55;
+ fAnimations[aaPup].OffsetY := 90;
+ If Not assigned(fAnimations[aaPup].ani) Then exit;
+
+
+ Bomb.ani := CreateAnimation(path + 'bomb.png', 0, 50, 40, 37, 5, 4, 18, [0]);
+ Bomb.OffsetX := -20;
+ Bomb.OffsetY := -37 Div 2;
+ If Not assigned(Bomb.ani) Then exit;
+ Bomb_dud.ani := CreateAnimation(path + 'bomb_dud.png', 0, 750, 40, 40, 1, 2, 2, [0]);
+ Bomb_dud.OffsetX := -20;
+ Bomb_dud.OffsetY := -20;
+ If Not assigned(Bomb_dud.ani) Then exit;
+ Bomb_trigger.ani := CreateAnimation(path + 'bomb_trigger.png', 0, 50, 40, 40, 5, 4, 18, [0]);
+ Bomb_trigger.OffsetX := -20;
+ Bomb_trigger.OffsetY := -20;
+ If Not assigned(Bomb_trigger.ani) Then exit;
+ Bomb_Wobble.ani := CreateAnimation(path + 'bomb_wobble.png', 0, 75, 40, 37, 4, 3, 12, [0]);
+ Bomb_Wobble.OffsetX := -20;
+ Bomb_Wobble.OffsetY := -37 Div 2;
+ If Not assigned(Bomb_Wobble.ani) Then exit;
+ // Grid is 5 columns x 9 rows, each frame is 41x37 pixels
+ // Each row is a 5-frame animation of one flame element:
+ // Row 0 (frames 0-4): FlameCross - 5-frame animation of cross pattern
+ // Row 1 (frames 5-9): FlameEnd up (vertical top end) - 5-frame animation
+ // Row 2 (frames 10-14): FlameEnd left (horizontal left end) - 5-frame animation
+ // Row 3 (frames 15-19): FlameEnd down (vertical bottom end) - 5-frame animation
+ // Row 4 (frames 20-24): FlameEnd right (horizontal right end) - 5-frame animation
+ // Row 5 (frames 25-29): FlameMiddle up (vertical middle going up) - 5-frame animation
+ // Row 6 (frames 30-34): FlameMiddle down (vertical middle going down) - 5-frame animation
+ // Row 7 (frames 35-39): FlameMiddle right (horizontal middle going right) - 5-frame animation
+ // Row 8 (frames 40-44): FlameMiddle left (horizontal middle going left) - 5-frame animation
+ // Each range corresponds to a direction: 0°=right, 90°=up, 180°=left, 270°=down
+ FlameCross := CreateAnimation(path + 'flame.png', 0, 50, 41, 37, 5, 9, 5, [0]); // Row 0: cross animation (5 frames)
+ If Not assigned(FlameCross) Then exit;
+ // FlameEnd: 4 ranges for 4 directions, each with 5-frame animation
+ // EqualizeRanges divides 360° into 4 equal parts: Range 0=0-89°, Range 1=90-179°, Range 2=180-269°, Range 3=270-359°
+ // When FlameAngle is set: 0°=right, 90°=up, 180°=left, 270°=down
+ // Frame offsets: 20=right(0°), 5=up(90°), 10=left(180°), 15=down(270°)
+ FlameEnd := CreateAnimation(path + 'flame.png', 0, 50, 41, 37, 5, 9, 5, [20, 5, 10, 15]); // right, up, left, down
+ If Not assigned(FlameEnd) Then exit;
+ // FlameMiddle: 4 ranges for 4 directions, each with 5-frame animation
+ // Frame offsets: 40=right(0°), 30=up(90°), 35=left(180°), 25=down(270°) - swapped right/left and up/down
+ FlameMiddle := CreateAnimation(path + 'flame.png', 0, 50, 41, 37, 5, 9, 5, [40, 30, 35, 25]);
+ If Not assigned(FlameEnd) Then exit;
+ If Not LoadDir(Path + 'idle' + PathDelim, fZenAnimations) Then exit;
+ If Not LoadDir(Path + 'locked_in' + PathDelim, fLockedInAnimations) Then exit;
+ If Not LoadDir(Path + 'die' + PathDelim, fDieAnimations) Then exit;
+
+ result := true;
+End;
+
+Procedure TAtomic.Render(Const Info: TAtomicInfo; Edge: Boolean);
+Const // TODO: Redundant zu uatomic_field !
+ xOff = 20;
+ yOff = 66;
+Var
+ fAnimation: TAnimation;
+ aDirection: Single;
+Begin
+ aDirection := Info.Direction;
+ glColor4f(1, 1, 1, 1);
+ glPushMatrix;
+ glAlphaFunc(GL_LESS, 0.5);
+ glEnable(GL_ALPHA_TEST);
+ // Anfahren der Spielerposition
+ glTranslatef(info.Position.x * FieldBlockWidth + xOff, (info.Position.y + 0.25) * FieldBlockHeight + yOff, atomic_Layer);
+
+ glPushMatrix;
+
+ // Die Notwendige Animation
+ If Info.Dying Then Begin
+ // Das hier Triggert hoffentlich nur bei der ersten Steigenden Flanke
+ fAnimation := fDieAnimations[Info.Value Mod length(fDieAnimations)];
+ (*
+ * Wenn die Animation abgelaufen ist -> Abschalten und warten bis das Spiel beendet ist.
+ *)
+ If info.Counter >= fAnimation.Ani.Sprite[0].TimePerFrame * fAnimation.Ani.Sprite[0].FrameCount Then Begin
+ fAnimation.Ani := Nil;
+ End;
+ End
+ Else Begin
+ // Der Schatten
+ RenderAlphaQuad(-fShadowTex.OrigHeight / 2, -fShadowTex.OrigWidth / 2, fShadowTex);
+ // anhand der Info die Passende Animation wählen !
+ Case Info.Animation Of
+ raStandStill: fAnimation := fAnimations[aaStandStill];
+ raWalk: fAnimation := fAnimations[aaWalk];
+ raKick: fAnimation := fAnimations[aaKick];
+ raPunch: fAnimation := fAnimations[aaPunch];
+ raPup: fAnimation := fAnimations[aaPup];
+ raDie: fAnimation := fDieAnimations[Info.Value Mod length(fDieAnimations)]; // Eigentlich müsste es diesen Fall gar nicht geben da info.Dieing ja gesetzt ist dabei ..
+ raZen: fAnimation := fZenAnimations[Info.Value Mod length(fZenAnimations)];
+ raLockedIn: fAnimation := fLockedInAnimations[Info.Value Mod length(fLockedInAnimations)];
+ raTeleport: Begin
+ // Die Idee, dass die Animation alle 50 ms um 90 Grad weiter dreht, denn dem Atomic soll schwindelig werden !
+ fAnimation := fAnimations[aaWalk];
+ aDirection := ((Info.Counter Mod 200) Div 50) * 90;
+ Edge := True; // Der User soll immer das 1. Frame sehen, denn der Atomic steht ja wenn er sich dreht
+ End;
+ End;
+ End;
+ If assigned(fAnimation.Ani) Then Begin
+ If Edge And (info.Animation <> raWalk) Then Begin
+ fAnimation.Ani.ResetAnimation();
+ End;
+ glTranslatef(-fAnimation.OffsetX, -fAnimation.OffsetY, atomic_EPSILON);
+ fAnimation.ani.Render(aDirection);
+ End;
+ glPopMatrix;
+
+ gldisable(GL_ALPHA_TEST);
+ glPopMatrix;
+
+ (*
+ * Zum Debuggen ein Punkt exakt da wo finfo.Position ist !
+ * )
+ glPushMatrix;
+ glDisable(GL_DEPTH_TEST);
+ glTranslatef(finfo.Position.x * FieldBlockWidth + xOff, finfo.Position.y * FieldBlockHeight + yOff, atomic_Layer);
+ glPointSize(3);
+ glBegin(GL_POINTS);
+ glColor3f(1, 0, 0);
+ glVertex2f(0, 0);
+ glend();
+ glPointSize(1);
+ glEnable(GL_DEPTH_TEST);
+ glPopMatrix;
+ // Ende Debuggen *)
+End;
+
+End.
+
diff --git a/client/uearlylog.pas b/client/uearlylog.pas
new file mode 100644
index 0000000..ff7902a
--- /dev/null
+++ b/client/uearlylog.pas
@@ -0,0 +1,66 @@
+(******************************************************************************)
+(* *)
+(* Author : Uwe Schächterle (Corpsman) *)
+(* *)
+(* This file is part of FPC_Atomic *)
+(* *)
+(* See the file license.md, located under: *)
+(* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *)
+(* for details about the license. *)
+(* *)
+(* It is not allowed to change or remove this text from any *)
+(* source file of the project. *)
+(* *)
+(******************************************************************************)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
+Unit uearlylog;
+
+{$MODE objfpc}{$H+}
+
+{$I globaldefines.inc}
+
+Interface
+
+Procedure EarlyLog(Const Msg: String);
+
+Implementation
+
+Uses SysUtils
+{$IFDEF DARWIN}
+ , LazFileUtils
+{$ENDIF}
+ ;
+
+Procedure EarlyLog(Const Msg: String);
+Var
+ LogFile: TextFile;
+ LogPath: String;
+Begin
+ Try
+{$IFDEF DARWIN}
+ LogPath := IncludeTrailingPathDelimiter(GetUserDir) + 'Library/Application Support/fpc_atomic/early_debug.log';
+ If Not DirectoryExistsUTF8(ExtractFilePath(LogPath)) Then
+ ForceDirectoriesUTF8(ExtractFilePath(LogPath));
+{$ELSE}
+ // On Windows and Linux, create log file next to executable
+ LogPath := ChangeFileExt(ParamStr(0), '_debug.log');
+{$ENDIF}
+ AssignFile(LogFile, LogPath);
+ If FileExists(LogPath) Then
+ Append(LogFile)
+ Else
+ Rewrite(LogFile);
+ WriteLn(LogFile, FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Now) + ' [EARLY] ' + Msg);
+ Flush(LogFile);
+ CloseFile(LogFile);
+ Except
+ // Ignore errors in early logging
+ End;
+End;
+
+End.
+
diff --git a/client/ugame.pas b/client/ugame.pas
index 7486d40..1247663 100644
--- a/client/ugame.pas
+++ b/client/ugame.pas
@@ -12,6 +12,11 @@
(* source file of the project. *)
(* *)
(******************************************************************************)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
Unit ugame;
{$MODE ObjFPC}{$H+}
@@ -22,7 +27,8 @@
Uses
Classes, SysUtils, controls, OpenGLContext, lNetComponents, lnet,
- uatomic_common, uopengl_animation, uscreens, uChunkmanager, uatomic_field, uatomic, uopengl_graphikengine, usounds, usdl_joystick;
+ uatomic_common, uopengl_animation, uscreens, uChunkmanager, uatomic_field, uatomic, uopengl_graphikengine, usounds, usdl_joystick, usdl_gamecontroller,
+ uloaderdialog;
Type
TUDPPingData = Record
@@ -60,11 +66,19 @@
private
fsdl_Loaded: Boolean;
fsdlJoysticks: Array[TKeySet] Of TSDL_Joystick;
+ fsdlControllers: Array[TKeySet] Of TSDL_GameControllerEx;
+ fControllerLogged: Array[TKeySet] Of Boolean; // Track if we've logged controller usage
+ fMenuDpadState: record
+ up, down, left, right, buttonA, buttonB: Boolean;
+ end; // Track previous D-pad state for menu navigation
+ fBlockGameInputUntilRelease: Boolean; // Block game input until all buttons released
+ fBlockMenuInputUntilRelease: Boolean; // Block menu input until all buttons released
fTramp, fConveyors, fArrows: TOpenGL_Animation; // Wird den Karten zur Verfügung gestellt
fHurry: THurry;
fSoundManager: TSoundManager;
fSoundInfo: TSoundInfo;
fLastIdleTick: QWord;
+ fLastUpdateTimestamp: QWord; // For network performance monitoring
fLastKeyDown: Array[akFirstAction..akSecondAction] Of QWORD;
fPlayerdeadTex: TGraphikItem;
fPowerUpsTex: TPowerTexArray;
@@ -72,6 +86,9 @@
fBombs: Array[0..15 * 11 - 1] Of TBombInfo;
fParamJoinIP: String;
fParamJoinPort: integer;
+ fWaitingForLocalServer: Boolean; // True when waiting for local server to start
+ fLastConnectionAttempt: QWord; // Timestamp of last connection attempt
+ fConnectionRetryInterval: QWord; // Interval between retry attempts (ms)
fPlayingTime_s: integer;
fPause: Boolean;
fNeedDisconnect: Boolean; // Wenn True, dann wird ein Disconnect via Idle Handler durchgeführt (das darf nach LNet nicht im Socket Event gemacht werden da es sonst eine AV-Gibt)
@@ -80,6 +97,7 @@
fAtomics: TAtomics;
fBackupSettings: TAtomicSettings; // Sind wir nicht der Master Spieler, dann müssen wir unsere Settings Sichern
fInitialized: Boolean; // True, wenn Initialize erfolgreich durchgelaufen wurde
+ fLoaderDialog: TLoaderDialog; // Reference to loading dialog during initialization
fFields: Array Of TAtomicField;
fScheme: TScheme;
{$IFNDEF DebuggMode}
@@ -99,6 +117,36 @@
fChunkManager: TChunkManager;
fUDPPingData: TUDPPingData;
+ FViewportOffsetX: Integer;
+ FViewportOffsetY: Integer;
+ FViewportWidth: Integer;
+ FViewportHeight: Integer;
+ FControlWidth: Integer;
+ FControlHeight: Integer;
+ FViewportScale: Double;
+ fDataPath: String; // Base path to data directory
+ fServerPID: Integer; // PID of locally started server process (0 if no server started)
+
+ // === CLIENT-SIDE INTERPOLATION ===
+ // Snapshots of server state
+ fServerSnapshots: Array[0..1] Of Record
+ Timestamp: QWord; // GetTickCount64 when received
+ ServerTime_ms: Integer; // fPlayingTime_s * 1000
+ PlayerInfos: Array[0..9] Of TAtomicInfo;
+ Valid: Boolean; // Is this snapshot valid?
+ End;
+ fCurrentSnapshot: Integer; // Index of current snapshot (0 or 1)
+
+ // Interpolated state (calculated each frame)
+ fInterpolatedState: Record
+ PlayingTime_ms: Integer;
+ PlayerInfos: Array[0..9] Of TAtomicInfo;
+ End;
+
+ // Interpolation parameters
+ fExtrapolationLimit: Integer; // Max extrapolation time (default 100ms)
+
+ // Note: fInterpolationDelay and fDebugStats are now in public section for debug overlay access
Procedure FOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Procedure FOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
@@ -108,16 +156,27 @@
Procedure FOnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Procedure FOnKeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState);
- Procedure CheckKeyDown(Key: Word; Keys: TKeySet);
+ Function CheckKeyDown(Key: Word; Keys: TKeySet): Boolean;
Procedure CheckKeyUp(Key: Word; Keys: TKeySet);
Procedure CheckSDLKeys();
+ Procedure ReadCurrentButtonState(var up, down, left, right, buttonA, buttonB: Boolean);
+ Function AreAllGamepadButtonsReleased(): Boolean;
+ Procedure CheckSDLKeysForMenu();
+ Procedure ReinitControllersWithLogs();
Function LoadSchemeFromFile(Const SchemeFileName: String): Boolean;
Procedure OnQuitGameSoundFinished(Sender: TObject);
+ Function ResolveResourceBase(BasePath: String): String;
Procedure RenderPlayerbyInfo(Const Info: TAtomicInfo; Edge: Boolean);
Procedure RenderFieldHeader();
Procedure RenderBombs();
+ Function PointInsideViewport(ScreenX, ScreenY: Integer): Boolean;
+ Function ScreenToGameX(ScreenX: Integer): Integer;
+ Function ScreenToGameY(ScreenY: Integer): Integer;
+
+ // Client-side interpolation
+ Procedure InterpolateGameState();
Procedure Connection_Connect(aSocket: TLSocket);
Procedure Connection_Disconnect(aSocket: TLSocket);
@@ -149,6 +208,7 @@
* Routinen die der Master Spieler Aufruft um den Rest zu Aktualisieren
*)
Function StartHost: Boolean;
+ Function GetServerIPAddress(): String; // Get local network IP address for server display
Procedure SendSettings();
Procedure UpdateFieldSetup(FieldName: String; FieldHash: Uint64; NeededWins: integer);
Procedure SwitchToPlayerSetup;
@@ -168,9 +228,27 @@
fPlayer: TPlayers;
{$ENDIF}
Settings: TAtomicSettings; // für uscreens
+
+ // Expose interpolation fields for debug overlay (must be before properties!)
+ fDebugStats: Record
+ LastRTT: Integer;
+ AvgRTT: Single;
+ MaxRTT: Integer; // Worst RTT since game start
+ InterpolationFactor: Single;
+ MaxInterpFactor: Single; // Worst interpolation factor
+ IsExtrapolating: Boolean;
+ SnapshotAge: Integer;
+ MaxSnapAge: Integer; // Worst snapshot age
+ End;
+ fInterpolationDelay: Integer;
OnNeedHideCursor: TNotifyEvent;
OnNeedShowCursor: TNotifyEvent;
+
+ Property PlayingTime_s: Integer Read fPlayingTime_s;
+ Property ChunkManager: TChunkManager Read fChunkManager; // For network thread access
+ Property LoaderDialog: TLoaderDialog Read fLoaderDialog; // For OnPaint to render loading dialog during initialization
+ Property IsInitialized: Boolean Read fInitialized; // Check if game is initialized
Constructor Create();
Destructor Destroy; override;
@@ -187,6 +265,8 @@
Procedure OnIdle; // Wird von Application.OnIdle aufgerufen
Procedure JoinViaParams(ip: String; Port: integer); // Nur 1 mal direkt nach dem Start erlaubt (siehe TForm1.OnIdle)
+ Function GetControllerCount: Integer;
+
(*
* Werden und dürfen nur aus uScreens heraus aufgerufen werden
*)
@@ -196,10 +276,14 @@
Procedure StartGame();
Procedure StartPlayingSong(Filename: String);
Procedure PlaySoundEffect(Filename: String; EndCallback: TNotifyEvent = Nil);
+ Procedure SetViewportMetrics(ControlWidth, ControlHeight, OffsetX, OffsetY,
+ ViewportWidth, ViewportHeight: Integer);
+ Function GetKeySetDisplayName(Keys: TKeySet): String;
End;
Var
Game: TGame; // Die SpielEngine
+ NeedFormClose: Boolean = false; // Set to true when user confirms exit, triggers form close after quit sound
Implementation
@@ -214,7 +298,6 @@
, sdl2
, uip
, uOpenGL_ASCII_Font
- , uloaderdialog
, uvectormath
, LCLType
, process
@@ -223,11 +306,9 @@
, uatomicfont
, uopengl_spriteengine
, ugraphics
+ , uearlylog
;
-Var
- NeedFormClose: Boolean = false;
-
(*
* Gibt den Index von Value in aArray zurück, -1 wenn nicht enthalten.
*)
@@ -309,39 +390,19 @@
Procedure TGame.SwitchToScreen(TargetScreen: TScreenEnum);
Var
- index: integer;
+ index, index2: integer;
Begin
If Not fInitialized Then exit; // So Lange wir nicht Initialisiert sind, machen wir gar nix !
log('TGame.SwitchToScreen', llTrace);
+
+ // Blocking is now done immediately when button is pressed in CheckSDLKeysForMenu
+ // Don't reset fMenuDpadState here - let the blocking mechanism handle it
// Sobald wir versuchen uns in ein Spiel ein zu loggen muss ggf. SDL initialisiert werden
- If (TargetScreen = sHost) Or (TargetScreen = sJoinNetwork) Then Begin
+ // Also initialize for main menu and options to enable gamepad navigation
+ If (TargetScreen = sHost) Or (TargetScreen = sJoinNetwork) Or
+ (TargetScreen = sMainScreen) Or (TargetScreen = sOptions) Then Begin
If assigned(OnNeedHideCursor) Then OnNeedHideCursor(Nil);
- If (Settings.Keys[ks0].UseSDL2 Or Settings.Keys[ks1].UseSDL2) Then Begin
- If (Not fsdl_Loaded) Then Begin
- fsdl_Loaded := SDL_LoadLib('');
- If fsdl_Loaded Then Begin
- fsdl_Loaded := SDL_Init(SDL_INIT_JOYSTICK) = 0;
- End;
- End;
- If assigned(fsdlJoysticks[ks0]) Then fsdlJoysticks[ks0].Free;
- If assigned(fsdlJoysticks[ks1]) Then fsdlJoysticks[ks1].Free;
- fsdlJoysticks[ks0] := Nil;
- fsdlJoysticks[ks1] := Nil;
- If fsdl_Loaded Then Begin
- If Settings.Keys[ks0].UseSDL2 Then Begin
- index := ResolveJoystickNameToIndex(Settings.Keys[ks0].Name, Settings.Keys[ks0].NameIndex);
- If index <> -1 Then Begin
- fsdlJoysticks[ks0] := TSDL_Joystick.Create(index);
- End;
- End;
- If Settings.Keys[ks1].UseSDL2 Then Begin
- index := ResolveJoystickNameToIndex(Settings.Keys[ks1].Name, Settings.Keys[ks1].NameIndex);
- If index <> -1 Then Begin
- fsdlJoysticks[ks1] := TSDL_Joystick.Create(index);
- End;
- End;
- End;
- End;
+ ReinitControllersWithLogs();
End;
(*
* Wenn es "individuell" noch was zu tun gibt ...
@@ -353,6 +414,7 @@
sMainScreen: Begin
fgameState := gs_MainMenu;
StopPingingForGames;
+ fWaitingForLocalServer := false; // Stop waiting for local server when returning to main menu
Disconnect();
HandleSetPause(false); // Sonst bleibt die Hauptmenü Animation ggf stehen, das will natürlich keiner ;)
If assigned(OnNeedShowCursor) Then OnNeedShowCursor(Nil);
@@ -360,7 +422,10 @@
sExitBomberman: Begin
NeedFormClose := true;
StartPlayingSong(''); // Disable the Background musik if playing, that speeds up the shutdown process or at least stop making noises
- PlaySoundEffect('data' + pathdelim + 'res' + PathDelim + 'quitgame.wav', @OnQuitGameSoundFinished);
+ If fDataPath = '' Then Begin
+ fDataPath := ResolveResourceBase(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))));
+ End;
+ PlaySoundEffect(fDataPath + 'res' + PathDelim + 'quitgame.wav', @OnQuitGameSoundFinished);
End;
sHost: Begin
fParamJoinIP := '';
@@ -368,10 +433,19 @@
LogLeave;
exit;
End;
+ // After starting server, automatically connect to localhost
+ // This is faster and more reliable than UDP broadcast
+ fParamJoinIP := '127.0.0.1';
+ fParamJoinPort := Settings.Port;
+ log('Server started, will connect to localhost:' + inttostr(fParamJoinPort), llInfo);
+
+ // Get and display server IP address for other players to connect
+ If Assigned(fScreens[sJoinNetwork]) Then Begin
+ TJoinMenu(fScreens[sJoinNetwork]).SetServerIP(GetServerIPAddress());
+ End;
+
TargetScreen := sJoinNetwork;
- //Als nächstes muss es einen Server zum Drauf verbinden geben
- // -> Der Server Startet und macht den UDP Auf
- // Sobald der Client den finden verbindet er direkt, PW gibt es keins !
+ // The client will automatically connect via JoinViaParams in sJoinNetwork handler
End;
sPlayerSetupRequest: Begin
SwitchToPlayerSetup;
@@ -381,6 +455,7 @@
End;
sPlayerSetup: Begin
// Den Screen mit den Aktuellsten Daten versorgen
+ ReinitControllersWithLogs(); // ensure detection fresh in setup
TPlayerSetupMenu(fScreens[sPlayerSetup]).TeamPlay := Settings.TeamPlay;
TPlayerSetupMenu(fScreens[sPlayerSetup]).LoadPlayerdata(fPlayer, fUserID);
End;
@@ -412,7 +487,7 @@
exit;
End
Else Begin
- If FileExists('data' + PathDelim + 'schemes' + PathDelim + Settings.SchemeFile) Then Begin
+ If (fDataPath <> '') And FileExistsUTF8(fDataPath + 'schemes' + PathDelim + Settings.SchemeFile) Then Begin
StartPingingForGames;
End
Else Begin
@@ -436,8 +511,42 @@
Procedure TGame.ChangePlayerKey(PlayerIndex, Direction: Integer);
Var
m: TMemoryStream;
+ numJoy: Integer;
+ currentKeySet: TKeySet;
+ skipJoy1, skipJoy2: Boolean;
+ nextKeySet: TKeySet;
Begin
log('TGame.ChangePlayerKey', llTrace);
+
+ // Check which joysticks are available
+ numJoy := 0;
+ skipJoy1 := false;
+ skipJoy2 := false;
+ try
+ If fsdl_Loaded And Assigned(SDL_NumJoysticks) Then Begin
+ numJoy := SDL_NumJoysticks();
+ // Joy 1 is available only if at least 1 joystick is detected
+ skipJoy1 := (numJoy < 1);
+ // Joy 2 is available only if at least 2 joysticks are detected
+ skipJoy2 := (numJoy < 2);
+ End
+ Else Begin
+ // SDL not loaded, skip both joysticks
+ skipJoy1 := true;
+ skipJoy2 := true;
+ End;
+ except
+ // On error, skip both joysticks
+ skipJoy1 := true;
+ skipJoy2 := true;
+ end;
+
+ // If joysticks need to be skipped, we need to send multiple change requests
+ // to skip unavailable joysticks. But this is complex and could cause issues.
+ // Instead, we'll let the server cycle through all options, and the client
+ // will handle skipping unavailable joysticks in HandleRefreshPlayerStats.
+ // This is simpler and more reliable.
+
m := TMemoryStream.Create;
m.Write(PlayerIndex, SizeOf(PlayerIndex));
m.Write(Direction, SizeOf(Direction));
@@ -469,9 +578,13 @@
Var
xx, yy: Integer;
Begin
- // Umrechnen der Echten Koords in die Screencoords
- xx := round(ConvertDimension(0, fOwner.ClientWidth, x, 0, GameWidth));
- yy := round(ConvertDimension(0, fOwner.ClientHeight, y, 0, GameHeight));
+ If Not PointInsideViewport(X, Y) Then Begin
+ If Assigned(FOnMouseDownCapture) Then
+ FOnMouseDownCapture(Sender, Button, Shift, X, Y);
+ exit;
+ End;
+ xx := ScreenToGameX(X);
+ yy := ScreenToGameY(Y);
Case fgameState Of
gs_MainMenu: Begin
If assigned(fActualScreen) Then Begin
@@ -513,6 +626,7 @@
Procedure TGame.FOnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Var
aVolume: Dword;
+ KeyProcessed: Boolean;
Begin
(*
* Der Hack zum Beenden von Atomic Bomberman im Fehlerfall ;)
@@ -522,18 +636,21 @@
SwitchToScreen(sExitBomberman);
exit;
End;
+ KeyProcessed := false;
If Not ((ssalt In Shift) And (key = VK_RETURN)) Then Begin // Sonst wird das VK_Return ggf unsinnig ausgewertet
If key = VK_ADD Then Begin
aVolume := fSoundManager.IncVolume;
settings.VolumeValue := aVolume;
fBackupSettings.VolumeValue := aVolume;
fSoundInfo.Volume := aVolume;
+ KeyProcessed := true;
End;
If key = VK_SUBTRACT Then Begin
aVolume := fSoundManager.DecVolume();
settings.VolumeValue := aVolume;
fBackupSettings.VolumeValue := aVolume;
fSoundInfo.Volume := aVolume;
+ KeyProcessed := true;
End;
If key = VK_M Then Begin // Toggle Musik an aus
Settings.PlaySounds := Not Settings.PlaySounds;
@@ -549,38 +666,70 @@
StartPlayingSong(fActualField.Sound);
End;
End;
+ KeyProcessed := true;
End;
Case fgameState Of
gs_MainMenu: Begin
If assigned(fActualScreen) Then Begin
+ // Save original key value before menu processes it
+ // Check if this is a key that menu typically processes
+ KeyProcessed := (key In [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_RETURN, VK_BACK, VK_ESCAPE]) Or
+ ((fPlayerIndex[ks0] <> -1) And (key In [Settings.Keys[ks0].KeyPrimary, Settings.Keys[ks0].KeySecondary])) Or
+ ((fPlayerIndex[ks1] <> -1) And (key In [Settings.Keys[ks1].KeyPrimary, Settings.Keys[ks1].KeySecondary]));
+ // Let menu process the key first - menu will play sounds and handle the key
+ // Menu needs Key to remain unchanged during OnKeyDown to properly process it
fActualScreen.OnKeyDown(Sender, Key, Shift);
+ // If menu set key to 0, it was definitely processed and consumed
+ If (key = 0) Then KeyProcessed := true;
+ // After menu processed the key, we need to mark it as handled to prevent system beep
+ // but we do this at the end, after menu had chance to play sounds
End;
End;
gs_Gaming: Begin
If key = VK_ESCAPE Then Begin
- SwitchToScreen(sMainScreen);
+{$IFNDEF Only3Player}
+ If ID_YES = Application.MessageBox('Do you really want to quit?', 'Question', MB_ICONQUESTION Or MB_YESNO) Then
+{$ENDIF}
+ SwitchToScreen(sMainScreen);
+ KeyProcessed := true;
End;
If key = VK_P Then Begin
SendChunk(miTogglePause, Nil);
+ KeyProcessed := true;
+ End;
+ If fPlayerIndex[ks0] <> -1 Then Begin
+ If CheckKeyDown(key, ks0) Then KeyProcessed := true;
+ End;
+ If fPlayerIndex[ks1] <> -1 Then Begin
+ If CheckKeyDown(key, ks1) Then KeyProcessed := true;
End;
- If fPlayerIndex[ks0] <> -1 Then CheckKeyDown(key, ks0);
- If fPlayerIndex[ks1] <> -1 Then CheckKeyDown(key, ks1);
End;
End;
End;
If assigned(FOnKeyDownCapture) Then Begin
FOnKeyDownCapture(sender, key, shift);
End;
+ // Mark key as handled to prevent system beep on macOS
+ // For gaming state, always set Key := 0 if processed
+ If KeyProcessed And (fgameState = gs_Gaming) Then Begin
+ Key := 0;
+ End;
+ // For menu: don't set Key := 0 to allow menu sounds to play properly
+ // Menu needs Key unchanged to process it and play sounds
+ // The menu OnKeyDown handlers should process keys and prevent system beep naturally
+ // by consuming the key events they handle
End;
-Procedure TGame.CheckKeyDown(Key: Word; Keys: TKeySet);
+Function TGame.CheckKeyDown(Key: Word; Keys: TKeySet): Boolean;
Var
m: TMemoryStream;
db, b: Boolean;
ak: TAtomicKey;
n: QWORD;
Begin
+ result := false;
If key In [Settings.Keys[Keys].KeyLeft, Settings.Keys[Keys].KeyRight, Settings.Keys[Keys].KeyUp, Settings.Keys[Keys].KeyDown, Settings.Keys[Keys].KeyPrimary, Settings.Keys[Keys].KeySecondary] Then Begin
+ result := true;
m := TMemoryStream.Create;
b := true;
db := false;
@@ -651,6 +800,8 @@
If fgameState = gs_Gaming Then Begin
If fPlayerIndex[ks0] <> -1 Then CheckKeyUp(Key, ks0);
If fPlayerIndex[ks1] <> -1 Then CheckKeyUp(key, ks1);
+ If fPlayerIndex[ksJoy1] <> -1 Then CheckKeyUp(key, ksJoy1);
+ If fPlayerIndex[ksJoy2] <> -1 Then CheckKeyUp(key, ksJoy2);
End;
If assigned(FOnKeyUpCapture) Then Begin
FOnKeyUpCapture(sender, key, shift);
@@ -661,29 +812,230 @@
Procedure CheckKeys(Keys: TKeySet);
Var
- d: Integer;
+ d, d0, d1: Integer;
up, down, left, right, first, second: Boolean;
+ wasUp, wasDown, wasLeft, wasRight: Boolean; // Previous state for hysteresis
+ diagonalThreshold: Integer; // Lower threshold when in diagonal mode
+ wasDiagonal: Boolean; // Was in diagonal mode in previous frame
+ isDiagonal: Boolean;
+ verticalStrength, horizontalStrength: Integer;
+ dominantDirection: TAtomicKey;
+ sendDominant: Boolean;
+ dpadUp, dpadDown, dpadLeft, dpadRight: Boolean; // D-Pad state
+ wasDpadUp, wasDpadDown, wasDpadLeft, wasDpadRight: Boolean; // Previous D-Pad state
+ isDpadDiagonal: Boolean; // D-Pad diagonal state
+ dpadActive: Boolean; // Whether D-Pad is currently active
Begin
+ If fPlayerIndex[keys] = AIPlayer Then exit;
+ If fPlayerIndex[keys] = -1 Then exit;
+ // Use legacy joystick mapping if configured
If Not Settings.Keys[keys].UseSDL2 Then exit;
If Not assigned(fsdlJoysticks[keys]) Then exit;
- If fPlayerIndex[keys] = AIPlayer Then exit;
+
+ // Remember previous state for hysteresis
+ wasUp := fPlayer[fPlayerIndex[keys]].KeysPressed[akUp];
+ wasDown := fPlayer[fPlayerIndex[keys]].KeysPressed[akDown];
+ wasLeft := fPlayer[fPlayerIndex[keys]].KeysPressed[akLeft];
+ wasRight := fPlayer[fPlayerIndex[keys]].KeysPressed[akRight];
+
+ // 1. Check D-Pad first (digital input, should be sent immediately like keyboard)
+ // D-Pad is processed separately from analog stick to ensure smooth diagonal movement
+ dpadUp := false;
+ dpadDown := false;
+ dpadLeft := false;
+ dpadRight := false;
+ dpadActive := false;
+
+ // Universal approach: Check both HAT and button-based D-Pad
+ // Some controllers use HAT (classic), others use buttons 11-14 (modern controllers like DualSense)
+ try
+ // First check HAT-based D-pad (classic joysticks)
+ if fsdlJoysticks[keys].HatCount > 0 then begin
+ d := fsdlJoysticks[keys].Hat[0];
+ if (d and SDL_HAT_UP) <> 0 then begin
+ dpadUp := true;
+ dpadActive := true;
+ end;
+ if (d and SDL_HAT_DOWN) <> 0 then begin
+ dpadDown := true;
+ dpadActive := true;
+ end;
+ if (d and SDL_HAT_LEFT) <> 0 then begin
+ dpadLeft := true;
+ dpadActive := true;
+ end;
+ if (d and SDL_HAT_RIGHT) <> 0 then begin
+ dpadRight := true;
+ dpadActive := true;
+ end;
+ end;
+
+ // Also check button-based D-pad (modern controllers like DualSense, some Xbox controllers)
+ // Check if controller has enough buttons and try buttons 11-14
+ // Note: We check both HAT and buttons, so if controller has both, HAT takes priority
+ if (not dpadActive) and (fsdlJoysticks[keys].ButtonCount > 14) then begin
+ // Modern controllers: D-pad as buttons 11-14
+ // Button 11 = Up, 12 = Down, 13 = Left, 14 = Right
+ if fsdlJoysticks[keys].Button[11] then begin
+ dpadUp := true;
+ dpadActive := true;
+ end;
+ if fsdlJoysticks[keys].Button[12] then begin
+ dpadDown := true;
+ dpadActive := true;
+ end;
+ if fsdlJoysticks[keys].Button[13] then begin
+ dpadLeft := true;
+ dpadActive := true;
+ end;
+ if fsdlJoysticks[keys].Button[14] then begin
+ dpadRight := true;
+ dpadActive := true;
+ end;
+ end;
+ except
+ // Ignore D-pad errors, analog stick still works
+ end;
+
+ // If D-Pad is active, send events immediately (like keyboard) and skip analog stick processing
+ // This ensures D-Pad behaves like keyboard input with smooth diagonal movement
+ if dpadActive then begin
+ // Remember previous D-Pad state
+ wasDpadUp := fPlayer[fPlayerIndex[keys]].KeysPressed[akUp];
+ wasDpadDown := fPlayer[fPlayerIndex[keys]].KeysPressed[akDown];
+ wasDpadLeft := fPlayer[fPlayerIndex[keys]].KeysPressed[akLeft];
+ wasDpadRight := fPlayer[fPlayerIndex[keys]].KeysPressed[akRight];
+
+ // Send all direction changes (like keyboard - each key is independent)
+ // This allows server to process diagonal movement when multiple directions are active
+ If wasDpadUp <> dpadUp Then Begin
+ If dpadUp Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeyUp, keys);
+ End
+ Else Begin
+ CheckKeyUp(Settings.Keys[keys].KeyUp, keys);
+ End;
+ End;
+ If wasDpadDown <> dpadDown Then Begin
+ If dpadDown Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeyDown, keys);
+ End
+ Else Begin
+ CheckKeyUp(Settings.Keys[keys].KeyDown, keys);
+ End;
+ End;
+ If wasDpadLeft <> dpadLeft Then Begin
+ If dpadLeft Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeyLeft, keys);
+ End
+ Else Begin
+ CheckKeyUp(Settings.Keys[keys].KeyLeft, keys);
+ End;
+ End;
+ If wasDpadRight <> dpadRight Then Begin
+ If dpadRight Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeyRight, keys);
+ End
+ Else Begin
+ CheckKeyUp(Settings.Keys[keys].KeyRight, keys);
+ End;
+ End;
+
+ // Enhanced: When in diagonal mode, send all active directions every frame
+ // This matches keyboard behavior where all pressed keys are sent continuously
+ // Server processes diagonal movement when multiple directions are active
+ isDpadDiagonal := ((dpadUp Or dpadDown) And (dpadLeft Or dpadRight));
+ If isDpadDiagonal Then Begin
+ // Send all active directions every frame (like keyboard - keys are held down)
+ // This ensures smooth diagonal movement like keyboard
+ If dpadUp Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeyUp, keys);
+ End;
+ If dpadDown Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeyDown, keys);
+ End;
+ If dpadLeft Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeyLeft, keys);
+ End;
+ If dpadRight Then Begin
+ // Send right last so server processes it (matching keyboard behavior)
+ CheckKeyDown(Settings.Keys[keys].KeyRight, keys);
+ End;
+ End;
+
+ // D-Pad is active, skip analog stick processing
+ // Process buttons and exit early
+ first := Settings.Keys[keys].ButtonsIdle[0] = fsdlJoysticks[keys].Button[Settings.Keys[keys].ButtonIndex[0]];
+ second := Settings.Keys[keys].ButtonsIdle[1] = fsdlJoysticks[keys].Button[Settings.Keys[keys].ButtonIndex[1]];
+
+ // Das Key Up wird bei Action nicht geprüft..
+ If (fPlayer[fPlayerIndex[keys]].KeysPressed[akFirstAction] <> first) And first Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeyPrimary, keys);
+ End;
+ // Das Key Up wird bei Action nicht geprüft..
+ If (fPlayer[fPlayerIndex[keys]].KeysPressed[akSecondAction] <> second) And Second Then Begin
+ CheckKeyDown(Settings.Keys[keys].KeySecondary, keys);
+ End;
+ // 3. Speichern für die nächste Runde ;)
+ fPlayer[fPlayerIndex[keys]].KeysPressed[akFirstAction] := first;
+ fPlayer[fPlayerIndex[keys]].KeysPressed[akSecondAction] := second;
+
+ // Exit early - D-Pad processing is complete, analog stick is skipped
+ exit;
+ end;
+
+ // D-Pad is not active, process analog stick normally (original logic unchanged)
// 1. Ermitteln des Aktuellen "Gedrückt" stati
up := false;
down := false;
left := false;
right := false;
- d := Settings.Keys[keys].AchsisIdle[0] - fsdlJoysticks[keys].Axis[Settings.Keys[keys].AchsisIndex[0]];
- If abs(d) > achsistrigger Then Begin
- If sign(d) = Settings.Keys[keys].AchsisDirection[0] Then Begin
+
+ // Calculate axis differences
+ d0 := Settings.Keys[keys].AchsisIdle[0] - fsdlJoysticks[keys].Axis[Settings.Keys[keys].AchsisIndex[0]];
+ d1 := Settings.Keys[keys].AchsisIdle[1] - fsdlJoysticks[keys].Axis[Settings.Keys[keys].AchsisIndex[1]];
+
+ // Use hysteresis for diagonal directions: if we were in diagonal mode (both axes active),
+ // use lower threshold to turn off. This prevents flickering when one axis slightly drops below threshold.
+ // Check if we were in diagonal mode in previous frame
+ diagonalThreshold := achsistrigger Div 2; // 50% of normal threshold when in diagonal
+ wasDiagonal := ((wasUp Or wasDown) And (wasLeft Or wasRight));
+
+ // Check up/down axis with hysteresis
+ If abs(d0) > achsistrigger Then Begin
+ // Normal threshold for activation
+ If sign(d0) = Settings.Keys[keys].AchsisDirection[0] Then Begin
+ up := true;
+ End
+ Else Begin
+ down := true;
+ End;
+ End
+ Else If wasDiagonal And (abs(d1) > achsistrigger) And (abs(d0) > diagonalThreshold) Then Begin
+ // If we were in diagonal mode and horizontal axis is still active,
+ // use lower threshold to keep vertical direction active
+ If sign(d0) = Settings.Keys[keys].AchsisDirection[0] Then Begin
up := true;
End
Else Begin
down := true;
End;
End;
- d := Settings.Keys[keys].AchsisIdle[1] - fsdlJoysticks[keys].Axis[Settings.Keys[keys].AchsisIndex[1]];
- If abs(d) > achsistrigger Then Begin
- If sign(d) = Settings.Keys[keys].AchsisDirection[1] Then Begin
+
+ // Check left/right axis with hysteresis
+ If abs(d1) > achsistrigger Then Begin
+ // Normal threshold for activation
+ If sign(d1) = Settings.Keys[keys].AchsisDirection[1] Then Begin
+ left := true;
+ End
+ Else Begin
+ right := true;
+ End;
+ End
+ Else If wasDiagonal And (abs(d0) > achsistrigger) And (abs(d1) > diagonalThreshold) Then Begin
+ // If we were in diagonal mode and vertical axis is still active,
+ // use lower threshold to keep horizontal direction active
+ If sign(d1) = Settings.Keys[keys].AchsisDirection[1] Then Begin
left := true;
End
Else Begin
@@ -692,7 +1044,124 @@
End;
first := Settings.Keys[keys].ButtonsIdle[0] = fsdlJoysticks[keys].Button[Settings.Keys[keys].ButtonIndex[0]];
second := Settings.Keys[keys].ButtonsIdle[1] = fsdlJoysticks[keys].Button[Settings.Keys[keys].ButtonIndex[1]];
+
// 2. Rauskriegen ob ein Event abgeleitet werden muss
+ // For diagonal directions, determine which direction should win based on axis strength
+ // This matches keyboard behavior where the last key pressed determines direction
+ // When in diagonal mode, send the stronger direction last so server processes it correctly
+
+ // Determine if we're in diagonal mode and which direction should win
+ Begin
+ isDiagonal := ((up Or down) And (left Or right));
+ verticalStrength := 0;
+ horizontalStrength := 0;
+ dominantDirection := akUp; // Default
+ sendDominant := false;
+
+ // Calculate axis strengths for diagonal mode
+ If isDiagonal Then Begin
+ If up Or down Then verticalStrength := abs(d0);
+ If left Or right Then horizontalStrength := abs(d1);
+
+ // Determine dominant direction based on axis strength
+ // If vertical is stronger, prioritize up/down; if horizontal is stronger, prioritize left/right
+ If (verticalStrength > horizontalStrength) Then Begin
+ If up Then dominantDirection := akUp
+ Else If down Then dominantDirection := akDown;
+ sendDominant := true;
+ End
+ Else If (horizontalStrength > verticalStrength) Then Begin
+ If left Then dominantDirection := akLeft
+ Else If right Then dominantDirection := akRight;
+ sendDominant := true;
+ End
+ Else Begin
+ // Equal strength - use priority order: Up > Down > Left > Right
+ If up Then dominantDirection := akUp
+ Else If down Then dominantDirection := akDown
+ Else If left Then dominantDirection := akLeft
+ Else If right Then dominantDirection := akRight;
+ sendDominant := true;
+ End;
+ End;
+
+ // Send direction changes, handling diagonal mode specially
+ If isDiagonal And sendDominant Then Begin
+ // In diagonal mode, send all active directions, but send the dominant one last
+ // This ensures server processes the correct direction
+
+ // Send non-dominant directions first (if they changed)
+ If (dominantDirection <> akUp) Then Begin
+ If fPlayer[fPlayerIndex[keys]].KeysPressed[akUp] <> up Then Begin
+ If up Then CheckKeyDown(Settings.Keys[keys].KeyUp, keys)
+ Else CheckKeyUp(Settings.Keys[keys].KeyUp, keys);
+ End;
+ End;
+ If (dominantDirection <> akDown) Then Begin
+ If fPlayer[fPlayerIndex[keys]].KeysPressed[akDown] <> down Then Begin
+ If down Then CheckKeyDown(Settings.Keys[keys].KeyDown, keys)
+ Else CheckKeyUp(Settings.Keys[keys].KeyDown, keys);
+ End;
+ End;
+ If (dominantDirection <> akLeft) Then Begin
+ If fPlayer[fPlayerIndex[keys]].KeysPressed[akLeft] <> left Then Begin
+ If left Then CheckKeyDown(Settings.Keys[keys].KeyLeft, keys)
+ Else CheckKeyUp(Settings.Keys[keys].KeyLeft, keys);
+ End;
+ End;
+ If (dominantDirection <> akRight) Then Begin
+ If fPlayer[fPlayerIndex[keys]].KeysPressed[akRight] <> right Then Begin
+ If right Then CheckKeyDown(Settings.Keys[keys].KeyRight, keys)
+ Else CheckKeyUp(Settings.Keys[keys].KeyRight, keys);
+ End;
+ End;
+
+ // Send dominant direction last so server processes it
+ Case dominantDirection Of
+ akUp: Begin
+ If fPlayer[fPlayerIndex[keys]].KeysPressed[akUp] <> up Then Begin
+ If up Then CheckKeyDown(Settings.Keys[keys].KeyUp, keys)
+ Else CheckKeyUp(Settings.Keys[keys].KeyUp, keys);
+ End
+ Else If up Then Begin
+ // Re-send to ensure server processes it (in case other direction was sent first)
+ CheckKeyDown(Settings.Keys[keys].KeyUp, keys);
+ End;
+ End;
+ akDown: Begin
+ If fPlayer[fPlayerIndex[keys]].KeysPressed[akDown] <> down Then Begin
+ If down Then CheckKeyDown(Settings.Keys[keys].KeyDown, keys)
+ Else CheckKeyUp(Settings.Keys[keys].KeyDown, keys);
+ End
+ Else If down Then Begin
+ // Re-send to ensure server processes it (in case other direction was sent first)
+ CheckKeyDown(Settings.Keys[keys].KeyDown, keys);
+ End;
+ End;
+ akLeft: Begin
+ If fPlayer[fPlayerIndex[keys]].KeysPressed[akLeft] <> left Then Begin
+ If left Then CheckKeyDown(Settings.Keys[keys].KeyLeft, keys)
+ Else CheckKeyUp(Settings.Keys[keys].KeyLeft, keys);
+ End
+ Else If left Then Begin
+ // Re-send to ensure server processes it (in case other direction was sent first)
+ CheckKeyDown(Settings.Keys[keys].KeyLeft, keys);
+ End;
+ End;
+ akRight: Begin
+ If fPlayer[fPlayerIndex[keys]].KeysPressed[akRight] <> right Then Begin
+ If right Then CheckKeyDown(Settings.Keys[keys].KeyRight, keys)
+ Else CheckKeyUp(Settings.Keys[keys].KeyRight, keys);
+ End
+ Else If right Then Begin
+ // Re-send to ensure server processes it (in case other direction was sent first)
+ CheckKeyDown(Settings.Keys[keys].KeyRight, keys);
+ End;
+ End;
+ End;
+ End
+ Else Begin
+ // Normal single-direction mode - send changes as before
If fPlayer[fPlayerIndex[keys]].KeysPressed[akUp] <> up Then Begin
If up Then Begin
CheckKeyDown(Settings.Keys[keys].KeyUp, keys);
@@ -723,6 +1192,8 @@
End
Else Begin
CheckKeyUp(Settings.Keys[keys].KeyRight, keys);
+ End;
+ End;
End;
End;
// Das Key Up wird bei Action nicht geprüft..
@@ -738,44 +1209,591 @@
fPlayer[fPlayerIndex[keys]].KeysPressed[akSecondAction] := second;
End;
-Var
- event: TSDL_Event;
Begin
If Not fsdl_Loaded Then exit;
- If Not (Settings.Keys[ks0].UseSDL2 Or Settings.Keys[ks1].UseSDL2) Then exit;
- SDL_PumpEvents();
- While SDL_PollEvent(@event) <> 0 Do Begin // TODO: Braucht man das wirklich ?
+ // If neither joystick is present and UseSDL2 not configured, nothing to do
+ // Check all possible keysets that might use SDL
+ If Not (Settings.Keys[ks0].UseSDL2 Or Settings.Keys[ks1].UseSDL2 Or
+ Settings.Keys[ksJoy1].UseSDL2 Or Settings.Keys[ksJoy2].UseSDL2) Then exit;
+
+ // If we're blocking input until buttons are released, skip input processing
+ If fBlockGameInputUntilRelease Then Begin
+ exit;
End;
+
+ // SDL_PumpEvents is now called in OnIdle before this function
CheckKeys(ks0);
CheckKeys(ks1);
+ CheckKeys(ksJoy1);
+ CheckKeys(ksJoy2);
+End;
+
+Procedure TGame.ReadCurrentButtonState(var up, down, left, right, buttonA, buttonB: Boolean);
+
+ Procedure CheckJoystick(Keys: TKeySet);
+Var
+ d: Integer;
+Begin
+ If Not Assigned(fsdlJoysticks[Keys]) Then exit;
+ try
+ // Check analog stick
+ d := fsdlJoysticks[Keys].Axis[1]; // Y axis
+ if d < -12000 then up := true;
+ if d > 12000 then down := true;
+ d := fsdlJoysticks[Keys].Axis[0]; // X axis
+ if d < -12000 then left := true;
+ if d > 12000 then right := true;
+
+ // Check D-pad buttons (DualSense style)
+ if fsdlJoysticks[Keys].ButtonCount > 14 then begin
+ if fsdlJoysticks[Keys].Button[11] then up := true;
+ if fsdlJoysticks[Keys].Button[12] then down := true;
+ if fsdlJoysticks[Keys].Button[13] then left := true;
+ if fsdlJoysticks[Keys].Button[14] then right := true;
+ end;
+ // Check HAT (classic joysticks)
+ if fsdlJoysticks[Keys].HatCount > 0 then begin
+ d := fsdlJoysticks[Keys].Hat[0];
+ if (d and SDL_HAT_UP) <> 0 then up := true;
+ if (d and SDL_HAT_DOWN) <> 0 then down := true;
+ if (d and SDL_HAT_LEFT) <> 0 then left := true;
+ if (d and SDL_HAT_RIGHT) <> 0 then right := true;
+ end;
+
+ // Buttons: X = button 0 (Enter), Circle = button 1 (Esc)
+ if fsdlJoysticks[Keys].ButtonCount > 0 then buttonA := fsdlJoysticks[Keys].Button[0];
+ if fsdlJoysticks[Keys].ButtonCount > 1 then buttonB := fsdlJoysticks[Keys].Button[1];
+ except
+ // Ignore errors
+ end;
+ End;
+
+Begin
+ up := false;
+ down := false;
+ left := false;
+ right := false;
+ buttonA := false;
+ buttonB := false;
+
+ // Check all possible joysticks - first available one wins
+ CheckJoystick(ks0);
+ CheckJoystick(ks1);
+ CheckJoystick(ksJoy1);
+ CheckJoystick(ksJoy2);
+End;
+
+Function TGame.AreAllGamepadButtonsReleased(): Boolean;
+Var
+ up, down, left, right, buttonA, buttonB: Boolean;
+Begin
+ // Read current button state
+ ReadCurrentButtonState(up, down, left, right, buttonA, buttonB);
+
+ // Return true only if ALL buttons are released
+ result := not (up or down or left or right or buttonA or buttonB);
+End;
+
+Procedure TGame.CheckSDLKeysForMenu();
+Var
+ up, down, left, right, buttonA, buttonB: Boolean;
+ d, i: Integer;
+ key: Word;
+ shift: TShiftState;
+Begin
+ // Only process in menu, not during gameplay
+ If fgameState = gs_Gaming Then exit;
+ If Not fsdl_Loaded Then exit;
+ If Not assigned(fActualScreen) Then exit;
+
+ // If we're blocking menu input until buttons are released, skip input processing
+ If fBlockMenuInputUntilRelease Then Begin
+ exit;
+ End;
+
+ // Check if any joystick is available (check all possible keysets)
+ If Not (Assigned(fsdlJoysticks[ks0]) Or Assigned(fsdlJoysticks[ks1]) Or
+ Assigned(fsdlJoysticks[ksJoy1]) Or Assigned(fsdlJoysticks[ksJoy2])) Then exit;
+
+ // Read D-pad and button state from first available controller
+ ReadCurrentButtonState(up, down, left, right, buttonA, buttonB);
+
+ shift := [];
+
+ // Generate key events on state change (press only)
+ if up and not fMenuDpadState.up then begin
+ key := VK_UP;
+ fActualScreen.OnKeyDown(nil, key, shift);
+ end;
+ if down and not fMenuDpadState.down then begin
+ key := VK_DOWN;
+ fActualScreen.OnKeyDown(nil, key, shift);
+ end;
+ if left and not fMenuDpadState.left then begin
+ key := VK_LEFT;
+ fActualScreen.OnKeyDown(nil, key, shift);
+ end;
+ if right and not fMenuDpadState.right then begin
+ key := VK_RIGHT;
+ fActualScreen.OnKeyDown(nil, key, shift);
+ end;
+ if buttonA and not fMenuDpadState.buttonA then begin
+ key := VK_RETURN;
+ // Mark button as pressed AND block menu input BEFORE calling OnKeyDown to prevent double-trigger
+ fMenuDpadState.buttonA := true;
+ fBlockMenuInputUntilRelease := true;
+ fActualScreen.OnKeyDown(nil, key, shift);
+ end;
+ if buttonB and not fMenuDpadState.buttonB then begin
+ key := VK_ESCAPE;
+ // Mark button as pressed AND block menu input BEFORE calling OnKeyDown to prevent double-trigger
+ fMenuDpadState.buttonB := true;
+ fBlockMenuInputUntilRelease := true;
+ fActualScreen.OnKeyDown(nil, key, shift);
+ end;
+
+ // Save state for next frame
+ fMenuDpadState.up := up;
+ fMenuDpadState.down := down;
+ fMenuDpadState.left := left;
+ fMenuDpadState.right := right;
+ // buttonA and buttonB are already set above if they were just pressed,
+ // otherwise update them normally
+ if not buttonA then fMenuDpadState.buttonA := false;
+ if not buttonB then fMenuDpadState.buttonB := false;
+End;
+
+Function TGame.GetControllerCount: Integer;
+begin
+ result := 0;
+ if Assigned(fsdlJoysticks[ks0]) then inc(result);
+ if Assigned(fsdlJoysticks[ks1]) then inc(result);
+ if Assigned(fsdlJoysticks[ksJoy1]) then inc(result);
+ if Assigned(fsdlJoysticks[ksJoy2]) then inc(result);
+end;
+
+Procedure TGame.ReinitControllersWithLogs();
+Var
+ index, index2: integer;
+ numJoy: Integer;
+ i: Integer;
+Begin
+ // If menu or game input is blocked, skip reinit to avoid resetting button states
+ If (fBlockMenuInputUntilRelease Or fBlockGameInputUntilRelease) And Assigned(fsdlJoysticks[ks0]) Then Begin
+ exit;
+ End;
+
+ // Always try to init SDL and detect controllers
+ If (Not fsdl_Loaded) Then Begin
+ fsdl_Loaded := SDL_LoadLib('');
+ If fsdl_Loaded Then Begin
+ // Initialize with GAMECONTROLLER (implies JOYSTICK)
+ fsdl_Loaded := SDL_Init(SDL_INIT_GAMECONTROLLER) = 0;
+ End;
+ End;
+
+ // Clean up old instances
+ If assigned(fsdlJoysticks[ks0]) Then Begin
+ fsdlJoysticks[ks0].Free;
+ fsdlJoysticks[ks0] := Nil;
+ End;
+ If assigned(fsdlJoysticks[ks1]) Then Begin
+ fsdlJoysticks[ks1].Free;
+ fsdlJoysticks[ks1] := Nil;
+ End;
+ If assigned(fsdlJoysticks[ksJoy1]) Then Begin
+ fsdlJoysticks[ksJoy1].Free;
+ fsdlJoysticks[ksJoy1] := Nil;
+ End;
+ If assigned(fsdlJoysticks[ksJoy2]) Then Begin
+ fsdlJoysticks[ksJoy2].Free;
+ fsdlJoysticks[ksJoy2] := Nil;
+ End;
+ If assigned(fsdlControllers[ks0]) Then Begin
+ fsdlControllers[ks0].Free;
+ fsdlControllers[ks0] := Nil;
+ End;
+ If assigned(fsdlControllers[ks1]) Then Begin
+ fsdlControllers[ks1].Free;
+ fsdlControllers[ks1] := Nil;
+ End;
+ If assigned(fsdlControllers[ksJoy1]) Then Begin
+ fsdlControllers[ksJoy1].Free;
+ fsdlControllers[ksJoy1] := Nil;
+ End;
+ If assigned(fsdlControllers[ksJoy2]) Then Begin
+ fsdlControllers[ksJoy2].Free;
+ fsdlControllers[ksJoy2] := Nil;
+ End;
+ // Reset logging flags
+ fControllerLogged[ks0] := false;
+ fControllerLogged[ks1] := false;
+ fControllerLogged[ksJoy1] := false;
+ fControllerLogged[ksJoy2] := false;
+
+ If fsdl_Loaded Then Begin
+ // Try to detect and configure joystick-based controls (SDL_Joystick + existing mapping)
+ try
+ numJoy := SDL_NumJoysticks();
+ except
+ numJoy := 0;
+ end;
+
+ // Auto-configure ksJoy1/ksJoy2 to use first/second joystick
+ // Note: We do NOT auto-configure ks0/ks1 anymore - they remain as keyboard inputs
+ // Users can manually select Joy 1 or Joy 2 in the player setup menu
+ // Always configure ksJoy1 and ksJoy2 so they're available for selection
+ if numJoy > 0 then begin
+ // Configure Joy 1 (ksJoy1) to use joystick 0
+ // Only set UseSDL2 if not already configured (preserve user settings)
+ if not Settings.Keys[ksJoy1].UseSDL2 then begin
+ Settings.Keys[ksJoy1].UseSDL2 := true;
+ try
+ if SDL_JoystickNameForIndex(0) <> nil then
+ Settings.Keys[ksJoy1].Name := SDL_JoystickNameForIndex(0)
+ else
+ Settings.Keys[ksJoy1].Name := '';
+ except
+ Settings.Keys[ksJoy1].Name := '';
+ end;
+ Settings.Keys[ksJoy1].NameIndex := 0;
+ Settings.Keys[ksJoy1].AchsisIndex[0] := 1;
+ Settings.Keys[ksJoy1].AchsisIdle[0] := 0;
+ Settings.Keys[ksJoy1].AchsisDirection[0] := 1;
+ Settings.Keys[ksJoy1].AchsisIndex[1] := 0;
+ Settings.Keys[ksJoy1].AchsisIdle[1] := 0;
+ Settings.Keys[ksJoy1].AchsisDirection[1] := 1;
+ Settings.Keys[ksJoy1].ButtonIndex[0] := 0;
+ Settings.Keys[ksJoy1].ButtonsIdle[0] := false;
+ Settings.Keys[ksJoy1].ButtonIndex[1] := 2;
+ Settings.Keys[ksJoy1].ButtonsIdle[1] := false;
+ end;
+ end;
+ if numJoy > 1 then begin
+ // Configure Joy 2 (ksJoy2) to use joystick 1
+ // Only set UseSDL2 if not already configured (preserve user settings)
+ if not Settings.Keys[ksJoy2].UseSDL2 then begin
+ Settings.Keys[ksJoy2].UseSDL2 := true;
+ try
+ if SDL_JoystickNameForIndex(1) <> nil then
+ Settings.Keys[ksJoy2].Name := SDL_JoystickNameForIndex(1)
+ else
+ Settings.Keys[ksJoy2].Name := '';
+ except
+ Settings.Keys[ksJoy2].Name := '';
+ end;
+ Settings.Keys[ksJoy2].NameIndex := 0;
+ Settings.Keys[ksJoy2].AchsisIndex[0] := 1;
+ Settings.Keys[ksJoy2].AchsisIdle[0] := 0;
+ Settings.Keys[ksJoy2].AchsisDirection[0] := 1;
+ Settings.Keys[ksJoy2].AchsisIndex[1] := 0;
+ Settings.Keys[ksJoy2].AchsisIdle[1] := 0;
+ Settings.Keys[ksJoy2].AchsisDirection[1] := 1;
+ Settings.Keys[ksJoy2].ButtonIndex[0] := 0;
+ Settings.Keys[ksJoy2].ButtonsIdle[0] := false;
+ Settings.Keys[ksJoy2].ButtonIndex[1] := 2;
+ Settings.Keys[ksJoy2].ButtonsIdle[1] := false;
+ end;
+ end;
+
+ // Open legacy joystick instances according to configured names
+ If Settings.Keys[ks0].UseSDL2 Then Begin
+ index := ResolveJoystickNameToIndex(Settings.Keys[ks0].Name, Settings.Keys[ks0].NameIndex);
+ If index <> -1 Then Begin
+ fsdlJoysticks[ks0] := TSDL_Joystick.Create(index);
+ End;
+ End;
+ If Settings.Keys[ks1].UseSDL2 Then Begin
+ index := ResolveJoystickNameToIndex(Settings.Keys[ks1].Name, Settings.Keys[ks1].NameIndex);
+ If index <> -1 Then Begin
+ fsdlJoysticks[ks1] := TSDL_Joystick.Create(index);
+ End;
+ End;
+ // Universal approach: Always map ksJoy1 and ksJoy2 by physical index, not by name
+ // This ensures any controller works regardless of its name
+ // ksJoy1 always maps to physical joystick index 0, ksJoy2 to index 1
+ If Settings.Keys[ksJoy1].UseSDL2 And (numJoy > 0) Then Begin
+ // Always use physical index 0 for ksJoy1, regardless of saved name
+ // This ensures universal compatibility - any controller at index 0 will work
+ try
+ fsdlJoysticks[ksJoy1] := TSDL_Joystick.Create(0);
+ except
+ On E: Exception Do Begin
+ fsdlJoysticks[ksJoy1] := Nil;
+ End;
+ end;
+ End;
+ If Settings.Keys[ksJoy2].UseSDL2 And (numJoy > 1) Then Begin
+ // Always use physical index 1 for ksJoy2, regardless of saved name
+ // This ensures universal compatibility - any controller at index 1 will work
+ try
+ fsdlJoysticks[ksJoy2] := TSDL_Joystick.Create(1);
+ except
+ On E: Exception Do Begin
+ fsdlJoysticks[ksJoy2] := Nil;
+ End;
+ end;
+ End;
+ End;
+End;
+
+Function TGame.GetKeySetDisplayName(Keys: TKeySet): String;
+begin
+ // Handle joystick-specific keysets - show just "Joy 1" or "Joy 2" without controller name
+ if keys = ksJoy1 then begin
+ exit('Joy 1');
+ end;
+ if keys = ksJoy2 then begin
+ exit('Joy 2');
+ end;
+
+ // Keyboard labels - shortened to "Key 0" and "Key 1" for consistency with "Joy 1" and "Joy 2"
+ if keys = ks0 then exit('Key 0') else exit('Key 1');
+end;
+
+Function TGame.GetServerIPAddress(): String;
+Var
+ adapters: TNetworkAdapterList;
+ i: Integer;
+Begin
+ Result := '127.0.0.1'; // Default to localhost
+ Try
+ adapters := GetLocalIPs();
+ // Find first non-localhost IP address (prefer network IP over localhost)
+ For i := 0 To High(adapters) Do Begin
+ If (adapters[i].IpAddress <> '127.0.0.1') And (adapters[i].IpAddress <> '') Then Begin
+ Result := adapters[i].IpAddress;
+ log('Server IP address: ' + Result, llInfo);
+ exit;
+ End;
+ End;
+ // If no network IP found, use localhost
+ log('No network IP found, using localhost: ' + Result, llInfo);
+ Except
+ On E: Exception Do Begin
+ log('Error getting server IP address: ' + E.Message + ', using localhost', llWarning);
+ Result := '127.0.0.1';
+ End;
+ End;
End;
Function TGame.StartHost: Boolean;
Var
serv: String;
p: TProcessUTF8;
+ basePath, clientPath: String;
+{$IFDEF DARWIN}
+ serverAppPath: String;
+ portCheck: TProcessUTF8;
+ portCheckOutput: String;
+ portCheckCount: Integer;
+ portListening: Boolean;
+{$ENDIF}
+{$IFDEF UNIX}
+{$IFNDEF DARWIN}
+ serverCmd: String;
+ terminalFound: Boolean;
+ terminalExe: String;
+{$ENDIF}
+{$ENDIF}
Begin
//Begin
log('TGame.StartHost', llTrace);
result := false;
// Starten des Atomic_servers, dann als Client verbinden
- serv := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStrUTF8(0))) + 'atomic_server';
+ clientPath := ExtractFilePath(ParamStrUTF8(0));
+ basePath := IncludeTrailingPathDelimiter(clientPath);
+{$IFDEF DARWIN}
+ // On macOS, check if we're in an .app bundle
+ // If so, look for FPCAtomicServer.app in the same directory as FPCAtomic.app
+ If Pos('.app/Contents/MacOS/', clientPath) > 0 Then Begin
+ // We're in an .app bundle (e.g., FPCAtomic.app/Contents/MacOS/)
+ // Go up to the app bundle directory (../../ from MacOS)
+ serverAppPath := ExpandFileName(IncludeTrailingPathDelimiter(clientPath) + '../../');
+ // Replace FPCAtomic.app with FPCAtomicServer.app
+ If Pos('FPCAtomic.app', serverAppPath) > 0 Then Begin
+ serverAppPath := StringReplace(serverAppPath, 'FPCAtomic.app', 'FPCAtomicServer.app', []);
+ End
+ Else Begin
+ // Fallback: try relative to MacOS directory
+ serverAppPath := ExpandFileName(IncludeTrailingPathDelimiter(clientPath) + '../../../FPCAtomicServer.app');
+ End;
+ log('Looking for server app at: ' + serverAppPath, llInfo);
+ If DirectoryExistsUTF8(serverAppPath) Then Begin
+ // Launch server directly with atomic_server binary (like run_server script does)
+ // This ensures DYLD_LIBRARY_PATH is set correctly and parameters are passed
+ serv := IncludeTrailingPathDelimiter(serverAppPath) + 'Contents/MacOS/atomic_server';
+ If FileExistsUTF8(serv) Then Begin
+ log('Launching server in terminal: ' + serv, llInfo);
+ p := TProcessUTF8.Create(Nil);
+ p.Options := [poDetached];
+ // Use osascript to open Terminal and run server command
+ p.Executable := '/usr/bin/osascript';
+ p.Parameters.Add('-e');
+ p.Parameters.Add('tell application "Terminal" to do script "cd ''' +
+ IncludeTrailingPathDelimiter(serverAppPath) + 'Contents/MacOS''' +
+ ' && export DYLD_LIBRARY_PATH=''' + IncludeTrailingPathDelimiter(serverAppPath) + 'Contents/lib:$DYLD_LIBRARY_PATH''' +
+ ' && ''' + serv + ''' -p ' + inttostr(settings.Port) +
+ ' -t 0 -l ' + IntToStr(GetLoggerLoglevel()) + '; echo \"\nServer terminated. Press any key to close this window...\"; read"');
+ p.Execute;
+ p.free;
+ result := true;
+ fServerPID := 0; // Server runs in terminal, no PID tracking needed
+ // Wait for server to start
+ Sleep(2000);
+ LogLeave;
+ exit;
+ End
+ Else Begin
+ log('Server binary not found at: ' + serv, llWarning);
+ End;
+ End
+ Else Begin
+ log('Server app not found at: ' + serverAppPath, llWarning);
+ End;
+ End;
+{$ENDIF}
+ // Fallback: look for atomic_server binary in the same directory
+ serv := basePath + 'atomic_server';
{$IFDEF Windows}
serv := serv + '.exe';
{$ENDIF}
If FileExistsUTF8(serv) Then Begin
+ log('Launching server in terminal: ' + serv, llInfo);
+{$IFDEF Windows}
+ // On Windows, use start command to open new console window
p := TProcessUTF8.Create(Nil);
- p.Options := [poNewConsole];
+ p.Options := [poDetached];
+ p.Executable := 'cmd.exe';
+ p.Parameters.Add('/c');
+ p.Parameters.Add('start');
+ p.Parameters.Add('"FPC Atomic Server"');
+ p.Parameters.Add('cmd.exe');
+ p.Parameters.Add('/k');
+ // Build the command to run server
+ p.Parameters.Add(serv + ' -p ' + inttostr(settings.Port) +
+ ' -t 0 -l ' + IntToStr(GetLoggerLoglevel()) +
+ ' -f ' + IncludeTrailingPathDelimiter(ExtractFilePath(ParamStrUTF8(0))) + 'logs' + PathDelim + 'server.log');
+ p.Execute;
+ p.free;
+ fServerPID := 0; // Server runs in terminal, no PID tracking needed
+ Sleep(2000); // Wait for server to start
+{$ELSE}
+{$IFDEF UNIX}
+{$IFNDEF DARWIN}
+ // On Linux/Unix (not macOS), try to find a terminal emulator
+ serverCmd := 'cd ''' + basePath + ''' && ''' + serv + ''' -p ' + inttostr(settings.Port) +
+ ' -t 0 -l ' + IntToStr(GetLoggerLoglevel()) +
+ ' -f ' + IncludeTrailingPathDelimiter(ExtractFilePath(ParamStrUTF8(0))) + 'logs' + PathDelim + 'server.log' +
+ '; echo ""; echo "Server terminated. Press Enter to close..."; read';
+ terminalFound := false;
+
+ // Try x-terminal-emulator first (works on most Linux systems)
+ terminalExe := FindDefaultExecutablePath('x-terminal-emulator');
+ If (terminalExe <> '') Or FileExistsUTF8('/usr/bin/x-terminal-emulator') Then Begin
+ p := TProcessUTF8.Create(Nil);
+ p.Options := [poDetached];
+ If terminalExe <> '' Then p.Executable := terminalExe Else p.Executable := '/usr/bin/x-terminal-emulator';
+ p.Parameters.Add('-e');
+ p.Parameters.Add('bash');
+ p.Parameters.Add('-c');
+ p.Parameters.Add(serverCmd);
+ p.Execute;
+ p.free;
+ terminalFound := true;
+ End
+ // Try gnome-terminal
+ Else Begin
+ terminalExe := FindDefaultExecutablePath('gnome-terminal');
+ If (terminalExe <> '') Or FileExistsUTF8('/usr/bin/gnome-terminal') Then Begin
+ p := TProcessUTF8.Create(Nil);
+ p.Options := [poDetached];
+ If terminalExe <> '' Then p.Executable := terminalExe Else p.Executable := '/usr/bin/gnome-terminal';
+ p.Parameters.Add('--');
+ p.Parameters.Add('bash');
+ p.Parameters.Add('-c');
+ p.Parameters.Add(serverCmd);
+ p.Execute;
+ p.free;
+ terminalFound := true;
+ End
+ // Try konsole (KDE)
+ Else Begin
+ terminalExe := FindDefaultExecutablePath('konsole');
+ If (terminalExe <> '') Or FileExistsUTF8('/usr/bin/konsole') Then Begin
+ p := TProcessUTF8.Create(Nil);
+ p.Options := [poDetached];
+ If terminalExe <> '' Then p.Executable := terminalExe Else p.Executable := '/usr/bin/konsole';
+ p.Parameters.Add('-e');
+ p.Parameters.Add('bash');
+ p.Parameters.Add('-c');
+ p.Parameters.Add(serverCmd);
+ p.Execute;
+ p.free;
+ terminalFound := true;
+ End
+ // Try xterm as fallback
+ Else Begin
+ terminalExe := FindDefaultExecutablePath('xterm');
+ If (terminalExe <> '') Or FileExistsUTF8('/usr/bin/xterm') Then Begin
+ p := TProcessUTF8.Create(Nil);
+ p.Options := [poDetached];
+ If terminalExe <> '' Then p.Executable := terminalExe Else p.Executable := '/usr/bin/xterm';
+ p.Parameters.Add('-e');
+ p.Parameters.Add('bash');
+ p.Parameters.Add('-c');
+ p.Parameters.Add(serverCmd);
+ p.Execute;
+ p.free;
+ terminalFound := true;
+ End;
+ End;
+ End;
+ End;
+
+ If Not terminalFound Then Begin
+ log('Warning: No terminal emulator found, starting server in background', llWarning);
+ // Fallback: start server without terminal
+ p := TProcessUTF8.Create(Nil);
+ p.Options := [poNewConsole, poNewProcessGroup];
+ p.Executable := serv;
+ p.Parameters.Add('-p');
+ p.Parameters.Add(inttostr(settings.Port));
+ p.Parameters.Add('-t');
+ p.Parameters.Add('0');
+ p.Parameters.Add('-l');
+ p.Parameters.Add(IntToStr(GetLoggerLoglevel()));
+ p.Parameters.Add('-f');
+ p.Parameters.Add(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStrUTF8(0))) + 'logs' + PathDelim + 'server.log');
+ p.Execute;
+ fServerPID := p.ProcessID;
+ p.free;
+ End
+ Else Begin
+ fServerPID := 0; // Server runs in terminal, no PID tracking needed
+ End;
+ Sleep(2000); // Wait for server to start
+{$ENDIF} // IFNDEF DARWIN
+{$ELSE} // UNIX
+ // Other platforms - fallback to background start
+ p := TProcessUTF8.Create(Nil);
+ p.Options := [poNewConsole, poNewProcessGroup];
p.Executable := serv;
p.Parameters.Add('-p');
p.Parameters.Add(inttostr(settings.Port));
+ p.Parameters.Add('-t');
+ p.Parameters.Add('0');
p.Parameters.Add('-l');
p.Parameters.Add(IntToStr(GetLoggerLoglevel()));
p.Parameters.Add('-f');
p.Parameters.Add(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStrUTF8(0))) + 'logs' + PathDelim + 'server.log');
p.Execute;
+ fServerPID := p.ProcessID;
p.free;
+ Sleep(2000);
+{$ENDIF} // UNIX
+{$ENDIF} // Windows
End
Else Begin
LogShow('Error: could not find server application, abort now', llError);
@@ -783,10 +1801,46 @@
exit;
End;
// Bis der Server Steht dauerts ein bischen, also warten wir
+ // On macOS, .app bundles take longer to start, especially with network thread initialization
+ // Also need time for the server to initialize and start listening on the port
{$IFDEF Windows}
- sleep(1500); // Unter Windows scheint es deutlich "länger" zu dauern, wie lange genau wäre gut zu wissen ..
+ sleep(3000); // Unter Windows scheint es deutlich "länger" zu dauern
+{$ELSE}
+{$IFDEF DARWIN}
+ // Wait for server to start and check if port is listening
+ sleep(3000); // Initial wait for .app bundle to start (increased from 2000ms)
+ // Check if server is actually listening on the port (up to 10 seconds)
+ portListening := false;
+ portCheckCount := 0;
+ While (portCheckCount < 20) And (Not portListening) Do Begin
+ sleep(500); // Check every 500ms
+ Inc(portCheckCount);
+
+ // Use lsof to check if port is listening
+ portCheck := TProcessUTF8.Create(Nil);
+ portCheck.Options := [poUsePipes, poWaitOnExit];
+ portCheck.Executable := '/usr/sbin/lsof';
+ portCheck.Parameters.Add('-i');
+ portCheck.Parameters.Add(':' + inttostr(settings.Port));
+ portCheck.Execute;
+
+ SetLength(portCheckOutput, 1024);
+ SetLength(portCheckOutput, portCheck.Output.Read(portCheckOutput[1], Length(portCheckOutput)));
+ portCheck.Free;
+
+ // If lsof found something, port is listening
+ If Length(portCheckOutput) > 0 Then Begin
+ portListening := true;
+ log('Server is listening on port ' + inttostr(settings.Port), llInfo);
+ End;
+ End;
+
+ If Not portListening Then Begin
+ log('Warning: Server port not detected after ' + inttostr(portCheckCount * 500) + 'ms, will try to connect anyway', llWarning);
+ End;
{$ELSE}
- sleep(500);
+ sleep(3000); // For other Unix-like systems
+{$ENDIF}
{$ENDIF}
// StartClientGame; --> Das Verbinden macht der SwitchToScreen schon ;)
Application.Restore;
@@ -874,6 +1928,10 @@
Begin
// Der Client ist beim Server Registriert, nun gilt es um die Mitspielerlaubniss zu fragen.
log('TGame.Connection_Connect', llTrace);
+
+ // Stop waiting for local server - we're connected now
+ fWaitingForLocalServer := false;
+
fChunkManager.SetNoDelay(true);
m := TMemoryStream.Create;
m.Write(ProtocollVersion, sizeof(ProtocollVersion));
@@ -911,6 +1969,16 @@
Procedure TGame.Connection_Error(Const msg: String; aSocket: TLSocket);
Begin
log('TGame.Connection_Error', llTrace);
+
+ // If we're waiting for local server, don't show error and don't switch to main menu
+ // OnIdle will retry the connection periodically
+ If fWaitingForLocalServer Then Begin
+ log('Connection error while waiting for local server: ' + msg + ' - will retry', llInfo);
+ LogLeave;
+ exit;
+ End;
+
+ // For remote servers or if we're not waiting, show error and go back to main menu
LogShow(msg, llError);
SwitchToScreen(sMainScreen); // Wir Fliegen raus auf die Top ebene
LogLeave;
@@ -987,12 +2055,6 @@
m: TMemoryStream;
b: Boolean;
Begin
-{$IFDEF DoNotLog_CyclicMessages}
- If ((Chunk.UserDefinedID And $FFFF) <> miUpdateGameData) And
- ((Chunk.UserDefinedID And $FFFF) <> miHeartBeat) And
- ((Chunk.UserDefinedID And $FFFF) <> miClientKeyEvent) Then
-{$ENDIF}
- log('TGame.OnReceivedChunk : ' + MessageIdentifierToString(Chunk.UserDefinedID), llTrace);
Case (Chunk.UserDefinedID And $FFFF) Of
miUpdateMasterID: Begin
HandleUpdateMasterId(Chunk.Data);
@@ -1105,12 +2167,6 @@
log('Unknown user defined id : ' + inttostr((Chunk.UserDefinedID And $FFFF)), llError);
End;
End;
-{$IFDEF DoNotLog_CyclicMessages}
- If ((Chunk.UserDefinedID And $FFFF) <> miUpdateGameData) And
- ((Chunk.UserDefinedID And $FFFF) <> miHeartBeat) And
- ((Chunk.UserDefinedID And $FFFF) <> miClientKeyEvent) Then
-{$ENDIF}
- LogLeave;
End;
Procedure TGame.SendChunk(UserDefinedID: Integer; Const Data: TStream);
@@ -1130,7 +2186,7 @@
Procedure TGame.HandleRefreshPlayerStats(Const Stream: TMemoryStream);
Var
- cnt, i, uid, j: integer;
+ cnt, i, uid, j, index, numJoy: integer;
found: Boolean;
k: TKeySet;
Begin
@@ -1153,6 +2209,119 @@
fPlayer[i].UID := uid;
k := ks0;
stream.Read(k, sizeof(k));
+
+ // Check if selected joystick is available, if not, skip to next available option
+ numJoy := 0;
+ try
+ If fsdl_Loaded And Assigned(SDL_NumJoysticks) Then Begin
+ numJoy := SDL_NumJoysticks();
+ End;
+ except
+ numJoy := 0;
+ end;
+
+ // If server set Joy 1 but no joysticks are available, skip to next option
+ If (k = ksJoy1) And (numJoy < 1) Then Begin
+ // Skip to next option by sending another change request
+ If (uid = fUserID) And (fPlayer[i].UID = uid) Then Begin
+ // This is our player, send change request to skip unavailable joystick
+ ChangePlayerKey(i, 1);
+ // Don't process this update, wait for next refresh
+ LogLeave;
+ exit;
+ End
+ Else Begin
+ // Not our player, just set to Keyboard 1 as fallback
+ k := ks1;
+ End;
+ End
+ // If server set Joy 2 but only 0-1 joysticks are available, skip to next option
+ Else If (k = ksJoy2) And (numJoy < 2) Then Begin
+ // Skip to next option by sending another change request
+ If (uid = fUserID) And (fPlayer[i].UID = uid) Then Begin
+ // This is our player, send change request to skip unavailable joystick
+ ChangePlayerKey(i, 1);
+ // Don't process this update, wait for next refresh
+ LogLeave;
+ exit;
+ End
+ Else Begin
+ // Not our player, just set to Keyboard 1 as fallback
+ k := ks1;
+ End;
+ End;
+
+ // Reset UseSDL2 based on selected input type
+ // If player selected keyboard (ks0 or ks1), disable SDL2 and close joystick
+ // If player selected joystick (ksJoy1 or ksJoy2), enable SDL2
+ If (k = ks0) Or (k = ks1) Then Begin
+ // Keyboard input selected - disable SDL2 and close joystick
+ If Settings.Keys[k].UseSDL2 Then Begin
+ Settings.Keys[k].UseSDL2 := false;
+ // Close joystick if open
+ If assigned(fsdlJoysticks[k]) Then Begin
+ fsdlJoysticks[k].Free;
+ fsdlJoysticks[k] := Nil;
+ End;
+ If assigned(fsdlControllers[k]) Then Begin
+ fsdlControllers[k].Free;
+ fsdlControllers[k] := Nil;
+ End;
+ End;
+ End Else If (k = ksJoy1) Or (k = ksJoy2) Then Begin
+ // Joystick input selected - ensure SDL2 is enabled
+ If Not Settings.Keys[k].UseSDL2 Then Begin
+ Settings.Keys[k].UseSDL2 := true;
+ // Open joystick if not already open
+ // Universal approach: Always map by physical index, not by name
+ // ksJoy1 always maps to physical joystick index 0, ksJoy2 to index 1
+ If Not assigned(fsdlJoysticks[k]) And fsdl_Loaded Then Begin
+ If (k = ksJoy1) And (numJoy > 0) Then Begin
+ // Always use physical index 0 for ksJoy1
+ try
+ fsdlJoysticks[k] := TSDL_Joystick.Create(0);
+ except
+ On E: Exception Do Begin
+ fsdlJoysticks[k] := Nil;
+ End;
+ end;
+ End Else If (k = ksJoy2) And (numJoy > 1) Then Begin
+ // Always use physical index 1 for ksJoy2
+ try
+ fsdlJoysticks[k] := TSDL_Joystick.Create(1);
+ except
+ On E: Exception Do Begin
+ fsdlJoysticks[k] := Nil;
+ End;
+ end;
+ End;
+ End;
+ End Else Begin
+ // SDL2 already enabled, but make sure joystick is open
+ // Universal approach: Always map by physical index, not by name
+ If Not assigned(fsdlJoysticks[k]) And fsdl_Loaded Then Begin
+ If (k = ksJoy1) And (numJoy > 0) Then Begin
+ // Always use physical index 0 for ksJoy1
+ try
+ fsdlJoysticks[k] := TSDL_Joystick.Create(0);
+ except
+ On E: Exception Do Begin
+ fsdlJoysticks[k] := Nil;
+ End;
+ end;
+ End Else If (k = ksJoy2) And (numJoy > 1) Then Begin
+ // Always use physical index 1 for ksJoy2
+ try
+ fsdlJoysticks[k] := TSDL_Joystick.Create(1);
+ except
+ On E: Exception Do Begin
+ fsdlJoysticks[k] := Nil;
+ End;
+ end;
+ End;
+ End;
+ End;
+ End;
fPlayer[i].Keyboard := k;
j := -1;
stream.Read(j, SizeOf(j));
@@ -1221,6 +2390,7 @@
i: Integer;
ahash: uint64;
s: String;
+ found: Boolean;
Begin
log('TGame.HandleUpdateAvailableFieldList', llTrace);
For i := 0 To high(fFields) Do Begin
@@ -1231,13 +2401,29 @@
s := stream.ReadAnsiString;
ahash := 0;
stream.Read(ahash, sizeof(ahash));
+ found := false;
+ // First try exact match (name and hash)
For i := 0 To high(fFields) Do Begin
- If (fFields[i].Name = s) And
+ If (CompareText(fFields[i].Name, s) = 0) And
(fFields[i].Hash = ahash) Then Begin
fFields[i].Available := true;
+ found := true;
break;
End;
End;
+ // If exact match not found, try name-only match (for cross-platform compatibility)
+ If Not found Then Begin
+ For i := 0 To high(fFields) Do Begin
+ If CompareText(fFields[i].Name, s) = 0 Then Begin
+ // Name matches but hash differs - accept for cross-platform compatibility
+ // Log warning for debugging (commented out - too noisy in production)
+ // log(format('Field "%s": accepting despite hash mismatch (Server hash: %d, Local hash: %d)',
+ // [s, ahash, fFields[i].Hash]), llWarning);
+ fFields[i].Available := true;
+ break;
+ End;
+ End;
+ End;
End;
// Prüfen ob wir wenigstens noch eine Verfügbare Karte haben
For i := 0 To high(fFields) - 1 Do Begin // Das Letzte Field ist das Random Field, das zählt nicht
@@ -1264,8 +2450,9 @@
fActualField := Nil;
stream.Read(FieldHash, SizeOf(FieldHash));
stream.Read(Wins, SizeOf(Wins));
+ // First try exact match (name and hash)
For i := 0 To high(fFields) Do Begin
- If (fFields[i].Name = FieldName)
+ If (CompareText(fFields[i].Name, FieldName) = 0)
And (fFields[i].Hash = FieldHash) Then Begin
fActualField := fFields[i];
TFieldSetupMenu(fScreens[sEditFieldSetup]).ActualField := fActualField;
@@ -1275,6 +2462,21 @@
exit;
End;
End;
+ // If exact match not found, try name-only match (for cross-platform compatibility)
+ // This handles cases where Windows and Mac have different file versions but same field name
+ For i := 0 To high(fFields) Do Begin
+ If CompareText(fFields[i].Name, FieldName) = 0 Then Begin
+ // Name matches but hash differs - accept for cross-platform compatibility
+ log(format('Field name match but hash mismatch (using local field): Server "%s" (hash: %d) vs Local "%s" (hash: %d)',
+ [FieldName, FieldHash, fFields[i].Name, fFields[i].Hash]), llWarning);
+ fActualField := fFields[i];
+ TFieldSetupMenu(fScreens[sEditFieldSetup]).ActualField := fActualField;
+ TFieldSetupMenu(fScreens[sEditFieldSetup]).LastWinsToWinMatch := wins;
+ Settings.LastWinsToWinMatch := wins;
+ LogLeave;
+ exit;
+ End;
+ End;
// Der Spieler fliegt raus, er kann offensichtlich nicht mit spielen
// Eigentlich darf dieser Code hier aber nie kommen, weil der Master
// Nicht weiterschalten kann wenn nicht alle Spieler die Karten haben ..
@@ -1320,6 +2522,8 @@
fHurry.Enabled := false;
fPlayerIndex[ks0] := -1;
fPlayerIndex[ks1] := -1;
+ fPlayerIndex[ksJoy1] := -1;
+ fPlayerIndex[ksJoy2] := -1;
For i := 0 To high(fPlayer) Do Begin
(*
* Löschen der ggf. vorherigen Die Animation, sonst beginnt der Spieler das Spiel erst mal sterbend...
@@ -1336,11 +2540,35 @@
End;
fLastKeyDown[akFirstAction] := 0;
fLastKeyDown[akSecondAction] := 0;
+ // Transfer menu blocking to game blocking if menu input was blocked (button still pressed)
+ // Otherwise set game blocking anyway to be safe
+ If fBlockMenuInputUntilRelease Then Begin
+ // Button was pressed in menu and is still blocked - transfer to game blocking
+ fBlockGameInputUntilRelease := true;
+ fBlockMenuInputUntilRelease := false;
+ End Else Begin
+ // Set game blocking anyway to prevent any stray presses
+ fBlockGameInputUntilRelease := true;
+ End;
fActualField.Reset;
// TODO: What ever da noch alles so fehlt
StartPlayingSong(fActualField.Sound);
HandleSetPause(false); // Pause auf jeden Fall, aus
fPlayingTime_s := 0;
+
+ // Reset interpolation snapshots when game starts
+ fServerSnapshots[0].Valid := False;
+ fServerSnapshots[0].Timestamp := 0;
+ fServerSnapshots[1].Valid := False;
+ fServerSnapshots[1].Timestamp := 0;
+ fCurrentSnapshot := 0;
+ fInterpolatedState.PlayingTime_ms := 0;
+
+ // Reset MAX stats for new game
+ fDebugStats.MaxRTT := 0;
+ fDebugStats.MaxSnapAge := 0;
+ fDebugStats.MaxInterpFactor := 0;
+
fgameState := gs_Gaming;
End;
@@ -1354,33 +2582,80 @@
i: Integer;
OldValue: UInt16; // Bei Die, Zen, Locked in braucht es ebenfalls den Index
OldAnim: TRenderAnimation;
+ CurrentTime, TimeSinceLastUpdate: QWord;
+ PacketSize: Int64;
Begin
- stream.Read(fPlayingTime_s, sizeof(fPlayingTime_s));
+ CurrentTime := GetTickCount64;
+ PacketSize := Stream.Size;
+
+ // Measure time since last update (for debug stats only, no logging)
+ If fLastUpdateTimestamp > 0 Then Begin
+ TimeSinceLastUpdate := CurrentTime - fLastUpdateTimestamp;
+ // Removed logging - was slowing down client on older machines
+ End;
+ // Calculate RTT for debug stats
+ If fLastUpdateTimestamp > 0 Then Begin
+ fDebugStats.LastRTT := CurrentTime - fLastUpdateTimestamp;
+ If fDebugStats.AvgRTT = 0 Then
+ fDebugStats.AvgRTT := fDebugStats.LastRTT
+ Else
+ fDebugStats.AvgRTT := fDebugStats.AvgRTT * 0.9 + fDebugStats.LastRTT * 0.1; // Running average
+ // Track MAX RTT
+ If fDebugStats.LastRTT > fDebugStats.MaxRTT Then
+ fDebugStats.MaxRTT := fDebugStats.LastRTT;
+ End;
+ fLastUpdateTimestamp := CurrentTime;
+
+ // === NEW: Store data in snapshot instead of directly in fPlayingTime_s ===
+ // Switch to next snapshot buffer
+ fCurrentSnapshot := 1 - fCurrentSnapshot;
+
+ // Read server data into NEW snapshot
+ stream.Read(fPlayingTime_s, sizeof(fPlayingTime_s)); // Read temporarily
+ fServerSnapshots[fCurrentSnapshot].ServerTime_ms := fPlayingTime_s * 1000; // Convert to ms
+ fServerSnapshots[fCurrentSnapshot].Timestamp := CurrentTime;
+ fServerSnapshots[fCurrentSnapshot].Valid := True;
+
+ // Read player positions into snapshot
For i := 0 To high(fPlayer) Do Begin
OldValue := fPlayer[i].Info.Value;
OldAnim := fPlayer[i].Info.Animation;
- Stream.Read(fPlayer[i].Info, sizeof(fPlayer[i].Info));
+ Stream.Read(fServerSnapshots[fCurrentSnapshot].PlayerInfos[i], sizeof(TAtomicInfo));
+
+ // === IMPORTANT: Only copy NON-POSITION data to fPlayer for Edge detection ===
+ // DO NOT copy Position - that's handled by interpolation!
+ fPlayer[i].Info.Animation := fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Animation;
+ fPlayer[i].Info.Alive := fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Alive;
+ fPlayer[i].Info.Dying := fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Dying;
+ fPlayer[i].Info.Direction := fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Direction;
+ fPlayer[i].Info.Counter := fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Counter;
+ fPlayer[i].Info.Value := fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Value;
+ fPlayer[i].Info.ColorIndex := fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].ColorIndex;
+ // Position is NOT copied here - it's interpolated in InterpolateGameState()!
+
(*
* Der Server sendet die OneTimeAnimations genau 1 mal
* Wenn der Server aber schneller neu Sendet als der CLient Rendert
* dann würde der Client diese Flanke beim Rendern gar nicht berücksichtigen
* -> Hier ein Or und im Rendern dann das False !
*)
- fPlayer[i].Edge := (fPlayer[i].Info.Animation In OneTimeAnimations) And (OldAnim <> fPlayer[i].Info.Animation);
+ fPlayer[i].Edge := (fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Animation In OneTimeAnimations) And
+ (OldAnim <> fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Animation);
(*
* Wenn eine neue Animation kommt, stellen wir hier Sicher, dass die neue die alte
* überschreiben kann z.B. "Zen" -> Die
* Die Zen Animation, kann zusätzlich aber auch vom Laufen unterbrochen werden, da
* diese ja nur kommt wenn der Spieler AtomicZenTime lang keine Eingaben gemacht hat.
*)
- If (fPlayer[i].Edge) Or (((OldAnim = raZen) Or (oldAnim = raLockedIn)) And (fPlayer[i].Info.Animation = raWalk)) Then Begin
+ If (fPlayer[i].Edge) Or (((OldAnim = raZen) Or (oldAnim = raLockedIn)) And
+ (fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Animation = raWalk)) Then Begin
OldAnim := raStandStill; // -- Egal es soll ja nur die OldAnim In OneTimeAnimations verhindert werden
End;
(*
* Wenn die Alte Animation eine einmal ablaufen Animation ist.
*)
If OldAnim In OneTimeAnimations Then Begin
- If fPlayer[i].Info.Counter < fAtomics[0].GetAnimTimeInMs(OldAnim, OldValue) Then Begin
+ If fServerSnapshots[fCurrentSnapshot].PlayerInfos[i].Counter < fAtomics[0].GetAnimTimeInMs(OldAnim, OldValue) Then Begin
fPlayer[i].Info.Animation := OldAnim;
fPlayer[i].Info.Value := OldValue;
End;
@@ -1414,6 +2689,8 @@
For ak In TAtomicKey Do Begin
If fPlayerIndex[ks0] <> -1 Then fPlayer[fPlayerIndex[ks0]].KeysPressed[ak] := false;
If fPlayerIndex[ks1] <> -1 Then fPlayer[fPlayerIndex[ks1]].KeysPressed[ak] := false;
+ If fPlayerIndex[ksJoy1] <> -1 Then fPlayer[fPlayerIndex[ksJoy1]].KeysPressed[ak] := false;
+ If fPlayerIndex[ksJoy2] <> -1 Then fPlayer[fPlayerIndex[ksJoy2]].KeysPressed[ak] := false;
End;
End;
End;
@@ -1443,35 +2720,51 @@
Procedure TGame.HandlePlaySoundEffekt(Const Stream: TMemoryStream);
Var
se: TSoundEffect;
- s: String;
+ s, soundFile: String;
Begin
se := seNone;
stream.Read(se, SizeOf(TSoundEffect));
- s := '';
+ soundFile := '';
Case se Of
seNone: Begin // Nix
End;
- seBombDrop: s := SelectRandomSound(BombDrops);
- seBombKick: s := SelectRandomSound(BombKick);
- seBombStop: s := SelectRandomSound(BombStop);
- seBombJelly: s := SelectRandomSound(BombJelly);
- seBombBounce: s := SelectRandomSound(BombBounce);
- seBombGrab: s := SelectRandomSound(BombGrab);
- seBombPunch: s := SelectRandomSound(BombPunch);
- seBombExplode: s := SelectRandomSound(BombExplode);
- seAtomicDie: s := SelectRandomSound(AtomicDie);
- seWinner: s := SelectRandomSound(Winner);
- seGetGoodPowerUp: s := SelectRandomSound(GetGoodPowerUp);
- seGetBadPowerUp: s := SelectRandomSound(GetBadPowerUp);
- seZen: s := SelectRandomSound(AtomicZen);
- seOtherPlayerDied: s := SelectRandomSound(OtherPlayerDie);
- seHurryBrick: s := SelectRandomSound(HurryBrick);
- seHurry: s := SelectRandomSound(Hurry);
- seWrapHohle: s := SelectRandomSound(AtomicWrapHole);
- seTrampoline: s := SelectRandomSound(AtomicJump);
- End;
- If s <> '' Then s := 'data' + PathDelim + 'sounds' + PathDelim + s;
- PlaySoundEffect(s);
+ seBombDrop: soundFile := SelectRandomSound(BombDrops);
+ seBombKick: soundFile := SelectRandomSound(BombKick);
+ seBombStop: soundFile := SelectRandomSound(BombStop);
+ seBombJelly: soundFile := SelectRandomSound(BombJelly);
+ seBombBounce: soundFile := SelectRandomSound(BombBounce);
+ seBombGrab: soundFile := SelectRandomSound(BombGrab);
+ seBombPunch: soundFile := SelectRandomSound(BombPunch);
+ seBombExplode: soundFile := SelectRandomSound(BombExplode);
+ seAtomicDie: soundFile := SelectRandomSound(AtomicDie);
+ seWinner: soundFile := SelectRandomSound(Winner);
+ seGetGoodPowerUp: soundFile := SelectRandomSound(GetGoodPowerUp);
+ seGetBadPowerUp: soundFile := SelectRandomSound(GetBadPowerUp);
+ seZen: soundFile := SelectRandomSound(AtomicZen);
+ seOtherPlayerDied: soundFile := SelectRandomSound(OtherPlayerDie);
+ seHurryBrick: soundFile := SelectRandomSound(HurryBrick);
+ seHurry: soundFile := SelectRandomSound(Hurry);
+ seWrapHohle: soundFile := SelectRandomSound(AtomicWrapHole);
+ seTrampoline: soundFile := SelectRandomSound(AtomicJump);
+ End;
+ If soundFile <> '' Then Begin
+ If fDataPath = '' Then Begin
+ fDataPath := ResolveResourceBase(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))));
+ log('fDataPath was empty, resolved to: ' + fDataPath, llInfo);
+ End;
+ s := fDataPath + 'sounds' + PathDelim + soundFile;
+ If Not FileExistsUTF8(s) Then Begin
+ log('Sound effect file not found: ' + s + ', trying to re-resolve data path', llWarning);
+ // Try to re-resolve data path
+ fDataPath := ResolveResourceBase(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))));
+ s := fDataPath + 'sounds' + PathDelim + soundFile;
+ log('Retrying with resolved path: ' + s, llInfo);
+ If Not FileExistsUTF8(s) Then Begin
+ log('Sound effect file still not found: ' + s, llError);
+ End;
+ End;
+ PlaySoundEffect(s);
+ End;
End;
Procedure TGame.HandleUpdateMasterId(Const Stream: TMemoryStream);
@@ -1663,7 +2956,10 @@
Begin
log('TGame.LoadScheme: ' + SchemeFileName, llTrace);
result := false;
- fn := 'data' + PathDelim + 'schemes' + PathDelim + SchemeFileName;
+ If fDataPath = '' Then Begin
+ fDataPath := ResolveResourceBase(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))));
+ End;
+ fn := fDataPath + 'schemes' + PathDelim + SchemeFileName;
If Not FileExistsUTF8(fn) Then Begin
logshow('Error, could not find scheme file:' + SchemeFileName, llCritical);
LogLeave;
@@ -1752,9 +3048,10 @@
AtomicFont.BackColor := clBlack; // Auf Jeden Fall die BackColor wieder Resetten
(*
* Die Verbleibende Spielzeit
+ * === CHANGED: Use interpolated time instead of raw server time ===
*)
glColor3f(1, 1, 1);
- AtomicBigFont.Textout(500, 10, fPlayingTime_s);
+ AtomicBigFont.Textout(500, 10, fInterpolatedState.PlayingTime_ms div 1000);
glPopMatrix;
End;
@@ -1865,18 +3162,49 @@
End;
Procedure TGame.Join(IP: String; Port: Integer);
+Var
+ isLocalhost: Boolean;
Begin
log('TGame.Join', lltrace);
log(format('Joining to %s on port %d as %s', [ip, port, Settings.NodeName]));
- (*
- * Sollte aus welchem Grund auch immer der Chunkmanager nicht verbinden können (ggf weil er schon verbunden ist),
- * fliegt er hier über den Wechsel in den MainScreen raus und wird dann automatisch disconnected
- * -> Spätestens wenn der User es nun erneut versucht kommt er wieder rein.
- *)
+
+ // Store connection parameters for retry logic
+ fParamJoinIP := ip;
+ fParamJoinPort := port;
+
+ // Check if connecting to localhost
+ isLocalhost := (ip = '127.0.0.1') Or (ip = 'localhost');
+
+ If isLocalhost Then Begin
+ // For localhost, enable waiting mode - will retry periodically in OnIdle
+ // This is needed because localhost "connection refused" comes back immediately
+ // while remote servers may take time to respond (allowing time for server to start)
+ fWaitingForLocalServer := true;
+ fLastConnectionAttempt := 0; // Will trigger immediate attempt in OnIdle
+ fConnectionRetryInterval := 2000; // Retry every 2 seconds
+ log('Localhost connection - will retry periodically until server is available', llInfo);
+ End
+ Else Begin
+ // For remote servers, connection attempt is async - if it fails, Connection_Error will handle it
+ fWaitingForLocalServer := false;
+ End;
+
+ // Initiate async connection attempt
+ // Note: Connect() returning True only means the async connection was initiated,
+ // not that we're actually connected. Real connection status comes via callbacks.
If Not fChunkManager.Connect(ip, port) Then Begin
- LogShow('Error could not connect to server', llError);
- SwitchToScreen(sMainScreen);
+ // Immediate failure - connection couldn't even be initiated
+ log('Could not initiate connection', llWarning);
+ If Not isLocalhost Then Begin
+ LogShow('Error: Could not initiate connection to server', llError);
+ SwitchToScreen(sMainScreen);
+ End;
+ // For localhost, OnIdle will retry
+ End
+ Else Begin
+ log('Connection initiated (async), waiting for result...', llInfo);
End;
+
logleave;
End;
@@ -1886,13 +3214,47 @@
fsdl_Loaded := false;
fsdlJoysticks[ks0] := Nil;
fsdlJoysticks[ks1] := Nil;
+ fControllerLogged[ks0] := false;
+ fControllerLogged[ks1] := false;
+ fLastUpdateTimestamp := 0; // Initialize network performance monitoring
+
+ // Initialize interpolation
+ fServerSnapshots[0].Valid := False;
+ fServerSnapshots[0].Timestamp := 0;
+ fServerSnapshots[1].Valid := False;
+ fServerSnapshots[1].Timestamp := 0;
+ fCurrentSnapshot := 0;
+ fInterpolationDelay := 0; // 0ms delay - interpolate between last 2 snapshots immediately
+ fExtrapolationLimit := 50; // Max 50ms extrapolation (reduced from 100ms)
+ fDebugStats.LastRTT := 0;
+ fDebugStats.AvgRTT := 0;
+ fDebugStats.MaxRTT := 0;
+ fDebugStats.InterpolationFactor := 0;
+ fDebugStats.MaxInterpFactor := 0;
+ fDebugStats.IsExtrapolating := False;
+ fDebugStats.SnapshotAge := 0;
+ fDebugStats.MaxSnapAge := 0;
+
+ fMenuDpadState.up := false;
+ fMenuDpadState.down := false;
+ fMenuDpadState.left := false;
+ fMenuDpadState.right := false;
+ fMenuDpadState.buttonA := false;
+ fMenuDpadState.buttonB := false;
+ fBlockGameInputUntilRelease := false;
+ fBlockMenuInputUntilRelease := false;
fSoundManager := TSoundManager.Create();
fSoundInfo := TSoundInfo.Create();
fParamJoinIP := '';
+ fWaitingForLocalServer := false;
+ fLastConnectionAttempt := 0;
+ fConnectionRetryInterval := 2000; // Retry every 2 seconds
fPause := false;
fNeedDisconnect := false;
fPlayerIndex[ks0] := -1;
fPlayerIndex[ks1] := -1;
+ fPlayerIndex[ksJoy1] := -1;
+ fPlayerIndex[ksJoy2] := -1;
fInitialized := false;
fActualScreen := Nil;
fChunkManager := TChunkManager.create;
@@ -1901,6 +3263,15 @@
fLastIdleTick := GetTickCount64;
OnNeedHideCursor := Nil;
OnNeedShowCursor := Nil;
+ FViewportOffsetX := 0;
+ FViewportOffsetY := 0;
+ FViewportWidth := GameWidth;
+ FViewportHeight := GameHeight;
+ FControlWidth := GameWidth;
+ FControlHeight := GameHeight;
+ FViewportScale := 1;
+ fDataPath := ''; // Will be set in Initialize
+ fServerPID := 0; // No server started initially
End;
Destructor TGame.Destroy;
@@ -1908,10 +3279,18 @@
i: TScreenEnum;
j: Integer;
Begin
+ // Server is running in terminal window - user can terminate it manually
+ // No automatic termination to avoid Access violation errors
+ fServerPID := 0;
+
If assigned(fsdlJoysticks[ks0]) Then fsdlJoysticks[ks0].free;
If assigned(fsdlJoysticks[ks1]) Then fsdlJoysticks[ks1].free;
+ If assigned(fsdlJoysticks[ksJoy1]) Then fsdlJoysticks[ksJoy1].free;
+ If assigned(fsdlJoysticks[ksJoy2]) Then fsdlJoysticks[ksJoy2].free;
fsdlJoysticks[ks0] := Nil;
fsdlJoysticks[ks1] := Nil;
+ fsdlJoysticks[ksJoy1] := Nil;
+ fsdlJoysticks[ksJoy2] := Nil;
fSoundManager.free;
fSoundManager := Nil;
fArrows.free;
@@ -1944,6 +3323,9 @@
Connection.OnError := @Connection_Error;
fChunkManager.OnReceivedChunk := @OnReceivedChunk;
fChunkManager.RegisterConnection(Connection);
+ // Start network thread for non-blocking network processing
+ fChunkManager.StartNetworkThread();
+ log('Network thread started for client', llInfo);
LogLeave;
End;
@@ -1990,9 +3372,37 @@
{$IFDEF ShowInitTime}
t := GetTickCount64;
{$ENDIF}
+ uearlylog.EarlyLog('TGame.Initialize: Starting');
+ uearlylog.EarlyLog('TGame.Initialize: Owner assigned: ' + BoolToStr(Assigned(Owner), true));
log('TGame.Initialize', lltrace);
+ log('TGame.Initialize: Owner assigned: ' + BoolToStr(Assigned(Owner), true), llInfo);
fOwner := Owner;
- Loader := TLoaderDialog.create(Owner);
+
+ // Resolve data path BEFORE creating Loader dialog (Loader needs it)
+ p := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
+ uearlylog.EarlyLog('TGame.Initialize: Assets root: ' + p);
+ // Resolve data directory path - check multiple locations for .app bundle compatibility
+ fDataPath := ResolveResourceBase(p);
+ uearlylog.EarlyLog('TGame.Initialize: Data path: ' + fDataPath);
+ uearlylog.EarlyLog('TGame.Initialize: Data path exists: ' + BoolToStr(DirectoryExists(fDataPath), true));
+ log('Assets root: ' + p, llInfo);
+ log('Data path: ' + fDataPath, llInfo);
+ log('Data path exists: ' + BoolToStr(DirectoryExists(fDataPath), true), llInfo);
+ Try
+ uearlylog.EarlyLog('TGame.Initialize: Creating TLoaderDialog...');
+ Loader := TLoaderDialog.create(Owner, fDataPath);
+ fLoaderDialog := Loader; // Store reference for OnPaint
+ uearlylog.EarlyLog('TGame.Initialize: TLoaderDialog created successfully');
+ log('TLoaderDialog created successfully', llInfo);
+ Except
+ On E: Exception Do Begin
+ uearlylog.EarlyLog('ERROR creating TLoaderDialog: ' + E.Message);
+ uearlylog.EarlyLog('Exception class: ' + E.ClassName);
+ log('ERROR creating TLoaderDialog: ' + E.Message, llError);
+ log('Exception class: ' + E.ClassName, llError);
+ Raise;
+ End;
+ End;
(*
* Lade Prozente
* 0..10 : Screens
@@ -2024,8 +3434,7 @@
FOnKeyUpCapture := Owner.OnKeyUp;
Owner.OnKeyUp := @FOnKeyUp;
- p := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
- AtomicBigFont.CreateFont(p + 'data' + PathDelim + 'res' + PathDelim);
+ AtomicBigFont.CreateFont(fDataPath + 'res' + PathDelim);
// Laden aller Screens
fScreens[sMainScreen] := TMainMenu.Create(self);
@@ -2043,9 +3452,10 @@
fScreens[sOptions] := TOptionsMenu.Create(self);
fScreens[sExitBomberman] := Nil;
+ log('Loading UI screens from ' + fDataPath + 'res', llInfo);
For i In TScreenEnum Do Begin
If Not assigned(fScreens[i]) Then Continue;
- fScreens[i].LoadFromDisk(p + 'data' + PathDelim + 'res' + PathDelim);
+ fScreens[i].LoadFromDisk(fDataPath + 'res' + PathDelim);
End;
Loader.Percent := 10;
Loader.Render();
@@ -2054,59 +3464,133 @@
{$ENDIF}
fPowerUpsTex[puNone] := 0; // Das Gibts ja net -> Weg
- fPowerUpsTex[puExtraBomb] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powbomb.png', smStretchHard);
- If fPowerUpsTex[puExtraBomb] = 0 Then exit;
- fPowerUpsTex[puLongerFlameLength] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powflame.png', smStretchHard);
- If fPowerUpsTex[puLongerFlameLength] = 0 Then exit;
- fPowerUpsTex[puDisease] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powdisea.png', smStretchHard);
- If fPowerUpsTex[puDisease] = 0 Then exit;
- fPowerUpsTex[puCanCick] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powkick.png', smStretchHard);
- If fPowerUpsTex[puCanCick] = 0 Then exit;
- fPowerUpsTex[puExtraSpeed] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powskate.png', smStretchHard);
- If fPowerUpsTex[puExtraSpeed] = 0 Then exit;
- fPowerUpsTex[puCanPunch] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powpunch.png', smStretchHard);
- If fPowerUpsTex[puCanPunch] = 0 Then exit;
- fPowerUpsTex[puCanGrab] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powgrab.png', smStretchHard);
- If fPowerUpsTex[puCanGrab] = 0 Then exit;
- fPowerUpsTex[puCanSpooger] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powspoog.png', smStretchHard);
- If fPowerUpsTex[puCanSpooger] = 0 Then exit;
- fPowerUpsTex[puGoldFlame] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powgold.png', smStretchHard);
- If fPowerUpsTex[puGoldFlame] = 0 Then exit;
- fPowerUpsTex[puTrigger] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powtrig.png', smStretchHard);
- If fPowerUpsTex[puTrigger] = 0 Then exit;
- fPowerUpsTex[puCanJelly] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powjelly.png', smStretchHard);
- If fPowerUpsTex[puCanJelly] = 0 Then exit;
- fPowerUpsTex[puSuperBadDisease] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powebola.png', smStretchHard);
- If fPowerUpsTex[puSuperBadDisease] = 0 Then exit;
- fPowerUpsTex[puSlow] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powslow.png', smStretchHard);
- If fPowerUpsTex[puSlow] = 0 Then exit;
- fPowerUpsTex[purandom] := OpenGL_GraphikEngine.LoadGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'powrand.png', smStretchHard);
- If fPowerUpsTex[purandom] = 0 Then exit;
+ fPowerUpsTex[puExtraBomb] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powbomb.png', smStretchHard);
+ If fPowerUpsTex[puExtraBomb] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powbomb.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puLongerFlameLength] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powflame.png', smStretchHard);
+ If fPowerUpsTex[puLongerFlameLength] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powflame.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puDisease] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powdisea.png', smStretchHard);
+ If fPowerUpsTex[puDisease] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powdisea.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puCanCick] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powkick.png', smStretchHard);
+ If fPowerUpsTex[puCanCick] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powkick.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puExtraSpeed] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powskate.png', smStretchHard);
+ If fPowerUpsTex[puExtraSpeed] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powskate.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puCanPunch] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powpunch.png', smStretchHard);
+ If fPowerUpsTex[puCanPunch] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powpunch.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puCanGrab] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powgrab.png', smStretchHard);
+ If fPowerUpsTex[puCanGrab] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powgrab.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puCanSpooger] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powspoog.png', smStretchHard);
+ If fPowerUpsTex[puCanSpooger] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powspoog.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puGoldFlame] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powgold.png', smStretchHard);
+ If fPowerUpsTex[puGoldFlame] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powgold.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puTrigger] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powtrig.png', smStretchHard);
+ If fPowerUpsTex[puTrigger] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powtrig.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puCanJelly] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powjelly.png', smStretchHard);
+ If fPowerUpsTex[puCanJelly] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powjelly.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puSuperBadDisease] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powebola.png', smStretchHard);
+ If fPowerUpsTex[puSuperBadDisease] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powebola.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[puSlow] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powslow.png', smStretchHard);
+ If fPowerUpsTex[puSlow] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powslow.png', llError);
+ logleave;
+ exit;
+ End;
+ fPowerUpsTex[purandom] := OpenGL_GraphikEngine.LoadGraphik(fDataPath + 'res' + PathDelim + 'powrand.png', smStretchHard);
+ If fPowerUpsTex[purandom] = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'powrand.png', llError);
+ logleave;
+ exit;
+ End;
// Load PlayerDead Tex correct.
- fPlayerdeadTex.Image := OpenGL_GraphikEngine.LoadAlphaColorGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'playerdead.png', ugraphics.ColorToRGB(clfuchsia), smClamp);
- fPlayerdeadTex := OpenGL_GraphikEngine.FindItem(p + 'data' + PathDelim + 'res' + PathDelim + 'playerdead.png');
- If fPlayerdeadTex.Image = 0 Then exit;
- fhurry.Texture.Image := OpenGL_GraphikEngine.LoadAlphaColorGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'hurry.png', ugraphics.ColorToRGB(clfuchsia), smClamp);
- If fhurry.Texture.Image = 0 Then exit;
- fhurry.Texture := OpenGL_GraphikEngine.FindItem(p + 'data' + PathDelim + 'res' + PathDelim + 'hurry.png');
- hohletex.image := OpenGL_GraphikEngine.LoadAlphaColorGraphik(p + 'data' + PathDelim + 'res' + PathDelim + 'hole.png', ugraphics.ColorToRGB(clfuchsia), smStretchHard);
- If hohletex.Image = 0 Then exit;
- hohletex := OpenGL_GraphikEngine.FindItem(p + 'data' + PathDelim + 'res' + PathDelim + 'hole.png');
+ fPlayerdeadTex.Image := OpenGL_GraphikEngine.LoadAlphaColorGraphik(fDataPath + 'res' + PathDelim + 'playerdead.png', ugraphics.ColorToRGB(clfuchsia), smClamp);
+ fPlayerdeadTex := OpenGL_GraphikEngine.FindItem(fDataPath + 'res' + PathDelim + 'playerdead.png');
+ If fPlayerdeadTex.Image = 0 Then Begin
+ log('Failed to locate texture handle for playerdead.png', llError);
+ logleave;
+ exit;
+ End;
+ fhurry.Texture.Image := OpenGL_GraphikEngine.LoadAlphaColorGraphik(fDataPath + 'res' + PathDelim + 'hurry.png', ugraphics.ColorToRGB(clfuchsia), smClamp);
+ If fhurry.Texture.Image = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'hurry.png', llError);
+ logleave;
+ exit;
+ End;
+ fhurry.Texture := OpenGL_GraphikEngine.FindItem(fDataPath + 'res' + PathDelim + 'hurry.png');
+ hohletex.image := OpenGL_GraphikEngine.LoadAlphaColorGraphik(fDataPath + 'res' + PathDelim + 'hole.png', ugraphics.ColorToRGB(clfuchsia), smStretchHard);
+ If hohletex.Image = 0 Then Begin
+ log('Failed to load texture ' + fDataPath + 'res' + PathDelim + 'hole.png', llError);
+ logleave;
+ exit;
+ End;
+ hohletex := OpenGL_GraphikEngine.FindItem(fDataPath + 'res' + PathDelim + 'hole.png');
{$IFDEF ShowInitTime}
TimePoint(3);
{$ENDIF}
// Laden der Felder
fArrows := TOpenGL_Animation.Create;
- If Not fArrows.LoadFromFile(p + 'data' + PathDelim + 'res' + PathDelim + 'arrows.ani', true) Then Begin
+ If Not fArrows.LoadFromFile(fDataPath + 'res' + PathDelim + 'arrows.ani', true) Then Begin
+ log('Failed to load animation ' + fDataPath + 'res' + PathDelim + 'arrows.ani', llError);
+ logleave;
Exit;
End;
fConveyors := TOpenGL_Animation.Create;
- If Not fConveyors.LoadFromFile(p + 'data' + PathDelim + 'res' + PathDelim + 'conveyor.ani', true) Then Begin
+ If Not fConveyors.LoadFromFile(fDataPath + 'res' + PathDelim + 'conveyor.ani', true) Then Begin
+ log('Failed to load animation ' + fDataPath + 'res' + PathDelim + 'conveyor.ani', llError);
+ logleave;
Exit;
End;
fTramp := TOpenGL_Animation.Create;
- If Not fTramp.LoadFromFile(p + 'data' + PathDelim + 'res' + PathDelim + 'tramp.ani', true) Then Begin
+ If Not fTramp.LoadFromFile(fDataPath + 'res' + PathDelim + 'tramp.ani', true) Then Begin
+ log('Failed to load animation ' + fDataPath + 'res' + PathDelim + 'tramp.ani', llError);
+ logleave;
Exit;
End;
{$IFDEF ShowInitTime}
@@ -2135,7 +3619,8 @@
{$IFDEF ShowInitTime}
TimePoint(5);
{$ENDIF}
- sl := FindAllDirectories(p + 'data' + PathDelim + 'maps', false);
+ log('Scanning map directories in ' + fDataPath + 'maps', llInfo);
+ sl := FindAllDirectories(fDataPath + 'maps', false);
sl.Sorted := true;
sl.Sort;
{$IFDEF Only1Map}
@@ -2145,17 +3630,18 @@
{$ENDIF}
setlength(fFields, sl.Count);
If sl.count = 0 Then Begin
- LogShow('Error, no fields to load found', llFatal);
+ LogShow('Error, no fields to load found in ' + fDataPath + 'maps', llFatal);
LogLeave;
exit;
End;
+ log('Found ' + inttostr(sl.Count) + ' map directories', llInfo);
{$IFDEF ShowInitTime}
TimePoint(6);
{$ENDIF}
For j := 0 To sl.count - 1 Do Begin
fFields[j] := TAtomicField.Create();
If Not fFields[j].loadFromDirectory(sl[j], fArrows, fConveyors, fTramp, hohletex.Image, fTrampStatic) Then Begin
- LogShow('Error, unable to load field:' + sl[j], llFatal);
+ LogShow('Error, unable to load field: ' + sl[j], llFatal);
LogLeave;
exit;
End;
@@ -2180,8 +3666,8 @@
Loader.Percent := 50 + round(50 * j / length(fAtomics));
Loader.Render();
fAtomics[j] := TAtomic.Create;
- If Not fAtomics[j].InitAsColor(p + 'data' + PathDelim + 'atomic' + PathDelim, PlayerColors[j]) Then Begin
- LogShow('Error, unable to load atomic.', llFatal);
+ If Not fAtomics[j].InitAsColor(fDataPath + 'atomic' + PathDelim, PlayerColors[j]) Then Begin
+ LogShow('Error, unable to load atomic from ' + fDataPath + 'atomic' + PathDelim, llFatal);
LogLeave;
exit;
End;
@@ -2192,6 +3678,7 @@
Loader.Percent := 100;
Loader.Render(); // Als letztes kriegt der User zu sehen, dass wir fertig sind :-)
Loader.free;
+ fLoaderDialog := Nil; // Clear reference after initialization
fInitialized := true;
SwitchToScreen(sMainScreen);
{$IFDEF ShowInitTime}
@@ -2242,11 +3729,157 @@
logleave;
End;
+// Client-side interpolation implementation
+Procedure TGame.InterpolateGameState();
+Var
+ CurrentTime, RenderTime: QWord;
+ OldSnapIndex, NewSnapIndex: Integer;
+ T, Extrapolation: Single;
+ i: Integer;
+ TimeDiff, SnapAge: Int64;
+ VelX, VelY: Single;
+ PlayerSpeed: Single;
+
+ // Linear interpolation
+ Function Lerp(A, B, T: Single): Single;
+ Begin
+ Result := A + (B - A) * T;
+ End;
+
+ // Interpolate 2D vector
+ Function LerpVector2(Const A, B: TVector2; T: Single): TVector2;
+ Begin
+ Result.x := Lerp(A.x, B.x, T);
+ Result.y := Lerp(A.y, B.y, T);
+ End;
+
+Begin
+ CurrentTime := GetTickCount64;
+
+ // Get the snapshot indices
+ OldSnapIndex := 1 - fCurrentSnapshot; // Older
+ NewSnapIndex := fCurrentSnapshot; // Newer
+
+ // If we don't have 2 valid snapshots yet, use the latest one
+ If (Not fServerSnapshots[OldSnapIndex].Valid) Or (Not fServerSnapshots[NewSnapIndex].Valid) Then Begin
+ If fServerSnapshots[NewSnapIndex].Valid Then Begin
+ fInterpolatedState.PlayingTime_ms := fServerSnapshots[NewSnapIndex].ServerTime_ms;
+ fInterpolatedState.PlayerInfos := fServerSnapshots[NewSnapIndex].PlayerInfos;
+ fDebugStats.InterpolationFactor := 1.0;
+ fDebugStats.IsExtrapolating := False;
+ fDebugStats.SnapshotAge := CurrentTime - fServerSnapshots[NewSnapIndex].Timestamp;
+ End;
+ Exit;
+ End;
+
+ // Calculate snapshot age
+ SnapAge := CurrentTime - fServerSnapshots[NewSnapIndex].Timestamp;
+ fDebugStats.SnapshotAge := SnapAge;
+ // Track MAX snapshot age
+ If SnapAge > fDebugStats.MaxSnapAge Then
+ fDebugStats.MaxSnapAge := SnapAge;
+
+ // Calculate time since last snapshot (for interpolation/extrapolation)
+ TimeDiff := fServerSnapshots[NewSnapIndex].Timestamp - fServerSnapshots[OldSnapIndex].Timestamp;
+
+ // If snapshots are too far apart (> 150ms), don't interpolate - just use newest
+ If TimeDiff > 150 Then Begin
+ fInterpolatedState.PlayingTime_ms := fServerSnapshots[NewSnapIndex].ServerTime_ms;
+ fInterpolatedState.PlayerInfos := fServerSnapshots[NewSnapIndex].PlayerInfos;
+ fDebugStats.InterpolationFactor := 1.0;
+ fDebugStats.IsExtrapolating := False;
+ Exit;
+ End;
+
+ // Calculate interpolation factor based on time between snapshots
+ // We want to render at the "latest safe time" which is the newest snapshot + elapsed time
+ If TimeDiff > 0 Then Begin
+ T := (CurrentTime - fServerSnapshots[OldSnapIndex].Timestamp) / TimeDiff;
+ End Else Begin
+ T := 1.0; // Use newest if timestamps are same
+ End;
+
+ // === INTERPOLATION (T between 0 and 1) ===
+ If (T >= 0.0) And (T <= 1.0) Then Begin
+ fDebugStats.InterpolationFactor := T;
+ fDebugStats.IsExtrapolating := False;
+ // Track MAX interpolation factor
+ If T > fDebugStats.MaxInterpFactor Then
+ fDebugStats.MaxInterpFactor := T;
+
+ // Interpolate playing time
+ fInterpolatedState.PlayingTime_ms := Round(
+ Lerp(fServerSnapshots[OldSnapIndex].ServerTime_ms, fServerSnapshots[NewSnapIndex].ServerTime_ms, T)
+ );
+
+ // Interpolate player positions
+ For i := 0 To 9 Do Begin
+ fInterpolatedState.PlayerInfos[i].Position := LerpVector2(
+ fServerSnapshots[OldSnapIndex].PlayerInfos[i].Position,
+ fServerSnapshots[NewSnapIndex].PlayerInfos[i].Position,
+ T
+ );
+
+ // Don't interpolate these - use newest values
+ fInterpolatedState.PlayerInfos[i].Direction := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Direction;
+ fInterpolatedState.PlayerInfos[i].Animation := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Animation;
+ fInterpolatedState.PlayerInfos[i].Alive := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Alive;
+ fInterpolatedState.PlayerInfos[i].Dying := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Dying;
+ fInterpolatedState.PlayerInfos[i].Counter := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Counter;
+ fInterpolatedState.PlayerInfos[i].Value := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Value;
+ fInterpolatedState.PlayerInfos[i].ColorIndex := fServerSnapshots[NewSnapIndex].PlayerInfos[i].ColorIndex;
+ End;
+ End
+ // === EXTRAPOLATION (T > 1.0 - we're ahead of last snapshot) ===
+ Else If T > 1.0 Then Begin
+ // Calculate how much time has elapsed since last snapshot
+ Extrapolation := (CurrentTime - fServerSnapshots[NewSnapIndex].Timestamp) / 1000.0; // in seconds
+
+ // Limit extrapolation aggressively to prevent jitter
+ If Extrapolation > (fExtrapolationLimit / 1000.0) Then Begin
+ Extrapolation := fExtrapolationLimit / 1000.0;
+ End;
+
+ fDebugStats.InterpolationFactor := T;
+ fDebugStats.IsExtrapolating := True;
+ // Track MAX interpolation factor (extrapolation)
+ If T > fDebugStats.MaxInterpFactor Then
+ fDebugStats.MaxInterpFactor := T;
+
+ // Extrapolate playing time smoothly
+ fInterpolatedState.PlayingTime_ms := fServerSnapshots[NewSnapIndex].ServerTime_ms + Round(Extrapolation * 1000);
+
+ // For positions: DON'T extrapolate - just use latest snapshot to avoid jitter!
+ // Extrapolation causes "jittery" movement when predictions are wrong
+ For i := 0 To 9 Do Begin
+ // Just use the latest snapshot position (no prediction)
+ fInterpolatedState.PlayerInfos[i].Position := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Position;
+
+ // Copy other fields
+ fInterpolatedState.PlayerInfos[i].Direction := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Direction;
+ fInterpolatedState.PlayerInfos[i].Animation := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Animation;
+ fInterpolatedState.PlayerInfos[i].Alive := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Alive;
+ fInterpolatedState.PlayerInfos[i].Dying := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Dying;
+ fInterpolatedState.PlayerInfos[i].Counter := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Counter;
+ fInterpolatedState.PlayerInfos[i].Value := fServerSnapshots[NewSnapIndex].PlayerInfos[i].Value;
+ fInterpolatedState.PlayerInfos[i].ColorIndex := fServerSnapshots[NewSnapIndex].PlayerInfos[i].ColorIndex;
+ End;
+ End
+ // === FALLBACK (T < 0 - should not happen, but handle it) ===
+ Else Begin
+ fDebugStats.InterpolationFactor := 0.0;
+ fDebugStats.IsExtrapolating := False;
+ fInterpolatedState.PlayingTime_ms := fServerSnapshots[OldSnapIndex].ServerTime_ms;
+ fInterpolatedState.PlayerInfos := fServerSnapshots[OldSnapIndex].PlayerInfos;
+ End;
+End;
+
Procedure TGame.Render;
Var
i: Integer;
n: QWORD;
Begin
+ // Viewport is set in OpenGLControl1Resize, don't override it here
Go2d(GameWidth, GameHeight);
If Not fInitialized Then Begin
glBindTexture(GL_TEXTURE_2D, 0);
@@ -2264,12 +3897,16 @@
If assigned(fActualScreen) Then fActualScreen.Render;
End;
gs_Gaming: Begin
+ // === NEW: Interpolate game state before rendering ===
+ InterpolateGameState();
+
CheckSDLKeys;
fActualField.render(fAtomics, fPowerUpsTex);
RenderBombs;
For i := 0 To high(fPlayer) Do Begin
- If fPlayer[i].Info.Alive Then Begin
- RenderPlayerbyInfo(fPlayer[i].Info, fPlayer[i].edge);
+ // Use interpolated positions instead of raw server data
+ If fInterpolatedState.PlayerInfos[i].Alive Then Begin
+ RenderPlayerbyInfo(fInterpolatedState.PlayerInfos[i], fPlayer[i].edge);
fPlayer[i].edge := false;
End;
End;
@@ -2305,6 +3942,65 @@
Exit2d();
End;
+Function TGame.PointInsideViewport(ScreenX, ScreenY: Integer): Boolean;
+Begin
+ If (FViewportWidth <= 0) Or (FViewportHeight <= 0) Then
+ exit(true);
+ Result :=
+ (ScreenX >= FViewportOffsetX) And
+ (ScreenX <= FViewportOffsetX + FViewportWidth) And
+ (ScreenY >= FViewportOffsetY) And
+ (ScreenY <= FViewportOffsetY + FViewportHeight);
+End;
+
+Function TGame.ScreenToGameX(ScreenX: Integer): Integer;
+Var
+ Local: Double;
+Begin
+ If (FViewportWidth <= 0) Or (FViewportScale <= 0) Then
+ exit(ScreenX);
+ Local := (ScreenX - FViewportOffsetX) / FViewportScale;
+ If Local < 0 Then
+ Local := 0
+ Else If Local > GameWidth Then
+ Local := GameWidth;
+ Result := round(Local);
+End;
+
+Function TGame.ScreenToGameY(ScreenY: Integer): Integer;
+Var
+ Local: Double;
+Begin
+ If (FViewportHeight <= 0) Or (FViewportScale <= 0) Then
+ exit(ScreenY);
+ Local := (ScreenY - FViewportOffsetY) / FViewportScale;
+ If Local < 0 Then
+ Local := 0
+ Else If Local > GameHeight Then
+ Local := GameHeight;
+ Result := round(Local);
+End;
+
+Procedure TGame.SetViewportMetrics(ControlWidth, ControlHeight, OffsetX,
+ OffsetY, ViewportWidth, ViewportHeight: Integer);
+Begin
+ FControlWidth := ControlWidth;
+ FControlHeight := ControlHeight;
+ FViewportOffsetX := OffsetX;
+ FViewportOffsetY := OffsetY;
+ FViewportWidth := ViewportWidth;
+ FViewportHeight := ViewportHeight;
+ If (ViewportWidth > 0) Then
+ FViewportScale := ViewportWidth / GameWidth
+ Else
+ FViewportScale := 1;
+ If FViewportScale <= 0 Then
+ FViewportScale := 1;
+ log(Format('Viewport metrics: control=%dx%d viewport=%dx%d scale=%.4f offset=(%d,%d)',
+ [FControlWidth, FControlHeight, FViewportWidth, FViewportHeight, FViewportScale,
+ FViewportOffsetX, FViewportOffsetY]), llInfo);
+End;
+
Procedure TGame.OnIdle;
Begin
PingForOpenGames;
@@ -2315,6 +4011,101 @@
If fNeedDisconnect Then Begin
DoDisconnect();
End;
+
+ // Periodically retry connection if we're waiting for local server to start
+ // On localhost, "connection refused" comes back immediately, so we need to retry periodically
+ If fWaitingForLocalServer And (fParamJoinIP <> '') Then Begin
+ If (fLastConnectionAttempt = 0) Or (GetTickCount64 - fLastConnectionAttempt >= fConnectionRetryInterval) Then Begin
+ fLastConnectionAttempt := GetTickCount64;
+ log(format('Retrying connection to %s:%d...', [fParamJoinIP, fParamJoinPort]), llInfo);
+ // Initiate new async connection attempt
+ If Not fChunkManager.Connect(fParamJoinIP, fParamJoinPort) Then Begin
+ log('Could not initiate connection, will retry later', llInfo);
+ End;
+ // If Connect returned True, we wait for Connection_Connect or Connection_Error callback
+ End;
+ End;
+
+ // Always pump SDL events first to update button states
+ // Check all possible keysets that might use SDL
+ If fsdl_Loaded And (Settings.Keys[ks0].UseSDL2 Or Settings.Keys[ks1].UseSDL2 Or
+ Settings.Keys[ksJoy1].UseSDL2 Or Settings.Keys[ksJoy2].UseSDL2) Then Begin
+ SDL_PumpEvents();
+ End;
+
+ // Check if we need to unblock game input (waiting for all buttons to be released)
+ If fBlockGameInputUntilRelease Then Begin
+ If AreAllGamepadButtonsReleased() Then Begin
+ fBlockGameInputUntilRelease := false;
+ End;
+ End;
+
+ // Check if we need to unblock menu input (waiting for all buttons to be released)
+ If fBlockMenuInputUntilRelease Then Begin
+ If AreAllGamepadButtonsReleased() Then Begin
+ fBlockMenuInputUntilRelease := false;
+ End;
+ End;
+
+ // Poll controllers/joysticks each idle tick for input (both menu and game)
+ CheckSDLKeys();
+ // Also poll for menu navigation via gamepad
+ CheckSDLKeysForMenu();
+End;
+
+Function TGame.ResolveResourceBase(BasePath: String): String;
+Var
+ testPath: String;
+ appBundlePath: String;
+Begin
+ // Normalize base path to absolute path
+ BasePath := ExpandFileName(IncludeTrailingPathDelimiter(BasePath));
+ log('ResolveResourceBase: BasePath=' + BasePath, llInfo);
+
+ // Try multiple locations for data directory
+ // 1. Direct relative to executable (works with symlinks)
+ testPath := BasePath + 'data';
+ If DirectoryExistsUTF8(testPath) Then Begin
+ Result := IncludeTrailingPathDelimiter(testPath);
+ log('ResolveResourceBase: Found data at ' + Result, llInfo);
+ exit;
+ End;
+ // 2. Relative path from MacOS directory in .app bundle
+ testPath := ExpandFileName(BasePath + '../Resources/data');
+ If DirectoryExistsUTF8(testPath) Then Begin
+ Result := IncludeTrailingPathDelimiter(testPath);
+ log('ResolveResourceBase: Found data at ' + Result, llInfo);
+ exit;
+ End;
+ // 3. Try symlink path (../../data from MacOS) - for shared data directory
+ testPath := ExpandFileName(BasePath + '../../data');
+ If DirectoryExistsUTF8(testPath) Then Begin
+ Result := IncludeTrailingPathDelimiter(testPath);
+ log('ResolveResourceBase: Found data at ' + Result, llInfo);
+ exit;
+ End;
+ // 4. Try symlink path (../../../data from MacOS) - alternative symlink location
+ testPath := ExpandFileName(BasePath + '../../../data');
+ If DirectoryExistsUTF8(testPath) Then Begin
+ Result := IncludeTrailingPathDelimiter(testPath);
+ log('ResolveResourceBase: Found data at ' + Result, llInfo);
+ exit;
+ End;
+ // 5. Try path next to .app bundle (for cases where data is outside the bundle)
+ // If BasePath contains ".app/Contents/MacOS/", try going up to the .app bundle's parent directory
+ If Pos('.app/Contents/MacOS/', BasePath) > 0 Then Begin
+ appBundlePath := Copy(BasePath, 1, Pos('.app/Contents/MacOS/', BasePath) + 4); // Get path up to ".app"
+ appBundlePath := ExtractFilePath(ExcludeTrailingPathDelimiter(appBundlePath)); // Get parent directory of .app
+ testPath := ExpandFileName(appBundlePath + 'data');
+ If DirectoryExistsUTF8(testPath) Then Begin
+ Result := IncludeTrailingPathDelimiter(testPath);
+ log('ResolveResourceBase: Found data at ' + Result, llInfo);
+ exit;
+ End;
+ End;
+ // Fallback: use base path (may not exist, but at least we tried)
+ Result := BasePath + 'data' + PathDelim;
+ log('Warning: Could not resolve data directory, using fallback: ' + Result, llWarning);
End;
End.
diff --git a/client/uloaderdialog.pas b/client/uloaderdialog.pas
index c4a98c7..9dccd32 100644
--- a/client/uloaderdialog.pas
+++ b/client/uloaderdialog.pas
@@ -1,209 +1,334 @@
-(******************************************************************************)
-(* *)
-(* Author : Uwe Schächterle (Corpsman) *)
-(* *)
-(* This file is part of FPC_Atomic *)
-(* *)
-(* See the file license.md, located under: *)
-(* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *)
-(* for details about the license. *)
-(* *)
-(* It is not allowed to change or remove this text from any *)
-(* source file of the project. *)
-(* *)
-(******************************************************************************)
-Unit uloaderdialog;
-
-{$MODE ObjFPC}{$H+}
-
-Interface
-
-Uses
- Classes, SysUtils, OpenGLContext;
-
-Type
-
- { TLoaderDialog }
-
- TLoaderDialog = Class
- private
- fWidth: integer;
- fHeight: integer;
- fOwner: TOpenGLControl;
- fTextures: Array[0..8] Of Integer; // Die 9 Einzeltextruren des Hintergrunds
- public
- Percent: integer;
- Constructor Create(Const Owner: TOpenGLControl);
- Destructor Destroy(); override;
- (*
- * !Achtung!
- * das ist Asynchron und macht ein Vollständiges Render !
- * -> Sollte also nur in Blockierenden Aufgaben aufgerufen werden !
- *)
- Procedure Render();
- End;
-
-Implementation
-
-Uses
- Graphics
- , dglOpenGL
- , Forms
- , LazUTF8
- , uatomic_common
- , uopengl_graphikengine
- , uOpenGL_ASCII_Font
- ;
-
-Procedure RenderImg(w, h, ImageIndex: integer); // TODO: das ggf noch mal irgendwohin auslagern ??
-Begin
- glBindTexture(gl_texture_2d, ImageIndex);
- glbegin(gl_quads);
- glTexCoord2f(0, 1);
- glvertex3f(0, h, 0);
-
- glTexCoord2f(1, 1);
- glvertex3f(w, h, 0);
-
- glTexCoord2f(1, 0);
- glvertex3f(w, 0, 0);
-
- glTexCoord2f(0, 0);
- glvertex3f(0, 0, 0);
- glend;
-End;
-
-{ TLoaderDialog }
-
-Constructor TLoaderDialog.Create(Const Owner: TOpenGLControl);
-Var
- p: String;
- png: TPortableNetworkGraphic;
- b, b2: TBitmap;
- i: Integer;
-Begin
- fWidth := 15 * 24;
- fHeight := 5 * 24;
- fOwner := Owner;
- Percent := 0;
- p := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStrUTF8(0))) + 'data' + PathDelim + 'res' + PathDelim + 'loaddialog.png';
- png := TPortableNetworkGraphic.Create;
- png.LoadFromFile(p);
- b := TBitmap.create;
- b.Assign(png);
- b.Transparent := false;
- png.free;
- b2 := TBitmap.Create;
- b2.Height := 24;
- b2.Width := 24;
- b2.Transparent := false;
- For i := 0 To 8 Do Begin
- b2.Canvas.Draw(-(i Mod 3) * 24, -(i Div 3) * 24, b);
- fTextures[i] := OpenGL_GraphikEngine.LoadGraphik(b2, 'TLoaderDialog_img' + inttostr(i), smStretch);
- End;
- b2.free;
- b.free;
-End;
-
-Destructor TLoaderDialog.Destroy;
-Var
- i: Integer;
-Begin
- For i := 0 To 8 Do Begin
- OpenGL_GraphikEngine.RemoveGraphik(fTextures[i]);
- End;
- Inherited Create;
-End;
-
-Procedure TLoaderDialog.Render;
-Var
- x, i, j: Integer;
- s: String;
-Begin
- glClearColor(0.0, 0.0, 0.0, 0.0);
- glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT);
- glLoadIdentity();
- glcolor4f(1, 1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, 0);
- Go2d(GameWidth, GameHeight);
- glPushMatrix;
- glTranslatef((GameWidth - fWidth) Div 2, (GameHeight - fHeight) Div 2, atomic_dialog_Layer);
- glPushMatrix;
- // Die "Dialogbox"
- // 1. Zeile
- RenderImg(24, 24, fTextures[0]); // Ecke Oben Links
- glPushMatrix;
- For i := 1 To (fWidth Div 24) - 2 Do Begin
- glTranslatef(24, 0, 0);
- RenderImg(24, 24, fTextures[1]); // Obere Mittlere Kante
- End;
- glTranslatef(24, 0, 0);
- RenderImg(24, 24, fTextures[2]); // Ecke Oben Rechts
- glPopMatrix;
- // Zeile 2 bis N -1
- For j := 1 To (fHeight Div 24) - 2 Do Begin
- glTranslatef(0, 24, 0);
- glPushMatrix;
- RenderImg(24, 24, fTextures[3]); // Linke Kante
- For i := 1 To (fWidth Div 24) - 2 Do Begin
- glTranslatef(24, 0, 0);
- RenderImg(24, 24, fTextures[4]); // Die Mittelstücke
- End;
- glTranslatef(24, 0, 0);
- RenderImg(24, 24, fTextures[5]); // Rechte Kante
- glPopMatrix;
- End;
- // Letzte Zeile
- glTranslatef(0, 24, 0);
- RenderImg(24, 24, fTextures[6]); // Ecke unten Links
- For i := 1 To (fWidth Div 24) - 2 Do Begin
- glTranslatef(24, 0, 0);
- RenderImg(24, 24, fTextures[7]); // untere Mittlere Kante
- End;
- glTranslatef(24, 0, 0);
- RenderImg(24, 24, fTextures[8]); // Ecke Unten Rechts
- glPopMatrix;
- // Rendern der Elemente auf dem Dialog
- glTranslatef(0, 0, atomic_EPSILON);
- glBindTexture(GL_TEXTURE_2D, 0);
- // Der Schriftzug "Loading data..."
- s := 'Loading data...';
- OpenGL_ASCII_Font.Color := clWhite;
- OpenGL_ASCII_Font.Textout((fWidth - round(OpenGL_ASCII_Font.TextWidth(s))) Div 2, 24, s);
- // Die Prozentzahl
- s := inttostr(Percent) + '%';
- OpenGL_ASCII_Font.Color := clYellow;
- OpenGL_ASCII_Font.Textout((fWidth - round(OpenGL_ASCII_Font.TextWidth(s))) Div 2, (fHeight - round(OpenGL_ASCII_Font.TextHeight(s))) Div 2, s);
- // Der Fortschrittsbalken
- glTranslatef(0, 0, -atomic_EPSILON); // Der Weise Rahmen, mittels LineLoop sieht das scheiße aus, also muss der so in den Hintergrund der anderen beiden.
- glBegin(GL_QUADS);
- glColor3f(1, 1, 1);
- glVertex3f(24, 82, 0);
- glVertex3f(24, 82 + 14, 0);
- glVertex3f(fWidth - 24, 82 + 14, 0);
- glVertex3f(fWidth - 24, 82, 0);
- glend;
- glTranslatef(0, 0, atomic_EPSILON);
- x := round((fWidth - 48 - 2) * Percent / 100);
- glBegin(GL_QUADS);
- glColor3f(168 / 255, 168 / 255, 168 / 255);
- glVertex3f(24 + 1, 82 + 1, 0);
- glVertex3f(24 + 1, 82 + 14 - 1, 0);
- glVertex3f(24 + 1 + x, 82 + 14 - 1, 0);
- glVertex3f(24 + 1 + x, 82 + 1, 0);
- glend;
- glBegin(GL_QUADS);
- glColor3f(0, 0, 0);
- glVertex3f(24 + 1 + x, 82 + 1, 0);
- glVertex3f(24 + 1 + x, 82 + 14 - 1, 0);
- glVertex3f(fWidth - 24 - 1, 82 + 14 - 1, 0);
- glVertex3f(fWidth - 24 - 1, 82 + 1, 0);
- glend;
- glPopMatrix;
- Exit2d();
- fOwner.SwapBuffers;
- Application.ProcessMessages;
-End;
-
-End.
-
+(******************************************************************************)
+(* *)
+(* Author : Uwe Schächterle (Corpsman) *)
+(* *)
+(* This file is part of FPC_Atomic *)
+(* *)
+(* See the file license.md, located under: *)
+(* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *)
+(* for details about the license. *)
+(* *)
+(* It is not allowed to change or remove this text from any *)
+(* source file of the project. *)
+(* *)
+(******************************************************************************)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
+Unit uloaderdialog;
+
+{$MODE ObjFPC}{$H+}
+
+Interface
+
+Uses
+ Classes, SysUtils, OpenGLContext;
+
+Type
+
+ { TLoaderDialog }
+
+ TLoaderDialog = Class
+ private
+ fWidth: integer;
+ fHeight: integer;
+ fOwner: TOpenGLControl;
+ fTextures: Array[0..8] Of Integer; // Die 9 Einzeltextruren des Hintergrunds
+ public
+ Percent: integer;
+ Constructor Create(Const Owner: TOpenGLControl; Const DataPath: String = '');
+ Destructor Destroy(); override;
+ (*
+ * !Achtung!
+ * das ist Asynchron und macht ein Vollständiges Render !
+ * -> Sollte also nur in Blockierenden Aufgaben aufgerufen werden !
+ *)
+ Procedure Render();
+ Procedure RenderDirect(); // Render without SwapBuffers and ProcessMessages - for use in OnPaint
+ End;
+
+Implementation
+
+Uses
+ Graphics
+ , dglOpenGL
+ , Forms
+ , LazUTF8
+ , LazFileUtils
+ , uatomic_common
+ , uopengl_graphikengine
+ , uOpenGL_ASCII_Font
+ ;
+
+Procedure RenderImg(w, h, ImageIndex: integer); // TODO: das ggf noch mal irgendwohin auslagern ??
+Begin
+ If ImageIndex = 0 Then Begin
+ exit;
+ End;
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(gl_texture_2d, ImageIndex);
+ glbegin(gl_quads);
+ glTexCoord2f(0, 1);
+ glvertex3f(0, h, 0);
+
+ glTexCoord2f(1, 1);
+ glvertex3f(w, h, 0);
+
+ glTexCoord2f(1, 0);
+ glvertex3f(w, 0, 0);
+
+ glTexCoord2f(0, 0);
+ glvertex3f(0, 0, 0);
+ glend;
+End;
+
+{ TLoaderDialog }
+
+Constructor TLoaderDialog.Create(Const Owner: TOpenGLControl; Const DataPath: String = '');
+Var
+ p: String;
+ png: TPortableNetworkGraphic;
+ b, b2: TBitmap;
+ i: Integer;
+Begin
+ fWidth := 15 * 24;
+ fHeight := 5 * 24;
+ fOwner := Owner;
+ Percent := 0;
+ // CRITICAL: Ensure OpenGL context is active before loading textures
+ // This is required because LoadGraphik uses glGenTextures and glTexImage2D
+ If Not Owner.MakeCurrent Then Begin
+ Raise Exception.Create('TLoaderDialog.Create: OpenGL context is not active');
+ End;
+ // Use provided DataPath if available, otherwise fall back to old method
+ If DataPath <> '' Then Begin
+ p := IncludeTrailingPathDelimiter(DataPath) + 'res' + PathDelim + 'loaddialog.png';
+ End Else Begin
+ p := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStrUTF8(0))) + 'data' + PathDelim + 'res' + PathDelim + 'loaddialog.png';
+ End;
+ png := TPortableNetworkGraphic.Create;
+ If Not FileExistsUTF8(p) Then Begin
+ png.Free;
+ Raise Exception.Create('The data directory is incomplete.' + LineEnding + LineEnding +
+ 'Please run FPC Atomic Launcher and use the "Run CD data extractor" button to extract the required game data.' + LineEnding + LineEnding +
+ 'Missing file: ' + ExtractFileName(p));
+ End;
+ png.LoadFromFile(p);
+ b := TBitmap.create;
+ b.Assign(png);
+ b.Transparent := false;
+ png.free;
+ b2 := TBitmap.Create;
+ b2.Height := 24;
+ b2.Width := 24;
+ b2.Transparent := false;
+ For i := 0 To 8 Do Begin
+ b2.Canvas.Draw(-(i Mod 3) * 24, -(i Div 3) * 24, b);
+ fTextures[i] := OpenGL_GraphikEngine.LoadGraphik(b2, 'TLoaderDialog_img' + inttostr(i), smStretch);
+ End;
+ b2.free;
+ b.free;
+End;
+
+Destructor TLoaderDialog.Destroy;
+Var
+ i: Integer;
+Begin
+ For i := 0 To 8 Do Begin
+ OpenGL_GraphikEngine.RemoveGraphik(fTextures[i]);
+ End;
+ Inherited Create;
+End;
+
+Procedure TLoaderDialog.Render;
+Var
+ x, i, j: Integer;
+ s: String;
+Begin
+ glClearColor(0.0, 0.0, 0.0, 0.0);
+ glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT);
+ glLoadIdentity();
+ glcolor4f(1, 1, 1, 1);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ Go2d(GameWidth, GameHeight);
+ glPushMatrix;
+ glTranslatef((GameWidth - fWidth) Div 2, (GameHeight - fHeight) Div 2, atomic_dialog_Layer);
+ glPushMatrix;
+ // Die "Dialogbox"
+ // 1. Zeile
+ RenderImg(24, 24, fTextures[0]); // Ecke Oben Links
+ glPushMatrix;
+ For i := 1 To (fWidth Div 24) - 2 Do Begin
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[1]); // Obere Mittlere Kante
+ End;
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[2]); // Ecke Oben Rechts
+ glPopMatrix;
+ // Zeile 2 bis N -1
+ For j := 1 To (fHeight Div 24) - 2 Do Begin
+ glTranslatef(0, 24, 0);
+ glPushMatrix;
+ RenderImg(24, 24, fTextures[3]); // Linke Kante
+ For i := 1 To (fWidth Div 24) - 2 Do Begin
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[4]); // Die Mittelstücke
+ End;
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[5]); // Rechte Kante
+ glPopMatrix;
+ End;
+ // Letzte Zeile
+ glTranslatef(0, 24, 0);
+ RenderImg(24, 24, fTextures[6]); // Ecke unten Links
+ For i := 1 To (fWidth Div 24) - 2 Do Begin
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[7]); // untere Mittlere Kante
+ End;
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[8]); // Ecke Unten Rechts
+ glPopMatrix;
+ // Rendern der Elemente auf dem Dialog
+ glTranslatef(0, 0, atomic_EPSILON);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ // Der Schriftzug "Loading data..."
+ s := 'Loading data...';
+ OpenGL_ASCII_Font.Color := clWhite;
+ OpenGL_ASCII_Font.Textout((fWidth - round(OpenGL_ASCII_Font.TextWidth(s))) Div 2, 24, s);
+ // Die Prozentzahl
+ s := inttostr(Percent) + '%';
+ OpenGL_ASCII_Font.Color := clYellow;
+ OpenGL_ASCII_Font.Textout((fWidth - round(OpenGL_ASCII_Font.TextWidth(s))) Div 2, (fHeight - round(OpenGL_ASCII_Font.TextHeight(s))) Div 2, s);
+ // Der Fortschrittsbalken
+ glTranslatef(0, 0, -atomic_EPSILON); // Der Weise Rahmen, mittels LineLoop sieht das scheiße aus, also muss der so in den Hintergrund der anderen beiden.
+ glBegin(GL_QUADS);
+ glColor3f(1, 1, 1);
+ glVertex3f(24, 82, 0);
+ glVertex3f(24, 82 + 14, 0);
+ glVertex3f(fWidth - 24, 82 + 14, 0);
+ glVertex3f(fWidth - 24, 82, 0);
+ glend;
+ glTranslatef(0, 0, atomic_EPSILON);
+ x := round((fWidth - 48 - 2) * Percent / 100);
+ glBegin(GL_QUADS);
+ glColor3f(168 / 255, 168 / 255, 168 / 255);
+ glVertex3f(24 + 1, 82 + 1, 0);
+ glVertex3f(24 + 1, 82 + 14 - 1, 0);
+ glVertex3f(24 + 1 + x, 82 + 14 - 1, 0);
+ glVertex3f(24 + 1 + x, 82 + 1, 0);
+ glend;
+ glBegin(GL_QUADS);
+ glColor3f(0, 0, 0);
+ glVertex3f(24 + 1 + x, 82 + 1, 0);
+ glVertex3f(24 + 1 + x, 82 + 14 - 1, 0);
+ glVertex3f(fWidth - 24 - 1, 82 + 14 - 1, 0);
+ glVertex3f(fWidth - 24 - 1, 82 + 1, 0);
+ glend;
+ glPopMatrix;
+ Exit2d();
+ fOwner.SwapBuffers;
+ Application.ProcessMessages;
+End;
+
+Procedure TLoaderDialog.RenderDirect();
+Var
+ x, i, j: Integer;
+ s: String;
+Begin
+ // Same as Render(), but without SwapBuffers and ProcessMessages
+ // This is for use in OnPaint, which already handles these
+
+ // CRITICAL: Ensure OpenGL context is active
+ If Not fOwner.MakeCurrent Then Begin
+ exit;
+ End;
+
+ // Enable texturing
+ glEnable(GL_TEXTURE_2D);
+ glClearColor(0.0, 0.0, 0.0, 0.0);
+ glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT);
+ glLoadIdentity();
+ glcolor4f(1, 1, 1, 1);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ Go2d(GameWidth, GameHeight);
+ glPushMatrix;
+ glTranslatef((GameWidth - fWidth) Div 2, (GameHeight - fHeight) Div 2, atomic_dialog_Layer);
+ glPushMatrix;
+ // Die "Dialogbox"
+ // 1. Zeile
+ RenderImg(24, 24, fTextures[0]); // Ecke Oben Links
+ glPushMatrix;
+ For i := 1 To (fWidth Div 24) - 2 Do Begin
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[1]); // Obere Mittlere Kante
+ End;
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[2]); // Ecke Oben Rechts
+ glPopMatrix;
+ // Zeile 2 bis N -1
+ For j := 1 To (fHeight Div 24) - 2 Do Begin
+ glTranslatef(0, 24, 0);
+ glPushMatrix;
+ RenderImg(24, 24, fTextures[3]); // Linke Kante
+ For i := 1 To (fWidth Div 24) - 2 Do Begin
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[4]); // Die Mittelstücke
+ End;
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[5]); // Rechte Kante
+ glPopMatrix;
+ End;
+ // Letzte Zeile
+ glTranslatef(0, 24, 0);
+ RenderImg(24, 24, fTextures[6]); // Ecke unten Links
+ For i := 1 To (fWidth Div 24) - 2 Do Begin
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[7]); // untere Mittlere Kante
+ End;
+ glTranslatef(24, 0, 0);
+ RenderImg(24, 24, fTextures[8]); // Ecke Unten Rechts
+ glPopMatrix;
+ // Rendern der Elemente auf dem Dialog
+ glTranslatef(0, 0, atomic_EPSILON);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ // Der Schriftzug "Loading data..."
+ s := 'Loading data...';
+ OpenGL_ASCII_Font.Color := clWhite;
+ OpenGL_ASCII_Font.Textout((fWidth - round(OpenGL_ASCII_Font.TextWidth(s))) Div 2, 24, s);
+ // Die Prozentzahl
+ s := inttostr(Percent) + '%';
+ OpenGL_ASCII_Font.Color := clYellow;
+ OpenGL_ASCII_Font.Textout((fWidth - round(OpenGL_ASCII_Font.TextWidth(s))) Div 2, (fHeight - round(OpenGL_ASCII_Font.TextHeight(s))) Div 2, s);
+ // Der Fortschrittsbalken
+ glTranslatef(0, 0, -atomic_EPSILON); // Der Weise Rahmen, mittels LineLoop sieht das scheiße aus, also muss der so in den Hintergrund der anderen beiden.
+ glBegin(GL_QUADS);
+ glColor3f(1, 1, 1);
+ glVertex3f(24, 82, 0);
+ glVertex3f(24, 82 + 14, 0);
+ glVertex3f(fWidth - 24, 82 + 14, 0);
+ glVertex3f(fWidth - 24, 82, 0);
+ glend;
+ glTranslatef(0, 0, atomic_EPSILON);
+ x := round((fWidth - 48 - 2) * Percent / 100);
+ glBegin(GL_QUADS);
+ glColor3f(168 / 255, 168 / 255, 168 / 255);
+ glVertex3f(24 + 1, 82 + 1, 0);
+ glVertex3f(24 + 1, 82 + 14 - 1, 0);
+ glVertex3f(24 + 1 + x, 82 + 14 - 1, 0);
+ glVertex3f(24 + 1 + x, 82 + 1, 0);
+ glend;
+ glBegin(GL_QUADS);
+ glColor3f(0, 0, 0);
+ glVertex3f(24 + 1 + x, 82 + 1, 0);
+ glVertex3f(24 + 1 + x, 82 + 14 - 1, 0);
+ glVertex3f(fWidth - 24 - 1, 82 + 14 - 1, 0);
+ glVertex3f(fWidth - 24 - 1, 82 + 1, 0);
+ glend;
+ glPopMatrix;
+ Exit2d();
+End;
+
+End.
+
diff --git a/client/unit1.lfm b/client/unit1.lfm
index df8df2a..86b80e3 100644
--- a/client/unit1.lfm
+++ b/client/unit1.lfm
@@ -7,7 +7,7 @@ object Form1: TForm1
Caption = 'Form1'
ClientHeight = 479
ClientWidth = 692
- FormStyle = fsStayOnTop
+ KeyPreview = True
Position = poScreenCenter
LCLVersion = '4.99.0.0'
OnCloseQuery = FormCloseQuery
diff --git a/client/unit1.pas b/client/unit1.pas
index bccef4a..a119b80 100644
--- a/client/unit1.pas
+++ b/client/unit1.pas
@@ -34,6 +34,11 @@
* Sicht auf Optionen Dialog: https://www.youtube.com/watch?v=fO9HhzhEloE
* Network Spiel aus Server Sicht: https://www.youtube.com/watch?v=cuZ2GOkse5k
*)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
Unit Unit1;
{$MODE objfpc}{$H+}
@@ -44,7 +49,7 @@
Uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
- ExtCtrls, IniPropStorage,
+ Math, ExtCtrls, IniPropStorage,
OpenGlcontext, lNetComponents, lNet,
(*
* Kommt ein Linkerfehler wegen OpenGL dann: sudo apt-get install freeglut3-dev
@@ -53,7 +58,8 @@
, uopengl_graphikengine // Die OpenGLGraphikengine ist eine Eigenproduktion von www.Corpsman.de, und kann getrennt geladen werden.
, uOpenGL_ASCII_Font
, ugame
- , uatomic_common;
+ , uatomic_common
+ , uscreens; // For TScreenEnum (sExitBomberman)
{$IFDEF AUTOMODE}
Const
@@ -107,7 +113,12 @@
Form1ShowOnce: Boolean;
FPS_Counter, LastFPS_Counter: integer;
LastFPSTime: int64;
+ fLastControlWidth, fLastControlHeight: Integer; // Track last control size to detect resize
+ fLevelStartTime: int64; // Time when current level started (for elapsed time tracking)
+ fLastPlayingTime_s: integer; // Last known playing time to detect level start
+ fGameInitialized: Boolean; // Flag to track if Game.Initialize has been called
FWishFullscreen: Boolean;
+ FAdjustingSize: Boolean;
{$IFDEF AUTOMODE}
AutomodeData: TAutomodeData;
{$ENDIF}
@@ -117,6 +128,7 @@
Function GetWorkDir(Out Directory: String): Boolean;
Procedure HideCursor(Sender: TObject);
Procedure ShowCursor(Sender: TObject);
+ Function InitializeBASS(): Boolean;
public
{ public declarations }
Procedure OnConnectToServer(Sender: TObject);
@@ -141,9 +153,8 @@
, bass
// , unit18 // Der Fortschrittsbalken während des Updates
, uatomicfont
-{$IFDEF AUTOMODE}
- , uscreens
-{$ENDIF}
+ // uscreens is now imported in main uses section (line 57) for TScreenEnum access
+ , uearlylog
;
Var
@@ -161,6 +172,8 @@
Procedure TForm1.OpenGLControl1MakeCurrent(Sender: TObject; Var Allow: boolean);
Begin
+ // Changed to llTrace to reduce log spam
+ // log('OpenGLControl1MakeCurrent allowcnt=' + inttostr(allowcnt), llTrace);
If allowcnt > 2 Then Begin
exit;
End;
@@ -171,10 +184,34 @@
ReadExtensions; // Anstatt der Extentions kann auch nur der Core geladen werden. ReadOpenGLCore;
ReadImplementationProperties;
End;
+{$IFDEF Windows}
+ // On Windows: allowcnt = 2 (exactly 2) and call Game.Initialize directly here
If allowcnt = 2 Then Begin // Dieses If Sorgt mit dem obigen dafür, dass der Code nur 1 mal ausgeführt wird.
+ log('Initializing OpenGL resources (allowcnt=' + inttostr(allowcnt) + ')', llInfo);
OpenGL_GraphikEngine.clear;
- Create_ASCII_Font;
- AtomicFont.CreateFont;
+ // EarlyLog('OpenGLControl1MakeCurrent: Creating ASCII font...');
+ Try
+ Create_ASCII_Font;
+ // If Assigned(OpenGL_ASCII_Font) Then
+ // EarlyLog('OpenGLControl1MakeCurrent: ASCII font created successfully')
+ // Else
+ // EarlyLog('OpenGLControl1MakeCurrent: WARNING - ASCII font is Nil after creation');
+ Except
+ On E: Exception Do Begin
+ // EarlyLog('OpenGLControl1MakeCurrent: ERROR creating ASCII font: ' + E.Message);
+ // log('ERROR creating ASCII font: ' + E.Message, llError);
+ End;
+ End;
+ // EarlyLog('OpenGLControl1MakeCurrent: Creating AtomicFont...');
+ Try
+ AtomicFont.CreateFont;
+ // EarlyLog('OpenGLControl1MakeCurrent: AtomicFont.CreateFont completed without exception');
+ Except
+ On E: Exception Do Begin
+ // EarlyLog('OpenGLControl1MakeCurrent: ERROR creating AtomicFont: ' + E.Message);
+ // log('ERROR creating AtomicFont: ' + E.Message, llError);
+ End;
+ End;
glenable(GL_TEXTURE_2D); // Texturen
glEnable(GL_DEPTH_TEST); // Tiefentest
glDepthFunc(gl_less);
@@ -186,73 +223,371 @@
Game.initialize(OpenGLControl1);
Timer1.Enabled := true;
End;
+{$ELSE}
+ // On macOS: allowcnt >= 1 and Game.Initialize will be called from OnIdle
+ If (allowcnt >= 1) And (Not Initialized) Then Begin // Ensure initialization runs once when the context becomes available.
+ // log('Initializing OpenGL resources (allowcnt=' + inttostr(allowcnt) + ')', llInfo);
+ OpenGL_GraphikEngine.clear;
+ // EarlyLog('OpenGLControl1MakeCurrent: Creating ASCII font...');
+ Try
+ Create_ASCII_Font;
+ // If Assigned(OpenGL_ASCII_Font) Then
+ // EarlyLog('OpenGLControl1MakeCurrent: ASCII font created successfully')
+ // Else
+ // EarlyLog('OpenGLControl1MakeCurrent: WARNING - ASCII font is Nil after creation');
+ Except
+ On E: Exception Do Begin
+ // EarlyLog('OpenGLControl1MakeCurrent: ERROR creating ASCII font: ' + E.Message);
+ // log('ERROR creating ASCII font: ' + E.Message, llError);
+ End;
+ End;
+ // EarlyLog('OpenGLControl1MakeCurrent: Creating AtomicFont...');
+ Try
+ AtomicFont.CreateFont;
+ // EarlyLog('OpenGLControl1MakeCurrent: AtomicFont.CreateFont completed without exception');
+ Except
+ On E: Exception Do Begin
+ // EarlyLog('OpenGLControl1MakeCurrent: ERROR creating AtomicFont: ' + E.Message);
+ // log('ERROR creating AtomicFont: ' + E.Message, llError);
+ End;
+ End;
+ glenable(GL_TEXTURE_2D); // Texturen
+ glEnable(GL_DEPTH_TEST); // Tiefentest
+ glDepthFunc(gl_less);
+ glBlendFunc(gl_one, GL_ONE_MINUS_SRC_ALPHA); // Sorgt dafür, dass Voll Transparente Pixel nicht in den Tiefenpuffer Schreiben.
+
+ // Der Anwendung erlauben zu Rendern.
+ Initialized := True;
+ OpenGLControl1Resize(Nil);
+ Timer1.Enabled := true;
+ // NOTE: On macOS, Game.Initialize is called from Application.OnIdle
+ // This ensures Application.Run is active, so OnPaint can be called during initialization
+ fGameInitialized := false; // Will be set to true in OnIdle after Game.Initialize completes
+ End;
+{$ENDIF}
Form1.Invalidate;
End;
Procedure TForm1.OpenGLControl1Paint(Sender: TObject);
Var
s: String;
+ CurrentPlayingTime: Integer;
+ // ElapsedMs, ElapsedSeconds, Minutes, Seconds: Integer;
Begin
(*
* Unter Windows kann es vorkommen, dass dieses OnPaint ausgelöst wird obwohl wir noch am Laden in OpenGLControl1MakeCurrent sind
* Wenn das Passiert, bekommt der User eine Fehlermeldung die nicht stimmt.
*
* Zum Glück kann man das Abfangen in dem man hier den Timer1 abprüft und das so verhindert ;)
+ *
+ * NOTE: Allow rendering during initialization to show loading dialog (critical on macOS and Windows)
*)
If Not Timer1.Enabled Then exit;
- If Not Initialized Then Exit;
+ // Allow rendering loading dialog even if Initialized is false (during Game.Initialize on macOS)
+ // On macOS, Initialized may be false but Game.Initialize is in progress
+ If Not Initialized And (Not Assigned(Game) Or Not Assigned(Game.LoaderDialog) Or Game.IsInitialized) Then Exit;
+ // On Windows, Game.Initialize is called from OpenGLControl1MakeCurrent, so if Initialized is true
+ // but Game is not initialized yet, we should wait (though this should not happen)
+{$IFDEF Windows}
+ If Initialized And (Not Assigned(Game) Or (Assigned(Game) And Not Game.IsInitialized And Not Assigned(Game.LoaderDialog))) Then Exit;
+{$ENDIF}
+
+ // Check if window size changed and update viewport if needed
+ If (OpenGLControl1.ClientWidth <> fLastControlWidth) Or
+ (OpenGLControl1.ClientHeight <> fLastControlHeight) Then Begin
+ OpenGLControl1Resize(Nil);
+ End;
+
// Render Szene
glClearColor(0.0, 0.0, 0.0, 0.0);
glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT);
glLoadIdentity();
glcolor4f(1, 1, 1, 1);
glBindTexture(GL_TEXTURE_2D, 0);
- Game.Render();
- If Game.Settings.ShowFPS Then Begin
+ // Render loading dialog during initialization, otherwise render game
+ If Assigned(Game) And Assigned(Game.LoaderDialog) And Not Game.IsInitialized Then Begin
+ // Render loading dialog directly during initialization (critical for macOS visibility)
+ // EarlyLog('OpenGLControl1Paint: Rendering LoaderDialog');
+ Game.LoaderDialog.RenderDirect();
+ // EarlyLog('OpenGLControl1Paint: LoaderDialog rendered');
+ End Else If Assigned(Game) And Game.IsInitialized Then Begin
+ Game.Render();
+ End Else Begin
+ // EarlyLog('OpenGLControl1Paint: Not rendering - Game=' + BoolToStr(Assigned(Game), true) +
+ // ', LoaderDialog=' + BoolToStr(Assigned(Game) And Assigned(Game.LoaderDialog), true) +
+ // ', IsInitialized=' + BoolToStr(Assigned(Game) And Game.IsInitialized, true));
+ End;
+ If Assigned(Game) And Game.IsInitialized And Game.Settings.ShowFPS Then Begin
+ // Track level start time - detect when level begins (playing time resets to 0 or jumps up)
+ If Assigned(Game) Then Begin
+ CurrentPlayingTime := Game.PlayingTime_s;
+ // Detect level start: playing time reset to 0 (or -1 for infinity) when level begins
+ // or when playing time suddenly increases (new round starts)
+ If (CurrentPlayingTime >= 0) And ((fLastPlayingTime_s < 0) Or
+ (fLastPlayingTime_s > CurrentPlayingTime + 5)) Then Begin
+ // Level started (reset detected or time jumped backwards significantly)
+ fLevelStartTime := GetTickCount64();
+ End;
+ fLastPlayingTime_s := CurrentPlayingTime;
+ End;
+
Go2d(OpenGLControl1.Width, OpenGLControl1.Height);
glBindTexture(GL_TEXTURE_2D, 0);
- OpenGL_ASCII_Font.Color := clwhite;
glTranslatef(0, 0, atomic_dialog_Layer + atomic_EPSILON);
- s := 'FPS : ' + inttostr(LastFPS_Counter);
-{$IFDEF DebuggMode}
- If game.fPlayer[1].UID = -1 Then Begin // Wenn der Spieler 1 eine AI ist ..
- s := s + format(' AI: %0.4f %0.4f', [game.fPlayer[1].Info.Position.x, game.fPlayer[1].Info.Position.y]);
+
+ // === ENHANCED DEBUG OVERLAY - BOTTOM OF SCREEN ===
+ // Use AtomicFont for larger, more readable text
+ AtomicFont.Color := clWhite;
+
+ // First line: FPS and Network stats with MAX values
+ s := 'FPS: ' + inttostr(LastFPS_Counter);
+ If Assigned(Game) Then Begin
+ s := s + format(' | RTT: %dms (max %dms)', [Game.fDebugStats.LastRTT, Game.fDebugStats.MaxRTT]);
+ s := s + format(' | Snap: %dms (max %dms)', [Game.fDebugStats.SnapshotAge, Game.fDebugStats.MaxSnapAge]);
End;
-{$ENDIF}
- OpenGL_ASCII_Font.Textout(5, 5, s);
+ AtomicFont.Textout(10, OpenGLControl1.Height - 60, s);
+
+ // Second line: Interpolation stats with MAX
+ If Assigned(Game) Then Begin
+ s := format('Interp: %.2f (max %.2f)', [Game.fDebugStats.InterpolationFactor, Game.fDebugStats.MaxInterpFactor]);
+ If Game.fDebugStats.IsExtrapolating Then
+ s := s + ' [EXTRAPOLATING]'
+ Else
+ s := s + ' [interpolating]';
+ AtomicFont.Textout(10, OpenGLControl1.Height - 40, s);
+ End;
+
+ // Third line: Viewport info (if in debug mode)
+ {$IFDEF DebuggMode}
+ If Assigned(Game) Then Begin
+ s := 'Viewport: ' + inttostr(OpenGLControl1.ClientWidth) + 'x' + inttostr(OpenGLControl1.ClientHeight);
+ s := s + ' | Game: ' + inttostr(Game.DebugViewportWidth) + 'x' + inttostr(Game.DebugViewportHeight);
+ s := s + format(' Scale: %.2f', [Game.DebugViewportScale]);
+ AtomicFont.Textout(10, OpenGLControl1.Height - 20, s);
+
+ // AI position debug
+ If game.fPlayer[1].UID = -1 Then Begin
+ s := format('AI: %.2f, %.2f', [game.fPlayer[1].Info.Position.x, game.fPlayer[1].Info.Position.y]);
+ OpenGL_ASCII_Font.Textout(10, OpenGLControl1.Height - 5, s);
+ End;
+ End;
+ {$ENDIF}
Exit2d();
End;
OpenGLControl1.SwapBuffers;
End;
Procedure TForm1.OpenGLControl1Resize(Sender: TObject);
+Var
+ ControlW, ControlH: Integer;
+ ScaleX, ScaleY, UniformScale: Double;
+ ViewportWidth, ViewportHeight: Integer;
+ OffsetX, OffsetY: Integer;
Begin
- If Initialized Then Begin
+ ControlW := OpenGLControl1.ClientWidth;
+ ControlH := OpenGLControl1.ClientHeight;
+ If ControlW <= 0 Then ControlW := GameWidth;
+ If ControlH <= 0 Then ControlH := GameHeight;
+
+ ScaleX := ControlW / GameWidth;
+ ScaleY := ControlH / GameHeight;
+ If ScaleX < ScaleY Then
+ UniformScale := ScaleX
+ Else
+ UniformScale := ScaleY;
+ If UniformScale <= 0 Then
+ UniformScale := 1;
+
+ ViewportWidth := Round(GameWidth * UniformScale);
+ ViewportHeight := Round(GameHeight * UniformScale);
+ If ViewportWidth < 1 Then ViewportWidth := 1;
+ If ViewportHeight < 1 Then ViewportHeight := 1;
+ If ViewportWidth > ControlW Then ViewportWidth := ControlW;
+ If ViewportHeight > ControlH Then ViewportHeight := ControlH;
+
+ OffsetX := (ControlW - ViewportWidth) div 2;
+ OffsetY := (ControlH - ViewportHeight) div 2;
+
+ // Always set viewport if OpenGL context is available
+ // CRITICAL: Set projection matrix to fixed logical dimensions (GameWidth x GameHeight)
+ // This ensures game coordinates are always the same regardless of viewport size
+ // Without this, changing viewport size changes the logical coordinate system,
+ // which affects animation timing and game speed
+ If Initialized And OpenGLControl1.MakeCurrent Then Begin
+ glViewport(OffsetX, OffsetY, ViewportWidth, ViewportHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
- glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
- gluPerspective(45.0, OpenGLControl1.Width / OpenGLControl1.Height, 0.1, 100.0);
+ // Set orthographic projection with fixed logical dimensions (GameWidth x GameHeight)
+ // This ensures that game coordinates are always the same, regardless of viewport size
+ glOrtho(0, GameWidth, GameHeight, 0, -1, 1);
glMatrixMode(GL_MODELVIEW);
End;
+
+ // Update game viewport metrics even before initialization
+ If Assigned(Game) Then
+ Game.SetViewportMetrics(ControlW, ControlH, OffsetX, OffsetY,
+ ViewportWidth, ViewportHeight);
+
+ // Track current control size to detect resize changes
+ fLastControlWidth := ControlW;
+ fLastControlHeight := ControlH;
+End;
+
+Function TForm1.InitializeBASS(): Boolean;
+Var
+ DeviceIndex: Integer;
+ DeviceInfo: BASS_DEVICEINFO;
+ ErrorCode: Integer;
+ ErrorMsg: String;
+ TriedDevices: String;
+Begin
+ Result := False;
+ TriedDevices := '';
+
+ (*
+ * BASS_DEVICE_DMIX = Allows multiple applications to write to the sound card.
+ * Without this flag, no other sound applications can run.
+ *)
+
+ // First try: Default device (-1) with DMIX flag
+ log('Trying to initialize BASS with default device (-1) and DMIX flag...', llInfo);
+{$IFDEF Windows}
+ If BASS_Init(-1, 44100, BASS_DEVICE_DMIX, 0, Nil) Then Begin
+{$ELSE}
+ If BASS_Init(-1, 44100, BASS_DEVICE_DMIX, Nil, Nil) Then Begin
+{$ENDIF}
+ log('BASS initialized successfully with default device and DMIX', llInfo);
+ Result := True;
+ Exit;
+ End;
+
+ ErrorCode := BASS_ErrorGetCode;
+ TriedDevices := 'Default device (-1)';
+ log('Failed to initialize with default device, error code: ' + IntToStr(ErrorCode), llWarning);
+
+ // Second try: Enumerate available devices and try each one with DMIX
+ log('Enumerating available audio devices...', llInfo);
+ DeviceIndex := 0;
+ While BASS_GetDeviceInfo(DeviceIndex, DeviceInfo) Do Begin
+ If (DeviceInfo.flags And BASS_DEVICE_ENABLED) <> 0 Then Begin
+ If TriedDevices <> '' Then TriedDevices := TriedDevices + ', ';
+ If Assigned(DeviceInfo.name) Then
+ TriedDevices := TriedDevices + 'Device ' + IntToStr(DeviceIndex) + ' (' + String(DeviceInfo.name) + ')'
+ Else
+ TriedDevices := TriedDevices + 'Device ' + IntToStr(DeviceIndex);
+
+ log('Trying device ' + IntToStr(DeviceIndex) + ' with DMIX...', llInfo);
+{$IFDEF Windows}
+ If BASS_Init(DeviceIndex, 44100, BASS_DEVICE_DMIX, 0, Nil) Then Begin
+{$ELSE}
+ If BASS_Init(DeviceIndex, 44100, BASS_DEVICE_DMIX, Nil, Nil) Then Begin
+{$ENDIF}
+ log('BASS initialized successfully with device ' + IntToStr(DeviceIndex) + ' and DMIX', llInfo);
+ Result := True;
+ Exit;
+ End;
+ ErrorCode := BASS_ErrorGetCode;
+ log('Failed to initialize device ' + IntToStr(DeviceIndex) + ', error code: ' + IntToStr(ErrorCode), llWarning);
+ End;
+ Inc(DeviceIndex);
+ End;
+
+ // Third try: Default device without DMIX flag (fallback)
+ log('Trying default device without DMIX flag (fallback)...', llInfo);
+{$IFDEF Windows}
+ If BASS_Init(-1, 44100, 0, 0, Nil) Then Begin
+{$ELSE}
+ If BASS_Init(-1, 44100, 0, Nil, Nil) Then Begin
+{$ENDIF}
+ log('BASS initialized successfully with default device without DMIX (note: other sound apps may not work)', llWarning);
+ Result := True;
+ Exit;
+ End;
+
+ ErrorCode := BASS_ErrorGetCode;
+
+ // Fourth try: Enumerate devices without DMIX
+ log('Trying available devices without DMIX flag...', llInfo);
+ DeviceIndex := 0;
+ While BASS_GetDeviceInfo(DeviceIndex, DeviceInfo) Do Begin
+ If (DeviceInfo.flags And BASS_DEVICE_ENABLED) <> 0 Then Begin
+ log('Trying device ' + IntToStr(DeviceIndex) + ' without DMIX...', llInfo);
+{$IFDEF Windows}
+ If BASS_Init(DeviceIndex, 44100, 0, 0, Nil) Then Begin
+{$ELSE}
+ If BASS_Init(DeviceIndex, 44100, 0, Nil, Nil) Then Begin
+{$ENDIF}
+ log('BASS initialized successfully with device ' + IntToStr(DeviceIndex) + ' without DMIX', llWarning);
+ Result := True;
+ Exit;
+ End;
+ ErrorCode := BASS_ErrorGetCode;
+ End;
+ Inc(DeviceIndex);
+ End;
+
+ // All attempts failed - show detailed error message
+ ErrorMsg := 'Unable to initialize audio device.' + LineEnding + LineEnding;
+ ErrorMsg := ErrorMsg + 'Error code: ' + IntToStr(ErrorCode);
+ Case ErrorCode Of
+ 23: ErrorMsg := ErrorMsg + ' (BASS_ERROR_DEVICE - illegal device number)';
+ 3: ErrorMsg := ErrorMsg + ' (BASS_ERROR_DRIVER - cannot find a free sound driver)';
+ 8: ErrorMsg := ErrorMsg + ' (BASS_ERROR_INIT - BASS_Init has not been successfully called)';
+ 11: ErrorMsg := ErrorMsg + ' (BASS_ERROR_REINIT - device needs to be reinitialized)';
+ 46: ErrorMsg := ErrorMsg + ' (BASS_ERROR_BUSY - the device is busy)';
+ 49: ErrorMsg := ErrorMsg + ' (BASS_ERROR_DENIED - access denied)';
+ Else ErrorMsg := ErrorMsg + ' (unknown error)';
+ End;
+ ErrorMsg := ErrorMsg + LineEnding + LineEnding;
+ ErrorMsg := ErrorMsg + 'Tried devices: ' + TriedDevices;
+ ErrorMsg := ErrorMsg + LineEnding + LineEnding;
+ ErrorMsg := ErrorMsg + 'Possible solutions:' + LineEnding;
+ ErrorMsg := ErrorMsg + '1. Check if audio device is available and not used by another application' + LineEnding;
+ ErrorMsg := ErrorMsg + '2. Restart the application' + LineEnding;
+ ErrorMsg := ErrorMsg + '3. Check audio driver installation' + LineEnding;
+ ErrorMsg := ErrorMsg + '4. On Linux: ensure ALSA/PulseAudio is properly configured';
+
+ log(ErrorMsg, llError);
+ showmessage(ErrorMsg);
End;
Procedure TForm1.FormCreate(Sender: TObject);
Var
FileloggingDir: String;
i: integer;
+ AutoLogFile: String;
+ ConfigDirUsed: String;
+{$IFDEF DARWIN}
+ ConfigDir: String;
+{$ENDIF}
Begin
Randomize;
ConnectParamsHandled := false;
Initialized := false; // Wenn True dann ist OpenGL initialisiert
Form1ShowOnce := true;
- IniPropStorage1.IniFileName := 'fpc_atomic.ini';
+ FAdjustingSize := false;
+ fGameInitialized := false; // Game.Initialize will be called from OnIdle
+ FileloggingDir := '';
+ AutoLogFile := '';
+ ConfigDirUsed := '';
+{$IFDEF DARWIN}
+ ConfigDir := IncludeTrailingPathDelimiter(GetUserDir) + 'Library/Application Support/fpc_atomic/';
+ If Not ForceDirectoriesUTF8(ConfigDir) Then
+ ConfigDir := IncludeTrailingPathDelimiter(GetAppConfigDirUTF8(False));
+ If (ConfigDir <> '') And ForceDirectoriesUTF8(ConfigDir) Then Begin
+ IniPropStorage1.IniFileName := ConfigDir + 'fpc_atomic.ini';
+ ConfigDirUsed := ConfigDir;
+ AutoLogFile := ConfigDir + 'debug.log';
+ End
+ Else
+{$ENDIF}
+ IniPropStorage1.IniFileName := 'fpc_atomic.ini';
DefFormat := DefaultFormatSettings;
DefFormat.DecimalSeparator := '.';
LogShowHandler := @ShowUserMessage;
fUserMessages := Nil;
DefaultFormatSettings.DecimalSeparator := '.';
InitLogger();
- FileloggingDir := '';
For i := 1 To Paramcount Do Begin
{$IFDEF Windows}
If lowercase(ParamStrUTF8(i)) = '-c' Then Begin
@@ -283,10 +618,19 @@
End;
End;
End;
+ If (FileloggingDir = '') And (AutoLogFile <> '') Then Begin
+ FileloggingDir := AutoLogFile;
+ SetLoggerLogFile(FileloggingDir);
+ End;
+ If ConfigDirUsed <> '' Then
+ log('Using config dir: ' + ConfigDirUsed, llInfo);
log('TForm1.FormCreate', llInfo);
log('TForm1.FormCreate', lltrace);
If FileloggingDir = '' Then Begin
log('Disabled, file logging.', llWarning);
+ End
+ Else Begin
+ log('Writing log to: ' + FileloggingDir, llInfo);
End;
caption := defCaption;
@@ -295,17 +639,8 @@
halt;
End;
- (*
- BASS_DEVICE_DMIX = Erlaubt das Mehrfache Beschreiben auf die Soundkarte.
- Ohne dieses Flag, können keine anderen Sound anwendungen mehr laufen.
- *)
-{$IFDEF Windows}
- If Not Bass_init(-1, 44100, BASS_DEVICE_DMIX, 0, Nil) Then Begin
-{$ELSE}
- // Steht der Compiler auf Object Pascal mus diese Zeile genommen werden.
- If Not Bass_init(-1, 44100, BASS_DEVICE_DMIX, Nil, Nil) Then Begin
-{$ENDIF}
- showmessage('Unable to init the device, Error code :' + inttostr(BASS_ErrorGetCode));
+ // Try to initialize BASS with better error handling and fallback options
+ If Not InitializeBASS() Then Begin
halt;
End;
@@ -313,6 +648,11 @@
ClientHeight := 480;
Tform(self).Constraints.MinHeight := 480;
Tform(self).Constraints.Minwidth := 640;
+{$IFDEF Darwin}
+ // Prevent fullscreen mode by limiting window size (prevents "Game Mode" activation)
+ Tform(self).Constraints.MaxWidth := Screen.Width - 1;
+ Tform(self).Constraints.MaxHeight := Screen.Height - 1;
+{$ENDIF}
// Init dglOpenGL.pas , Teil 1
If Not InitOpenGl Then Begin
LogShow('Error, could not init dglOpenGL.pas', llfatal);
@@ -327,6 +667,10 @@
*)
Timer1.Interval := 17;
OpenGLControl1.Align := alClient;
+ fLastControlWidth := 0;
+ fLastControlHeight := 0;
+ fLevelStartTime := 0;
+ fLastPlayingTime_s := -1;
Game := TGame.Create();
game.OnNeedHideCursor := @HideCursor;
game.OnNeedShowCursor := @ShowCursor;
@@ -377,20 +721,42 @@
Procedure TForm1.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
log('TForm1.FormCloseQuery', llTrace);
- // Todo: Speichern der Map, oder wenigstens Nachfragen ob gespeichert werden soll
- log('Shuting down.', llInfo);
- IniPropStorage1.WriteInteger('ProtocollVersion', ProtocollVersion);
- IniPropStorage1.WriteString('Version', Version);
- //setValue('MainForm', 'Left', inttostr(Form1.left));
- //setValue('MainForm', 'Top', inttostr(Form1.top));
- //setValue('MainForm', 'Width', inttostr(Form1.Width));
- //setValue('MainForm', 'Height', inttostr(Form1.Height));
-
- timer1.Enabled := false;
- Initialized := false;
- // Eine Evtl bestehende Verbindung Kappen, so lange die LCL und alles andere noch Lebt.
- Game.Disconnect;
- Game.OnIdle;
+
+ // If NeedFormClose is already true, user has confirmed exit via menu/ESC
+ // Allow the close to proceed normally
+ If NeedFormClose Then Begin
+ log('Shuting down (user confirmed exit).', llInfo);
+ IniPropStorage1.WriteInteger('ProtocollVersion', ProtocollVersion);
+ IniPropStorage1.WriteString('Version', Version);
+ //setValue('MainForm', 'Left', inttostr(Form1.left));
+ //setValue('MainForm', 'Top', inttostr(Form1.top));
+ //setValue('MainForm', 'Width', inttostr(Form1.Width));
+ //setValue('MainForm', 'Height', inttostr(Form1.Height));
+
+ timer1.Enabled := false;
+ Initialized := false;
+ // Eine Evtl bestehende Verbindung Kappen, so lange die LCL und alles andere noch Lebt.
+ Game.Disconnect;
+ Game.OnIdle;
+ LogLeave;
+ Exit; // Allow close to proceed
+ End;
+
+ // User clicked window close button - show confirmation dialog
+ log('Window close button clicked, showing confirmation dialog', llInfo);
+ CanClose := false; // Prevent immediate close
+
+ // Show the same dialog as when user presses ESC or selects Exit from menu
+ If ID_YES = Application.MessageBox('Do you really want to quit?', 'Question', MB_ICONQUESTION Or MB_YESNO) Then Begin
+ // User confirmed - switch to Exit Bomberman screen
+ // This will set NeedFormClose := true, play quit sound, and then close the form
+ // TScreenEnum is available through ugame.pas which uses uscreens.pas
+ If Assigned(Game) Then Begin
+ Game.SwitchToScreen(sExitBomberman);
+ End;
+ End;
+ // If user clicked No, CanClose remains false, so window stays open
+
LogLeave;
End;
@@ -401,7 +767,26 @@
p: Pchar;
{$ENDIF}
t: int64;
+{$IFDEF Darwin}
+ MaxWidth, MaxHeight: Integer;
+{$ENDIF}
Begin
+{$IFDEF Darwin}
+ // Convert fullscreen attempt (green button click) to large windowed mode
+ If WindowState = wsFullScreen Then Begin
+ WindowState := wsNormal;
+ MaxWidth := Screen.Width - 1;
+ MaxHeight := Screen.Height - 1;
+ Tform(self).Constraints.MaxWidth := MaxWidth;
+ Tform(self).Constraints.MaxHeight := MaxHeight;
+ Left := (Screen.Width - MaxWidth) div 2;
+ Top := (Screen.Height - MaxHeight) div 2;
+ Width := MaxWidth;
+ Height := MaxHeight;
+ fWishFullscreen := True;
+ Game.Settings.Fullscreen := True;
+ End;
+{$ENDIF}
If Initialized Then Begin
inc(FPS_Counter);
t := GetTickCount64();
@@ -430,6 +815,32 @@
i, port: Integer;
msg, ip: String;
Begin
+ // CRITICAL: On macOS, Game.Initialize must be called from OnIdle (after Application.Run starts)
+ // This ensures OnPaint can be called during initialization to show the loading dialog
+ // On Windows, Game.Initialize is called directly from OpenGLControl1MakeCurrent
+{$IFNDEF Windows}
+ If Not fGameInitialized And Initialized And Assigned(Game) Then Begin
+ // Ensure OpenGL context is active before initializing (required for texture loading)
+ // On macOS, context might not be ready immediately after Application.Run starts
+ If Not OpenGLControl1.MakeCurrent Then Begin
+ // Context not ready yet, try again next time
+ exit;
+ End;
+ fGameInitialized := true; // Set flag first to prevent re-entry
+ // Initialize game - this will load textures and create loading dialog
+ // All texture loading happens here, so context must be active
+ Game.initialize(OpenGLControl1);
+ // Process messages to allow OnPaint to render loading dialog
+ // This is critical on macOS to show loading progress
+ Application.ProcessMessages;
+ End;
+{$ENDIF}
+
+ // Process incoming network chunks from network thread
+ If Assigned(Game) Then Begin
+ Game.ChunkManager.ProcessIncomingChunks();
+ End;
+
{$IFDEF AUTOMODE}
Case AutomodeData.State Of
AM_Idle: Begin
@@ -557,6 +968,40 @@
Game.Settings.Keys[ks1].AchsisIdle[1] := IniPropStorage1.readInteger('SDL_LeftRightIdle2', Game.Settings.Keys[ks1].AchsisIdle[1]);
Game.Settings.Keys[ks1].AchsisDirection[1] := IniPropStorage1.readInteger('SDL_LeftRightDirection2', Game.Settings.Keys[ks1].AchsisDirection[1]);
End;
+ // Load joystick mappings for ksJoy1
+ Game.Settings.Keys[ksJoy1] := AtomicDefaultKeys(ksJoy1);
+ Game.Settings.Keys[ksJoy1].UseSDL2 := IniPropStorage1.ReadBoolean('UseSDLJoy1', Game.Settings.Keys[ksJoy1].UseSDL2);
+ If Game.Settings.Keys[ksJoy1].UseSDL2 Then Begin
+ Game.Settings.Keys[ksJoy1].Name := IniPropStorage1.ReadString('SDL_NameJoy1', Game.Settings.Keys[ksJoy1].Name);
+ Game.Settings.Keys[ksJoy1].NameIndex := IniPropStorage1.readInteger('SDL_NameIndexJoy1', Game.Settings.Keys[ksJoy1].NameIndex);
+ Game.Settings.Keys[ksJoy1].ButtonIndex[0] := IniPropStorage1.readInteger('SDL_FirstJoy1', Game.Settings.Keys[ksJoy1].ButtonIndex[0]);
+ Game.Settings.Keys[ksJoy1].ButtonsIdle[0] := IniPropStorage1.ReadBoolean('SDL_FirstIdleJoy1', Game.Settings.Keys[ksJoy1].ButtonsIdle[0]);
+ Game.Settings.Keys[ksJoy1].ButtonIndex[1] := IniPropStorage1.readInteger('SDL_SecondJoy1', Game.Settings.Keys[ksJoy1].ButtonIndex[1]);
+ Game.Settings.Keys[ksJoy1].ButtonsIdle[1] := IniPropStorage1.ReadBoolean('SDL_SecondIdleJoy1', Game.Settings.Keys[ksJoy1].ButtonsIdle[1]);
+ Game.Settings.Keys[ksJoy1].AchsisIndex[0] := IniPropStorage1.readInteger('SDL_UpDownJoy1', Game.Settings.Keys[ksJoy1].AchsisIndex[0]);
+ Game.Settings.Keys[ksJoy1].AchsisIdle[0] := IniPropStorage1.readInteger('SDL_UpDownIdleJoy1', Game.Settings.Keys[ksJoy1].AchsisIdle[0]);
+ Game.Settings.Keys[ksJoy1].AchsisDirection[0] := IniPropStorage1.readInteger('SDL_UpDownDirectionJoy1', Game.Settings.Keys[ksJoy1].AchsisDirection[0]);
+ Game.Settings.Keys[ksJoy1].AchsisIndex[1] := IniPropStorage1.readInteger('SDL_LeftRightJoy1', Game.Settings.Keys[ksJoy1].AchsisIndex[1]);
+ Game.Settings.Keys[ksJoy1].AchsisIdle[1] := IniPropStorage1.readInteger('SDL_LeftRightIdleJoy1', Game.Settings.Keys[ksJoy1].AchsisIdle[1]);
+ Game.Settings.Keys[ksJoy1].AchsisDirection[1] := IniPropStorage1.readInteger('SDL_LeftRightDirectionJoy1', Game.Settings.Keys[ksJoy1].AchsisDirection[1]);
+ End;
+ // Load joystick mappings for ksJoy2
+ Game.Settings.Keys[ksJoy2] := AtomicDefaultKeys(ksJoy2);
+ Game.Settings.Keys[ksJoy2].UseSDL2 := IniPropStorage1.ReadBoolean('UseSDLJoy2', Game.Settings.Keys[ksJoy2].UseSDL2);
+ If Game.Settings.Keys[ksJoy2].UseSDL2 Then Begin
+ Game.Settings.Keys[ksJoy2].Name := IniPropStorage1.ReadString('SDL_NameJoy2', Game.Settings.Keys[ksJoy2].Name);
+ Game.Settings.Keys[ksJoy2].NameIndex := IniPropStorage1.readInteger('SDL_NameIndexJoy2', Game.Settings.Keys[ksJoy2].NameIndex);
+ Game.Settings.Keys[ksJoy2].ButtonIndex[0] := IniPropStorage1.readInteger('SDL_FirstJoy2', Game.Settings.Keys[ksJoy2].ButtonIndex[0]);
+ Game.Settings.Keys[ksJoy2].ButtonsIdle[0] := IniPropStorage1.ReadBoolean('SDL_FirstIdleJoy2', Game.Settings.Keys[ksJoy2].ButtonsIdle[0]);
+ Game.Settings.Keys[ksJoy2].ButtonIndex[1] := IniPropStorage1.readInteger('SDL_SecondJoy2', Game.Settings.Keys[ksJoy2].ButtonIndex[1]);
+ Game.Settings.Keys[ksJoy2].ButtonsIdle[1] := IniPropStorage1.ReadBoolean('SDL_SecondIdleJoy2', Game.Settings.Keys[ksJoy2].ButtonsIdle[1]);
+ Game.Settings.Keys[ksJoy2].AchsisIndex[0] := IniPropStorage1.readInteger('SDL_UpDownJoy2', Game.Settings.Keys[ksJoy2].AchsisIndex[0]);
+ Game.Settings.Keys[ksJoy2].AchsisIdle[0] := IniPropStorage1.readInteger('SDL_UpDownIdleJoy2', Game.Settings.Keys[ksJoy2].AchsisIdle[0]);
+ Game.Settings.Keys[ksJoy2].AchsisDirection[0] := IniPropStorage1.readInteger('SDL_UpDownDirectionJoy2', Game.Settings.Keys[ksJoy2].AchsisDirection[0]);
+ Game.Settings.Keys[ksJoy2].AchsisIndex[1] := IniPropStorage1.readInteger('SDL_LeftRightJoy2', Game.Settings.Keys[ksJoy2].AchsisIndex[1]);
+ Game.Settings.Keys[ksJoy2].AchsisIdle[1] := IniPropStorage1.readInteger('SDL_LeftRightIdleJoy2', Game.Settings.Keys[ksJoy2].AchsisIdle[1]);
+ Game.Settings.Keys[ksJoy2].AchsisDirection[1] := IniPropStorage1.readInteger('SDL_LeftRightDirectionJoy2', Game.Settings.Keys[ksJoy2].AchsisDirection[1]);
+ End;
Game.Settings.ShowFPS := IniPropStorage1.ReadBoolean('ShowFPS', false);
Game.Settings.CheckForUpdates := IniPropStorage1.ReadBoolean('CheckForUpdates', true);
Game.Settings.LastPlayedField := IniPropStorage1.ReadString('LastPlayedField', '');
@@ -638,6 +1083,38 @@
IniPropStorage1.WriteInteger('SDL_LeftRight2', Game.Settings.Keys[ks1].AchsisIndex[1]);
IniPropStorage1.WriteInteger('SDL_LeftRightIdle2', Game.Settings.Keys[ks1].AchsisIdle[1]);
IniPropStorage1.WriteInteger('SDL_LeftRightDirection2', Game.Settings.Keys[ks1].AchsisDirection[1]);
+ // Save joystick mappings for ksJoy1
+ IniPropStorage1.WriteBoolean('UseSDLJoy1', Game.Settings.Keys[ksJoy1].UseSDL2);
+ If Game.Settings.Keys[ksJoy1].UseSDL2 Then Begin
+ IniPropStorage1.WriteString('SDL_NameJoy1', Game.Settings.Keys[ksJoy1].Name);
+ IniPropStorage1.WriteInteger('SDL_NameIndexJoy1', Game.Settings.Keys[ksJoy1].NameIndex);
+ IniPropStorage1.WriteInteger('SDL_FirstJoy1', Game.Settings.Keys[ksJoy1].ButtonIndex[0]);
+ IniPropStorage1.WriteBoolean('SDL_FirstIdleJoy1', Game.Settings.Keys[ksJoy1].ButtonsIdle[0]);
+ IniPropStorage1.WriteInteger('SDL_SecondJoy1', Game.Settings.Keys[ksJoy1].ButtonIndex[1]);
+ IniPropStorage1.WriteBoolean('SDL_SecondIdleJoy1', Game.Settings.Keys[ksJoy1].ButtonsIdle[1]);
+ IniPropStorage1.WriteInteger('SDL_UpDownJoy1', Game.Settings.Keys[ksJoy1].AchsisIndex[0]);
+ IniPropStorage1.WriteInteger('SDL_UpDownIdleJoy1', Game.Settings.Keys[ksJoy1].AchsisIdle[0]);
+ IniPropStorage1.WriteInteger('SDL_UpDownDirectionJoy1', Game.Settings.Keys[ksJoy1].AchsisDirection[0]);
+ IniPropStorage1.WriteInteger('SDL_LeftRightJoy1', Game.Settings.Keys[ksJoy1].AchsisIndex[1]);
+ IniPropStorage1.WriteInteger('SDL_LeftRightIdleJoy1', Game.Settings.Keys[ksJoy1].AchsisIdle[1]);
+ IniPropStorage1.WriteInteger('SDL_LeftRightDirectionJoy1', Game.Settings.Keys[ksJoy1].AchsisDirection[1]);
+ End;
+ // Save joystick mappings for ksJoy2
+ IniPropStorage1.WriteBoolean('UseSDLJoy2', Game.Settings.Keys[ksJoy2].UseSDL2);
+ If Game.Settings.Keys[ksJoy2].UseSDL2 Then Begin
+ IniPropStorage1.WriteString('SDL_NameJoy2', Game.Settings.Keys[ksJoy2].Name);
+ IniPropStorage1.WriteInteger('SDL_NameIndexJoy2', Game.Settings.Keys[ksJoy2].NameIndex);
+ IniPropStorage1.WriteInteger('SDL_FirstJoy2', Game.Settings.Keys[ksJoy2].ButtonIndex[0]);
+ IniPropStorage1.WriteBoolean('SDL_FirstIdleJoy2', Game.Settings.Keys[ksJoy2].ButtonsIdle[0]);
+ IniPropStorage1.WriteInteger('SDL_SecondJoy2', Game.Settings.Keys[ksJoy2].ButtonIndex[1]);
+ IniPropStorage1.WriteBoolean('SDL_SecondIdleJoy2', Game.Settings.Keys[ksJoy2].ButtonsIdle[1]);
+ IniPropStorage1.WriteInteger('SDL_UpDownJoy2', Game.Settings.Keys[ksJoy2].AchsisIndex[0]);
+ IniPropStorage1.WriteInteger('SDL_UpDownIdleJoy2', Game.Settings.Keys[ksJoy2].AchsisIdle[0]);
+ IniPropStorage1.WriteInteger('SDL_UpDownDirectionJoy2', Game.Settings.Keys[ksJoy2].AchsisDirection[0]);
+ IniPropStorage1.WriteInteger('SDL_LeftRightJoy2', Game.Settings.Keys[ksJoy2].AchsisIndex[1]);
+ IniPropStorage1.WriteInteger('SDL_LeftRightIdleJoy2', Game.Settings.Keys[ksJoy2].AchsisIdle[1]);
+ IniPropStorage1.WriteInteger('SDL_LeftRightDirectionJoy2', Game.Settings.Keys[ksJoy2].AchsisDirection[1]);
+ End;
IniPropStorage1.WriteBoolean('ShowFPS', Game.Settings.ShowFPS);
IniPropStorage1.WriteBoolean('CheckForUpdates', Game.Settings.CheckForUpdates);
@@ -650,17 +1127,33 @@
End;
Procedure TForm1.SetFullScreen(Value: Boolean);
+Var
+ MaxWidth, MaxHeight: Integer;
Begin
If value Then Begin
- // TODO: Klären ob man unter Windows wirklich die Differenzierung braucht
-{$IFDEF Windows}
- WindowState := wsMaximized;
-{$ELSE}
- WindowState := wsFullScreen;
+ // On macOS: use large windowed mode instead of true fullscreen to avoid "Game Mode"
+ MaxWidth := Screen.Width - 1;
+ MaxHeight := Screen.Height - 1;
+{$IFDEF Darwin}
+ Tform(self).Constraints.MaxWidth := MaxWidth;
+ Tform(self).Constraints.MaxHeight := MaxHeight;
{$ENDIF}
+ Left := (Screen.Width - MaxWidth) div 2;
+ Top := (Screen.Height - MaxHeight) div 2;
+ Width := MaxWidth;
+ Height := MaxHeight;
+ WindowState := wsNormal;
End
Else Begin
+{$IFDEF Darwin}
+ Tform(self).Constraints.MaxWidth := Screen.Width - 1;
+ Tform(self).Constraints.MaxHeight := Screen.Height - 1;
+{$ENDIF}
WindowState := wsNormal;
+ Left := (Screen.Width - 640) div 2;
+ Top := (Screen.Height - 480) div 2;
+ Width := 640;
+ Height := 480;
End;
Game.Settings.Fullscreen := value;
fWishFullscreen := value;
@@ -682,10 +1175,55 @@
End;
Procedure TForm1.FormResize(Sender: TObject);
+Const
+ DesiredWidth = GameWidth;
+ DesiredHeight = GameHeight;
+Var
+ TargetHeight, TargetWidth: Integer;
+{$IFDEF Darwin}
+ MaxWidth, MaxHeight: Integer;
+{$ENDIF}
Begin
+{$IFDEF Darwin}
+ // Convert fullscreen attempt (green button click) to large windowed mode
+ If WindowState = wsFullScreen Then Begin
+ WindowState := wsNormal;
+ MaxWidth := Screen.Width - 1;
+ MaxHeight := Screen.Height - 1;
+ Tform(self).Constraints.MaxWidth := MaxWidth;
+ Tform(self).Constraints.MaxHeight := MaxHeight;
+ Left := (Screen.Width - MaxWidth) div 2;
+ Top := (Screen.Height - MaxHeight) div 2;
+ Width := MaxWidth;
+ Height := MaxHeight;
+ fWishFullscreen := True;
+ Game.Settings.Fullscreen := True;
+ Exit;
+ End;
+{$ENDIF}
+{$IFDEF Windows}
If fWishFullscreen Then Begin
WindowState := wsFullScreen;
End;
+{$ENDIF}
+ If FAdjustingSize Then
+ Exit;
+ If WindowState <> wsNormal Then
+ Exit;
+ FAdjustingSize := true;
+ Try
+ TargetHeight := Round(ClientWidth * DesiredHeight / DesiredWidth);
+ If Abs(TargetHeight - ClientHeight) > 1 Then Begin
+ ClientHeight := TargetHeight;
+ End
+ Else Begin
+ TargetWidth := Round(ClientHeight * DesiredWidth / DesiredHeight);
+ If Abs(TargetWidth - ClientWidth) > 1 Then
+ ClientWidth := TargetWidth;
+ End;
+ Finally
+ FAdjustingSize := false;
+ End;
End;
Function TForm1.GetWorkDir(Out Directory: String): Boolean;
diff --git a/client/uscreens.pas b/client/uscreens.pas
index 494b4cc..76c77c6 100644
--- a/client/uscreens.pas
+++ b/client/uscreens.pas
@@ -1,1250 +1,1351 @@
-(******************************************************************************)
-(* *)
-(* Author : Uwe Schächterle (Corpsman) *)
-(* *)
-(* This file is part of FPC_Atomic *)
-(* *)
-(* See the file license.md, located under: *)
-(* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *)
-(* for details about the license. *)
-(* *)
-(* It is not allowed to change or remove this text from any *)
-(* source file of the project. *)
-(* *)
-(******************************************************************************)
-Unit uscreens;
-
-{$MODE ObjFPC}{$H+}
-
-Interface
-
-{$I globaldefines.inc}
-
-Uses
- Classes, SysUtils, controls, uatomic_common, uopengl_animation, uatomic_field;
-
-Type
-
- (*
- * Im MainMenu die diversen Screens
- *)
- TScreenEnum = (
- sMainScreen // Hauptscreen
- //, sSinglePlayer -- ??
- , sHost // Den Gibt es gar nicht, der wird direkt auf den sJoinNetwork umgeleitet
- , sJoinNetwork // Alle Spieler gehen zusammen in das Spiel rein
- , sPlayerSetupRequest // Anfrage zum Wechsel in sPlayerSetup
- , sPlayerSetup // Die Spieler dürfen sich ihre Farben "aussuchen"
- , sEditFieldSetupRequest // Anfrage zum Einstellen der Field einstellungen
- , sEditFieldSetup // Der Master stellt die eigenschaften des fields ein
- , sDrawGame // Der Screen der Angezeigt wird wenn ein Unentschieden gespielt wurde
- , sMatchStatistik // Der Screen der die Match Statistik anzeigt
- , sVictory // Der Screen der das Wer hat gewonnen bild anzeigt
- , sOptions // Der Optionen Dialog
- //, sOnlineManual -- ??
- , sExitBomberman // byby
- );
-
- { TScreen }
-
- TScreen = Class
- private
- fOwner: TObject;
- fBackFile: String;
- fBackTex: Integer; // OpenGL Pointer der fBackFile
- fSoundFile: String;
- fSoundExitScreen: String;
- fCursorFile: String;
- public
-
- PlayerIsFirst: Boolean; // Global Verfügbar, True, wenn der Spieler "Spieler 1" ist !
-
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); virtual;
- Procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
-
- Constructor Create(Owner: TObject); virtual;
- Destructor Destroy(); override;
-
- Procedure Render; virtual;
- Procedure LoadFromDisk(ResPath: String); virtual;
-
- Procedure Reset; virtual; // Abstract
- Procedure StartPLaySong(); virtual;
- End;
-
- { TMainMenu }
-
- TMainMenu = Class(TScreen)
- private
- fCursor: TOpenGL_Animation;
- fCursorPos: integer; // Position der "Bombe" in Menüpunkten
- public
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
- Procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
-
- Constructor Create(Owner: TObject); override;
- Destructor Destroy(); override;
-
- Procedure LoadFromDisk(ResPath: String); override;
- Procedure Render; override;
- Procedure Reset; override;
- End;
-
- { TJoinMenu }
-
- TJoinMenu = Class(TScreen)
- private
- fPlayerInfoString: String; // Die Spieler die Gerade auch eingewählt sind.
-
- public
- Connected: Boolean;
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
-
- Constructor Create(Owner: TObject); override;
- Procedure LoadPlayerdata(Const PlayerData: Array Of TPlayer);
- Procedure Render; override;
- Procedure Reset; override;
- End;
-
- { TPlayerSetupMenu }
-
- TPlayerSetupMenu = Class(TScreen)
- private
- fSchemeFile: String;
- fcursorTex: integer;
- fCursorPos: integer; // Position des "Kopfes" in Menüpunkten
- fPlayerDetails: Array[0..length(PlayerColors) - 1] Of Record
- Team: Integer;
- PlayerData: String;
- End;
- public
- TeamPlay: Boolean; // True = Anzeigen der Spielerfarben als Team wird via "miSwitchToPlayerSetup" gesetzt
-
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
- // TODO: Maus Support
-
- Constructor Create(Owner: TObject); override;
-
- Procedure LoadScheme(Const Scheme: TScheme); // Wird via miUpdateScheme gesetzt
- Procedure LoadPlayerdata(Const PlayerData: TPlayers; Uid: Integer); // wird via TAtomic.SwitchToScreen gesetzt
-
- Procedure LoadFromDisk(ResPath: String); override;
-
- Procedure Render; override;
- Procedure Reset; override;
- End;
-
- { TFieldSetupMenu }
-
- TFieldSetupMenu = Class(TScreen)
- private
- fCursorPos: integer;
- fcursorTex: Integer;
- public
- MasterPlayerName: String;
- ActualField: TAtomicField;
- LastWinsToWinMatch: Integer;
- SchemeFile: String;
-
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
-
- Constructor Create(Owner: TObject); override;
-
- Procedure LoadFromDisk(ResPath: String); override;
- Procedure Render; override;
- Procedure Reset; override;
- End;
-
- { TDrawGameMenu }
-
- TDrawGameMenu = Class(TScreen)
- private
- public
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
-
- Constructor Create(Owner: TObject); override;
-
- Procedure Reset; override;
- End;
-
- { TMatchStatistikMenu }
-
- TMatchStatistikMenu = Class(TScreen)
- private
- fPlayers: TPlayers;
- public
- Victor: TVictor;
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
-
- Procedure LoadPlayerdata(Const PlayerData: TPlayers);
-
- Constructor Create(Owner: TObject); override;
-
- Procedure Render; override;
-
- End;
-
- { TVictoryMenu }
-
- TVictoryMenu = Class(TScreen)
- private
- fbackGrounds: Array[TVictor] Of Integer;
- public
- Victor: TVictor;
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
-
- Procedure LoadFromDisk(ResPath: String); override;
-
- Procedure Render; override;
- Constructor Create(Owner: TObject); override;
- End;
-
- { TOptionsMenu }
-
- TOptionsMenu = Class(TScreen)
- private
- fcursorTex: integer;
- fCursorPos: integer; // Position des "Kopfes" in Menüpunkten
- public
- Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
- Procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
-
- Constructor Create(Owner: TObject); override;
-
- Procedure LoadFromDisk(ResPath: String); override;
- Procedure Render; override;
- Procedure Reset; override;
- End;
-
-Implementation
-
-Uses LCLType, Math, Graphics, Dialogs, forms, StdCtrls, fileutil, StrUtils
- , dglOpenGL
- , Unit1 // WTF, why is this unit in here ?
- , uopengl_graphikengine
- , uatomicfont
- , uvectormath
- , ugraphics
- , ugame
- , ukeyboarddialog
- ;
-
-Type
-
- { TSchemQuestionForm }
-
- TSchemQuestionForm = Class(TForm)
- Procedure FormButton1Click(Sender: TObject);
- Procedure FormShow(Sender: Tobject);
- Procedure ListboxKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
- private
- Listbox1: TListbox;
- Button1: TButton;
- public
- Procedure LoadSchemes(SelectedScheme: String);
- // Weil die Form keine Ressource hat, muss sie mittels CreateNew erzeugt werden, was auch immer das für einen unterschied macht ...
- Constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
- End;
-
- { TJoinQuestionForm }
-
- TJoinQuestionForm = Class(TForm)
- private
- Edit1: TEdit;
- Edit2: TEdit;
- Label1: TLabel;
- Label2: TLabel;
- Button1: TButton;
- Button2: TButton;
- public
- Constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
- End;
-
- { TJoinQuestionForm }
-
-Constructor TJoinQuestionForm.CreateNew(AOwner: TComponent; Num: Integer);
-Begin
- Inherited CreateNew(AOwner, Num);
- caption := 'Enter IP-Settings';
- width := 312;
- height := 163;
- Position := poScreenCenter;
- Constraints.MaxWidth := Width;
- Constraints.MinWidth := Width;
- Constraints.MaxHeight := Height;
- Constraints.MinHeight := Height;
-
- Edit1 := TEdit.Create(self);
- edit1.name := 'Edit1';
- edit1.Parent := self;
- edit1.Top := 32;
- edit1.Left := 16;
- edit1.Width := 288;
- edit1.Text := '127.0.0.1';
-
- Edit2 := TEdit.Create(self);
- edit2.name := 'Edit2';
- edit2.Parent := self;
- edit2.Top := 88;
- edit2.Left := 16;
- edit2.Width := 288;
- edit2.Text := '9876';
-
- label1 := TLabel.Create(self);
- label1.Name := 'Label1';
- label1.Parent := self;
- label1.caption := 'IP';
- label1.top := 8;
- label1.Left := 8;
-
- label2 := TLabel.Create(self);
- label2.Name := 'Label2';
- label2.Parent := self;
- label2.caption := 'Port';
- label2.top := 64;
- label2.Left := 8;
-
- Button1 := TButton.Create(self);
- Button1.Name := 'Button1';
- Button1.Parent := self;
- Button1.caption := 'OK';
- Button1.ModalResult := mrOK;
- Button1.Top := 128;
- Button1.Left := 229;
-
- Button2 := TButton.Create(self);
- Button2.Name := 'Button2';
- Button2.Parent := self;
- Button2.caption := 'Cancel';
- Button2.ModalResult := mrCancel;
- Button2.Top := 128;
- Button2.Left := 16;
-End;
-
-{ TVictoryMenu }
-
-Procedure TVictoryMenu.OnKeyDown(Sender: TObject; Var Key: Word;
- Shift: TShiftState);
-Begin
- If (key = VK_RETURN) Or (key = VK_ESCAPE) Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- TGame(fOwner).SwitchToScreen(sMainScreen);
- End;
-End;
-
-Procedure TVictoryMenu.LoadFromDisk(ResPath: String);
-Begin
- Inherited LoadFromDisk(ResPath);
- fbackGrounds[vWhiteTeam] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'team0.png', smStretch);
- fbackGrounds[vRedTeam] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'team1.png', smStretch);
- fbackGrounds[vCol0] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory0.png', smStretch);
- fbackGrounds[vCol1] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory1.png', smStretch);
- fbackGrounds[vCol2] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory2.png', smStretch);
- fbackGrounds[vCol3] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory3.png', smStretch);
- fbackGrounds[vCol4] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory4.png', smStretch);
- fbackGrounds[vCol5] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory5.png', smStretch);
- fbackGrounds[vCol6] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory6.png', smStretch);
- fbackGrounds[vCol7] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory7.png', smStretch);
- fbackGrounds[vCol8] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory8.png', smStretch);
- fbackGrounds[vCol9] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory9.png', smStretch);
-End;
-
-Procedure TVictoryMenu.Render;
-Begin
- fBackTex := fbackGrounds[Victor];
- Inherited Render;
-End;
-
-Constructor TVictoryMenu.Create(Owner: TObject);
-Begin
- Inherited Create(Owner);
- fSoundFile := 'draw.wav';
-End;
-
-{ TMatchStatistikMenu }
-
-Procedure TMatchStatistikMenu.OnKeyDown(Sender: TObject; Var Key: Word;
- Shift: TShiftState);
-Begin
- If key = VK_ESCAPE Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- TGame(fOwner).SwitchToScreen(sMainScreen);
- End;
- If PlayerIsFirst Then Begin
- If key = VK_RETURN Then Begin
- TGame(fOwner).StartGame();
- End;
- End;
-End;
-
-Procedure TMatchStatistikMenu.LoadPlayerdata(Const PlayerData: TPlayers);
-Begin
- fPlayers := PlayerData;
-End;
-
-Constructor TMatchStatistikMenu.Create(Owner: TObject);
-Begin
- Inherited Create(Owner);
- fBackFile := 'results.png';
- fSoundFile := 'draw.wav';
-End;
-
-Procedure TMatchStatistikMenu.Render;
-
- Function VictorToString(Value: TVictor): String;
- Var
- index: integer;
- Begin
- Case Value Of
- vRedTeam: result := 'Red Team';
- vWhiteTeam: result := 'White Team';
- Else Begin
- index := integer(value) - integer(vCol0);
- result := fPlayers[index].UserName;
- If result = '' Then
- result := 'Ai';
- End;
- End;
- End;
-
-Var
- s, un: String;
- i: Integer;
-Begin
- Inherited Render;
- glpushmatrix();
- glTranslatef(0, 0, atomic_Map_Layer + 0.5);
- glBindTexture(GL_TEXTURE_2D, 0);
- glColor4f(1, 1, 1, 1);
- AtomicFont.BackColor := clBlack;
- AtomicFont.Color := $00A8ADAB;
- AtomicFont.Textout(150, 100, '(Match winner must score ' + inttostr(TGame(fOwner).Settings.LastWinsToWinMatch) + ' victories)');
- s := 'Game Winner was ' + VictorToString(Victor) + ' !';
- AtomicFont.BackColor := clBlack;
- AtomicFont.Color := clwhite;
- AtomicFont.Textout(150, 150, s);
- glPushMatrix;
- glTranslatef(130, 200, 0);
- For i := 0 To high(fPlayers) Do Begin
- If fPlayers[i].UID <> NoPlayer Then Begin
- If i = 1 Then Begin
- AtomicFont.BackColor := clWhite;
- End
- Else Begin
- AtomicFont.BackColor := clBlack;
- End;
- AtomicFont.Color := AtomicPlayerColorToColor(PlayerColors[i]);
- un := fPlayers[i].UserName;
- If un = '' Then un := 'Ai';
- un := PadRight(un, 20);
- s := format('%s: score: %d (kills: %d)', [un, fPlayers[i].Score, fPlayers[i].Kills]);
- AtomicFont.Textout(0, 0, s);
- glTranslatef(0, 20, 0);
- End;
- End;
- glPopMatrix;
- AtomicFont.BackColor := clBlack; // Reset nach außen
- glPopMatrix;
-End;
-
-{ TDrawGameMenu }
-
-Procedure TDrawGameMenu.OnKeyDown(Sender: TObject; Var Key: Word;
- Shift: TShiftState);
-Begin
- If key = VK_ESCAPE Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- Tgame(fOwner).SwitchToScreen(sMainScreen);
- End;
- If PlayerIsFirst Then Begin
- If key = VK_RETURN Then Begin
- TGame(fOwner).StartGame;
- End;
- End;
-End;
-
-Constructor TDrawGameMenu.Create(Owner: TObject);
-Begin
- Inherited Create(Owner);
- fBackFile := 'draw.png'; // WTF, warum geht das net als PNG ?
- fSoundFile := 'draw.wav';
- fCursorFile := '';
-End;
-
-Procedure TDrawGameMenu.Reset;
-Begin
- Inherited Reset;
-End;
-
-{ TSchemQuestionForm }
-
-Constructor TSchemQuestionForm.CreateNew(AOwner: TComponent; Num: Integer);
-Begin
- Inherited CreateNew(AOwner, Num);
- caption := 'Please select a scheme';
- Width := 350;
- height := 350;
- FormStyle := fsSystemStayOnTop;
- Constraints.MinHeight := height;
- Constraints.MaxHeight := height;
- Constraints.MinWidth := Width;
- Constraints.MaxWidth := Width;
- BorderIcons := [biSystemMenu];
- position := poScreenCenter;
- Button1 := TButton.Create(self);
- button1.name := 'Button1';
- Button1.Parent := self;
- Button1.Align := alBottom;
- button1.caption := 'OK';
- button1.OnClick := @FormButton1Click;
- Listbox1 := TListBox.Create(self);
- Listbox1.Name := 'Listbox1';
- Listbox1.Parent := self;
- Listbox1.Align := alClient;
- Listbox1.OnKeyDown := @ListboxKeyDown;
-
- OnShow := @FormShow;
-End;
-
-Procedure TSchemQuestionForm.FormButton1Click(Sender: TObject);
-Begin
- If Listbox1.ItemIndex <> -1 Then Begin
- ModalResult := mrOK;
- End
- Else Begin
- ModalResult := mrCancel; // Anscheinend haben wir keine Scheme files, dann versuchen wir auch nicht sie zu speichern
- End;
-End;
-
-Procedure TSchemQuestionForm.FormShow(Sender: Tobject);
-Begin
- Listbox1.SetFocus;
- (*
- * Die TopRow Eigenschaft darf erst gesetzt werden, wenn die Listbox dabei ist sich zu zeichnen
- * im LoadSchemes geht das nicht ..
- *)
- If Listbox1.ItemIndex <> -1 Then Begin
- Listbox1.TopIndex := Listbox1.ItemIndex;
- End;
-End;
-
-Procedure TSchemQuestionForm.ListboxKeyDown(Sender: TObject; Var Key: Word;
- Shift: TShiftState);
-Begin
- If key = VK_RETURN Then Begin
- key := 0; // Den Key Löschen, da der Button1.Click das Formular Platt macht und der Key sonst in TScreen nochmal ausgewertet wird.
- button1.Click;
- End;
- If key = VK_ESCAPE Then ModalResult := mrCancel;
-End;
-
-Procedure TSchemQuestionForm.LoadSchemes(SelectedScheme: String);
-Var
- p: String;
- sl: TStringList;
- i: Integer;
-Begin
- p := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'data' + PathDelim + 'schemes';
- sl := FindAllfiles(p, '*.sch', false);
- Listbox1.Clear;
- Listbox1.Sorted := true;
- For i := 0 To sl.Count - 1 Do Begin
- Listbox1.Items.Add(ExtractFileName(sl[i]));
- End;
- For i := 0 To Listbox1.Items.Count - 1 Do Begin
- If lowercase(SelectedScheme) = lowercase(Listbox1.Items[i]) Then Begin
- Listbox1.ItemIndex := i;
- break;
- End;
- End;
- sl.free;
-End;
-
-{ TFieldSetupMenu }
-
-Procedure TFieldSetupMenu.OnKeyDown(Sender: TObject; Var Key: Word;
- Shift: TShiftState);
-Begin
- If key = VK_ESCAPE Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- TGame(fOwner).SwitchToScreen(sMainScreen);
- End;
- If PlayerIsFirst Then Begin
- If key = VK_RETURN Then Begin
- TGame(fOwner).StartGame;
- End;
- If key = VK_DOWN Then Begin
- fCursorPos := min(fCursorPos + 1, 1);
- End;
- If key = VK_UP Then Begin
- fCursorPos := max(fCursorPos - 1, 0);
- End;
- If key = VK_LEFT Then Begin
- Case fCursorPos Of
- 0: TGame(fOwner).UpdateSelectedField(-1);
- 1: TGame(fOwner).UpdateWinsToWin(-1);
- End;
- End;
- If key = VK_Right Then Begin
- Case fCursorPos Of
- 0: TGame(fOwner).UpdateSelectedField(1);
- 1: TGame(fOwner).UpdateWinsToWin(1);
- End;
- End;
- End;
-End;
-
-Constructor TFieldSetupMenu.Create(Owner: TObject);
-Begin
- Inherited Create(Owner);
- ActualField := Nil;
- fBackFile := 'fieldsetup.png'; // WTF, warum geht das net als PNG ?
- fSoundFile := 'player_setup_sound.wav';
- fCursorFile := 'options_cursor.png';
-End;
-
-Procedure TFieldSetupMenu.LoadFromDisk(ResPath: String);
-Begin
- Inherited LoadFromDisk(ResPath);
- (*
- * Neu Laden der Hintergrundgraphik mit Transparenz
- *)
- OpenGL_GraphikEngine.RemoveGraphik(fBackTex);
- fBackTex := OpenGL_GraphikEngine.LoadAlphaColorGraphik(ResPath + fBackFile, ColorToRGB(clfuchsia), smStretchHard);
- fcursorTex := OpenGL_GraphikEngine.LoadAlphaColorGraphik(ResPath + fCursorFile, ColorToRGB(clfuchsia), smStretch);
-End;
-
-Procedure TFieldSetupMenu.Render;
-Begin
- // Das Vorschaubild
- glColor4f(1, 1, 1, 1);
- // Der Eigentliche Hintergrund
- glpushmatrix();
- glAlphaFunc(GL_LESS, 0.5);
- // Das ist ja eine Textur mit "Fenster" -> Also Alphatest mit an
- glEnable(GL_ALPHA_TEST);
- glTranslatef(0, 0, atomic_Map_Layer + 0.5);
- RenderAlphaQuad(v2(320, 240), GameWidth, -GameHeight, 0, fBackTex);
- gldisable(GL_ALPHA_TEST);
- glBindTexture(GL_TEXTURE_2D, 0);
- glpopmatrix();
- If assigned(ActualField) Then Begin
- AtomicFont.Color := clwhite;
- AtomicFont.BackColor := clBlack;
- If ActualField.Name = '' Then Begin
- AtomicFont.Textout(55, 176, 'Random Each Game');
- End
- Else Begin
- AtomicFont.Textout(55, 176, ActualField.Name);
- End;
- End
- Else Begin
- AtomicFont.Color := clRed;
- AtomicFont.BackColor := clBlack;
- AtomicFont.Textout(55, 176, 'No Field informations...');
- End;
- AtomicFont.Color := clwhite;
- AtomicFont.BackColor := clBlack;
- AtomicFont.Textout(55, 176 + 28, inttostr(LastWinsToWinMatch) + ' Wins to win match');
- If PlayerIsFirst Then Begin
- glPushMatrix();
- glTranslatef(20, 176 - 14 + 28 * fCursorPos, atomic_Map_Layer + 0.5 + atomic_EPSILON);
- RenderAlphaQuad(point(16, 16), 32, -32, 0, fcursorTex);
- glPopMatrix();
- End
- Else Begin
- AtomicFont.Color := clYellow;
- AtomicFont.BackColor := clBlack;
- AtomicFont.Textout(45, 176 - 28 - 28, 'Wait until ' + MasterPlayerName + LineEnding + 'finished setup.');
- End;
- glBindTexture(GL_TEXTURE_2D, 0);
- AtomicFont.Color := clwhite;
- AtomicFont.BackColor := clBlack;
- AtomicFont.Textout(60, 400, 'Scheme: ' + SchemeFile);
- (*
- * Das Eigentliche Kartenvorschau Fenster
- *)
- glpushmatrix();
- glTranslatef(379, 33, 0); // Das Offset zum Vorschaufenster ;)
- If assigned(ActualField) Then Begin
- ActualField.RenderPreview;
- End;
- glpopmatrix();
-End;
-
-Procedure TFieldSetupMenu.Reset;
-Begin
- Inherited Reset;
- MasterPlayerName := '';
- fCursorPos := 0;
-End;
-
-{ TPlayerSetupMenu }
-
-Procedure TPlayerSetupMenu.OnKeyDown(Sender: TObject; Var Key: Word;
- Shift: TShiftState);
-Begin
- If key = VK_RETURN Then Begin
- If PlayerIsFirst Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- Tgame(fOwner).SwitchToScreen(sEditFieldSetupRequest);
- End;
- End;
- If key = VK_ESCAPE Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- Tgame(fOwner).SwitchToScreen(sMainScreen);
- End;
- If key = VK_DOWN Then Begin
- fCursorPos := min(fCursorPos + 1, length(PlayerColors) - 1);
- End;
- If key = VK_UP Then Begin
- fCursorPos := max(fCursorPos - 1, 0);
- End;
- If key = VK_LEFT Then Begin
- Tgame(fOwner).ChangePLayerKey(fCursorPos, -1);
- End;
- If key = VK_RIGHT Then Begin
- Tgame(fOwner).ChangePLayerKey(fCursorPos, 1);
- End;
-End;
-
-Constructor TPlayerSetupMenu.Create(Owner: TObject);
-Begin
- Inherited Create(Owner);
- fBackFile := 'join.png';
- fSoundFile := 'player_setup_sound.wav';
- fCursorFile := 'options_cursor.png';
-End;
-
-Procedure TPlayerSetupMenu.LoadScheme(Const Scheme: TScheme);
-Var
- i: Integer;
-Begin
- fSchemeFile := Scheme.Filename;
- (*
- * Für das Playersetup ist nur die "TEAM" Verteilung relevant / interessant
- *)
- For i := 0 To high(fPlayerDetails) Do Begin
- fPlayerDetails[i].Team := Scheme.PlayerStartPositions[i].Team;
- End;
-End;
-
-Procedure TPlayerSetupMenu.LoadPlayerdata(Const PlayerData: TPlayers;
- Uid: Integer);
-Var
- i: Integer;
-Begin
- (*
- * Siehe TPlayer.UID
- *)
- For i := 0 To high(fPlayerDetails) Do Begin
- If PlayerData[i].UID = Uid Then Begin
- If PlayerData[i].Keyboard = ks0 Then Begin
- fPlayerDetails[i].PlayerData := 'key 0';
- End
- Else Begin
- fPlayerDetails[i].PlayerData := 'key 1';
- End;
- //fCursorPos := i; // Das geht leider nicht, da sonst der Cursor merkwürdig Springt wenn der Spieler 2 mal eingestellt ist..
- End
- Else Begin
- If PlayerData[i].UID > 0 Then Begin
- fPlayerDetails[i].PlayerData := PlayerData[i].UserName; // 'NET'; -- The Orig Game shows at this place only a "NET" entry
- End
- Else Begin
- If PlayerData[i].UID = NoPlayer Then Begin
- fPlayerDetails[i].PlayerData := 'OFF';
- End
- Else Begin
- If PlayerData[i].UID = AIPlayer Then Begin
- fPlayerDetails[i].PlayerData := 'AI';
- End;
- End;
- End;
- End;
- End;
-End;
-
-Procedure TPlayerSetupMenu.LoadFromDisk(ResPath: String);
-Begin
- Inherited LoadFromDisk(ResPath);
- fcursorTex := OpenGL_GraphikEngine.LoadAlphaColorGraphik(ResPath + fCursorFile, ColorToRGB(clfuchsia), smStretch);
-End;
-
-Procedure TPlayerSetupMenu.Render;
-Var
- i: Integer;
- s: String;
-Begin
- Inherited Render;
- glBindTexture(GL_TEXTURE_2D, 0);
- AtomicFont.Color := clwhite;
- AtomicFont.BackColor := clBlack;
- AtomicFont.Textout(60, 37 + 40, 'Available players:');
- For i := 0 To high(fPlayerDetails) Do Begin
- If i = 1 Then Begin
- AtomicFont.BackColor := clWhite;
- End
- Else Begin
- AtomicFont.BackColor := clBlack;
- End;
- AtomicFont.Color := AtomicPlayerColorToColor(PlayerColors[i]);
- s := format('Player %0.2d: ', [i + 1]);
- AtomicFont.Textout(60 + 20, 37 + (i + 1) * 28 + 50, s);
- If TeamPlay Then Begin
- (*
- * Im Teamplay Färben wir den Detail Text in der teamfarbe ein
- *)
- If fPlayerDetails[i].Team = TeamIndexWhite Then Begin
- AtomicFont.Color := clwhite;
- AtomicFont.BackColor := clBlack;
- End
- Else Begin
- AtomicFont.Color := clRed;
- AtomicFont.BackColor := clBlack;
- End;
- End;
- s := format(' %s', [fPlayerDetails[i].PlayerData]);
- AtomicFont.Textout(60 + 20, 37 + (i + 1) * 28 + 50, s);
- End;
- // Reset am ende
- AtomicFont.Color := clwhite;
- AtomicFont.BackColor := clBlack;
- AtomicFont.Textout(60, 400, 'Scheme: ' + fSchemeFile);
- glPushMatrix();
- glTranslatef(60 - 32 + 10, 37 + 14 + 28 * fCursorPos + 50, atomic_Map_Layer + atomic_EPSILON);
- RenderAlphaQuad(point(16, 16), 32, -32, 0, fcursorTex);
- glPopMatrix();
-End;
-
-Procedure TPlayerSetupMenu.Reset;
-Begin
- Inherited Reset;
- fCursorPos := 0;
-End;
-
-{ TJoinMenu }
-
-Procedure TJoinMenu.OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState
- );
-Begin
- If (key = VK_ESCAPE) Or (key = VK_BACK) Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- Tgame(fOwner).SwitchToScreen(sMainScreen);
- End;
- If key = VK_RETURN Then Begin // Alle Clients sind da -> Ab in den Spieler Config Dialog..
- If PlayerIsFirst Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- Tgame(fOwner).SwitchToScreen(sPlayerSetupRequest);
- End;
- End;
-End;
-
-Constructor TJoinMenu.Create(Owner: TObject);
-Begin
- Inherited Create(Owner);
- fBackFile := 'join.png';
- fSoundFile := 'join_sound.wav';
- fCursorFile := '';
-End;
-
-Procedure TJoinMenu.LoadPlayerdata(Const PlayerData: Array Of TPlayer);
-Var
- i: Integer;
-Begin
- fPlayerInfoString := 'Connected network players:' + LineEnding + LineEnding;
- For i := 0 To high(PlayerData) Do Begin
- If PlayerData[i].UID <> NoPlayer Then Begin
- fPlayerInfoString := fPlayerInfoString + ' ' + PlayerData[i].UserName + LineEnding;
- End;
- End;
-End;
-
-Procedure TJoinMenu.Render;
-Begin
- Inherited Render;
- glPushMatrix;
- glColor3f(1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, 0);
- AtomicFont.color := $00EAE556;
- AtomicFont.BackColor := clBlack;
- AtomicFont.Textout(100, 50, 'Our Nodename is: ''' + Tgame(fOwner).Settings.NodeName + '''');
- If Connected Then Begin
- // Der Server hat unseren Login Versuch Grundsätzlich aktzeptiert
- // Wir zeigen nun die Infos der Spieler an, bis der 1. Spieler in den Nächsten Screen umschaltet
- AtomicFont.color := clWhite;
- AtomicFont.Textout(120, 100, fPlayerInfoString);
- End
- Else Begin
- AtomicFont.color := clYellow;
- AtomicFont.Textout(120, 100, 'Waiting for server to host a game..');
- End;
- glPopMatrix;
-End;
-
-Procedure TJoinMenu.Reset;
-Begin
- Inherited Reset;
- Connected := false;
- fPlayerInfoString := 'waiting for playerlist from server..';
-End;
-
-{ TOptionsMenu }
-
-Procedure TOptionsMenu.OnKeyDown(Sender: TObject; Var Key: Word;
- Shift: TShiftState);
-Var
- kd: TKeyboardDialog;
- qf: TSchemQuestionForm;
- nn: String;
-Begin
- // Zurück ins Hauptmenü
- If (key = VK_ESCAPE) Or (key = VK_BACK) Then Begin
- Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
- Tgame(fOwner).SwitchToScreen(sMainScreen);
- Form1.IniPropStorage1SavingProperties(Nil);
- End;
- If key = VK_DOWN Then Begin
- fCursorPos := min(fCursorPos + 1, 11);
- End;
- If key = VK_UP Then Begin
- fCursorPos := max(fCursorPos - 1, 0);
- End;
- If (key = VK_RETURN) Or (Key = VK_ADD) Or (key = VK_SUBTRACT)
- Or (Key = VK_LEFT) Or (Key = VK_RIGHT) Then Begin
- Case fCursorPos Of
- 0: Tgame(fOwner).Settings.TeamPlay := Not Tgame(fOwner).Settings.TeamPlay;
- 1: Tgame(fOwner).Settings.RandomStart := Not Tgame(fOwner).Settings.RandomStart;
- 2: Begin
- key := 0;
- nn := InputBox('Edit', 'Enter Nodename', Tgame(fOwner).Settings.NodeName);
- If trim(nn) <> '' Then Begin
- Tgame(fOwner).Settings.NodeName := nn;
- End
- Else Begin
- LogShow('Empty username not allowed', llWarning);
- End;
- End;
- 3: Begin
- If key In [VK_RETURN, VK_ADD, VK_RIGHT] Then Begin
- Case Tgame(fOwner).Settings.ConveyorSpeed Of
- csSlow: Tgame(fOwner).Settings.ConveyorSpeed := csMiddle;
- csMiddle: Tgame(fOwner).Settings.ConveyorSpeed := csFast;
- csFast: Tgame(fOwner).Settings.ConveyorSpeed := csSlow;
- End;
- End
- Else Begin
- Case Tgame(fOwner).Settings.ConveyorSpeed Of
- csSlow: Tgame(fOwner).Settings.ConveyorSpeed := csFast;
- csMiddle: Tgame(fOwner).Settings.ConveyorSpeed := csSlow;
- csFast: Tgame(fOwner).Settings.ConveyorSpeed := csMiddle;
- End;
- End;
- End;
- 4: Begin // Scheme File
- key := 0;
- qf := TSchemQuestionForm.CreateNew(Nil);
- qf.LoadSchemes(Tgame(fOwner).Settings.SchemeFile);
- qf.ShowModal;
- If qf.ModalResult = mrOK Then Begin
- Tgame(fOwner).Settings.SchemeFile := qf.Listbox1.Items[qf.Listbox1.ItemIndex];
- End;
- qf.free;
- End;
- 5: Begin // Play Time
- If key In [VK_LEFT, VK_SUBTRACT] Then Begin
- Tgame(fOwner).Settings.PlayTime := max(0, Tgame(fOwner).Settings.PlayTime - 15);
- If Tgame(fOwner).Settings.PlayTime < 80 Then Tgame(fOwner).Settings.PlayTime := 0;
- End
- Else Begin
- If Tgame(fOwner).Settings.PlayTime = 0 Then Begin
- Tgame(fOwner).Settings.PlayTime := 90;
- End
- Else Begin
- Tgame(fOwner).Settings.PlayTime := Tgame(fOwner).Settings.PlayTime + 15;
- End;
- End;
- End;
- 6: Tgame(fOwner).Settings.LostPlayersRevertToAI := Not Tgame(fOwner).Settings.LostPlayersRevertToAI;
- 7: Tgame(fOwner).Settings.PlaySounds := Not Tgame(fOwner).Settings.PlaySounds;
- 8: Begin
- key := 0;
- kd := TKeyboardDialog.CreateNew(Nil);
- kd.LoadKeys(Tgame(fOwner).Settings.Keys[ks0], Tgame(fOwner).Settings.Keys[ks1]);
- If kd.Execute() Then Begin
- Tgame(fOwner).Settings.Keys[ks0] := kd.GetKeys(ks0);
- Tgame(fOwner).Settings.Keys[ks1] := kd.GetKeys(ks1);
- End;
- kd.Free;
- End;
- 9: Tgame(fOwner).Settings.Port := strtointdef(InputBox('Edit', 'Enter port', inttostr(Tgame(fOwner).Settings.Port)), 1234);
- 10: Tgame(fOwner).Settings.ShowFPS := Not Tgame(fOwner).Settings.ShowFPS;
- 11: Begin
- Tgame(fOwner).Settings.Fullscreen := Not Tgame(fOwner).Settings.Fullscreen;
- Form1.SetFullScreen(Tgame(fOwner).Settings.Fullscreen);
-{$IFDEF Windows}
- If Tgame(fOwner).Settings.Fullscreen Then Begin
- LogShow('To switch to Fullscreen mode, you need to restart the game.');
- End;
-{$ENDIF}
- End;
- End;
- End;
-End;
-
-Procedure TOptionsMenu.OnMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-Var
- key: Word;
-Begin
- // Der Klick auf die Buttons ;)
- If (x > 60) And (x < 320) And
- (y > 36) And
- (y < 36 + 12 * 28)
- Then Begin
- fCursorPos := (y - 36) Div 28;
- key := VK_RETURN;
- OnKeyDown(Nil, key, []);
- End;
-End;
-
-Constructor TOptionsMenu.Create(Owner: TObject);
-Begin
- Inherited Create(Owner);
- fBackFile := 'options.png';
- fSoundFile := ''; // Die Optionen haben keinen Extra "Sound"
- fCursorFile := 'options_cursor.png';
-End;
-
-Procedure TOptionsMenu.LoadFromDisk(ResPath: String);
-Begin
- Inherited LoadFromDisk(ResPath);
- fcursorTex := OpenGL_GraphikEngine.LoadAlphaColorGraphik(ResPath + fCursorFile, ColorToRGB(clfuchsia), smStretch);
-End;
-
-Procedure TOptionsMenu.Render;
- Function PrettyTime(Value_s: integer): String;
- Begin
- If Value_s = 0 Then Begin
- result := 'infinity';
- End
- Else Begin
- result := format('%0.2d:%0.2d', [Value_s Div 60, Value_s Mod 60]);
- End;
- End;
-
- Function ConveyerSpeedToString(aSpeed: TConveyorSpeed): String;
- Begin
- result := '';
- Case aSpeed Of
- csSlow: result := 'Slow';
- csMiddle: result := 'Middle';
- csFast: result := 'Fast';
- End;
- End;
-
-Begin
- Inherited Render;
- glBindTexture(GL_TEXTURE_2D, 0);
- AtomicFont.BackColor := clblack;
- AtomicFont.Color := clwhite;
- AtomicFont.Textout(60, 37,
- 'Team Play: ' + BoolToStr(TGame(fOwner).Settings.TeamPlay, 'Yes', 'No') + LineEnding + LineEnding +
- 'Random Start: ' + BoolToStr(TGame(fOwner).Settings.RandomStart, 'Yes', 'No') + LineEnding + LineEnding +
- 'Node Name: ''' + TGame(fOwner).Settings.NodeName + '''' + LineEnding + LineEnding +
- 'Conveyor Speed: ' + ConveyerSpeedToString(TGame(fOwner).Settings.ConveyorSpeed) + LineEnding + LineEnding +
- 'Scheme File: ' + TGame(fOwner).Settings.SchemeFile + LineEnding + LineEnding +
- 'Play Time: ' + PrettyTime(TGame(fOwner).Settings.PlayTime) + LineEnding + LineEnding +
- 'Lost net players revert to AIs: ' + BoolToStr(TGame(fOwner).Settings.LostPlayersRevertToAI, 'Yes', 'No') + LineEnding + LineEnding +
- 'Disable music during gameplay: ' + BoolToStr(TGame(fOwner).Settings.PlaySounds, 'No', 'Yes') + LineEnding + LineEnding +
- 'Define keyboard layouts' + LineEnding + LineEnding +
- 'Network port: ' + inttostr(TGame(fOwner).Settings.Port) + LineEnding + LineEnding +
- 'Show FPS: ' + BoolToStr(TGame(fOwner).Settings.ShowFPS, 'Yes', 'No') + LineEnding + LineEnding +
- 'Fullscreen: ' + BoolToStr(TGame(fOwner).Settings.Fullscreen, 'Yes', 'No')
- );
-
- glPushMatrix();
- glTranslatef(20, 25 + 28 * fCursorPos, atomic_Map_Layer + atomic_EPSILON);
- RenderAlphaQuad(point(16, 16), 32, -32, 0, fcursorTex);
- glPopMatrix();
-End;
-
-Procedure TOptionsMenu.Reset;
-Begin
- fCursorPos := 0;
-End;
-
-{ TMainMenu }
-
-Procedure TMainMenu.OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState
- );
-Var
- f: TJoinQuestionForm;
-Begin
- If key = VK_J Then Begin
- // Frage IP und Port zum Game.JoinViaParams(ip, port); ab !
- f := TJoinQuestionForm.CreateNew(Nil, 0);
- f.Edit1.Text := TGame(fOwner).Settings.Router_IP;
- f.Edit2.Text := TGame(fOwner).Settings.Router_Port;
- If f.ShowModal = mrOK Then Begin
- TGame(fOwner).JoinViaParams(f.Edit1.Text, strtointdef(f.Edit2.Text, 9876));
- End;
- f.free;
- End;
- If key = VK_DOWN Then Begin
- // fCursorPos := min(fCursorPos + 1, 6);
- fCursorPos := (fCursorPos + 1) Mod 7; // Feature Request by Community, rotating navigation
- End;
- If key = VK_UP Then Begin
- // fCursorPos := max(fCursorPos - 1, 0);
- fCursorPos := (fCursorPos + 6) Mod 7; // Feature Request by Community, rotating navigation
- End;
- If (key >= VK_1) And (key <= VK_7) Then Begin
- fCursorPos := key - VK_1;
- key := VK_RETURN;
- End;
- If key = VK_RETURN Then Begin
- Case fCursorPos Of
- 0: logshow('Not yet implemented.', llinfo); // TAtomic(fOwner).SwitchToScreen(); -- Single Player
- 1: TGame(fOwner).SwitchToScreen(sHost);
- 2: TGame(fOwner).SwitchToScreen(sJoinNetwork);
- 3: TGame(fOwner).SwitchToScreen(sOptions);
- 4: logshow('Not yet implemented.', llinfo); //TGame(fOwner).SwitchToScreen(); -- About Bomberman
- 5: logshow('Not yet implemented.', llinfo); //TGame(fOwner).SwitchToScreen(); -- Online Manual
- 6: Begin
-{$IFNDEF Only3Player}
- If ID_YES = Application.MessageBox('Do you really want to quit?', 'Question', MB_ICONQUESTION Or MB_YESNO) Then
-{$ENDIF}
- TGame(fOwner).SwitchToScreen(sExitBomberman);
- End;
- End;
- End;
- If key = VK_ESCAPE Then Begin
-{$IFNDEF Only3Player}
- If ID_YES = Application.MessageBox('Do you really want to quit?', 'Question', MB_ICONQUESTION Or MB_YESNO) Then
-{$ENDIF}
- TGame(fOwner).SwitchToScreen(sExitBomberman);
- End;
-End;
-
-Procedure TMainMenu.OnMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-Var
- key: Word;
-Begin
- // Der Klick auf die Buttons ;)
- If (x > 350) And (x < 610) And
- (y > 100) And (y < 100 + 7 * 37) Then Begin
- fCursorPos := (y - 100) Div 37;
- key := VK_RETURN;
- OnKeyDown(Nil, key, []);
- End;
-End;
-
-Constructor TMainMenu.Create(Owner: TObject);
-Begin
- Inherited Create(Owner);
- fBackFile := 'mainmenu.png';
- fSoundFile := 'mainmenu_sound.wav';
- fCursorFile := 'mainmenu_cursor.ani';
- fCursor := TOpenGL_Animation.Create;
-End;
-
-Destructor TMainMenu.Destroy;
-Begin
- fCursor.Free;
- Inherited Destroy;
-End;
-
-Procedure TMainMenu.LoadFromDisk(ResPath: String);
-Begin
- Inherited LoadFromDisk(ResPath);
- fCursor.LoadFromFile(ResPath + fCursorFile);
-End;
-
-Procedure TMainMenu.Render;
-Begin
- Inherited Render;
- glPushMatrix();
- glTranslatef(310, 100 + fCursorPos * 37, atomic_Map_Layer + atomic_EPSILON);
- fCursor.Render(0);
- glPopMatrix();
-End;
-
-Procedure TMainMenu.Reset;
-Begin
- Inherited Reset;
- fCursorPos := 0;
-End;
-
-{ TScreen }
-
-Procedure TScreen.OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
-Begin
- // Nichts nur zum Überscheiben da..
-End;
-
-Procedure TScreen.OnMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-Begin
- // Nichts nur zum Überscheiben da..
-End;
-
-Constructor TScreen.Create(Owner: TObject);
-Begin
- fOwner := Owner;
- If Not (fOwner Is TGame) Then Begin
- Raise exception.Create('Error, Owner has to be TAtomic!');
- End;
- fBackFile := '';
- fSoundFile := '';
- fBackTex := 0;
-End;
-
-Destructor TScreen.Destroy;
-Begin
- // Nix
-End;
-
-Procedure TScreen.Render;
-Begin
- (*
- * Die Hintergrund Graphik kann auf jeden Fall gerendert werden..
- *)
- glpushmatrix();
- glTranslatef(0, 0, atomic_Map_Layer);
- glColor3f(1, 1, 1);
- RenderQuad(v2(0, 0), v2(GameWidth, GameHeight), 0, false, fBackTex);
- glpopmatrix();
-End;
-
-Procedure TScreen.LoadFromDisk(ResPath: String);
-Begin
- fSoundExitScreen := ResPath + 'menuexit.wav';
- If fSoundFile <> '' Then Begin
- fSoundFile := ResPath + fSoundFile;
- End;
- If fBackFile <> '' Then Begin
- fBackTex := OpenGL_GraphikEngine.LoadGraphik(ResPath + fBackFile, smStretch);
- End
- Else Begin
- fBackTex := 0;
- End;
-End;
-
-Procedure TScreen.Reset;
-Begin
- PlayerIsFirst := false;
- StartPLaySong();
-End;
-
-Procedure TScreen.StartPLaySong();
-Begin
- // Auf Jeden Fall soll mal die Passende Screen Musik abgespielt werden.
- If trim(fSoundFile) <> '' Then Begin
- TGame(fOwner).StartPlayingSong(fSoundFile);
- End;
-End;
-
-End.
-
+(******************************************************************************)
+(* *)
+(* Author : Uwe Schächterle (Corpsman) *)
+(* *)
+(* This file is part of FPC_Atomic *)
+(* *)
+(* See the file license.md, located under: *)
+(* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *)
+(* for details about the license. *)
+(* *)
+(* It is not allowed to change or remove this text from any *)
+(* source file of the project. *)
+(* *)
+(******************************************************************************)
+(* *)
+(* Modified by : Pavel Zverina *)
+(* Note : This file has been modified while preserving the original *)
+(* authorship and license terms. *)
+(* *)
+Unit uscreens;
+
+{$MODE ObjFPC}{$H+}
+
+Interface
+
+{$I globaldefines.inc}
+
+Uses
+ Classes, SysUtils, controls, uatomic_common, uopengl_animation, uatomic_field;
+
+Type
+
+ (*
+ * Im MainMenu die diversen Screens
+ *)
+ TScreenEnum = (
+ sMainScreen // Hauptscreen
+ //, sSinglePlayer -- ??
+ , sHost // Den Gibt es gar nicht, der wird direkt auf den sJoinNetwork umgeleitet
+ , sJoinNetwork // Alle Spieler gehen zusammen in das Spiel rein
+ , sPlayerSetupRequest // Anfrage zum Wechsel in sPlayerSetup
+ , sPlayerSetup // Die Spieler dürfen sich ihre Farben "aussuchen"
+ , sEditFieldSetupRequest // Anfrage zum Einstellen der Field einstellungen
+ , sEditFieldSetup // Der Master stellt die eigenschaften des fields ein
+ , sDrawGame // Der Screen der Angezeigt wird wenn ein Unentschieden gespielt wurde
+ , sMatchStatistik // Der Screen der die Match Statistik anzeigt
+ , sVictory // Der Screen der das Wer hat gewonnen bild anzeigt
+ , sOptions // Der Optionen Dialog
+ //, sOnlineManual -- ??
+ , sExitBomberman // byby
+ );
+
+ { TScreen }
+
+ TScreen = Class
+ private
+ fOwner: TObject;
+ fBackFile: String;
+ fBackTex: Integer; // OpenGL Pointer der fBackFile
+ fSoundFile: String;
+ fSoundExitScreen: String;
+ fCursorFile: String;
+ public
+
+ PlayerIsFirst: Boolean; // Global Verfügbar, True, wenn der Spieler "Spieler 1" ist !
+
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); virtual;
+ Procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
+
+ Constructor Create(Owner: TObject); virtual;
+ Destructor Destroy(); override;
+
+ Procedure Render; virtual;
+ Procedure LoadFromDisk(ResPath: String); virtual;
+
+ Procedure Reset; virtual; // Abstract
+ Procedure StartPLaySong(); virtual;
+ End;
+
+ { TMainMenu }
+
+ TMainMenu = Class(TScreen)
+ private
+ fCursor: TOpenGL_Animation;
+ fCursorPos: integer; // Position der "Bombe" in Menüpunkten
+ public
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
+ Procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+
+ Constructor Create(Owner: TObject); override;
+ Destructor Destroy(); override;
+
+ Procedure LoadFromDisk(ResPath: String); override;
+ Procedure Render; override;
+ Procedure Reset; override;
+ End;
+
+ { TJoinMenu }
+
+ TJoinMenu = Class(TScreen)
+ private
+ fPlayerInfoString: String; // Die Spieler die Gerade auch eingewählt sind.
+ fServerIP: String; // Server IP address (for display when hosting)
+
+ public
+ Connected: Boolean;
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
+
+ Constructor Create(Owner: TObject); override;
+ Procedure LoadPlayerdata(Const PlayerData: Array Of TPlayer);
+ Procedure SetServerIP(Const IP: String); // Set server IP address for display
+ Procedure Render; override;
+ Procedure Reset; override;
+ End;
+
+ { TPlayerSetupMenu }
+
+ TPlayerSetupMenu = Class(TScreen)
+ private
+ fSchemeFile: String;
+ fcursorTex: integer;
+ fCursorPos: integer; // Position des "Kopfes" in Menüpunkten
+ fPlayerDetails: Array[0..length(PlayerColors) - 1] Of Record
+ Team: Integer;
+ PlayerData: String;
+ End;
+ public
+ TeamPlay: Boolean; // True = Anzeigen der Spielerfarben als Team wird via "miSwitchToPlayerSetup" gesetzt
+
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
+ // TODO: Maus Support
+
+ Constructor Create(Owner: TObject); override;
+
+ Procedure LoadScheme(Const Scheme: TScheme); // Wird via miUpdateScheme gesetzt
+ Procedure LoadPlayerdata(Const PlayerData: TPlayers; Uid: Integer); // wird via TAtomic.SwitchToScreen gesetzt
+
+ Procedure LoadFromDisk(ResPath: String); override;
+
+ Procedure Render; override;
+ Procedure Reset; override;
+ End;
+
+ { TFieldSetupMenu }
+
+ TFieldSetupMenu = Class(TScreen)
+ private
+ fCursorPos: integer;
+ fcursorTex: Integer;
+ public
+ MasterPlayerName: String;
+ ActualField: TAtomicField;
+ LastWinsToWinMatch: Integer;
+ SchemeFile: String;
+
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
+
+ Constructor Create(Owner: TObject); override;
+
+ Procedure LoadFromDisk(ResPath: String); override;
+ Procedure Render; override;
+ Procedure Reset; override;
+ End;
+
+ { TDrawGameMenu }
+
+ TDrawGameMenu = Class(TScreen)
+ private
+ public
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
+
+ Constructor Create(Owner: TObject); override;
+
+ Procedure Reset; override;
+ End;
+
+ { TMatchStatistikMenu }
+
+ TMatchStatistikMenu = Class(TScreen)
+ private
+ fPlayers: TPlayers;
+ public
+ Victor: TVictor;
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
+
+ Procedure LoadPlayerdata(Const PlayerData: TPlayers);
+
+ Constructor Create(Owner: TObject); override;
+
+ Procedure Render; override;
+
+ End;
+
+ { TVictoryMenu }
+
+ TVictoryMenu = Class(TScreen)
+ private
+ fbackGrounds: Array[TVictor] Of Integer;
+ public
+ Victor: TVictor;
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
+
+ Procedure LoadFromDisk(ResPath: String); override;
+
+ Procedure Render; override;
+ Constructor Create(Owner: TObject); override;
+ End;
+
+ { TOptionsMenu }
+
+ TOptionsMenu = Class(TScreen)
+ private
+ fcursorTex: integer;
+ fCursorPos: integer; // Position des "Kopfes" in Menüpunkten
+ public
+ Procedure OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); override;
+ Procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+
+ Constructor Create(Owner: TObject); override;
+
+ Procedure LoadFromDisk(ResPath: String); override;
+ Procedure Render; override;
+ Procedure Reset; override;
+ End;
+
+Implementation
+
+Uses LCLType, Math, Graphics, Dialogs, forms, StdCtrls, fileutil, StrUtils
+ , dglOpenGL
+ , Unit1 // WTF, why is this unit in here ?
+ , uopengl_graphikengine
+ , uatomicfont
+ , uvectormath
+ , ugraphics
+ , ugame
+ , ukeyboarddialog
+ , uip // For GetLocalIPs() to get server IP address
+ , sdl2 // For SDL joystick functions
+ ;
+
+Type
+
+ { TSchemQuestionForm }
+
+ TSchemQuestionForm = Class(TForm)
+ Procedure FormButton1Click(Sender: TObject);
+ Procedure FormShow(Sender: Tobject);
+ Procedure ListboxKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
+ private
+ Listbox1: TListbox;
+ Button1: TButton;
+ public
+ Procedure LoadSchemes(SelectedScheme: String);
+ // Weil die Form keine Ressource hat, muss sie mittels CreateNew erzeugt werden, was auch immer das für einen unterschied macht ...
+ Constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
+ End;
+
+ { TJoinQuestionForm }
+
+ TJoinQuestionForm = Class(TForm)
+ private
+ Edit1: TEdit;
+ Edit2: TEdit;
+ Label1: TLabel;
+ Label2: TLabel;
+ Button1: TButton;
+ Button2: TButton;
+ Procedure EditKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
+ Procedure FormKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
+ public
+ Constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
+ End;
+
+ { TJoinQuestionForm }
+
+Constructor TJoinQuestionForm.CreateNew(AOwner: TComponent; Num: Integer);
+Begin
+ Inherited CreateNew(AOwner, Num);
+ caption := 'Enter IP-Settings';
+ width := 312;
+ height := 163;
+ Position := poScreenCenter;
+ Constraints.MaxWidth := Width;
+ Constraints.MinWidth := Width;
+ Constraints.MaxHeight := Height;
+ Constraints.MinHeight := Height;
+
+ Edit1 := TEdit.Create(self);
+ edit1.name := 'Edit1';
+ edit1.Parent := self;
+ edit1.Top := 32;
+ edit1.Left := 16;
+ edit1.Width := 288;
+ edit1.Text := '127.0.0.1';
+
+ Edit2 := TEdit.Create(self);
+ edit2.name := 'Edit2';
+ edit2.Parent := self;
+ edit2.Top := 88;
+ edit2.Left := 16;
+ edit2.Width := 288;
+ edit2.Text := '9876';
+
+ label1 := TLabel.Create(self);
+ label1.Name := 'Label1';
+ label1.Parent := self;
+ label1.caption := 'IP';
+ label1.top := 8;
+ label1.Left := 8;
+
+ label2 := TLabel.Create(self);
+ label2.Name := 'Label2';
+ label2.Parent := self;
+ label2.caption := 'Port';
+ label2.top := 64;
+ label2.Left := 8;
+
+ Button1 := TButton.Create(self);
+ Button1.Name := 'Button1';
+ Button1.Parent := self;
+ Button1.caption := 'OK';
+ Button1.ModalResult := mrOK;
+ Button1.Default := True; // Make Enter key trigger this button (when focus is on button)
+ Button1.Top := 128;
+ Button1.Left := 229;
+
+ Button2 := TButton.Create(self);
+ Button2.Name := 'Button2';
+ Button2.Parent := self;
+ Button2.caption := 'Cancel';
+ Button2.ModalResult := mrCancel;
+ Button2.Cancel := True; // Make Esc key trigger this button
+ Button2.Top := 128;
+ Button2.Left := 16;
+
+ // Add keyboard support: Enter = OK everywhere
+ // Set handlers on Edit fields to catch Enter when focus is in Edit
+ Edit1.OnKeyDown := @EditKeyDown;
+ Edit2.OnKeyDown := @EditKeyDown;
+ // Set handler on form to catch Enter when focus is on form (not on Edit or Button)
+ OnKeyDown := @FormKeyDown;
+ KeyPreview := True; // Enable form-level key handling
+End;
+
+Procedure TJoinQuestionForm.EditKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
+Begin
+ If key = VK_RETURN Then Begin
+ // Enter in Edit field = OK button
+ // Strategy: Set focus to OK button, then trigger it programmatically
+ Key := 0; // Prevent default behavior (newline in Edit)
+ Button1.SetFocus; // Focus the OK button first
+ // Now trigger the button click programmatically
+ Button1.Click; // This will set ModalResult := mrOK and close the form
+ End;
+ // Esc is handled automatically by Button2.Cancel := True
+End;
+
+Procedure TJoinQuestionForm.FormKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
+Begin
+ If key = VK_RETURN Then Begin
+ // Enter on form (when focus is NOT on Button1) = OK button
+ // Strategy: Set focus to OK button, then trigger it programmatically
+ If ActiveControl <> Button1 Then Begin
+ Key := 0; // Prevent default behavior
+ Button1.SetFocus; // Focus the OK button first
+ // Now trigger the button click programmatically
+ Button1.Click; // This will set ModalResult := mrOK and close the form
+ End;
+ // If focus is on Button1, let default behavior (Default := True) handle it
+ End;
+ // Esc is handled automatically by Button2.Cancel := True
+End;
+
+{ TVictoryMenu }
+
+Procedure TVictoryMenu.OnKeyDown(Sender: TObject; Var Key: Word;
+ Shift: TShiftState);
+Begin
+ If (key = VK_RETURN) Or (key = VK_ESCAPE) Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ TGame(fOwner).SwitchToScreen(sMainScreen);
+ End;
+End;
+
+Procedure TVictoryMenu.LoadFromDisk(ResPath: String);
+Begin
+ Inherited LoadFromDisk(ResPath);
+ fbackGrounds[vWhiteTeam] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'team0.png', smStretch);
+ fbackGrounds[vRedTeam] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'team1.png', smStretch);
+ fbackGrounds[vCol0] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory0.png', smStretch);
+ fbackGrounds[vCol1] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory1.png', smStretch);
+ fbackGrounds[vCol2] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory2.png', smStretch);
+ fbackGrounds[vCol3] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory3.png', smStretch);
+ fbackGrounds[vCol4] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory4.png', smStretch);
+ fbackGrounds[vCol5] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory5.png', smStretch);
+ fbackGrounds[vCol6] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory6.png', smStretch);
+ fbackGrounds[vCol7] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory7.png', smStretch);
+ fbackGrounds[vCol8] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory8.png', smStretch);
+ fbackGrounds[vCol9] := OpenGL_GraphikEngine.LoadGraphik(ResPath + 'victory9.png', smStretch);
+End;
+
+Procedure TVictoryMenu.Render;
+Begin
+ fBackTex := fbackGrounds[Victor];
+ Inherited Render;
+End;
+
+Constructor TVictoryMenu.Create(Owner: TObject);
+Begin
+ Inherited Create(Owner);
+ fSoundFile := 'draw.wav';
+End;
+
+{ TMatchStatistikMenu }
+
+Procedure TMatchStatistikMenu.OnKeyDown(Sender: TObject; Var Key: Word;
+ Shift: TShiftState);
+Begin
+ If key = VK_ESCAPE Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ TGame(fOwner).SwitchToScreen(sMainScreen);
+ End;
+ If PlayerIsFirst Then Begin
+ If key = VK_RETURN Then Begin
+ TGame(fOwner).StartGame();
+ End;
+ End;
+End;
+
+Procedure TMatchStatistikMenu.LoadPlayerdata(Const PlayerData: TPlayers);
+Begin
+ fPlayers := PlayerData;
+End;
+
+Constructor TMatchStatistikMenu.Create(Owner: TObject);
+Begin
+ Inherited Create(Owner);
+ fBackFile := 'results.png';
+ fSoundFile := 'draw.wav';
+End;
+
+Procedure TMatchStatistikMenu.Render;
+
+ Function VictorToString(Value: TVictor): String;
+ Var
+ index: integer;
+ Begin
+ Case Value Of
+ vRedTeam: result := 'Red Team';
+ vWhiteTeam: result := 'White Team';
+ Else Begin
+ index := integer(value) - integer(vCol0);
+ result := fPlayers[index].UserName;
+ If result = '' Then
+ result := 'Ai';
+ End;
+ End;
+ End;
+
+Var
+ s, un: String;
+ i: Integer;
+Begin
+ Inherited Render;
+ glpushmatrix();
+ glTranslatef(0, 0, atomic_Map_Layer + 0.5);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ glColor4f(1, 1, 1, 1);
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Color := $00A8ADAB;
+ AtomicFont.Textout(150, 100, '(Match winner must score ' + inttostr(TGame(fOwner).Settings.LastWinsToWinMatch) + ' victories)');
+ s := 'Game Winner was ' + VictorToString(Victor) + ' !';
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Color := clwhite;
+ AtomicFont.Textout(150, 150, s);
+ glPushMatrix;
+ glTranslatef(130, 200, 0);
+ For i := 0 To high(fPlayers) Do Begin
+ If fPlayers[i].UID <> NoPlayer Then Begin
+ If i = 1 Then Begin
+ AtomicFont.BackColor := clWhite;
+ End
+ Else Begin
+ AtomicFont.BackColor := clBlack;
+ End;
+ AtomicFont.Color := AtomicPlayerColorToColor(PlayerColors[i]);
+ un := fPlayers[i].UserName;
+ If un = '' Then un := 'Ai';
+ un := PadRight(un, 20);
+ s := format('%s: score: %d (kills: %d)', [un, fPlayers[i].Score, fPlayers[i].Kills]);
+ AtomicFont.Textout(0, 0, s);
+ glTranslatef(0, 20, 0);
+ End;
+ End;
+ glPopMatrix;
+ AtomicFont.BackColor := clBlack; // Reset nach außen
+ glPopMatrix;
+End;
+
+{ TDrawGameMenu }
+
+Procedure TDrawGameMenu.OnKeyDown(Sender: TObject; Var Key: Word;
+ Shift: TShiftState);
+Begin
+ If key = VK_ESCAPE Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ Tgame(fOwner).SwitchToScreen(sMainScreen);
+ End;
+ If PlayerIsFirst Then Begin
+ If key = VK_RETURN Then Begin
+ TGame(fOwner).StartGame;
+ End;
+ End;
+End;
+
+Constructor TDrawGameMenu.Create(Owner: TObject);
+Begin
+ Inherited Create(Owner);
+ fBackFile := 'draw.png'; // WTF, warum geht das net als PNG ?
+ fSoundFile := 'draw.wav';
+ fCursorFile := '';
+End;
+
+Procedure TDrawGameMenu.Reset;
+Begin
+ Inherited Reset;
+End;
+
+{ TSchemQuestionForm }
+
+Constructor TSchemQuestionForm.CreateNew(AOwner: TComponent; Num: Integer);
+Begin
+ Inherited CreateNew(AOwner, Num);
+ caption := 'Please select a scheme';
+ Width := 350;
+ height := 350;
+ FormStyle := fsSystemStayOnTop;
+ Constraints.MinHeight := height;
+ Constraints.MaxHeight := height;
+ Constraints.MinWidth := Width;
+ Constraints.MaxWidth := Width;
+ BorderIcons := [biSystemMenu];
+ position := poScreenCenter;
+ Button1 := TButton.Create(self);
+ button1.name := 'Button1';
+ Button1.Parent := self;
+ Button1.Align := alBottom;
+ button1.caption := 'OK';
+ button1.OnClick := @FormButton1Click;
+ Listbox1 := TListBox.Create(self);
+ Listbox1.Name := 'Listbox1';
+ Listbox1.Parent := self;
+ Listbox1.Align := alClient;
+ Listbox1.OnKeyDown := @ListboxKeyDown;
+
+ OnShow := @FormShow;
+End;
+
+Procedure TSchemQuestionForm.FormButton1Click(Sender: TObject);
+Begin
+ If Listbox1.ItemIndex <> -1 Then Begin
+ ModalResult := mrOK;
+ End
+ Else Begin
+ ModalResult := mrCancel; // Anscheinend haben wir keine Scheme files, dann versuchen wir auch nicht sie zu speichern
+ End;
+End;
+
+Procedure TSchemQuestionForm.FormShow(Sender: Tobject);
+Begin
+ Listbox1.SetFocus;
+ (*
+ * Die TopRow Eigenschaft darf erst gesetzt werden, wenn die Listbox dabei ist sich zu zeichnen
+ * im LoadSchemes geht das nicht ..
+ *)
+ If Listbox1.ItemIndex <> -1 Then Begin
+ Listbox1.TopIndex := Listbox1.ItemIndex;
+ End;
+End;
+
+Procedure TSchemQuestionForm.ListboxKeyDown(Sender: TObject; Var Key: Word;
+ Shift: TShiftState);
+Begin
+ If key = VK_RETURN Then Begin
+ key := 0; // Den Key Löschen, da der Button1.Click das Formular Platt macht und der Key sonst in TScreen nochmal ausgewertet wird.
+ button1.Click;
+ End;
+ If key = VK_ESCAPE Then ModalResult := mrCancel;
+End;
+
+Procedure TSchemQuestionForm.LoadSchemes(SelectedScheme: String);
+Var
+ p: String;
+ sl: TStringList;
+ i: Integer;
+Begin
+ p := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'data' + PathDelim + 'schemes';
+ sl := FindAllfiles(p, '*.sch', false);
+ Listbox1.Clear;
+ Listbox1.Sorted := true;
+ For i := 0 To sl.Count - 1 Do Begin
+ Listbox1.Items.Add(ExtractFileName(sl[i]));
+ End;
+ For i := 0 To Listbox1.Items.Count - 1 Do Begin
+ If lowercase(SelectedScheme) = lowercase(Listbox1.Items[i]) Then Begin
+ Listbox1.ItemIndex := i;
+ break;
+ End;
+ End;
+ sl.free;
+End;
+
+{ TFieldSetupMenu }
+
+Procedure TFieldSetupMenu.OnKeyDown(Sender: TObject; Var Key: Word;
+ Shift: TShiftState);
+Begin
+ If key = VK_ESCAPE Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ TGame(fOwner).SwitchToScreen(sMainScreen);
+ End;
+ If PlayerIsFirst Then Begin
+ If key = VK_RETURN Then Begin
+ TGame(fOwner).StartGame;
+ End;
+ If key = VK_DOWN Then Begin
+ fCursorPos := min(fCursorPos + 1, 1);
+ End;
+ If key = VK_UP Then Begin
+ fCursorPos := max(fCursorPos - 1, 0);
+ End;
+ If key = VK_LEFT Then Begin
+ Case fCursorPos Of
+ 0: TGame(fOwner).UpdateSelectedField(-1);
+ 1: TGame(fOwner).UpdateWinsToWin(-1);
+ End;
+ End;
+ If key = VK_Right Then Begin
+ Case fCursorPos Of
+ 0: TGame(fOwner).UpdateSelectedField(1);
+ 1: TGame(fOwner).UpdateWinsToWin(1);
+ End;
+ End;
+ End;
+End;
+
+Constructor TFieldSetupMenu.Create(Owner: TObject);
+Begin
+ Inherited Create(Owner);
+ ActualField := Nil;
+ fBackFile := 'fieldsetup.png'; // WTF, warum geht das net als PNG ?
+ fSoundFile := 'player_setup_sound.wav';
+ fCursorFile := 'options_cursor.png';
+End;
+
+Procedure TFieldSetupMenu.LoadFromDisk(ResPath: String);
+Begin
+ Inherited LoadFromDisk(ResPath);
+ (*
+ * Neu Laden der Hintergrundgraphik mit Transparenz
+ *)
+ OpenGL_GraphikEngine.RemoveGraphik(fBackTex);
+ fBackTex := OpenGL_GraphikEngine.LoadAlphaColorGraphik(ResPath + fBackFile, ColorToRGB(clfuchsia), smStretchHard);
+ fcursorTex := OpenGL_GraphikEngine.LoadAlphaColorGraphik(ResPath + fCursorFile, ColorToRGB(clfuchsia), smStretch);
+End;
+
+Procedure TFieldSetupMenu.Render;
+Begin
+ // Das Vorschaubild
+ glColor4f(1, 1, 1, 1);
+ // Der Eigentliche Hintergrund
+ glpushmatrix();
+ glAlphaFunc(GL_LESS, 0.5);
+ // Das ist ja eine Textur mit "Fenster" -> Also Alphatest mit an
+ glEnable(GL_ALPHA_TEST);
+ glTranslatef(0, 0, atomic_Map_Layer + 0.5);
+ RenderAlphaQuad(v2(320, 240), GameWidth, -GameHeight, 0, fBackTex);
+ gldisable(GL_ALPHA_TEST);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ glpopmatrix();
+ If assigned(ActualField) Then Begin
+ AtomicFont.Color := clwhite;
+ AtomicFont.BackColor := clBlack;
+ If ActualField.Name = '' Then Begin
+ AtomicFont.Textout(55, 176, 'Random Each Game');
+ End
+ Else Begin
+ AtomicFont.Textout(55, 176, ActualField.Name);
+ End;
+ End
+ Else Begin
+ AtomicFont.Color := clRed;
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Textout(55, 176, 'No Field informations...');
+ End;
+ AtomicFont.Color := clwhite;
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Textout(55, 176 + 28, inttostr(LastWinsToWinMatch) + ' Wins to win match');
+ If PlayerIsFirst Then Begin
+ glPushMatrix();
+ glTranslatef(20, 176 - 14 + 28 * fCursorPos, atomic_Map_Layer + 0.5 + atomic_EPSILON);
+ RenderAlphaQuad(point(16, 16), 32, -32, 0, fcursorTex);
+ glPopMatrix();
+ End
+ Else Begin
+ AtomicFont.Color := clYellow;
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Textout(45, 176 - 28 - 28, 'Wait until ' + MasterPlayerName + LineEnding + 'finished setup.');
+ End;
+ glBindTexture(GL_TEXTURE_2D, 0);
+ AtomicFont.Color := clwhite;
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Textout(60, 400, 'Scheme: ' + SchemeFile);
+ (*
+ * Das Eigentliche Kartenvorschau Fenster
+ *)
+ glpushmatrix();
+ glTranslatef(379, 33, 0); // Das Offset zum Vorschaufenster ;)
+ If assigned(ActualField) Then Begin
+ ActualField.RenderPreview;
+ End;
+ glpopmatrix();
+End;
+
+Procedure TFieldSetupMenu.Reset;
+Begin
+ Inherited Reset;
+ MasterPlayerName := '';
+ fCursorPos := 0;
+End;
+
+{ TPlayerSetupMenu }
+
+Procedure TPlayerSetupMenu.OnKeyDown(Sender: TObject; Var Key: Word;
+ Shift: TShiftState);
+Begin
+ If key = VK_RETURN Then Begin
+ If PlayerIsFirst Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ Tgame(fOwner).SwitchToScreen(sEditFieldSetupRequest);
+ End;
+ End;
+ If key = VK_ESCAPE Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ Tgame(fOwner).SwitchToScreen(sMainScreen);
+ End;
+ If key = VK_DOWN Then Begin
+ fCursorPos := min(fCursorPos + 1, length(PlayerColors) - 1);
+ End;
+ If key = VK_UP Then Begin
+ fCursorPos := max(fCursorPos - 1, 0);
+ End;
+ If key = VK_LEFT Then Begin
+ Tgame(fOwner).ChangePLayerKey(fCursorPos, -1);
+ End;
+ If key = VK_RIGHT Then Begin
+ Tgame(fOwner).ChangePLayerKey(fCursorPos, 1);
+ End;
+End;
+
+Constructor TPlayerSetupMenu.Create(Owner: TObject);
+Begin
+ Inherited Create(Owner);
+ fBackFile := 'join.png';
+ fSoundFile := 'player_setup_sound.wav';
+ fCursorFile := 'options_cursor.png';
+End;
+
+Procedure TPlayerSetupMenu.LoadScheme(Const Scheme: TScheme);
+Var
+ i: Integer;
+Begin
+ fSchemeFile := Scheme.Filename;
+ (*
+ * Für das Playersetup ist nur die "TEAM" Verteilung relevant / interessant
+ *)
+ For i := 0 To high(fPlayerDetails) Do Begin
+ fPlayerDetails[i].Team := Scheme.PlayerStartPositions[i].Team;
+ End;
+End;
+
+Procedure TPlayerSetupMenu.LoadPlayerdata(Const PlayerData: TPlayers;
+ Uid: Integer);
+Var
+ i: Integer;
+Begin
+ (*
+ * Siehe TPlayer.UID
+ *)
+ For i := 0 To high(fPlayerDetails) Do Begin
+ // Always show the input method label for ks0/ks1/ksJoy1/ksJoy2; OFF/AI for special states
+ If PlayerData[i].UID = NoPlayer Then Begin
+ fPlayerDetails[i].PlayerData := 'OFF';
+ End
+ Else If PlayerData[i].UID = AIPlayer Then Begin
+ fPlayerDetails[i].PlayerData := 'AI';
+ End
+ Else Begin
+ // Player assigned; display the control mapping label (keyboard, game controller, or joystick)
+ fPlayerDetails[i].PlayerData := TGame(fOwner).GetKeySetDisplayName(PlayerData[i].Keyboard);
+ End;
+ End;
+End;
+
+Procedure TPlayerSetupMenu.LoadFromDisk(ResPath: String);
+Begin
+ Inherited LoadFromDisk(ResPath);
+ fcursorTex := OpenGL_GraphikEngine.LoadAlphaColorGraphik(ResPath + fCursorFile, ColorToRGB(clfuchsia), smStretch);
+End;
+
+Procedure TPlayerSetupMenu.Render;
+Var
+ i, numJoy, joyIndex: Integer;
+ s: String;
+ joyName: PAnsiChar;
+Begin
+ Inherited Render;
+ glBindTexture(GL_TEXTURE_2D, 0);
+ AtomicFont.Color := clwhite;
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Textout(60, 37 + 40, 'Available players:');
+ For i := 0 To high(fPlayerDetails) Do Begin
+ If i = 1 Then Begin
+ AtomicFont.BackColor := clWhite;
+ End
+ Else Begin
+ AtomicFont.BackColor := clBlack;
+ End;
+ AtomicFont.Color := AtomicPlayerColorToColor(PlayerColors[i]);
+ s := format('Player %0.2d: ', [i + 1]);
+ AtomicFont.Textout(60 + 20, 37 + (i + 1) * 28 + 50, s);
+ If TeamPlay Then Begin
+ (*
+ * Im Teamplay Färben wir den Detail Text in der teamfarbe ein
+ *)
+ If fPlayerDetails[i].Team = TeamIndexWhite Then Begin
+ AtomicFont.Color := clwhite;
+ AtomicFont.BackColor := clBlack;
+ End
+ Else Begin
+ AtomicFont.Color := clRed;
+ AtomicFont.BackColor := clBlack;
+ End;
+ End;
+ s := format(' %s', [fPlayerDetails[i].PlayerData]);
+ AtomicFont.Textout(60 + 20, 37 + (i + 1) * 28 + 50, s);
+ End;
+
+ // Display available joysticks on the right side (moved left, formatted on multiple lines)
+ AtomicFont.Color := clwhite;
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Textout(300, 37 + 40, 'Available Joysticks:');
+ try
+ If Assigned(SDL_NumJoysticks) Then Begin
+ numJoy := SDL_NumJoysticks();
+ For joyIndex := 0 To numJoy - 1 Do Begin
+ try
+ // Display "Joy X" on one line
+ s := format('Joy %d', [joyIndex + 1]);
+ AtomicFont.Textout(300 + 20, 37 + (joyIndex * 2 + 2) * 28 + 50, s);
+ // Display controller name on next line
+ If Assigned(SDL_JoystickNameForIndex) Then Begin
+ joyName := SDL_JoystickNameForIndex(joyIndex);
+ If Assigned(joyName) Then Begin
+ s := String(joyName);
+ End
+ Else Begin
+ s := 'Unknown';
+ End;
+ End
+ Else Begin
+ s := 'Unknown';
+ End;
+ AtomicFont.Textout(300 + 20, 37 + (joyIndex * 2 + 3) * 28 + 50, s);
+ except
+ // On error, still show "Joy X"
+ s := format('Joy %d', [joyIndex + 1]);
+ AtomicFont.Textout(300 + 20, 37 + (joyIndex * 2 + 2) * 28 + 50, s);
+ end;
+ End;
+ End;
+ except
+ // SDL not loaded or error, don't display joysticks
+ end;
+
+ // Reset am ende
+ AtomicFont.Color := clwhite;
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Textout(60, 400, 'Scheme: ' + fSchemeFile);
+ glPushMatrix();
+ glTranslatef(60 - 32 + 10, 37 + 14 + 28 * fCursorPos + 50, atomic_Map_Layer + atomic_EPSILON);
+ RenderAlphaQuad(point(16, 16), 32, -32, 0, fcursorTex);
+ glPopMatrix();
+End;
+
+Procedure TPlayerSetupMenu.Reset;
+Begin
+ Inherited Reset;
+ fCursorPos := 0;
+End;
+
+{ TJoinMenu }
+
+Procedure TJoinMenu.OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState
+ );
+Begin
+ If (key = VK_ESCAPE) Or (key = VK_BACK) Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ Tgame(fOwner).SwitchToScreen(sMainScreen);
+ End;
+ If key = VK_RETURN Then Begin // Alle Clients sind da -> Ab in den Spieler Config Dialog..
+ If PlayerIsFirst Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ Tgame(fOwner).SwitchToScreen(sPlayerSetupRequest);
+ End;
+ End;
+End;
+
+Constructor TJoinMenu.Create(Owner: TObject);
+Begin
+ Inherited Create(Owner);
+ fBackFile := 'join.png';
+ fSoundFile := 'join_sound.wav';
+ fCursorFile := '';
+ fServerIP := '';
+End;
+
+Procedure TJoinMenu.LoadPlayerdata(Const PlayerData: Array Of TPlayer);
+Var
+ i: Integer;
+Begin
+ fPlayerInfoString := 'Connected network players:' + LineEnding + LineEnding;
+ For i := 0 To high(PlayerData) Do Begin
+ If PlayerData[i].UID <> NoPlayer Then Begin
+ fPlayerInfoString := fPlayerInfoString + ' ' + PlayerData[i].UserName + LineEnding;
+ End;
+ End;
+End;
+
+Procedure TJoinMenu.SetServerIP(Const IP: String);
+Begin
+ fServerIP := IP;
+End;
+
+Procedure TJoinMenu.Render;
+Var
+ serverInfo: String;
+Begin
+ Inherited Render;
+ glPushMatrix;
+ glColor3f(1, 1, 1);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ AtomicFont.color := $00EAE556;
+ AtomicFont.BackColor := clBlack;
+ AtomicFont.Textout(100, 50, 'Our Nodename is: ''' + Tgame(fOwner).Settings.NodeName + '''');
+
+ // Display server IP address if available (when hosting)
+ If fServerIP <> '' Then Begin
+ serverInfo := 'Server IP: ' + fServerIP + ':' + Tgame(fOwner).Settings.Router_Port;
+ AtomicFont.color := clLime; // Green color for server IP
+ AtomicFont.Textout(100, 75, serverInfo);
+ End;
+
+ If Connected Then Begin
+ // Der Server hat unseren Login Versuch Grundsätzlich aktzeptiert
+ // Wir zeigen nun die Infos der Spieler an, bis der 1. Spieler in den Nächsten Screen umschaltet
+ AtomicFont.color := clWhite;
+ AtomicFont.Textout(120, 100, fPlayerInfoString);
+ End
+ Else Begin
+ AtomicFont.color := clYellow;
+ AtomicFont.Textout(120, 100, 'Waiting for server to host a game..');
+ End;
+ glPopMatrix;
+End;
+
+Procedure TJoinMenu.Reset;
+Begin
+ Inherited Reset;
+ Connected := false;
+ fPlayerInfoString := 'waiting for playerlist from server..';
+End;
+
+{ TOptionsMenu }
+
+Procedure TOptionsMenu.OnKeyDown(Sender: TObject; Var Key: Word;
+ Shift: TShiftState);
+Var
+ kd: TKeyboardDialog;
+ qf: TSchemQuestionForm;
+ nn: String;
+Begin
+ // Zurück ins Hauptmenü
+ If (key = VK_ESCAPE) Or (key = VK_BACK) Then Begin
+ Tgame(fOwner).PlaySoundEffect(fSoundExitScreen);
+ Tgame(fOwner).SwitchToScreen(sMainScreen);
+ Form1.IniPropStorage1SavingProperties(Nil);
+ End;
+ If key = VK_DOWN Then Begin
+ fCursorPos := min(fCursorPos + 1, 11);
+ End;
+ If key = VK_UP Then Begin
+ fCursorPos := max(fCursorPos - 1, 0);
+ End;
+ If (key = VK_RETURN) Or (Key = VK_ADD) Or (key = VK_SUBTRACT)
+ Or (Key = VK_LEFT) Or (Key = VK_RIGHT) Then Begin
+ Case fCursorPos Of
+ 0: Tgame(fOwner).Settings.TeamPlay := Not Tgame(fOwner).Settings.TeamPlay;
+ 1: Tgame(fOwner).Settings.RandomStart := Not Tgame(fOwner).Settings.RandomStart;
+ 2: Begin
+ key := 0;
+ nn := InputBox('Edit', 'Enter Nodename', Tgame(fOwner).Settings.NodeName);
+ If trim(nn) <> '' Then Begin
+ Tgame(fOwner).Settings.NodeName := nn;
+ End
+ Else Begin
+ LogShow('Empty username not allowed', llWarning);
+ End;
+ End;
+ 3: Begin
+ If key In [VK_RETURN, VK_ADD, VK_RIGHT] Then Begin
+ Case Tgame(fOwner).Settings.ConveyorSpeed Of
+ csSlow: Tgame(fOwner).Settings.ConveyorSpeed := csMiddle;
+ csMiddle: Tgame(fOwner).Settings.ConveyorSpeed := csFast;
+ csFast: Tgame(fOwner).Settings.ConveyorSpeed := csSlow;
+ End;
+ End
+ Else Begin
+ Case Tgame(fOwner).Settings.ConveyorSpeed Of
+ csSlow: Tgame(fOwner).Settings.ConveyorSpeed := csFast;
+ csMiddle: Tgame(fOwner).Settings.ConveyorSpeed := csSlow;
+ csFast: Tgame(fOwner).Settings.ConveyorSpeed := csMiddle;
+ End;
+ End;
+ End;
+ 4: Begin // Scheme File
+ key := 0;
+ qf := TSchemQuestionForm.CreateNew(Nil);
+ qf.LoadSchemes(Tgame(fOwner).Settings.SchemeFile);
+ qf.ShowModal;
+ If qf.ModalResult = mrOK Then Begin
+ Tgame(fOwner).Settings.SchemeFile := qf.Listbox1.Items[qf.Listbox1.ItemIndex];
+ End;
+ qf.free;
+ End;
+ 5: Begin // Play Time
+ If key In [VK_LEFT, VK_SUBTRACT] Then Begin
+ Tgame(fOwner).Settings.PlayTime := max(0, Tgame(fOwner).Settings.PlayTime - 15);
+ If Tgame(fOwner).Settings.PlayTime < 80 Then Tgame(fOwner).Settings.PlayTime := 0;
+ End
+ Else Begin
+ If Tgame(fOwner).Settings.PlayTime = 0 Then Begin
+ Tgame(fOwner).Settings.PlayTime := 90;
+ End
+ Else Begin
+ Tgame(fOwner).Settings.PlayTime := Tgame(fOwner).Settings.PlayTime + 15;
+ End;
+ End;
+ End;
+ 6: Tgame(fOwner).Settings.LostPlayersRevertToAI := Not Tgame(fOwner).Settings.LostPlayersRevertToAI;
+ 7: Tgame(fOwner).Settings.PlaySounds := Not Tgame(fOwner).Settings.PlaySounds;
+ 8: Begin
+ key := 0;
+ kd := TKeyboardDialog.CreateNew(Nil);
+ kd.LoadKeys(Tgame(fOwner).Settings.Keys[ks0], Tgame(fOwner).Settings.Keys[ks1]);
+ If kd.Execute() Then Begin
+ Tgame(fOwner).Settings.Keys[ks0] := kd.GetKeys(ks0);
+ Tgame(fOwner).Settings.Keys[ks1] := kd.GetKeys(ks1);
+ End;
+ kd.Free;
+ End;
+ 9: Tgame(fOwner).Settings.Port := strtointdef(InputBox('Edit', 'Enter port', inttostr(Tgame(fOwner).Settings.Port)), 1234);
+ 10: Tgame(fOwner).Settings.ShowFPS := Not Tgame(fOwner).Settings.ShowFPS;
+ 11: Begin
+ Tgame(fOwner).Settings.Fullscreen := Not Tgame(fOwner).Settings.Fullscreen;
+ Form1.SetFullScreen(Tgame(fOwner).Settings.Fullscreen);
+{$IFDEF Windows}
+ If Tgame(fOwner).Settings.Fullscreen Then Begin
+ LogShow('To switch to Fullscreen mode, you need to restart the game.');
+ End;
+{$ENDIF}
+ End;
+ End;
+ End;
+End;
+
+Procedure TOptionsMenu.OnMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+Var
+ key: Word;
+Begin
+ // Der Klick auf die Buttons ;)
+ If (x > 60) And (x < 320) And
+ (y > 36) And
+ (y < 36 + 12 * 28)
+ Then Begin
+ fCursorPos := (y - 36) Div 28;
+ key := VK_RETURN;
+ OnKeyDown(Nil, key, []);
+ End;
+End;
+
+Constructor TOptionsMenu.Create(Owner: TObject);
+Begin
+ Inherited Create(Owner);
+ fBackFile := 'options.png';
+ fSoundFile := ''; // Die Optionen haben keinen Extra "Sound"
+ fCursorFile := 'options_cursor.png';
+End;
+
+Procedure TOptionsMenu.LoadFromDisk(ResPath: String);
+Begin
+ Inherited LoadFromDisk(ResPath);
+ fcursorTex := OpenGL_GraphikEngine.LoadAlphaColorGraphik(ResPath + fCursorFile, ColorToRGB(clfuchsia), smStretch);
+End;
+
+Procedure TOptionsMenu.Render;
+ Function PrettyTime(Value_s: integer): String;
+ Begin
+ If Value_s = 0 Then Begin
+ result := 'infinity';
+ End
+ Else Begin
+ result := format('%0.2d:%0.2d', [Value_s Div 60, Value_s Mod 60]);
+ End;
+ End;
+
+ Function ConveyerSpeedToString(aSpeed: TConveyorSpeed): String;
+ Begin
+ result := '';
+ Case aSpeed Of
+ csSlow: result := 'Slow';
+ csMiddle: result := 'Middle';
+ csFast: result := 'Fast';
+ End;
+ End;
+
+Begin
+ Inherited Render;
+ glBindTexture(GL_TEXTURE_2D, 0);
+ AtomicFont.BackColor := clblack;
+ AtomicFont.Color := clwhite;
+ AtomicFont.Textout(60, 37,
+ 'Team Play: ' + BoolToStr(TGame(fOwner).Settings.TeamPlay, 'Yes', 'No') + LineEnding + LineEnding +
+ 'Random Start: ' + BoolToStr(TGame(fOwner).Settings.RandomStart, 'Yes', 'No') + LineEnding + LineEnding +
+ 'Node Name: ''' + TGame(fOwner).Settings.NodeName + '''' + LineEnding + LineEnding +
+ 'Conveyor Speed: ' + ConveyerSpeedToString(TGame(fOwner).Settings.ConveyorSpeed) + LineEnding + LineEnding +
+ 'Scheme File: ' + TGame(fOwner).Settings.SchemeFile + LineEnding + LineEnding +
+ 'Play Time: ' + PrettyTime(TGame(fOwner).Settings.PlayTime) + LineEnding + LineEnding +
+ 'Lost net players revert to AIs: ' + BoolToStr(TGame(fOwner).Settings.LostPlayersRevertToAI, 'Yes', 'No') + LineEnding + LineEnding +
+ 'Disable music during gameplay: ' + BoolToStr(TGame(fOwner).Settings.PlaySounds, 'No', 'Yes') + LineEnding + LineEnding +
+ 'Define keyboard layouts' + LineEnding + LineEnding +
+ 'Network port: ' + inttostr(TGame(fOwner).Settings.Port) + LineEnding + LineEnding +
+ 'Show FPS: ' + BoolToStr(TGame(fOwner).Settings.ShowFPS, 'Yes', 'No') + LineEnding + LineEnding +
+ 'Fullscreen: ' + BoolToStr(TGame(fOwner).Settings.Fullscreen, 'Yes', 'No')
+ );
+
+ glPushMatrix();
+ glTranslatef(20, 25 + 28 * fCursorPos, atomic_Map_Layer + atomic_EPSILON);
+ RenderAlphaQuad(point(16, 16), 32, -32, 0, fcursorTex);
+ glPopMatrix();
+End;
+
+Procedure TOptionsMenu.Reset;
+Begin
+ fCursorPos := 0;
+End;
+
+{ TMainMenu }
+
+Procedure TMainMenu.OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState
+ );
+Var
+ f: TJoinQuestionForm;
+Begin
+ If key = VK_J Then Begin
+ // Frage IP und Port zum Game.JoinViaParams(ip, port); ab !
+ f := TJoinQuestionForm.CreateNew(Nil, 0);
+ f.Edit1.Text := TGame(fOwner).Settings.Router_IP;
+ f.Edit2.Text := TGame(fOwner).Settings.Router_Port;
+ If f.ShowModal = mrOK Then Begin
+ TGame(fOwner).JoinViaParams(f.Edit1.Text, strtointdef(f.Edit2.Text, 9876));
+ End;
+ f.free;
+ End;
+ If key = VK_DOWN Then Begin
+ // fCursorPos := min(fCursorPos + 1, 6);
+ fCursorPos := (fCursorPos + 1) Mod 7; // Feature Request by Community, rotating navigation
+ End;
+ If key = VK_UP Then Begin
+ // fCursorPos := max(fCursorPos - 1, 0);
+ fCursorPos := (fCursorPos + 6) Mod 7; // Feature Request by Community, rotating navigation
+ End;
+ If (key >= VK_1) And (key <= VK_7) Then Begin
+ fCursorPos := key - VK_1;
+ key := VK_RETURN;
+ End;
+ If key = VK_RETURN Then Begin
+ Case fCursorPos Of
+ 0: logshow('Not yet implemented.', llinfo); // TAtomic(fOwner).SwitchToScreen(); -- Single Player
+ 1: TGame(fOwner).SwitchToScreen(sHost);
+ 2: Begin
+ // Join Network Game - open IP/Port dialog (same as pressing J)
+ f := TJoinQuestionForm.CreateNew(Nil, 0);
+ f.Edit1.Text := TGame(fOwner).Settings.Router_IP;
+ f.Edit2.Text := TGame(fOwner).Settings.Router_Port;
+ If f.ShowModal = mrOK Then Begin
+ TGame(fOwner).JoinViaParams(f.Edit1.Text, strtointdef(f.Edit2.Text, 9876));
+ End;
+ f.free;
+ End;
+ 3: TGame(fOwner).SwitchToScreen(sOptions);
+ 4: logshow('Not yet implemented.', llinfo); //TGame(fOwner).SwitchToScreen(); -- About Bomberman
+ 5: logshow('Not yet implemented.', llinfo); //TGame(fOwner).SwitchToScreen(); -- Online Manual
+ 6: Begin
+{$IFNDEF Only3Player}
+ If ID_YES = Application.MessageBox('Do you really want to quit?', 'Question', MB_ICONQUESTION Or MB_YESNO) Then
+{$ENDIF}
+ TGame(fOwner).SwitchToScreen(sExitBomberman);
+ End;
+ End;
+ End;
+ If key = VK_ESCAPE Then Begin
+{$IFNDEF Only3Player}
+ If ID_YES = Application.MessageBox('Do you really want to quit?', 'Question', MB_ICONQUESTION Or MB_YESNO) Then
+{$ENDIF}
+ TGame(fOwner).SwitchToScreen(sExitBomberman);
+ End;
+End;
+
+Procedure TMainMenu.OnMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+Var
+ key: Word;
+Begin
+ // Der Klick auf die Buttons ;)
+ If (x > 350) And (x < 610) And
+ (y > 100) And (y < 100 + 7 * 37) Then Begin
+ fCursorPos := (y - 100) Div 37;
+ key := VK_RETURN;
+ OnKeyDown(Nil, key, []);
+ End;
+End;
+
+Constructor TMainMenu.Create(Owner: TObject);
+Begin
+ Inherited Create(Owner);
+ fBackFile := 'mainmenu.png';
+ fSoundFile := 'mainmenu_sound.wav';
+ fCursorFile := 'mainmenu_cursor.ani';
+ fCursor := TOpenGL_Animation.Create;
+End;
+
+Destructor TMainMenu.Destroy;
+Begin
+ fCursor.Free;
+ Inherited Destroy;
+End;
+
+Procedure TMainMenu.LoadFromDisk(ResPath: String);
+Begin
+ Inherited LoadFromDisk(ResPath);
+ fCursor.LoadFromFile(ResPath + fCursorFile);
+End;
+
+Procedure TMainMenu.Render;
+Begin
+ Inherited Render;
+ glPushMatrix();
+ glTranslatef(310, 100 + fCursorPos * 37, atomic_Map_Layer + atomic_EPSILON);
+ fCursor.Render(0);
+ glPopMatrix();
+End;
+
+Procedure TMainMenu.Reset;
+Begin
+ Inherited Reset;
+ fCursorPos := 0;
+End;
+
+{ TScreen }
+
+Procedure TScreen.OnKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
+Begin
+ // Nichts nur zum Überscheiben da..
+End;
+
+Procedure TScreen.OnMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+Begin
+ // Nichts nur zum Überscheiben da..
+End;
+
+Constructor TScreen.Create(Owner: TObject);
+Begin
+ fOwner := Owner;
+ If Not (fOwner Is TGame) Then Begin
+ Raise exception.Create('Error, Owner has to be TAtomic!');
+ End;
+ fBackFile := '';
+ fSoundFile := '';
+ fBackTex := 0;
+End;
+
+Destructor TScreen.Destroy;
+Begin
+ // Nix
+End;
+
+Procedure TScreen.Render;
+Begin
+ (*
+ * Die Hintergrund Graphik kann auf jeden Fall gerendert werden..
+ *)
+ glpushmatrix();
+ glTranslatef(0, 0, atomic_Map_Layer);
+ glColor3f(1, 1, 1);
+ RenderQuad(v2(0, 0), v2(GameWidth, GameHeight), 0, false, fBackTex);
+ glpopmatrix();
+End;
+
+Procedure TScreen.LoadFromDisk(ResPath: String);
+Begin
+ fSoundExitScreen := ResPath + 'menuexit.wav';
+ If fSoundFile <> '' Then Begin
+ fSoundFile := ResPath + fSoundFile;
+ End;
+ If fBackFile <> '' Then Begin
+ fBackTex := OpenGL_GraphikEngine.LoadGraphik(ResPath + fBackFile, smStretch);
+ End
+ Else Begin
+ fBackTex := 0;
+ End;
+End;
+
+Procedure TScreen.Reset;
+Begin
+ PlayerIsFirst := false;
+ StartPLaySong();
+End;
+
+Procedure TScreen.StartPLaySong();
+Begin
+ // Auf Jeden Fall soll mal die Passende Screen Musik abgespielt werden.
+ If trim(fSoundFile) <> '' Then Begin
+ TGame(fOwner).StartPlayingSong(fSoundFile);
+ End;
+End;
+
+End.
+
diff --git a/client/usounds.pas b/client/usounds.pas
index 61efc9d..f063180 100644
--- a/client/usounds.pas
+++ b/client/usounds.pas
@@ -171,7 +171,7 @@
// ggf. neu starten des Songs
If game.Settings.PlaySounds And (FileExists(Filename)) And (Filename <> '') Then Begin
// Start des Liedes in Endlosschleife
- fBassSong := BASS_StreamCreateFile(false, Pchar(filename), 0, 0, BASS_MUSIC_LOOP);
+ fBassSong := BASS_StreamCreateFile(0, Pchar(filename), 0, 0, BASS_MUSIC_LOOP);
If fBassSong = 0 Then Begin
LogShow('Error unable to load :' + LineEnding + filename + LineEnding + 'Error code :' + inttostr(BASS_ErrorGetCode), llCritical);
exit;
@@ -206,7 +206,7 @@
End;
End;
// Wir kennen den Sound noch nicht -> Aufnehmen und starten
- song := BASS_StreamCreateFile(false, Pchar(filename), 0, 0, 0);
+ song := BASS_StreamCreateFile(0, Pchar(filename), 0, 0, 0);
If Song = 0 Then Begin
LogShow('Error unable to load :' + LineEnding + filename + LineEnding + 'Error code :' + inttostr(BASS_ErrorGetCode), llCritical);
exit;
diff --git a/documentation/asset_download_preview.png b/documentation/asset_download_preview.png
index 4ac5a7b..82bfde6 100644
Binary files a/documentation/asset_download_preview.png and b/documentation/asset_download_preview.png differ
diff --git a/flyio_server/.dockerignore b/flyio_server/.dockerignore
new file mode 100644
index 0000000..155269e
--- /dev/null
+++ b/flyio_server/.dockerignore
@@ -0,0 +1,41 @@
+# .dockerignore for FPC Atomic TCP Server
+
+# macOS specific
+.DS_Store
+*.app
+app_*
+bin/
+
+# Build artifacts
+*.o
+*.ppu
+*.a
+lib/
+*.compiled
+*.or
+
+# Development
+.git/
+.gitignore
+*.log
+*.bak
+*~
+
+# IDE
+.vscode/
+.idea/
+*.lps
+
+# Test files
+test_*
+tools/packet_*
+tools/udp_*
+
+# Enet (not used for TCP)
+enet_src/
+flyio/echo_test/
+
+# Documentation
+*.md
+README*
+
diff --git a/flyio_server/Dockerfile b/flyio_server/Dockerfile
new file mode 100644
index 0000000..bbf2e72
--- /dev/null
+++ b/flyio_server/Dockerfile
@@ -0,0 +1,107 @@
+# Dockerfile for FPC Atomic TCP Server on Fly.io
+# Multi-stage build for smaller final image
+
+FROM ubuntu:22.04 AS builder
+
+WORKDIR /build
+
+# Install Lazarus and dependencies (including gcc for AI library)
+RUN apt-get update && DEBIAN_FRONTEND=noninteractive apt-get install -y \
+ fpc \
+ fp-compiler \
+ lazarus \
+ lazarus-ide-gtk2 \
+ libgtk2.0-dev \
+ build-essential \
+ gcc \
+ make \
+ && rm -rf /var/lib/apt/lists/*
+
+# Copy source code
+# Build context should be project root, not flyio_server/
+COPY server /build/server
+COPY units /build/units
+COPY client /build/client
+COPY ai /build/ai
+
+# Copy data directory
+# Note: Workflow ensures flyio_server/data exists (copies from data/ if needed)
+# If flyio_server/data doesn't exist, this will fail - but workflow should handle it
+COPY flyio_server/data /build/data
+
+# Download and setup LNet library (needed for server networking)
+# LNet is not in the repository, so we download it during build
+RUN echo "=== Downloading LNet library ===" && \
+ apt-get update && DEBIAN_FRONTEND=noninteractive apt-get install -y curl unzip && \
+ lnetUrl="https://github.com/PascalCorpsman/lnet/archive/refs/heads/master.zip" && \
+ lnetZip="/tmp/lnet.zip" && \
+ lnetDir="/tmp/lnet" && \
+ curl -L -f -o "$lnetZip" "$lnetUrl" || \
+ curl -L -f -o "$lnetZip" "https://github.com/PascalCorpsman/lnet/archive/master.zip" && \
+ unzip -q "$lnetZip" -d "$lnetDir" && \
+ lnetSourceDir=$(find "$lnetDir" -type d -name "lnet-*" | head -1) && \
+ mkdir -p /build/lnet_src && \
+ if [ -d "$lnetSourceDir/lazaruspackage" ]; then \
+ cp -r "$lnetSourceDir/lazaruspackage" /build/lnet_src/; \
+ fi && \
+ if [ -d "$lnetSourceDir/lib" ]; then \
+ mkdir -p /build/lnet_src/lib && \
+ cp -r "$lnetSourceDir/lib"/* /build/lnet_src/lib/; \
+ fi && \
+ rm -rf "$lnetZip" "$lnetDir" && \
+ apt-get purge -y curl unzip && \
+ apt-get autoremove -y && \
+ echo "=== LNet library downloaded and set up ===" && \
+ ls -la /build/lnet_src/
+
+# Build AI library (Pascal version - fully functional!)
+WORKDIR /build/ai
+RUN echo "=== Building Pascal AI library ===" && \
+ cp /build/server/uai_types.pas . && \
+ cp /build/units/ufifo.pas . && \
+ fpc -Tlinux -Px86_64 -O3 -CX -XX -Xs -vw ai.lpr && \
+ mv libai.so ../libai.so && \
+ echo "=== AI library built, checking..." && \
+ ls -la ../libai.so && \
+ file ../libai.so && \
+ nm -D ../libai.so | grep -E "(AiInit|AiHandlePlayer|AiVersion)" && \
+ echo "=== Pascal AI library OK ==="
+
+# Modify .lpi to use correct search paths for Docker build and compile
+WORKDIR /build/server
+RUN sed -i 's|../../Sample/TCP_IP;../../Sample/DatenSteuerung;../units;../../Sample/Graphik;../macos/third_party/lnet/lib;../macos/third_party/lnet_src/lazaruspackage|../units;../lnet_src/lib;../lnet_src/lazaruspackage|g' atomic_server.lpi && \
+ echo "=== Building TCP server with Lazarus ===" && \
+ lazbuild --lazarusdir=/usr/lib/lazarus/default --build-mode="Default" atomic_server.lpi && \
+ mkdir -p /app && \
+ mv /build/atomic_server /app/atomic_server && \
+ mv /build/libai.so /app/libai.so && \
+ ls -la /app/atomic_server /app/libai.so && \
+ file /app/atomic_server /app/libai.so
+
+# Runtime stage
+FROM debian:bookworm-slim
+
+WORKDIR /app
+
+# Install runtime dependencies
+RUN apt-get update && apt-get install -y \
+ libc6 \
+ && rm -rf /var/lib/apt/lists/*
+
+# Copy compiled server, AI library, and data directory
+COPY --from=builder /app/atomic_server /app/atomic_server
+COPY --from=builder /app/libai.so /app/libai.so
+COPY --from=builder /build/data /app/data
+
+# Make executable
+RUN chmod +x /app/atomic_server
+
+# Expose TCP port
+EXPOSE 5521/tcp
+
+# Run server
+# -p 5521 = port
+# -t 30000 = auto-shutdown after 30s with no players (for clean restart)
+# -l 2 = log level Info
+CMD ["/app/atomic_server", "-p", "5521", "-t", "30000", "-l", "2"]
+
diff --git a/flyio_server/README.cs.md b/flyio_server/README.cs.md
new file mode 100644
index 0000000..7d4bac5
--- /dev/null
+++ b/flyio_server/README.cs.md
@@ -0,0 +1,326 @@
+# Deployment FPC Atomic Server na Fly.io
+
+## 🌐 Co je Fly.io?
+
+**Fly.io** je cloudová platforma, která umožňuje spouštět aplikace na edge serverech po celém světě. Pro FPC Atomic server to znamená:
+
+- **Server mimo lokální síť** - Server běží v cloudu, takže nemusíte mít otevřený port ve vaší lokální síti
+- **Menší zátěž pro lokální síť** - Veškerý herní provoz jde přes Fly.io, ne přes vaši domácí síť
+- **Větší bezpečnost** - Nemusíte otevírat porty ve firewallu nebo routeru
+- **Každý si může vytvořit svůj server** - Každý hráč si může jednoduše vytvořit vlastní server pro sebe a své kamarády
+- **Automatické spouštění** - Server se nemusí spouštět ručně - spouští se automaticky, když se někdo připojí, a vypíná se po 30 sekundách nečinnosti
+
+## 📋 Požadavky
+
+1. **Fly.io Účet** - Vytvořte si bezplatný účet na [fly.io](https://fly.io)
+ - Přejděte na https://fly.io a zaregistrujte se (dostupný bezplatný tarif)
+ - K vytvoření účtu budete potřebovat emailovou adresu
+ - Bezplatný tarif zahrnuje 3 sdílené CPU VM a 3GB trvalého úložiště
+
+2. **Fly.io CLI** - Command Line Interface - nainstalovaný a přihlášený
+ ```bash
+ # Instalace (macOS)
+ curl -L https://fly.io/install.sh | sh
+
+ # Instalace (Linux)
+ curl -L https://fly.io/install.sh | sh
+
+ # Instalace (Windows - PowerShell)
+ powershell -Command "iwr https://fly.io/install.ps1 -useb | iex"
+
+ # Přihlášení (vyžaduje Fly.io účet)
+ flyctl auth login
+ ```
+
+2. **Git** - pro klonování repozitáře (volitelné, pokud používáte předpřipravený image)
+
+## 📋 Který deploy script použít?
+
+V repozitáři jsou dva deploy scripty:
+
+- **`deploy_prebuilt.sh`** (doporučeno) - Rychlejší varianta
+ - Používá předpřipravený Docker image z GitHub Container Registry
+ - Rychlejší (nekompiluje z source)
+ - Vyžaduje herní data (bez nich selže)
+ - Použij, pokud máš herní data a chceš rychlý deploy
+
+- **`build_and_deploy.sh`** - Pomalejší varianta
+ - Builduje server z Pascal source kódu
+ - Pomalejší (kompiluje během build procesu)
+ - Může pracovat bez herních dat (varuje, ale pokračuje)
+ - Použij, pokud chceš buildnout z aktuálního source kódu nebo nemáš herní data
+
+## 🚀 Rychlý postup
+
+### Varianta A: Deploy z předpřipraveného Docker image (doporučeno) - `deploy_prebuilt.sh`
+
+**Rychlejší varianta** - používá předpřipravený Docker image z GitHub Container Registry. Nemusíte mít nainstalovaný Pascal compiler ani Lazarus. Musíte ale přidat herní data extrahovaná z originálního CD.
+
+**⚠️ DŮLEŽITÉ: Herní data jsou vyžadována**
+
+Předpřipravený Docker image neobsahuje herní data kvůli licenčním důvodům. Musíte extrahovat data z originálního CD Atomic Bomberman a přidat je k deploymentu.
+
+1. **Extrahujte herní data:**
+ - Použijte CD Data Extractor (součást repozitáře) k extrakci dat z originálního CD
+ - Tím se vytvoří adresář `data` s mapami, zdroji a zvuky
+
+2. **Vytvořte adresář pro deployment:**
+ ```bash
+ mkdir fpc-atomic-server
+ cd fpc-atomic-server
+ ```
+
+3. **Zkopírujte herní data:**
+ ```bash
+ # Zkopírujte extrahovaný adresář data
+ cp -r /cesta/k/extrahovanym/datam .
+ ```
+
+ Adresář `data` by měl obsahovat:
+ - `maps/` - herní mapy
+ - `res/` - zdroje, textury, atd.
+ - `sounds/` - zvukové efekty
+
+4. **Naklonujte repozitář (pro získání deploy scriptu):**
+ ```bash
+ git clone https://github.com/PavelZverina/fpc_atomic_macos.git
+ cd fpc_atomic/flyio_server
+ ```
+
+5. **Zkopírujte svůj adresář data:**
+ ```bash
+ # Zkopírujte extrahovaná data do flyio_server/
+ cp -r /cesta/k/extrahovanym/datam .
+ ```
+
+6. **Deploy na Fly.io:**
+ ```bash
+ # Použijte deploy script, který přidá data k předpřipravenému image
+ ./deploy_prebuilt.sh
+ ```
+
+ **Alternativa - Ruční deployment:**
+
+ Pokud preferujete ruční deployment, můžete vytvořit vlastní Dockerfile:
+ ```dockerfile
+ FROM ghcr.io/PavelZverina/fpc-atomic-server:latest
+ COPY data /app/data
+ ```
+
+ Pak vytvořte `fly.toml`:
+ ```toml
+ app = "your-app-name-here" # Změňte to na váš unikátní název aplikace
+ primary_region = "fra"
+
+ [build]
+ dockerfile = "Dockerfile"
+
+ [env]
+ PORT = "5521"
+
+ [[services]]
+ protocol = "tcp"
+ internal_port = 5521
+ processes = ["app"]
+ auto_stop_machines = true
+ auto_start_machines = true
+ min_machines_running = 0
+
+ [[services.ports]]
+ port = 5521
+ ```
+
+ Pak deployujte:
+ ```bash
+ flyctl deploy
+ ```
+
+### Varianta B: Build z source kódu a deploy - `build_and_deploy.sh`
+
+**Pomalejší varianta** - builduje server z Pascal source kódu a pak ho deployuje. Vyžaduje Pascal compiler (ale ten je už v Dockerfile, takže nemusíte mít nic lokálně nainstalované). Může pracovat i bez herních dat (server poběží, ale bez map).
+
+**⚠️ DŮLEŽITÉ: Herní data jsou vyžadována**
+
+Před deployem musíte extrahovat herní data z originálního CD Atomic Bomberman a zkopírovat je do adresáře `flyio_server/data`.
+
+1. **Extrahujte herní data:**
+ - Použijte CD Data Extractor (součást repozitáře) k extrakci dat z originálního CD
+ - Tím se vytvoří adresář `data` s mapami, zdroji a zvuky
+
+2. **Zkopírujte data do flyio_server:**
+ ```bash
+ # Zkopírujte extrahovaný adresář data do flyio_server/
+ cp -r /cesta/k/extrahovanym/datam flyio_server/data
+ ```
+
+ Adresář `flyio_server/data` by měl obsahovat:
+ - `maps/` - herní mapy
+ - `res/` - zdroje, textury, atd.
+ - `sounds/` - zvukové efekty
+
+3. **Naklonujte repozitář:**
+ ```bash
+ git clone https://github.com/PavelZverina/fpc_atomic_macos.git
+ cd fpc_atomic
+ ```
+
+4. **Nastavte název aplikace v .env souboru:**
+
+ Vytvořte nebo upravte `.env` soubor v rootu projektu:
+ ```bash
+ # V rootu projektu (ne v flyio_server/)
+ echo "FLY_APP_NAME=fpc-atomic-tcp-server-moje-jmeno" >> .env
+ ```
+
+ **Důležité:** Název aplikace je uložen v `.env` souboru (který je v `.gitignore`), takže můžeš commitovat `fly.toml` do gitu bez odhalení svého názvu aplikace.
+
+5. **Deploy na Fly.io:**
+
+ **Nejjednodušší způsob - použijte build and deploy script:**
+ ```bash
+ cd flyio_server
+ ./build_and_deploy.sh
+ ```
+
+ **Co tento script dělá:**
+ - Builduje server z Pascal source kódu (kompilace probíhá v Docker image)
+ - Deployuje buildu na Fly.io
+ - Může pracovat bez herních dat (varuje, ale pokračuje)
+
+ **Nebo ručně:**
+ ```bash
+ # Ujistěte se, že jste v rootu projektu
+ cd /cesta/k/fpc_atomic
+
+ # První deploy (vytvoří novou aplikaci)
+ flyctl deploy --config flyio_server/fly.toml
+
+ # Nebo pokud už máte aplikaci
+ flyctl deploy --config flyio_server/fly.toml
+ ```
+
+ **Poznámka:** Build context musí být root projektu (ne `flyio_server/`), takže vždy spouštějte `flyctl deploy` z rootu projektu s `--config flyio_server/fly.toml`.
+
+ **Poznámka:** Pokud nezahrnete herní data, server se zbuildí a poběží, ale bez herních map. Budou dostupné pouze náhodné mapy.
+
+### 3. Zobrazení informací
+
+```bash
+# Zobrazit status a IP adresu
+flyctl status
+
+# Zobrazit logy
+flyctl logs
+
+# SSH do kontejneru (pro debugging)
+flyctl ssh console
+```
+
+## 📝 Co se děje při deployi?
+
+1. **Build**: Dockerfile automaticky:
+ - Zkompiluje AI knihovnu (`libai.so`) pro Linux
+ - Zkompiluje server (`atomic_server`) pro Linux
+ - Zkopíruje data adresář (obsahuje mapy a další herní data)
+
+2. **Deploy**: Fly.io:
+ - Vytvoří Docker image
+ - Spustí server na portu 5521
+ - Server se automaticky vypne po 30 sekundách nečinnosti (auto_stop_machines)
+ - Server se automaticky zapne při novém připojení (auto_start_machines)
+
+## ⚙️ Konfigurace
+
+### Port
+Server naslouchá na portu **5521** (nastaveno v `fly.toml` a `Dockerfile`).
+
+### Timeout
+Server se automaticky vypne po **30 sekundách** nečinnosti (nastaveno v `Dockerfile` jako `-t 30000`).
+
+### Region
+Defaultní region je **Frankfurt (fra)** - můžete změnit v `fly.toml`.
+
+## 🔧 Troubleshooting
+
+### Build selže
+
+1. Zkontrolujte, že všechny potřebné soubory jsou v projektu:
+ - `server/` - zdrojové kódy serveru
+ - `units/` - jednotky
+ - `macos/third_party/lnet_src/` - LNet knihovna
+ - `macos/data/` - game data
+ - `ai/` - AI knihovna
+
+2. Zkuste lokální build:
+ ```bash
+ docker build -t fpc-atomic-test .
+ ```
+
+### Server se nespustí
+
+1. Zkontrolujte logy:
+ ```bash
+ flyctl logs
+ ```
+
+2. Ověřte, že data adresář existuje a obsahuje potřebné soubory (mapy v `data/maps/`)
+
+### Připojení klientů
+
+**⚠️ DŮLEŽITÉ: Každý server má svou vlastní adresu**
+
+Každý, kdo nasadí server na fly.io, má svou vlastní unikátní adresu. Pokud více lidí použije stejný název aplikace, budou se snažit deploynout do stejné aplikace, což nebude fungovat - každý musí mít svůj vlastní účet a aplikaci.
+
+**DŮLEŽITÉ:** Před deployem změňte název aplikace v `fly.toml` na něco unikátního, například:
+```toml
+app = "fpc-atomic-tcp-server-moje-jmeno"
+```
+
+**Jak zjistit adresu serveru:**
+
+1. **DNS adresa (doporučeno):** `.fly.dev`
+ - Například: `your-app-name-here.fly.dev`
+ - Tato adresa se nemění a je spolehlivější než IP adresa
+ - Zjistíte ji z názvu aplikace v `fly.toml` nebo z:
+ ```bash
+ flyctl status
+ ```
+
+2. **IP adresa (alternativa):**
+ ```bash
+ flyctl status
+ ```
+ - IP adresa se může měnit, proto je lepší použít DNS jméno
+
+**Připojení v klientovi:**
+
+1. Stiskněte **"j"** v hlavním menu
+2. Zadejte adresu serveru:
+ - **DNS adresa:** `.fly.dev` (např. `your-app-name-here.fly.dev`)
+ - **Nebo IP adresa:** z `flyctl status`
+3. Zadejte port: **5521**
+4. Stiskněte **OK**
+
+**Alternativa - Command line parametry:**
+```bash
+./fpc_atomic -ip your-app-name-here.fly.dev -port 5521
+```
+
+## 📊 Monitoring
+
+```bash
+# Reálné logy
+flyctl logs
+
+# Status aplikace
+flyctl status
+
+# Metriky
+flyctl metrics
+```
+
+## 🔗 Užitečné odkazy
+
+- [Fly.io dokumentace](https://fly.io/docs/)
+- [Fly.io CLI reference](https://fly.io/docs/flyctl/)
+
diff --git a/flyio_server/README.md b/flyio_server/README.md
new file mode 100644
index 0000000..d7a35d2
--- /dev/null
+++ b/flyio_server/README.md
@@ -0,0 +1,324 @@
+# Deploying FPC Atomic Server to Fly.io
+
+## 🌐 What is Fly.io?
+
+**Fly.io** is a cloud platform that allows you to run applications on edge servers around the world. For FPC Atomic server, this means:
+
+- **Server outside local network** - Server runs in the cloud, so you don't need to open ports in your local network
+- **Less load on local network** - All game traffic goes through Fly.io, not through your home network
+- **Better security** - You don't need to open ports in your firewall or router
+- **Everyone can create their own server** - Each player can easily create their own server for themselves and their friends
+- **Automatic startup** - Server doesn't need to be started manually - it starts automatically when someone connects, and shuts down after 30 seconds of inactivity
+
+## 📋 Requirements
+
+1. **Fly.io Account** - Create a free account at [fly.io](https://fly.io)
+ - Go to https://fly.io and register (free tier available)
+ - You'll need an email address to create an account
+ - Free tier includes 3 shared CPU VMs and 3GB persistent storage
+
+2. **Fly.io CLI** - Command Line Interface - installed and logged in
+ ```bash
+ # Installation (macOS)
+ curl -L https://fly.io/install.sh | sh
+
+ # Installation (Linux)
+ curl -L https://fly.io/install.sh | sh
+
+ # Installation (Windows - PowerShell)
+ powershell -Command "iwr https://fly.io/install.ps1 -useb | iex"
+
+ # Login (requires Fly.io account)
+ flyctl auth login
+ ```
+
+3. **Git** - for cloning the repository (optional, if using pre-built image)
+
+## 📋 Which deploy script to use?
+
+There are two deploy scripts in the repository:
+
+- **`deploy_prebuilt.sh`** (recommended) - Faster option
+ - Uses pre-built Docker image from GitHub Container Registry
+ - Faster (doesn't compile from source)
+ - Requires game data (will fail without it)
+ - Use if you have game data and want a quick deploy
+
+- **`build_and_deploy.sh`** - Slower option
+ - Builds server from Pascal source code
+ - Slower (compiles during build process)
+ - Can work without game data (warns but continues)
+ - Use if you want to build from current source code or don't have game data
+
+## 🚀 Quick Start
+
+### Option A: Deploy from pre-built Docker image (recommended) - `deploy_prebuilt.sh`
+
+**Faster option** - uses pre-built Docker image from GitHub Container Registry. You don't need to have Pascal compiler or Lazarus installed. However, you must add game data extracted from the original CD.
+
+**⚠️ IMPORTANT: Game data is required**
+
+The pre-built Docker image doesn't contain game data due to licensing reasons. You must extract data from the original Atomic Bomberman CD and add it to the deployment.
+
+1. **Extract game data:**
+ - Use CD Data Extractor (part of the repository) to extract data from the original CD
+ - This will create a `data` directory with maps, resources, and sounds
+
+2. **Create deployment directory:**
+ ```bash
+ mkdir fpc-atomic-server
+ cd fpc-atomic-server
+ ```
+
+3. **Copy game data:**
+ ```bash
+ # Copy the extracted data directory
+ cp -r /path/to/extracted/data .
+ ```
+
+ The `data` directory should contain:
+ - `maps/` - game maps
+ - `res/` - resources, textures, etc.
+ - `sounds/` - sound effects
+
+4. **Clone the repository (to get the deploy script):**
+ ```bash
+ git clone https://github.com/your-username/fpc_atomic.git
+ cd fpc_atomic/flyio_server
+ ```
+
+5. **Copy your data directory:**
+ ```bash
+ # Copy extracted data to flyio_server/
+ cp -r /path/to/extracted/data .
+ ```
+
+6. **Deploy to Fly.io:**
+ ```bash
+ # Use the deploy script, which will add data to the pre-built image
+ ./deploy_prebuilt.sh
+ ```
+
+ **Alternative - Manual deployment:**
+
+ If you prefer manual deployment, you can create your own Dockerfile:
+ ```dockerfile
+ FROM ghcr.io/your-username/fpc-atomic-server:latest
+ COPY data /app/data
+ ```
+
+ Then create `fly.toml`:
+ ```toml
+ app = "your-app-name-here" # Change this to your unique application name
+ primary_region = "fra"
+
+ [build]
+ dockerfile = "Dockerfile"
+
+ [env]
+ PORT = "5521"
+
+ [[services]]
+ protocol = "tcp"
+ internal_port = 5521
+ processes = ["app"]
+ auto_stop_machines = true
+ auto_start_machines = true
+ min_machines_running = 0
+
+ [[services.ports]]
+ port = 5521
+ ```
+
+ Then deploy:
+ ```bash
+ flyctl deploy
+ ```
+
+### Option B: Build from source code and deploy - `build_and_deploy.sh`
+
+**Slower option** - builds server from Pascal source code and then deploys it. Requires Pascal compiler (but it's already in Dockerfile, so you don't need anything installed locally). Can work even without game data (server will run, but without maps).
+
+**⚠️ IMPORTANT: Game data is required**
+
+Before deploying, you must extract game data from the original Atomic Bomberman CD and copy it to the `flyio_server/data` directory.
+
+1. **Extract game data:**
+ - Use CD Data Extractor (part of the repository) to extract data from the original CD
+ - This will create a `data` directory with maps, resources, and sounds
+
+2. **Copy data to flyio_server:**
+ ```bash
+ # Copy extracted data directory to flyio_server/
+ cp -r /path/to/extracted/data flyio_server/data
+ ```
+
+ The `flyio_server/data` directory should contain:
+ - `maps/` - game maps
+ - `res/` - resources, textures, etc.
+ - `sounds/` - sound effects
+
+3. **Clone the repository:**
+ ```bash
+ git clone https://github.com/your-username/fpc_atomic.git
+ cd fpc_atomic
+ ```
+
+4. **Set application name in .env file:**
+
+ Create or edit `.env` file in the project root:
+ ```bash
+ # In project root (not in flyio_server/)
+ echo "FLY_APP_NAME=fpc-atomic-tcp-server-my-name" >> .env
+ ```
+
+ **Important:** The application name is stored in the `.env` file (which is in `.gitignore`), so you can commit `fly.toml` to git without revealing your application name.
+
+5. **Deploy to Fly.io:**
+
+ **Easiest way - use the build and deploy script:**
+ ```bash
+ cd flyio_server
+ ./build_and_deploy.sh
+ ```
+
+ **What this script does:**
+ - Builds server from Pascal source code (compilation happens in Docker image)
+ - Deploys the build to Fly.io
+ - Can work without game data (warns but continues)
+
+ **Or manually:**
+ ```bash
+ # Make sure you're in the project root
+ cd /path/to/fpc_atomic
+
+ # First deploy (creates new application)
+ flyctl deploy --config flyio_server/fly.toml
+
+ # Or if you already have an application
+ flyctl deploy --config flyio_server/fly.toml
+ ```
+
+ **Note:** Build context must be the project root (not `flyio_server/`), so always run `flyctl deploy` from the project root with `--config flyio_server/fly.toml`.
+
+ **Note:** If you don't include game data, the server will build and run, but without game maps. Only random maps will be available.
+
+### 3. View information
+
+```bash
+# Show status and IP address
+flyctl status
+
+# Show logs
+flyctl logs
+
+# SSH into container (for debugging)
+flyctl ssh console
+```
+
+## 📝 What happens during deployment?
+
+1. **Build**: Dockerfile automatically:
+ - Compiles AI library (`libai.so`) for Linux
+ - Compiles server (`atomic_server`) for Linux
+ - Copies data directory (contains maps and other game data)
+
+2. **Deploy**: Fly.io:
+ - Creates Docker image
+ - Starts server on port 5521
+ - Server automatically shuts down after 30 seconds of inactivity (auto_stop_machines)
+ - Server automatically starts on new connection (auto_start_machines)
+
+## ⚙️ Configuration
+
+### Port
+Server listens on port **5521** (set in `fly.toml` and `Dockerfile`).
+
+### Timeout
+Server automatically shuts down after **30 seconds** of inactivity (set in `Dockerfile` as `-t 30000`).
+
+### Region
+Default region is **Frankfurt (fra)** - you can change it in `fly.toml`.
+
+## 🔧 Troubleshooting
+
+### Build fails
+
+1. Check that all required files are in the project:
+ - `server/` - server source code
+ - `units/` - units
+ - `ai/` - AI library
+ - `data/` - game data
+
+2. Try local build:
+ ```bash
+ docker build -t fpc-atomic-test -f flyio_server/Dockerfile .
+ ```
+
+### Server doesn't start
+
+1. Check logs:
+ ```bash
+ flyctl logs
+ ```
+
+2. Verify that data directory exists and contains required files (maps in `data/maps/`)
+
+### Client connections
+
+**⚠️ IMPORTANT: Each server has its own address**
+
+Everyone who deploys a server on fly.io has their own unique address. If multiple people use the same application name, they will try to deploy to the same application, which won't work - everyone must have their own account and application.
+
+**IMPORTANT:** Before deploying, change the application name in `fly.toml` to something unique, for example:
+```toml
+app = "fpc-atomic-tcp-server-my-name"
+```
+
+**How to find server address:**
+
+1. **DNS address (recommended):** `.fly.dev`
+ - For example: `your-app-name-here.fly.dev`
+ - This address doesn't change and is more reliable than IP address
+ - You can find it from the application name in `fly.toml` or from:
+ ```bash
+ flyctl status
+ ```
+
+2. **IP address (alternative):**
+ ```bash
+ flyctl status
+ ```
+ - IP address may change, so it's better to use DNS name
+
+**Connecting in client:**
+
+1. Press **"j"** in the main menu
+2. Enter server address:
+ - **DNS address:** `.fly.dev` (e.g., `your-app-name-here.fly.dev`)
+ - **Or IP address:** from `flyctl status`
+3. Enter port: **5521**
+4. Press **OK**
+
+**Alternative - Command line parameters:**
+```bash
+./fpc_atomic -ip your-app-name-here.fly.dev -port 5521
+```
+
+## 📊 Monitoring
+
+```bash
+# Real-time logs
+flyctl logs
+
+# Application status
+flyctl status
+
+# Metrics
+flyctl metrics
+```
+
+## 🔗 Useful links
+
+- [Fly.io documentation](https://fly.io/docs/)
+- [Fly.io CLI reference](https://fly.io/docs/flyctl/)
diff --git a/flyio_server/build_and_deploy.sh b/flyio_server/build_and_deploy.sh
new file mode 100755
index 0000000..06cff7f
--- /dev/null
+++ b/flyio_server/build_and_deploy.sh
@@ -0,0 +1,160 @@
+#!/bin/bash
+# Build and deploy FPC Atomic Server to Fly.io from source code
+# This script builds the server from Pascal source code and deploys it to Fly.io
+# Works on macOS, Linux, and Windows (with Git Bash or WSL)
+# This script ensures the correct build context (project root) is used
+
+set -euo pipefail
+
+SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)"
+PROJECT_ROOT="$(cd "${SCRIPT_DIR}/.." && pwd)"
+FLYIO_DIR="${SCRIPT_DIR}"
+
+echo "========================================="
+echo "Deploying FPC Atomic Server to Fly.io"
+echo "========================================="
+echo ""
+
+# Check if flyctl is installed
+if ! command -v flyctl &> /dev/null; then
+ echo "Error: flyctl is not installed" >&2
+ echo "Please install it using:" >&2
+ echo " curl -L https://fly.io/install.sh | sh" >&2
+ echo "Or visit: https://fly.io/docs/getting-started/installing-flyctl/" >&2
+ exit 1
+fi
+
+# Check if fly.toml exists
+if [[ ! -f "${FLYIO_DIR}/fly.toml" ]]; then
+ echo "Error: fly.toml not found at ${FLYIO_DIR}/fly.toml" >&2
+ exit 1
+fi
+
+# Load app name from .env file (if exists)
+FLY_APP_NAME=""
+if [[ -f "${PROJECT_ROOT}/.env" ]]; then
+ # Extract FLY_APP_NAME from .env file
+ # Handles: FLY_APP_NAME=value, export FLY_APP_NAME=value, FLY_APP_NAME="value", FLY_APP_NAME='value', and comments
+ FLY_APP_NAME=$(grep -E '^[[:space:]]*(export[[:space:]]+)?FLY_APP_NAME[[:space:]]*=' "${PROJECT_ROOT}/.env" 2>/dev/null | head -1 | sed -E 's/^[[:space:]]*(export[[:space:]]+)?FLY_APP_NAME[[:space:]]*=[[:space:]]*//' | sed -E 's/^["'\''](.*)["'\'']$/\1/' | sed -E 's/[[:space:]]*#.*$//' | tr -d '[:space:]')
+ if [[ -n "${FLY_APP_NAME:-}" ]]; then
+ echo "✓ Using app name from .env: ${FLY_APP_NAME}"
+ fi
+fi
+
+# If FLY_APP_NAME is not set, try to extract from fly.toml placeholder
+if [[ -z "${FLY_APP_NAME:-}" ]]; then
+ # Check if fly.toml contains placeholder
+ if grep -q '\${FLY_APP_NAME}' "${FLYIO_DIR}/fly.toml" 2>/dev/null; then
+ echo "⚠️ Error: FLY_APP_NAME not found in .env file" >&2
+ echo "Please add FLY_APP_NAME=your-app-name to ${PROJECT_ROOT}/.env" >&2
+ exit 1
+ fi
+ # If no placeholder, extract actual app name from fly.toml
+ FLY_APP_NAME=$(grep -E '^app\s*=' "${FLYIO_DIR}/fly.toml" | head -1 | sed -E 's/^app\s*=\s*["'\'']?([^"'\'']+)["'\'']?.*/\1/' | tr -d ' ')
+ if [[ -n "${FLY_APP_NAME}" ]]; then
+ echo "✓ Using app name from fly.toml: ${FLY_APP_NAME}"
+ fi
+fi
+
+# Create temporary fly.toml with replaced app name
+TEMP_FLY_TOML="${FLYIO_DIR}/fly.toml.tmp"
+if [[ -n "${FLY_APP_NAME:-}" ]]; then
+ # Replace ${FLY_APP_NAME} placeholder in fly.toml
+ sed "s|\${FLY_APP_NAME}|${FLY_APP_NAME}|g" "${FLYIO_DIR}/fly.toml" > "${TEMP_FLY_TOML}"
+ echo "✓ Created temporary fly.toml with app name: ${FLY_APP_NAME}"
+else
+ echo "⚠️ Warning: No app name found, using fly.toml as-is" >&2
+ cp "${FLYIO_DIR}/fly.toml" "${TEMP_FLY_TOML}"
+fi
+
+# Check if Dockerfile exists
+if [[ ! -f "${FLYIO_DIR}/Dockerfile" ]]; then
+ echo "Error: Dockerfile not found at ${FLYIO_DIR}/Dockerfile" >&2
+ exit 1
+fi
+
+# Check if data directory exists in flyio_server/
+if [[ ! -d "${FLYIO_DIR}/data" ]]; then
+ echo "========================================="
+ echo "⚠️ WARNING: Game data directory not found!"
+ echo "========================================="
+ echo ""
+ echo "The server will work but WITHOUT game maps (only random maps available)."
+ echo ""
+ echo "To add game data before deployment:"
+ echo " 1. Extract data from the original Atomic Bomberman CD"
+ echo " using the CD Data Extractor tool (included in the repository)"
+ echo " 2. Copy the extracted 'data' directory to:"
+ echo " ${FLYIO_DIR}/data"
+ echo ""
+ echo "The data directory should contain:"
+ echo " - maps/ (game maps)"
+ echo " - res/ (resources, textures, etc.)"
+ echo " - sounds/ (sound effects)"
+ echo ""
+
+ # Check if data exists in project root as alternative
+ if [[ -d "${PROJECT_ROOT}/data" ]]; then
+ echo "Found data directory in project root: ${PROJECT_ROOT}/data"
+ read -p "Copy it to flyio_server/data? (y/N) " -n 1 -r
+ echo ""
+ if [[ $REPLY =~ ^[Yy]$ ]]; then
+ echo "Copying data directory..."
+ cp -r "${PROJECT_ROOT}/data" "${FLYIO_DIR}/data"
+ echo "✓ Data directory copied"
+ else
+ read -p "Continue deployment without game data? (y/N) " -n 1 -r
+ echo ""
+ if [[ ! $REPLY =~ ^[Yy]$ ]]; then
+ echo "Deployment cancelled."
+ exit 0
+ fi
+ fi
+ else
+ read -p "Continue deployment without game data? (y/N) " -n 1 -r
+ echo ""
+ if [[ ! $REPLY =~ ^[Yy]$ ]]; then
+ echo "Deployment cancelled."
+ exit 0
+ fi
+ fi
+else
+ echo "✓ Game data directory found at ${FLYIO_DIR}/data"
+fi
+
+# Change to project root (build context must be project root)
+cd "${PROJECT_ROOT}"
+
+echo ""
+echo "Build context: ${PROJECT_ROOT}"
+echo "Fly.io config: ${FLYIO_DIR}/fly.toml"
+echo "Dockerfile: ${FLYIO_DIR}/Dockerfile"
+echo ""
+
+# Deploy to Fly.io
+# Build context is project root, so we use --config to point to temporary fly.toml
+echo "Starting deployment..."
+flyctl deploy --config "${TEMP_FLY_TOML}" "$@"
+
+# Cleanup temporary file
+rm -f "${TEMP_FLY_TOML}"
+
+echo ""
+echo "========================================="
+echo "Deployment complete!"
+echo "========================================="
+echo ""
+echo "To check server status:"
+if [[ -n "${FLY_APP_NAME:-}" ]]; then
+ echo " flyctl status --app ${FLY_APP_NAME}"
+else
+ echo " flyctl status --config ${FLYIO_DIR}/fly.toml"
+fi
+echo ""
+echo "To view logs:"
+if [[ -n "${FLY_APP_NAME:-}" ]]; then
+ echo " flyctl logs --app ${FLY_APP_NAME}"
+else
+ echo " flyctl logs --config ${FLYIO_DIR}/fly.toml"
+fi
+echo ""
diff --git a/flyio_server/deploy_prebuilt.sh b/flyio_server/deploy_prebuilt.sh
new file mode 100755
index 0000000..5c8e93a
--- /dev/null
+++ b/flyio_server/deploy_prebuilt.sh
@@ -0,0 +1,228 @@
+#!/bin/bash
+# Deploy FPC Atomic Server to Fly.io using pre-built Docker image from GitHub
+# This script uses a pre-built Docker image from GitHub Container Registry and adds game data
+# Faster than building from source - no compilation needed
+# Works on macOS, Linux, and Windows (with Git Bash or WSL)
+
+set -euo pipefail
+
+SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)"
+PROJECT_ROOT="$(cd "${SCRIPT_DIR}/.." && pwd)"
+FLYIO_DIR="${SCRIPT_DIR}"
+
+# Default base image
+BASE_IMAGE="${BASE_IMAGE:-ghcr.io/PavelZverina/fpc-atomic-server:latest}"
+
+echo "========================================="
+echo "Deploying FPC Atomic Server to Fly.io"
+echo "Using pre-built image + game data"
+echo "========================================="
+echo ""
+
+# Check if flyctl is installed
+if ! command -v flyctl &> /dev/null; then
+ echo "Error: flyctl is not installed" >&2
+ echo "Please install it using:" >&2
+ echo " curl -L https://fly.io/install.sh | sh" >&2
+ exit 1
+fi
+
+# Check if Docker is installed (needed for local build)
+if ! command -v docker &> /dev/null; then
+ echo "Error: Docker is not installed" >&2
+ echo "This script requires Docker to build a custom image with game data." >&2
+ echo "Please install Docker Desktop or Docker Engine." >&2
+ exit 1
+fi
+
+# Check if data directory exists
+if [[ ! -d "${FLYIO_DIR}/data" ]]; then
+ echo "========================================="
+ echo "⚠️ ERROR: Game data directory not found!"
+ echo "========================================="
+ echo ""
+ echo "This script requires game data to be present."
+ echo ""
+ echo "To add game data:"
+ echo " 1. Extract data from the original Atomic Bomberman CD"
+ echo " using the CD Data Extractor tool"
+ echo " 2. Copy the extracted 'data' directory to:"
+ echo " ${FLYIO_DIR}/data"
+ echo ""
+ echo "The data directory should contain:"
+ echo " - maps/ (game maps)"
+ echo " - res/ (resources, textures, etc.)"
+ echo " - sounds/ (sound effects)"
+ echo ""
+
+ # Check if data exists in project root as alternative
+ if [[ -d "${PROJECT_ROOT}/data" ]]; then
+ echo "Found data directory in project root: ${PROJECT_ROOT}/data"
+ read -p "Copy it to flyio_server/data? (y/N) " -n 1 -r
+ echo ""
+ if [[ $REPLY =~ ^[Yy]$ ]]; then
+ echo "Copying data directory..."
+ cp -r "${PROJECT_ROOT}/data" "${FLYIO_DIR}/data"
+ echo "✓ Data directory copied"
+ else
+ echo "Deployment cancelled."
+ exit 1
+ fi
+ else
+ echo "Deployment cancelled. Please add game data first."
+ exit 1
+ fi
+else
+ echo "✓ Game data directory found at ${FLYIO_DIR}/data"
+fi
+
+# Verify data directory has required content
+if [[ ! -d "${FLYIO_DIR}/data/maps" ]]; then
+ echo "Warning: data/maps directory not found. Server will work but without game maps." >&2
+fi
+
+# Create temporary Dockerfile that uses base image + adds data
+TEMP_DOCKERFILE="${FLYIO_DIR}/Dockerfile.with_data"
+cat > "${TEMP_DOCKERFILE}" << EOF
+# Temporary Dockerfile for deployment with game data
+# This file is auto-generated by deploy_prebuilt.sh
+# It uses the pre-built base image and adds game data
+
+FROM ${BASE_IMAGE}
+
+# Copy game data into the image
+COPY data /app/data
+
+# The base image already has the server binary and all dependencies
+# We just need to add the game data
+EOF
+
+echo ""
+echo "Created temporary Dockerfile: ${TEMP_DOCKERFILE}"
+echo "Base image: ${BASE_IMAGE}"
+echo ""
+
+# Load app name from .env file (if exists)
+APP_NAME=""
+if [[ -f "${PROJECT_ROOT}/.env" ]]; then
+ # Extract FLY_APP_NAME from .env file
+ # Handles: FLY_APP_NAME=value, export FLY_APP_NAME=value, FLY_APP_NAME="value", FLY_APP_NAME='value', and comments
+ FLY_APP_NAME=$(grep -E '^[[:space:]]*(export[[:space:]]+)?FLY_APP_NAME[[:space:]]*=' "${PROJECT_ROOT}/.env" 2>/dev/null | head -1 | sed -E 's/^[[:space:]]*(export[[:space:]]+)?FLY_APP_NAME[[:space:]]*=[[:space:]]*//' | sed -E 's/^["'\''](.*)["'\'']$/\1/' | sed -E 's/[[:space:]]*#.*$//' | tr -d '[:space:]')
+ if [[ -n "${FLY_APP_NAME:-}" ]]; then
+ APP_NAME="${FLY_APP_NAME}"
+ echo "✓ Using app name from .env: ${APP_NAME}"
+ fi
+fi
+
+# If FLY_APP_NAME is not set, try to extract from fly.toml
+if [[ -z "${APP_NAME:-}" ]]; then
+ if [[ -f "${FLYIO_DIR}/fly.toml" ]]; then
+ # Check if fly.toml contains placeholder
+ if grep -q '\${FLY_APP_NAME}' "${FLYIO_DIR}/fly.toml" 2>/dev/null; then
+ echo "⚠️ Error: FLY_APP_NAME not found in .env file" >&2
+ echo "Please add FLY_APP_NAME=your-app-name to ${PROJECT_ROOT}/.env" >&2
+ exit 1
+ fi
+ # Try to extract app name from existing fly.toml
+ EXTRACTED_APP=$(grep -E '^app\s*=' "${FLYIO_DIR}/fly.toml" | head -1 | sed -E 's/^app\s*=\s*["'\'']?([^"'\'']+)["'\'']?.*/\1/' | tr -d ' ')
+ if [[ -n "${EXTRACTED_APP}" && "${EXTRACTED_APP}" != "your-app-name-here" && "${EXTRACTED_APP}" != "\${FLY_APP_NAME}" ]]; then
+ APP_NAME="${EXTRACTED_APP}"
+ echo "✓ Using app name from fly.toml: ${APP_NAME}"
+ fi
+ fi
+fi
+
+# If still no app name, use placeholder
+if [[ -z "${APP_NAME:-}" ]]; then
+ APP_NAME="your-app-name-here"
+ echo "⚠️ Warning: Using placeholder app name 'your-app-name-here'"
+ echo " Please add FLY_APP_NAME=your-app-name to ${PROJECT_ROOT}/.env"
+ echo ""
+fi
+
+# Extract primary_region from existing fly.toml or fly.toml.example
+PRIMARY_REGION="fra"
+if [[ -f "${FLYIO_DIR}/fly.toml" ]]; then
+ EXTRACTED_REGION=$(grep -E '^primary_region\s*=' "${FLYIO_DIR}/fly.toml" | head -1 | sed -E 's/^primary_region\s*=\s*["'\'']?([^"'\'']+).*/\1/' | tr -d ' ')
+ if [[ -n "${EXTRACTED_REGION}" ]]; then
+ PRIMARY_REGION="${EXTRACTED_REGION}"
+ fi
+elif [[ -f "${FLYIO_DIR}/fly.toml.example" ]]; then
+ EXTRACTED_REGION=$(grep -E '^primary_region\s*=' "${FLYIO_DIR}/fly.toml.example" | head -1 | sed -E 's/^primary_region\s*=\s*["'\'']?([^"'\'']+).*/\1/' | tr -d ' ')
+ if [[ -n "${EXTRACTED_REGION}" ]]; then
+ PRIMARY_REGION="${EXTRACTED_REGION}"
+ fi
+fi
+
+# Create temporary fly.toml that uses the Dockerfile
+TEMP_FLY_TOML="${FLYIO_DIR}/fly.toml.with_data"
+cat > "${TEMP_FLY_TOML}" << EOF
+# Temporary fly.toml for deployment with game data
+# This file is auto-generated by deploy_prebuilt.sh
+
+app = "${APP_NAME}"
+primary_region = "${PRIMARY_REGION}"
+
+[build]
+ dockerfile = "Dockerfile.with_data"
+ build_args = {}
+
+[deploy]
+ strategy = "immediate"
+
+[env]
+ PORT = "5521"
+
+[[services]]
+ protocol = "tcp"
+ internal_port = 5521
+ processes = ["app"]
+ auto_stop_machines = true
+ auto_start_machines = true
+ min_machines_running = 0
+
+ [[services.ports]]
+ port = 5521
+
+ [services.concurrency]
+ type = "connections"
+ hard_limit = 100
+ soft_limit = 50
+
+ [[services.tcp_checks]]
+ interval = "15s"
+ timeout = "10s"
+ grace_period = "45s"
+ restart_limit = 6
+EOF
+
+echo "Created temporary fly.toml: ${TEMP_FLY_TOML}"
+echo ""
+
+# Change to flyio_server directory (build context will be this directory)
+cd "${FLYIO_DIR}"
+
+echo "Build context: ${FLYIO_DIR}"
+echo "Dockerfile: ${TEMP_DOCKERFILE}"
+echo ""
+
+# Deploy to Fly.io
+echo "Starting deployment with game data..."
+flyctl deploy --config "${TEMP_FLY_TOML}" "$@"
+
+# Cleanup temporary files
+echo ""
+echo "Cleaning up temporary files..."
+rm -f "${TEMP_DOCKERFILE}" "${TEMP_FLY_TOML}"
+
+echo ""
+echo "========================================="
+echo "Deployment complete!"
+echo "========================================="
+echo ""
+echo "To check server status:"
+echo " flyctl status --config ${FLYIO_DIR}/fly.toml"
+echo ""
+echo "To view logs:"
+echo " flyctl logs --config ${FLYIO_DIR}/fly.toml"
+echo ""
diff --git a/flyio_server/fly.toml b/flyio_server/fly.toml
new file mode 100644
index 0000000..c34ab44
--- /dev/null
+++ b/flyio_server/fly.toml
@@ -0,0 +1,40 @@
+# Fly.io configuration for FPC Atomic TCP Server
+
+app = "${FLY_APP_NAME}" # App name is loaded from .env file (FLY_APP_NAME variable) via deploy script
+primary_region = "fra" # Frankfurt (closest to Czech Republic)
+
+[build]
+ dockerfile = "Dockerfile"
+ build_args = {}
+
+[deploy]
+ strategy = "immediate"
+
+[env]
+ PORT = "5521"
+
+# TCP service configuration
+[[services]]
+ protocol = "tcp"
+ internal_port = 5521
+ processes = ["app"]
+ auto_stop_machines = true # Stop machine when server exits (after 30s timeout)
+ auto_start_machines = true # Auto-start when new connection arrives
+ min_machines_running = 0 # No machine running when no players connected
+
+ [[services.ports]]
+ port = 5521
+ # No handlers = plain TCP passthrough (no TLS termination)
+
+ [services.concurrency]
+ type = "connections"
+ hard_limit = 100
+ soft_limit = 50
+
+ # TCP health check
+ [[services.tcp_checks]]
+ interval = "15s"
+ timeout = "10s"
+ grace_period = "45s" # Wait for server auto-shutdown (30s) + buffer
+ restart_limit = 6
+
diff --git a/flyio_server/fly.toml.example b/flyio_server/fly.toml.example
new file mode 100644
index 0000000..040d0eb
--- /dev/null
+++ b/flyio_server/fly.toml.example
@@ -0,0 +1,52 @@
+# Fly.io configuration for FPC Atomic TCP Server
+#
+# This is a template file. Copy this to fly.toml.
+#
+# Usage:
+# 1. Copy this file: cp fly.toml.example fly.toml
+# 2. Add FLY_APP_NAME=your-app-name to your .env file (in project root)
+# 3. Deploy using: ./build_and_deploy.sh (build from source) or ./deploy_prebuilt.sh (use pre-built image)
+#
+# The app name is loaded from .env file (FLY_APP_NAME variable) to keep your
+# app name private while still being able to commit fly.toml to git.
+
+app = "${FLY_APP_NAME}" # App name is loaded from .env file (FLY_APP_NAME variable) via deploy script
+primary_region = "fra" # Frankfurt (closest to Czech Republic)
+
+[build]
+ # Použití předpřipraveného Docker image (bez nutnosti Pascal compiler)
+ image = "ghcr.io/PavelZverina/fpc-atomic-server:latest"
+
+ # Pokud chcete buildnout z source kódu, použijte místo toho:
+ # dockerfile = "flyio_server/Dockerfile"
+
+[deploy]
+ strategy = "immediate"
+
+[env]
+ PORT = "5521"
+
+# TCP service configuration
+[[services]]
+ protocol = "tcp"
+ internal_port = 5521
+ processes = ["app"]
+ auto_stop_machines = true # Stop machine when server exits (after 30s timeout)
+ auto_start_machines = true # Auto-start when new connection arrives
+ min_machines_running = 0 # No machine running when no players connected
+
+ [[services.ports]]
+ port = 5521
+ # No handlers = plain TCP passthrough (no TLS termination)
+
+ [services.concurrency]
+ type = "connections"
+ hard_limit = 100
+ soft_limit = 50
+
+ # TCP health check
+ [[services.tcp_checks]]
+ interval = "15s"
+ timeout = "10s"
+ grace_period = "45s" # Wait for server auto-shutdown (30s) + buffer
+ restart_limit = 6
diff --git a/launcher/atomic_launcher.lpi b/launcher/atomic_launcher.lpi
index b1a3b81..8c1feed 100644
--- a/launcher/atomic_launcher.lpi
+++ b/launcher/atomic_launcher.lpi
@@ -12,8 +12,50 @@
-
-