From 4c483f63e79130478b7ab86d7d37dcc5d3477503 Mon Sep 17 00:00:00 2001
From: oscarl-2 <oscarl-2@d5ff2aa3-e835-421f-bc93-9a7aa3229f71>
Date: Sat, 20 Dec 2003 03:09:02 +0000
Subject: [PATCH] := operator changes.

---
 .../bepascal/pas/src/be/bepas_kernel/beobj.pp | 59 +++++++++++++++----
 .../pas/src/be/bepas_kernel/fdblib.pp         | 16 +++--
 2 files changed, 56 insertions(+), 19 deletions(-)

diff --git a/bepascal/source/bepascal/pas/src/be/bepas_kernel/beobj.pp b/bepascal/source/bepascal/pas/src/be/bepas_kernel/beobj.pp
index 6768484..df0478b 100644
--- a/bepascal/source/bepascal/pas/src/be/bepas_kernel/beobj.pp
+++ b/bepascal/source/bepascal/pas/src/be/bepas_kernel/beobj.pp
@@ -1,5 +1,6 @@
-{  BePascal - A pascal wrapper around the BeOS API
-    Copyright (C) 2002 Olivier Coursiere
+{   BePascal - A pascal wrapper around the BeOS API
+    Copyright (C) 2002 - 2003 Olivier Coursiere
+                              Oscar Lesta
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Library General Public
@@ -15,8 +16,7 @@
     License along with this library; if not, write to the Free
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 }
-
-unit beobj;
+unit BeObj;
 
 interface
 
@@ -29,7 +29,7 @@ const
   BePascalLibName = 'bepascal';
 
 type
-	// BePascal types
+  // BePascal types
   TCPlusObject = Pointer;
   THandle = Pointer;
   
@@ -39,7 +39,7 @@ type
   protected
     FCPlusObject : TCPlusObject;
   public
-    constructor Create; virtual;
+    constructor Create; virtual; // XXX "An inherited method is hidden by TBEOBJECT.CREATE"
     constructor CreatePas; virtual;
     constructor Wrap(ACPlusObject : TCPlusObject); virtual;
     destructor UnWrap; virtual;
@@ -52,11 +52,49 @@ type
 procedure SendText(aText : string);
 procedure SetSendTextProc(aProc : TSendTextProc);
 
+{
+  This operator is added to mimic (at least to some point) BeAPI's
+  const uint32 B_SOME_CONST = '_SMC';
+
+  With this operator, we can do something like this on pascal:
+
+  const
+    _B_SOME_CONST = '_SMC';
+  var
+    B_SOME_CONST : Longword;
+
+  And in the initialization:
+  B_SOME_CONST := _B_SOME_CONST; // Or just use 'TEXT' here and avoid the const.
+}
+operator := (ValueStr : string) : Longword;
+
 implementation
 
 uses
   SysUtils;
 
+operator := (ValueStr : string) : Longword;
+const
+  kOpErrorMsg = 'This operator (:=) requires four-characters strings.';
+var
+  Num : array[1..4] of Byte;
+  i : Integer;
+begin
+{$IFOPT C+} {$define assert_was_on} {$ENDIF}
+  {$C+}
+  Assert(Length(ValueStr) = 4, kOpErrorMsg);
+{$IFNDEF assert_was_on} {$C-} {$ENDIF}
+
+  for i := 1 to 4 do
+{$IFDEF ENDIAN_LITTLE}
+    Num[i] := Ord(ValueStr[5 - i]);
+{$ELSE}
+    Num[i] := Ord(ValueStr[i]);
+{$ENDIF}
+
+  Result := Longword(Num);
+end;
+
 var
   PasObject_GetPasClassName_hook : Pointer; cvar; external;
   SendTextProc : TSendTextProc;
@@ -107,8 +145,10 @@ begin
 end;
 
 procedure TBeObject.Debug;
+{$IFDEF DEBUG}
 var
   size : cardinal;
+{$ENDIF}
 begin
 {$IFDEF DEBUG}
   size := 0;
@@ -133,14 +173,13 @@ begin
   Self.CPlusObject := nil;
 end;
 
-  // end TBeObject
+// end TBeObject
 
 initialization
   PasObject_GetPasClassName_hook := @PasObject_GetPasClassName_hook_func;
   if not Assigned(SendTextProc) then
     SendTextProc := nil;
-  
+
 finalization
   PasObject_GetPasClassName_hook := nil;
-  
-end.
+end.
\ No newline at end of file
diff --git a/bepascal/source/bepascal/pas/src/be/bepas_kernel/fdblib.pp b/bepascal/source/bepascal/pas/src/be/bepas_kernel/fdblib.pp
index adbbde1..8400b53 100644
--- a/bepascal/source/bepascal/pas/src/be/bepas_kernel/fdblib.pp
+++ b/bepascal/source/bepascal/pas/src/be/bepas_kernel/fdblib.pp
@@ -1,5 +1,6 @@
-{  BePascal - A pascal wrapper around the BeOS API
-    Copyright (C) 2002 Olivier Coursiere
+{   BePascal - A pascal wrapper around the BeOS API
+    Copyright (C) 2002 - 2003 Olivier Coursiere
+                              Oscar Lesta
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Library General Public
@@ -21,7 +22,6 @@ When this unit is used in a BePascal project, the SendText function
 in beobj.pp send a "dbug" message to a fdb client.
 When fdblib is not in the project, SendText in beobj just do nothing.
 }
-
 unit fdblib;
 
 interface 
@@ -31,10 +31,10 @@ procedure force;
 implementation
 
 uses
-  appdefs, message, application, messenger, handler, os, supportdefs, beobj;
+  BeObj, Application, Handler, Message, Messenger, OS, SupportDefs;
   
 const
-  B_DEBUG : array[0..3] of Char = ('d', 'b', 'u', 'g');
+  B_DEBUG = 'dbug';
   
 procedure SendMessage(message : BMessage);
 var
@@ -68,7 +68,7 @@ begin
   if be_app <> nil then
   begin
     local := text + #0;
-    message := BMessage.Create(trans(B_DEBUG));
+    message := BMessage.Create(Longword(B_DEBUG));
     try
       message.AddString(PChar('dbstring'), @local[1]);
       SendMessage(message);
@@ -90,7 +90,6 @@ begin
 end;
 }
 
-
 procedure force;
 begin
   writeln('force');
@@ -103,5 +102,4 @@ initialization
 
 finalization
   SendText('App end');
-
-end.
+end.
\ No newline at end of file