← Back to branch summary

~ubuntu-branches/ubuntu/utopic/castle-game-engine/utopic

« back to all changes in this revision

Viewing changes to src/castlescript/castlescriptarrays_implement.inc

  • Committer: Package Import Robot
  • Author(s): Abou Al Montacir
  • Date: 2013-04-27 18:06:40 UTC
  • Revision ID: package-import@ubuntu.com-20130427180640-eink4nmwzuivez1c
Tags: upstream-4.0.1
Import upstream version 4.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/castlescript/castlescriptarrays_implement.inc
 
1
{
 
2
  Copyright 2008-2013 Michalis Kamburelis.
 
3
 
 
4
  This file is part of "Castle Game Engine".
 
5
 
 
6
  "Castle Game Engine" is free software; see the file COPYING.txt,
 
7
  included in this distribution, for details about the copyright.
 
8
 
 
9
  "Castle Game Engine" is distributed in the hope that it will be useful,
 
10
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
12
 
 
13
  ----------------------------------------------------------------------------
 
14
}
 
15
 
 
16
constructor TCasScriptXxxArray.Create(const AWriteable: boolean; const AValue: TXxxList);
 
17
begin
 
18
  Create(AWriteable);
 
19
  Value := AValue;
 
20
end;
 
21
 
 
22
constructor TCasScriptXxxArray.Create(const AWriteable: boolean);
 
23
begin
 
24
  inherited;
 
25
  FValue := TXxxList.Create;
 
26
end;
 
27
 
 
28
destructor TCasScriptXxxArray.Destroy;
 
29
begin
 
30
  FreeAndNil(FValue);
 
31
  inherited;
 
32
end;
 
33
 
 
34
procedure TCasScriptXxxArray.SetValue(const AValue: TXxxList);
 
35
begin
 
36
  FValue.Assign(AValue);
 
37
  ValueAssigned := true;
 
38
end;
 
39
 
 
40
procedure TCasScriptXxxArray.AssignValue(Source: TCasScriptValue);
 
41
begin
 
42
  if Source is TCasScriptXxxArray then
 
43
    Value := TCasScriptXxxArray(Source).Value else
 
44
    raise ECasScriptAssignError.CreateFmt('Assignment from %s to %s not possible', [Source.ClassName, ClassName]);
 
45
end;
 
46
 
 
47
class procedure TCasScriptXxxArray.HandleArrayFun(AFunction: TCasScriptFunction; const Arguments: array of TCasScriptValue; var AResult: TCasScriptValue; var ParentOfResult: boolean);
 
48
var
 
49
  I: Integer;
 
50
  Arr: TXxxList;
 
51
begin
 
52
  CreateValueIfNeeded(AResult, ParentOfResult, TCasScriptXxxArray);
 
53
 
 
54
  Arr := TCasScriptXxxArray(AResult).Value;
 
55
  Arr.Count := Length(Arguments);
 
56
  for I := 0 to Length(Arguments) - 1 do
 
57
    Arr.L[I] := TCasScriptXxxElement(Arguments[I]).Value;
 
58
 
 
59
  TCasScriptXxxArray(AResult).ValueAssigned := true;
 
60
end;
 
61
 
 
62
class procedure TCasScriptXxxArray.HandleArrayGetCount(AFunction: TCasScriptFunction; const Arguments: array of TCasScriptValue; var AResult: TCasScriptValue; var ParentOfResult: boolean);
 
63
begin
 
64
  CreateValueIfNeeded(AResult, ParentOfResult, TCasScriptInteger);
 
65
  TCasScriptInteger(AResult).Value :=
 
66
    TCasScriptXxxArray(Arguments[0]).FValue.Count;
 
67
end;
 
68
 
 
69
class procedure TCasScriptXxxArray.HandleArraySetCount(AFunction: TCasScriptFunction; const Arguments: array of TCasScriptValue; var AResult: TCasScriptValue; var ParentOfResult: boolean);
 
70
var
 
71
  NewCount: Int64;
 
72
begin
 
73
  if ParentOfResult then
 
74
    AResult.FreeByParentExpression;
 
75
  AResult := nil;
 
76
  ParentOfResult := false;
 
77
 
 
78
  NewCount := TCasScriptInteger(Arguments[1]).Value;
 
79
  if NewCount < 0 then
 
80
    raise ECasScriptError.CreateFmt('Invalid count %d for array_set_count (should be non-negative)',
 
81
      [NewCount]);
 
82
 
 
83
  TCasScriptXxxArray(Arguments[0]).FValue.Count := NewCount;
 
84
  TCasScriptXxxArray(Arguments[0]).ValueAssigned := true;
 
85
 
 
86
  AResult := Arguments[0];
 
87
end;
 
88
 
 
89
class procedure TCasScriptXxxArray.HandleArrayGet(AFunction: TCasScriptFunction; const Arguments: array of TCasScriptValue; var AResult: TCasScriptValue; var ParentOfResult: boolean);
 
90
var
 
91
  Index: Integer;
 
92
  Arr: TXxxList;
 
93
begin
 
94
  CreateValueIfNeeded(AResult, ParentOfResult, TCasScriptXxxElement);
 
95
 
 
96
  Arr := TCasScriptXxxArray(Arguments[0]).Value;
 
97
 
 
98
  Index := TCasScriptInteger(Arguments[1]).Value;
 
99
  if not Between(Index, 0, Arr.Count - 1) then
 
100
    raise ECasScriptError.CreateFmt('Invalid index %d for array_get, array count is %d',
 
101
      [Index, Arr.Count]);
 
102
 
 
103
  TCasScriptXxxElement(AResult).Value := Arr.L[Index];
 
104
end;
 
105
 
 
106
class procedure TCasScriptXxxArray.HandleArraySet(AFunction: TCasScriptFunction; const Arguments: array of TCasScriptValue; var AResult: TCasScriptValue; var ParentOfResult: boolean);
 
107
var
 
108
  Index: Integer;
 
109
  Arr: TXxxList;
 
110
begin
 
111
  if ParentOfResult then
 
112
    AResult.FreeByParentExpression;
 
113
  AResult := nil;
 
114
  ParentOfResult := false;
 
115
 
 
116
  Arr := TCasScriptXxxArray(Arguments[0]).Value;
 
117
 
 
118
  Index := TCasScriptInteger(Arguments[1]).Value;
 
119
  if not Between(Index, 0, Arr.Count - 1) then
 
120
    raise ECasScriptError.CreateFmt('Invalid index %d for array_set, array count is %d',
 
121
      [Index, Arr.Count]);
 
122
 
 
123
  Arr.L[Index] := TCasScriptXxxElement(Arguments[2]).Value;
 
124
  TCasScriptXxxArray(Arguments[0]).ValueAssigned := true;
 
125
 
 
126
  AResult := Arguments[0];
 
127
end;
 
128
 
 
129
class procedure TCasScriptXxxArray.HandleAdd(AFunction: TCasScriptFunction; const Arguments: array of TCasScriptValue; var AResult: TCasScriptValue; var ParentOfResult: boolean);
 
130
var
 
131
  I: Integer;
 
132
  Arr: TXxxList;
 
133
begin
 
134
  CreateValueIfNeeded(AResult, ParentOfResult, TCasScriptXxxArray);
 
135
 
 
136
  Arr := TCasScriptXxxArray(AResult).Value;
 
137
  { initially Arr is empty. This is needed to set explicitly,
 
138
    since CreateValueIfNeeded could left previous AResult }
 
139
  Arr.Clear;
 
140
  for I := 0 to Length(Arguments) - 1 do
 
141
    Arr.AddList(TCasScriptXxxArray(Arguments[I]).Value);
 
142
 
 
143
  TCasScriptXxxArray(AResult).ValueAssigned := true;
 
144
end;
 
145
 
 
146
procedure RegisterXxxFunctions;
 
147
begin
 
148
  FunctionHandlers.RegisterHandler(@TCasScriptXxxArray(nil).HandleArrayFun, TCasScriptXxxArrayFun, [TCasScriptXxxElement], true);
 
149
  FunctionHandlers.RegisterHandler(@TCasScriptXxxArray(nil).HandleArrayGetCount, TCasScriptArrayGetCount, [TCasScriptXxxArray], false);
 
150
  FunctionHandlers.RegisterHandler(@TCasScriptXxxArray(nil).HandleArraySetCount, TCasScriptArraySetCount, [TCasScriptXxxArray, TCasScriptInteger], false);
 
151
  FunctionHandlers.RegisterHandler(@TCasScriptXxxArray(nil).HandleArrayGet, TCasScriptArrayGet, [TCasScriptXxxArray, TCasScriptInteger], false);
 
152
  FunctionHandlers.RegisterHandler(@TCasScriptXxxArray(nil).HandleArraySet, TCasScriptArraySet, [TCasScriptXxxArray, TCasScriptInteger, TCasScriptXxxElement], false);
 
153
  FunctionHandlers.RegisterHandler(@TCasScriptXxxArray(nil).HandleAdd, TCasScriptAdd, [TCasScriptXxxArray], true);
 
154
end;