diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 08:54:39 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 08:54:39 +0000 |
commit | 1e00430227e56fd2691f8374418f352c171039b1 (patch) | |
tree | 0451194af432a8b80270defb403bb100f1e95d90 /src/corelib/gfx_msgqueue.inc | |
parent | 2ecc101eb1573c272d570289987807c44937631b (diff) | |
download | fpGUI-1e00430227e56fd2691f8374418f352c171039b1.tar.xz |
The first part of removing the obsolete fpGUI and replacing it with the new multi-handle design from the prototypes directory.
Diffstat (limited to 'src/corelib/gfx_msgqueue.inc')
-rw-r--r-- | src/corelib/gfx_msgqueue.inc | 195 |
1 files changed, 195 insertions, 0 deletions
diff --git a/src/corelib/gfx_msgqueue.inc b/src/corelib/gfx_msgqueue.inc new file mode 100644 index 00000000..ae893b44 --- /dev/null +++ b/src/corelib/gfx_msgqueue.inc @@ -0,0 +1,195 @@ + +// fpGFX internal message queue implementation + +type + // a simlpe linked list implementation + TMessageListElement = class + protected + Next: TMessageListElement; + Prev: TMessageListElement; + public + msg: TfpgMessageRec; + end; + +var + // to make things easier we have a few global variable that will get set + UsedFirstMessage: TMessageListElement; + UsedLastMessage: TMessageListElement; + FreeFirstMessage: TMessageListElement; + FreeLastMessage: TMessageListElement; + +procedure MsgListInsertElement(Elem: TMessageListElement; var First: TMessageListElement; var Last: TMessageListElement); +begin + Elem.Prev := nil; + Elem.Next := nil; + + if First = nil then + begin + First := Elem; + Last := Elem; + end + else + begin + Last.Next := Elem; + Elem.Prev := Last; + Last := Elem; + end; +end; + +procedure MsgListRemoveElement(Elem: TMessageListElement; var First: TMessageListElement; var Last: TMessageListElement); +begin + if Elem = First then + First := Elem.Next; + + if Elem = Last then + Last := Elem.Prev; + + if Elem.Next <> nil then + Elem.Next.Prev := Elem.Prev; + + if Elem.Prev <> nil then + Elem.Prev.Next := Elem.Next; +end; + +function pgfAllocateMessage: PfpgMessageRec; +var + e: TMessageListElement; +begin + e := FreeFirstMessage; + if e <> nil then + begin + MsgListRemoveElement(e, FreeFirstMessage, FreeLastMessage); + MsgListInsertElement(e, UsedFirstMessage, UsedLastMessage); + result := @(e.msg); + end + else + result := nil; +end; + +procedure fpgDeleteFirstMessage; +var + e: TMessageListElement; +begin + e := UsedFirstMessage; + if e <> nil then + begin + MsgListRemoveElement(e, UsedFirstMessage, UsedLastMessage); + MsgListInsertElement(e, FreeFirstMessage, FreeLastMessage); + end; +end; + +function fpgGetFirstMessage: PfpgMessageRec; +begin + if UsedFirstMessage <> nil then + Result := @(UsedFirstMessage.msg) + else + Result := nil; +end; + +procedure fpgInitMsgQueue; +var + n: integer; + e: TMessageListElement; +begin + UsedFirstMessage := nil; + UsedLastMessage := nil; + FreeFirstMessage := nil; + FreeLastMessage := nil; + + for n := 1 to cMessageQueueSize do + begin + e := TMessageListElement.Create; + MsgListInsertElement(e,FreeFirstMessage,FreeLastMessage); + end; +end; + +procedure fpgPostMessage(Sender, Dest: TObject; MsgCode: integer; var aparams: TfpgMessageParams); overload; +var + p: PfpgMessageRec; +begin + if Dest = nil then + Exit; //==> + + p := pgfAllocateMessage; + if p <> nil then + begin + p^.MsgCode := MsgCode; + p^.Sender := Sender; + p^.Dest := Dest; + p^.Params := aparams; + end + else + Writeln('THE MESSAGE QUEUE IS FULL.'); +end; + +procedure fpgPostMessage(Sender, Dest: TObject; MsgCode: integer); overload; +var + p: PfpgMessageRec; +begin + if Dest = nil then + Exit; //==> + + p := pgfAllocateMessage; + if p <> nil then + begin + p^.MsgCode := MsgCode; + p^.Sender := Sender; + p^.Dest := Dest; + end + else + Writeln('THE MESSAGE QUEUE IS FULL.'); +end; + +procedure fpgSendMessage(Sender, Dest: TObject; MsgCode: integer; var aparams: TfpgMessageParams); overload; +var + m: TfpgMessageRec; +begin + if Dest = nil then + Exit; //==> + + m.MsgCode := MsgCode; + m.Sender := Sender; + m.Dest := Dest; + m.Params := aparams; + + m.Dest.Dispatch(m) +end; + +procedure fpgSendMessage(Sender, Dest: TObject; MsgCode: integer); overload; +var + m: TfpgMessageRec; +begin + if Dest = nil then + Exit; //==> + + m.MsgCode := MsgCode; + m.Sender := Sender; + m.Dest := Dest; + + m.Dest.Dispatch(m) +end; + +procedure fpgDeliverMessage(var msg: TfpgMessageRec); +begin + if msg.MsgCode = FPGM_KILLME then + msg.Dest.Free + else + msg.Dest.Dispatch(msg); +end; + +procedure fpgDeliverMessages; +var + mp: PfpgMessageRec; + m: TfpgMessageRec; +begin + repeat + mp := fpgGetFirstMessage; + if mp <> nil then + begin + m := mp^; + fpgDeleteFirstMessage; + fpgDeliverMessage(m); + end; + until mp = nil; +end; + |