unit progs; interface {$M+} type GMathLib = class published function cos(x : single) : single; stdcall; function sin(x : single) : single; stdcall; function tan(x : single) : single; stdcall; function random(x : integer) : integer; stdcall; end; GStringLib = class function left(src, delim : string) : string; stdcall; function right(src, delim : string) : string; stdcall; function IntToStr(x : integer) : string; stdcall; function StrToInt(x : string) : integer; stdcall; function uppercase(s : string) : string; stdcall; end; {$M-} var gmlib : GMathLib; gslib : GStringLib; procedure init_progs; implementation uses Math, Strip, SysUtils, TypInfo, chars, dtypes, mudthread, mudsystem, gvm; // GMathLib function GMathLib.cos(x : single) : single; stdcall; begin Result := System.Cos(x); end; function GMathLib.sin(x : single) : single; stdcall; begin Result := System.Sin(x); end; function GMathLib.tan(x : single) : single; stdcall; begin Result := Math.Tan(x); end; function GMathLib.random(x : integer) : integer; stdcall; begin Result := System.Random(x); end; // GStringLib function GStringLib.left(src, delim : string) : string; stdcall; begin Result := Strip.left(src, delim[1]); end; function GStringLib.right(src, delim : string) : string; stdcall; begin Result := Strip.right(src, delim[1]); end; function GStringLib.IntToStr(x : integer) : string; stdcall; begin Result := Sysutils.IntToStr(x); end; function GStringLib.StrToInt(x : string) : integer; stdcall; begin Result := Sysutils.StrToInt(x); end; function GStringLib.uppercase(s : string) : string; stdcall; begin Result := Sysutils.Uppercase(s); end; procedure grendelVMError(owner : TObject; msg : string); begin if (owner <> nil) then write_console('VM error in context of ' + GNPC(owner).name^ + ': ' + msg) else write_console('VM error: ' + msg); end; function grendelExternalTrap(obj : variant; member : string) : variant; var s : TObject; prop : PPropInfo; v : variant; begin Result := 0; if (varType(obj) = varString) then begin Result := integer(findCharWorld(nil, obj)); end else if (varType(obj) = varInteger) then begin s := TObject(integer(obj)); prop := GetPropInfo(s.ClassInfo(), member); if (prop <> nil) then case (prop.PropType^.Kind) of tkInteger: Result := GetOrdProp(s, prop); tkFloat: Result := GetFloatProp(s, prop); tkLString: Result := GetStrProp(s, prop); tkVariant: Result := GetVariantProp(s, prop); end; end; end; procedure grendelSystemTrap(owner : TObject; msg : string); begin interpret(GNPC(owner), msg); end; procedure init_progs; var sig : GSignature; begin gmlib := GMathLib.Create; gslib := GStringLib.Create; sig.resultType := varSingle; setLength(sig.paramTypes, 1); sig.paramTypes[0] := varSingle; registerExternalMethod('cos', gmlib, gmlib.MethodAddress('cos'), sig); registerExternalMethod('sin', gmlib, gmlib.MethodAddress('sin'), sig); registerExternalMethod('tan', gmlib, gmlib.MethodAddress('tan'), sig); sig.resultType := varInteger; setLength(sig.paramTypes, 1); sig.paramTypes[0] := varInteger; registerExternalMethod('random', gmlib, gmlib.MethodAddress('random'), sig); sig.resultType := varInteger; setLength(sig.paramTypes, 1); sig.paramTypes[0] := varString; registerExternalMethod('StrToInt', gslib, gslib.MethodAddress('StrToInt'), sig); sig.resultType := varString; setLength(sig.paramTypes, 2); sig.paramTypes[0] := varString; sig.paramTypes[1] := varString; registerExternalMethod('left', gslib, gslib.MethodAddress('left'), sig); registerExternalMethod('right', gslib, gslib.MethodAddress('right'), sig); sig.resultType := varString; setLength(sig.paramTypes, 1); sig.paramTypes[0] := varInteger; registerExternalMethod('IntToStr', gslib, gslib.MethodAddress('IntToStr'), sig); sig.resultType := varString; setLength(sig.paramTypes, 1); sig.paramTypes[0] := varString; registerExternalMethod('uppercase', gslib, gslib.MethodAddress('uppercase'), sig); setVMError(grendelVMError); setSystemTrap(grendelSystemTrap); setExternalTrap(grendelExternalTrap); end; end.