开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 游戏 > 游戏引擎 > 查看源码
ExpComb.inc
资源名称：CAST2SDK.rar　[点击查看]
上传用户：yj_qiu
上传日期：2022-08-08
资源大小：23636k
文件大小：9k
源码类别：

游戏引擎

开发平台：

Delphi

ExpComb.inc：源码内容
  1. procedure TOberonVM.RunTimeError(ErrorNumber: Integer);
  2. var s: string;
  3. begin
  4.   s := 'Runtime error #' + IntToStr(ErrorNumber)+#13;
  5.   case ErrorNumber of
  6.     rteRangeError: MessageDlg(s+'Range check error', mtError, [mbOK], 0);
  7.     rteStackEmpty: MessageDlg(s+'Stack is empty', mtError, [mbOK], 0);
  8.   end;
  9. end;
  11. function TOberonVM.AddII(Value1, Value2: Integer): Integer;
  12. begin {$Q-} Result := Value1 + Value2; end;
  14. function TOberonVM.AddRR(Value1, Value2: Single): Single;
  15. begin Result := Value1 + Value2; end;
  17. function TOberonVM.AddIR(Value1: Integer; Value2: Single): Single;
  18. begin Result := Value1 + Value2; end;
  20. function TOberonVM.AddRI(Value1: Single; Value2: Integer): Single;
  21. begin Result := Value1 + Value2; end;
  23. function TOberonVM.AddSS(Value1, Value2: Integer): Integer;
  24. begin Result := Value1 or Value2; end;
  26. function TOberonVM.AddStrStr(Value1, Value2: Integer): Integer;
  27. begin
  28. {  Move(Pointer(Int32(Comp.Data)+Value1)^, Len1, 2);
  29.   Move(Pointer(Int32(Comp.Data)+Value2)^, Len2, 2);
  30.   SetLength(Buf, Len1+Len2);
  31.   if Len1 > 0 then Move(Pointer(Int32(Comp.Data)+Item1.Value+2)^, Buf[1], Len1);
  32.   if Len2 > 0 then Move(Pointer(Int32(Comp.Data)+Item2.Value+2)^, Buf[1+Len1], Len2);
  33.   Comp.SetSValue(Result, Buf);}
  34.   Result := -1;
  35. end;
  37. function TOberonVM.SubII(Value1, Value2: Integer): Integer;
  38. begin {$Q-} Result := Value1 - Value2; end;
  40. function TOberonVM.SubRR(Value1, Value2: Single): Single;
  41. begin Result := Value1 - Value2; end;
  43. function TOberonVM.SubIR(Value1: Integer; Value2: Single): Single;
  44. begin Result := Value1 - Value2; end;
  46. function TOberonVM.SubRI(Value1: Single; Value2: Integer): Single;
  47. begin Result := Value1 - Value2; end;
  49. function TOberonVM.SubSS(Value1, Value2: Integer): Integer;
  50. begin Result := Value1 and not Value2; end;
  52. function TOberonVM.MulII(Value1, Value2: Integer): Integer;
  53. begin {$Q-} Result := Value1 * Value2; end;
  55. function TOberonVM.MulRR(Value1, Value2: Single): Single;
  56. begin Result := Value1 * Value2; end;
  58. function TOberonVM.MulIR(Value1: Integer; Value2: Single): Single;
  59. begin Result := Value1 * Value2; end;
  61. function TOberonVM.MulRI(Value1: Single; Value2: Integer): Single;
  62. begin Result := Value1 * Value2; end;
  64. function TOberonVM.MulSS(Value1, Value2: Integer): Integer;
  65. begin Result := Value1 and Value2; end;
  67. function TOberonVM.DivII(Value1, Value2: Integer): Single;
  68. begin Result := Value1 / Value2; end;
  70. function TOberonVM.DivRR(Value1, Value2: Single): Single;
  71. begin Result := Value1 / Value2; end;
  73. function TOberonVM.DivIR(Value1: Integer; Value2: Single): Single;
  74. begin Result := Value1 / Value2; end;
  76. function TOberonVM.DivRI(Value1: Single; Value2: Integer): Single;
  77. begin Result := Value1 / Value2; end;
  79. function TOberonVM.DivSS(Value1, Value2: Integer): Integer;
  80. begin Result := Value1 xor Value2; end;
  82. function TOberonVM.OrII(Value1, Value2: Integer): Integer;
  83. begin Result := Value1 or Value2; end;
  85. function TOberonVM.AndII(Value1, Value2: Integer): Integer;
  86. begin Result := Value1 and Value2; end;
  88. function TOberonVM.IDivII(Value1, Value2: Integer): Integer;
  89. begin Result := Value1 div Value2; end;
  91. function TOberonVM.ModII(Value1, Value2: Integer): Integer;
  92. begin Result := Value1 mod Value2; end;
  94. function TOberonVM.NegI(Value1: Integer): Integer;
  95. begin Result := -Value1; end;
  97. function TOberonVM.NegR(Value1: Single): Single;
  98. begin Result := -Value1; end;
  100. function TOberonVM.NegS(Value1: Integer): Integer;
  101. begin Result := not Value1; end;
  103. function TOberonVM.InvI(Value1: Integer): Integer;
  104. begin Result := not Value1; end;
  106. function TOberonVM.InvB(Value1: Integer): Integer;
  107. begin Result := Integer(not Boolean(Value1)); end;
  109. function TOberonVM.Equal(Value1, Value2: Integer): Integer;
  110. begin Result := Integer(Boolean(Value1 = Value2)); end;
  112. function TOberonVM.EqualRI(Value1: Single; Value2: Integer): Integer;
  113. begin Result := Integer(Boolean(Value1 = Value2)); end;
  115. function TOberonVM.GreaterII(Value1, Value2: Integer): Integer;
  116. begin Result := Integer(Boolean(Value1 > Value2)); end;
  118. function TOberonVM.GreaterIR(Value1: Integer; Value2: Single): Integer;
  119. begin Result := Integer(Boolean(Value1 > Value2)); end;
  121. function TOberonVM.GreaterRI(Value1: Single; Value2: Integer): Integer;
  122. begin Result := Integer(Boolean(Value1 > Value2)); end;
  124. function TOberonVM.GreaterRR(Value1, Value2: Single): Integer;
  125. begin Result := Integer(Boolean(Value1 > Value2)); end;
  127. function TOberonVM.LessII(Value1, Value2: Integer): Integer;
  128. begin Result := Integer(Boolean(Value1 < Value2)); end;
  130. function TOberonVM.LessIR(Value1: Integer; Value2: Single): Integer;
  131. begin Result := Integer(Boolean(Value1 < Value2)); end;
  133. function TOberonVM.LessRI(Value1: Single; Value2: Integer): Integer;
  134. begin Result := Integer(Boolean(Value1 < Value2)); end;
  136. function TOberonVM.LessRR(Value1, Value2: Single): Integer;
  137. begin Result := Integer(Boolean(Value1 < Value2)); end;
  139. function TOberonVM.GreaterEqualII(Value1, Value2: Integer): Integer;
  140. begin Result := Integer(Boolean(Value1 >= Value2)); end;
  142. function TOberonVM.GreaterEqualIR(Value1: Integer; Value2: Single): Integer;
  143. begin Result := Integer(Boolean(Value1 >= Value2)); end;
  145. function TOberonVM.GreaterEqualRI(Value1: Single; Value2: Integer): Integer;
  146. begin Result := Integer(Boolean(Value1 >= Value2)); end;
  148. function TOberonVM.GreaterEqualRR(Value1, Value2: Single): Integer;
  149. begin Result := Integer(Boolean(Value1 >= Value2)); end;
  151. function TOberonVM.LessEqualII(Value1, Value2: Integer): Integer;
  152. begin Result := Integer(Boolean(Value1 <= Value2)); end;
  154. function TOberonVM.LessEqualIR(Value1: Integer; Value2: Single): Integer;
  155. begin Result := Integer(Boolean(Value1 <= Value2)); end;
  157. function TOberonVM.LessEqualRI(Value1: Single; Value2: Integer): Integer;
  158. begin Result := Integer(Boolean(Value1 <= Value2)); end;
  160. function TOberonVM.LessEqualRR(Value1, Value2: Single): Integer;
  161. begin Result := Integer(Boolean(Value1 <= Value2)); end;
  163. function TOberonVM.NotEqual(Value1, Value2: Integer): Integer;
  164. begin Result := Integer(Boolean(Value1 <> Value2)); end;
  166. function TOberonVM.NotEqualRI(Value1: Single; Value2: Integer): Integer;
  167. begin Result := Integer(Boolean(Value1 <> Value2)); end;
  169. function TOberonVM.GreaterEqual(Value1, Value2: Integer): Integer;
  170. begin Result := Integer(Boolean(Value1 >= Value2)); end;
  172. function TOberonVM.LessEqual(Value1, Value2: Integer): Integer;
  173. begin Result := Integer(Boolean(Value1 <= Value2)); end;
  175. function TOberonVM.TestIn(Value1, Value2: Integer): Integer;
  176. begin Result := Integer((El2Set[Value1] and Value2) > 0); end;
  178. procedure TOberonVM.DoAssign4(Value1, Value2: Integer);
  179. begin
  180.   {dtBoolean = 0; dtChar = 1;
  181.   dtInt8 = 2; dtInt16 = 3; dtInt32 = 4; dtInt = 5;
  182.   dtNat8 = 6; dtNat16 = 7; dtNat32 = 8; dtNat = 9;
  183.   dtSingle = 10; dtReal = 11; dtDouble = 12;
  184.   dtString = 13;
  185.   dtSet = 14;
  186.   dtArray = 16;
  187.   dtRecord = 17;
  188.   dtPointer = 18;
  189.   dtProcedure = 19;}
  190. {  case Data.Variables[Value1].VType of
  191.     dtBoolean, dtChar, dtInt8, dtNat8: elSize := 1;
  192.     dtInt16, dtNat16: elSize := 2;
  193.     dtInt32, dtInt, dtNat32, dtNat, dtSingle, dtReal, dtSet, dtPointer, dtProcedure: elSize := 4;
  194.     dtDouble: elSize := 8;
  195.     dtString:;
  196.   end;
  197.   case elSize of
  198.     1: TByteArray(Data.Data)[Data.Variables[Value1].Index] := Value2;
  199.     2: Word((@TByteArray(Data.Data)[Data.Variables[Value1].Index])^) := Value2;
  200.     4: Int32((@TByteArray(Data.Data)[Data.Variables[Value1].Index])^) := Value2;
  201.     else Int32((@TByteArray(Data.Data)[Data.Variables[Value1].Index])^) := Value2;
  202.   end;}
  203.   Int32((@Data.Data[Value1])^) := Value2;
  204. end;
  206. procedure TOberonVM.DoExtAssign4(Value1, Value2: Integer);
  207. begin
  208.   Int32((@Data.BaseData[Value1])^) := Value2;
  209. end;
  211. procedure TOberonVM.DoStackAssign4(Value1, Value2: Integer);
  212. begin
  213.   Stack[StackBase+Value1] := Value2;
  214. end;
  216. procedure TOberonVM.DoGoto(var IP: Integer);
  217. begin
  218.   IP := Data.PIN[IP+1];
  219. end;
  221. procedure TOberonVM.DoZeroJump(Value1: Integer; var IP: Integer);
  222. begin
  223.   Inc(IP);
  224.   if Value1 = 0 then IP := Data.PIN[IP];
  225. end;
  227. procedure TOberonVM.DoCall(const Dest: Integer; var IP: Integer);
  228. begin
  229.   Push(IP);
  230.   IP := Dest;
  231. end;
  233. procedure TOberonVM.DoReturn(var IP: Integer);
  234. var Temp: Integer;
  235. begin
  236.   Inc(IP);
  237.   Temp := Data.PIN[IP];
  238.   Dec(TotalStack, Data.PIN[IP+1]-Temp);             // Pop all local variables
  239.   StackBase := Pop;                                 // Pop old stack base
  240.   IP := Pop;                                        // Pop return address
  241.   Dec(TotalStack, Temp);                            // Pop parameters
  242. end;
  244. procedure TOberonVM.DoExit(const Dest: Integer; var IP: Integer);
  245. begin
  246.   IP := Dest;
  247. end;
  249. function TOberonVM.ConstructSet(const TotalElements: Integer): Integer;
  250. var i: Integer; El: Longword;
  251. begin
  252.   Result := 0;
  253.   if TotalElements = -1 then Result := Pop else for i := 0 to TotalElements-1 do begin
  254.     El := Pop;
  255.     if El > MaxSet then RunTimeError(rteRangeError) else Result := Result or Integer(El2Set[El]);
  256.   end;
  257. end;