GLBasic forum

Codesnippets => Code Snippets => Topic started by: MrTAToad on 2010-Jul-07

Title: Inter-Type Messaging Routine
Post by: MrTAToad 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