initial version

This commit is contained in:
memson
2002-05-26 18:52:43 +00:00
parent b0351d5098
commit c850afcc5c
31 changed files with 3031 additions and 0 deletions

View File

@@ -0,0 +1,25 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _APPKIT_CPP_
#define _APPKIT_CPP_
#include <Application.cpp>
#include <Message.cpp>
#endif /* _APPKIT_CPP_ */

View File

@@ -0,0 +1,24 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _BE_CPP_
#define _BE_CPP_
#include <AppKit.cpp>
#endif /* _BE_CPP_ */

View File

@@ -0,0 +1,150 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _APPLICATION_CPP_
#define _APPLICATION_CPP_
#include <Application.h>
#include <Archivable.h>
#include <Roster.cpp>
#include <Message.cpp>
#include <Archivable.cpp>
#include <Handler.cpp>
#include <Looper.cpp>
#include <Window.cpp>
#include <Point.cpp>
#include <Rect.cpp>
#include <beobj.cpp>
// definition of callback function in BApplication
typedef void (*BApplication_AppActivated_hook) (TPasObject PasObject, bool active);
typedef void (*BApplication_ReadyToRun_hook) (TPasObject PasObject);
// typedef bool (*BApplication_QuitRequested_hook) (TPasObject PasObject);
// typedef void (*BApplication_MessageReceived_hook) (TPasObject PasObject, TCPlusObject message);
#if defined(__cplusplus)
extern "C" {
#endif
BApplication_AppActivated_hook Application_AppActivated_hook;
BApplication_ReadyToRun_hook Application_ReadyToRun_hook;
//BApplication_QuitRequested_hook Application_QuitRequested_hook;
//BApplication_MessageReceived_hook Application_MessageReceived_hook;
#if defined(__cplusplus)
}
#endif
class BPApplication : public BApplication, public BPLooper
{
public:
BPApplication(TPasObject PasObject, const char *signature);
BPApplication(TPasObject PasObject, const char *signature,
status_t *error);
virtual void AppActivated(bool active);
virtual void ReadyToRun(void);
virtual bool QuitRequested(void);
virtual void MessageReceived(BMessage *message);
private:
};
BPApplication::BPApplication(TPasObject PasObject, const char *signature)
: BApplication(signature), BPLooper(PasObject)
{
}
BPApplication::BPApplication(TPasObject PasObject, const char *signature,
status_t *error) : BApplication(signature, error), BPLooper(PasObject)
{
}
void BPApplication::AppActivated(bool active)
{
Application_AppActivated_hook(GetPasObject(), active);
}
void BPApplication::ReadyToRun(void)
{
Application_ReadyToRun_hook(GetPasObject());
}
bool BPApplication::QuitRequested(void)
{
return BPLooper::QuitRequested();
}
void BPApplication::MessageReceived(BMessage *message)
{
BPHandler::MessageReceived(message);
}
#if defined(__cplusplus)
extern "C" {
#endif
TCPlusObject BApplication_Create_1(TPasObject PasObject)
{
return new BPApplication(PasObject, "application/x-vnd.RuBe");
}
TCPlusObject BApplication_Create_2(TPasObject PasObject, const char *Signature)
{
return new BPApplication(PasObject, Signature);
}
TCPlusObject BApplication_Create_3(TPasObject PasObject, const char *Signature,
status_t *error)
{
return new BPApplication(PasObject, Signature, error);
}
void BApplication_Free(TCPlusObject Application)
{
delete Application;
}
void BApplication_HideCursor(TCPlusObject Application)
{
reinterpret_cast<BApplication*>(Application)->HideCursor();
}
void BApplication_ShowCursor(TCPlusObject Application)
{
reinterpret_cast<BApplication*>(Application)->ShowCursor();
}
thread_id BApplication_Run(TCPlusObject Application)
{
return reinterpret_cast<BApplication*>(Application)->Run();
}
void BApplication_Quit(TCPlusObject Application)
{
reinterpret_cast<BApplication*>(Application)->Quit();
}
#if defined(__cplusplus)
}
#endif
#endif /* _APPLICATION_CPP_ */

View File

@@ -0,0 +1,78 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _HANDLER_CPP_
#define _HANDLER_CPP_
#include <Handler.h>
#include <beobj.cpp>
// definition of callback function in BHandler
typedef void (*BHandler_MessageReceived_hook) (TPasObject PasObject, TCPlusObject message);
#if defined(__cplusplus)
extern "C" {
#endif
BHandler_MessageReceived_hook Handler_MessageReceived_hook;
#if defined(__cplusplus)
}
#endif
class BPHandler : public BHandler, public BPasObject
{
public:
BPHandler(TPasObject PasObject, const char *name = NULL);
virtual ~BPHandler(void);
virtual void MessageReceived(BMessage *message);
private:
};
BPHandler::BPHandler(TPasObject PasObject, const char *name)
: BHandler(name), BPasObject(PasObject)
{
}
BPHandler::~BPHandler()
{
}
void BPHandler::MessageReceived(BMessage *message)
{
Handler_MessageReceived_hook(GetPasObject(), message);
}
#if defined(__cplusplus)
extern "C" {
#endif
TCPlusObject BHandler_Create(TPasObject PasObject, const char *name)
{
return new BPHandler(PasObject, name);
}
#if defined(__cplusplus)
}
#endif
#endif /* _HANDLER_CPP_ */

View File

@@ -0,0 +1,121 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _LOOPER_CPP_
#define _LOOPER_CPP_
#include <Looper.h>
#include <Message.h>
#include <OS.h>
#include <beobj.cpp>
// definition of callback function in BLooper
typedef void (*BLooper_DispatchMessage_hook) (TPasObject PasObject,
TCPlusObject message,
TCPlusObject target);
typedef bool(*BLooper_QuitRequested_hook) (TPasObject PasObject);
#if defined(__cplusplus)
extern "C" {
#endif
BLooper_DispatchMessage_hook Looper_DispatchMessage_hook;
BLooper_QuitRequested_hook Looper_QuitRequested_hook;
#if defined(__cplusplus)
}
#endif
class BPLooper : public BLooper, public BPHandler
{
public:
BPLooper(TPasObject PasObject, const char *name = NULL,
int32 priority = B_NORMAL_PRIORITY,
int32 portCapacity = B_LOOPER_PORT_DEFAULT_CAPACITY);
virtual ~BPLooper();
virtual void DispatchMessage(BMessage *message, BHandler *target);
virtual bool QuitRequested(void);
private:
};
BPLooper::BPLooper(TPasObject PasObject, const char *name = NULL,
int32 priority = B_NORMAL_PRIORITY,
int32 portCapacity = B_LOOPER_PORT_DEFAULT_CAPACITY)
: BLooper(name, priority, portCapacity),
BPHandler(PasObject, name)
{
}
BPLooper::~BPLooper()
{
}
void BPLooper::DispatchMessage(BMessage *message, BHandler *target)
{
Looper_DispatchMessage_hook(GetPasObject(), message, target);
}
bool BPLooper::QuitRequested(void)
{
return Looper_QuitRequested_hook(GetPasObject());
}
#if defined(__cplusplus)
extern "C" {
#endif
TCPlusObject BLooper_Create(TPasObject PasObject, const char *name,
int32 priority,
int32 portCapacity)
{
return new BPLooper(PasObject, name, priority, portCapacity);
}
status_t BLooper_GetSupportedSuites(TCPlusObject Looper, BMessage *message)
{
return reinterpret_cast<BLooper*>(Looper)->GetSupportedSuites(message);
}
bool BLooper_LockLooper(TCPlusObject Looper)
{
return reinterpret_cast<BLooper*>(Looper)->LockLooper();
}
status_t BLooper_LockLooperWithTimeout(TCPlusObject Looper, bigtime_t timeout)
{
return reinterpret_cast<BLooper*>(Looper)->LockLooperWithTimeout(timeout);
}
void BLooper_UnlockLooper(TCPlusObject Looper)
{
reinterpret_cast<BLooper*>(Looper)->UnlockLooper();
}
status_t BLooper_PostMessage_2(TCPlusObject Looper, uint32 command)
{
return reinterpret_cast<BLooper*>(Looper)->PostMessage(command);
}
#if defined(__cplusplus)
}
#endif
#endif /* _LOOPER_CPP_ */

View File

@@ -0,0 +1,233 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _MESSAGE_CPP_
#define _MESSAGE_CPP_
#include <Application.h>
#include <Message.h>
#include <SupportDefs.h>
#include <beobj.cpp>
#if defined(__cplusplus)
extern "C" {
#endif
// No hook in BMessage
#if defined(__cplusplus)
}
#endif
class BPMessage;
class BPMessage : public BMessage, private BPasObject
{
public:
BPMessage(TPasObject PasObject);
BPMessage(TPasObject PasObject, uint32 what);
BPMessage(TPasObject PasObject, TCPlusObject message);
private:
};
BPMessage::BPMessage(TPasObject PasObject)
: BMessage(), BPasObject(PasObject)
{
}
BPMessage::BPMessage(TPasObject PasObject, uint32 what)
: BMessage(what), BPasObject(PasObject)
{
}
BPMessage::BPMessage(TPasObject PasObject, TCPlusObject message)
: BMessage(reinterpret_cast<BMessage&>(message)), BPasObject(PasObject)
{
// Attention, problème potentiel avec le reinterpret_cast de la référence
// A tester !
// Je ne suis pas sur de la correspondance entre le C++ et le pascal
}
#if defined(__cplusplus)
extern "C" {
#endif
TCPlusObject BMessage_Create_1(TPasObject PasObject)
{
return new BPMessage(PasObject);
}
TCPlusObject BMessage_Create_2(TPasObject PasObject, uint32 what)
{
return new BPMessage(PasObject, what);
}
TCPlusObject BMessage_Create_3(TPasObject PasObject, TCPlusObject message)
{
return new BPMessage(PasObject, message);
}
void BMessage_Free(TCPlusObject message)
{
delete message;
}
uint32 BMessage_Getwhat(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->what;
}
void BMessage_Setwhat(TCPlusObject message, uint32 what)
{
reinterpret_cast<BMessage*>(message)->what = what;
}
status_t BMessage_AddData(TCPlusObject message, const char *name,
type_code type,
const void *data,
ssize_t fixedSize = true,
int32 numItems = 1)
{
return reinterpret_cast<BMessage*>(message)->AddData(name, type, data,
fixedSize, numItems);
}
status_t BMessage_AddBool(TCPlusObject message, const char *name, bool aBool)
{
return reinterpret_cast<BMessage*>(message)->AddBool(name, aBool);
}
status_t BMessage_AddInt8(TCPlusObject message, const char *name, int8 anInt8)
{
return reinterpret_cast<BMessage*>(message)->AddInt8(name, anInt8);
}
status_t BMessage_AddInt16(TCPlusObject message, const char *name, int16 anInt16)
{
return reinterpret_cast<BMessage*>(message)->AddInt16(name, anInt16);
}
status_t BMessage_AddInt32(TCPlusObject message, const char *name, int32 anInt32)
{
return reinterpret_cast<BMessage*>(message)->AddInt32(name, anInt32);
}
status_t BMessage_AddInt64(TCPlusObject message, const char *name, int64 anInt64)
{
return reinterpret_cast<BMessage*>(message)->AddInt64(name, anInt64);
}
status_t BMessage_AddFloat(TCPlusObject message, const char *name, float aFloat)
{
return reinterpret_cast<BMessage*>(message)->AddFloat(name, aFloat);
}
status_t BMessage_AddDouble(TCPlusObject message, const char *name, double aDouble)
{
return reinterpret_cast<BMessage*>(message)->AddDouble(name, aDouble);
}
status_t BMessage_AddString(TCPlusObject message, const char *name, const char *string)
{
return reinterpret_cast<BMessage*>(message)->AddString(name, string);
}
status_t BMessage_AddMessage(TCPlusObject message, const char *name, const TCPlusObject amessage)
{
return reinterpret_cast<BMessage*>(message)->AddMessage(name, reinterpret_cast<BMessage*>(amessage));
}
int32 BMessage_CountNames(TCPlusObject message, type_code type)
{
return reinterpret_cast<BMessage*>(message)->CountNames(type);
}
bool BMessage_HasSpecifiers(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->HasSpecifiers();
}
bool BMessage_IsSystem(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->IsSystem();
}
status_t BMessage_MakeEmpty(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->MakeEmpty();
}
bool BMessage_IsEmpty(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->IsEmpty();
}
status_t BMessage_RemoveName(TCPlusObject message, const char *name)
{
return reinterpret_cast<BMessage*>(message)->RemoveName(name);
}
void BMessage_PrintToStream(TCPlusObject message)
{
reinterpret_cast<BMessage*>(message)->PrintToStream();
}
status_t BMessage_RemoveData(TCPlusObject message, const char *name, int32 index = 0)
{
return reinterpret_cast<BMessage*>(message)->RemoveData(name, index);
}
bool BMessage_WasDelivered(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->WasDelivered();
}
bool BMessage_IsSourceRemote(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->IsSourceRemote();
}
bool BMessage_IsSourceWaiting(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->IsSourceWaiting();
}
bool BMessage_IsReply(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->IsReply();
}
const BMessage *BMessage_Previous(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->Previous();
}
bool BMessage_WasDropped(TCPlusObject message)
{
return reinterpret_cast<BMessage*>(message)->WasDropped();
}
#if defined(__cplusplus)
}
#endif
#endif /* _MESSAGE_CPP_ */

View File

@@ -0,0 +1,56 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _ROSTER_CPP_
#define _ROSTER_CPP_
#include <Roster.h>
#include <beobj.cpp>
#include <Message.cpp>
#if defined(__cplusplus)
extern "C" {
#endif
const TCPlusObject Get_be_roster(void)
{
// Pas très propre ! Si quelqu'un a mieux...
return TCPlusObject(be_roster);
}
TCPlusObject BRoster_Create(TPasObject PasObject)
{
return new BRoster();
}
void BRoster_Destroy(TPasObject PasObject)
{
delete PasObject;
}
status_t BRoster_Broadcast(TCPlusObject Roster, TCPlusObject *message)
{
return reinterpret_cast<BRoster*>(Roster)->Broadcast(reinterpret_cast<BMessage*>(message));
}
#if defined(__cplusplus)
}
#endif
#endif /* _ROSTER_CPP_ */

View File

@@ -0,0 +1,302 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit appdefs;
interface
const
// System Messages Codes
_B_ABOUT_REQUESTED : array[0..3] of Char = ('_', 'A', 'B', 'R');
_B_WINDOW_ACTIVATED : array[0..3] of Char = ('_', 'A', 'C', 'T');
_B_APP_ACTIVATED : array[0..3] of Char = ('_', 'A', 'C', 'T'); //* Same as B_WINDOW_ACTIVATED */
_B_ARGV_RECEIVED : array[0..3] of Char = ('_', 'A', 'R', 'G');
_B_QUIT_REQUESTED : array[0..3] of Char = ('_', 'Q', 'R', 'Q');
_B_CLOSE_REQUESTED : array[0..3] of Char = ('_', 'Q', 'R', 'Q'); //* Obsolete; use B_QUIT_REQUESTED */
_B_CANCEL : array[0..3] of Char = ('_', 'C', 'N', 'C');
_B_KEY_DOWN : array[0..3] of Char = ('_', 'K', 'Y', 'D');
_B_KEY_UP : array[0..3] of Char = ('_', 'K', 'Y', 'U');
_B_UNMAPPED_KEY_DOWN : array[0..3] of Char = ('_', 'U', 'K', 'D');
_B_UNMAPPED_KEY_UP : array[0..3] of Char = ('_', 'U', 'K', 'U');
_B_MODIFIERS_CHANGED : array[0..3] of Char = ('_', 'M', 'C', 'H');
_B_MINIMIZE : array[0..3] of Char = ('_', 'W', 'M', 'N');
_B_MOUSE_DOWN : array[0..3] of Char = ('_', 'M', 'D', 'N');
_B_MOUSE_MOVED : array[0..3] of Char = ('_', 'M', 'M', 'V');
_B_MOUSE_ENTER_EXIT : array[0..3] of Char = ('_', 'M', 'E', 'X');
_B_MOUSE_UP : array[0..3] of Char = ('_', 'M', 'U', 'P');
_B_MOUSE_WHEEL_CHANGED : array[0..3] of Char = ('_', 'M', 'W', 'C');
_B_OPEN_IN_WORKSPACE : array[0..3] of Char = ('_', 'O', 'W', 'S');
_B_PRINTER_CHANGED : array[0..3] of Char = ('_', 'P', 'C', 'H');
_B_PULSE : array[0..3] of Char = ('_', 'P', 'U', 'L');
_B_READY_TO_RUN : array[0..3] of Char = ('_', 'R', 'T', 'R');
_B_REFS_RECEIVED : array[0..3] of Char = ('_', 'R', 'R', 'C');
_B_RELEASE_OVERLAY_LOCK : array[0..3] of Char = ('_', 'R', 'O', 'V');
_B_ACQUIRE_OVERLAY_LOCK : array[0..3] of Char = ('_', 'A', 'O', 'V');
_B_SCREEN_CHANGED : array[0..3] of Char = ('_', 'S', 'C', 'H');
_B_VALUE_CHANGED : array[0..3] of Char = ('_', 'V', 'C', 'H');
_B_VIEW_MOVED : array[0..3] of Char = ('_', 'V', 'M', 'V');
_B_VIEW_RESIZED : array[0..3] of Char = ('_', 'V', 'R', 'S');
_B_WINDOW_MOVED : array[0..3] of Char = ('_', 'W', 'M', 'V');
_B_WINDOW_RESIZED : array[0..3] of Char = ('_', 'W', 'R', 'S');
_B_WORKSPACES_CHANGED : array[0..3] of Char = ('_', 'W', 'C', 'G');
_B_WORKSPACE_ACTIVATED : array[0..3] of Char = ('_', 'W', 'A', 'C');
_B_ZOOM : array[0..3] of Char = ('_', 'W', 'Z', 'M');
__APP_MENU_ : array[0..3] of Char = ('_', 'A', 'M', 'N');
__BROWSER_MENUS_ : array[0..3] of Char = ('_', 'B', 'R', 'M');
__MENU_EVENT_ : array[0..3] of Char = ('_', 'M', 'E', 'V');
__PING_ : array[0..3] of Char = ('_', 'P', 'B', 'L');
__QUIT_ : array[0..3] of Char = ('_', 'Q', 'I', 'T');
__VOLUME_MOUNTED_ : array[0..3] of Char = ('_', 'N', 'V', 'L');
__VOLUME_UNMOUNTED_ : array[0..3] of Char = ('_', 'V', 'R', 'M');
__MESSAGE_DROPPED_ : array[0..3] of Char = ('_', 'M', 'D', 'P');
__DISPOSE_DRAG_ : array[0..3] of Char = ('_', 'D', 'P', 'D');
__MENUS_DONE_ : array[0..3] of Char = ('_', 'M', 'N', 'D');
__SHOW_DRAG_HANDLES_ : array[0..3] of Char = ('_', 'S', 'D', 'H');
__EVENTS_PENDING_ : array[0..3] of Char = ('_', 'E', 'V', 'P');
__UPDATE_ : array[0..3] of Char = ('_', 'U', 'P', 'D');
__UPDATE_IF_NEEDED_ : array[0..3] of Char = ('_', 'U', 'P', 'N');
__PRINTER_INFO_ : array[0..3] of Char = ('_', 'P', 'I', 'N');
__SETUP_PRINTER_ : array[0..3] of Char = ('_', 'S', 'U', 'P');
__SELECT_PRINTER_ : array[0..3] of Char = ('_', 'P', 'S', 'L');
// Other Commands
_B_SET_PROPERTY : array[0..3] of Char = ('P', 'S', 'E', 'T');
_B_GET_PROPERTY : array[0..3] of Char = ('P', 'G', 'E', 'T');
_B_CREATE_PROPERTY : array[0..3] of Char = ('P', 'C', 'R', 'T');
_B_DELETE_PROPERTY : array[0..3] of Char = ('P', 'D', 'E', 'L');
_B_COUNT_PROPERTIES : array[0..3] of Char = ('P', 'C', 'N', 'T');
_B_EXECUTE_PROPERTY : array[0..3] of Char = ('P', 'E', 'X', 'E');
_B_GET_SUPPORTED_SUITES : array[0..3] of Char = ('S', 'U', 'I', 'T');
_B_UNDO : array[0..3] of Char = ('U', 'N', 'D', 'O');
_B_CUT : array[0..3] of Char = ('C', 'C', 'U', 'T');
_B_COPY : array[0..3] of Char = ('C', 'O', 'P', 'Y');
_B_PASTE : array[0..3] of Char = ('P', 'S', 'T', 'E');
_B_SELECT_ALL : array[0..3] of Char = ('S', 'A', 'L', 'L');
_B_SAVE_REQUESTED : array[0..3] of Char = ('S', 'A', 'V', 'E');
_B_MESSAGE_NOT_UNDERSTOOD : array[0..3] of Char = ('M', 'N', 'O', 'T');
_B_NO_REPLY : array[0..3] of Char = ('N', 'O', 'N', 'E');
_B_REPLY : array[0..3] of Char = ('R', 'P', 'L', 'Y');
_B_SIMPLE_DATA : array[0..3] of Char = ('D', 'A', 'T', 'A');
_B_MIME_DATA : array[0..3] of Char = ('M', 'I', 'M', 'E');
_B_ARCHIVED_OBJECT : array[0..3] of Char = ('A', 'R', 'C', 'V');
_B_UPDATE_STATUS_BAR : array[0..3] of Char = ('S', 'B', 'U', 'P');
_B_RESET_STATUS_BAR : array[0..3] of Char = ('S', 'B', 'R', 'S');
_B_NODE_MONITOR : array[0..3] of Char = ('N', 'D', 'M', 'N');
_B_QUERY_UPDATE : array[0..3] of Char = ('Q', 'U', 'P', 'D');
_B_ENDORSABLE : array[0..3] of Char = ('E', 'N', 'D', 'O');
_B_COPY_TARGET : array[0..3] of Char = ('D', 'D', 'C', 'P');
_B_MOVE_TARGET : array[0..3] of Char = ('D', 'D', 'M', 'V');
_B_TRASH_TARGET : array[0..3] of Char = ('D', 'D', 'R', 'M');
_B_LINK_TARGET : array[0..3] of Char = ('D', 'D', 'L', 'N');
_B_INPUT_DEVICES_CHANGED : array[0..3] of Char = ('I', 'D', 'C', 'H');
_B_INPUT_METHOD_EVENT : array[0..3] of Char = ('I', 'M', 'E', 'V');
_B_WINDOW_MOVE_TO : array[0..3] of Char = ('W', 'D', 'M', 'T');
_B_WINDOW_MOVE_BY : array[0..3] of Char = ('W', 'D', 'M', 'B');
_B_SILENT_RELAUNCH : array[0..3] of Char = ('A', 'R', 'E', 'L');
_B_OBSERVER_NOTICE_CHANGE : array[0..3] of Char = ('N', 'T', 'C', 'H');
_B_CONTROL_INVOKED : array[0..3] of Char = ('C', 'I', 'V', 'K');
_B_CONTROL_MODIFIED : array[0..3] of Char = ('C', 'M', 'O', 'D');
//* Media Kit reserves all reserved codes starting in 'TRI' */
var
B_ABOUT_REQUESTED : Cardinal;
B_WINDOW_ACTIVATED : Cardinal;
B_APP_ACTIVATED : Cardinal;
B_ARGV_RECEIVED : Cardinal;
B_QUIT_REQUESTED : Cardinal;
B_CLOSE_REQUESTED : Cardinal;
B_CANCEL : Cardinal;
B_KEY_DOWN : Cardinal;
B_KEY_UP : Cardinal;
B_UNMAPPED_KEY_DOWN : Cardinal;
B_UNMAPPED_KEY_UP : Cardinal;
B_MODIFIERS_CHANGED : Cardinal;
B_MINIMIZE : Cardinal;
B_MOUSE_DOWN : Cardinal;
B_MOUSE_MOVED : Cardinal;
B_MOUSE_ENTER_EXIT : Cardinal;
B_MOUSE_UP : Cardinal;
B_MOUSE_WHEEL_CHANGED : Cardinal;
B_OPEN_IN_WORKSPACE : Cardinal;
B_PRINTER_CHANGED : Cardinal;
B_PULSE : Cardinal;
B_READY_TO_RUN : Cardinal;
B_REFS_RECEIVED : Cardinal;
B_RELEASE_OVERLAY_LOCK : Cardinal;
B_ACQUIRE_OVERLAY_LOCK : Cardinal;
B_SCREEN_CHANGED : Cardinal;
B_VALUE_CHANGED : Cardinal;
B_VIEW_MOVED : Cardinal;
B_VIEW_RESIZED : Cardinal;
B_WINDOW_MOVED : Cardinal;
B_WINDOW_RESIZED : Cardinal;
B_WORKSPACES_CHANGED : Cardinal;
B_WORKSPACE_ACTIVATED : Cardinal;
B_ZOOM : Cardinal;
_APP_MENU_ : Cardinal;
_BROWSER_MENUS_ : Cardinal;
_MENU_EVENT_ : Cardinal;
_PING_ : Cardinal;
_QUIT_ : Cardinal;
_VOLUME_MOUNTED_ : Cardinal;
_VOLUME_UNMOUNTED_ : Cardinal;
_MESSAGE_DROPPED_ : Cardinal;
_DISPOSE_DRAG_ : Cardinal;
_MENUS_DONE_ : Cardinal;
_SHOW_DRAG_HANDLES_ : Cardinal;
_EVENTS_PENDING_ : Cardinal;
_UPDATE_ : Cardinal;
_UPDATE_IF_NEEDED_ : Cardinal;
_PRINTER_INFO_ : Cardinal;
_SETUP_PRINTER_ : Cardinal;
_SELECT_PRINTER_ : Cardinal;
// Other Commands
B_SET_PROPERTY : Cardinal;
B_GET_PROPERTY : Cardinal;
B_CREATE_PROPERTY : Cardinal;
B_DELETE_PROPERTY : Cardinal;
B_COUNT_PROPERTIES : Cardinal;
B_EXECUTE_PROPERTY : Cardinal;
B_GET_SUPPORTED_SUITES : Cardinal;
B_UNDO : Cardinal;
B_CUT : Cardinal;
B_COPY : Cardinal;
B_PASTE : Cardinal;
B_SELECT_ALL : Cardinal;
B_SAVE_REQUESTED : Cardinal;
B_MESSAGE_NOT_UNDERSTOOD : Cardinal;
B_NO_REPLY : Cardinal;
B_REPLY : Cardinal;
B_SIMPLE_DATA : Cardinal;
B_MIME_DATA : Cardinal;
B_ARCHIVED_OBJECT : Cardinal;
B_UPDATE_STATUS_BAR : Cardinal;
B_RESET_STATUS_BAR : Cardinal;
B_NODE_MONITOR : Cardinal;
B_QUERY_UPDATE : Cardinal;
B_ENDORSABLE : Cardinal;
B_COPY_TARGET : Cardinal;
B_MOVE_TARGET : Cardinal;
B_TRASH_TARGET : Cardinal;
B_LINK_TARGET : Cardinal;
B_INPUT_DEVICES_CHANGED : Cardinal;
B_INPUT_METHOD_EVENT : Cardinal;
B_WINDOW_MOVE_TO : Cardinal;
B_WINDOW_MOVE_BY : Cardinal;
B_SILENT_RELAUNCH : Cardinal;
B_OBSERVER_NOTICE_CHANGE : Cardinal;
B_CONTROL_INVOKED : Cardinal;
B_CONTROL_MODIFIED : Cardinal;
implementation
initialization
// System Messages Codes
B_ABOUT_REQUESTED := Cardinal(_B_ABOUT_REQUESTED);
B_WINDOW_ACTIVATED := Cardinal(_B_WINDOW_ACTIVATED);
B_APP_ACTIVATED := Cardinal(_B_APP_ACTIVATED);
B_ARGV_RECEIVED := Cardinal(_B_ARGV_RECEIVED);
B_QUIT_REQUESTED := Cardinal(_B_QUIT_REQUESTED);
B_CLOSE_REQUESTED := Cardinal(_B_CLOSE_REQUESTED);
B_CANCEL := Cardinal(_B_CANCEL);
B_KEY_DOWN := Cardinal(_B_KEY_DOWN);
B_KEY_UP := Cardinal(_B_KEY_UP);
B_UNMAPPED_KEY_DOWN := Cardinal(_B_UNMAPPED_KEY_DOWN);
B_UNMAPPED_KEY_UP := Cardinal(_B_UNMAPPED_KEY_UP);
B_MODIFIERS_CHANGED := Cardinal(_B_MODIFIERS_CHANGED);
B_MINIMIZE := Cardinal(_B_MINIMIZE);
B_MOUSE_DOWN := Cardinal(_B_MOUSE_DOWN);
B_MOUSE_MOVED := Cardinal(_B_MOUSE_MOVED);
B_MOUSE_ENTER_EXIT := Cardinal(_B_MOUSE_ENTER_EXIT);
B_MOUSE_UP := Cardinal(_B_MOUSE_UP);
B_MOUSE_WHEEL_CHANGED := Cardinal(_B_MOUSE_WHEEL_CHANGED);
B_OPEN_IN_WORKSPACE := Cardinal(_B_OPEN_IN_WORKSPACE);
B_PRINTER_CHANGED := Cardinal(_B_PRINTER_CHANGED);
B_PULSE := Cardinal(_B_PULSE);
B_READY_TO_RUN := Cardinal(_B_READY_TO_RUN);
B_REFS_RECEIVED := Cardinal(_B_REFS_RECEIVED);
B_RELEASE_OVERLAY_LOCK := Cardinal(_B_RELEASE_OVERLAY_LOCK);
B_ACQUIRE_OVERLAY_LOCK := Cardinal(_B_ACQUIRE_OVERLAY_LOCK);
B_SCREEN_CHANGED := Cardinal(_B_SCREEN_CHANGED);
B_VALUE_CHANGED := Cardinal(_B_VALUE_CHANGED);
B_VIEW_MOVED := Cardinal(_B_VIEW_MOVED);
B_VIEW_RESIZED := Cardinal(_B_VIEW_RESIZED);
B_WINDOW_MOVED := Cardinal(_B_WINDOW_MOVED);
B_WINDOW_RESIZED := Cardinal(_B_WINDOW_RESIZED);
B_WORKSPACES_CHANGED := Cardinal(_B_WORKSPACES_CHANGED);
B_WORKSPACE_ACTIVATED := Cardinal(_B_WORKSPACE_ACTIVATED);
B_ZOOM := Cardinal(_B_ZOOM);
_APP_MENU_ := Cardinal(__APP_MENU_);
_BROWSER_MENUS_ := Cardinal(__BROWSER_MENUS_);
_MENU_EVENT_ := Cardinal(__MENU_EVENT_);
_PING_ := Cardinal(__PING_);
_QUIT_ := Cardinal(__QUIT_);
_VOLUME_MOUNTED_ := Cardinal(__VOLUME_MOUNTED_);
_VOLUME_UNMOUNTED_ := Cardinal(__VOLUME_UNMOUNTED_);
_MESSAGE_DROPPED_ := Cardinal(__MESSAGE_DROPPED_);
_DISPOSE_DRAG_ := Cardinal(__DISPOSE_DRAG_);
_MENUS_DONE_ := Cardinal(__MENUS_DONE_);
_SHOW_DRAG_HANDLES_ := Cardinal(__SHOW_DRAG_HANDLES_);
_EVENTS_PENDING_ := Cardinal(__EVENTS_PENDING_);
_UPDATE_ := Cardinal(__UPDATE_);
_UPDATE_IF_NEEDED_ := Cardinal(__UPDATE_IF_NEEDED_);
_PRINTER_INFO_ := Cardinal(__PRINTER_INFO_);
_SETUP_PRINTER_ := Cardinal(__SETUP_PRINTER_);
_SELECT_PRINTER_ := Cardinal(__SELECT_PRINTER_);
// Other Commands
B_SET_PROPERTY := Cardinal(_B_SET_PROPERTY);
B_GET_PROPERTY := Cardinal(_B_GET_PROPERTY);
B_CREATE_PROPERTY := Cardinal(_B_CREATE_PROPERTY);
B_DELETE_PROPERTY := Cardinal(_B_DELETE_PROPERTY);
B_COUNT_PROPERTIES := Cardinal(_B_COUNT_PROPERTIES);
B_EXECUTE_PROPERTY := Cardinal(_B_EXECUTE_PROPERTY);
B_GET_SUPPORTED_SUITES := Cardinal(_B_GET_SUPPORTED_SUITES);
B_UNDO := Cardinal(_B_UNDO);
B_CUT := Cardinal(_B_CUT);
B_COPY := Cardinal(_B_COPY);
B_PASTE := Cardinal(_B_PASTE);
B_SELECT_ALL := Cardinal(_B_SELECT_ALL);
B_SAVE_REQUESTED := Cardinal(_B_SAVE_REQUESTED);
B_MESSAGE_NOT_UNDERSTOOD := Cardinal(_B_MESSAGE_NOT_UNDERSTOOD);
B_NO_REPLY := Cardinal(_B_NO_REPLY);
B_REPLY := Cardinal(_B_REPLY);
B_SIMPLE_DATA := Cardinal(_B_SIMPLE_DATA);
B_MIME_DATA := Cardinal(_B_MIME_DATA);
B_ARCHIVED_OBJECT := Cardinal(_B_ARCHIVED_OBJECT);
B_UPDATE_STATUS_BAR := Cardinal(_B_UPDATE_STATUS_BAR);
B_RESET_STATUS_BAR := Cardinal(_B_RESET_STATUS_BAR);
B_NODE_MONITOR := Cardinal(_B_NODE_MONITOR);
B_QUERY_UPDATE := Cardinal(_B_QUERY_UPDATE);
B_ENDORSABLE := Cardinal(_B_ENDORSABLE);
B_COPY_TARGET := Cardinal(_B_COPY_TARGET);
B_MOVE_TARGET := Cardinal(_B_MOVE_TARGET);
B_TRASH_TARGET := Cardinal(_B_TRASH_TARGET);
B_LINK_TARGET := Cardinal(_B_LINK_TARGET);
B_INPUT_DEVICES_CHANGED := Cardinal(_B_INPUT_DEVICES_CHANGED);
B_INPUT_METHOD_EVENT := Cardinal(_B_INPUT_METHOD_EVENT);
B_WINDOW_MOVE_TO := Cardinal(_B_WINDOW_MOVE_TO);
B_WINDOW_MOVE_BY := Cardinal(_B_WINDOW_MOVE_BY);
B_SILENT_RELAUNCH := Cardinal(_B_SILENT_RELAUNCH);
B_OBSERVER_NOTICE_CHANGE := Cardinal(_B_OBSERVER_NOTICE_CHANGE);
B_CONTROL_INVOKED := Cardinal(_B_CONTROL_INVOKED);
B_CONTROL_MODIFIED := Cardinal(_B_CONTROL_MODIFIED);
end.

View File

@@ -0,0 +1,166 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit Application;
interface
uses
beobj, looper, appdefs, supportdefs, message, os;
type
TApplication = class(TLooper)
private
public
constructor Create; override;
constructor Create(Signature : PChar); virtual;
constructor Create(Signature : PChar; error : PStatus_t); virtual;
destructor Destroy; override;
procedure ShowCursor;
procedure HideCursor;
function Run : TThread_id;
procedure Quit;
// Hook functions
procedure AppActivated(Active : boolean); virtual;
procedure ReadyToRun; virtual;
end;
function BApplication_Create(AObject : TObject) : TCPlusObject; cdecl; external BePascalLibName name 'BApplication_Create_1';
function BApplication_Create(AObject : TObject; Signature : PChar) : TCPlusObject; cdecl; external BePascalLibName name 'BApplication_Create_2';
function BApplication_Create(AObject : TObject; Signature : PChar; error : PStatus_t) : TCPlusObject; cdecl; external BePascalLibName name 'BApplication_Create_3';
procedure BApplication_Free(Application : TCPlusObject); cdecl; external BePascalLibName;
procedure BApplication_HideCursor(Application : TCPlusObject); cdecl; external BePascalLibName;
procedure BApplication_ShowCursor(Application : TCPlusObject); cdecl; external BePascalLibName;
function BApplication_Run(Application : TCPlusObject) : TThread_id; cdecl; external BePascalLibName;
procedure BApplication_Quit(Application : TCPlusObject); cdecl; external BePascalLibName;
var
be_app : TApplication;
implementation
var
Application_AppActivated_hook : Pointer; cvar; external;
Application_ReadyToRun_hook : Pointer; cvar; external;
// start TApplication
constructor TApplication.Create;
begin
inherited;
CPlusObject := BApplication_Create(Self, PChar('application/x-vnd.BePascal'));
be_app := Self;
end;
constructor TApplication.Create(Signature : PChar);
begin
inherited Create;
CPlusObject := BApplication_Create(Self, Signature);
be_app := Self;
end;
constructor TApplication.Create(Signature : PChar; error : PStatus_t);
begin
inherited Create;
CPlusObject := BApplication_Create(Self, Signature, error);
be_app := Self;
end;
destructor TApplication.Destroy;
begin
if CPlusObject <> nil then
BApplication_Free(CPlusObject);
inherited;
end;
// Hook functions
procedure Application_AppActivated_hook_func(Application : TApplication; Active : boolean); cdecl;
begin
if Application <> nil then
Application.AppActivated(Active);
end;
procedure TApplication.AppActivated(Active : boolean);
begin
WriteLn(Active);
if Active then
WriteLn('Application activée !')
else
WriteLn('Application désactivée !');
end;
procedure Application_ReadyToRun_hook_func(Application : TApplication); cdecl;
begin
WriteLn('Hook ReadyToRun !');
if Application <> nil then
Application.ReadyToRun;
end;
procedure Application_MessageReceived_hook_func(Application : TApplication; aMessage : TCPlusObject);
var
Message : TMessage;
begin
WriteLn('Hook MessageReceived !');
Message := TMessage.Wrap(aMessage);
try
if Application <> nil then
Application.MessageReceived(Message);
finally
Message.UnWrap;
end;
end;
procedure TApplication.ReadyToRun;
begin
WriteLn('Prêt à démarer !');
end;
procedure TApplication.ShowCursor;
begin
BApplication_ShowCursor(CPlusObject);
end;
procedure TApplication.HideCursor;
begin
BApplication_HideCursor(CPlusObject);
end;
function TApplication.Run : TThread_id;
begin
Result := BApplication_Run(CPlusObject);
end;
procedure TApplication.Quit;
begin
BApplication_Quit(CPlusObject);
end;
// end TApplication
initialization
WriteLn('Initialisation');
be_app := nil;
Application_AppActivated_hook := @Application_AppActivated_hook_func;
Application_ReadyToRun_hook := @Application_ReadyToRun_hook_func;
finalization
Application_AppActivated_hook := nil;
Application_ReadyToRun_hook := nil;
be_app := nil;
end.

View File

@@ -0,0 +1,72 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit handler;
interface
uses
beobj, archivable, message;
type
THandler = class(TArchivable)
public
procedure MessageReceived(aMessage : TMessage); virtual;
end;
implementation
uses
SysUtils;
var
Handler_MessageReceived_hook : Pointer; cvar; external;
procedure THandler.MessageReceived(aMessage : TMessage);
begin
WriteLn('Message reçue');
end;
procedure Handler_MessageReceived_hook_func(Handler : THandler; aMessage : TCPlusObject);
var
Message : TMessage;
begin
try
WriteLn('Hook MessageReceived !');
Message := TMessage.Wrap(aMessage);
try
if Handler <> nil then
Handler.MessageReceived(Message);
finally
Message.UnWrap;
end;
except
on e : exception do
begin
WriteLn(e.Message + 'Handler_MessageReceived');
end;
end
end;
initialization
Handler_MessageReceived_hook := @Handler_MessageReceived_hook_func;
finalization
Handler_MessageReceived_hook := nil;
end.

View File

@@ -0,0 +1,107 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit looper;
interface
uses
beobj, handler, message, os, SupportDefs;
const
B_LOOPER_PORT_DEFAULT_CAPACITY = 100;
type
TLooper = class(THandler)
private
public
procedure DispatchMessage(aMessage : TMessage; aTarget : THandler); virtual;
function QuitRequested() : boolean; virtual;
function GetSupportedSuites(aMessage : TMessage) : TStatus_t;
function PostMessage(command : Cardinal) : TStatus_t;
end;
//function BLooper_Create(AObject : TObject);
function BLooper_GetSupportedSuites(Looper : TCplusObject; aMessage : TCPlusObject) : TStatus_t; cdecl; external BePascalLibName name 'BLooper_GetSupportedSuites';
function BLooper_PostMessage(Looper : TCPlusObject; command : Cardinal) : TStatus_t; cdecl; external BePascalLibName name 'BLooper_PostMessage_2';
implementation
var
Looper_DispatchMessage_hook : Pointer; cvar; external;
Looper_QuitRequested_hook : Pointer; cvar; external;
procedure TLooper.DispatchMessage(aMessage : TMessage; aTarget : THandler);
begin
WriteLn('Looper.DispatchMessage');
end;
function TLooper.QuitRequested() : boolean;
begin
WriteLn('Looper.QuitRequested');
Result := True;
end;
function TLooper.GetSupportedSuites(aMessage : TMessage) : TStatus_t;
begin
result := BLooper_GetSupportedSuites(CPlusObject, aMessage.CPlusObject);
end;
function TLooper.PostMessage(command : Cardinal) : TStatus_t;
begin
result := BLooper_PostMessage(CPlusObject, command);
end;
// hooks
procedure Looper_DispatchMessage_hook_func(Looper : TLooper;
aMessage : TCPlusObject; aTarget : TCPlusObject);
var
Message : TMessage;
Target : THandler;
begin
WriteLn('Hook DispatchMessage !');
Message := TMessage.Wrap(aMessage);
try
Target := THandler.Wrap(aTarget);
try
Looper.DispatchMessage(Message, Target);
finally
Target.UnWrap;
end;
finally
Message.UnWrap;
end;
end;
function Looper_QuitRequested_hook_func(Looper : TLooper) : boolean;
begin
WriteLn('Hook QuitRequested !');
if Looper <> nil then
Result := Looper.QuitRequested();
end;
initialization
Looper_DispatchMessage_hook := @Looper_DispatchMessage_hook_func;
Looper_QuitRequested_hook := @Looper_QuitRequested_hook_func;
finalization
Looper_DispatchMessage_hook := nil;
Looper_QuitRequested_hook := nil;
end.

View File

@@ -0,0 +1,267 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit message;
interface
uses
beobj, supportdefs, typeconstants;
const
B_NO_SPECIFIER = 0;
B_DIRECT_SPECIFIER = 1;
B_INDEX_SPECIFIER = 2;
B_REVERSE_INDEX_SPECIFIER = 3;
B_RANGE_SPECIFIER = 4;
B_REVERSE_RANGE_SPECIFIER = 5;
B_NAME_SPECIFIER = 6;
B_ID_SPECIFIER = 7;
B_SPECIFIERS_END = 128;
B_FIELD_NAME_LENGTH = 255;
B_PROPERTY_NAME_LENGTH = 255;
type
TMessage = class(TBeObject)
private
function GetWhat : Cardinal;
procedure SetWhat(aWhat : Cardinal);
public
constructor Create; override;
constructor Create(Command : Cardinal); virtual;
constructor Create(var Message : TMessage); virtual;
destructor Destroy; override;
function AddData(const Name : PChar; aType : TType_Code; const Data : Pointer; FixedSize : Cardinal; NumItems : Integer) : TStatus_t;
function AddBool(const Name : PChar; aBool : boolean) : TStatus_t;
function AddInt8(const Name : PChar; anInt8 : Shortint) : TStatus_t;
function AddInt16(const Name : PChar; anInt16 : Smallint) : TStatus_t;
function AddInt32(const Name : PChar; anInt32 : Integer) : TStatus_t;
function AddInt64(const Name : PChar; anInt64 : int64) : TStatus_t;
function AddFloat(const Name : PChar; aFloat : Single) : TStatus_t;
function AddDouble(const Name : PChar; aDouble : Double) : TStatus_t;
function AddString(const Name : PChar; aString : PChar) : TStatus_t;
function AddMessage(const Name : PChar; aMessage : TCPlusObject) : TStatus_t;
function CountNames(aType : TType_Code) : Integer;
function HasSpecifiers : boolean;
function IsSystem : boolean;
function MakeEmpty : TStatus_t;
function IsEmpty : boolean;
function RemoveName(const Name : PChar) : TStatus_t;
procedure PrintToStream;
function RemoveData(const name : PChar; index : Integer) : TStatus_t;
function WasDelivered : boolean;
function IsSourceRemote : boolean;
function IsSourceWaiting : boolean;
function IsReply : boolean;
function Previous : TMessage;
function WasDropped : boolean;
property What : Cardinal read GetWhat write SetWhat;
end;
function BMessage_Create(AObject : TObject) : TCPlusObject; cdecl; external BePascalLibName name 'BMessage_Create_1';
function BMessage_Create(AObject : TObject; command : Cardinal) : TCPlusObject; cdecl; external BePascalLibName name 'BMessage_Create_2';
function BMessage_Create(AObject : TObject; var Message : TCPlusObject) : TCPlusObject; cdecl; external BePascalLibName name 'BMessage_Create_3';
procedure BMessage_Free(Message : TCPlusObject); cdecl; external BePascalLibName;
function BMessage_GetWhat(Message : TCPlusObject) : Cardinal; cdecl; external BePascalLibName name 'BMessage_Getwhat';
procedure BMessage_SetWhat(Message : TCPlusObject; What : Cardinal); cdecl; external BePascalLibName name 'BMessage_Setwhat';
function BMessage_AddData(Message : TCPlusObject; const Name : PChar; aType : TType_Code; const Data : Pointer; FixedSize : Cardinal; NumItems : Integer) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddBool(Message : TCPlusObject; const Name : PChar; aBool : boolean) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddInt8(Message : TCPlusObject; const Name : PChar; anInt8 : Shortint) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddInt16(Message : TCPlusObject; const Name : PChar; anInt16 : Smallint) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddInt32(Message : TCPlusObject; const Name : PChar; anInt32 : Integer) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddInt64(Message : TCPlusObject; const Name : PChar; anInt64 : int64) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddFloat(Message : TCPlusObject; const Name : PChar; aFloat : Single) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddDouble(Message : TCPlusObject; const Name : PChar; aDouble : Double) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddString(Message : TCPlusObject; const Name : PChar; aString : PChar) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_AddMessage(Message : TCPlusObject; const Name : PChar; aMessage : TCPlusObject) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_CountNames(Message : TCPlusObject; aType : TType_Code) : Integer; cdecl; external BePascalLibName;
function BMessage_HasSpecifiers(Message : TCPlusObject) : boolean; cdecl; external BePascalLibName;
function BMessage_IsSystem(Message : TCPlusObject) : boolean; cdecl; external BePascalLibName;
function BMessage_MakeEmpty(Message : TCPlusObject) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_IsEmpty(Message : TCPlusObject) : boolean; cdecl; external BePascalLibName;
function BMessage_RemoveName(Message : TCPlusObject; const Name : PChar) : TStatus_t; cdecl; external BePascalLibName;
procedure BMessage_PrintToStream(Message : TCPlusObject); cdecl; external BePascalLibName;
function BMessage_RemoveData(Message : TCPlusObject; const name : PChar; index : Integer) : TStatus_t; cdecl; external BePascalLibName;
function BMessage_WasDelivered(Message : TCPlusObject) : boolean; cdecl; external BePascalLibName;
function BMessage_IsSourceRemote(Message : TCPlusObject) : boolean; cdecl; external BePascalLibName;
function BMessage_IsSourceWaiting(Message : TCPlusObject) : boolean; cdecl; external BePascalLibName;
function BMessage_IsReply(Message : TCPlusObject) : boolean; cdecl; external BePascalLibName;
function BMessage_Previous(Message : TCPlusObject) : TCPlusObject; cdecl; external BePascalLibName;
function BMessage_WasDropped(Message : TCPlusObject) : boolean; cdecl; external BePascalLibName;
implementation
// start TMessage
constructor TMessage.Create;
begin
inherited Create;
CPlusObject := BMessage_Create(Self);
end;
constructor TMessage.Create(Command : Cardinal);
begin
inherited Create;
CPlusObject := BMessage_Create(Self, Command);
end;
constructor TMessage.Create(var Message : TMessage);
begin
inherited Create;
CPlusObject := BMessage_Create(Self, Message.FCPlusObject);
end;
destructor TMessage.Destroy;
begin
if CPlusObject <> nil then
BMessage_Free(CPlusObject);
inherited;
end;
function TMessage.GetWhat : Cardinal;
begin
Result := BMessage_GetWhat(CPlusObject);
end;
procedure TMessage.SetWhat(aWhat : Cardinal);
begin
BMessage_SetWhat(CPlusObject, aWhat);
end;
function TMessage.AddData(const Name : PChar; aType : TType_Code; const Data : Pointer; FixedSize : Cardinal; NumItems : Integer) : TStatus_t;
begin
result := BMessage_AddData(CPlusObject, Name, aType, Data, FixedSize, NumItems);
end;
function TMessage.AddBool(const Name : PChar; aBool : boolean) : TStatus_t;
begin
result := BMessage_AddBool(CPlusObject, Name, aBool);
end;
function TMessage.AddInt8(const Name : PChar; anInt8 : Shortint) : TStatus_t;
begin
result := BMessage_AddInt8(CPlusObject, Name, anInt8);
end;
function TMessage.AddInt16(const Name : PChar; anInt16 : Smallint) : TStatus_t;
begin
result := BMessage_AddInt16(CPlusObject, Name, anInt16);
end;
function TMessage.AddInt32(const Name : PChar; anInt32 : Integer) : TStatus_t;
begin
result := BMessage_AddInt32(CPlusObject, Name, anInt32);
end;
function TMessage.AddInt64(const Name : PChar; anInt64 : int64) : TStatus_t;
begin
result := BMessage_AddInt64(CPlusObject, Name, anInt64);
end;
function TMessage.AddFloat(const Name : PChar; aFloat : Single) : TStatus_t;
begin
result := BMessage_AddFloat(CPlusObject, Name, aFloat);
end;
function TMessage.AddDouble(const Name : PChar; aDouble : Double) : TStatus_t;
begin
result := BMessage_AddDouble(CPlusObject, Name, aDouble);
end;
function TMessage.AddString(const Name : PChar; aString : PChar) : TStatus_t;
begin
result := BMessage_AddString(CPlusObject, Name, aString);
end;
function TMessage.AddMessage(const Name : PChar; aMessage : TCPlusObject) : TStatus_t;
begin
result := BMessage_AddMessage(CPlusObject, Name, aMessage);
end;
function TMessage.CountNames(aType : TType_Code) : Integer;
begin
result := BMessage_CountNames(CPlusObject, aType);
end;
function TMessage.HasSpecifiers : boolean;
begin
result := BMessage_HasSpecifiers(CPlusObject);
end;
function TMessage.IsSystem : boolean;
begin
result := BMessage_IsSystem(CPlusObject);
end;
function TMessage.MakeEmpty : TStatus_t;
begin
result := BMessage_MakeEmpty(CPlusObject);
end;
function TMessage.IsEmpty : boolean;
begin
result := BMessage_IsEmpty(CPlusObject);
end;
function TMessage.RemoveName(const Name : PChar) : TStatus_t;
begin
result := BMessage_RemoveName(CPlusObject, Name);
end;
procedure TMessage.PrintToStream;
begin
BMessage_PrintToStream(CPlusObject);
end;
function TMessage.RemoveData(const name : PChar; index : Integer) : TStatus_t;
begin
result := BMessage_RemoveData(CPlusObject, name, index);
end;
function TMessage.WasDelivered : boolean;
begin
result := BMessage_WasDelivered(CPlusObject);
end;
function TMessage.IsSourceRemote : boolean;
begin
result := BMessage_IsSourceRemote(CPlusObject);
end;
function TMessage.IsSourceWaiting : boolean;
begin
result := BMessage_IsSourceWaiting(CPlusObject);
end;
function TMessage.IsReply : boolean;
begin
result := BMessage_IsReply(CPlusObject);
end;
function TMessage.Previous : TMessage;
begin
result := TMessage.Wrap(BMessage_Previous(CPlusObject));
end;
function TMessage.WasDropped : boolean;
begin
result := BMessage_WasDropped(CPlusObject);
end;
end.

View File

@@ -0,0 +1,70 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit Roster;
interface
uses
beobj, appdefs, supportdefs,
message;
type
TRoster = class(TBeObject)
private
public
constructor Create; override;
destructor Destroy; override;
function Broadcast(aMessage : TMessage) : TStatus_t;
end;
function Get_be_roster : TCPlusObject; cdecl; external BePascalLibName;
function BRoster_Create(AObject : TObject) : TCPlusObject; cdecl; external BePascalLibName;
procedure BRoster_Destroy(CPlusObject : TCPlusObject); cdecl; external BePascalLibName;
function BRoster_Broadcast(aRoster : TCPlusObject; aMessage : TCPlusObject) : TStatus_t; cdecl; external BePascalLibName;
var
be_roster : TRoster;
implementation
constructor TRoster.Create;
begin
inherited;
CPlusObject := BRoster_Create(Self);
be_roster := Self;
end;
destructor TRoster.Destroy;
begin
BRoster_Destroy(CPlusObject);
inherited;
end;
function TRoster.Broadcast(aMessage : TMessage) : TStatus_t;
begin
result := BRoster_Broadcast(Self.CPlusObject, aMessage.CPlusObject);
end;
initialization
be_roster := TRoster.Wrap(Get_be_roster);
finalization
be_roster.UnWrap;
be_roster := nil;
end.

View File

@@ -0,0 +1,65 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _BEOBJ_CPP_
#define _BEOBJ_CPP_
typedef void* TPasObject;
typedef void* TCPlusObject;
typedef char *(*BPasObject_GetPasClassName_hook)(TPasObject PasObject);
#if defined(__cplusplus)
extern "C" {
#endif
BPasObject_GetPasClassName_hook PasObject_GetPasClassName_hook;
#if defined(__cplusplus)
}
#endif
class BPasObject
{
public:
BPasObject(TPasObject PasObject);
TPasObject GetPasObject(void) const;
virtual ~BPasObject(void);
char *GetPasClassName(void);
private:
TPasObject FPasObject;
};
BPasObject::BPasObject(TPasObject PasObject)
{
FPasObject = PasObject;
}
TPasObject BPasObject::GetPasObject(void) const
{
return FPasObject;
}
BPasObject::~BPasObject(){}
char *BPasObject::GetPasClassName(void)
{
return PasObject_GetPasClassName_hook(FPasObject);
}
#endif /* _BEOBJ_CPP_ */

View File

@@ -0,0 +1,112 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
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;
interface
{$M+}
// FreePascal use ld on BeOS (like on LINUX) to link to libraries.
// ld use the environment variable BELIBRARIES to find libraries.
const
BePascalLibName = 'bepascal';
type
// BePascal types
TCPlusObject = Pointer;
TBeObject = class(TObject)
private
procedure Debug;
protected
FCPlusObject : TCPlusObject;
public
constructor Create; virtual;
constructor Wrap(ACPlusObject : TCPlusObject); virtual;
destructor UnWrap; virtual;
property CPlusObject : TCPlusObject read FCPlusObject write FCPlusObject;
end;
implementation
uses
SysUtils;
var
PasObject_GetPasClassName_hook : Pointer; cvar; external;
function PasObject_GetPasClassName_hook_func(PasObject : TBeObject) : PChar;
begin
if PasObject <> nil then
Result := StrPCopy(Result, PasObject.ClassName)
else
Result := '';
end;
// Not really a useful function. Un jour peut être...
function BPasObject_GetPasObject(ACPlusObject : TCPlusObject) : TObject; cdecl; external BePascalLibName name 'BPasObject_GetPasObject';
// start TBeObject
constructor TBeObject.Create;
begin
inherited;
Debug;
end;
// Constructeur utilisé pour créer une instance Pascal à partir d'un objet C++.
// Nécessaire notamment pour encapsuler les objets C++ passé en paramètre des
// fonctions de hook.
constructor TBeObject.Wrap(ACPlusObject : TCPlusObject);
begin
Self.CPlusObject := ACPlusObject;
Debug;
end;
procedure TBeObject.Debug;
var
size : cardinal;
begin
size := 0;
size := SizeOf(Self.ClassType);
WriteLn('Instance de ' + Self.ClassName + '(' + HexStr(longint(pointer(Self)), 8) + ')' +
'(' + IntToStr(size) + ')' +
' ');
end;
// Destructeur utilisé pour libérer l'objet pascal sans
// détruire l'objet C++ correspondant. Utile pour
// libérer la mémoire coté pascal dans le cas d'objets
// C++ qui ne sont pas propriété de l'application
// (cas des messages passés aux fonctions de rappel)
destructor TBeObject.UnWrap;
begin
WriteLn('UnWrap');
// On passe CPlusObject à nil pour éviter de libérer
// l'objet C++ lors de l'appel de free
Self.CPlusObject := nil;
end;
// end TBeObject
initialization
PasObject_GetPasClassName_hook := @PasObject_GetPasClassName_hook_func;
finalization
PasObject_GetPasClassName_hook := nil;
end.

View File

@@ -0,0 +1,90 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _POINT_CPP
#define _POINT_CPP
#include <Point.h>
#include <beobj.cpp>
class BPPoint : public BPoint, public BPasObject
{
public:
BPPoint(TPasObject PasObject, float x, float y);
BPPoint(TPasObject PasObject, const BPoint& point);
BPPoint(TPasObject PasObject);
};
BPPoint::BPPoint(TPasObject PasObject, float x, float y) : BPoint(x, y), BPasObject(PasObject)
{
}
BPPoint::BPPoint(TPasObject PasObject, const BPoint& point) : BPoint(point), BPasObject(PasObject)
{
}
BPPoint::BPPoint(TPasObject PasObject) : BPoint(), BPasObject(PasObject)
{
}
#if defined(__cplusplus)
extern "C" {
#endif
TCPlusObject BPoint_Create_1(TPasObject PasObject, float x, float y)
{
return new BPPoint(PasObject, x, y);
}
TCPlusObject BPoint_Create_2(TPasObject PasObject, const BPoint& point)
{
return new BPPoint(PasObject, point);
}
TCPlusObject BPoint_Create_3(TPasObject PasObject)
{
return new BPPoint(PasObject);
}
void BPoint_Free(TCPlusObject Point)
{
delete Point;
}
void BPoint_ConstrainTo(TCPlusObject Point, BRect rect)
{
reinterpret_cast<BPoint*>(Point)->ConstrainTo(rect);
}
void BPoint_PrintToStream(TCPlusObject Point)
{
reinterpret_cast<BPoint*>(Point)->PrintToStream();
}
void BPoint_Set(TCPlusObject Point, float x, float y)
{
reinterpret_cast<BPoint*>(Point)->Set(x, y);
}
#if defined(__cplusplus)
}
#endif
#endif _POINT_CPP /* _POINT_CPP */

View File

@@ -0,0 +1,92 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _RECT_CPP
#define _RECT_CPP
#include <Point.h>
#include <Rect.h>
#include <beobj.cpp>
class BPRect : public BRect, public BPasObject
{
public:
BPRect(TPasObject PasObject);
BPRect(TPasObject PasObject, const BRect & rect);
BPRect(TPasObject PasObject, float l, float t, float r, float b);
BPRect(TPasObject PasObject, BPoint leftTop, BPoint rightBottom);
};
BPRect::BPRect(TPasObject PasObject) : BRect(), BPasObject(PasObject)
{
}
BPRect::BPRect(TPasObject PasObject, const BRect & rect) : BRect(rect), BPasObject(PasObject)
{
}
BPRect::BPRect(TPasObject PasObject, float l, float t, float r, float b) : BRect(l, t, r, b), BPasObject(PasObject)
{
}
BPRect::BPRect(TPasObject PasObject, BPoint leftTop, BPoint rightBottom) : BRect(leftTop, rightBottom), BPasObject(PasObject)
{
}
#if defined(__cplusplus)
extern "C" {
#endif
TCPlusObject BRect_Create_1(TPasObject PasObject)
{
return new BPRect(PasObject);
}
TCPlusObject BRect_Create_2(TPasObject PasObject, const BRect& rect)
{
return new BPRect(PasObject, rect);
}
TCPlusObject BRect_Create_3(TPasObject PasObject, float l, float t, float r, float b)
{
return new BPRect(PasObject, l, t, r, b);
}
TCPlusObject BRect_Create_4(TPasObject PasObject, BPoint leftTop, BPoint rightBottom)
{
return new BPRect(PasObject, leftTop, rightBottom);
}
void BRect_Free(TCPlusObject rect)
{
delete rect;
}
void BRect_PrintToStream(TCPlusObject rect)
{
reinterpret_cast<BRect*>(rect)->PrintToStream();
}
#if defined(__cplusplus)
}
#endif
#endif _RECT_CPP /* _RECT_CPP */

View File

@@ -0,0 +1,98 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _WINDOW_CPP_
#define _WINDOW_CPP_
#include <Window.h>
#include <OS.h>
#include <beobj.cpp>
// definition of callback function in BWindow
#if defined(__cplusplus)
extern "C" {
#endif
#if defined(__cplusplus)
}
#endif
class BPWindow : public BWindow, public BPLooper
{
public:
BPWindow(TPasObject PasObject,
BRect frame,
const char *title,
window_type type,
uint32 flags,
uint32 workspaces = B_CURRENT_WORKSPACE);
// virtual void DispatchMessage(BMessage *message, BHandler *target);
// virtual bool QuitRequested(void);
private:
};
BPWindow::BPWindow(TPasObject PasObject,
BRect frame,
const char *title,
window_type type,
uint32 flags,
uint32 workspaces = B_CURRENT_WORKSPACE)
: BWindow(frame, title, type, flags, workspaces),
BPLooper(PasObject)
{
}
#if defined(__cplusplus)
extern "C" {
#endif
TCPlusObject BWindow_Create_1(TPasObject PasObject,
BRect frame,
const char *title,
window_type type,
uint32 flags,
uint32 workspaces)
{
return new BPWindow(PasObject, frame, title, type, flags, workspaces);
}
void BWindow_Free(TCPlusObject Window)
{
delete Window;
}
void BWindow_Show(TCPlusObject Window)
{
reinterpret_cast<BWindow*>(Window)->Show();
}
void BWindow_Hide(TCPlusObject Window)
{
reinterpret_cast<BWindow*>(Window)->Hide();
}
#if defined(__cplusplus)
}
#endif
#endif /* _WINDOW_CPP_ */

View File

@@ -0,0 +1,72 @@
unit Point;
interface
uses
beobj, rect;
type
// TRect = class;
TPoint = class(TBeObject)
public
constructor Create(x, y : single); virtual;
constructor Create(point : TPoint); virtual;
constructor Create; override;
destructor Destroy; override;
procedure ConstrainTo(Rect : TRect);
procedure PrintToStream;
procedure Sept(x, y : single);
end;
function BPoint_Create(AObject : TBeObject; x, y : single) : TCPlusObject; cdecl; external BePascalLibName name 'BPoint_Create_1';
function BPoint_Create(AObject : TBeObject; point : TCPlusObject) : TCPlusObject; cdecl; external BePascalLibName name 'BPoint_Create_2';
function BPoint_Create(AObject : TBeObject) : TCPlusObject; cdecl; external BePascalLibName name 'BPoint_Create_3';
procedure BPoint_Free(Point : TCPlusObject); cdecl; external BePascalLibName name 'BPoint_Free';
procedure BPoint_ConstrainTo(Point : TCPlusObject; Rect : TCPlusObject); cdecl; external BePascalLibName name 'BPoint_ConstrainTo';
procedure BPoint_PrintToStream(Point : TCPlusObject); cdecl; external bePascalLibName name 'BPoint_PrintToStream';
procedure BPoint_Set(Point : TCPlusObject; x, y : single); cdecl; external BePascalLibName name 'BPoint_Set';
implementation
constructor TPoint.Create(x, y : single);
begin
inherited Create;
CPlusObject := BPoint_Create(Self, x, y);
end;
constructor TPoint.Create(point : TPoint);
begin
inherited Create;
CPlusObject := BPoint_Create(Self, point.CPlusObject)
end;
constructor TPoint.Create;
begin
inherited Create;
CPlusObject := BPoint_Create(Self);
end;
destructor TPoint.Destroy;
begin
BPoint_Free(CPlusObject);
inherited;
end;
procedure TPoint.ConstrainTo(Rect : TRect);
begin
BPoint_ConstrainTo(CPlusObject, Rect.CPlusObject);
end;
procedure TPoint.PrintToStream;
begin
BPoint_PrintToStream(CPlusObject);
end;
procedure TPoint.Sept(x, y : single);
begin
BPoint_Set(CPlusObject, x, y);
end;
initialization
end.

View File

@@ -0,0 +1,144 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit rect;
interface
uses
beobj;
type
// TPoint and TRect are defined in the same unit to avoid circular reference
TPoint = class;
TRect = class(TBeObject)
public
constructor Create; override;
constructor Create(rect : TRect); virtual; // Problème de référence circulaire avec TPoint
constructor Create(l, t, r, b : single); virtual;
constructor Create(leftTop, rightBottom : TPoint); virtual;
destructor Destroy; override;
procedure PrintToStream;
end;
function BRect_Create(AObject : TBeObject) : TCPlusObject; cdecl; external BePascalLibName name 'BRect_Create_1';
function BRect_Create(AObject : TBeObject; rect : TCPlusObject) : TCPlusObject; cdecl; external BePascalLibName name 'BRect_Create_2';
function BRect_Create(AObject : TBeObject; l, t, r, b : single) : TCPlusObject; cdecl; external BePascalLibName name 'BRect_Create_3';
function BRect_Create(AObject : TBeObject; leftTop, rightBottom : TCPlusObject) : TCPlusObject; cdecl; external BePascalLibName name 'BRect_Create_4';
procedure BRect_Free(rect : TCPlusObject); cdecl; external BePascalLibName name 'BRect_Free';
procedure BRect_PrintToStream(Rect : TCPlusObject); cdecl; external bePascalLibName name 'BRect_PrintToStream';
type
TPoint = class(TBeObject)
public
constructor Create; override;
constructor Create(x, y : single); virtual;
constructor Create(point : TPoint); virtual;
destructor Destroy; override;
procedure ConstrainTo(Rect : TRect);
procedure PrintToStream;
procedure Sept(x, y : single);
end;
function BPoint_Create(AObject : TBeObject; x, y : single) : TCPlusObject; cdecl; external BePascalLibName name 'BPoint_Create_1';
function BPoint_Create(AObject : TBeObject; point : TCPlusObject) : TCPlusObject; cdecl; external BePascalLibName name 'BPoint_Create_2';
function BPoint_Create(AObject : TBeObject) : TCPlusObject; cdecl; external BePascalLibName name 'BPoint_Create_3';
procedure BPoint_Free(Point : TCPlusObject); cdecl; external BePascalLibName name 'BPoint_Free';
procedure BPoint_ConstrainTo(Point : TCPlusObject; Rect : TCPlusObject); cdecl; external BePascalLibName name 'BPoint_ConstrainTo';
procedure BPoint_PrintToStream(Point : TCPlusObject); cdecl; external bePascalLibName name 'BPoint_PrintToStream';
procedure BPoint_Set(Point : TCPlusObject; x, y : single); cdecl; external BePascalLibName name 'BPoint_Set';
implementation
constructor TRect.Create;
begin
inherited Create;
CPlusObject := BRect_Create(Self);
end;
constructor TRect.Create(rect : TRect);
begin
inherited Create;
CPlusObject := BRect_Create(Self, rect.CPlusObject);
end;
constructor TRect.Create(l, t, r, b : single);
begin
inherited Create;
CPlusObject := BRect_Create(Self, l, t, r, b);
end;
constructor TRect.Create(leftTop, rightBottom : TPoint);
begin
inherited Create;
CPlusObject := BRect_Create(Self, leftTop.CPlusObject, rightBottom.CPlusObject);
end;
destructor TRect.Destroy;
begin
BRect_Free(CPlusObject);
inherited Destroy;
end;
procedure TRect.PrintToStream;
begin
BRect_PrintToStream(CPlusObject);
end;
constructor TPoint.Create(x, y : single);
begin
inherited Create;
CPlusObject := BPoint_Create(Self, x, y);
end;
constructor TPoint.Create(point : TPoint);
begin
inherited Create;
CPlusObject := BPoint_Create(Self, point.CPlusObject)
end;
constructor TPoint.Create;
begin
inherited Create;
CPlusObject := BPoint_Create(Self);
end;
destructor TPoint.Destroy;
begin
BPoint_Free(CPlusObject);
inherited;
end;
procedure TPoint.ConstrainTo(Rect : TRect);
begin
BPoint_ConstrainTo(CPlusObject, Rect.CPlusObject);
end;
procedure TPoint.PrintToStream;
begin
BPoint_PrintToStream(CPlusObject);
end;
procedure TPoint.Sept(x, y : single);
begin
BPoint_Set(CPlusObject, x, y);
end;
initialization
end.

View File

@@ -0,0 +1,120 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit Window;
interface
uses
beobj, looper, rect, os, application, appdefs;
const
// window_type
B_UNTYPED_WINDOW = 0;
B_TITLED_WINDOW = 1;
B_MODAL_WINDOW = 3;
B_DOCUMENT_WINDOW = 11;
B_BORDERED_WINDOW = 20;
B_FLOATING_WINDOW = 21;
// window_look
B_BORDERED_WINDOW_LOOK = 20;
B_NO_BORDER_WINDOW_LOOK = 19;
B_TITLED_WINDOW_LOOK = 1;
B_DOCUMENT_WINDOW_LOOK = 11;
B_MODAL_WINDOW_LOOK = 3;
B_FLOATING_WINDOW_LOOK = 7;
// window_feel
B_NORMAL_WINDOW_FEEL = 0;
B_MODAL_SUBSET_WINDOW_FEEL = 2;
B_MODAL_APP_WINDOW_FEEL = 1;
B_MODAL_ALL_WINDOW_FEEL = 3;
B_FLOATING_SUBSET_WINDOW_FEEL = 5;
B_FLOATING_APP_WINDOW_FEEL = 4;
B_FLOATING_ALL_WINDOW_FEEL = 6;
// flags
B_NOT_MOVABLE = $00000001;
B_NOT_CLOSABLE = $00000020;
B_NOT_ZOOMABLE = $00000040;
B_NOT_MINIMIZABLE = $00004000;
B_NOT_RESIZABLE = $00000002;
B_NOT_H_RESIZABLE = $00000004;
B_NOT_V_RESIZABLE = $00000008;
B_AVOID_FRONT = $00000080;
B_AVOID_FOCUS = $00002000;
B_WILL_ACCEPT_FIRST_CLICK = $00000010;
B_OUTLINE_RESIZE = $00001000;
B_NO_WORKSPACE_ACTIVATION = $00000100;
B_NOT_ANCHORED_ON_ACTIVATE = $00020000;
B_ASYNCHRONOUS_CONTROLS = $00080000;
B_QUIT_ON_WINDOW_CLOSE = $00100000;
B_CURRENT_WORKSPACE = 0;
B_ALL_WORKSPACES = $ffffffff;
type
TWindow = class(TLooper)
public
constructor Create(frame : TRect; title : PChar; atype, flags, workspaces : Cardinal);
destructor Destroy; override;
procedure Show;
procedure Hide;
function QuitRequested : boolean; override;
end;
function BWindow_Create(AObject : TObject; frame : TCPlusObject; title : PChar;
atype, flags, workspaces : cardinal) : TCplusObject; cdecl; external BePascalLibName name 'BWindow_Create_1';
procedure BWindow_Free(CPlusObject : TCPlusObject); cdecl; external BePascalLibName name 'BWindow_Free';
procedure BWindow_Show(CPlusObject : TCPlusObject); cdecl; external BePascalLibName name 'BWindow_Show';
procedure BWindow_Hide(CPlusObject : TCPlusObject); cdecl; external BePascalLibName name 'BWindow_Hide';
implementation
function TWindow.QuitRequested : boolean;
begin
Result := inherited;
be_app.PostMessage(B_QUIT_REQUESTED);
end;
constructor TWindow.Create(frame : TRect; title : PChar; atype, flags, workspaces : Cardinal);
begin
inherited Create;
CPlusObject := BWindow_Create(Self, frame.CPlusObject, title, atype, flags, workspaces);
end;
destructor TWindow.Destroy;
begin
BWindow_Free(CPlusObject);
inherited;
end;
procedure TWindow.Show;
begin
BWindow_Show(Self.CPlusObject);
end;
procedure TWindow.Hide;
begin
BWindow_Hide(Self.CPlusObject);
end;
initialization
end.

View File

@@ -0,0 +1,38 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit os;
interface
const
B_LOW_LATENCY = 5;
B_LOW_PRIORITY = 5;
B_NORMAL_PRIORITY = 10;
B_DISPLAY_PRIORITY = 15;
B_URGENT_DISPLAY_PRIORITY = 20;
B_REAL_TIME_DISPLAY_PRIORITY = 100;
B_URGENT_PRIORITY = 110;
B_REAL_TIME_PRIORITY = 120;
type
TThread_id = Longint;
implementation
end.

View File

@@ -0,0 +1,128 @@
/* BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef _ARCHIVABLE_CPP_
#define _ARCHIVABLE_CPP_
#include <Archivable.h>
#include <Message.cpp>
#include <beobj.cpp>
typedef TCPlusObject (*BArchivable_Instantiate_hook) (BMessage *from);
typedef status_t (*BArchivable_Archive_hook)(TPasObject PasObject, BMessage *into, bool deep);
#if defined(__cplusplus)
extern "C" {
#endif
BArchivable_Instantiate_hook Archivable_Instantiate_hook;
BArchivable_Archive_hook Archivable_Archive_hook;
#if defined(__cplusplus)
}
#endif
class _EXPORT BPArchivable : public BArchivable, private BPasObject
{
public:
BPArchivable(TPasObject PasObject);
BPArchivable(TPasObject PasObject, BMessage *from);
~BPArchivable(void);
virtual status_t Archive(BMessage *into, bool deep = true) const;
virtual status_t ArchiveFromPascal(BMessage *into, bool deep = true);
static BArchivable *Instantiate(BMessage *from);
private:
};
BPArchivable::BPArchivable(TPasObject PasObject)
: BArchivable(), BPasObject(PasObject)
{
}
BPArchivable::BPArchivable(TPasObject PasObject, BMessage *from)
: BArchivable(from), BPasObject(PasObject)
{
}
BPArchivable::~BPArchivable(void)
{
}
status_t BPArchivable::Archive(BMessage *into, bool deep = true) const
{
if (GetPasObject() != NULL)
{
// Demande l'archivage de l'objet Pascal
return BArchivable::Archive(into, deep);
}
else
{
into->AddString("class", "BPArchivable");
return BArchivable::Archive(into, deep);
}
}
status_t BPArchivable::ArchiveFromPascal(BMessage *into, bool deep = true)
{
into->AddString("class", "BPArchivable");
return BArchivable::Archive(into, deep);
}
BArchivable *BPArchivable::Instantiate(BMessage *from)
{
// Appel à la fonction de création de l'objet pascal correspondant
// au contenu du message
// return new BPArchivable(<pascal_func>, from);
if (validate_instantiation(from, "BPArchivable"))
return reinterpret_cast<BPArchivable*>(Archivable_Instantiate_hook(from));
return NULL;
}
#if defined(__cplusplus)
extern "C" {
#endif
TCPlusObject BArchivable_Create_1(TPasObject PasObject)
{
return new BPArchivable(PasObject);
}
TCPlusObject BArchivable_Create_2(TPasObject PasObject, TCPlusObject from)
{
return new BPArchivable(PasObject, reinterpret_cast<BMessage*>(from));
}
status_t BArchivable_Archive(TCPlusObject archivable, TCPlusObject into, bool deep = true)
{
// On ajoute BPArchivable dans l'entrée class du message
// pour que l'API BeOS appelle BPArchivable pour instancier
// les objets pascal qui supportent BArchivable.
reinterpret_cast<BMessage*>(into)->AddString("class", "BPArchivable");
return reinterpret_cast<BPArchivable*>(archivable)->ArchiveFromPascal(reinterpret_cast<BMessage*>(into), deep);
}
#if defined(__cplusplus)
}
#endif
#endif /* _ARCHIVABLE_CPP_ */

View File

@@ -0,0 +1,32 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit _beep;
interface
uses
supportdefs;
// beep is a simple function. We can link to libbe.so.
// beep__Fv is the mangled name of the function in libbe.so.
function beep : TStatus_t; cdecl; external 'be' name 'beep__Fv';
implementation
end.

View File

@@ -0,0 +1,55 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit Archivable;
interface
uses
beobj, message, supportdefs;
type
TArchivable = class(TBeObject)
private
public
end;
function BArchivable_Create(AObject : TObject) : TCPlusObject; cdecl; external BePascalLibName name 'BApplication_Create_1';
function BArchivable_Create(AObject : TObject; from : TCPlusObject) : TCPlusObject; cdecl; external BePascalLibName name 'BApplication_Create_1';
function BArchivable_Archive(archivable : TCPlusObject; into : TCPlusObject; deep : boolean) : TStatus_t; cdecl; external BePascalLibName name 'BApplication_Create_1';
implementation
var
Archivable_Instantiate_hook : Pointer; cvar; external;
Archivable_Archive_hook : Pointer; cvar; external;
function Archivable_Instantiate_hook_func(from : TCPlusObject) : TCPlusObject;
begin
WriteLn('Bonjour');
end;
function Archivable_Archive_hook_func(into : TCPlusObject; deep : boolean) : TCPlusObject;
begin
WriteLn('Bonjour');
end;
initialization
Archivable_Instantiate_hook := @Archivable_Instantiate_hook_func;
Archivable_Archive_hook := @Archivable_Archive_hook_func;
end.

View File

@@ -0,0 +1,38 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit SupportDefs;
interface
type
// Descriptive formats
TStatus_t = Longint;
TBigtime_t = int64;
TType_code = Cardinal;
TPerform_code = Cardinal;
// pointer types for FreePascal : to make life easier
PStatus_t = ^TStatus_t;
// TODO : import other functions !
implementation
end.

View File

@@ -0,0 +1,67 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit TypeConstants;
interface
const
B_ANY_TYPE = 'ANYT';
B_BOOL_TYPE = 'BOOL';
B_CHAR_TYPE = 'CHAR';
B_COLOR_8_BIT_TYPE = 'CLRB';
B_DOUBLE_TYPE = 'DBLE';
B_FLOAT_TYPE = 'FLOT';
B_GRAYSCALE_8_BIT_TYPE = 'GRYB';
B_INT64_TYPE = 'LLNG';
B_INT32_TYPE = 'LONG';
B_INT16_TYPE = 'SHRT';
B_INT8_TYPE = 'BYTE';
B_MESSAGE_TYPE = 'MSGG';
B_MESSENGER_TYPE = 'MSNG';
B_MIME_TYPE = 'MIME';
B_MONOCHROME_1_BIT_TYPE = 'MNOB';
B_OBJECT_TYPE = 'OPTR';
B_OFF_T_TYPE = 'OFFT';
B_PATTERN_TYPE = 'PATN';
B_POINTER_TYPE = 'PNTR';
B_POINT_TYPE = 'BPNT';
B_RAW_TYPE = 'RAWT';
B_RECT_TYPE = 'RECT';
B_REF_TYPE = 'RREF';
B_RGB_32_BIT_TYPE = 'RGBB';
B_RGB_COLOR_TYPE = 'RGBC';
B_SIZE_T_TYPE = 'SIZT';
B_SSIZE_T_TYPE = 'SSZT';
B_STRING_TYPE = 'CSTR';
B_TIME_TYPE = 'TIME';
B_UINT64_TYPE = 'ULLG';
B_UINT32_TYPE = 'ULNG';
B_UINT16_TYPE = 'USHT';
B_UINT8_TYPE = 'UBYT';
B_MEDIA_PARAMETER_TYPE = 'BMCT';
B_MEDIA_PARAMETER_WEB_TYPE = 'BMCW';
B_MEDIA_PARAMETER_GROUP_TYPE= 'BMCG';
B_ATOM_TYPE = 'ATOM';
B_ATOMREF_TYPE = 'ATMR';
// deprecated, do not use
B_ASCII_TYPE = 'TEXT'; // use B_STRING_TYPE instead
implementation
end.

Binary file not shown.

View File

@@ -0,0 +1,140 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
program Hello;
{$M+}
uses
beobj, application, message, _beep, roster, SysUtils,
archivable, handler, toto, rect, window;
type
TMonApplication = class(TApplication)
public
procedure ReadyToRun; override;
procedure MessageReceived(aMessage : TMessage); override;
function QuitRequested : boolean; override;
end;
TMonObjet = class(TObject)
private
FMessage : string;
public
constructor Create;
destructor Destroy; override;
procedure Bonjour(test : string);
published
property Message : string read FMessage write FMessage;
end;
var
MonObj : TMonObjet;
function TMonApplication.QuitRequested : boolean;
begin
Result := inherited;
be_app.Free;
end;
procedure TMonApplication.ReadyToRun;
var
Mess : TMessage;
begin
inherited;
if MonObj <> nil then
MonObj.Bonjour('BONJOUR');
Mess := TMessage.Create;
try
Mess.What := 7777;
be_roster.Broadcast(Mess);
finally
Mess.Free;
end;
end;
procedure TMonApplication.MessageReceived(aMessage : TMessage);
begin
inherited;
WriteLn(IntToStr(aMessage.What));
end;
constructor TMonObjet.Create;
var
a, b : string;
c : longint;
begin
inherited;
// GetLineInfo($A0000DB4, a, b, c);
Writeln(a + ' ' + b + ' ' + IntToStr(c));
WriteLn('Constructor');
end;
procedure TMonObjet.Bonjour(test : string);
var
a, b : string;
c : longint;
begin
// GetLineInfo($8002AEA5, a, b, c);
Writeln(a + ' ' + b + ' ' + IntToStr(c));
WriteLn(test);
beep;
WriteLn('Fin de ' + test);
end;
destructor TMonObjet.Destroy;
var
point : TPoint;
rect : TRect;
begin
point := TPoint.Create(10, 20);
rect := TRect.Create(10.0, 10.0, 10.0, 20.0);
try
point.PrintToStream;
point.Sept(15, 30);
rect.PrintToStream;
finally
point.PrintToStream;
point.Free;
rect.Free;
end;
WriteLn('The End');
inherited;
end;
var
aRect : TRect;
win : TWindow;
begin
beep;
Write('Hello world !' + #13#10);
MonObj := TMonObjet.Create;
TMonApplication.Create;
try
aRect := TRect.Create(20, 20, 200, 200);
win := TWindow.Create(aRect, 'Bonjour', B_TITLED_WINDOW, B_QUIT_ON_WINDOW_CLOSE, B_CURRENT_WORKSPACE);
win.Show;
be_app.Run;
be_app.HideCursor;
be_app.ShowCursor;
finally
MonObj.Free;
aRect.Free;
win.Free;
end;
end.

View File

@@ -0,0 +1,39 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
program test;
{$M+}
type
TObjet = class(TObject)
private
public
end;
var
obj : TObjet;
begin
writeln('Bonjour');
obj := TObjet.Create;
try
writeln('Bonjour');
finally
obj.Free;
end;
end.

View File

@@ -0,0 +1,30 @@
{ BePascal - A pascal wrapper around the BeOS API
Copyright (C) 2002 Olivier Coursiere
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit toto;
interface
implementation
initialization
Writeln('Init');
finalization
Writeln('Final');
end.