hedgewars/PascalExports.pas
author koda
Tue, 23 Aug 2011 03:46:17 +0200
changeset 5662 99083392cd4f
parent 5492 a0455a050ca8
child 5725 e27100a0e2d0
child 5968 4e8bb227be9a
permissions -rw-r--r--
FREE AT LAST!!! SDL came around a (mostly) sane way for implementing rotation events, so we can scrap all the workaround code that has been added to workaround it!! Also this allows us to use proper (internal) multitasking handling and can simplify optional settings and other yet unexplored features. Yay!

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2011 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 *)

{$INCLUDE "options.inc"}

unit PascalExports;
(*
 * If the engine is compiled as library this unit will export functions
 * as C declarations for convenient library usage in your application and
 * language of choice.
 *
 * See also: C declarations on wikipedia
 *           http://en.wikipedia.org/wiki/X86_calling_conventions#cdecl
 *)
interface
uses uTypes, uConsts, uVariables, GLunit, uKeys, uSound, uAmmos, uUtils, uCommands;

{$INCLUDE "config.inc"}
procedure HW_versionInfo(netProto: PLongInt; versionStr: PPChar); cdecl; export;

implementation
{$IFDEF HWLIBRARY}
var cZoomVal: GLfloat;

// retrieve protocol information
procedure HW_versionInfo(netProto: PLongInt; versionStr: PPChar); cdecl; export;
begin
    netProto^:= cNetProtoVersion;
    versionStr^:= cVersionString;
end;

// emulate mouse/keyboard input
procedure HW_click; cdecl; export;
begin
    leftClick:= true;
end;

procedure HW_ammoMenu; cdecl; export;
begin
    rightClick:= true;
end;

procedure HW_zoomSet(value: GLfloat); cdecl; export;
begin
    cZoomVal:= value;
    ZoomValue:= value;
end;

procedure HW_zoomIn; cdecl; export;
begin
    if wheelDown = false then
        wheelUp:= true;
end;

procedure HW_zoomOut; cdecl; export;
begin
    if wheelUp = false then
        wheelDown:= true;
end;

procedure HW_zoomReset; cdecl; export;
begin
    ZoomValue:= cZoomVal;
    // center the camera at current hog
    if CurrentHedgehog <> nil then
        followGear:= CurrentHedgehog^.Gear;
end;

function HW_zoomFactor: GLfloat; cdecl; export;
begin
    exit( ZoomValue / cDefaultZoomLevel );
end;

function HW_zoomLevel: LongInt; cdecl; export;
begin
    exit( trunc((ZoomValue - cDefaultZoomLevel) / cZoomDelta) );
end;

procedure HW_walkingKeysUp; cdecl; export;
begin
    leftKey:= false;
    rightKey:= false;
    upKey:= false;
    downKey:= false;
    preciseKey:= false;
end;

procedure HW_otherKeysUp; cdecl; export;
begin
    spaceKey:= false;
    enterKey:= false;
    backspaceKey:= false;
end;

procedure HW_allKeysUp; cdecl; export;
begin
    // set all keys to released
    uKeys.initModule;
end;

procedure HW_walkLeft; cdecl; export;
begin
    leftKey:= true;
end;

procedure HW_walkRight; cdecl; export;
begin
    rightKey:= true;
end;

procedure HW_preciseSet(status:boolean); cdecl; export;
begin
    preciseKey:= status;
end;

procedure HW_aimUp; cdecl; export;
begin
    upKey:= true;
end;

procedure HW_aimDown; cdecl; export;
begin
    downKey:= true;
end;

procedure HW_shoot; cdecl; export;
begin
    spaceKey:= true;
end;

procedure HW_jump; cdecl; export;
begin
    enterKey:= true;
end;

procedure HW_backjump; cdecl; export;
begin
    backspaceKey:= true;
end;

procedure HW_tab; cdecl; export;
begin
    tabKey:= true;
end;

procedure HW_chat; cdecl; export;
begin
    chatAction:= true;
end;

procedure HW_screenshot; cdecl; export;
begin
    flagMakeCapture:= true;
end;

procedure HW_pause; cdecl; export;
begin
    if isPaused = false then
        pauseAction:= true;
end;

procedure HW_pauseToggle; cdecl; export;
begin
    pauseAction:= true;
end;

function HW_isPaused: boolean; cdecl; export;
begin
    exit( isPaused );
end;

// equivalent to esc+y; when closeFrontend = true the game exits after memory cleanup
procedure HW_terminate(closeFrontend: boolean); cdecl; export;
begin
    alsoShutdownFrontend:= closeFrontend;
    ParseCommand('forcequit', true);
end;

function HW_getSDLWindow: pointer; cdecl; export;
begin
{$IFDEF SDL13}
    exit( SDLwindow );
{$ELSE}
    exit( nil );
{$ENDIF}
end;

// cursor handling
procedure HW_setCursor(x,y: LongInt); cdecl; export;
begin
    CursorPoint.X:= x;
    CursorPoint.Y:= y;
end;

procedure HW_getCursor(x,y: PLongInt); cdecl; export;
begin
    x^:= CursorPoint.X;
    y^:= CursorPoint.Y;
end;

// ammo menu related functions
function HW_isAmmoMenuOpen: boolean; cdecl; export;
begin
    exit( bShowAmmoMenu );
end;

function HW_isAmmoMenuNotAllowed: boolean; cdecl; export;
begin;
    exit( (TurnTimeLeft = 0) or (not CurrentTeam^.ExtDriven and (((CurAmmoGear = nil) or
          ((Ammoz[CurAmmoGear^.AmmoType].Ammo.Propz and ammoprop_AltAttack) = 0)) and hideAmmoMenu)) );
end;

function HW_isWeaponRequiringClick: boolean; cdecl; export;
begin
    if (CurrentHedgehog <> nil) and (CurrentHedgehog^.Gear <> nil) and (CurrentHedgehog^.BotLevel = 0) then
        exit( (CurrentHedgehog^.Gear^.State and gstHHChooseTarget) <> 0 )
    else
        exit(false);
end;

function HW_isWeaponTimerable: boolean; cdecl; export;
begin
    if (CurrentHedgehog <> nil) and (CurrentHedgehog^.Ammo <> nil) and (CurrentHedgehog^.BotLevel = 0) then
        exit( (Ammoz[CurrentHedgehog^.CurAmmoType].Ammo.Propz and ammoprop_Timerable) <> 0)
    else
        exit(false);
end;

function HW_isWeaponSwitch: boolean cdecl; export;
begin
    if (CurAmmoGear <> nil) and (CurrentHedgehog^.BotLevel = 0) then
        exit(CurAmmoGear^.AmmoType = amSwitch)
    else
        exit(false)
end;

function HW_isWeaponRope: boolean cdecl; export;
begin
    if (CurrentHedgehog <> nil) and (CurrentHedgehog^.Ammo <> nil) and (CurrentHedgehog^.BotLevel = 0) then
        exit(CurrentHedgehog^.CurAmmoType = amRope)
    else
        exit(false);
end;

procedure HW_setGrenadeTime(time: LongInt); cdecl; export;
begin
    ParseCommand('/timer ' + inttostr(time), true);
end;

procedure HW_setPianoSound(snd: LongInt); cdecl; export;
begin
    // this most likely won't work in network game
    if (CurrentHedgehog <> nil) and (CurrentHedgehog^.Ammo <> nil) and (CurrentHedgehog^.BotLevel = 0)
       and (CurrentHedgehog^.CurAmmoType = amPiano) then
        case snd of
            0: PlaySound(sndPiano0);
            1: PlaySound(sndPiano1);
            2: PlaySound(sndPiano2);
            3: PlaySound(sndPiano3);
            4: PlaySound(sndPiano4);
            5: PlaySound(sndPiano5);
            6: PlaySound(sndPiano6);
            7: PlaySound(sndPiano7);
            else PlaySound(sndPiano8);
        end;
end;

function HW_getWeaponNameByIndex(whichone: LongInt): PChar; cdecl; export;
begin
    exit(str2pchar(trammo[Ammoz[TAmmoType(whichone+1)].NameId]));
end;

function HW_getWeaponCaptionByIndex(whichone: LongInt): PChar; cdecl; export;
begin
    exit(str2pchar(trammoc[Ammoz[TAmmoType(whichone+1)].NameId]));
end;

function HW_getWeaponDescriptionByIndex(whichone: LongInt): PChar; cdecl; export;
begin
    exit(str2pchar(trammod[Ammoz[TAmmoType(whichone+1)].NameId]));
end;

function HW_getNumberOfWeapons:LongInt; cdecl; export;
begin
    exit(ord(high(TAmmoType)));
end;

procedure HW_setWeapon(whichone: LongInt); cdecl; export;
begin
    if (CurrentTeam = nil) then exit;
    if (not CurrentTeam^.ExtDriven) and (CurrentTeam^.Hedgehogs[0].BotLevel = 0) then
        SetWeapon(TAmmoType(whichone+1));
end;

function HW_isWeaponAnEffect(whichone: LongInt): boolean; cdecl; export;
begin
    exit(Ammoz[TAmmoType(whichone+1)].Ammo.Propz and ammoprop_Effect <> 0)
end;

function HW_getAmmoCounts(counts: PLongInt): LongInt; cdecl; export;
var a : PHHAmmo;
    slot, index: LongInt;
begin
    // nil check
    if (CurrentHedgehog = nil) or (CurrentHedgehog^.Ammo = nil) or (CurrentTeam = nil) then
        exit(-1);
    // hog controlled by opponent (net or ai)
    if (CurrentTeam^.ExtDriven) or (CurrentTeam^.Hedgehogs[0].BotLevel <> 0) then
        exit(1);

    a:= CurrentHedgehog^.Ammo;
    for slot:= 0 to cMaxSlotIndex do
        for index:= 0 to cMaxSlotAmmoIndex do
            if a^[slot,index].Count <> 0 then // yes, ammomenu is hell
                counts[ord(a^[slot,index].AmmoType)-1]:= a^[slot,index].Count;
    exit(0);
end;

procedure HW_getAmmoDelays (skipTurns: PByte); cdecl; export;
var a : TAmmoType;
begin
    for a:= Low(TAmmoType) to High(TAmmoType) do
        skipTurns[ord(a)-1]:= byte(Ammoz[a].SkipTurns);
end;

function HW_getTurnsForCurrentTeam: LongInt; cdecl; export;
begin
    if (CurrentTeam <> nil) and (CurrentTeam^.Clan <> nil) then
        exit(CurrentTeam^.Clan^.TurnNumber)
    else
        exit(0);
end;

function HW_getMaxNumberOfHogs: LongInt; cdecl; export;
begin
    exit(cMaxHHIndex+1);
end;

function HW_getMaxNumberOfTeams: LongInt; cdecl; export;
begin
    exit(cMaxTeams);
end;
{$ENDIF}

end.