BASIC

Author Topic: Inter-Type Messaging Routine  (Read 1190 times)

MrTAToad

  • Guest
Inter-Type Messaging Routine
« on: 2010-Jul-07 »
Here it is - its quite simple :

Code: GLBasic [Select]
TYPE tMessage
        fromHashValue%
        toHashValue%
        data$
ENDTYPE

TYPE tTypeList
        hashValue%
        typeName$
ENDTYPE

TYPE TMessage
        NOT_VALID%      =       -1
        typeList[] AS tTypeList
        messages[] AS tMessage

        FUNCTION TMessage_Initialise%:
                DIM self.typeList[0]
        ENDFUNCTION

        FUNCTION TMessage_RegisterType%:typeName$
        LOCAL loop AS tTypeList
        LOCAL found%,hashValue%

                found%=FALSE
                hashValue%=Hash(typeName$)
                IF TMessage_LookForHash(hashValue%)=self.NOT_VALID%
                        // Not found, so add this hash to the list
                        loop.typeName$=typeName$
                        loop.hashValue%=hashValue%
                        DIMPUSH self.typeList[],loop
                        SORTARRAY self.typeList[],0
                        RETURN hashValue%
                ELSE
                        RETURN self.NOT_VALID%
                ENDIF
        ENDFUNCTION

        FUNCTION TMessage_SendMessage%:fromHash%,toHash%,data$
        LOCAL fromIndex%,toIndex%
        LOCAL message AS tMessage

                fromIndex%=TMessage_LookForHash(fromHash%)
                toIndex%=TMessage_LookForHash(toHash%)
                IF fromIndex%>self.NOT_VALID% AND toIndex%>self.NOT_VALID%
                        message.fromHashValue%=fromHash%
                        message.toHashValue%=toHash%
                        message.data$=data$
                        DIMPUSH self.messages[],message
                        RETURN TRUE
                ELSE
                        RETURN FALSE
                ENDIF
        ENDFUNCTION

        //! Send debug information to the output window
        FUNCTION TMessage_Debug%:
        LOCAL loop AS tTypeList

                DEBUG "Number of registered types : "+BOUNDS(self.typeList[],0)+"\n"
                FOREACH loop IN self.typeList[]
                        DEBUG "("+loop.hashValue%+" - "+loop.typeName$+")\n"
                NEXT
                DEBUG "Messages Outstanding : "+BOUNDS(self.messages[],0)+"\n"
        ENDFUNCTION

        //! Send a message to the destination type, using its registered name.  This could be very slow
        FUNCTION TMessage_SendMessage_Text%:fromHash%,toType$,data$
        LOCAL fromIndex%,toIndex%
        LOCAL message AS tMessage

                fromIndex%=TMessage_LookForHash(fromHash%)
                IF fromIndex%>self.NOT_VALID%
                        toIndex%=TMessage_LookForName(toType$)
                        IF toIndex%>self.NOT_VALID%
                                message.fromHashValue%=fromHash%
                                message.toHashValue%=self.typeList[toIndex%].hashValue%
                                message.data$=data$
                                DIMPUSH self.messages[],message
                                RETURN TRUE
                        ENDIF
                ENDIF
                RETURN FALSE
        ENDFUNCTION

        FUNCTION TMessage_SendMessage_All%:fromHash%,data$,includeFrom%=FALSE
        LOCAL fromIndex%
        LOCAL message AS tMessage
        LOCAL loop AS tTypeList

                fromIndex%=TMessage_LookForHash(fromHash%)
                IF fromIndex%>=0
                        message.fromHashValue%=fromHash%
                        message.data$=data$

                        FOREACH loop IN self.typeList[]
                                IF (loop.hashValue%=fromHash% AND includeFrom%=TRUE) OR (loop.hashValue%<>fromHash%)
                                        message.toHashValue%=loop.hashValue%

                                        DIMPUSH self.messages[],message
                                ENDIF
                        NEXT

                        RETURN TRUE
                ENDIF

                RETURN FALSE
        ENDFUNCTION

        //! Send to the first ordered type - may not be in the order added by the user
        FUNCTION TMessage_SendMessage_First%:fromHash%,data$
        LOCAL fromIndex%,toIndex%
        LOCAL message AS tMessage

                fromIndex%=TMessage_LookForHash(fromHash%)
                toIndex%=0
                IF fromIndex%>=0
                        message.fromHashValue%=fromHash%
                        message.toHashValue%=self.typeList[toIndex%].hashValue%
                        message.data$=data$
                        DIMPUSH self.messages[],message
                        RETURN TRUE
                ENDIF
        ENDFUNCTION

        //! Send to the last ordered type - may not be in the order added by the user
        FUNCTION TMessage_SendMessage_Last%:fromHash%,data$
        LOCAL fromIndex%,toIndex%
        LOCAL message AS tMessage

                fromIndex%=TMessage_LookForHash(fromHash%)
                toIndex%=BOUNDS(self.typeList[],0)-1
                IF fromIndex%>=0
                        message.fromHashValue%=fromHash%
                        message.toHashValue%=self.typeList[toIndex%].hashValue%
                        message.data$=data$
                        DIMPUSH self.messages[],message
                        RETURN TRUE
                ENDIF
        ENDFUNCTION

        //! Send to the next ordered type - may not be in the order added by the user
        FUNCTION TMessage_SendMessage_Next%:fromHash%,data$,wrap%=TRUE
        LOCAL fromIndex%
        LOCAL message AS tMessage

                fromIndex%=TMessage_LookForHash(fromHash%)
                IF fromIndex%>=0
                        INC fromIndex%
                        IF fromIndex%>=BOUNDS(self.typeList[],0)
                                IF wrap%=FALSE THEN RETURN FALSE

                                fromIndex%=0
                        ENDIF

                        message.fromHashValue%=fromHash%
                        message.toHashValue%=self.typeList[fromIndex%].hashValue%
                        message.data$=data$
                        DIMPUSH self.messages[],message
                        RETURN TRUE
                ENDIF

                RETURN FALSE
        ENDFUNCTION

        //! Send to the previous ordered type - may not be in the order added by the user
        FUNCTION TMessage_SendMessage_Prev%:fromHash%,data$,wrap%=TRUE
        LOCAL fromIndex%
        LOCAL message AS tMessage

                fromIndex%=TMessage_LookForHash(fromHash%)
                IF fromIndex%>=0
                        DEC fromIndex%
                        IF fromIndex%<0
                                IF wrap%=FALSE THEN RETURN FALSE

                                fromIndex%=BOUNDS(self.typeList[],0)-1
                        ENDIF

                        message.fromHashValue%=fromHash%
                        message.toHashValue%=self.typeList[fromIndex%].hashValue%
                        message.data$=data$
                        DIMPUSH self.messages[],message
                        RETURN TRUE
                ENDIF

                RETURN FALSE
        ENDFUNCTION

        FUNCTION TMessage_PeekMessage%:hashValue%,BYREF data$,BYREF fromHash%
        LOCAL index%

                IF BOUNDS(self.messages[],0)>0
                        IF self.messages[0].toHashValue%=hashValue%
                                data$=self.messages[0].data$
                                fromHash%=self.messages[0].fromHashValue%
                                DIMDEL self.messages[],0
                                RETURN TRUE
                        ELSE
                                RETURN FALSE
                        ENDIF
                ELSE
                        RETURN FALSE
                ENDIF
        ENDFUNCTION

        FUNCTION TMessage_GetRegisteredText$:
        LOCAL temp$
        LOCAL loop AS tTypeList

                temp$=""
                FOREACH loop IN self.typeList[]
                        temp$=temp$+loop.typeName$+","+loop.hashValue%+","
                NEXT

                RETURN LEFT$(temp$,LEN(temp$)-1)
        ENDFUNCTION

        //! This is a private function and should not be called
        FUNCTION TMessage_LookForHash%:hashValue%
        LOCAL count%
        LOCAL low%,high%,middle%

                count%=BOUNDS(self.typeList[],0)
                IF count%=0 THEN RETURN self.NOT_VALID%
                IF count%=1
                        IF self.typeList[0].hashValue%=hashValue%
                                RETURN self.typeList[0].hashValue%
                        ELSE
                                RETURN self.NOT_VALID%
                        ENDIF
                ENDIF

                low%=0
                high%=count%-1

                WHILE low%<=high%
                        middle%=low%+(high%-low%)/2
                        IF hashValue%<self.typeList[middle%].hashValue%
                                high%=middle%-1
                        ELSEIF hashValue%>self.typeList[middle%].hashValue%
                                low%=middle%+1
                        ELSE
                                RETURN middle%
                        ENDIF
                WEND

                RETURN self.NOT_VALID%
        ENDFUNCTION

        FUNCTION TMessage_LookForName%:typeName$
        LOCAL loop%

                FOR loop%=0 TO BOUNDS(self.typeList[],0)-1
                        IF self.typeList[loop%].typeName$=typeName$ THEN RETURN loop%
                NEXT

                RETURN self.NOT_VALID%
        ENDFUNCTION
ENDTYPE
 

Test code (you need DDgui) :

Code: GLBasic [Select]
TYPE TWindow
        hashValue%
        widget$
        list$
        sendType$
        text$
        send$

        FUNCTION TWindow_Initialise%:message AS TMessage,width%,height%,name$
                self.hashValue%=message.TMessage_RegisterType(name$)
                IF self.hashValue%<0
                        RETURN FALSE
                ENDIF

                self.list$=name$+"list"
                self.sendType$=name$+"combo"
                self.text$=name$+"text"
                self.send$=name$+"send"
                self.widget$=name$+"widget"
                DDgui_widget(self.widget$,name$+" :",width%-8,0)
                DDgui_list(self.list$,"",width%-32,height%-46)
                DDgui_combo(self.sendType$,"",96,0)
                DDgui_text(self.text$,"",192,0)
                DDgui_button(self.send$,"SEND",0,0)
                RETURN TRUE
        ENDFUNCTION

        FUNCTION TWindow_Logic%:message AS TMessage
        LOCAL text$,data$,from%,sendType$,index%
        LOCAL array$[]

                IF message.TMessage_PeekMessage(self.hashValue%,data$,from%)
                        // A message has been received
                        text$=DDgui_get$(self.list$,"TEXT")+"|"+data$
                        DDgui_set(self.list$,"TEXT",text$)
                ENDIF

                IF DDgui_get(self.send$,"CLICKED")
                        // Send button pressed
                        text$=DDgui_get$(self.text$,"TEXT")
                        IF text$<>""
                                index%=DDgui_get(self.sendType$,"SELECT")
                                IF index%>=0
                                        SELECT index%
                                                CASE    0
                                                                        // All windows including sending one
                                                                        message.TMessage_SendMessage_All(self.hashValue%,text$,TRUE)

                                                CASE    1
                                                                        // All windows excluding sending one
                                                                        message.TMessage_SendMessage_All(self.hashValue%,text$,FALSE)

                                                CASE    2
                                                                        // First
                                                                        message.TMessage_SendMessage_First(self.hashValue%,text$)

                                                CASE    3
                                                                        // Last
                                                                        message.TMessage_SendMessage_Last(self.hashValue%,text$)

                                                CASE    4
                                                                        // Next
                                                                        message.TMessage_SendMessage_Next(self.hashValue%,text$,FALSE)

                                                CASE    5
                                                                        // Next
                                                                        message.TMessage_SendMessage_Prev(self.hashValue%,text$,FALSE)

                                                DEFAULT
                                                                        DIM array$[0]
                                                                        IF SPLITSTR(DDgui_get$(self.sendType$,"TEXT"),array$[],"|")>0
                                                                                message.TMessage_SendMessage_Text(self.hashValue%,array$[index%],text$)
                                                                        ENDIF

                                        ENDSELECT
                                ENDIF
                        ENDIF
                ENDIF
        ENDFUNCTION

        FUNCTION TWindow_SetComboText%:list$
        LOCAL array$[]
        LOCAL str$
        LOCAL loop2%

                DIM array$[0]
                IF SPLITSTR(list$,array$[],",")>0
                        str$="ALLI|ALLE|FIRST|LAST|NEXT|PREV"

                        // Now, we only want the names and not the hash values
                        FOR loop2%=0 TO BOUNDS(array$[],0)-1 STEP 2
                                str$=str$+"|"+array$[loop2%]
                        NEXT

                        DDgui_set(self.sendType$,"TEXT",str$)
                ENDIF
        ENDFUNCTION
ENDTYPE

LOCAL messages AS TMessage
LOCAL window[] AS TWindow
LOCAL sW%,sH%,loop%,temp$

GETSCREENSIZE sW%,sH%
DIM window[4]
messages.TMessage_Initialise()
DDgui_pushdialog(0,0,sW%-1,sH%-1)

// Create 4 areas
FOR loop%=0 TO 3
        IF window[loop%].TWindow_Initialise(messages,sW%,sH%/4,"Window "+CHR$(49+loop%))<0
                DEBUG "Unable to initialise Window : "+loop%+"\n"
                END
        ENDIF
NEXT

messages.TMessage_Debug()

// Get the list of registered types
temp$=messages.TMessage_GetRegisteredText$()
FOR loop%=0 TO 3
        window[loop%].TWindow_SetComboText(temp$)
NEXT

WHILE TRUE
        DDgui_show(FALSE)
        SHOWSCREEN

        FOR loop%=0 TO 3
                window[loop%].TWindow_Logic(messages)
        NEXT
WEND