* Initial check-in

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@14857 3ad0048d-3df7-0310-abae-a5850022a9f2

4 files changed, 554 insertions, 0 deletions

diff --git a/packages/libsee/examples/mod_stream.pp b/packages/libsee/examples/mod_stream.pp
new file mode 100644
index 0000000000..35e12a1d16
--- /dev/null
+++ b/packages/libsee/examples/mod_stream.pp
@@ -0,0 +1,478 @@
+unit mod_stream;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, libsee;
+
+Procedure RegisterStreamModule;
+Procedure RegisterWriteModule;
+
+implementation
+
+{ ---------------------------------------------------------------------
+  General auxiliary functions
+  ---------------------------------------------------------------------}
+
+Function ValueToString(V : TSee_Value) : string;
+
+Var
+  PS : Ptcuint;
+  PD : PChar;
+  I : Integer;
+
+begin
+  SetLength(Result,v.u._string^.length);
+  If Length(Result)<>0 then
+    begin
+    PD:=PChar(Result);
+    PS:=v.u._string^.data;
+    For I:=0 to length(Result)-1 do
+      begin
+      PD^:=Char(PS^ and $ff);
+      Inc(PD);
+      Inc(PS);
+      end;
+    end;
+end;
+
+Procedure CreateJSObject(Interp : PSEE_Interpreter; Parent : PSEE_Object;AName : PSEE_String; Obj : PSee_Object);
+
+var
+  V : PSEE_Value;
+
+begin
+  v:=new_see_value;
+  see_set_object(V,Obj);
+  see_object_put(interp,parent,AName,V,SEE_ATTR_DEFAULT);
+end;
+
+Procedure CreateJSNumber(Interp : PSEE_Interpreter; Obj : PSee_Object; AName : PSEE_String; AValue : TSEE_number_t);
+
+var
+  V : PSEE_Value;
+
+begin
+  v:=new_SEE_value;
+  see_set_number(V,AValue);
+  see_object_put(Interp,Obj,AName,v,SEE_ATTR_DEFAULT);
+end;
+
+Procedure CreateJSFunction(Interp : PSEE_Interpreter; Obj : PSee_Object; Func : TSEE_call_fn_t; AName : PSEE_String; Len : Integer);
+
+var
+  V : PSEE_Value;
+
+begin
+  v:=new_SEE_value;
+  see_set_object(V,see_cfunction_make(interp,Func,AName,len));
+  see_object_put(Interp,Obj,AName,v,SEE_ATTR_DEFAULT);
+end;
+
+{ ---------------------------------------------------------------------
+  Stream module support
+  ---------------------------------------------------------------------}
+Var
+  StreamModule : TSEE_module;
+  StreamObjectDef,
+  StreamPrototypeDef : PSEE_objectclass;
+
+  WriteModule : TSEE_module;
+
+Type
+  TStreamModuleData = record
+    Stream : PSEE_object;
+    Prototype :  PSEE_object;
+    Error : PSEE_object;
+  end;
+  PStreamModuleData = ^TStreamModuleData;
+
+  TStreamObject = record
+    native : TSEE_native;
+    Stream : TStream;
+  end;
+  PSTreamObject = ^TStreamObject;
+
+Var
+  GStreamRead,
+  GStreamWrite,
+  GStreamSeek,
+  GStreamSize,
+  GStreamPosition,
+  GStreamFree,
+  GStreamfmCreate,
+  GStreamfmOpenRead,
+  GStreamfmOpenWrite,
+  GStreamfmOpenReadWrite,
+  GStreamStream,
+  GStreamError,
+  GStreamPrototype : PSEE_String;
+
+Procedure StreamAlloc(Interp : PSEE_Interpreter); cdecl;
+
+begin
+  PPointer(see_module_private(Interp,@StreamModule))^:=new(PStreamModuleData);
+end;
+
+Function PrivateData(Interp : PSEE_Interpreter) : PStreamModuleData;
+begin
+  Result:=PStreamModuleData((see_module_private(Interp,@StreamModule))^)
+end;
+
+Function AsFile(i:PTSEE_interpreter; obj:PTSEE_object) : PStreamObject;
+
+begin
+  If (Not Assigned(obj)) or (Obj^.objectclass<>StreamPrototypeDef) then
+      SEE_error__throw0(i,I^.TypeError,Nil);
+  Result:=PStreamObject(Obj)
+end;
+
+procedure StreamSize (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+Var
+  S : PStreamObject;
+
+begin
+  S:=AsFile(I,ThisObj);
+  If (S^.Stream=Nil) then
+    SEE_error__throw0(i,PrivateData(I)^.Error,Nil);
+  SEE_SET_NUMBER(res,S^.Stream.Size);
+end;
+
+
+procedure StreamWrite (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+Var
+  S : PStreamObject;
+  v : TSEE_Value;
+  t : string;
+
+begin
+  S:=AsFile(I,ThisObj);
+  If (S^.Stream=Nil) then
+    SEE_error__throw0(i,PrivateData(I)^.Error,'File is closed');
+  if (ArgC=0) then
+    SEE_error__throw0(i,I^.RangeError,'Missing argument');
+  SEE_ToString(i,argv[0], @v);
+  T:=ValueToString(V);
+  If Length(T)>0 then
+    S^.Stream.Write(T[1],Length(T));
+end;
+
+procedure StreamPosition (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+Var
+  S : PStreamObject;
+  v : TSEE_Value;
+  t : string;
+
+begin
+  S:=AsFile(I,ThisObj);
+  If (S^.Stream=Nil) then
+    SEE_error__throw0(i,PrivateData(I)^.Error,'File is closed');
+  SEE_SET_NUMBER(res,S^.Stream.Position);
+end;
+
+procedure StreamSeek (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+Var
+  S : PStreamObject;
+  v : TSEE_Value;
+  newpos : integer;
+
+begin
+  S:=AsFile(I,ThisObj);
+  If (S^.Stream=Nil) then
+    SEE_error__throw0(i,PrivateData(I)^.Error,'File is closed');
+  if (ArgC=0) then
+    SEE_error__throw0(i,I^.RangeError,'Missing argument');
+  newpos:=SEE_ToUint32(i,argv[0]);
+  SEE_SET_NUMBER(res,S^.Stream.Seek(soFromBeginning,newpos));
+end;
+
+procedure StreamRead (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+Var
+  S : PStreamObject;
+  r : PSEE_String;
+  j,maxlen : integer;
+  c : char;
+
+begin
+  S:=AsFile(I,ThisObj);
+  If (S^.Stream=Nil) then
+    SEE_error__throw0(i,PrivateData(I)^.Error,'File is closed');
+  if (ArgC=0) then
+    maxlen:=1024
+  else
+    maxlen:=see_touint32(I,argv[0]);
+  r:=see_string_new(I,maxlen);
+  For j:=0 to maxLen-1 do
+    begin
+    S^.stream.Read(c,sizeOf(c));
+    SEE_string_addch(R,ord(c));
+    end;
+  SEE_SET_STRING(Res,r);
+end;
+
+procedure StreamFree (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+Var
+  S : PStreamObject;
+  v : TSEE_Value;
+  t : string;
+
+begin
+  S:=AsFile(I,ThisObj);
+  If (S^.Stream=Nil) then
+    SEE_error__throw0(i,PrivateData(I)^.Error,'File is closed');
+  FreeAndNil(S^.Stream);
+  SEE_SET_UNDEFINED(Res);
+end;
+
+procedure StreamFinalize ( i:PTSEE_interpreter; p:pointer; closure:pointer);cdecl;
+
+begin
+  FreeAndNil(PStreamObject(P)^.Stream);
+end;
+
+procedure StreamConstruct (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+Var
+  P : PChar;
+  fm : Integer;
+  S : TStream;
+  Err : String;
+  R : PTSEE_Object;
+
+begin
+  SEE_parse_args(i,argc,argv,'Z|i',@p,@fm);
+  If (P=Nil) then
+    SEE_error__throw0(i,I^.RangeError,'Missing argument');
+  Err:='';
+  try
+    S:=TFileStream.Create(strpas(p),fm);
+  except
+    On E : Exception do
+      Err:=E.Message;
+  end;
+  If (Err<>'') then
+    SEE_error__throw0(i,PrivateData(I)^.Error,PChar(Err));
+  R:=PTSEE_Object(SEE_malloc_finalize(I,SizeOf(TStreamObject),@StreamFinalize,Nil));
+  SEE_Native_init(PSEE_Native(R),I,StreamPrototypeDef,PrivateData(I)^.Prototype);
+  PStreamObject(r)^.Stream:=S;
+  SEE_SET_OBJECT(Res,R);
+end;
+
+
+
+Procedure StreamInit(Interp : PSEE_Interpreter); cdecl;
+
+Var
+  Stream,
+  StreamPrototype,
+  StreamError : PSee_object;
+begin
+//  writeln('Initializing stream');
+  // Construct Stream.prototype object
+//  writeln('Creating Stream Prototype ');
+  StreamPrototype:=PSEE_object(SEE_malloc(Interp,SizeOf(TSTreamObject)));
+  See_native_init(PSEE_native(StreamProtoType),Interp,StreamPrototypeDef,interp^.Object_prototype);
+  PSTreamObject(StreamPrototype)^.stream:=Nil;
+  createJSFUnction(Interp,StreamPrototype,@StreamRead,GStreamRead,0);
+  createJSFUnction(Interp,StreamPrototype,@StreamWrite,GStreamWrite,0);
+  createJSFUnction(Interp,StreamPrototype,@StreamSize,GStreamSize,0);
+  createJSFUnction(Interp,StreamPrototype,@StreamPosition,GStreamPosition,0);
+  createJSFUnction(Interp,StreamPrototype,@StreamSeek,GStreamSeek,0);
+  createJSFUnction(Interp,StreamPrototype,@StreamFree,GStreamFree,0);
+//  writeln('Creating Stream');
+  // Construct Stream object
+  Stream:=PSEE_object(new_see_native);
+  See_native_init(PSEE_native(Stream),Interp,StreamObjectDef,interp^.Object_prototype);
+  CreateJSObject(Interp,Interp^.Global,GStreamStream,Stream);
+  CreateJSObject(Interp,Stream,GStreamprototype,StreamPrototype);
+  CreateJSNumber(Interp,Stream,GStreamfmCreate,fmCreate);
+  CreateJSNumber(Interp,Stream,GStreamfmOpenRead,fmOpenRead);
+  CreateJSNumber(Interp,Stream,GStreamfmOpenWrite,fmOpenWrite);
+  CreateJSNumber(Interp,Stream,GStreamfmOpenReadWrite,fmOpenReadWrite);
+  StreamError:=SEE_Error_make(interp, GSTreamError);
+  PrivateData(Interp)^.Stream:=STream;
+  PrivateData(Interp)^.Prototype:=StreamPrototype;
+  PrivateData(Interp)^.Error:=StreamError;
+//  writeln('Done initializing stream');
+end;
+
+Procedure AllocateStreamStrings;
+
+begin
+  GStreamRead:=SEE_intern_global('Read');
+  GStreamWrite:=SEE_intern_global('Write');
+  GStreamSeek:=SEE_intern_global('Seek');
+  GStreamSize:=SEE_intern_global('Size');
+  GStreamPosition:=SEE_intern_global('Position');
+  GStreamFree:=SEE_intern_global('Free');
+  GStreamfmCreate:=SEE_intern_global('fmCreate');
+  GStreamfmOpenRead:=SEE_intern_global('fmOpenRead');
+  GStreamfmOpenWrite:=SEE_intern_global('fmOpenWrite');
+  GStreamfmOpenReadWrite:=SEE_intern_global('fmOpenReadWrite');
+  GStreamStream:=SEE_intern_global('Stream');
+  GStreamError:=SEE_intern_global('Error');
+  GStreamPrototype:=SEE_intern_global('prototype');
+end;
+
+Function StreamInitModule : Integer; cdecl;
+
+begin
+//  writeln('Initializing module');
+  StreamPrototypeDef:=new_SEE_objectclass;
+  With StreamPrototypeDef^ do
+    begin
+    _Class:='Stream';
+    get:=SEE_native_get;
+    put:=SEE_native_put;
+    canput:=SEE_native_canput;
+    hasproperty:=SEE_native_hasproperty;
+    Delete:=SEE_native_delete;
+    DefaultValue:=SEE_native_defaultvalue;
+    ENumerator:=SEE_native_enumerator;
+    Construct:=Nil;
+    Call:=Nil;
+    HasInstance:=Nil;
+    end;
+  StreamObjectDef:=new_SEE_objectclass;
+  With StreamObjectDef^ do
+    begin
+    _Class:='Stream';
+    get:=SEE_native_get;
+    put:=SEE_native_put;
+    get:=SEE_native_get;
+    put:=SEE_native_put;
+    canput:=SEE_native_canput;
+    hasproperty:=SEE_native_hasproperty;
+    Delete:=SEE_native_delete;
+    DefaultValue:=SEE_native_defaultvalue;
+    ENumerator:=SEE_native_enumerator;
+    Construct:=@StreamConstruct;
+    Call:=Nil;
+    HasInstance:=Nil;
+    end;
+  AllocateStreamStrings;
+//  writeln('Done Initializing module');
+  Result:=0;
+end;
+
+Procedure RegisterStreamModule;
+
+begin
+//  writeln('Registering stream module');
+//  StreamModule:=new_SEE_module;
+  With StreamModule do
+    begin
+    magic:=SEE_MODULE_MAGIC;
+    name:='Stream';
+    version:='1.0';
+    Index:=0;
+    Mod_init:=@StreamInitModule;
+    alloc:=@StreamAlloc;
+    init:=@StreamInit
+    end;
+  SEE_module_add(@StreamModule);
+end;
+
+{ ---------------------------------------------------------------------
+  Write(ln) module support
+  ---------------------------------------------------------------------}
+
+procedure WriteWrite (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+Var
+  a,C : Integer;
+  t : string;
+  v : TSEE_Value;
+
+begin
+  if (ArgC=0) then
+    SEE_error__throw0(i,I^.RangeError,'Missing argument');
+  C:=0;
+  For A:=0 to Argc-1 do
+    begin
+    SEE_ToString(i,argv[a], @v);
+    T:=ValueToString(V);
+    If Length(T)>0 then
+      begin
+      Write(T);
+      C:=C+Length(T);
+      end;
+    end;
+  SEE_SET_NUMBER(Res,C);
+end;
+
+procedure WriteWriteln (i:PTSEE_interpreter; obj:PTSEE_object; thisobj:PTSEE_object; argc:Tcint; argv:PPTSEE_value;
+             res:PTSEE_value);cdecl;
+
+
+begin
+  if (Argc>0) then
+    WriteWrite(i,obj,thisobj,argc,argv,res)
+  else
+    SEE_SET_NUMBER(Res,0);
+  Writeln;
+end;
+
+Var
+  GWriteWrite   : PSEE_STRING;
+  GWriteWriteln : PSEE_STRING;
+
+Procedure WriteInit(Interp : PSEE_Interpreter); cdecl;
+
+begin
+//  writeln('Initializing write');
+  createJSFUnction(Interp,Interp^.Global,@WriteWrite,GWriteWrite,1);
+  createJSFUnction(Interp,Interp^.Global,@WriteWriteln,GWriteWriteln,1);
+//  writeln('Done initializing write');
+end;
+
+Procedure AllocateWriteStrings;
+
+begin
+  GWriteWrite:=SEE_intern_global('write');
+  GWriteWriteln:=SEE_intern_global('writeln');
+end;
+
+Function WriteInitModule : Integer; cdecl;
+begin
+  Result:=0;
+end;
+
+Procedure RegisterWriteModule;
+
+begin
+//  writeln('Registering write module');
+//  StreamModule:=new_SEE_module;
+  With WriteModule do
+    begin
+    magic:=SEE_MODULE_MAGIC;
+    name:='Write';
+    version:='1.0';
+    Index:=0;
+    Mod_init:=@WriteInitModule;
+    alloc:=Nil;
+    init:=@WriteInit
+    end;
+  AllocateWriteStrings;
+  SEE_module_add(@WriteModule);
+end;
+
+
+end.
+
diff --git a/packages/libsee/examples/teststream.pp b/packages/libsee/examples/teststream.pp
new file mode 100644
index 0000000000..cf35945435
--- /dev/null
+++ b/packages/libsee/examples/teststream.pp
@@ -0,0 +1,28 @@
+program teststream;
+
+{$mode objfpc}
+{$H+}
+
+uses
+  Classes, libsee, mod_stream;
+
+Var
+  interp : TSEE_interpreter;
+  ainput : PSEE_INPUT;
+  res    : TSEE_Value;
+
+const
+   Program_text = 's = new Stream("test.txt",Stream.fmCreate); '+
+                  's.Write("something"); '+
+                  's.Free(); '+
+                  'delete s;';
+
+begin
+  see_init;
+  RegisterStreamModule;
+  SEE_interpreter_init(@interp);
+  ainput :=SEE_input_utf8(@interp, pchar(program_text));
+  See_global_eval(@interp,ainput,@res);
+  see_input_close(ainput);
+end.
+
diff --git a/packages/libsee/examples/testwrite.pp b/packages/libsee/examples/testwrite.pp
new file mode 100644
index 0000000000..537e66fbf8
--- /dev/null
+++ b/packages/libsee/examples/testwrite.pp
@@ -0,0 +1,25 @@
+program testwrite;
+
+{$mode objfpc}
+{$H+}
+
+uses
+  Classes, libsee, mod_stream;
+
+Var
+  interp : TSEE_interpreter;
+  ainput : PSEE_INPUT;
+  res    : TSEE_Value;
+
+const
+   Program_text = 'writeln("Hello, world!");';
+   
+begin
+  see_init;
+  RegisterWriteModule;
+  SEE_interpreter_init(@interp);
+  ainput :=SEE_input_utf8(@interp, pchar(program_text));
+  See_global_eval(@interp,ainput,@res);
+  see_input_close(ainput);
+end.
+
diff --git a/packages/libsee/examples/tlibsee.pp b/packages/libsee/examples/tlibsee.pp
new file mode 100644
index 0000000000..894ac95345
--- /dev/null
+++ b/packages/libsee/examples/tlibsee.pp
@@ -0,0 +1,23 @@
+program tlibsee;
+
+uses libsee;
+
+Var
+  Interp : TSEE_interpreter;
+  ainput : PSEE_INPUT;
+  res : TSEE_Value;
+  
+Const
+  Program_text = 'Math.sqrt(3 + 4 * 7)+9;';
+  
+begin
+  see_init;
+  SEE_interpreter_init(@Interp);
+  ainput :=SEE_input_utf8(@Interp, pchar(program_text));
+  See_global_eval(@interp,ainput,@res);
+  if (res._type=SEE_NUMBER) then
+    Writeln('Result is : ',res.u.number)
+  else
+    Writeln('Result is not a number');
+  see_input_close(ainput);
+end.
\ No newline at end of file