diff --git a/bepascal/bepascal/be/AppKit.cpp b/bepascal/bepascal/be/AppKit.cpp new file mode 100644 index 0000000..c7cbb98 --- /dev/null +++ b/bepascal/bepascal/be/AppKit.cpp @@ -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 +#include + +#endif /* _APPKIT_CPP_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/Be.cpp b/bepascal/bepascal/be/Be.cpp new file mode 100644 index 0000000..c879736 --- /dev/null +++ b/bepascal/bepascal/be/Be.cpp @@ -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 + +#endif /* _BE_CPP_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/app/Application.cpp b/bepascal/bepascal/be/app/Application.cpp new file mode 100644 index 0000000..1aff847 --- /dev/null +++ b/bepascal/bepascal/be/app/Application.cpp @@ -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 +#include + +#include +#include +#include +#include +#include +#include +#include +#include + +#include + +// 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(Application)->HideCursor(); +} + +void BApplication_ShowCursor(TCPlusObject Application) +{ + reinterpret_cast(Application)->ShowCursor(); +} + +thread_id BApplication_Run(TCPlusObject Application) +{ + return reinterpret_cast(Application)->Run(); +} + +void BApplication_Quit(TCPlusObject Application) +{ + reinterpret_cast(Application)->Quit(); +} + + + +#if defined(__cplusplus) +} +#endif + +#endif /* _APPLICATION_CPP_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/app/Handler.cpp b/bepascal/bepascal/be/app/Handler.cpp new file mode 100644 index 0000000..0770436 --- /dev/null +++ b/bepascal/bepascal/be/app/Handler.cpp @@ -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 + +#include + +// 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_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/app/Looper.cpp b/bepascal/bepascal/be/app/Looper.cpp new file mode 100644 index 0000000..5f6cd7d --- /dev/null +++ b/bepascal/bepascal/be/app/Looper.cpp @@ -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 +#include + +#include + +#include + +// 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(Looper)->GetSupportedSuites(message); +} + +bool BLooper_LockLooper(TCPlusObject Looper) +{ + return reinterpret_cast(Looper)->LockLooper(); +} + +status_t BLooper_LockLooperWithTimeout(TCPlusObject Looper, bigtime_t timeout) +{ + return reinterpret_cast(Looper)->LockLooperWithTimeout(timeout); +} + +void BLooper_UnlockLooper(TCPlusObject Looper) +{ + reinterpret_cast(Looper)->UnlockLooper(); +} + +status_t BLooper_PostMessage_2(TCPlusObject Looper, uint32 command) +{ + return reinterpret_cast(Looper)->PostMessage(command); +} + +#if defined(__cplusplus) +} +#endif + +#endif /* _LOOPER_CPP_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/app/Message.cpp b/bepascal/bepascal/be/app/Message.cpp new file mode 100644 index 0000000..aad69ee --- /dev/null +++ b/bepascal/bepascal/be/app/Message.cpp @@ -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 +#include + +#include + +#include + +#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(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(message)->what; +} + +void BMessage_Setwhat(TCPlusObject message, uint32 what) +{ + reinterpret_cast(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(message)->AddData(name, type, data, + fixedSize, numItems); +} + +status_t BMessage_AddBool(TCPlusObject message, const char *name, bool aBool) +{ + return reinterpret_cast(message)->AddBool(name, aBool); +} + +status_t BMessage_AddInt8(TCPlusObject message, const char *name, int8 anInt8) +{ + return reinterpret_cast(message)->AddInt8(name, anInt8); +} + +status_t BMessage_AddInt16(TCPlusObject message, const char *name, int16 anInt16) +{ + return reinterpret_cast(message)->AddInt16(name, anInt16); +} + +status_t BMessage_AddInt32(TCPlusObject message, const char *name, int32 anInt32) +{ + return reinterpret_cast(message)->AddInt32(name, anInt32); +} + +status_t BMessage_AddInt64(TCPlusObject message, const char *name, int64 anInt64) +{ + return reinterpret_cast(message)->AddInt64(name, anInt64); +} + +status_t BMessage_AddFloat(TCPlusObject message, const char *name, float aFloat) +{ + return reinterpret_cast(message)->AddFloat(name, aFloat); +} + +status_t BMessage_AddDouble(TCPlusObject message, const char *name, double aDouble) +{ + return reinterpret_cast(message)->AddDouble(name, aDouble); +} + +status_t BMessage_AddString(TCPlusObject message, const char *name, const char *string) +{ + return reinterpret_cast(message)->AddString(name, string); +} + +status_t BMessage_AddMessage(TCPlusObject message, const char *name, const TCPlusObject amessage) +{ + return reinterpret_cast(message)->AddMessage(name, reinterpret_cast(amessage)); +} + +int32 BMessage_CountNames(TCPlusObject message, type_code type) +{ + return reinterpret_cast(message)->CountNames(type); +} + +bool BMessage_HasSpecifiers(TCPlusObject message) +{ + return reinterpret_cast(message)->HasSpecifiers(); +} + +bool BMessage_IsSystem(TCPlusObject message) +{ + return reinterpret_cast(message)->IsSystem(); +} + +status_t BMessage_MakeEmpty(TCPlusObject message) +{ + return reinterpret_cast(message)->MakeEmpty(); +} + +bool BMessage_IsEmpty(TCPlusObject message) +{ + return reinterpret_cast(message)->IsEmpty(); +} + +status_t BMessage_RemoveName(TCPlusObject message, const char *name) +{ + return reinterpret_cast(message)->RemoveName(name); +} + +void BMessage_PrintToStream(TCPlusObject message) +{ + reinterpret_cast(message)->PrintToStream(); +} + +status_t BMessage_RemoveData(TCPlusObject message, const char *name, int32 index = 0) +{ + return reinterpret_cast(message)->RemoveData(name, index); +} + +bool BMessage_WasDelivered(TCPlusObject message) +{ + return reinterpret_cast(message)->WasDelivered(); +} + +bool BMessage_IsSourceRemote(TCPlusObject message) +{ + return reinterpret_cast(message)->IsSourceRemote(); +} + +bool BMessage_IsSourceWaiting(TCPlusObject message) +{ + return reinterpret_cast(message)->IsSourceWaiting(); +} + +bool BMessage_IsReply(TCPlusObject message) +{ + return reinterpret_cast(message)->IsReply(); +} + +const BMessage *BMessage_Previous(TCPlusObject message) +{ + return reinterpret_cast(message)->Previous(); +} + +bool BMessage_WasDropped(TCPlusObject message) +{ + return reinterpret_cast(message)->WasDropped(); +} + +#if defined(__cplusplus) +} +#endif + + +#endif /* _MESSAGE_CPP_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/app/Roster.cpp b/bepascal/bepascal/be/app/Roster.cpp new file mode 100644 index 0000000..b0b770e --- /dev/null +++ b/bepascal/bepascal/be/app/Roster.cpp @@ -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 + +#include +#include + +#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(Roster)->Broadcast(reinterpret_cast(message)); +} + +#if defined(__cplusplus) +} +#endif + +#endif /* _ROSTER_CPP_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/app/appdefs.pp b/bepascal/bepascal/be/app/appdefs.pp new file mode 100644 index 0000000..5997848 --- /dev/null +++ b/bepascal/bepascal/be/app/appdefs.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/app/application.pp b/bepascal/bepascal/be/app/application.pp new file mode 100644 index 0000000..40941cc --- /dev/null +++ b/bepascal/bepascal/be/app/application.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/app/handler.pp b/bepascal/bepascal/be/app/handler.pp new file mode 100644 index 0000000..1dae223 --- /dev/null +++ b/bepascal/bepascal/be/app/handler.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/app/looper.pp b/bepascal/bepascal/be/app/looper.pp new file mode 100644 index 0000000..f3c6d9c --- /dev/null +++ b/bepascal/bepascal/be/app/looper.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/app/message.pp b/bepascal/bepascal/be/app/message.pp new file mode 100644 index 0000000..878695b --- /dev/null +++ b/bepascal/bepascal/be/app/message.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/app/roster.pp b/bepascal/bepascal/be/app/roster.pp new file mode 100644 index 0000000..05c8dd7 --- /dev/null +++ b/bepascal/bepascal/be/app/roster.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/bepas_kernel/beobj.cpp b/bepascal/bepascal/be/bepas_kernel/beobj.cpp new file mode 100644 index 0000000..389b101 --- /dev/null +++ b/bepascal/bepascal/be/bepas_kernel/beobj.cpp @@ -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_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/bepas_kernel/beobj.pp b/bepascal/bepascal/be/bepas_kernel/beobj.pp new file mode 100644 index 0000000..8fc72c6 --- /dev/null +++ b/bepascal/bepascal/be/bepas_kernel/beobj.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/interface/Point.cpp b/bepascal/bepascal/be/interface/Point.cpp new file mode 100644 index 0000000..2e5afab --- /dev/null +++ b/bepascal/bepascal/be/interface/Point.cpp @@ -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 + +#include + +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(Point)->ConstrainTo(rect); +} + +void BPoint_PrintToStream(TCPlusObject Point) +{ + reinterpret_cast(Point)->PrintToStream(); +} + +void BPoint_Set(TCPlusObject Point, float x, float y) +{ + reinterpret_cast(Point)->Set(x, y); +} + +#if defined(__cplusplus) +} +#endif + + +#endif _POINT_CPP /* _POINT_CPP */ \ No newline at end of file diff --git a/bepascal/bepascal/be/interface/Rect.cpp b/bepascal/bepascal/be/interface/Rect.cpp new file mode 100644 index 0000000..f933253 --- /dev/null +++ b/bepascal/bepascal/be/interface/Rect.cpp @@ -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 +#include + +#include + +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(rect)->PrintToStream(); +} + + +#if defined(__cplusplus) +} +#endif + + +#endif _RECT_CPP /* _RECT_CPP */ \ No newline at end of file diff --git a/bepascal/bepascal/be/interface/Window.cpp b/bepascal/bepascal/be/interface/Window.cpp new file mode 100644 index 0000000..17ce488 --- /dev/null +++ b/bepascal/bepascal/be/interface/Window.cpp @@ -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 + +#include + +#include + +// 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(Window)->Show(); +} + +void BWindow_Hide(TCPlusObject Window) +{ + reinterpret_cast(Window)->Hide(); +} + +#if defined(__cplusplus) +} +#endif + +#endif /* _WINDOW_CPP_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/interface/point.pp.arch b/bepascal/bepascal/be/interface/point.pp.arch new file mode 100644 index 0000000..6253dd8 --- /dev/null +++ b/bepascal/bepascal/be/interface/point.pp.arch @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/interface/rect.pp b/bepascal/bepascal/be/interface/rect.pp new file mode 100644 index 0000000..9948550 --- /dev/null +++ b/bepascal/bepascal/be/interface/rect.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/interface/window.pp b/bepascal/bepascal/be/interface/window.pp new file mode 100644 index 0000000..ed02a9d --- /dev/null +++ b/bepascal/bepascal/be/interface/window.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/kernel/os.pp b/bepascal/bepascal/be/kernel/os.pp new file mode 100644 index 0000000..590454c --- /dev/null +++ b/bepascal/bepascal/be/kernel/os.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/support/Archivable.cpp b/bepascal/bepascal/be/support/Archivable.cpp new file mode 100644 index 0000000..0146ed7 --- /dev/null +++ b/bepascal/bepascal/be/support/Archivable.cpp @@ -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 + +#include + +#include + +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(, from); + if (validate_instantiation(from, "BPArchivable")) + return reinterpret_cast(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(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(into)->AddString("class", "BPArchivable"); + return reinterpret_cast(archivable)->ArchiveFromPascal(reinterpret_cast(into), deep); +} + +#if defined(__cplusplus) +} +#endif + +#endif /* _ARCHIVABLE_CPP_ */ \ No newline at end of file diff --git a/bepascal/bepascal/be/support/_beep.pp b/bepascal/bepascal/be/support/_beep.pp new file mode 100644 index 0000000..be35e42 --- /dev/null +++ b/bepascal/bepascal/be/support/_beep.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/support/archivable.pp b/bepascal/bepascal/be/support/archivable.pp new file mode 100644 index 0000000..20f0e3f --- /dev/null +++ b/bepascal/bepascal/be/support/archivable.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/support/supportdefs.pp b/bepascal/bepascal/be/support/supportdefs.pp new file mode 100644 index 0000000..401928c --- /dev/null +++ b/bepascal/bepascal/be/support/supportdefs.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/be/support/typeconstants.pp b/bepascal/bepascal/be/support/typeconstants.pp new file mode 100644 index 0000000..fea6278 --- /dev/null +++ b/bepascal/bepascal/be/support/typeconstants.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/bepascal/bepascal.proj b/bepascal/bepascal/bepascal/bepascal.proj new file mode 100644 index 0000000..0e75068 Binary files /dev/null and b/bepascal/bepascal/bepascal/bepascal.proj differ diff --git a/bepascal/bepascal/test_app/hello.pp b/bepascal/bepascal/test_app/hello.pp new file mode 100644 index 0000000..f70fc2f --- /dev/null +++ b/bepascal/bepascal/test_app/hello.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/test_app/test.pp b/bepascal/bepascal/test_app/test.pp new file mode 100644 index 0000000..0d78b8e --- /dev/null +++ b/bepascal/bepascal/test_app/test.pp @@ -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. \ No newline at end of file diff --git a/bepascal/bepascal/test_app/toto.pp b/bepascal/bepascal/test_app/toto.pp new file mode 100644 index 0000000..2a6c9ca --- /dev/null +++ b/bepascal/bepascal/test_app/toto.pp @@ -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. +