« previous next »
Pages: [1]

Author Topic: out of range...  (Read 990 times)

0 Members and 1 Guest are viewing this topic.

Offline Kavukamari

  • Camper
  • ***
  • Posts: 435
  • 3.14159265358979, mmm... pi
out of range...
« on: January 04, 2008, 07:30:02 pm »
Code: [Select]
const
//-----Default-----
  Default_Enabled=true;
  Default_Command='/toggle';
  Default_Name='OverShields';
  Default_On=$FF20FF20;
  Default_Off=$FFFF8020;
  Default_Error=$FFFF2020;

var
  Enabled: boolean;

function xsplit(const source: string; const delimiter: string):TStringArray;
var
i,x,d:integer;
s:string;
begin
d:=length(delimiter);
x:=0;
i:=1;
SetArrayLength(Result,1);
while(i<=length(source)) do begin
s:=Copy(source,i,d);   
if(s=delimiter) then begin
inc(i,d);
inc(x,1);
SetArrayLength(result,x+1);
end else begin       
result[x]:= result[x]+Copy(s,1,1);
inc(i,1);
end;
end;
end;

function DivStr(const str: string):array of string;
var
  i, divis: integer;
begin
  if (Length(str) > 72) then begin
    divis:=Round(Length(str) / 72);
    SetArrayLength(Result,divis);
    for i:=1 to divis do try
      Result[i]:=Copy(str,72*(divis-1),72*divis);
    except
      SetArrayLength(Result,1);
      Result[1]:=str;
    end;
  end else begin
    SetArrayLength(Result,1);
    Result[1]:=str;
  end;
end;

procedure ActivateServer();
begin
  Enabled:=Default_Enabled;
//this turns the script on/off as-per the default
end;

function OnCommand(ID: Byte; Text: string):boolean;
var
  Temp0, Temp1: string;
  i, ltt: integer;
  Temp: array of string;
begin
  Result:=false;
//-----Toggle-----
  Temp0:=GetPiece(LowerCase(Text), ' ', 0); //command
  Temp1:=GetPiece(LowerCase(Text), ' ', 1); //value
  if Temp0 = Default_Command then begin
    Case Temp1 of
//-----Enable-----
      'enable','true','on','1': begin
        if Enabled <> true then begin
          Enabled:=true;
          WriteConsole(0,Default_Name+' script enabled by '+GetPlayerStat(ID,'Name')+'.',Default_On);
        end else WriteConsole(ID,Default_Name+' script is already enabled.',Default_Error);
      end;
//-----Disable-----
      'disable','false','off','0': begin
        if Enabled <> false then begin
          Enabled:=false;
          WriteConsole(0,Default_Name+' script disabled by '+GetPlayerStat(ID,'Name')+'.',Default_Off);
        end else WriteConsole(ID,Default_Name+' script is already disabled.',Default_Error);
      end;
    end;
  end;
  if Enabled then begin
    ltt:=Length('/test ');
    if Copy(Text,0,ltt) = '/test ' then begin
      Temp:=DivStr(Copy(Text,ltt,Length(Text)));
      for i:=1 to GetArrayLength(Temp) do WriteConsole(ID,Temp[i],Default_On);
    end;
  end else exit;
end;

need help on that one, when I do the testing command, it says it is out of range

Code: [Select]
const
//-----Default-----
  Default_Enabled=false;
  Default_Command='/turns';
  Default_Name='Turns';
  Default_On=$FF20FF20;
  Default_Off=$FFFF8020;
  Default_Error=$FFFF2020;

  E_MPlr=false;
  E_BChk=false;
  E_Mins=true;
  E_SecA=false;
  E_MinA=false;
  E_Pnds=true;
  E_PndA=true;

  M_Time=10;

var
  Enabled: boolean;
  MPlr: integer;
  BChk: integer;
  Secs: array of integer;
  Mins: array of integer;
  Pends: integer;
  Pending: array of boolean;

function HighVal(haystack: array of integer): integer;
var
  i, value: integer;
begin
  If GetArrayLength(haystack) > 0 then begin
    result:=0;
    value:=haystack[0];
    for i:=0 to GetArrayLength(haystack) - 1 do begin
      If haystack[i] > value then begin
        result:=i;
        value:=haystack[i];
      end;
    end;
  end;
end;

procedure Int();
begin
//Int_MPlr
  MPlr:=32;
  if E_MPlr then WriteLn('MPlr: '+inttostr(MPlr));
//Int_BChk
  BChk:=32;
  if E_BChk then WriteLn('BChk: '+inttostr(BChk));
//Int_Secs
  SetArrayLength(Secs,BChk);
  if E_SecA then WriteLn('SecA: '+inttostr(GetArrayLength(Secs)));
//Int_Mins
  SetArrayLength(Mins,BChk);
  if E_MinA then WriteLn('MinA: '+inttostr(GetArrayLength(Mins)));
end;

procedure PlayerJoin(ID: byte);
begin
{
  if not GetPlayerStat(ID,'human') then begin
    BChk:=MPlr;
    if E_BChk then WriteLn('BChk: '+inttostr(BChk));
  end else begin
//Set_SecA
//    SetArrayLength(Secs,GetArrayLength(Secs)+1);
    if E_SecA then WriteLn('SecA: '+inttostr(GetArrayLength(Secs)));
//Set_MinA
//    SetArrayLength(Mins,GetArrayLength(Mins)+1);
    if E_MinA then WriteLn('MinA: '+inttostr(GetArrayLength(Mins)));
}
    Secs[ID]:=0;
    Mins[ID]:=0;
    Pending[ID]:=false;
//  end;
end;

procedure PlayerLeave(ID: byte);
begin
{
  if not GetPlayerStat(ID,'human') then begin
    BChk:=MPlr;
    if E_BChk then WriteLn('BChk: '+inttostr(BChk));
  end else begin
//Set_SecA2
//    SetArrayLength(Secs,GetArrayLength(Secs)-1);
    if E_SecA then WriteLn('SecA: '+inttostr(GetArrayLength(Secs)));
//Set_MinA2
//    SetArrayLength(Mins,GetArrayLength(Mins)-1);
    if E_MinA then WriteLn('MinA: '+inttostr(GetArrayLength(Mins)));
}
    Secs[ID]:=0;
    Mins[ID]:=0;
    Pending[ID]:=false;
    dec(Pends,1);
//  end;
end;

procedure ActivateServer();
begin
  Enabled:=Default_Enabled;

  if Enabled then begin
    Int();
  end;
end;

function OnRequestGame(IP: string; State: integer):integer;
var
  i: integer;
  MHigh, SHigh, Highest: integer;
begin
  Result:=State;

  if Enabled then begin
    if State = 5 then begin
      WriteConsole(0,'Server requested, server is full...',Default_Off);
      if Pends > 0 then begin
        i:=HighVal(Mins);
        if Pending[i] then begin
          MHigh:=Mins[HighVal(Mins)];
          if Mins[i] = MHigh then begin

            WriteConsole(0,'...someone is pending, kicking player with most in server time...',Default_Off);
            WriteConsole(0,'...kicking: '+GetPlayerStat(i,'name')+'.',Default_Off);
            WriteConsole(i,'==================================================',Default_Error);
            WriteConsole(i,'A join request has been made and server is full...',Default_On);
            WriteConsole(i,'...your total in-server minutes are highest, so you will be kicked.',Default_On);

            KickPlayer(i);

          end else WriteConsole(0,'...unknown exception, ignoring request.',Default_Error);
        end else WriteConsole(0,'...unknown exception, ignoring request.',Default_Error);

      end else begin
        WriteConsole(0,'...no one is pending, ignoring request.',Default_Off);
      end;

    end else begin
      WriteConsole(0,'Server requested...',Default_Off);
    end;
  end else exit;
end;

procedure OnJoinGame(ID, Team: byte);
begin
  if Enabled then begin
    PlayerJoin(ID);
  end else exit;
end;

function OnCommand(ID: Byte; Text: string):boolean;
var
  Temp0, Temp1: string;
begin
  Result:=false;
//-----Toggle-----
  Temp0:=GetPiece(LowerCase(Text), ' ', 0); //command
  Temp1:=GetPiece(LowerCase(Text), ' ', 1); //value
  if Temp0 = Default_Command then begin
    Case Temp1 of
//-----Enable-----
      'enable','true','on','1': begin
        if Enabled <> true then begin
          Int();
          Enabled:=true;
          WriteConsole(0,Default_Name+' script enabled by '+GetPlayerStat(ID,'Name')+'.',Default_On);
        end else WriteConsole(ID,Default_Name+' script is already enabled.',Default_Error);
      end;
//-----Disable-----
      'disable','false','off','0': begin
        if Enabled <> false then begin
          Enabled:=false;
          WriteConsole(0,Default_Name+' script disabled by '+GetPlayerStat(ID,'Name')+'.',Default_Off);
        end else WriteConsole(ID,Default_Name+' script is already disabled.',Default_Error);
      end;
    end;
  end;
end;

function OnPlayerCommand(ID: byte; Text: string):boolean;
begin
  Case Text of
    '/mytime','/time','/mtm': begin
      WriteConsole(ID,'Your in-server time is: '+inttostr(Mins[ID])+'.',iif(Pending[ID],Default_Off,Default_On));
    end;
  end;
end;

procedure AppOnIdle(Ticks: integer);
var
  i: byte;
begin
  if Enabled then begin
    for i:=1 to 32 do begin
      if GetPlayerStat(i,'active') then begin
        if GetPlayerStat(i,'human') then begin
          inc(Secs[i],1);
          if Secs[i] = 60 then begin
            dec(Secs[i],Secs[i]);
            inc(Mins[i],1);
            if E_Mins then WriteLn('Mins['+inttostr(i)+']: '+inttostr(Mins[i]));
            if (Mins[i] = M_Time) and (Secs[i] = 0) then begin
              SetArrayLength(Pending,BChk);
              Pending[i]:=true;
              WriteLn(GetPlayerStat(i,'name')+'is now pending.');
              WriteConsole(i,'You are now pending for a Time-Kick.',Default_Off);
              inc(Pends,1);
            end else exit;
          end else exit;
        end else continue;
      end else continue;
    end;
  end;
end;

procedure OnLeaveGame(ID, Team: byte; Kicked: boolean);
begin
  if Enabled then begin
    PlayerLeave(ID);
  end else exit;
end;

also that one says "out of range" when someone joins and/or exits and it also doesn't work for all players (only one player's minutes accumulate)
Logged
"Be mindful of fame, show a mighty courage, watch against foes. Nor shalt thou lack what thou desirest, if with thy life thou hast comest out from that heroic task."

Offline DorkeyDear

  • Veteran
  • *****
  • Posts: 1507
  • I also go by Curt or menturi
Re: out of range...
« Reply #1 on: January 04, 2008, 07:55:06 pm »
Arrays start at 0, not 1.. so when you do SetArrayLength(Variable, 8); you want to do for i := 0 to 7 (7 can also be "GetArrayLength(Variable) - 1")

First seen at function DivStr:
SetArrayLength(Result,divis);
for i:=1 to divis do try

should be "0 to divis - 1" for example
Logged

Offline Kavukamari

  • Camper
  • ***
  • Posts: 435
  • 3.14159265358979, mmm... pi
Re: out of range...
« Reply #2 on: January 05, 2008, 05:12:23 pm »
will writing the array to the console work if that is fixed? or am I trying to do something arrays arent sposed to do?

and is the second script haveing the same problem?

and by the way, what does div do, because divis used to be div and the script expected an identifyer there
« Last Edit: January 05, 2008, 05:13:54 pm by Kavukamari »
Logged
"Be mindful of fame, show a mighty courage, watch against foes. Nor shalt thou lack what thou desirest, if with thy life thou hast comest out from that heroic task."

Offline chrisgbk

  • Moderator
  • Veteran
  • *****
  • Posts: 1739
Re: out of range...
« Reply #3 on: January 05, 2008, 09:17:18 pm »
Quote from: Kavukamari on January 05, 2008, 05:12:23 pm
will writing the array to the console work if that is fixed? or am I trying to do something arrays arent sposed to do?

and is the second script haveing the same problem?

and by the way, what does div do, because divis used to be div and the script expected an identifyer there

DIV is the integer division operator.
Logged

Offline Kavukamari

  • Camper
  • ***
  • Posts: 435
  • 3.14159265358979, mmm... pi
Re: out of range...
« Reply #4 on: January 06, 2008, 06:37:06 pm »
so you can use it instead of / ?
Logged
"Be mindful of fame, show a mighty courage, watch against foes. Nor shalt thou lack what thou desirest, if with thy life thou hast comest out from that heroic task."

Offline chrisgbk

  • Moderator
  • Veteran
  • *****
  • Posts: 1739
Re: out of range...
« Reply #5 on: January 06, 2008, 10:39:52 pm »
Quote from: Kavukamari on January 06, 2008, 06:37:06 pm
so you can use it instead of / ?

/ is floating point division; for example:

3 DIV 4 = 0
3 / 4 = 0.75

5 DIV 4 = 1
5 / 4 = 1.25
Logged
Pages: [1]
« previous next »