ideas/ 40750 764 764 0 6675704632 11073 5ustar javierjavierideas/uam_dialog.tcl100640 764 764 7725 6050375557 14006 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_dialog # # This procedure displays a dialog box, waits for a button in the dialog # to be invoked, then returns the index of the selected button. # # Arguments: # title - Title to display in dialog's decorative frame. # text - Message to display in dialog. # justify - Justification of text (left, center or rigth). # bitmap - Bitmap to display in dialog (empty string means none). # bimapside - Where the bitmap should appear in the window # (top, left, right or bottom). # default -Index of button that is to display the default ring and # bind to Return # (-1 means none). # escape - Index of button that is invoked on pressing Escape-key # (-1 means return -1 on Escape) # args - One or more strings to display in buttons across the # bottom of the dialog box. # # Results: # # Returns the number of the pressed button. # proc uam_dialog {title text justify bitmap bitmapside default escape args} { global tk_priv # 1. Create the top-level window and divide it into top # and bottom parts. set w .dialog catch {destroy $w} toplevel $w -class Dialog wm title $w $title wm iconname $w Dialog frame $w.top pack $w.top -side top -fill both -padx 5m -pady 5m frame $w.bot pack $w.bot -side bottom -fill both # 2. Fill the top part with bitmap and message. if {$bitmap != ""} { label $w.bitmap -bitmap $bitmap pack $w.bitmap -in $w.top -side $bitmapside } message $w.msg -text $text \ -font -Adobe-Times-Medium-R-Normal-*-180-* \ -width 300 \ -justify $justify pack $w.msg -in $w.top -expand 1 -fill both # 3. Create a row of buttons at the bottom of the dialog. set i 0 foreach but $args { button $w.button$i -text $but \ -command "set tk_priv(button) $i; destroy $w" \ -width 8 if {$i == $default} { frame $w.default -relief sunken -bd 1 raise $w.button$i $w.default pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m pack $w.button$i -in $w.default -padx 1m -pady 1m \ -ipadx 2m -ipady 1m bind $w "$w.button$i flash $w.button$i invoke" } else { pack $w.button$i -in $w.bot -side left -expand 1 \ -padx 2m -pady 1m -ipadx 2m -ipady 1m } if {$i == $escape} { bind $w "$w.button$i flash $w.button$i invoke" } incr i } if {$escape == -1} { bind $w "destroy $w" } # 4. Withdraw the window, then update all the geometry information # so we know how big it wants to be, then place the window relative # to its parent and de-iconify it. wm withdraw $w update idletasks set dad [winfo parent $w] if {([set dadX [winfo x $dad]] == 0) || ([set dadY [winfo y $dad]] == 0)} { set x 300 set y 200 } else { set x [expr $dadX + ([winfo reqwidth $dad] - [winfo reqwidth $w])/2] set y [expr round($dadY + [winfo reqheight $dad]*0.3)] } wm geom $w +$x+$y wm deiconify $w # 5. Set a grab and claim the focus too. catch {grab $w} set oldFocus [focus] focus $w # 6. Wait for the user to respond, then restore the focus and # return the index of the selected button. set tk_priv(button) -1 tkwait window $w grab release $w focus $oldFocus update return $tk_priv(button) } ideas/agt_belUpdateProcs.tcl100640 764 764 20773 6050144165 15457 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_insert # # Tries to assert a belief to Belief-Base. # # Arguments: # # belief - belief to assert # # Results: # # Returns 0 on successfull insertion, 1 if an error occurrs. # Shows a remark in logfile. # proc agt_insert {belief} { global agt_VarTimeOffset # check if 'belief' contains strings that are not allowed: # set error 0 switch -glob -- $belief { *:-* {set failString :-; set error 1} *set_time* {set failString set_time; set error 1} *time* {set failString time; set error 1} *invalid* {set failString invalid; set error 1} *valid* {set failString valid; set error 1} } if {$error} { agt_puts "'$failString' not allowed in '$belief'\n\nBelief-Base\ not changed.\n" return 1 } agt_puts "Insert Belief:" # remove leading and succeding spaces from belief set belief [string trimleft $belief] if {[cindex $belief 0] == "("} { # in this case the belief has a time specification, i.e. it is of the form # (), , or # (), # check ()-brackets are balanced in 'belief' # set brackets 0 for {set index 0} {$index <= [clength $belief]} {incr index} { set char [cindex $belief $index] switch -glob -- $char { ( {incr brackets 1} ) {incr brackets -1} } } if {$brackets} { agt_puts "unbalanced brackets in '$belief'\n\nBelief-Base\ not changed.\n" return 1 } # get the index of the close bracket set index1 [string last ")" $belief] # get the characters of the time specification set timeString [string trimleft [crange $belief $index1+1 end]] # get just the belief, without brackets set belief [crange $belief 1 $index1-1] # check if the ',' exists after the belief if {[cindex $timeString 0] != ","} { agt_puts "',' expected after '$belief'\n\nBelief-Base\ not changed.\n" return 1 } # check if time specification includes a # and set 'timeFrom', 'timeTill' depending on it: if {[set index2 [string last "," $timeString]] == 0} { # no , set 'timeTill' to 0, i.e. belief is valid # after 'timeFrom' set timeFrom [crange $timeString 1 end] set timeTill 0 } else { # exists so get 'timeFrom' and 'timeTill' from 'timeString' set timeFrom [crange $timeString 1 $index2-1] set timeTill [crange $timeString $index2+1 end] } } else { # check ()-brackets are balanced in 'belief' # set brackets 0 for {set index 0} {$index <= [clength $belief]} {incr index} { set char [cindex $belief $index] switch -regexp -- $char { [(] {incr brackets 1} [)] {incr brackets -1} [,]|[;] {if {$brackets == 0} { agt_puts "character '$char' in illegal position in\ '$belief'\n\nBelief-Base\ not changed.\n" return 1 } } } } if {$brackets} { agt_puts "unbalanced brackets in '$belief'\n\nBelief-Base\ not changed.\n" return 1 } # no time specification, so the belief is always valid set timeFrom now set timeTill 0 } # use Tcl-command 'convertclock' to get the UNIX-time from # time specification; subtract a value 'agt_VarTimeOffset' so that BinProlog # can get the integer value if {[catch {set timeFrom [expr [convertclock $timeFrom]-$agt_VarTimeOffset]; \ set timeTill [expr [convertclock $timeTill]-$agt_VarTimeOffset] } \ errorMesg]} { agt_puts "$errorMesg\n\nBelief-Base\ not changed.\n" return 1 } # remove a possibly existing fact with same name # if {[agt_listQuery retract(($belief:-A))] == -1} { agt_puts "Belief-Base not changed.\n" return 1 } if {[agt_listQuery retract(validity($belief,B,C))] == -1} { agt_puts "Belief-Base not changed.\n" return 1 } # build up the belief to insert to Belief-Base set belief_1 "$belief:-validity(($belief), FROM, TILL), \ (valid(FROM, TILL); \ (invalid(FROM, TILL), \ retract((($belief):-A)),\ retract(validity(($belief), FROM, TILL)),fail))" if {[catch {agt_quietQuery "assert(($belief_1))"} errorMesg]} { agt_puts "Prolog - $errorMesg\n\nBelief-Base\ not changed.\n" return 1 } # built up the validity-belief for the just inserted belief set belief_2 "validity(($belief), $timeFrom, $timeTill)" if {[catch {agt_quietQuery "assert(($belief_2))"} errorMesg]} { agt_puts "Prolog - $errorMesg\n\nBelief-Base\ not changed.\n" } else { agt_puts "Inserted: '$belief'\n" # set the actual time in Prolog agt_timeSet agt_displayBelBase return 0 } } # # agt_delete # # Tries to retract a belief from Belief-Base. # # Arguments: # # belief - belief to retract # # Results: # # Returns 0 on successfull retraction, 1 if an error occurrs. # Shows a remark in control display. # proc agt_delete {belief} { agt_puts "Delete Belief:" # check if 'belief' contains strings that are not allowed: # set error 0 switch -glob -- $belief { *:-* {set failString :-; set error 1} *set_time* {set failString set_time; set error 1} *time* {set failString time; set error 1} *invalid* {set failString invalid; set error 1} *valid* {set failString valid; set error 1} } if {$error} { agt_puts "'$failString' not allowed in '$belief'\n\nBelief-Base\ not changed.\n" return 1 } # build up belief to delete set belief_1 "($belief:-A)" # delete the belief if {[set result [agt_listQuery retract($belief_1)]] == -1} { agt_puts "Belief-Base not changed.\n" return 1 } elseif {$result == 0} { agt_puts "Prolog - '$belief' not exists in Belief-Base\n\nBelief-Base\ not changed.\n" return 1 } else { # remove the validity-belief for the just removed belief set belief_2 "validity($belief, FROM, TILL)" if {[agt_listQuery retract($belief_2)] == -1} { agt_puts "Belief-Base not changed.\n" return 1 } agt_puts "Deleted: '$belief'\n" # set the actual time in Prolog agt_timeSet agt_displayBelBase return 0 } } # # agt_saveBelBase # # Saves content of Belief-Base to a file with extension '.pl' # in directory 'ideas/save'. # # Arguments: # # fileName - name (path) of file to save to # # Results: # # 0 - everything ok # 1 - cannot create fileName # 2 - write error # # Shows an errorMesg in logfile. # proc agt_saveBelBase {fileName} { # if extension of fileName is not '.pl' set it to '.pl' # if {![cequal [file extension $fileName] .pl]} { append fileName .pl } # open file if {[catch {set tmpFid [open "save/$fileName" w]} errorMesg]} { agt_puts "Failed to save Belief-Base:\n$errorMesg\n" return 1 } # read actual Belief-Base from text widget set beliefBase [.f3.text get 0.0 end] # write actual beliefs to this file if {[catch {puts $tmpFid $beliefBase; flush $tmpFid} errorMesg]} { agt_puts "Failed to save Belief-Base:\n$errorMesg\n" return 2 } catch {close $tmpFid} agt_puts "Saved Belief-Base to file '$fileName'.\n" return 0 } # # agt_loadBelBase # # Loads a Belief-Base from a file in directory 'ideas/save'. # # Arguments: # # fileName - name (path) of file to load from # # Results: # # 0 - everything ok # 1 - prolog returned error # # Shows an message in logfile. # proc agt_loadBelBase {fileName} { # if extension of fileName is .pl remove it # if {[cequal [file extension $fileName] .pl]} { set fileName [csubstr $fileName 0 [expr [clength $fileName]-3]] } # reconsult the file if {[catch {agt_quietQuery "reconsult('save/$fileName')"} \ errorMesg]} { agt_puts "Failed to load Belief-Base:\n$errorMesg\n" return 1 } agt_displayBelBase agt_puts "Loaded Belief-Base from file '$fileName.pl'.\n" return 0 } ideas/agt_chgStatus.tcl100640 764 764 2753 6050144165 14466 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_chgStatus # # Handles a status change for the agent. # # Arguments: # # replyTo - number to reply with status mesg to UAM # # Results: # # None. # proc agt_chgStatus {replyTo} { global agents # change the STATUS entry in array 'agents' # and display the bitmap for agent in his 'path-view' weak or solid (resp.): if {[keylget agents(SELF) STATUS] == "act"} { keylset agents(SELF) STATUS deact agt_drawWeak SELF } else { keylset agents(SELF) STATUS act agt_drawSolid SELF } # build up a statusinfo-message to send back to UAM: keylset identifikation NAME [keylget agents(SELF) NAME] keylset identifikation TYPE [keylget agents(SELF) TYPE] keylset identifikation STATUS [keylget agents(SELF) STATUS] keylset mesg :RECEIVER UAM :TYPE statusinfo \ :IDFK $identifikation :REPLY-TO $replyTo agt_send $mesg } ideas/agt_commCtrl.tcl100640 764 764 10021 6115063171 14303 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # agt_commCtrl # # Procedure for controlling incomming pipes. # # agt_commCtrl is called by addinput whenever an event occurs # on an incoming pipe. # The event is analysed and it is checked if pipe is broken. # If not, message is read from pipe and put in the FIFO for # incoming messages or the agent deals with it directly, if it # is a command-message from his UAM. # # Arguments: # # fid - pipe identifier # agtName - name of agent pipe comes from # (may be 'unknown') # # Results: # # None # proc agt_commCtrl {fid agtName} { global agents agt_RecMesgList SELF # it follows a special hack: # # there were problems when building connections across the net to # other hosts; socket building works, but when a message is sent # reading causes an error, 'Resource temporarily unavailable' # # it seems to me that it is an delay error: # the signal for addinput seems to be faster as the mesg # # the following catches these error until the mesg can be read... # # not nice but it works # while {[catch {set readResult [gets $fid mesg]}]} {} # if the empty string is read the connection is broken # if {$readResult == -1} { # broken connection detected agt_conBroken $fid $agtName return } if {[catch {keylget mesg :SENDER sender}]} { # the mesg has a currupted format and will be # dismissed by 'agt_evalMesg' later; # put it in mesg-buffer with priority 1 for that lappend agt_RecMesgList(1) [list $fid $mesg] return } if {[cequal $sender UAM]} { # in this case the received message has :SENDER UAM # if {![cequal $fid stdin]} { # in this case the mesg was not received on UAM's pipe - stdin, # so forget it # agt_puts "Received a message with sender 'UAM' not from UAM:\n$mesg \ \nMessage ignored!\n" return } elseif {[cequal [keylget mesg :TYPE] command]} { # this is an UAM-command-mesg, so append it to the mesg-buffer # agt_RecMesgList(-1) which has highest priority: lappend agt_RecMesgList(-1) [list $fid $mesg] } else { # this is a 'normal' mesg from UAM, so append it to the mesg-buffer # according to the :PRIORITY of the mesg or agt_RecMesgList(1) # by default: if {(![keylget mesg :PRIORITY priority]) || \ (![regexp ^1$|^2$|^3$ $priority])} { keylset mesg :PRIORITY 1 set priority 1 } lappend agt_RecMesgList($priority) [list $fid $mesg] } } elseif {[cequal $sender $SELF]} { if {![cequal $fid [keylget agents(SELF) INFID]]} { agt_puts "Received a message with sender '$SELF' not from SELF:\n$mesg \ \nMessage ignored!\n" return } # this message is from the agent himself, so put it in the mesg-buffer # agt_RecMesgList(0), which is for SELF mesgs only, if no lower priority # is specified: # if {(![keylget mesg :PRIORITY priority]) || \ (![regexp ^0$|^1$|^2$|^3$ $priority])} { keylset mesg :PRIORITY 0 set priority 0 } lappend agt_RecMesgList($priority) [list $fid $mesg] } else { # the mesg is from an other agent, so put it in the mesg-buffer # that belongs to the mesg :PRIORITY, agt_RecMesgList(1) by # default # if {(![keylget mesg :PRIORITY priority]) || \ (![regexp ^1$|^2$|^3$ $priority])} { keylset mesg :PRIORITY 3 set priority 3 } lappend agt_RecMesgList($priority) [list $fid $mesg] } } ideas/agt_conBroken.tcl100640 764 764 4321 6050144165 14432 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_conBroken # # Handles a broken connection on fid, # closes pipes to/from agent. # # Arguments: # # fid - name of broken pipe # agtName - name of agent pipe 'fid' comes from # # Results: # # None # proc agt_conBroken {fid agtName} { global agents SELF OTHER global agt_VarComFilter catch {fileevent $fid readable ""} # remove pipes from/to agent # catch {close $fid} catch {close [keylget agents($agtName) OUTFID]} agt_puts "Connection $fid to agent '$agtName'\ broken!\n" if {[lsearch $agt_VarComFilter $agtName] != -1} { agt_logComm "Communication with agent '$agtName' broken!\n" } if {[cequal $agtName $SELF]} { # if the pipe leads from/to SELF build up a new one: keyldel agents(SELF) OUTFID keyldel agents(SELF) INFID agt_puts "Pipe to SELF broken !\nRebuilding now ... " 0 # open new pipe to send messages to the agent himself # and set commCtrl on it pipe in out keylset agents(SELF) INFID $in \ OUTFID $out fileevent $in readable "agt_commCtrl $in $SELF" agt_puts "ready\n" } else { # if the pipe not leads to SELF forget everything about the agent # the pipe belongs to: catch {unset OTHER($agtName)} agt_delAgtBitmap $agtName catch {unset agents($agtName)} } # if the file is 'stdin' the connection to UAM is broken; # display the 'Exit'-menu in the menuebar of the agent to enable # a correct quit: if {[cequal $fid stdin]} { pack .mbar.exit -side left -padx 2m tk_menuBar .mbar .mbar.view .mbar.exit .mbar.help bind all {agt_exit} } } ideas/agt_conDetected.tcl100640 764 764 2277 6115063171 14742 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_conDetected # # Invoked by an event on agents base socket; # agt_conDetected accepts a new connection and sets # communication control on it. # # Arguments: # # socket - identifier of the socket # # Results: # # None # proc agt_conDetected {socket} { global agents # read event detected: # try to catch a new connection # if {[catch {set conID [server_accept -buf $socket]}]} { agt_puts "Acception on $socket failed!\n" } else { agt_puts "Connection detected: $conID\n" fileevent $conID readable "agt_commCtrl $conID unknown" } } ideas/agt_createCon.tcl100640 764 764 2617 6115063171 14422 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_createCon # # This procedure tries to establish a socket connection to an # specified agent address. # # Arguments: # # agtAddr - address of agent to connect to; form: 'host.port' # # Results: # # Returns an fileID for the connection or generates an error # and returns an error message. # proc agt_createCon {agtAddr} { # get agents host and port from agtAddr by splitting it: # Form: host.port # set a [expr [string last . $agtAddr ]-1] set agtHost [string range $agtAddr 0 $a] incr a 2 set agtPort [string range $agtAddr $a end] # open the connection to the host and port # if [catch {set conID [server_connect -buf $agtHost $agtPort]}] { return -code error "connection refused" } else { agt_puts "conID: $conID" return $conID } } ideas/uam_mesgToProcs.tcl100640 764 764 20001 6050375557 15012 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_initMesgTo # # Initializes the widget .mesgTo for defining mesges to agents. # The widget is shown when button 'Message To' in UAM is invoked. # # Arguments: None. # # Results: None. # proc uam_initMesgTo {} { global ideas_KeyNumber # create a new toplevel widget .MESGTO # catch {destroy .mesgTo} toplevel .mesgTo wm title .mesgTo "Message To" wm iconname .mesgTo "MesgTo" wm withdraw .mesgTo # divide the widget in three frames: # one at the bottom for some buttons # frame .mesgTo.bot pack .mesgTo.bot -side bottom -fill both -pady 5 # and two big vertical frames, the left one for mesg keys # the right one for the content of each key # frame .mesgTo.left -width 15 -bd 3 pack .mesgTo.left -side left frame .mesgTo.right -bd 3 pack .mesgTo.right -side left -fill x -expand 1 # create OK, Shortcuts and Cancel buttons at bottom of toplevel # button .mesgTo.ok -text OK \ -width 8 \ -command {uam_mesgToOK} frame .mesgTo.default -relief sunken -bd 1 raise .mesgTo.ok .mesgTo.default pack .mesgTo.default -in .mesgTo.bot -side left \ -expand 1 -padx 3m -pady 2m pack .mesgTo.ok -in .mesgTo.default -padx 1m -pady 1m \ -ipadx 2m -ipady 1m button .mesgTo.short -text Shortcuts \ -width 8 \ -command { set dad .mesgTo set x [expr [winfo x $dad] - ([winfo reqwidth .shorts]+50)] if {$x < 0} { set x 0 } set y [expr round([winfo y $dad])] wm geom .shorts +$x+$y if {[winfo ismapped .shorts]} { raise .shorts } else { wm deiconify .shorts } update } pack .mesgTo.short -in .mesgTo.bot -side left \ -padx 2m -pady 1m -ipadx 2m -ipady 1m button .mesgTo.cancel -text Cancel \ -width 8 \ -command {wm withdraw .mesgTo; focus .mbar} pack .mesgTo.cancel -in .mesgTo.bot -side left \ -padx 2m -pady 1m -ipadx 2m -ipady 1m bind .mesgTo.ok {.mesgTo.ok flash .mesgTo.ok invoke} bind .mesgTo.ok {.mesgTo.cancel flash .mesgTo.cancel invoke} # at top of toplevel show headline # 'Key Content' above the frames for this label .mesgTo.l1 -text Key -anchor w pack .mesgTo.l1 -in .mesgTo.left -side top -fill x label .mesgTo.l2 -text Content -anchor w pack .mesgTo.l2 -in .mesgTo.right -side top -fill x # create entry widgets in rows for input of keys .k # and content .c set keyNumber $ideas_KeyNumber for {set i 1} {$i <= $keyNumber} {incr i} { global uam_VarKey uam_VarCont catch {unset uam_VarKey($i); unset uam_VarCont($i)} entry .mesgTo.k$i -textvariable uam_VarKey($i) \ -width 15 \ -relief sunken pack .mesgTo.k$i -in .mesgTo.left -side top -pady 1 entry .mesgTo.c$i -textvariable uam_VarCont($i)\ -exportselection 1 \ -relief sunken pack .mesgTo.c$i -in .mesgTo.right -side top -pady 1 \ -fill x # set up the bindings for the entries: # jump from field to field with Tab or arrows, end with # Return or Escape bind .mesgTo.k$i {uam_initHelp mesgTo.hlp} bind .mesgTo.k$i {uam_initHelp mesgTo.hlp} bind .mesgTo.c$i {uam_initHelp mesgTo.hlp} bind .mesgTo.c$i {uam_initHelp mesgTo.hlp} bind .mesgTo.k$i {.mesgTo.cancel flash .mesgTo.cancel invoke} bind .mesgTo.c$i {catch {%W insert insert [selection get]}} bind .mesgTo.c$i {.mesgTo.cancel flash .mesgTo.cancel invoke} bind .mesgTo.c$i {.mesgTo.ok flash .mesgTo.ok invoke} bind .mesgTo.c$i "focus .mesgTo.c[expr $i-1]" bind .mesgTo.k$i "focus .mesgTo.c$i" bind .mesgTo.k$i "focus .mesgTo.c$i" bind .mesgTo.k$i "focus .mesgTo.c$i" bind .mesgTo.k$i "focus .mesgTo.c[expr $i-1]" bind .mesgTo.k$i "focus .mesgTo.k[expr $i-1]" bind .mesgTo.c$i "focus .mesgTo.k[expr $i+1]" bind .mesgTo.c$i "focus .mesgTo.k[expr $i+1]" bind .mesgTo.c$i "focus .mesgTo.c[expr $i+1]" bind .mesgTo.k$i "focus .mesgTo.k[expr $i+1]" bind .mesgTo.c$i "focus .mesgTo.k[expr $i]" bind .mesgTo.k$i {uam_exit} bind .mesgTo.c$i {uam_exit} } bind .mesgTo.c2 "focus .mesgTo.c3" bind .mesgTo.c2 "focus .mesgTo.c3" bind .mesgTo.c2 "focus .mesgTo.c$keyNumber" bind .mesgTo.c2 "focus .mesgTo.c$keyNumber" bind .mesgTo.c3 "focus .mesgTo.c2" bind .mesgTo.c$keyNumber "focus .mesgTo.c2" bind .mesgTo.c$keyNumber "focus .mesgTo.c2" bind .mesgTo.c$keyNumber "focus .mesgTo.c2" bind .mesgTo.k4 "focus .mesgTo.k$keyNumber" bind .mesgTo.k$keyNumber "focus .mesgTo.k4" # make some entries unvisible that user should not edit # set uam_VarKey(1) ":SENDER" set uam_VarCont(1) "UAM" .mesgTo.k1 configure -state disabled -relief flat .mesgTo.c1 configure -state disabled -relief flat set uam_VarKey(2) ":RECEIVER" .mesgTo.k2 configure -state disabled -relief flat set uam_VarKey(3) ":TYPE" .mesgTo.k3 configure -state disabled -relief flat update } # # uam_mesgTo # # Provides an UAM-tool to send messages to agents selected # from agent list. # It displays the toplevel widget .mesgTo created in uam_initMesgTo # # Arguments: # # None. # # Results: # # None. # proc uam_mesgTo {} { global uam_VarKey uam_VarCont # see how big the widgets want to be and place the toplevel # on the screen right in the middle of its parent widget # set dad [winfo parent .mesgTo] set x [expr [winfo x $dad] + ([winfo reqwidth $dad] - [winfo reqwidth .mesgTo])/2] set y [expr round([winfo y $dad] + [winfo reqheight $dad]*0.3)] wm geom .mesgTo +$x+$y if {[winfo ismapped .mesgTo]} { raise .mesgTo update } set sel [.frame1.list curselection] set targetList "" # build a list of selected agent names # foreach i $sel { set listentry [.frame1.list get $i] lappend targetList [lindex $listentry 0] } set uam_VarCont(2) $targetList set uam_VarCont(3) "" for {set i 4} {$i <= [array size uam_VarCont]} {incr i} { set uam_VarKey($i) "" set uam_VarCont($i) "" } wm deiconify .mesgTo update if {$targetList == ""} { focus .mesgTo.c2 } else { focus .mesgTo.c3 } } # # uam_mesgToOK # # Called by uam_mesgTo when the OK-button is invoked. # Checks if each specified key has a content and builts # up the mesg for sending. # # Arguments: # # None. # # Results: # # None. # proc uam_mesgToOK {} { global uam_VarKey uam_VarCont for {set i 1} {$i <= 6} {incr i} { if {![lempty $uam_VarKey($i)]} { if {![lempty $uam_VarCont($i)]} { # set a ":" before the key if necessary and convert # all chars to upper chars # set uam_VarKey($i) [string trim $uam_VarKey($i)] set uam_VarCont($i) [string trim $uam_VarCont($i)] if {![cequal [cindex $uam_VarKey($i) 0] ":"]} { set uam_VarKey($i) [string toupper :$uam_VarKey($i)] } else { set uam_VarKey($i) [string toupper $uam_VarKey($i)] } keylset mesg $uam_VarKey($i) $uam_VarCont($i) } else { BEEP focus .mesgTo.c$i return } } } uam_sendMesg $mesg } ideas/agt_doTypeInits.tcl100640 764 764 3432 6050144165 14767 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_doTypeInits # # Invoke the parsing of agents ASL-script. # Sends an error-mesg to UAM if error occurs, or # an init-mesg to himself, if not. # # Arguments: # # None. # # Results: # # None. # proc agt_doTypeInits {} { global agents SELF agt_MesgRules global agt_VarInitialization agt_VarStdMesgRuleNo global agt_RecMesgList # read the standard initial Belief-Base # keylget agents(SELF) PROLOG prologFd if {[agt_loadBelBase agt_stdBelBase]} { return } # read the standard Message-Rules agt_sourceStdMesgRules # start reading the ASL file: # agt_puts "Start parsing ASL-Script:\n" keylget agents(SELF) TYPE fileName if {[catch {agt_parseDescFile $fileName} errorMesg]} { agt_puts "$errorMesg\n\nInitialisation not completed!\n" keylset mesg :TYPE asl-error :RECEIVER UAM set agt_VarInitialization 0 } else { agt_puts "End of script parsing.\n" keylset mesg :TYPE initialization \ :RECEIVER $SELF # set global variable 'agt_VarInitialization' to 1, i.e. if the agent # will eval the 'initialization' message set agt_VarInitialization 1 } agt_send $mesg catch {agt_displayBelBase} } ideas/agt_evalMesg.tcl100640 764 764 16271 6526013026 14303 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_evalMesg # # Tries to match an received message with agents mesg-rules # and to evalute a matching rule. # # Arguments: # # agt_VarFid - file descriptor mesg arrived on # agt_VarMesg - mesg just received # # Results: # # Side effects belonging to evaluation of the mesg rules. # proc agt_evalMesg {agt_VarFid agt_VarMesg} { global agents agt_MesgRules SELF OTHER global agt_VarBreakEval agt_VarInitialization global agt_VarComFilter global agt_VarStdMesgRuleNo keylget agents(SELF) NAME SELF # set the actual time in Prolog agt_timeSet # display received message if {[catch {set agt_VarText [agt_formatMesg $agt_VarMesg]} errorMesg]} { # Format error in received mesg # send back an error to sender # # search for the agent belonging to the fid: foreach agt_VarAgtName [keylkeys agents] { if {[keylget agents($agt_VarAgtName) INFID] == $agt_VarFid} { break } } keylset agt_VarRespMesg :RECEIVER $agt_VarAgtName :TYPE error \ :CODE 1 :COMMENT "message format error" if {[keylget agt_VarMesg :REPLY-WITH replyWith]} { keylset agt_VarRespMesg :REPLY-TO $replyWith } agt_send $agt_VarRespMesg agt_puts "FORMAT ERROR when receiving :\n$agt_VarMesg\nFailure:\ '$errorMesg'\n" return } agt_puts "Message received\n$agt_VarText" keylget agt_VarMesg :SENDER mesgSender regsub $SELF $mesgSender SELF mesgSender foreach name $agt_VarComFilter { if {[lsearch $mesgSender $name] != -1} { agt_logComm "Message received from '$name'\n$agt_VarText" } } # initialize a variable that shows if a rule matched this mesg: set agt_VarRuleMatch 0 #run through all MesgRules # set agt_VarMaxRule [array size agt_MesgRules] for {set agt_VarRuleNo 1} {$agt_VarRuleNo <= $agt_VarMaxRule} \ {incr agt_VarRuleNo} { # initialize the evaluation break variable with NO set agt_VarBreakEval 0 # get actual rule set agt_VarActRule $agt_MesgRules($agt_VarRuleNo) # get the pattern for the mesgForm from actRule set agt_VarMesgForm [lindex $agt_VarActRule 0] # test if listlengths of form is less than that of mesg, # if not take next MesgRule if {[llength $agt_VarMesgForm] > [llength $agt_VarMesg]} { continue } # get the keylist of received mesg set agt_VarMesgKeys [keylkeys agt_VarMesg] # get the keylist of mesgForm set agt_VarFormKeys [keylkeys agt_VarMesgForm] # test if keylists of form is included in that of mesg, # if not take next MesgRule set agt_VarKeyError 0 foreach agt_VarKey $agt_VarFormKeys { if {[lsearch $agt_VarMesgKeys $agt_VarKey] == -1} { set agt_VarKeyError 1 break } } if {$agt_VarKeyError} {continue} # try to match the rule with the message: set agt_VarMatchError 0 set agt_VarKeyValue "" # run through all mesgForm keys foreach agt_VarKey $agt_VarFormKeys { keylget agt_VarMesgForm $agt_VarKey agt_VarPattern keylget agt_VarMesg $agt_VarKey agt_VarMatch # try to match the actual key of mesg with the agt_VarPattern # in mesgForm if {![agt_keyPattMatches $agt_VarPattern $agt_VarMatch]} { set agt_VarMatchError 1 break } keylset agt_VarKeyValue $agt_VarKey $agt_VarMatch } # if the matching failed take next MesgRule if {$agt_VarMatchError} { continue } # in this case the rule matches the message, so eval it: set agt_VarRuleMatch 1 # get the MesgCond of the actRule and eval it: set agt_VarMesgCond [lindex $agt_VarActRule 1] # eval MesgCond and catch errors if {[catch {set agt_VarCondResult [expr $agt_VarMesgCond]} errorMesg]} { agt_puts "Error when evaluating Message-Rule No. $agt_VarRuleNo,\ message condition:\n'$agt_VarMesgCond'" agt_logMesgEval "\nError when evaluating Message-Rule No. $agt_VarRuleNo,\ message condition:\n'$agt_VarMesgCond'" if [info exists errorMesg] { agt_puts "Error: $errorMesg\n" agt_logMesgEval "Error: $errorMesg" } agt_tracepoint continue } if {$agt_VarCondResult != 0} { set index 2 } else { set index 3 } # depending on result of MesgCond choose the action from rule, # eval it and catch errors set agt_VarAction [lindex $agt_VarActRule $index] # mesg-rule control output if {$agt_VarRuleNo > $agt_VarStdMesgRuleNo} { agt_logMesgEval "\nEvaling Message-Rule No. $agt_VarRuleNo:\nMesg-Form:\ \t$agt_VarMesgForm\nVar-Values:\t$agt_VarVariableValues\nMesg-Cond:\ \t($agt_VarMesgCond) evals to\ $agt_VarCondResult\nAction:\t\t($agt_VarAction)" } if {[catch {eval $agt_VarAction} errorMesg]} { agt_puts "Error when evaluating Message-Rule No. $agt_VarRuleNo,\ action:\n'$agt_VarAction'" agt_logMesgEval "\nError when evaluating Message-Rule No. $agt_VarRuleNo,\ action:\n'$agt_VarAction'" if [info exists errorMesg] { agt_puts "Error: $errorMesg\n" agt_logMesgEval "Error: $errorMesg" } agt_tracepoint } # if 'agt_break' is called in the action break the evaluation: # if {$agt_VarBreakEval} { break } # eval the standard action of the rule which is # done independent of MesgCond set agt_VarStdAction [lindex $agt_VarActRule 4] if {$agt_VarRuleNo > $agt_VarStdMesgRuleNo} { agt_logMesgEval "Std-Action:\t($agt_VarStdAction)" } if {[catch {eval $agt_VarStdAction} errorMesg]} { agt_puts "Error when evaluating Message-Rule No. $agt_VarRuleNo,\ standard-action:\n'$agt_VarStdAction'" agt_logMesgEval "\nError when evaluating Message-Rule No. $agt_VarRuleNo,\ standard-action:\n'$agt_VarStdAction'" if [info exists errorMesg] { agt_puts "Error: $errorMesg\n" agt_logMesgEval "Error: $errorMesg" } agt_tracepoint } # if 'agt_break' is called in the action break the evaluation: # if {$agt_VarBreakEval} { break } } # if no rule matches the message send back an error message # to the sender of the message: # if {!$agt_VarRuleMatch} { keylset agt_VarRespMesg :RECEIVER [keylget agt_VarMesg :SENDER] :TYPE error \ :CODE 2 :COMMENT "no match for message" \ :REPLY-TO [keylget agt_VarMesg :REPLY-WITH] agt_send $agt_VarRespMesg } agt_puts "End of message evaluation!\n" } # # agt_break # # Sets global variable agt_VarBreakEval to 1. This is used to break evaluation # of a message in agt_evalMesg # # Arguments: None. # # Results: # # global agt_VarBreakEval is 1 # proc agt_break {} { global agt_VarBreakEval set agt_VarBreakEval 1 } ideas/agt_exit.tcl100640 764 764 2736 6050144165 13473 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_exit # # Handles the correct exit of the agent and # cleans up some stuff. # # Arguments: # # None # # Results: # # None # proc agt_exit {} { global agents SELF global agt_VarMesgEvalSave agt_VarCommSave keylget agents(SELF) SOCKET socketId catch {removeinput $socketId} catch {close $socketId} set fileNo [keylget agents(SELF) FILENO] set endTime [getclock] agt_puts "Logfile closed at [fmtclock $endTime "%a %b %d %Y, %T"]\n" agt_logMesgEval "Message evaluation Logfile closed at\ [fmtclock $endTime "%a %b %d %Y, %T"]\n" agt_logComm "Communication Logfile closed at\ [fmtclock $endTime "%a %b %d %Y, %T"]\n" update if {!$agt_VarMesgEvalSave} { catch {exec rm "logfiles/$SELF.$fileNo.msg"} } if {!$agt_VarCommSave} { catch {exec rm "logfiles/$SELF.$fileNo.com"} } exit } ideas/agt_formatMesg.tcl100640 764 764 3773 6050144165 14630 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_formatMesg # # Formats a mesg so that it can be printed in a 'nice' form in logfile. # # Arguments: # # mesg - mesg to format # # Results: # # Returns a string, that includes all parts of the mesg. # Keys are separated from their contents by Tabs and ':'. # Returns an error if format of keyedlist in mesg is wrong. proc agt_formatMesg {mesg} { # first look for :SENDER, :RECEIVER, :TYPE and put this keys # in front of text; # then append all the other keys in alphabetical order # if {![keylget mesg :SENDER mesgSend]} { return -code error ":SENDER specification missing" } else { append text ":SENDER\t\t: $mesgSend\n" keyldel mesg :SENDER } if {![keylget mesg :RECEIVER mesgRecv]} { return -code error ":RECEIVER specification missing" } else { append text ":RECEIVER\t: $mesgRecv\n" keyldel mesg :RECEIVER } if {![keylget mesg :TYPE mesgType]} { return -code error ":TYPE specification missing" } else { append text ":TYPE\t\t: $mesgType\n" keyldel mesg :TYPE } if {[catch {set keyList [lsort [keylkeys mesg]]} errorMesg]} { return -code error $errorMesg } foreach key $keyList { append text "[string toupper $key]\t" if {[string length $key] < 8} { append text "\t" } if {[catch {append text ": [keylget mesg $key]\n"}]} { return $mesg } } return $text } ideas/agt_getHandshake.tcl100640 764 764 6411 6050144165 15102 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_getHandshake # # Reacts to a handshake received on an incoming pipe. # # Arguments: # # inFid - identifier of incomming pipe # agtName - name of agent that sent rehandshake # agtIdfk - identifikation information of that agent # replyTo - number to reply with proc agt_getHandshake {inFid agtName agtIdfk replyTo} { global agents OTHER catch {removeinput $inFid} # initialize flags for registering agents identifikation # and sending a confirmation mesg # set register 0 set send_handshake 0 # check if connection to senders address exists # # get agents address from received identifikation: # keylget agtIdfk ADDR recAddr set fid_found 0 foreach name [array name agents] { if {[keylget agents($name) ADDR] == $recAddr} { set fid_found 1 break } } if {!$fid_found} { # this is a connection setup: # create an outgoing pipe, register agent identifikation # and response with a handshake message # if {[catch {set outFid [agt_createCon $recAddr]}]} { agt_puts "Connection to $agtName failed!\n" catch {unset agents($agtName)} catch {close $inFid} return } set register 1 set send_handshake 1 } else { # there is an entry for this address, so this is the # confirmation of the connection: # # if the connection is fully established do nothing, # else register agents idetifikation under his name # if {[keylget agents($name) INFID {}] == 0} { # there must be a filedesc for outgoing mesgs # keylget agents($name) OUTFID outFid # remove old array entry # unset agents($name) # delete old agent bitmap # agt_delAgtBitmap $name set register 1 } } # set communication control back on the incoming pipe - if not broken # if {[catch { fileevent $inFid readable "agt_commCtrl $inFid $agtName" }]} { agt_conBroken $inFid $agtName return } if {$register} { # register agents identifikation # set agents($agtName) $agtIdfk # display the agent bitmap with a solid connection # agt_displAgtBitmap $agtName agt_drawSolid $agtName keylset agents($agtName) INFID $inFid \ OUTFID $outFid set OTHER($agtName) $recAddr agt_puts "Registered: $agents($agtName)\n" } if {$send_handshake} { # send a handshake for confirmation to sender # keylset idfk NAME [keylget agents(SELF) NAME] \ TYPE [keylget agents(SELF) TYPE] \ ADDR [keylget agents(SELF) ADDR] keylset response :RECEIVER $agtName :TYPE handshake \ :IDFK $idfk :REPLY-TO $replyTo agt_send $response } } ideas/agt_tracepoint.tcl100640 764 764 2232 6050144166 14662 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_tracepoint # # Sets a tracepoint for the agent. # In trace-mode the agent will stop when calling this proc # and the user has to awake it by pressing the 'Wake Up'-button. # # Arguments: None. # # Results: None. # # proc agt_tracepoint {} { global agt_VarTraceEnable agt_VarWakeUp # check if agent is in trace mode if {!$agt_VarTraceEnable} { return } .trace.wakeup configure -state normal # wait for 'wake Up#-button to be pressed: tkwait variable agt_VarWakeUp .trace.wakeup configure -state disabled } ideas/agt_keyPattMatches.tcl100640 764 764 7226 6050144165 15447 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_keyPattMatches # # Tries to match a key pattern of a mesg rule with a # key content of a received mesg. # Called by agt_evalMesg. # # Arguments: # # pattern - pattern to match with # match - string that should be matched # # Results: # # Returns 1 if the match was successful. In this case the # variables of the pattern are bounded to values of the # match in the context of the calling procedure, so that # they can be used for evalling mesg cond and actions. # If matching fails 0 is returned. # proc agt_keyPattMatches {pattern match} { upvar agt_VarVariableValues variableValues # this is a variable used to print the actual values of # variables in mesg-form, initialize it as an empty string set variableValues "" # indexcounter for pattern set ctp 0 # indexcounter for match set ctm 0 # counter for number of variables in pattern set ctVar 0 # flag that causes variable recognition in pattern set varCheck 1 # get length of pattern and match set lenp [string length $pattern] set lenm [string length $match] # start matching while {$ctp <= $lenp} { set chp [cindex $pattern $ctp] set chm [cindex $match $ctm] if {[cequal $chp "~"]} { if {[cindex $pattern $ctp+1] == "~"} { incr ctp set chp [cindex $pattern $ctp] } else { # set varCheck off set varCheck 0 incr ctp continue } } if {$varCheck && [ctype upper $chp]} { # prefix of variable in pattern detected incr ctVar # read name of variable, # i. e. char of form a-z, A-Z, 0-9, _ while {([ctype alnum $chp] || [cequal $chp _])} { append varName($ctVar) $chp incr ctp set chp [cindex $pattern $ctp] } # $chp is now separator after varName # initialize variable named $varName($ctVar) at # one level up upvar $varName($ctVar) localVar$ctVar catch {unset localVar$ctVar} #puts "varName:($ctVar) >$varName($ctVar)<"; flush stdout set varCont($ctVar) "" # read char from match until separator or end of match # is reached while {(![cequal $chm $chp]) && ($ctm <= $lenm)} { append varCont($ctVar) $chm incr ctm set chm [cindex $match $ctm] } #puts "varCont($ctVar): >$varCont($ctVar)<"; flush stdout # if end of match is reached befor separator is read # matching failed if {$ctm > $lenm} { return 0 } # else content for variable is examined and saved in # varCont($ctVar), so continue matching #set varCheck on set varCheck 1 continue } # in case of no variable in pattern # just compare the actual characters if [cequal $chp $chm] { incr ctp incr ctm } else { return 0 } # set varCheck on set varCheck 1 } # if strings are completely matched set varCont to its # variable at upper level for {set ct 1} {$ct <= $ctVar} {incr ct} { set localVar$ct $varCont($ct) lappend variableValues "$varName($ctVar) $varCont($ct)" } return 1 } ideas/agt_loadDescPart.tcl100640 764 764 3061 6050144165 15057 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_loadDescPart # # Loads a part of agent description from a file as # specified in a 'load ' statement in type file # # Arguments: # # typeFile (referenz) - list of lines of agt type file not # scanned till now # fileName - file to read # # Results: # # Set 'typeFile' as the concatenation of the lines list read # from fileName with the old 'typeFile'. # Shows an error message, if 'fileName' is not readable. # proc agt_loadDescPart {typeFile fileName} { upvar $typeFile file # try to open file 'fileName' in directory 'desc' if {[catch {set fid [open desc/$fileName]} errorMesg]} { agt_puts "Error when loading '$fileName':" if {[info exists errorMesg]} { agt_puts "$errorMesg\n" } return } # read file and split it in lines set data [split [read $fid] \n] close $fid # concat the just read part and the old one set file [concat $data $file] agt_puts "Loaded: $fileName\n" } ideas/uam_handleASLError.tcl100640 764 764 2764 6050144166 15340 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_handleASLError # # When an agent parses an ASL-Syntax-Error it sends an error message to # the UAM. The UAM catches the message by a MesgRule, which # calls this procedure to show a warning to the user. # # Arguments: # # realFid - filedesc the mesg arrived on # agtName - sender of mesg # # Results: None. # proc uam_handleASLError {realFid agtName} { global agents # check if the mesg really arrived on the file belonging to this agent # if {[catch {keylget agents($agtName) FID agtFid}]} { uam_logText "WARNING - received ASL-Error-Message on foreign FID:\ $fid\nMessage ignored!\n" return } # show a mesg in a toplevel widget # BEEP uam_dialog "Script Error" "ASL-Syntax-Error\n\nwhen initializing \ agent\n\n $agtName\n\nSee agents logfile for details!" \ center error left 0 -1 OK } ideas/agt_openSocket.tcl100640 764 764 3015 6115063171 14622 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_openSocket # # Opens a TCP-socket for listening to connections to other agents. # # Arguments: # # agtHost - host of this agent # # Results: # # Sets agents entry for SELF to correct NAME, SOCKET and ADDR # # proc agt_openSocket {} { global agents # the agent tries to get this portno first: set portNo 1200 # if it is not free it takes the next higher, if possible, up to a upper border: # keylget agents(SELF) HOSTIP agtHost_ip while {[catch {set socketId [server_create -myip $agtHost_ip \ -myport $portNo \ -backlog 50]} errMesg]} { if {$portNo < 2000} { incr portNo 1 } else { set portNo 1200 } } keylset agents(SELF) ADDR [keylget agents(SELF) HOSTIP].$portNo keylset agents(SELF) SOCKET $socketId keylset agents(SELF) NAME "[keylget agents(SELF) NAME].$portNo" return } ideas/agt_parseDescFile.tcl100640 764 764 15023 6050144165 15244 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_parseDescFile # # Reads the agents description file and calls # procs to parse ACTION-C-SOURCE, BELIEFS, # BELIEF-RULES, MESSAGE-RULES, ACTIONS # and to initialize their stuff. # # Arguments: # # fileName - name of file to parse # # Results: # # Returns an error with error message when a parsing # error occurs. # proc agt_parseDescFile {fileName} { # try to open fileName in directory 'desc' for reading if {[catch {set fid [open desc/$fileName]} errorMesg]} { return -code error $errorMesg } # read file and split it in lines set file [split [read $fid] \n] close $fid # # This is the initial situation for parsing: # Variable 'file' is a list containing the content of agents type file, # each list entry is one line of type file. # Line by line is popped from this list and the actual line to parse # is hold in variable 'line'. So 'line' and 'file' allways contain the # unparsed rest of the type file. # # pop the first line from file and remove leading and # succeeding white spaces set line [string trim [lvarpop file]] # As described in the ASL-Syntax the type file has 5 parts which have # to occure in a fixed order. The variable 'itemCt' is used to count this # parts and shows which parts are legal next, belonging to the following list: # # <= 0 ACTION-C-SOURCE # <= 1 BELIEFS # <= 2 BELIEF-RULES # <= 3 MESSAGE-RULES # <= 4 ACTIONS # set itemCt 0 # start parsing 'file' line by line # while {1} { switch -regexp $line { ^$|^# { # This is an empty line or a remark, so get the next line # frome 'file' if it is not empty if {[llength $file] == 0} { return -code ok } set line [string trim [lvarpop file]] } ^load { # This is a 'load' command to load a description part from # a file specified in the rest of this line agt_loadDescPart file [string trimleft [csubstr $line 4 end]] # get the next line from file set line [string trim [lvarpop file]]} ^ACTION-C-SOURCE { # Check the 'itemCt' if a 'ACTION-C-Source' declaration # is legal at this position (see above list) if {$itemCt > 0} { return -code error \ "ASL-Syntax-Error:\nno ACTION-C-SOURCE declaration\ expected at '$line'" } # remove 'ACTION-C-SOURCE' and following spaces from line set line [string trimleft [crange $line 15 end]] # call 'agt_parseActSrc' to read the source specification if {[catch {agt_parseActSrc file line} errorMesg]} { return -code error \ "ASL-Syntax-Error - ACTION-C-SOURCE:\n$errorMesg" } # set 'itemCt' to 1, i. e. ASL-part to read next must have # an index greater or equal 1 in above list set itemCt 1 } ^BELIEFS {if {$itemCt > 1} { return -code error \ "ASL-Syntax-Error:\nno BELIEF declaration\ expected at '$line'" } # remove 'BELIEFS' and following spaces from line set line [string trimleft [crange $line 7 end]] # call 'agt_parseInits' with index 1 to read the initial # beliefs and insert them in BeliefBase. if {[catch {agt_parseInits file line 1} errorMesg]} { return -code error \ "ASL-Syntax-Error - BELIEFS:\n$errorMesg" } set itemCt 2 } ^BELIEF-RULES { if {$itemCt > 2} { return -code error \ "ASL-Syntax-Error:\nno BELIEF-RULES declaration\ expected at '$line'" } # remove 'BELIEF-RULES' and following spaces from line set line [string trimleft [crange $line 12 end]] # call 'agt_parseInits' with index 2 to read the # belief-rules and insert them in BeliefBase. if {[catch {agt_parseInits file line 2} errorMesg]} { return -code error \ "ASL-Syntax-Error - BELIEF-RULES:\n$errorMesg" } set itemCt 3 } ^MESSAGE-RULES { if {$itemCt > 3} { return -code error \ "ASL-Syntax-Error: no MESSAGE-RULES declaration\ expected at '$line'" } # remove 'MESSAGE-RULES' and following spaces from line set line [string trimleft [crange $line 13 end]] # call 'agt_parseInits' with index 3 to read the # message-rules. if {[catch {agt_parseInits file line 3} errorMesg]} { return -code error \ "ASL-Syntax-Error - MESSAGE-RULES:\n$errorMesg" } set itemCt 4 } ^ACTIONS { if {$itemCt > 4} { return -code error \ "ASL-Syntax-Error:\nno ACTIONS declaration\ expected at '$line'" } # remove 'ACTIONS' and following spaces from line set line [string trimleft [crange $line 7 end] ] # call 'agt_parseInits' with index 4 to read the # actions and insert them in TCL-interpreter. if {[catch {agt_parseInits file line 4} errorMesg]} { return -code error \ "ASL-Syntax-Error - ACTIONS:\n$errorMesg" } set itemCt 5 } default {return -code error \ "ASL-Syntax-Error:\nunexpected symbol at '$line'"} } } } ideas/agt_parseInits.tcl100640 764 764 7172 6050144166 14643 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_parseInits # # Used to scan initial BELIEFS, BELIEF-RULES, MESSAGE-RULES # and ACTIONS from agents type File and initialize the belief # data base. # Calls procs agt_parseOneBelief, agt_parseOneBeliefRule, # agt_parseOneMesgRule, agt_parseOneAction (resp.) to do so. # # Arguments: # # typeFile (referenz) - list of lines of agt type file not # scanned till now # actLine (referenz) - actual line to scan # procNo - flag that shows whats to scan: # 1 BELIEFS # 2 BELIEF-RULES # 3 MESSAGE-RULES # 4 ACTIONS # # Results: # # typeFile is scanned for 1, 2, 3 or 4 and read lines are popped. # actLine contains the unscanned rest of the actual line to scan. # Returns an error with an errorMesg if a scan error occurs # proc agt_parseInits {typeFile actLine procNo} { upvar $typeFile file \ $actLine line # The next character in this line must be an open bracket # if {[cindex $line 0] != "\{"} { return -code error "'\{' expected at '$line'" } # counter for open brackets set brackets 1 # first character in $line is now a \{-bracket # remove the bracket and following spaces set line [string trimleft [csubstr $line 1 end]] # run through file until brackets are balanced # while {$brackets != 0} { switch -regexp -- $line { ^$|^# { # This is an empty line or a remark, so get the next line # frome 'file' if it is not empty if {[llength $file] ==0} { return -code error \ "'\}' expected" } set line [string trim [lvarpop file]] } ^load { # This is a 'load' command to load a description part from # a file specified in the rest of this line agt_loadDescPart file [string trim [csubstr $line 4 end]] # get the next line from file set line [string trim [lvarpop file]]} ^[(] { # This is the open bracket for a BELIEF, BELIEF-RULE, # MESSAGE-RULE or ACTION. # Remove the bracket and following spaces from 'line' and # call a parsing subroutine depending on 'procNo'. set line [string trimleft [csubstr $line 1 end]] switch $procNo { 1 {set result [catch {agt_parseOneBelief file line} errorMesg]} 2 {set result [catch {agt_parseOneBeliefRule file line} errorMesg]} 3 {set result [catch {agt_parseOneMesgRule file line} errorMesg]} 4 {set result [catch {agt_parseOneAction file line} errorMesg]} } # if the result of the subroutine is an error return # the error message of the subroutine if {$result} { return -code error $errorMesg } } ^\} {incr brackets -1} default {return -code error \ "'\}' expected at '$line'"} } } # first character in $line is now a \}-bracket # remove the bracket and following spaces set line [string trimleft [csubstr $line 1 end]] return } ideas/agt_parseOneAction.tcl100640 764 764 3775 6050144166 15441 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_parseOneAction # # Parses the type file for one correct action and put this # to the Tcl-Interpreter. # # Arguments: # # typeFile (referenz) - list of lines of agt type file not # scanned till now # actLine (referenz) - actual line to scan next; # starts with the begin of a action # # Results: # # Removes the action from typeFile, set actline so that its first character # is the first one after the end of action. # Returns an error with error message if syntax error is detected. # proc agt_parseOneAction {typeFile actLine} { upvar $typeFile file \ $actLine line global agents # the first character of line is here the first one _AFTER_ # the (-bracket and line has no succeeding white spaces # the scanning itself is done in a subroutine that puts the read # characters of the action in variable 'action' or # returns with error if it fails # if {[catch {agt_parseSubPart file line action "\n"} errorMesg]} { return -code error $errorMesg } # check if the action is really a Tcl-procedure declaration # if {![regexp ^proc $action]} { return -code error \ "proc-declaration expected in '[csubstr $action 0 20] ...'" } # eval the action so that it can be called by Tcl # if {[catch {eval $action} errorMesg]} { return -code error \ "$errorMesg in '[csubstr $action 0 20] ...'" } agt_puts "Read Action: >$action<\n" } ideas/agt_parseOneBelief.tcl100640 764 764 11632 6050144166 15421 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_parseOneBelief # # Parses the type file for one correct belief and inserts it in BeliefBase. # # Arguments: # # typeFile (referenz) - list of lines of agt type file not # scanned till now # actLine (referenz) - actual line to scan next; # starts with the begin of a belief # # Results: # # Removes the belief from 'typeFile', # set 'actline' so that its first character is the first one # after the end of belief and adds the belief to the belief-base. # Returns an error with error message if syntax error is # detected. # proc agt_parseOneBelief {typeFile actLine} { upvar $typeFile file \ $actLine line global agents agt_VarTimeOffset # the first character of line is here the first one _AFTER_ # the (-bracket and line has no succeeding white spaces # the scanning itself is done in a subroutine that puts the read # characters of the action in variable 'belief' or # returns with error if it fails # if {[catch {agt_parseSubPart file line belief} errorMesg]} { return -code error $errorMesg } if {[cindex $belief 0] == "("} { # in this case the belief has a time specification, i.e. it is of the form # (), , or # (), # get the index of the close bracket set index1 [string last ")" $belief] # get the characters of the time specification set timeString [string trimleft [crange $belief $index1+1 end]] # get just the belief, without brackets set belief [crange $belief 1 $index1-1] # check if the ',' exists after the belief if {[cindex $timeString 0] != ","} { return -code error "',' expected after '$belief'" } # check if time specification includes a # and set 'timeFrom', 'timeTill' depending on it: if {[set index2 [string last "," $timeString]] == 0} { # no , set 'timeTill' to 0, i.e. belief is valid # after 'timeFrom' set timeFrom [crange $timeString 1 end] set timeTill 0 } else { # exists so get 'timeFrom' and 'timeTill' from 'timeString' set timeFrom [crange $timeString 1 $index2-1] set timeTill [crange $timeString $index2+1 end] } } else { # no time specification, so the belief is always valid # check ()-brackets if there are no "," and ";" outside # balanced brackets # set brackets 0 for {set index 0} {$index <= [clength $belief]} {incr index} { set char [cindex $belief $index] switch -regexp -- $char { [(] {incr brackets 1} [)] {incr brackets -1} [,]|[;] {if {$brackets == 0} { set errorMesg "character '$char' in illegal position in\ '$belief'\n" return -code error $errorMesg } } } } set timeFrom now set timeTill 0 } if {[string match *:-* $belief]} { return -code error "no ':-' expected in '$belief'" } # use Tcl-command 'convertclock' to get the UNIX-time from # time specification; subtract a value 'agt_VarTimeOffset' so that BinProlog # can get the integer value if {[catch {set timeFrom [expr [convertclock $timeFrom]-$agt_VarTimeOffset]; \ set timeTill [expr [convertclock $timeTill]-$agt_VarTimeOffset] } \ errorMesg]} { return -code error $errorMesg } # substitute all occurenses of $SELF in the scanned # belief with agents name regsub -all {\$SELF} $belief [keylget agents(SELF) NAME] belief # remove a possibly existing fact with same name # if {[agt_listQuery retract(($belief:-A))] != 0} { agt_listQuery retract(validity($belief,B,C)) } # build up the belief to insert to BeliefBase set belief_1 "$belief:-validity($belief, FROM, TILL), \ (valid(FROM, TILL); \ (invalid(FROM, TILL), \ retract(($belief:-A)),\ retract(validity($belief, FROM, TILL)),fail))" if {[catch {agt_quietQuery assert(($belief_1))} errorMesg]} { return -code error "Prolog - $errorMesg" } # built up the validity-belief for the just inserted belief set belief_2 "validity($belief, $timeFrom, $timeTill)" if {[catch {agt_quietQuery assert(($belief_2))} errorMesg]} { return -code error "Prolog - $errorMesg" } agt_puts "Read Belief: >$belief<\n" } ideas/agt_parseOneBeliefRule.tcl100640 764 764 4167 6050144166 16236 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_parseOneBeliefRule # # Parses the type file for one correct belief-rule and inserts it in BeliefBase. # # Arguments: # # typeFile (referenz) - list of lines of agt type file not # scanned till now # actLine (referenz) - actual line to scan next; # starts with the begin of a belief-rule # # Results: # # Removes the belief-rule from 'typeFile', # set 'actline' so that its first character is the first one # after the end of rule and adds the rule to the belief-base. # Returns an error with error message if syntax error is # detected. # proc agt_parseOneBeliefRule {typeFile actLine} { upvar $typeFile file \ $actLine line global agents # the first character of line is here the first one _AFTER_ # the (-bracket and line has no succeeding white spaces # the scanning itself is done in a subroutine that puts the read # characters of the action in variable 'beliefRule' or # returns with error if it fails # if {[catch {agt_parseSubPart file line beliefRule} errorMesg]} { return -code error $errorMesg } if {![string match *:-* $beliefRule]} { return -code error "':-' expected in '$beliefRule'" } # substitute all occurenses of $SELF in the scanned # beliefRule with agents name regsub -all {\$SELF} $beliefRule [keylget agents(SELF) NAME] beliefRule # insert the rule in the BeliefBase if {[catch {agt_quietQuery assert(($beliefRule))} errorMesg]} { return -code error "Prolog - $errorMesg" } agt_puts "Read Belief-Rule: >$beliefRule<\n" } ideas/agt_parseOneMesgRule.tcl100640 764 764 11520 6050144166 15752 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_parseOneMesgRule # # Parses the type file for one correct message-rule and puts it in global array agt_MesgRules. # # Arguments: # # typeFile (referenz) - list of lines of agt type file not # scanned till now # actLine (referenz) - actual line to scan next; # starts with the begin of a message-rule # # Results: # # Removes the message-rule from 'typeFile', # set 'actline' so that its first character is the first one # after end of rule and add the rule to the global array # agt_MesgRules. # Returns and error with error message if syntax error is # detected. # proc agt_parseOneMesgRule {typeFile actLine} { upvar $typeFile file \ $actLine line global agents agt_MesgRules # the first character of line is here the first one _AFTER_ # the (-bracket and line has no succeeding white spaces # initialize a counter for ()-brackets # set brackets 1 # initialize a counter for the 5 parts of a mesg-rule # set index 0 # go on till brackets are balanced while {$brackets} { switch -regexp -- $line { ^$|^[\\]$ { # if not end of file get next line # if {[cequal $file ""]} { return -code error \ "')' expected" } set line [string trim [lvarpop file]] } ^[(] { # not more than 5 parts in a mesg-rule # if {$index == 5} { return -code error \ "')' expected after '($rulePart(4))'" } # remove the (-bracket and following white spaces # from line # set line [string trimleft [csubstr $line 1 end]] # on index 2, 3 and 4 Tcl-commands are read, so we # have to add a ";" after each command # if {[string match *$index* "2 3 4"]} { set eofl ";" } else { set eofl "" } # scan for expression in ()-brackets with subroutine, # return on error # if {[catch {agt_parseSubPart file line rulePart($index) $eofl} \ errorMesg]} { return -code error $errorMesg } # line starts now with first character after )-bracket; # read "," after parts with index less or equal 3 # if {$index <= 3} { if {[cindex $line 0] != ","} { return -code error \ "',' expected after '($rulePart($index))'" } # remove ',' and following white spaces from line # set line [string trimleft [csubstr $line 1 end]] } # increment the part index incr index } ^[)] {incr brackets -1} default {if {$index == 5} { set errorMesg "')' expected at '$line'" } else { set errorMesg "'(' expected at '$line'" } return -code error $errorMesg } } } # first character in $line is now a )-bracket, # remove the bracket and following white spaces # set line [string trimleft [csubstr $line 1 end]] # check now the message-form: # # check for correct message-keys # regsub -all "\}\{" $rulePart(0) "\} \{" rulePart(0) foreach key [keylkeys rulePart(0)] { if {[cindex $key 0] != ":"} { return -code error \ "in '$rulePart(0)': expected ':' as first character of key '$key'" } if {[catch {keylget rulePart(0) $key keyCont} errorMesg]} { return -code error \ "in '$rulePart(0)': $errorMesg" } # convert key to upper characters # keyldel rulePart(0) $key keylset rulePart(0) [string toupper $key] $keyCont } # replace all occurences of $SELF in mesg-form with agents name # regsub -all {\$SELF} $rulePart(0) [keylget agents(SELF) NAME] \ rulePart(0) # built up the new rule as a list of the subparts # for {set index 0} {$index <= 4} {incr index} { lappend newMesgRule $rulePart($index) } # set the new mesg-rule in the global array agt_MesgRules # set ruleNo [expr [array size agt_MesgRules]+1] set agt_MesgRules($ruleNo) $newMesgRule agt_puts "Read Message-Rule $ruleNo: >$agt_MesgRules($ruleNo)<\n" } ideas/agt_parseSubPart.tcl100640 764 764 7037 6050144166 15135 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_parseSubPart # # Parses the type file for one expression in balanced ()-bracket. # # Arguments: # # typeFile (referenz) - list of lines of agt type file not # scanned till now # actLine (referenz) - actual line to scan next; # starts with the begin of the subPart # subPart (referenz) - contains the parsed expression # # Results: # # Returns the characters in balanced ()-brackets in 'subPart', # removes them from 'typeFile' and sets 'actline' so that its first # character is the first one afer )-bracket. # Returns an error with error message if brackets are not # balanced. # proc agt_parseSubPart {typeFile actLine subPart {eofl ""}} { upvar $typeFile file \ $actLine line \ $subPart part # the first character of line is here the first one _AFTER_ # the (-bracket and line has no succeeding white spaces # initialize a counter for ()-brackets and one for double-quotes # set brackets 1 set dblquote 0 # initialize a counter for parsing position in line # set chCt -1 set part "" # go on till brackets are balanced while {$brackets} { incr chCt set char [cindex $line $chCt] switch -glob -- $char { ( {if {[cindex $line $chCt-1] != "\\"} { incr brackets } } ) {if {[cindex $line $chCt-1] != "\\"} { incr brackets -1 } } \" {if {[cindex $line $chCt-1] != "\\"} { incr dblquote [expr ($dblquote) ? -1 : 1] } } "" { # if last character in line is "\" remove it before # appending the line to part and poping next line from # file; # => white spaces before "\" are save # if {[cequal "\\" [cindex $line $chCt-1]]} { if {$chCt >= 2} { append part [crange $line 0 $chCt-2] } append part " " } else { # eofl is used to add ";" or "\n" after Tcl-commands if {$chCt} { append part [crange $line 0 $chCt-1] $eofl } } if {[cequal $file ""]} { break } set line [string trim [lvarpop file]] set chCt -1 } # { # this is a comment if the '#'-character occurs # at the beginning of the line if {$chCt == 0} { set line [string trim [lvarpop file]] set chCt -1 } } } } if {$chCt} { append part [crange $line 0 $chCt-1] } if {$brackets} { return -code error "')' missing for '($part'" } # catch unbalanced double-quotes, because test had shown that # an unbalanced double quote at the end of a belief makes Prolog hang # if {$dblquote} { return -code error "unbalanced double-quotes in '$part'" } # first character in $line is now a )-bracket, # remove the bracket and following white spaces # set line [string trimleft [crange $line $chCt+1 end]] } ideas/agt_pathViewStuff.tcl100640 764 764 11747 6050144166 15344 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_pathViewStuff.tcl # # This file concludes the procedures used for displaying an agents # communication paths with bitmaps in a widget. # # # # agt_displAgtBitmap # # Displays a weak drawn agent-symbol in the pathView canvas widget # and creates a line, symboling the communication path, to agent with tag SELF # but doesn't show it yet. # # Arguments: # # agtName - name of the agent bitmap belongs to # # Results: # # None. # proc agt_displAgtBitmap {agtName} { # check for position - belongs to agent name # switch $agtName { SELF { set xPos 175 set yPos 90 } UAM {set xPos 50 set yPos 90 } default { set xPos 350 # search free place in widget for {set i 20} \ {[.f2.c find overlap ${xPos} ${i} [expr $xPos+0.1] [expr $i+1]]!=""} \ {set i [expr $i+50]} {} set xPos ${xPos} set yPos ${i} } } # create bitmap and add tag with agents name .f2.c create bitmap ${xPos} ${yPos} -bitmap questhead \ -foreground slategray3 \ -anchor center \ -tag $agtName.bitmap .f2.c addtag $agtName withtag $agtName.bitmap # create text for bitmap and add tag with agents name .f2.c create text ${xPos} [expr ${yPos}+20] -text $agtName \ -font -Adobe-Helvetica-Medium-R-Normal--*-120-* \ -anchor center \ -tag $agtName.text .f2.c addtag $agtName withtag $agtName.text set agtCoord [.f2.c coord $agtName] set selfCoord [.f2.c coord SELF] # create line from new bitmap to bitmap with tag SELF and add tag with agents name set edge [.f2.c create line [lindex $agtCoord 0] [lindex $agtCoord 1] \ [lindex $selfCoord 0] [lindex $selfCoord 1] \ -tag $agtName.edge \ -fill "" ] .f2.c addtag $agtName withtag $agtName.edge .f2.c lower $edge # do the binding for the bitmap .f2.c bind $agtName "agt_showAgtStatus $agtName %x %y" .f2.c bind $agtName { .f2.c delete status; destroy .f2.c.status } .f2.c bind $agtName { .f2.c coords status %x %y } if {$agtName != "SELF"} { .f2.c bind $agtName "agt_positBitmap $agtName %x %y" } update idletasks } # # agt_positBitmap # # Positionizes an agents bitmap new in the canvas. # Bind to an agents bitmap on holding button 1 pressed. # # Arguments: # # agtName - name of bitmap to positionize # xPos - new x coordinate # yPos - new y coordinate # # Results: # # None. # proc agt_positBitmap {agtName xPos yPos} { .f2.c coords $agtName.bitmap $xPos $yPos .f2.c coords $agtName.text $xPos [expr $yPos + 20] .f2.c coords $agtName.edge $xPos $yPos [lindex [.f2.c coord SELF.bitmap] 0] \ [lindex [.f2.c coord SELF.bitmap] 1] } # # agt_drawWeak # # Displays the line from a bitmap to SELF in a weak colour; # used when doing handshake and connection is still not established # completely. # # Arguments: # # agtName - name of the bitmap # # Results: # # None. # proc agt_drawWeak {agtName} { .f2.c itemconfigure $agtName.edge -fill slategray3 .f2.c itemconfigure $agtName.bitmap -foreground slategray3 update idletasks } # # agt_drawSolid # # Displays the line from a bitmap to SELF in a solid colour; # used when handshake is done and the connection is established. # # Arguments: # # agtName - name of the bitmap # # Results: # # None. # proc agt_drawSolid {agtName} { .f2.c itemconfigure $agtName.edge -fill black .f2.c itemconfigure $agtName.bitmap -foreground black update idletasks } # # agt_delAgtBitmap # # Deletes an agents bitmap from canvas. # # Arguments: # # agtName - name of the bitmap # # Results: # # None. # proc agt_delAgtBitmap {agtName} { .f2.c delete $agtName } # # agt_showAgtStatus # # Creates a message widget in the canvas and displays information about # a selected agent. # Bind to an agents bitmap on holding button 2 pressed. # # Arguments: # # agtName - name of the bitmap # xPos - x coordinate for message widget # yPos - y coordinate for message widget # # Results: # # None. # proc agt_showAgtStatus {agtName xPos yPos} { global agents catch {.f2.c delete status} catch {destroy .f2.c.status} set text "" foreach key [keylkeys agents($agtName)] { set text "${text}$key\t: [keylget agents($agtName) $key]\n" } message .f2.c.status -text $text \ -relief ridge \ -justify left \ -font -Adobe-Courier-Bold-R-Normal--*-120-* \ -width 200 .f2.c create window $xPos $yPos -window .f2.c.status -tag status -anchor n } ideas/save/ 40750 764 764 0 5765341337 12027 5ustar javierjavierideas/save/COPYRIGHT100440 764 764 1206 5765341050 13405 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # ideas/save/agt_stdBelBase.pl100440 764 764 2321 5765341337 15321 0ustar javierjavier% % Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann % Computer Science Department, % Christian-Albrechts-University of Kiel, % Olshausenstr. 40, 24118 Kiel, Germany % % All rights reserved. % No warranties will be given on any issues arising out of the use % of this software product. % Permission to use, copy, modify and distribute this software % product for non-commercial purposes is hereby granted, provided % that the above copyright notice appears in all copies and % respective publications. % All commercial trades with this product outside the CAU Kiel % without specific written prior permission are prohibited. % % % agt_prologClear.pl % % This is the initial belief base of an agent % containing some predicates for time realization % time/1 % contains an integer value representing the current time time(0). % set_time/1 % used to set a new time set_time(T):- retract(time(A)), assert(time(T)). % valid/2 % defines the validity of a time interval from A to B % relative to the current time valid(A,B):- time(C), A=B. ideas/agt_prologServ.tcl100640 764 764 23261 6050144166 14701 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_prologServ.tcl # # Tcl/Tk side of a BinProlog-Tcl/Tk interface for IDEAS # tested on tcl7.3 with tk3.6 with tclX # # by Olaf Scheew, 1995 # # # # agt_startProlog # # Starts a new Prolog process and registers its filedesc. # # Arguments: # # None. # # Results: # # 0, if process is OK, sets in global variable agents(SELF) # key PROLOG the filedesc # 1, if an error occurred # proc agt_startProlog {} { global agents ideas_PrologPath # initialize the globale value for the Prolog filedescriptor # with an empty string, so that there is 'something' to read # even if the Prolog process can't be started # keylset agents(SELF) PROLOG "" agt_puts "Starting Prolog process ..." 0 if {![file executable ${ideas_PrologPath}/bp]} { agt_puts "failed!\n\nError when trying to start\ Prolog:\n${ideas_PrologPath}/bp: " 0 if {![file exists ${ideas_PrologPath}/bp]} { agt_puts "Command not found !\nCheck entry in file\ 'init.tcl'.\n" return 1 } agt_puts "Permission denied \n" return 1 } if {![file exists agt_prologServ.bp]} { agt_puts "failed!\n\nError when trying to start\ Prolog:\nFile 'agt_prologServ.bp' not found!\nSee the\ README file for compiling 'agt_prologServ.pl' using\ BinProlog.\n" return 1 } set prologFd [open "|${ideas_PrologPath}/bp -q5 agt_prologServ.bp" r+] keylset agents(SELF) PROLOG $prologFd agt_listenProlog agt_puts "established on $prologFd .\n" return 0 } # # agt_listenProlog # # Reads the output of a Prolog process. # # Arguments: # # outputFlag - 0 quietQuery # 1 loudQuery # 2 listQuery # # Returns: # # Depends from query type/outputFlag: # 0 no output except error: errorcode is set and error returned # 1 full output, i.e. varaiable values are returned in Prolog manner # 2 If a query is started by procedure 'agt_listQuery', Prolog # will answer it in a special form: # The symbol '|' will be sent in front of each possible # solution of the query. # If this form is detected, 'agt_listenProlog' will build up # and return the response to the query in form of a list. # Each list element is a Tcl-KeyedList which keys are the variables # of the query and its Prolog values are the values of the keys. # If there is no such list is returned by Prolog, 1 or 0 is returned # for Prolog yes and no. # Errors return allways no. # proc agt_listenProlog {{outputFlag 0}} { global agents keylget agents(SELF) PROLOG f # listFlag set when a "|"-symbol is read in the # stream of the Prolog answer. # In this case a result list is build up. If not, the # Prolog answer is just put in a simple string. set listFlag 0 set respText "" set partList "" while {1} { # gets the next line of Prolog answer gets $f line # checks for end of prologs answer # if {$line == "EOPA"} break # check for Prolog error (they start with "*" or ">") # when occurred read Prolog answer till end # and return with error and set errorcode # if {[regexp {^(>|\*)} $line]} { fcntl $f NONBLOCK 1 while {![catch {gets $f errorMesg}]} { if {$errorMesg != "EOPA"} { set line "$line\n$errorMesg" } } fcntl $f NONBLOCK 0 # catch the error 'undefined_predicate' # it is stupid when asking for a non existing fact # to get an error # if {[regexp {^\*\*\* undefined_predicate} $line]} { if {$outputFlag == 2} { return 0 } return -code ok } return -code error $line } # checks for new part list # if {$line=="|"} { # detected a "|"-symbol, so set the listFlag set listFlag 1 # if this is not the beginning of the result list # append the part read so far to the final result # variable 'respList' if {$partList!=""} { lappend respList $partList } set partList "" continue } # builts up a part of the result list with the line # just read, if the "|"-symbol was read, or just a # normal String, if not. if {$listFlag} { # remove the '=' from answer list, # e.g. the result could be "| X=1 Y=2 | X=2 Y=4" # lappend partList [lreplace $line 1 1] } else { set respText "${respText}$line\n" } } # now the end of the Prolog answer (EOPA) has been read # so append the last part to the final response list lappend respList $partList # belongig to the output flag the result is returned # if {$outputFlag == 1} { return $respText } elseif {$outputFlag == 2} { if {!$listFlag} { return 0 } elseif {$respList == "{}"} { return 1 } else { return $respList } } else { return } } # agt_writeProlog # # Writes a string as an query to the Prolog process and waits for a result. # # Arguments: # # query - the string to send # flag - a flag specifying the form of the expected Prolog result # (s. agt_listenProlog) # # Results: # # Return the result of the Prolog query as read by agt_listenProlog or an # error with an error message if one occurrs. # proc agt_writeProlog {query flag} { global agents set error 0 # check if quotes and double-quotes are balanced because tests had # shown that an unbalanced quote makes Prolog hang. set quote 0 set dblquote 0 for {set index 0} {$index <= [clength $query]} {incr index} { set char [cindex $query $index] switch -glob -- $char { \' {incr quote [expr ($quote) ? -1 : 1]} \" {incr dblquote [expr ($dblquote) ? -1 : 1]} } } if {$quote} { set errorMesg "unbalanced quotes in '$query'" set error 1 } if {$dblquote} { set errorMesg "unbalanced double-quotes in '$query'" set error 1 } if {$error} { return -code error $errorMesg } keylget agents(SELF) PROLOG f if {[catch {puts $f $query. ; flush $f}]} { # Prolog process crashed, try to rebuild it # if {![agt_catchPrologCrash $f]} { agt_puts "Trying the query again...\n" return [agt_writeProlog $query $flag] } else { return -code error "Cannot rebuilt Prolog!" } } else { return [agt_listenProlog $flag] } } # agt_quietQuery # # NOT TO USE BY AGENT PROGRAMMER ! # # sends a goal to be quietly evaluated # to the Prolog process, # i.e. no result is returned, only errors are shown # # Arguments: # # query - the query to Prolog # # Results: # # Returns an error with an error message, if a Prolog error # occurred. # proc agt_quietQuery {query} { return [agt_writeProlog "call_prolog(($query))" 0] } # agt_loudQuery # # NOT TO USE BY AGENT PROGRAMMER ! # # sends a query to the Prolog process and wants back the # full Prolog answer as a simple string. # => 'loud' # agt_loudQuery is used to get a Prolog listing only. # # Arguments: # # query - the query to Prolog # # Results: # # String including the Prolog answer to the query, or # an error with an error message, if a Prolog error # occurred. # proc agt_loudQuery {query} { return [agt_writeProlog "query_prolog(($query))" 1] } # agt_listQuery # # NOT TO USE BY AGENT PROGRAMMER ! # # sends a query to the Prolog process and # wants the result back in a special form, # which is parsed by 'agt_listenProlog' and formed # to a Tcl list, # i.e. returns 1 or 0 for yes/no or a list of Tcl-KeyedLists # with variable values as describe in 'agt_listenProlog'. # # Arguments: # # query - the query to Prolog # # Results: # # Returns -1 and writes a message to logfile, if an error occurs. # Returns 0, if answer to query is TRUE. # Returns 1, if answer to query is FALSE. # Returns a list of variable values, if query includes Prolog # variables Prolog found values for. # proc agt_listQuery {query} { if {[catch {set result [agt_writeProlog "query_prolog_list(($query))" 2]} \ errorMesg]} { agt_puts "Prolog-Error when trying to eval '$query':\n$errorMesg\n" return -1 } else { return $result } } # # agt_query # # The 'standard' query to use by agent programmer: # # uses 'agt_listQuery' to send a query to the Prolog process # and to get the result back in a special form, # which is parsed by 'agt_listenProlog' and formed # to a list of Tcl-KeyedLists, # i.e. returns 1 or 0 for yes/no or a Tcl list # with variable values. # -1 is returned if an error occurs # # Arguments: # # query - the query to Prolog # # Results: # # Returns -1 and writes a message to logfile, if an error occurs. # Returns 0, if answer to query is TRUE. # Returns 1, if answer to query is FALSE. # Returns a list of variable values, if query includes Prolog # variables Prolog found values for. # proc agt_query {query} { # set the actual time in Prolog agt_timeSet agt_displayBelBase # do not allow changing of belief-base by simple queries # switch -regexp -- $query { assert[(]|asserta[(]|assertz[(]|retract[(]|consult[(]|compile[(]|abolish[(] { agt_puts "Prolog-Error when trying to eval '$query':\nNot allowed to\ assert, retract, consult ... in a query !\n" return -1} } return [agt_listQuery $query] } ideas/agt_puts.tcl100640 764 764 3052 6050144166 13506 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_puts # # Displays text in agents observer window and # writes it to the logfile. # # Arguments: # # text - text to display # nextLine - if '0' begin no newline after text, # default 1 # # Results: # # None. # proc agt_puts {text {nextLine 1}} { global agents agt_VarLogScroll set logFile [keylget agents(SELF) LOGFID] if {[catch { .f1.text configure -state normal if {$nextLine != "0"} { puts $logFile $text .f1.text insert end "$text \n" } else { puts -nonewline $logFile $text .f1.text insert end "$text" } .f1.text configure -state disabled if {$agt_VarLogScroll} { .f1.text yview -pickplace end } }]} { # if user close the agent window, the agent process does # NOT stop, so an error occurs when trying to write in # the destroyed window; catch it and kill the process ! # kill [pid] } flush $logFile update } ideas/agt_sendMesgProcs.tcl100640 764 764 11566 6050144166 15320 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_dispatchMesgs # # Sends well formatted messages of global agt_SendMesgList # to other agents. # If format is not correct, an error is displayed, # the message is not sent and an error-message is sent to self. # # Arguments: # # sendMesgList - messages to send # # Results: # # Format of possible error-messages: # {:TYPE error} {:CODE 1} {:COMMENT "message format error"} # {:TYPE error} {:CODE 3} {:COMMENT "no connection error"} # {:TYPE error} {:CODE 4} {:COMMENT "write error"} # proc agt_dispatchMesgs {} { global agents agt_SendMesgList SELF global agt_VarComFilter keylget agents(SELF) NAME SELF keylset error_mesg :TYPE error \ :SENDER $SELF \ :RECEIVER $SELF set error 0 set cp_SendMesgList $agt_SendMesgList set agt_SendMesgList "" foreach mesg $cp_SendMesgList { keylset error_mesg :REPLY-TO [keylget mesg :REPLY-WITH] # fill in return sender of message # if {[keylget mesg :SENDER {}] == 0} { keylset mesg :SENDER [keylget agents(SELF) NAME] } # replace SELF in list of receiver with agents own # name as saved in $SELF # keylget mesg :RECEIVER receiverList regsub SELF $receiverList $SELF receiverList keylset mesg :RECEIVER $receiverList # check format of message # if {[catch {set text [agt_formatMesg $mesg]} errorMesg]} { agt_puts "FORMAT-ERROR when trying to send:\n$mesg\nFailure:\ '$errorMesg'\n" keylset error_mesg :CODE 1 \ :COMMENT "message format error" agt_send $error_mesg set error 1 break } if {[catch {keylget mesg :REPLY-TO}]} { keylset mesg :REPLY-TO none } foreach agtName $receiverList { # if receiver is agents own name, replace it by SELF # to find the correct fid in next step # if {[cequal $agtName $SELF]} { set agtName SELF } # check if agents is connected to the receiver # and get the fid for outgoing messages # if {([catch {keylget agents($agtName)}]) || \ (![keylget agents($agtName) OUTFID agtFid])} { agt_puts "NO-CONNECTION-ERROR when trying to send\ to '$agtName':\n${mesg}Message not sent!\n" keylset error_mesg :CODE 3 \ :COMMENT "no connection error" agt_send $error_mesg set error 1 break } if {[catch {puts $agtFid $mesg; flush $agtFid }]} { # cannot write to pipe because its broken # so remove the information about the pipe # agt_puts "WRITE ERROR when trying to send\ to '$agtName':\n${mesg}Message not sent!\n" agt_conBroken $agtFid $agtName if {![cequal $agtName $SELF]} { keylset error_mesg :CODE 4 \ :COMMENT "write error" agt_send $error_mesg set error 1 } break } agt_puts "Message sent to '$agtName':\n$text" if {[lsearch $agt_VarComFilter $agtName] != -1} { agt_logComm "Message sent to '$agtName':\n$text" } } } # if an error occured send the error-messages to self # if {$error} { agt_dispatchMesgs } } # # agt_send # # Appends a message to the global list of messages to be # sent at the end of the cycle. # # Arguments: # # mesg - mesg to append to agt_SendMesgList # # Results: # # Global list agt_SendMesgList includes mesg, # returns number of the mesg (in :REPLY-WITH) or # -1 , if one of the keys :TYPE or :RECEIVER is missing in mesg # or format error in keyedList # proc agt_send {mesg} { global agt_SendMesgList agt_MesgCounter if {![keylget mesg :RECEIVER {}]} { agt_puts "agt_send - FORMAT ERROR:\n:RECEIVER specification missing in\ '$mesg'\nMessage not appended to send.\n" return -1 } if {![keylget mesg :TYPE {}]} { agt_puts "agt_send - FORMAT ERROR:\n:TYPE specification missing in\ '$mesg'\nMessage not appended to send.\n" return -1 } if {[catch {keylset mesg :REPLY-WITH $agt_MesgCounter} errorMesg]} { agt_puts "agt_send - FORMAT ERROR:\n$errorMesg in\ '$mesg'\nMessage not appended to send.\n" return -1 } lappend agt_SendMesgList $mesg incr agt_MesgCounter agt_puts "Append to send: $mesg\n" return [expr $agt_MesgCounter-1] } ideas/agt_stdMesgRules.tcl100640 764 764 22606 6050144166 15162 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # These are the standard message-rules known by all agents. # They control the basic actions of the agent, as initialization # status change, exit, handshakes etc. # # The message-rules are stored in global array 'agt_MesgRules' # and this piece of Tcl-Code is 'sourced' by 'agt_doTypeInits' # when initializing or reseting an agent. # set agt_MesgRules(1) [list {{:SENDER UAM} \ } \ {[.f1.text index end] >= 500} \ {.f1.text configure -state normal .f1.text delete 1.0 100.0 .f1.text configure -state disabled if {[.f4.text index end] >= 500} { .f4.text configure -state normal .f4.text delete 1.0 100.0 .f4.text configure -state disabled } if {[.f5.text index end] >= 500} { .f5.text configure -state normal .f5.text delete 1.0 100.0 .f5.text configure -state disabled } } \ {} \ {set agt_VarRuleMatch 0}] set agt_MesgRules(2) [list {{:TYPE command} \ {:COMMAND handshake} \ {:ADDRESS Addr} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {$Send == "UAM"} \ {foreach agtName $Addr { \ agt_handshake $agtName \ } \ } \ {agt_puts "No command messages from agent\ '$Send' accepted !\nMessage ignored!\n" agt_break } \ {}] set agt_MesgRules(3) [list {{:TYPE command} \ {:COMMAND chg_status} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {$Send == "UAM"} \ {agt_chgStatus $ReplyWith} \ {agt_puts "No command messages from agent\ '$Send'accepted !\nMessage ignored!\n" agt_break } \ {}] set agt_MesgRules(4) [list {{:TYPE command} \ {:COMMAND exit} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {$Send == "UAM"} \ {agt_exit} \ {agt_puts "No command messages from agent\ '$Send' accepted !\nMessage ignored!\n"} \ {agt_break}] set agt_MesgRules(5) [list {{:TYPE command} \ {:COMMAND reset} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {$Send == "UAM"} \ {agt_puts "Doing a RESET now!\n\nReseting\ Prolog process:\n"; agt_doTypeInits} \ {agt_puts "No command messages from agent\ '$Send' accepted !\nMessage ignored!\n"} \ {agt_break}] set agt_MesgRules(6) [list {{:TYPE command} \ {:COMMAND save} \ {:FILE FileName} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {$Send == "UAM"} \ { if {[agt_saveBelBase $FileName]} { \ keylset mesg :TYPE failed \ } else { \ keylset mesg :TYPE ok \ }; \ keylset mesg :REPLY-TO $ReplyWith \ :RECEIVER $Send ; \ agt_send $mesg \ } \ {agt_puts "No command messages from agent\ '$Send' accepted !\nMessage ignored!\n" agt_break } \ {}] set agt_MesgRules(7) [list {{:TYPE command} \ {:COMMAND load} \ {:FILE FileName} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {$Send == "UAM"} \ { \ if {[agt_loadBelBase $FileName]} { \ keylset mesg :TYPE failed \ } else { \ keylset mesg :TYPE ok \ } ;\ keylset mesg :REPLY-TO $ReplyWith \ :RECEIVER $Send ; \ agt_send $mesg \ } \ {agt_puts "No command messages from agent\ '$Send' accepted !\nMessage ignored!\n" agt_break } \ {}] set agt_MesgRules(8) [list {{:TYPE handshake} \ {:IDFK Idfk} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {1} \ {agt_getHandshake $agt_VarFid \ $Send $Idfk $ReplyWith} \ {} \ {}] set agt_MesgRules(9) [list {{:TYPE error} \ {:CODE Code} \ {:COMMENT Comment} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {1} \ {agt_puts "Received an ERROR-MESSAGE!\n"} \ {} \ {}] set agt_MesgRules(10) [list {{:TYPE initialization} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {$agt_VarInitialization} \ {set agt_VarInitialization 0} \ {agt_break} \ {}] set agt_MesgRules(11) [list {{:TYPE command} \ {:COMMAND testcon} \ {:ADDRESS Addr} \ {:REPLY-TO ReplyTo} \ {:REPLY-WITH ReplyWith} \ {:SENDER Send} \ {:RECEIVER Recv}} \ {$Send == "UAM"} \ {foreach addr $Addr { \ if {[set agtName [agt_checkaddr $addr]] != 0} {\ keylset mesg :RECEIVER $agtName \ :TYPE information \ :MESSAGE "This is just a Test!" agt_send $mesg } else {\ agt_puts "Not connected to address '$addr'.\n"\ }\ }\ } \ {agt_puts "No command messages from agent\ '$Send' accepted !\nMessage ignored!\n" agt_break } \ {}] ideas/uam_logText.tcl100640 764 764 2627 6050144167 14160 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_logText # # Displays text in UAMs observer window and # writes it to the logfile. # # Arguments: # # text - text to display # nextLine - if 0 no newline after text, # default 1 # # Results: None. # proc uam_logText {text {nextLine 1}} { global agents uam_VarLogScroll set logFile [keylget agents(UAM) LOGFID] # if the UAM widget is closed, exit the UAM without asking # if {[catch {.log.text configure -state normal}]} { uam_exit 0 return } if {$nextLine != 0 } { puts $logFile $text .log.text insert end "$text \n" } else { puts -nonewline $logFile $text .log.text insert end "$text" } .log.text configure -state disabled if {$uam_VarLogScroll} { .log.text yview -pickplace end } flush $logFile update } ideas/tclIndex100640 764 764 20026 6052360130 12662 0ustar javierjavier# Tcl autoload index file, version 2.0 # This file is generated by the "auto_mkindex" command # and sourced to set up indexing information for one or # more commands. Typically each line is a command that # sets an element in the auto_index array, where the # element name is the name of a command and the value is # a script that loads the command. set auto_index(uam_dialog) "source $dir/uam_dialog.tcl" set auto_index(agt_insert) "source $dir/agt_belUpdateProcs.tcl" set auto_index(agt_delete) "source $dir/agt_belUpdateProcs.tcl" set auto_index(agt_saveBelBase) "source $dir/agt_belUpdateProcs.tcl" set auto_index(agt_loadBelBase) "source $dir/agt_belUpdateProcs.tcl" set auto_index(agt_chgStatus) "source $dir/agt_chgStatus.tcl" set auto_index(agt_commCtrl) "source $dir/agt_commCtrl.tcl" set auto_index(agt_conBroken) "source $dir/agt_conBroken.tcl" set auto_index(agt_conDetected) "source $dir/agt_conDetected.tcl" set auto_index(agt_createCon) "source $dir/agt_createCon.tcl" set auto_index(uam_initMesgTo) "source $dir/uam_mesgToProcs.tcl" set auto_index(uam_mesgTo) "source $dir/uam_mesgToProcs.tcl" set auto_index(uam_mesgToOK) "source $dir/uam_mesgToProcs.tcl" set auto_index(agt_doTypeInits) "source $dir/agt_doTypeInits.tcl" set auto_index(agt_evalMesg) "source $dir/agt_evalMesg.tcl" set auto_index(agt_break) "source $dir/agt_evalMesg.tcl" set auto_index(agt_exit) "source $dir/agt_exit.tcl" set auto_index(agt_formatMesg) "source $dir/agt_formatMesg.tcl" set auto_index(agt_getHandshake) "source $dir/agt_getHandshake.tcl" set auto_index(agt_tracepoint) "source $dir/agt_tracepoint.tcl" set auto_index(agt_keyPattMatches) "source $dir/agt_keyPattMatches.tcl" set auto_index(agt_loadDescPart) "source $dir/agt_loadDescPart.tcl" set auto_index(uam_handleASLError) "source $dir/uam_handleASLError.tcl" set auto_index(agt_openSocket) "source $dir/agt_openSocket.tcl" set auto_index(agt_parseDescFile) "source $dir/agt_parseDescFile.tcl" set auto_index(agt_parseInits) "source $dir/agt_parseInits.tcl" set auto_index(agt_parseOneAction) "source $dir/agt_parseOneAction.tcl" set auto_index(agt_parseOneBelief) "source $dir/agt_parseOneBelief.tcl" set auto_index(agt_parseOneBeliefRule) "source $dir/agt_parseOneBeliefRule.tcl" set auto_index(agt_parseOneMesgRule) "source $dir/agt_parseOneMesgRule.tcl" set auto_index(agt_parseSubPart) "source $dir/agt_parseSubPart.tcl" set auto_index(agt_displAgtBitmap) "source $dir/agt_pathViewStuff.tcl" set auto_index(agt_positBitmap) "source $dir/agt_pathViewStuff.tcl" set auto_index(agt_drawWeak) "source $dir/agt_pathViewStuff.tcl" set auto_index(agt_drawSolid) "source $dir/agt_pathViewStuff.tcl" set auto_index(agt_delAgtBitmap) "source $dir/agt_pathViewStuff.tcl" set auto_index(agt_showAgtStatus) "source $dir/agt_pathViewStuff.tcl" set auto_index(agt_startProlog) "source $dir/agt_prologServ.tcl" set auto_index(agt_listenProlog) "source $dir/agt_prologServ.tcl" set auto_index(agt_writeProlog) "source $dir/agt_prologServ.tcl" set auto_index(agt_quietQuery) "source $dir/agt_prologServ.tcl" set auto_index(agt_loudQuery) "source $dir/agt_prologServ.tcl" set auto_index(agt_listQuery) "source $dir/agt_prologServ.tcl" set auto_index(agt_query) "source $dir/agt_prologServ.tcl" set auto_index(agt_puts) "source $dir/agt_puts.tcl" set auto_index(agt_dispatchMesgs) "source $dir/agt_sendMesgProcs.tcl" set auto_index(agt_send) "source $dir/agt_sendMesgProcs.tcl" set auto_index(uam_logText) "source $dir/uam_logText.tcl" set auto_index(uam_actAgt) "source $dir/uam_actAgt.tcl" set auto_index(uam_delAgt) "source $dir/uam_delAgt.tcl" set auto_index(uam_agtAbnormExit) "source $dir/uam_agtAbnormExit.tcl" set auto_index(uam_commCtrl) "source $dir/uam_commCtrl.tcl" set auto_index(uam_evalMesg) "source $dir/uam_evalMesg.tcl" set auto_index(uam_break) "source $dir/uam_evalMesg.tcl" set auto_index(uam_formatMesg) "source $dir/uam_formatMesg.tcl" set auto_index(uam_startEditor) "source $dir/uam_startEditor.tcl" set auto_index(uam_keyPattMatches) "source $dir/uam_keyPattMatches.tcl" set auto_index(uam_fillLb) "source $dir/uam_lbTools.tcl" set auto_index(uam_insertLbSel) "source $dir/uam_lbTools.tcl" set auto_index(uam_selectLbEntry) "source $dir/uam_lbTools.tcl" set auto_index(uam_registerAgt) "source $dir/uam_registerAgt.tcl" set auto_index(uam_rmAgt) "source $dir/uam_rmAgt.tcl" set auto_index(uam_sendMesg) "source $dir/uam_sendMesg.tcl" set auto_index(uam_showShortHelp) "source $dir/uam_showShortHelp.tcl" set auto_index(uam_notImpl) "source $dir/uam_stuff.tcl" set auto_index(uam_noAgtIdf) "source $dir/uam_stuff.tcl" set auto_index(uam_illegalAgtName) "source $dir/uam_stuff.tcl" set auto_index(uam_newNameExists) "source $dir/uam_stuff.tcl" set auto_index(uam_notExType) "source $dir/uam_stuff.tcl" set auto_index(uam_notExSystem) "source $dir/uam_stuff.tcl" set auto_index(uam_notExActSrc) "source $dir/uam_stuff.tcl" set auto_index(uam_sendMesgError) "source $dir/uam_stuff.tcl" set auto_index(uam_startMASError) "source $dir/uam_stuff.tcl" set auto_index(uam_conMASError) "source $dir/uam_stuff.tcl" set auto_index(uam_actSrcError) "source $dir/uam_stuff.tcl" set auto_index(agt_logComm) "source $dir/agt_logComm.tcl" set auto_index(agt_displayBelBase) "source $dir/agt_displayBelBase.tcl" set auto_index(agt_catchPrologCrash) "source $dir/agt_catchPrologCrash.tcl" set auto_index(agt_handshake) "source $dir/agt_handshake.tcl" set auto_index(agt_logMesgEval) "source $dir/agt_logMesgEval.tcl" set auto_index(uam_initShortcuts) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_shortsScrollCmd) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_fillShortcutLb) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_newShortcut) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_editShortcut) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_selectShortcut) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_shortcut2mesgTo) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_removeShortcut) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_addNewShortcut) "source $dir/uam_shortcutProcs.tcl" set auto_index(uam_shortcutResetFocus) "source $dir/uam_shortcutProcs.tcl" set auto_index(agt_checkaddr) "source $dir/agt_checkaddr.tcl" set auto_index(uam_newAgt) "source $dir/uam_newAgt.tcl" set auto_index(uam_initNewAgtOK) "source $dir/uam_newAgt.tcl" set auto_index(agt_closecon) "source $dir/agt_closecon.tcl" set auto_index(uam_startAgent) "source $dir/uam_startAgent.tcl" set auto_index(uam_startMAS) "source $dir/uam_startMAS.tcl" set auto_index(uam_edSystemFile) "source $dir/uam_edSystemFile.tcl" set auto_index(uam_edSystemFileOK) "source $dir/uam_edSystemFile.tcl" set auto_index(agt_hostport2addr) "source $dir/agt_hostport2addr.tcl" set auto_index(agt_updateComFilter) "source $dir/agt_updateComFilter.tcl" set auto_index(uam_newAgtChgView) "source $dir/uam_newAgtChgView.tcl" set auto_index(agt_showShortHelp) "source $dir/agt_showShortHelp.tcl" set auto_index(uam_initHelp) "source $dir/uam_helpSystemProcs.tcl" set auto_index(uam_showHelpFile) "source $dir/uam_helpSystemProcs.tcl" set auto_index(agt_valid) "source $dir/agt_valid.tcl" set auto_index(agt_time) "source $dir/agt_valid.tcl" set auto_index(agt_timeSet) "source $dir/agt_timeSet.tcl" set auto_index(agt_parseActSrc) "source $dir/agt_parseActSrc.tcl" set auto_index(uam_compileActSrc) "source $dir/uam_compileActSrc.tcl" set auto_index(uam_edActSrcFile) "source $dir/uam_edActSrcFile.tcl" set auto_index(uam_edActSrcFileOK) "source $dir/uam_edActSrcFile.tcl" set auto_index(uam_getActSrcFile) "source $dir/uam_getActSrcFile.tcl" set auto_index(uam_edScriptFile) "source $dir/uam_edScriptFile.tcl" set auto_index(uam_edTypeFileOK) "source $dir/uam_edScriptFile.tcl" set auto_index(uam_exit) "source $dir/uam_exit.tcl" set auto_index(uam_handlePrologError) "source $dir/uam_handlePrologError.tcl" set auto_index(agt_sourceStdMesgRules) "source $dir/agt_sourceStdMesgRules.tcl" set auto_index(uam_aboutIdeas) "source $dir/uam_aboutIdeas.tcl" set auto_index(uam_showCopyright) "source $dir/uam_aboutIdeas.tcl" set auto_index(uam_showAbout) "source $dir/uam_aboutIdeas.tcl" set auto_index(uam_helloIdeas) "source $dir/uam_helloIdeas.tcl" ideas/uam_actAgt.tcl100640 764 764 2311 6050144166 13722 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_actAgt # # Sends a status change message to agents selected in listbox # .frame1.list 'Local Agent List' in UAM. # An error message is shown if no listbox entry is # selected. # # Arguments: None. # # Results: None. # proc uam_actAgt {} { global agents # get current selection in 'Local Agent List' set sel [.frame1.list curselection] keylset mesg :TYPE command :COMMAND chg_status foreach i $sel { set listentry [.frame1.list get $i] set agtName [lindex $listentry 0] keylset mesg :RECEIVER $agtName uam_sendMesg $mesg } } ideas/uam_delAgt.tcl100640 764 764 3567 6050144166 13735 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_delAgt # # Deletes all agents marked in listbox .frame1.list # 'Local Agent List' in UAM after user agreed to do. # An error message is shown if no listbox entry is # selected. # # Arguments: None. # # Results: # # - deletes choosen agents from array agents() # - kill agents process # - removes agents entry from .frame1.list in UAM # proc uam_delAgt {} { global agents # get the current selection in 'Local Agent List': set sel [.frame1.list curselection] # create list of marked agent listbox entries sorted # to falling numbers # set l [expr [llength $sel] -1] for {set i $l} {$i >= 0} {incr i -1} { lappend indexlist [lindex $sel $i] } # for each marked agent: # security check ! # kill agents process, remove its agents() entry # and delete entry in listbox # foreach i $indexlist { set agtName [lindex [.frame1.list get $i] 0] set del_ok [uam_dialog "Delete Agent" "Are you sure you want\ to delete\nagent '$agtName' ?" left question left 0 1 OK Cancel] if {$del_ok==0} { keylget agents($agtName) FID agtFid catch {removeinput $agtFid} keylset mesg :RECEIVER $agtName :TYPE command :COMMAND exit uam_sendMesg $mesg uam_rmAgt $agtName $i } } } ideas/uam_agtAbnormExit.tcl100640 764 764 2277 6050144166 15276 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_agtAbnormExit # # Handles an abnormal exit of an agent, called by 'uam_commCtrl'. # # Arguments: # # agtFid - name of agents pipe # agtName - name of exited agent # # Results: None # proc uam_agtAbnormExit {agtFid agtName} { global agents # remove communication control from pipe catch {fileevent $agtFid readable ""} # remove information about agent uam_rmAgt $agtName BEEP uam_dialog "ERROR: abnormal exit" "Agent '$agtName' exited abnormally !" left\ error left 0 -1 OK uam_logText "Agent '$agtName' exited abnormally !\n" } ideas/desc/ 40750 764 764 0 6675456274 12017 5ustar javierjavierideas/desc/standard.agt100440 764 764 2473 5740464320 14375 0ustar javierjavier# This is the standard file for an agent ASL-description. # # It is read only, so save it under a new name ending with '.agt' # in directory 'desc' and use it to define a new agent following # the ASL-Syntax (see 'ASL: The Agent Specification Language (ASL)' in # IDEAS-Help-Index for a full description). # # Lines begining with a '#'-character will be ignored. # # As usual in Tcl-scripts the sequence backslash-newline can be used # to spread a long Tcl-command in an action across multiple lines. # # You can insert description parts from others files in directory # 'ideas/desc' with the command 'load ' somewhere in the # script outside of '()'-brackets. # The content of is inserted in place of the 'load' # command. # # insert in 'ACTION-C-SOURCE' the name of the C file including the # extended actions for this agent type # ACTION-C-SOURCE {standard.c} BELIEFS { # insert initial BELIEFS here # syntax: () | # ((), [, ]) } BELIEF-RULES { # insert BELIEF-RULES here # syntax: () } MESSAGE-RULES { # insert MESSAGE-RULES here # syntax: ((), (), ([]), # ([]), ([])) } ACTIONS { # insert ACTIONS here # syntax: () }ideas/desc/coala_bsca_actions100644 764 764 16011 6675457323 15646 0ustar javierjavier# bsca_eval : # Tests for better payoff vector ( proc bsca_eval {old_payoff new_payoff} { global all my_coal set eval True foreach agent [bsca_get_coals $my_coal] { if {[lindex $new_payoff [lsearch $all $agent]] < [lindex $old_payoff [lsearch $all $agent]]} { set eval False } } return $eval } ) # bsca_decide_representative : # Select a representative for a given coalition ( proc bsca_decide_representative {coalition} { return [lindex [lsort $coalition] 0] } ) # bsca_decide_representative_full : # Select a representative for a given coalition and # returns it full network address ( proc bsca_decide_representative_full {coalition} { global OTHER SELF set agent [bsca_decide_representative $coalition] set agents [array names OTHER] lappend agents $SELF return [lindex $agents [lsearch -glob $agents "$agent\.*"]] } ) # bsca_decide : # decides upon the monetary acceptance of a payoff configuration ( proc bsca_decide {payoff_vector SPropSet RPropSet} { global all my_coal set decide True # ===== test foreach other (sent or received) proposal foreach other_proposal [concat $SPropSet $RPropSet] { foreach agent [bsca_get_coals $my_coal] { # ===== if the payoff for any agent in my_coal is better than in # ===== the given payoff_vector if {[lindex [lindex $other_proposal 1] [lsearch $all $agent]] > [lindex $payoff_vector [lsearch $all $agent]]} { set decide False } } } return $decide } ) # bsca_broadcast : # sends a message to all other coalitions (respectively to # their representatives) ( proc bsca_broadcast {Mesg} { global my_coal coal_struct for {set i 0} {$i < [llength $coal_struct]} {incr i} { keylset Mesg :RECEIVER [bsca_decide_representative_full [lindex $coal_struct $i]] agt_send $Mesg } } ) # bsca_prop_better : # determines if first proposal ist better than second # (select_proposal) ( proc bsca_prop_better {new old} { global PropAcceptSet if {[bsca_bi_accepted $old]} { if {[bsca_bi_accepted $new]} { if {[bsca_coal_gain_better $new $old]} { return 1 } else { return 0 } } else { return 0 } } else { if {[bsca_bi_accepted $new]} { return 1 } else { if {[bsca_coal_gain_better $new $old]} { return 1 } else { return 0 } } } } ) # bsca_bi_accepted : # determines if proposal is bilateral accepted ( proc bsca_bi_accepted {proposal} { global PropAcceptSet if {[lsearch $PropAcceptSet [list [lindex $proposal 1] [lindex $proposal 0] [lindex $proposal 2]]] == -1} { return 0 } else { return 1 } } ) # bsca_coal_gain_better : # determines if the gain of the own coalition is better when # accepting new proposal ( proc bsca_coal_gain_better {new old} { global all payoff_vector set new_gain 0 set old_gain 0 foreach agent [concat [bsca_get_coals [lindex $new 0]] [bsca_get_coals [lindex $new 1]]] { set new_gain [expr $new_gain + ( [lindex [lindex $new 2] [lsearch $all $agent]] - [lindex $payoff_vector [lsearch $all $agent]])] } foreach agent [concat [bsca_get_coals [lindex $old 0]] [bsca_get_coals [lindex $old 1]]] { set old_gain [expr $old_gain + ( [lindex [lindex $old 2] [lsearch $all $agent]] - [lindex $payoff_vector [lsearch $all $agent]])] } if {$new_gain > $old_gain} { return 1 } else { # ===== select if gains are equal if {$new_gain == $old_gain && rand() < 0.5} { return 1 } else { return 0 } } } ) # bsca_rank : # ranks the coalitions # only monetary preferences ! ( proc bsca_rank {PList} { upvar $PList PrefList set PrefList {} global coal_struct my_coal all coal_struct founder_of payoff_vector array set tmp_founder_of [array get founder_of] for {set i 0} {$i < [llength $coal_struct]} {incr i} { # ===== test if the coalition is not my coalition if {$i != $my_coal} { set C1 [bsca_get_coals $i] set C2 [bsca_get_coals $my_coal] set new_coal [lsort [concat $C1 $C2]] set tmp_founder_of($new_coal) [list $C1 $C2] for {set j 0} {$j < [llength $coal_struct]} {incr j} { if {$j != $i && $j != $my_coal} { lappend dummy [bsca_get_coals $i] } else { if {$j == $i} { set new_coal {} foreach agent [bsca_get_coals $i] { lappend new_coal $agent } foreach agent [bsca_get_coals $my_coal] { lappend new_coal $agent } set new_coal [lsort $new_coal] lappend dummy $new_coal } } } set tmp_coal_struct $dummy bsca_bsv_calc $new_coal bsv 0 tmp_founder_of # ===== calc. bsv(C_mycoal) global sum sum2 set agent_rational 1 set sum($new_coal) 0 set sum2($new_coal) 0 set sum3([bsca_get_coals $i]) 0 foreach agent [bsca_get_coals $my_coal] { set sum($new_coal) [expr $sum($new_coal) + $bsv($agent)] set sum2($new_coal) [expr $sum2($new_coal) + [lindex $payoff_vector [lsearch $all $agent]]] if {$bsv($agent) < [lindex $payoff_vector [lsearch $all $agent]]} { set agent_rational 0 } } foreach agent [bsca_get_coals $i] { set sum3([bsca_get_coals $i]) [expr $sum3([bsca_get_coals $i]) + $bsv($agent)] } # ===== test if the result is better then what we currently receive if {$agent_rational && ($sum($new_coal) > $sum2($new_coal))} { lappend PrefList [list $i $sum($new_coal) $sum3([bsca_get_coals $i])] } if {$agent_rational && ($sum($new_coal) == $sum2($new_coal)) && rand() >= 0.5} { lappend PrefList [list $i $sum($new_coal) $sum3([bsca_get_coals $i])] } unset tmp_founder_of($new_coal) } } # ===== compare command for sorting the PrefList proc rank_compare {j i} { global all coal_struct my_coal sum sum2 if {[lindex $i 1] < [lindex $j 1]} { return -1 } else { if {[lindex $i 1] > [lindex $j 1]} { return 1 } else { if {rand() >= 0.5} { return 0 } else { return 1 } } } } # ===== sort the preferences set PrefList [lsort -command rank_compare $PrefList] } ) # bsca_bsv_calc: ( proc bsca_bsv_calc {coal ref_bsv gain ref_founder_of} { global all SELF self coal_struct upvar $ref_bsv bsv upvar $ref_founder_of founder_of if {[llength $coal] == 1} { set bsv($coal) [expr [bsca_value $coal] + $gain] } else { set C1 [lindex $founder_of($coal) 0] set C2 [lindex $founder_of($coal) 1] set alloc [expr 0.5 * ([bsca_value $coal] - [bsca_value $C1] - [bsca_value $C2] + $gain)] if {[llength $C1] == 1} { set bsv($C1) [expr [bsca_value $C1]+$alloc] } else { bsca_bsv_calc $C1 bsv $alloc founder_of } if {[llength $C2] == 1} { set bsv($C2) [expr [bsca_value $C2]+$alloc] } else { bsca_bsv_calc $C2 bsv $alloc founder_of } } } ) ideas/desc/example.agt100640 764 764 3467 5760112140 14226 0ustar javierjavier# # This is a simple but complete agent script example: # The agent has a small Belief-Base with the prices of # some articles in it and answers queries on this prices. # Further ists possible to expand the Belief-Base by # an insert message. # BELIEFS { # simple Belief-Base with for facts (price(shirt, 15)) (price(shorts, 18)) (price(shoes, 45)) (price(socks, 4))} MESSAGE-RULES { # first rule: (({:TYPE query} {:ARTICLE Var_Article} {:SENDER Var_Sender} {:REPLY-WITH Var_Reply}), ([set Var_Result [agt_query price($Var_Article,Var_Price)]] != 0), (# : usr_offer $Var_Sender $Var_Reply $Var_Article $Var_Result), (# : # building a 'sorry'-message using TclX-command 'keylset'. keylset Var_Mesg :TYPE sorry \ :RECEIVER $Var_Sender \ :REPLY-TO $Var_Reply # sending a message using standard-action agt_send $Var_Mesg # make a remark in agents logfile agt_puts "Send a sorry to '$Var_Sender'!\n"), (# )) # second rule: (({:TYPE insert} {:ARTICLE Var_Article} {:PRICE Var_Price}), (1), (# : agt_insert price($Var_Article,$Var_Price) ), (# : # never used, so empty ), (# : agt_break)) # third rule: (({:TYPE insert}), (1),(),(), (# : agt_puts "Matched the third rule ..."\n))} ACTIONS { (proc usr_offer {receiver reply article result} { # building an offer-message for each article keylset mesg :TYPE offer :RECEIVER $receiver \ :REPLY-TO $reply foreach offer $result { keylget offer Var_Price price keylset mesg :PRICE $price # send the message with standard-action agt_send $mesg # make remark in agents logfile agt_puts "Offered $article for \$$price to '$receiver'.\n" } })} ideas/desc/hello.agt100640 764 764 1002 5760112612 13661 0ustar javierjavier# # This script shows, how an agent can use the initialization # message to create its own additional windows. # # Start and activate an agent based on this script to see what happens. # MESSAGE-RULES { # syntax: ((), (), ([if_action]), # ([else_action]), ([standard_action])) (({:TYPE initialization} ), (1), (catch {destroy .one} toplevel .one button .one.a -text "Hello World !" \ -command {destroy .one} pack .one.a ), (), ()) } ideas/desc/COPYRIGHT100440 764 764 1206 5765341043 13367 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # ideas/desc/coala_sixbus_a_1.agt100664 764 764 1433 6675703446 16011 0ustar javierjavierACTION-C-SOURCE {coala_sixbus_kca.c} MESSAGE-RULES { load coala_kca_rules } ACTIONS { load coala_kca_actions (proc set_self {} { global self logfile set self a_1 set logfile [open "/home/javier/COPOP/ideas/logfiles/coala_sixbus_$self" w] } ) # kca_start_args : # standard settings for all agents # and getting own name (set_self) ( proc kca_start_args {} { global all coal_struct payoff_vector csizemin csizemax alg_mode infos coala_ival set all {a_1 a_2 a_3 a_4 a_5 a_6} set coal_struct {a_1 a_2 a_3 a_4 a_5 a_6} set payoff_vector {0.0000000000 -90.0000000000 0.0000000000 -60.0000000000 -40.0000000000 -60.0000000000} set csizemin 1 set csizemax 6 set_self set alg_mode 1 set coala_ival coala_always_true } ) } ideas/desc/coala_sixbus_a_2.agt100664 764 764 1433 6675703446 16012 0ustar javierjavierACTION-C-SOURCE {coala_sixbus_kca.c} MESSAGE-RULES { load coala_kca_rules } ACTIONS { load coala_kca_actions (proc set_self {} { global self logfile set self a_2 set logfile [open "/home/javier/COPOP/ideas/logfiles/coala_sixbus_$self" w] } ) # kca_start_args : # standard settings for all agents # and getting own name (set_self) ( proc kca_start_args {} { global all coal_struct payoff_vector csizemin csizemax alg_mode infos coala_ival set all {a_1 a_2 a_3 a_4 a_5 a_6} set coal_struct {a_1 a_2 a_3 a_4 a_5 a_6} set payoff_vector {0.0000000000 -90.0000000000 0.0000000000 -60.0000000000 -40.0000000000 -60.0000000000} set csizemin 1 set csizemax 6 set_self set alg_mode 1 set coala_ival coala_always_true } ) } ideas/desc/coala_sixbus_a_3.agt100664 764 764 1433 6675703446 16013 0ustar javierjavierACTION-C-SOURCE {coala_sixbus_kca.c} MESSAGE-RULES { load coala_kca_rules } ACTIONS { load coala_kca_actions (proc set_self {} { global self logfile set self a_3 set logfile [open "/home/javier/COPOP/ideas/logfiles/coala_sixbus_$self" w] } ) # kca_start_args : # standard settings for all agents # and getting own name (set_self) ( proc kca_start_args {} { global all coal_struct payoff_vector csizemin csizemax alg_mode infos coala_ival set all {a_1 a_2 a_3 a_4 a_5 a_6} set coal_struct {a_1 a_2 a_3 a_4 a_5 a_6} set payoff_vector {0.0000000000 -90.0000000000 0.0000000000 -60.0000000000 -40.0000000000 -60.0000000000} set csizemin 1 set csizemax 6 set_self set alg_mode 1 set coala_ival coala_always_true } ) } ideas/desc/coala_sixbus_a_4.agt100664 764 764 1433 6675703446 16014 0ustar javierjavierACTION-C-SOURCE {coala_sixbus_kca.c} MESSAGE-RULES { load coala_kca_rules } ACTIONS { load coala_kca_actions (proc set_self {} { global self logfile set self a_4 set logfile [open "/home/javier/COPOP/ideas/logfiles/coala_sixbus_$self" w] } ) # kca_start_args : # standard settings for all agents # and getting own name (set_self) ( proc kca_start_args {} { global all coal_struct payoff_vector csizemin csizemax alg_mode infos coala_ival set all {a_1 a_2 a_3 a_4 a_5 a_6} set coal_struct {a_1 a_2 a_3 a_4 a_5 a_6} set payoff_vector {0.0000000000 -90.0000000000 0.0000000000 -60.0000000000 -40.0000000000 -60.0000000000} set csizemin 1 set csizemax 6 set_self set alg_mode 1 set coala_ival coala_always_true } ) } ideas/desc/coala_sixbus_a_5.agt100664 764 764 1433 6675703446 16015 0ustar javierjavierACTION-C-SOURCE {coala_sixbus_kca.c} MESSAGE-RULES { load coala_kca_rules } ACTIONS { load coala_kca_actions (proc set_self {} { global self logfile set self a_5 set logfile [open "/home/javier/COPOP/ideas/logfiles/coala_sixbus_$self" w] } ) # kca_start_args : # standard settings for all agents # and getting own name (set_self) ( proc kca_start_args {} { global all coal_struct payoff_vector csizemin csizemax alg_mode infos coala_ival set all {a_1 a_2 a_3 a_4 a_5 a_6} set coal_struct {a_1 a_2 a_3 a_4 a_5 a_6} set payoff_vector {0.0000000000 -90.0000000000 0.0000000000 -60.0000000000 -40.0000000000 -60.0000000000} set csizemin 1 set csizemax 6 set_self set alg_mode 1 set coala_ival coala_always_true } ) } ideas/desc/coala_sixbus_a_6.agt100664 764 764 1433 6675703446 16016 0ustar javierjavierACTION-C-SOURCE {coala_sixbus_kca.c} MESSAGE-RULES { load coala_kca_rules } ACTIONS { load coala_kca_actions (proc set_self {} { global self logfile set self a_6 set logfile [open "/home/javier/COPOP/ideas/logfiles/coala_sixbus_$self" w] } ) # kca_start_args : # standard settings for all agents # and getting own name (set_self) ( proc kca_start_args {} { global all coal_struct payoff_vector csizemin csizemax alg_mode infos coala_ival set all {a_1 a_2 a_3 a_4 a_5 a_6} set coal_struct {a_1 a_2 a_3 a_4 a_5 a_6} set payoff_vector {0.0000000000 -90.0000000000 0.0000000000 -60.0000000000 -40.0000000000 -60.0000000000} set csizemin 1 set csizemax 6 set_self set alg_mode 1 set coala_ival coala_always_true } ) } ideas/desc/coala_bsca_rules100644 764 764 35714 6664735730 15352 0ustar javierjavier(({:TYPE initialization}), (1), ( global SELF all self coal_struct payoff_vector phase logfile rnum repeat_msg TIMEOUT bsca_start_args bsca_initialize set phase 1 set rnum 0 set repeat_msg {} set TIMEOUT 10 ), (), () ) (({:TYPE start}), (1), ( global phase # ===== phase == 4 => waiting for representative to inform me if {$phase == 4} { agt_break } if {$phase != 1 && $phase != 4} { # # if this agent got no start-command (bsca_activated) # ignore this message (repeat it in input stream after round 1!) # global agt_VarWorkMesg repeat_msg lappend repeat_msg $agt_VarWorkMesg bell agt_break } ), ( ), ( global all self coal_struct payoff_vector logfile rnum global my_coal number_of_received_proposals PrefList RPropSet SPropSet # ===== start info in logfile if {$rnum == 0} { puts $logfile "round: 0" puts $logfile "new coalitions = $coal_struct" puts $logfile "new payoff = $payoff_vector" } incr rnum # ===== log round number puts $logfile "round: $rnum" # ===== remember start-time of phase 1 puts $logfile "start phase 1 : [bsca_times]" # ===== Find the Coalition Number in which this agent is for {set i 0} {$i < [llength $coal_struct]} {incr i} { if {[lsearch [bsca_get_coals $i] $self] != -1} { agt_puts "I am in coalition $i" set my_coal $i } } # ===== DecideRepresentative if { [bsca_decide_representative [bsca_get_coals $my_coal]] != $self } { agt_puts "I am not the representative of my coalition" puts $logfile "not representative" # ===== log times puts $logfile "end phase 1 : [bsca_times]" puts $logfile "start phase 4 : [bsca_times]" set phase 4 # ===== set timeout limit for phase 4 global timeoutpid TIMEOUT set timeoutpid [bsca_timeout_cmd $TIMEOUT { global SELF agents keylset timeout_msg :SENDER TIMEOUT :RECEIVER $SELF :TYPE timeout :REPLY-WITH 0 keylget agents(SELF) HOSTIP ipaddr keylget agents(SELF) ADDR port set port [string range $port [expr [string length $port] - 4] end] set s [socket $ipaddr $port] puts $s $timeout_msg flush $s }] } else { # ===== begin perform agt_puts "I am the representative of my coalition" # ===== logfile puts $logfile "representative for [bsca_get_coals $my_coal]" # ===== determines the prefered agents set PrefList {} bsca_rank PrefList # ===== set for remembering what this agent sent set SPropSet {} # ===== remember the most profitable coalition global Cprime set Cprime -1 for {set i 0} {$i < [llength $coal_struct]} {incr i} { if {$i != $my_coal} { # ===== Send Proposal only to the most profitable Coalition if {[lindex [lindex $PrefList 0] 0] != $i} { # if {[lsearch $PrefList [list $i *]] == -1} { agt_puts "sending 'no proposal' to coalition $i due to RANK" puts $logfile "send noprop to $i" keylset Mesg :TYPE proposal \ :RECEIVER [bsca_decide_representative_full [bsca_get_coals $i]] \ :BSV {} \ :SENDCOAL $my_coal \ :ROUND $rnum agt_send $Mesg } else { # ===== send prop # ===== remember proposal agt_puts "sending prop to coalition $i" keylset Mesg :TYPE proposal \ :RECEIVER [bsca_decide_representative_full [bsca_get_coals $i]] \ :BSV [lindex [lindex $PrefList 0] 2] \ :SENDCOAL $my_coal \ :ROUND $rnum #agt_puts $Mesg agt_send $Mesg puts $logfile "send prop [lindex [lindex $PrefList 0] 2] to $i" set Cprime $i } } } # ===== end foreach coalition # ===== repeat messages which came to early global repeat_msg agt_RecMesgList foreach entry $repeat_msg { lappend agt_RecMesgList(3) $entry } set repeat_msg {} # ===== for the next step set number_of_received_proposals 0 set RPropSet {} # ===== change to next phase set phase 2 # ===== log global logfile puts $logfile "end phase 1 : [bsca_times]" puts $logfile "start phase 2 : [bsca_times]" # ===== set timeout limit for phase 2 global timeoutpid TIMEOUT set timeoutpid [bsca_timeout_cmd $TIMEOUT { global SELF agents keylset timeout_msg :SENDER TIMEOUT :RECEIVER $SELF :TYPE timeout :REPLY-WITH 0 keylget agents(SELF) HOSTIP ipaddr keylget agents(SELF) ADDR port set port [string range $port [expr [string length $port] - 4] end] set s [socket $ipaddr $port] puts $s $timeout_msg flush $s }] } # ===== end perform ) ) # # ===== Receive 'proposal' or 'no proposal' # (({:TYPE proposal}{:BSV Bsv}{:SENDCOAL Sendcoal}{:ROUND Rround}), (1), ( global phase rnum if {($Rround < $rnum) || ($Rround == $rnum && $phase >2)} { # ==== ignore message agt_puts "IGNORE !!!" agt_break } else { if {$phase != 2} { # # remember to repeat this message because it is too early # global agt_VarWorkMesg repeat_msg lappend repeat_msg $agt_VarWorkMesg bell agt_break } } ), (), ( global number_of_received_proposals coal_struct PrefList my_coal logfile rnum RPropSet Cprime if {[lempty $Bsv]} { agt_puts "got no proposal from $Sendcoal" } else { agt_puts "got proposal $Bsv from $Sendcoal" lappend RPropSet [list $Sendcoal $Bsv] } # ===== count received proposals incr number_of_received_proposals # ===== test if we have props from all coalitions if { $number_of_received_proposals == [expr [llength $coal_struct] - 1] } { # ===== kill timeout for phase 2 global timeoutpid kill $timeoutpid # ===== logfile puts $logfile "calc phase 2 : [bsca_times]" set cform 0 # ===== Decide upon bilateral coalitions foreach entry $RPropSet { if {[lindex $entry 0] == $Cprime} { set cform 1 keylset Mesg :TYPE cform \ :RECEIVER {} \ :CSENDER $my_coal \ :COALITION $Cprime \ :ROUND $rnum bsca_broadcast $Mesg } } # ===== no coalition formation possible => broadcast NoCForm if {!$cform} { keylset Mesg :TYPE cform \ :RECEIVER {} \ :CSENDER $my_coal \ :COALITION {} \ :ROUND $rnum bsca_broadcast $Mesg } # ===== repeat too early messages global repeat_msg agt_RecMesgList foreach entry $repeat_msg { lappend agt_RecMesgList(3) $entry } set repeat_msg {} # ===== for next step global received_acceptances PropAcceptSet set received_acceptances 0 set PropAcceptSet {} set phase 3 # ===== log global logfile puts $logfile "end phase 2 : [bsca_times]" puts $logfile "start phase 3 : [bsca_times]" # ===== set timeout limit for phase 3 global timeoutpid TIMEOUT set timeoutpid [bsca_timeout_cmd $TIMEOUT { global SELF agents keylset timeout_msg :SENDER TIMEOUT :RECEIVER $SELF :TYPE timeout :REPLY-WITH 0 keylget agents(SELF) HOSTIP ipaddr keylget agents(SELF) ADDR port set port [string range $port [expr [string length $port] - 4] end] set s [socket $ipaddr $port] puts $s $timeout_msg flush $s }] } ) ) # # ===== Determine new coalition configuration # (({:TYPE cform} {:CSENDER CSender} {:COALITION Coalition} {:ROUND Rround}), (1), ( global phase rnum if {$Rround < $rnum} { # ===== ignore agt_puts "IGNORE !!!!" agt_break } else { if {$phase != 3} { # # remember this message for repeating # global repeat_msg agt_VarWorkMesg lappend repeat_msg $agt_VarWorkMesg bell agt_break } } ), ( ), ( global received_acceptances coal_struct PropAcceptSet payoff_vector logfile my_coal all founder_of incr received_acceptances # ===== really a proposal accept (no ´NoCForm´) if {![lempty $Coalition]} { lappend PropAcceptSet [list $CSender $Coalition] } if {$received_acceptances == [llength $coal_struct]} { # ===== kill timeout for phase 3 global timeoutpid kill $timeoutpid # ===== logfile puts $logfile "calc phase 3 : [bsca_times]" if {![lempty $PropAcceptSet]} { catch { unset cform } foreach entry $PropAcceptSet { set cform([lindex $entry 0]) [lindex $entry 1] set cform([lindex $entry 1]) [lindex $entry 0] } catch { unset inform_founder_of } # ===== form coalition for {set i 0} {$i < [llength $coal_struct]} {incr i} { if {![info exists cform($i)]} { lappend dummy [bsca_get_coals $i] } else { if {$i < $cform($i)} { set new_coal {} foreach agent [bsca_get_coals $i] { lappend new_coal $agent } foreach agent [bsca_get_coals $cform($i)] { lappend new_coal $agent } set new_coal [lsort $new_coal] lappend dummy $new_coal set founder_of($new_coal) [list [bsca_get_coals $i] [bsca_get_coals $cform($i)]] lappend inform_founder_of [list $new_coal [bsca_get_coals $i] [bsca_get_coals $cform($i)]] # ===== logfile puts $logfile "selected prop from $i to $cform($i)" } } } set coal_struct $dummy agt_puts "new coal_struct $coal_struct" # ===== calc. current payoff foreach coal $coal_struct { bsca_bsv_calc $coal bsv 0 founder_of } foreach agent $all { lappend tmp_payoff $bsv($agent) } set payoff_vector $tmp_payoff global all rnum # ===== ´great coalition´ ? if {[llength $coal_struct] == 1} { global logfile self agt_puts "end coalitions = $coal_struct" agt_puts "end payoff = $payoff_vector" # ===== logfile puts $logfile "end coalitions = $coal_struct" puts $logfile "end payoff = $payoff_vector" puts $logfile "end phase 3 : [bsca_times]" if {[bsca_decide_representative [lindex $coal_struct 0]] == $self} { puts $logfile "end representative for [lindex $coal_struct 0]" } close $logfile # ===== inform the members of the coalition global my_coal OTHER self foreach agent [bsca_get_coals $my_coal] { if {$agent != $self} { keylset informMesg :RECEIVER [lindex [array names OTHER] [lsearch -glob [array names OTHER] "$agent\.*"]] \ :TYPE inform \ :COAL_STRUCT $coal_struct \ :END 1 \ :PAYOFF $payoff_vector \ :FOUNDERS $inform_founder_of \ :ROUND $rnum agt_send $informMesg } } } else { # ===== no ´great coalition agt_puts "new coalitions = $coal_struct" agt_puts "new payoff = $payoff_vector" # ===== logfile puts $logfile "new coalitions = $coal_struct" puts $logfile "new payoff = $payoff_vector" # ===== inform the members of the coalition global my_coal OTHER self foreach agent [bsca_get_coals $my_coal] { if {$agent != $self} { keylset informMesg :RECEIVER [lindex [array names OTHER] [lsearch -glob [array names OTHER] "$agent\.*"]] \ :TYPE inform \ :COAL_STRUCT $coal_struct \ :END 0 \ :PAYOFF $payoff_vector \ :FOUNDERS $inform_founder_of \ :ROUND $rnum agt_send $informMesg } } # ===== next iteration set phase 1 bsca_initialize # ===== log global logfile puts $logfile "end phase 3 : [bsca_times]" global SELF keylset MESG :RECEIVER $SELF \ :TYPE start agt_send $MESG } } else { # ===== end if lempty PropAcceptSet global logfile self agt_puts "end coalitions = $coal_struct" agt_puts "end payoff = $payoff_vector" foreach coal $coal_struct { bsca_bsv_calc $coal bsv 0 founder_of } # ===== logfile puts $logfile "end coalitions = $coal_struct" puts $logfile "end payoff = $payoff_vector" puts $logfile "end phase 3 : [bsca_times]" global self my_coal all coal_struct bsca_initialize # ===== Find the Coalition Number in which this agent is for {set i 0} {$i < [llength $coal_struct]} {incr i} { if {[lsearch [bsca_get_coals $i] $self] != -1} { agt_puts "I am in coalition $i" set my_coal $i } } if {[bsca_decide_representative [bsca_get_coals $my_coal]] == $self} { puts $logfile "end representative for [bsca_get_coals $my_coal]" } close $logfile # ===== inform the members of the coalition global all my_coal OTHER self foreach agent [bsca_get_coals $my_coal] { if {$agent != $self} { keylset informMesg :RECEIVER [lindex [array names OTHER] [lsearch -glob [array names OTHER] "$agent\.*"]] \ :TYPE inform \ :COAL_STRUCT $coal_struct \ :END 1 \ :PAYOFF $payoff_vector \ :FOUNDERS {} \ :ROUND $rnum agt_send $informMesg } } } } # ====== repeat too early messages global repeat_msg agt_RecMesgList foreach entry $repeat_msg { lappend agt_RecMesgList(3) $entry } set repeat_msg {} ) ) (({:TYPE inform}{:COAL_STRUCT Coal_struct}{:PAYOFF Payoff_vector}{:FOUNDERS Founders}{:END End}{:ROUND Rround}), (1), ( global coal_struct payoff_vector logfile rnum self founder_of set coal_struct $Coal_struct set payoff_vector $Payoff_vector # ===== kill timeout for phase 4 global timeoutpid kill $timeoutpid # ===== logfile puts $logfile "round: $rnum" # ===== update founders_of foreach entry $Founders { set founder_of([lindex $entry 0]) [lrange $entry 1 2] } # ===== Representative says END COALITION if {$End} { agt_puts "end coalitions = $coal_struct" agt_puts "end payoff = $payoff_vector" # ===== logfile puts $logfile "end coalitions = $coal_struct" puts $logfile "end payoff = $payoff_vector" puts $logfile "end phase 4 : [bsca_times]" close $logfile } else { # ===== Representative only informs agt_puts "new coalitions = $coal_struct" agt_puts "new payoff = $payoff_vector" # ===== logfile puts $logfile "new coalitions = $coal_struct" puts $logfile "new payoff = $payoff_vector" # ===== count round incr rnum # ===== set timeout limit for phase 4 global timeoutpid TIMEOUT set timeoutpid [bsca_timeout_cmd $TIMEOUT { global SELF agents keylset timeout_msg :SENDER TIMEOUT :RECEIVER $SELF :TYPE timeout :REPLY-WITH 0 keylget agents(SELF) HOSTIP ipaddr keylget agents(SELF) ADDR port set port [string range $port [expr [string length $port] - 4] end] set s [socket $ipaddr $port] puts $s $timeout_msg flush $s }] } ), (), () ) (({:TYPE timeout}), (1), ( for {set i 0} {$i < 4000} {incr i} { bell } ), (), () ) ideas/desc/coala_kca_actions100644 764 764 17507 6664735730 15506 0ustar javierjavier# kca_eval : # Tests for better payoff vector ( proc kca_eval {old_payoff new_payoff} { global all my_coal set eval True foreach agent [kca_get_coals $my_coal] { if {[lindex $new_payoff [lsearch $all $agent]] < [lindex $old_payoff [lsearch $all $agent]]} { set eval False } } return $eval } ) # kca_decide_representative : # Select a representative for a given coalition ( proc kca_decide_representative {coalition} { return [lindex [lsort $coalition] 0] } ) # kca_decide_representative_full : # Select a representative for a given coalition and # returns it full network address ( proc kca_decide_representative_full {coalition} { global OTHER SELF set agent [kca_decide_representative $coalition] set agents [array names OTHER] lappend agents $SELF return [lindex $agents [lsearch -glob $agents "$agent\.*"]] } ) # kca_decide : # decides upon the monetary acceptance of a payoff configuration ( proc kca_decide {payoff_vector SPropSet RPropSet} { global all my_coal set decide True # ===== test foreach other (sent or received) proposal foreach other_proposal [concat $SPropSet $RPropSet] { foreach agent [kca_get_coals $my_coal] { # ===== if the payoff for any agent in my_coal is better than in # ===== the given payoff_vector if {[lindex [lindex $other_proposal 1] [lsearch $all $agent]] > [lindex $payoff_vector [lsearch $all $agent]]} { set decide False } } } return $decide } ) # kca_broadcast : # sends a message to all other coalitions (respectively to # their representatives) ( proc kca_broadcast {Mesg} { global my_coal coal_struct for {set i 0} {$i < [llength $coal_struct]} {incr i} { keylset Mesg :RECEIVER [kca_decide_representative_full [lindex $coal_struct $i]] agt_send $Mesg } } ) # kca_prop_better : # determines if first proposal ist better than second # (select_proposal) ( proc kca_prop_better {new old} { global PropAcceptSet if {[kca_bi_accepted $old]} { if {[kca_bi_accepted $new]} { if {[kca_coal_gain_better $new $old]} { return 1 } else { return 0 } } else { return 0 } } else { if {[kca_bi_accepted $new]} { return 1 } else { if {[kca_coal_gain_better $new $old]} { return 1 } else { return 0 } } } } ) # kca_bi_accepted : # determines if proposal is bilateral accepted ( proc kca_bi_accepted {proposal} { global PropAcceptSet if {[lsearch $PropAcceptSet [list [lindex $proposal 1] [lindex $proposal 0] [lindex $proposal 2]]] == -1} { return 0 } else { return 1 } } ) # kca_coal_gain_better : # determines if the gain of the own coalition is better when # accepting new proposal ( proc kca_coal_gain_better {new old} { global all payoff_vector set new_gain 0 set old_gain 0 foreach agent [concat [kca_get_coals [lindex $new 0]] [kca_get_coals [lindex $new 1]]] { set new_gain [expr $new_gain + ( [lindex [lindex $new 2] [lsearch $all $agent]] - [lindex $payoff_vector [lsearch $all $agent]])] } foreach agent [concat [kca_get_coals [lindex $old 0]] [kca_get_coals [lindex $old 1]]] { set old_gain [expr $old_gain + ( [lindex [lindex $old 2] [lsearch $all $agent]] - [lindex $payoff_vector [lsearch $all $agent]])] } if {$new_gain > $old_gain} { return 1 } else { # ====== select if gains are equal if {$new_gain == $old_gain && [lindex $new 0] < [lindex $old 0]} { return 1 } else { return 0 } } } ) # kca_rank : # ranks the coalitions ( proc kca_rank {PList} { upvar $PList PrefList set PrefList {} global coal_struct my_coal csizemin csizemax all coal_struct coala_ival for {set i 0} {$i < [llength $coal_struct]} {incr i} { set new_size [expr [llength [kca_get_coals $i]] + [llength [kca_get_coals $my_coal]]] # ===== test if the "new" coalition is allowed and interesting if {$i != $my_coal && $new_size >= $csizemin && $new_size <= $csizemax && [$coala_ival [kca_get_coals $i] [kca_get_coals $my_coal]] > 0} { lappend PrefList $i } } # ===== compare command for sorting the PrefList proc rank_compare {i j} { global all coal_struct my_coal coala_ival if {[$coala_ival [kca_get_coals $i] [kca_get_coals $my_coal]] < [$coala_ival [kca_get_coals $j] [kca_get_coals $my_coal]]} { return -1 } else { if {[$coala_ival [kca_get_coals $i] [kca_get_coals $my_coal]] > [$coala_ival [kca_get_coals $j] [kca_get_coals $my_coal]]} { return 1 } else { return 0 } } } # ===== sort the preferences set PrefList [lsort -command rank_compare $PrefList] } ) # coala_ival-Functions: # coala_ival_g: for v_g-CEs ( proc coala_ival_g {C1 C2} { # ===== test if infos are accessible for to_test (access is the availibilty list) (CE v_g) proc info_is_accessible_g {to_test access} { set ret_value 1 if {[lsearch $access $to_test] == -1} { set ret_value 0 } return $ret_value } global infos set ival 0 # ===== foreach agent who possibly has new infounits foreach agent $C1 { # ===== foreach infounit(s) this agent provides foreach entry $infos($agent) { # ===== foreach agent in "my" coal foreach agent2 $C2 { # ===== test if the info(s) are accessible (CE v_g) for agent2 if [info_is_accessible_g $agent2 [lindex $entry 1]] { # ====== test if this/these infounit(s) are relevant for him if {[lsearch [lindex $entry 2] $agent2] != -1} { # ===== add infounit to ival incr ival [lindex $entry 0] } } } } } return $ival } ) # coala_ival_a: for v_a-CEs ( proc coala_ival_a {C1 C2} { # ===== test if infos are accessible for to_test (access is the availibilty list) (CE v_a) proc info_is_accessible_a {to_test access provider} { foreach agent $to_test { if {[lsearch $access $agent] != -1 && $agent != $provider} { return 1 } } return 0 } global infos set ival 0 # ===== foreach agent who possibly has new infounits foreach agent $C1 { # ===== foreach infounit(s) this agent provides foreach entry $infos($agent) { # ===== test if the info(s) are accessible (CE v_a) for C1+C2 if [info_is_accessible_a [concat $C1 $C2] [lindex $entry 1] $agent] { # ===== foreach agent in "my" coal foreach agent2 $C2 { # ====== test if this/these infounit(s) are relevant for him if {[lsearch [lindex $entry 2] $agent2] != -1} { # ===== add infounit to ival incr ival [lindex $entry 0] } } } } } return $ival } ) # coala_ival_ca: for v_ca-CEs ( proc coala_ival_ca {C1 C2} { # ===== test if infos are accessible for to_test (access is the availibilty list) (CE v_ca) proc info_is_accessible_ca {to_test access} { set ret_value 1 foreach agent $to_test { if {[lsearch $access $agent] == -1} { set ret_value 0 break } } return $ret_value } global infos set ival 0 # ===== foreach agent who possibly has new infounits foreach agent $C1 { # ===== foreach infounit(s) this agent provides foreach entry $infos($agent) { # ===== test if the info(s) are accessible (CE v_ca) for C1+C2 if [info_is_accessible_ca [concat $C1 $C2] [lindex $entry 1]] { # ===== foreach agent in "my" coal foreach agent2 $C2 { # ====== test if this/these infounit(s) are relevant for him if {[lsearch [lindex $entry 2] $agent2] != -1} { # ===== add infounit to ival incr ival [lindex $entry 0] } } } } } return $ival } ) # coala_always_true: as "ival" function for games which are v(C) based ( proc coala_always_true {C1 C2} { return 1 } ) ideas/desc/coala_kca_rules100644 764 764 44060 6664735730 15172 0ustar javierjavier(({:TYPE initialization}), (1), ( global SELF all self coal_struct payoff_vector phase logfile rnum repeat_msg TIMEOUT timedout kca_start_args kca_initialize set phase 1 set rnum 0 set repeat_msg {} set TIMEOUT 60 set timedout 0 ), (), () ) (({:TYPE start}), (1), ( # ===== test if we had a timeout message global timedout if {$timedout} { agt_puts "Ignoring due to TIMEOUT !" global timeoutpid catch { kill timeoutpid } agt_break } else { global phase # ===== phase == 4 => waiting for representative to inform me if {$phase == 4} { agt_break } if {$phase != 1 && $phase != 4} { # # if this agent got no start-command (kca_activated) # ignore this message (repeat it in input stream after round 1!) # global agt_VarWorkMesg repeat_msg lappend repeat_msg $agt_VarWorkMesg # bell agt_break } } ), ( ), ( global all self coal_struct payoff_vector logfile rnum global my_coal number_of_received_proposals PrefList RPropSet SPropSet # ===== start info in logfile if {$rnum == 0} { puts $logfile "round: 0" puts $logfile "new coalitions = $coal_struct" puts $logfile "new payoff = $payoff_vector" } incr rnum # ===== log round number puts $logfile "round: $rnum" # ===== remember start-time of phase 1 puts $logfile "start phase 1 : [kca_times]" # ===== Find the Coalition Number in which this agent is for {set i 0} {$i < [llength $coal_struct]} {incr i} { if {[lsearch [kca_get_coals $i] $self] != -1} { agt_puts "I am in coalition $i" set my_coal $i } } # ===== DecideRepresentative if { [kca_decide_representative [kca_get_coals $my_coal]] != $self } { agt_puts "I am not the representative of my coalition" puts $logfile "not representative" # ===== log times puts $logfile "end phase 1 : [kca_times]" puts $logfile "start phase 4 : [kca_times]" set phase 4 # ===== set timeout limit for phase 4 global timeoutpid TIMEOUT set timeoutpid [kca_timeout_cmd $TIMEOUT { global SELF agents keylset timeout_msg :SENDER TIMEOUT :RECEIVER $SELF :TYPE timeout :REPLY-WITH 0 :PRIORITY -1 keylget agents(SELF) HOSTIP ipaddr keylget agents(SELF) ADDR port set port [string range $port [expr [string length $port] - 4] end] set s [socket $ipaddr $port] puts $s $timeout_msg flush $s }] } else { # ===== begin perform agt_puts "I am the representative of my coalition" # ===== logfile puts $logfile "representative for [kca_get_coals $my_coal]" # ===== determines the prefered agents set PrefList {} kca_rank PrefList # ===== set for remembering what this agent sent set SPropSet {} for {set i 0} {$i < [llength $coal_struct]} {incr i} { if {$i != $my_coal} { if {[lsearch -exact $PrefList $i] == -1} { agt_puts "sending 'no proposal' to coalition $i due to RANK" puts $logfile "send noprop to $i" keylset Mesg :TYPE proposal \ :RECEIVER [kca_decide_representative_full [kca_get_coals $i]] \ :PAYOFF {} \ :SENDCOAL $my_coal \ :ROUND $rnum agt_send $Mesg } else { # ===== build a coalition for checking set check_coal_struct {} for {set j 0} {$j < [llength $coal_struct]} {incr j} { if {$j != $my_coal && $j != $i} { lappend check_coal_struct [kca_get_coals $j] } } set new_formed_coalition [concat [kca_get_coals $my_coal] [kca_get_coals $i]] lappend check_coal_struct $new_formed_coalition # ===== build payoff_vector for new coalition set check_payoff_vector $payoff_vector set surplus [expr [kca_value $new_formed_coalition] - [kca_value [kca_get_coals $my_coal]] - [kca_value [kca_get_coals $i]]] # ===== only the values of the agents in the new formed coalition change foreach agent $new_formed_coalition { set old_value [lindex $check_payoff_vector [lsearch $all $agent]] set check_payoff_vector [lreplace $check_payoff_vector [lsearch $all $agent] [lsearch $all $agent] [expr $old_value + ( $surplus / [llength $new_formed_coalition])]] } # ===== calculate pKs payoff configuration set new_payoff_vector [kca_calculate_pc $check_coal_struct $check_payoff_vector] for {set ag 0} {$ag < [llength $new_payoff_vector]} {incr ag} { if {[regexp {(^[-0-9]+\.[0-9]*0+$)} [lindex $new_payoff_vector $ag]]} { set new_payoff_vector [lreplace $new_payoff_vector $ag $ag [string trimright [string trimright [lindex $new_payoff_vector $ag] "0"] "."]] } } # ===== test for better payoff (Eval) if {[kca_eval $payoff_vector $new_payoff_vector]} { agt_puts "sending 'proposal' to coalition $i" puts $logfile "send prop $new_payoff_vector to $i" keylset Mesg :TYPE proposal \ :RECEIVER [kca_decide_representative_full [kca_get_coals $i]] \ :PAYOFF $new_payoff_vector \ :SENDCOAL $my_coal \ :ROUND $rnum agt_send $Mesg # ===== remember proposal lappend SPropSet [list $i $new_payoff_vector] } else { agt_puts "sending 'no proposal' to coalition $i" puts $logfile "send noprop to $i" keylset Mesg :TYPE proposal \ :RECEIVER [kca_decide_representative_full [kca_get_coals $i]] \ :PAYOFF {} \ :SENDCOAL $my_coal \ :ROUND $rnum agt_send $Mesg } } # ===== end else lsearch $PrefList $i } # ===== end if $i != $my_coal } # ===== end foreach coalition in PrefList # ===== repeat messages which came to early global repeat_msg agt_RecMesgList foreach entry $repeat_msg { lappend agt_RecMesgList(3) $entry } set repeat_msg {} # ===== for the next step set number_of_received_proposals 0 set RPropSet {} # ===== change to next phase set phase 2 # ===== log global logfile puts $logfile "end phase 1 : [kca_times]" puts $logfile "start phase 2 : [kca_times]" # ===== set timeout limit for phase 2 global timeoutpid TIMEOUT set timeoutpid [kca_timeout_cmd $TIMEOUT { global SELF agents keylset timeout_msg :SENDER TIMEOUT :RECEIVER $SELF :TYPE timeout :REPLY-WITH 0 :PRIORITY -1 keylget agents(SELF) HOSTIP ipaddr keylget agents(SELF) ADDR port set port [string range $port [expr [string length $port] - 4] end] set s [socket $ipaddr $port] puts $s $timeout_msg flush $s }] } # ===== end perform ) ) # # ===== Receive 'proposal' or 'no proposal' # (({:TYPE proposal}{:PAYOFF Payoff_vector}{:SENDCOAL Sendcoal}{:ROUND Rround}), (1), ( # ===== test if we had a timeout message global timedout if {$timedout} { agt_puts "Ignoring due to TIMEOUT !" global timeoutpid catch { kill timeoutpid } agt_break } else { global phase rnum if {($Rround < $rnum) || ($Rround == $rnum && $phase >2)} { # ==== ignore message agt_puts "IGNORE !!!" agt_break } else { if {$phase != 2} { # # remember to repeat this message because it is too early # global agt_VarWorkMesg repeat_msg lappend repeat_msg $agt_VarWorkMesg # bell agt_break } } } ), (), ( global number_of_received_proposals coal_struct PrefList RPropSet SPropSet my_coal logfile rnum if {[lempty $Payoff_vector]} { agt_puts "got no proposal from $Sendcoal" } else { agt_puts "got proposal $Payoff_vector from $Sendcoal" lappend RPropSet [list $Sendcoal $Payoff_vector] } # ===== count received proposals incr number_of_received_proposals # ===== test if we have props from all coalitions if {$number_of_received_proposals == [expr [llength $coal_struct] - 1] } { # ===== kill timeout for phase 2 global timeoutpid kill $timeoutpid # ===== logfile puts $logfile "calc phase 2 : [kca_times]" # ===== Decide upon bilateral coalitions set PrefListEmpty 0 set PAccept 0 while {! $PrefListEmpty && ! $PAccept} { if {[lempty $PrefList]} { # ===== there are no coalition which provides infounits for # ===== this coalition # ===== so let´s look for a coalition with which we have a # ===== monetary profit foreach prop $RPropSet { set C [lindex $prop 0] if {[kca_decide [lindex $prop 1] $SPropSet $RPropSet]} { agt_puts "Broadcast PropAccept for $C (monetary profit)" keylset Mesg :TYPE proposal_accept \ :RECEIVER {} \ :CSENDER $my_coal \ :COALITION $C \ :CONFIGURATION [lindex $prop 1] \ :ROUND $rnum kca_broadcast $Mesg set PAccept 1 break } } # ===== no monetary profit coalition found if {!$PAccept} { # ===== Broadcast 'No proposal accepted' keylset Mesg :TYPE proposal_accept \ :RECEIVER {} \ :CSENDER $my_coal \ :COALITION {} \ :CONFIGURATION {} \ :ROUND $rnum kca_broadcast $Mesg set PrefListEmpty 1 break } } set C [lindex $PrefList 0] # ===== delete c set PrefList [lrange $PrefList 1 end] for {set i 0} {$i < [llength $RPropSet]} {incr i} { if {[lindex [lindex $RPropSet $i] 0] == $C} { if {[kca_decide [lindex [lindex $RPropSet $i] 1] $SPropSet $RPropSet]} { agt_puts "Broadcast PropAccept for $C" keylset Mesg :TYPE proposal_accept \ :RECEIVER {} \ :CSENDER $my_coal \ :COALITION $C \ :CONFIGURATION [lindex [lindex $RPropSet $i] 1] \ :ROUND $rnum kca_broadcast $Mesg set PAccept 1 } } } } # ===== while not PrefListEmpty # ===== repeat too early messages global repeat_msg agt_RecMesgList foreach entry $repeat_msg { lappend agt_RecMesgList(3) $entry } set repeat_msg {} # ===== for next step global received_acceptances PropAcceptSet set received_acceptances 0 set PropAcceptSet {} set phase 3 # ===== log global logfile puts $logfile "end phase 2 : [kca_times]" puts $logfile "start phase 3 : [kca_times]" # ===== set timeout limit for phase 3 global timeoutpid TIMEOUT set timeoutpid [kca_timeout_cmd $TIMEOUT { global SELF agents keylset timeout_msg :SENDER TIMEOUT :RECEIVER $SELF :TYPE timeout :REPLY-WITH 0 :PRIORITY -1 keylget agents(SELF) HOSTIP ipaddr keylget agents(SELF) ADDR port set port [string range $port [expr [string length $port] - 4] end] set s [socket $ipaddr $port] puts $s $timeout_msg flush $s }] } ) ) # # ===== Determine new coalition configuration # (({:TYPE proposal_accept} {:CSENDER CSender} {:COALITION Coalition} {:CONFIGURATION Payoff_vector}{:ROUND Rround}), (1), ( # ===== test if we had a timeout message global timedout if {$timedout} { agt_puts "Ignoring due to TIMEOUT !" global timeoutpid catch { kill timeoutpid } agt_break } else { global phase rnum if {$Rround < $rnum} { # ===== ignore agt_puts "IGNORE !!!!" agt_break } else { if {$phase != 3} { # # remember this message for repeating # global repeat_msg agt_VarWorkMesg lappend repeat_msg $agt_VarWorkMesg # bell agt_break } } } ), ( ), ( global received_acceptances coal_struct PropAcceptSet payoff_vector logfile incr received_acceptances # ===== really a proposal accept (no ´NoPAccept´) if {![lempty $Payoff_vector]} { lappend PropAcceptSet [list $CSender $Coalition $Payoff_vector] } if {$received_acceptances == [llength $coal_struct]} { # ===== kill timeout for phase 3 global timeoutpid kill $timeoutpid # ===== logfile puts $logfile "calc phase 3 : [kca_times]" if {![lempty $PropAcceptSet]} { set BestPropAccept [lindex $PropAcceptSet 0] for {set i 1} {$i < [llength $PropAcceptSet]} {incr i} { if {[kca_prop_better [lindex $PropAcceptSet $i] $BestPropAccept]} { set BestPropAccept [lindex $PropAcceptSet $i] } } agt_puts "Selected : $BestPropAccept" # ===== form new coalition structure global payoff_vector coal_struct set payoff_vector [lindex $BestPropAccept 2] set j [lindex $BestPropAccept 0] set k [lindex $BestPropAccept 1] set new_coal_struct {} for {set i 0} {$i < [llength $coal_struct]} {incr i} { if {$i != $j && $i != $k} { lappend new_coal_struct [lindex $coal_struct $i] } } # ===== logfile puts $logfile "selected prop from $j to $k" global all rnum lappend new_coal_struct [concat [kca_get_coals $j] [kca_get_coals $k]] set coal_struct $new_coal_struct # ===== ´great coalition´ ? if {[llength $coal_struct] == 1} { global logfile self agt_puts "end coalitions = $coal_struct" agt_puts "end payoff = $payoff_vector" # ===== logfile puts $logfile "end coalitions = $coal_struct" puts $logfile "end payoff = $payoff_vector" puts $logfile "end phase 3 : [kca_times]" if {[kca_decide_representative [lindex $coal_struct 0]] == $self} { puts $logfile "end representative for [lindex $coal_struct 0]" } close $logfile # ===== inform the members of the coalition global my_coal OTHER self foreach agent [kca_get_coals $my_coal] { if {$agent != $self} { keylset informMesg :RECEIVER [lindex [array names OTHER] [lsearch -glob [array names OTHER] "$agent\.*"]] \ :TYPE inform \ :COAL_STRUCT $coal_struct \ :CONFIGURATION $payoff_vector \ :END 1 \ :ROUND $rnum agt_send $informMesg } } } else { # ===== no ´great coalition agt_puts "new coalitions = $coal_struct" agt_puts "new payoff = $payoff_vector" # ===== logfile puts $logfile "new coalitions = $coal_struct" puts $logfile "new payoff = $payoff_vector" # ===== inform the members of the coalition global my_coal OTHER self foreach agent [kca_get_coals $my_coal] { if {$agent != $self} { keylset informMesg :RECEIVER [lindex [array names OTHER] [lsearch -glob [array names OTHER] "$agent\.*"]] \ :TYPE inform \ :COAL_STRUCT $coal_struct \ :CONFIGURATION $payoff_vector \ :END 0 \ :ROUND $rnum agt_send $informMesg } } # ===== next iteration set phase 1 kca_initialize # ===== log global logfile puts $logfile "end phase 3 : [kca_times]" global SELF keylset MESG :RECEIVER $SELF \ :TYPE start agt_send $MESG } } else { # ===== end if lempty PropAcceptSet global logfile self agt_puts "end coalitions = $coal_struct" agt_puts "end payoff = $payoff_vector" # ===== logfile puts $logfile "end coalitions = $coal_struct" puts $logfile "end payoff = $payoff_vector" puts $logfile "end phase 3 : [kca_times]" global self my_coal all coal_struct kca_initialize # ===== Find the Coalition Number in which this agent is for {set i 0} {$i < [llength $coal_struct]} {incr i} { if {[lsearch [kca_get_coals $i] $self] != -1} { agt_puts "I am in coalition $i" set my_coal $i } } if {[kca_decide_representative [kca_get_coals $my_coal]] == $self} { puts $logfile "end representative for [kca_get_coals $my_coal]" } close $logfile # ===== inform the members of the coalition global all my_coal OTHER self foreach agent [kca_get_coals $my_coal] { if {$agent != $self} { keylset informMesg :RECEIVER [lindex [array names OTHER] [lsearch -glob [array names OTHER] "$agent\.*"]] \ :TYPE inform \ :COAL_STRUCT $coal_struct \ :CONFIGURATION $payoff_vector \ :END 1 \ :ROUND $rnum agt_send $informMesg } } } } # ====== repeat too early messages global repeat_msg agt_RecMesgList foreach entry $repeat_msg { lappend agt_RecMesgList(3) $entry } set repeat_msg {} ) ) (({:TYPE inform}{:COAL_STRUCT Coal_struct}{:CONFIGURATION Payoff_vector}{:END End}{:ROUND Rround}), (1), ( # ===== test if we had a timeout message global timedout if {$timedout} { agt_puts "Ignoring due to TIMEOUT !" global timeoutpid catch { kill timeoutpid } agt_break } ), (), ( global coal_struct payoff_vector logfile rnum self set coal_struct $Coal_struct set payoff_vector $Payoff_vector # ===== kill timeout for phase 4 global timeoutpid kill $timeoutpid # ===== logfile puts $logfile "round: $rnum" # ===== Representative says END COALITION if {$End} { agt_puts "end coalitions = $coal_struct" agt_puts "end payoff = $payoff_vector" # ===== logfile puts $logfile "end coalitions = $coal_struct" puts $logfile "end payoff = $payoff_vector" puts $logfile "end phase 4 : [kca_times]" close $logfile } else { # ===== Representative only informs agt_puts "new coalitions = $coal_struct" agt_puts "new payoff = $payoff_vector" # ===== logfile puts $logfile "new coalitions = $coal_struct" puts $logfile "new payoff = $payoff_vector" # ===== count round incr rnum # ===== set timeout limit for phase 4 global timeoutpid TIMEOUT set timeoutpid [kca_timeout_cmd $TIMEOUT { global SELF agents keylset timeout_msg :SENDER TIMEOUT :RECEIVER $SELF :TYPE timeout :REPLY-WITH 0 :PRIORITY -1 keylget agents(SELF) HOSTIP ipaddr keylget agents(SELF) ADDR port set port [string range $port [expr [string length $port] - 4] end] set s [socket $ipaddr $port] puts $s $timeout_msg flush $s }] } ) ) (({:TYPE timeout}), (1), ( global timedout logfile set timedout 1 catch { puts $logfile "TIMEOUT" close $logfile bell } agt_puts "End of Negotiation due to TIMEOUT !" ), (), () ) ideas/desc/coala_bsca_actions~100644 764 764 16041 6675454250 16043 0ustar javierjavier# bsca_eval : # Tests for better payoff vector ( proc bsca_eval {old_payoff new_payoff} { global all my_coal set eval True foreach agent [bsca_get_coals $my_coal] { if {[lindex $new_payoff [lsearch $all $agent]] < [lindex $old_payoff [lsearch $all $agent]]} { set eval False } } return $eval } ) # bsca_decide_representative : # Select a representative for a given coalition ( proc bsca_decide_representative {coalition} { return [lindex [lsort $coalition] 0] } ) # bsca_decide_representative_full : # Select a representative for a given coalition and # returns it full network address ( proc bsca_decide_representative_full {coalition} { global OTHER SELF set agent [bsca_decide_representative $coalition] set agents [array names OTHER] lappend agents $SELF return [lindex $agents [lsearch -glob $agents "$agent\.*"]] } ) # bsca_decide : # decides upon the monetary acceptance of a payoff configuration ( proc bsca_decide {payoff_vector SPropSet RPropSet} { global all my_coal set decide True # ===== test foreach other (sent or received) proposal foreach other_proposal [concat $SPropSet $RPropSet] { foreach agent [bsca_get_coals $my_coal] { # ===== if the payoff for any agent in my_coal is better than in # ===== the given payoff_vector if {[lindex [lindex $other_proposal 1] [lsearch $all $agent]] > [lindex $payoff_vector [lsearch $all $agent]]} { set decide False } } } return $decide } ) # bsca_broadcast : # sends a message to all other coalitions (respectively to # their representatives) ( proc bsca_broadcast {Mesg} { global my_coal coal_struct for {set i 0} {$i < [llength $coal_struct]} {incr i} { keylset Mesg :RECEIVER [bsca_decide_representative_full [lindex $coal_struct $i]] agt_send $Mesg } } ) # bsca_prop_better : # determines if first proposal ist better than second # (select_proposal) ( proc bsca_prop_better {new old} { global PropAcceptSet if {[bsca_bi_accepted $old]} { if {[bsca_bi_accepted $new]} { if {[bsca_coal_gain_better $new $old]} { return 1 } else { return 0 } } else { return 0 } } else { if {[bsca_bi_accepted $new]} { return 1 } else { if {[bsca_coal_gain_better $new $old]} { return 1 } else { return 0 } } } } ) # bsca_bi_accepted : # determines if proposal is bilateral accepted ( proc bsca_bi_accepted {proposal} { global PropAcceptSet if {[lsearch $PropAcceptSet [list [lindex $proposal 1] [lindex $proposal 0] [lindex $proposal 2]]] == -1} { return 0 } else { return 1 } } ) # bsca_coal_gain_better : # determines if the gain of the own coalition is better when # accepting new proposal ( proc bsca_coal_gain_better {new old} { global all payoff_vector set new_gain 0 set old_gain 0 foreach agent [concat [bsca_get_coals [lindex $new 0]] [bsca_get_coals [lindex $new 1]]] { set new_gain [expr $new_gain + ( [lindex [lindex $new 2] [lsearch $all $agent]] - [lindex $payoff_vector [lsearch $all $agent]])] } foreach agent [concat [bsca_get_coals [lindex $old 0]] [bsca_get_coals [lindex $old 1]]] { set old_gain [expr $old_gain + ( [lindex [lindex $old 2] [lsearch $all $agent]] - [lindex $payoff_vector [lsearch $all $agent]])] } if {$new_gain > $old_gain} { return 1 } else { # ===== select if gains are equal if {$new_gain == $old_gain && [lindex $new 0] < [lindex $old 0]} { return 1 } else { return 0 } } } ) # bsca_rank : # ranks the coalitions # only monetary preferences ! ( proc bsca_rank {PList} { upvar $PList PrefList set PrefList {} global coal_struct my_coal all coal_struct founder_of payoff_vector array set tmp_founder_of [array get founder_of] for {set i 0} {$i < [llength $coal_struct]} {incr i} { # ===== test if the coalition is not my coalition if {$i != $my_coal} { set C1 [bsca_get_coals $i] set C2 [bsca_get_coals $my_coal] set new_coal [lsort [concat $C1 $C2]] set tmp_founder_of($new_coal) [list $C1 $C2] for {set j 0} {$j < [llength $coal_struct]} {incr j} { if {$j != $i && $j != $my_coal} { lappend dummy [bsca_get_coals $i] } else { if {$j == $i} { set new_coal {} foreach agent [bsca_get_coals $i] { lappend new_coal $agent } foreach agent [bsca_get_coals $my_coal] { lappend new_coal $agent } set new_coal [lsort $new_coal] lappend dummy $new_coal } } } set tmp_coal_struct $dummy bsca_bsv_calc $new_coal bsv 0 tmp_founder_of # ===== calc. bsv(C_mycoal) global sum sum2 set agent_rational 1 set sum($new_coal) 0 set sum2($new_coal) 0 set sum3([bsca_get_coals $i]) 0 foreach agent [bsca_get_coals $my_coal] { set sum($new_coal) [expr $sum($new_coal) + $bsv($agent)] set sum2($new_coal) [expr $sum2($new_coal) + [lindex $payoff_vector [lsearch $all $agent]]] if {$bsv($agent) < [lindex $payoff_vector [lsearch $all $agent]]} { set agent_rational 0 } } foreach agent [bsca_get_coals $i] { set sum3([bsca_get_coals $i]) [expr $sum3([bsca_get_coals $i]) + $bsv($agent)] } # ===== test if the result is better then what we currently receive if {$agent_rational && ($sum($new_coal) > $sum2($new_coal))} { lappend PrefList [list $i $sum($new_coal) $sum3([bsca_get_coals $i])] } # if {$agent_rational && ($sum($new_coal) == $sum2($new_coal)) && rand() >= 0.5} { # lappend PrefList [list $i $sum($new_coal) $sum3([bsca_get_coals $i])] # } unset tmp_founder_of($new_coal) } } # ===== compare command for sorting the PrefList proc rank_compare {j i} { global all coal_struct my_coal sum sum2 if {[lindex $i 1] < [lindex $j 1]} { return -1 } else { if {[lindex $i 1] > [lindex $j 1]} { return 1 } else { if {rand() >= 0.5} { return 0 } else { return 1 } } } } # ===== sort the preferences set PrefList [lsort -command rank_compare $PrefList] } ) # bsca_bsv_calc: ( proc bsca_bsv_calc {coal ref_bsv gain ref_founder_of} { global all SELF self coal_struct upvar $ref_bsv bsv upvar $ref_founder_of founder_of if {[llength $coal] == 1} { set bsv($coal) [expr [bsca_value $coal] + $gain] } else { set C1 [lindex $founder_of($coal) 0] set C2 [lindex $founder_of($coal) 1] set alloc [expr 0.5 * ([bsca_value $coal] - [bsca_value $C1] - [bsca_value $C2] + $gain)] if {[llength $C1] == 1} { set bsv($C1) [expr [bsca_value $C1]+$alloc] } else { bsca_bsv_calc $C1 bsv $alloc founder_of } if {[llength $C2] == 1} { set bsv($C2) [expr [bsca_value $C2]+$alloc] } else { bsca_bsv_calc $C2 bsv $alloc founder_of } } } ) ideas/uam_commCtrl.tcl100640 764 764 2344 6050144166 14305 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_commCtrl # # Controls pipes to agent processes with 'addinput'. # Reads message from pipe if reading event is detected # and calls 'uam_evalMesg'. # Removes agent when pipe is broken, i.e. agent process # has exited. # # Arguments: # # agtFid - agtFid of pipe event occured on # agtName - name of agent pipe comes from # # Results: None # proc uam_commCtrl {agtFid agtName} { global agents uam_RecMesgList if {[gets $agtFid mesg] == -1} { # broken pipe detected, remove agent # uam_agtAbnormExit $agtFid $agtName return } lappend uam_RecMesgList [list $agtFid $mesg] } ideas/questionbulb100640 764 764 31463 5765340677 13663 0ustar javierjavier/*----------------------------------------------------------------------------- * Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann * Computer Science Department, * Christian-Albrechts-University of Kiel, * Olshausenstr. 40, 24118 Kiel, Germany * * All rights reserved. * No warranties will be given on any issues arising out of the use * of this software product. * Permission to use, copy, modify and distribute this software * product for non-commercial purposes is hereby granted, provided * that the above copyright notice appears in all copies and * respective publications. * All commercial trades with this product outside the CAU Kiel * without specific written prior permission are prohibited. *-----------------------------------------------------------------------------/ #define questionmark_width 100 #define questionmark_height 150 static char questionmark_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x04, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x04, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x04, 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x04, 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x04, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x04, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x04, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x04, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x04, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x04, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x04, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x04, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x02, 0x00, 0x04, 0x00, 0x08, 0x00, 0x00, 0x04, 0x00, 0x00, 0x08, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x02, 0x00, 0x00, 0x10, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x01, 0x00, 0x00, 0x20, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x04, 0x00, 0x80, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x02, 0x00, 0x40, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x03, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x80, 0x07, 0x00, 0x3c, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x70, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x1c, 0x00, 0x00, 0x00, 0x07, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x10, 0x80, 0x01, 0x00, 0x00, 0x00, 0x30, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x20, 0x40, 0x00, 0x00, 0x00, 0x00, 0x40, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x30, 0x00, 0x00, 0x00, 0x00, 0x80, 0x41, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x22, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0xc0, 0xff, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x70, 0x80, 0x03, 0x00, 0x20, 0x00, 0x00, 0x03, 0x30, 0x00, 0x80, 0x00, 0x00, 0x10, 0x00, 0x02, 0x00, 0x20, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0x40, 0x00, 0x00, 0x10, 0x00, 0x02, 0x00, 0x40, 0x00, 0x30, 0x00, 0x00, 0x03, 0x40, 0x00, 0x00, 0x10, 0x00, 0x02, 0x00, 0x40, 0x00, 0x0c, 0x00, 0x00, 0x0c, 0x20, 0x00, 0x00, 0x10, 0x00, 0x02, 0x00, 0x80, 0x00, 0x03, 0x00, 0x00, 0x30, 0x10, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0xc1, 0x00, 0x00, 0x00, 0xc0, 0x10, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x21, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x7e, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0xc0, 0x40, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0xfc, 0x7f, 0x02, 0x00, 0x00, 0x80, 0x40, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x3f, 0x00, 0x00, 0x00, 0xc8, 0xff, 0x07, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x28, 0x00, 0x0e, 0x80, 0x02, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x7c, 0x01, 0x04, 0xd0, 0x07, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x98, 0x27, 0x80, 0x3c, 0x03, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x10, 0x7a, 0xd5, 0x0b, 0x01, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x10, 0x90, 0x3f, 0x01, 0x01, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x20, 0x80, 0x2e, 0x80, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x20, 0x00, 0x04, 0x80, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x20, 0x00, 0x04, 0x80, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x40, 0x00, 0x04, 0x40, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x40, 0x00, 0x04, 0x40, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x40, 0x00, 0x04, 0x40, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x80, 0x00, 0x04, 0x20, 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x00, 0x80, 0x00, 0x04, 0x20, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x01, 0x04, 0x10, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0x00, 0x01, 0x04, 0x10, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x01, 0x04, 0x10, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x00, 0x02, 0x04, 0x08, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x02, 0x04, 0x08, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x04, 0x04, 0x04, 0x00, 0x30, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x03, 0x00, 0x04, 0x04, 0x04, 0x00, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x04, 0x04, 0x04, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x08, 0x04, 0x02, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x00, 0x08, 0x04, 0x02, 0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0x10, 0x04, 0x01, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0x00, 0x10, 0x04, 0x01, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x10, 0x04, 0x01, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x20, 0x84, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0x20, 0x84, 0x00, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x07, 0x20, 0x84, 0x00, 0x1c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0e, 0x40, 0x44, 0x00, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x40, 0x44, 0x00, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7c, 0x80, 0x2e, 0xc0, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xc3, 0x7f, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; ideas/uam_evalMesg.tcl100640 764 764 7455 6050144166 14300 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_evalMesg # # Tries to match a received message with UAM mesg-rules # and to evaluate a matching rule. # # Arguments: # # fid - file descriptor mesg arrived on # mesg - mesg just received # # Results: # # Side effects belonging to evaluation of the mesg-rules. # proc uam_evalMesg {fid mesg} { global uam_MesgRules # try to format received mesg, show it unformatted if this fails if {[catch {set text [uam_formatMesg $mesg]}]} { puts "Received without format: $mesg" return } # display received message uam_logText "Message received\n$text" set ruleMatch 0 #run through all MesgRules for_array_keys ruleNo uam_MesgRules { # initialize the evaluaition break variable with NO set uam_VarBreakEval 0 # get actual Rule set actRule $uam_MesgRules($ruleNo) # get the pattern for the mesgForm from actRule set mesgForm [lindex $actRule 0] # test if listlengths of form is less than that of mesg, # if not take next MesgRule if {[llength $mesgForm] > [llength $mesg]} { continue } # get the keylist of received mesg set mesgKeys [keylkeys mesg] # get the keylist of mesgForm set keylist [keylkeys mesgForm] # test if keylists of form is include in that of mesg, # if not take next MesgRule set keyError 0 foreach mesgFormKey $keylist { if {[lsearch $mesgKeys $mesgFormKey] == -1} { set agt_keyError 1 break } } if {$keyError} {continue} # try to match the rule with the message: set matchError 0 # run through all mesg keys foreach key $keylist { keylget mesgForm $key pattern keylget mesg $key match # try to match the actual key of mesg with the pattern # in mesgForm if {![uam_keyPattMatches $pattern $match]} { set matchError 1 break } } # if the matching failed take next MesgRule if {$matchError} { continue } set ruleMatch 1 # get the mesgCond of the actRule and eval it set mesgCond [lindex $actRule 1] if {[expr $mesgCond]} { set index 2 } else { set index 3 } # depending on mesgCond choose the action of rule # and eval it set action [lindex $actRule $index] if {[catch {eval $action} errorInfo]} { uam_logText "Error when evaluating action: $action" if [info exists errorInfo] { uam_logText "errorInfo: $errorInfo" } } # if 'uam_break' is called in the action break the evaluation: # if {$uam_VarBreakEval} { break } # eval the standard action of the rule which is # done independent of mesgCond set stdAction [lindex $actRule 4] if {[catch {eval $stdAction} errorInfo]} { uam_logText "Error when evaluating stdAction: $stdAction" if [info exists errorInfo] { uam_logText "errorInfo: $errorInfo" } } # if 'uam_break' is called in the action break the evaluation: # if {$uam_VarBreakEval} { break } } } # # uam_break # # Sets global variable 'uam_VarBreakEval' to 1. This is used to break evaluation # of a message in 'uam_evalMesg' # # Arguments: None. # # Results: # # global uam_VarBreakEval is 1 # proc uam_break {} { global uam_VarBreakEval set uam_VarBreakEval 1 } ideas/uam_formatMesg.tcl100640 764 764 3573 6050144166 14636 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_formatMesg # # Formats a mesg so that it can be printed in a 'nice' form. # # Arguments: # # mesg - mesg to format # # Results: # # Returns a string, that includes all parts of the mesg. # Keys are separated from their contents by Tabs and ':'. # Returns an error if format of keyedlist in mesg is wrong. proc uam_formatMesg {mesg} { # first look for :SENDER, :RECEIVER, :TYPE and put this keys # in front of text; # then append all the other keys in alphabetical order # if {![keylget mesg :SENDER mesgSend]} { return -code error } else { append text ":SENDER \t: $mesgSend\n" keyldel mesg :SENDER } if {![keylget mesg :RECEIVER mesgRecv]} { return -code error } else { append text ":RECEIVER\t: $mesgRecv\n" keyldel mesg :RECEIVER } if {![keylget mesg :TYPE mesgType]} { return -code error } else { append text ":TYPE\t\t: $mesgType\n" keyldel mesg :TYPE } if {[catch {set keyList [lsort [keylkeys mesg]]}]} { return -code error } foreach key $keyList { append text "[string toupper $key]\t" if {[string length $key] < 8} { append text "\t" } if {[catch {append text ": [keylget mesg $key]\n"}]} { return $mesg } } return $text } ideas/uam_startEditor.tcl100640 764 764 2111 6050144167 15022 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_startEditor # # starts the define editor with a file to edit # # Arguments: # # file - filename to edit # # Results: # # Appends process-Id of editor process in list uam_VarSubProcs # so it can be removed when finishing the UAM. # proc uam_startEditor {file} { global ideas_Editor uam_VarSubProcs set save_path [pwd] cd [file dirname $file] lappend uam_VarSubProcs [eval "exec $ideas_Editor [file tail $file] &"] cd $save_path } ideas/alarmclock100640 764 764 2520 5765340677 13227 0ustar javierjavier/*----------------------------------------------------------------------------- * Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann * Computer Science Department, * Christian-Albrechts-University of Kiel, * Olshausenstr. 40, 24118 Kiel, Germany * * All rights reserved. * No warranties will be given on any issues arising out of the use * of this software product. * Permission to use, copy, modify and distribute this software * product for non-commercial purposes is hereby granted, provided * that the above copyright notice appears in all copies and * respective publications. * All commercial trades with this product outside the CAU Kiel * without specific written prior permission are prohibited. *-----------------------------------------------------------------------------/ #define alarmclock_width 24 #define alarmclock_height 24 static char alarmclock_bits[] = { 0x00, 0x1c, 0x00, 0xf8, 0xdd, 0x07, 0xfc, 0xeb, 0x0f, 0xfe, 0x88, 0x1f, 0xfe, 0xff, 0x1f, 0xfe, 0xff, 0x1f, 0xfe, 0xc1, 0x1f, 0x76, 0x08, 0x1b, 0x30, 0x08, 0x06, 0x18, 0x08, 0x0c, 0x18, 0x08, 0x0c, 0x0c, 0x08, 0x18, 0x0c, 0x08, 0x18, 0x2c, 0x08, 0x1a, 0x0c, 0x08, 0x18, 0x0c, 0x04, 0x18, 0x18, 0x02, 0x0c, 0x18, 0x01, 0x0c, 0x30, 0x00, 0x06, 0x70, 0x08, 0x07, 0xe0, 0xc1, 0x03, 0xc0, 0xff, 0x01, 0xe0, 0xff, 0x03, 0xf0, 0x80, 0x07}; ideas/uam_initShortHelp.tcl100640 764 764 16556 6050144166 15353 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_initShortHelp.tcl # # This file initializes the ShortHelp for UAM. # The array 'uam_Shorthelp' is filled with help text for # specified UAM widgets. # # Entries have the following format: # # set uam_ShortHelp(widgetName) {helpText helfile.hlp} # # This causes 'helpText' to been shown as shortHelp # for widget 'widgetName' and 'helpfile.hlp' is shown in the # IDEAS-Help-System if it is invoke out of the Shorthelp window. # # # ShortHelp about ShortHelp # set uam_ShortHelp(.shortHelp) \ {"The IDEAS - ShortHelp :\n\nThe ShortHelp is\ invoked by pointing with the cursor on a detail of an IDEAS-window\ and pressing the right mouse button.\n\nIf ShortHelp is available for\ this item a window like this appears and gives you a short\ description." shortHelp.hlp} # # ShortHelp about the UAM main window # set uam_ShortHelp(.frame1) \ {"The User Agent Manager :\n\nAs the name says it manages the\ agents of the user.\n\nIt provides tools to specify and control\ them and takes the minutes of all actions in a logfile." uam.hlp} set uam_ShortHelp(.frame1.lbl) $uam_ShortHelp(.frame1) set uam_ShortHelp(.frame2.lbl) $uam_ShortHelp(.frame1) set uam_ShortHelp(.frame2) $uam_ShortHelp(.frame1) set uam_ShortHelp(.mbar) $uam_ShortHelp(.frame1) set uam_ShortHelp(.mbar.exit) \ {"The Exit Menu :\n\nUse it to quit the User Agent\ Manager.\n\n'Ctrl-q' is a shortcut." uam.hlp} set uam_ShortHelp(.mbar.exit.menu) $uam_ShortHelp(.mbar.exit) set uam_ShortHelp(.mbar.spec) \ {"The Specification Menu :\n\nContains functions to\ create and edit\n\nagent descriptions written in the Agent\ Specification Language (ASL),\n\nlocal Multi-Agent-Systems (MAS)\ and\n\nthe Action-C-Sources, which allows you to specify actions\ for the agents in C additionally to that written in TCL." uam.hlp} set uam_ShortHelp(.mbar.spec.menu) $uam_ShortHelp(.mbar.spec) set uam_ShortHelp(.mbar.spec.menu.agt) $uam_ShortHelp(.mbar.spec) set uam_ShortHelp(.mbar.spec.menu.mas) $uam_ShortHelp(.mbar.spec) set uam_ShortHelp(.mbar.spec.menu.act) $uam_ShortHelp(.mbar.spec) set uam_ShortHelp(.mbar.view) \ {"The View Menu :\n\nContains a menubutton to show or to hide (resp.)\ the User Agent Managers Logfile." uam.hlp} set uam_ShortHelp(.mbar.view.menu) $uam_ShortHelp(.mbar.view) set uam_ShortHelp(.mbar.help) \ {"The Help Menu :\n\nIt leads you to the IDEAS Help-System." uam.hlp} set uam_ShortHelp(.mbar.help.menu) $uam_ShortHelp(.mbar.help) set uam_ShortHelp(.frame1.list) \ {"The Agent List :\n\nThis list contains all agents currently local\ to this User Agent Manager.\n\nIt displays name, type and\ status of the agents.\n\nYou can select one agent from list by\ clicking on it or select more then one by moving the mouse cursor\ over them while holding the left button pressed down." uam.hlp} set uam_ShortHelp(.frame2.newB) \ {"The 'New'-Button :\n\nIt enables you to initialize a new\ agent by giving an identifier and selecting a specification from\ a list of all existing ASL-files." uam.hlp} set uam_ShortHelp(.frame2.actB) \ {"The 'Activate/Deactivate'-Button :\n\nAfter selecting an agent\ from the Agent List you can invoke this button to change its status\ from active to deactive and vice versa." uam.hlp} set uam_ShortHelp(.frame2.delB) \ {"The 'Delete'-Button :\n\nAfter selecting an agent from the Agent\ List you can delete it from the system by invoking this button.\ \nBefore deletion is executed you have to confirm." uam.hlp} set uam_ShortHelp(.frame2.mesgB) \ {"The 'Message To'-Button :\n\nInvoke this button to specify a message and\ send it to one or some of the local agents.\n\nYou can specify\ the receiver of the message by selection from the Agent List before\ invoking the button." uam.hlp} set uam_ShortHelp(.log) \ {"The Logfile Widget :\n\nIn this widget you can\ control UAMs activities by having a look in its Logfile.\n\nIn the\ Logfile the UAM takes the minute of his activities and shows\ each message sent to the agents and received from them.\n\nThe\ 'Auto-Scroll'-checkbutton is used to see always the latest entry\ in the widget." uam.hlp} set uam_ShortHelp(.log.label) $uam_ShortHelp(.log) set uam_ShortHelp(.log.mbar) $uam_ShortHelp(.log) set uam_ShortHelp(.log.mbar.scroll) $uam_ShortHelp(.log) set uam_ShortHelp(.log.text) $uam_ShortHelp(.log) # # ShortHelp for the 'Shortcuts' window # set uam_ShortHelp(.shorts)\ {"The Shortcuts Window :\n\nIt allows you to predefine messages to\ use in the 'Message To' window.\n\nThe list shows you all available\ shortcuts.\nYou can choice one entry and insert the message belonging\ to it in the 'Message to' window by pressing the 'Select' button or\ just doing a double click on the item.\n\nYou can use the shortcut from\ the 'Message To' window without opening the 'Shortcuts' window by\ pressing one of the key combinations shown in the list.\n\nFurther you\ can add new shortcuts for a message, edit or remove an existing one by\ using the appropriate button.\n\nSee Index for more details."\ shortcuts.hlp} set uam_ShortHelp(.shorts.f1) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.f1.t) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.f1.m) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.f1.m.title) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.f1.b) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.new) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.edit) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.del) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.sel) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.close) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.name) $uam_ShortHelp(.shorts) set uam_ShortHelp(.shorts.hotk) $uam_ShortHelp(.shorts) # # ShortHelp for the Help System # set uam_ShortHelp(.help.f0.list) \ {"The Topics List :\n\nThis listbox includes\ all available Help Topics.\nYou can select an item from the list and watch\ its content by invoking the 'Show'-button or double click."} set uam_ShortHelp(.help.f2.fr.lbl1) \ {"The Help Title :\n\nThis is the title of the Help Topic\ currently shown in the text window."} set uam_ShortHelp(.help.f2.fr.lbl2) $uam_ShortHelp(.help.f2.fr.lbl1) set uam_ShortHelp(.help.f2.text) \ {"The Help Content :\n\nHere you see the\ content of the last selected Help Topic.\n\nIts title is displayed in the\ headline."} set uam_ShortHelp(.help.f1.show) \ {"The Show Button :\n\nInvoke this button\ after selecting an Help Topic from the list to have a look at its\ content.\n\nIf no selection is made the information about the Help System\ is shown."} set uam_ShortHelp(.help.f1.close) \ {"The Close Button :\n\nIt just closes the Help System window."} ideas/uam_keyPattMatches.tcl100640 764 764 5603 6050144166 15454 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_keyPattMatches # # Tries to match a key pattern of a mesg-rule with a # key content of a received mesg. # Called by 'uam_evalMesg'. # # Arguments: # # pattern - pattern to match with # match - string that should be matched # # Results: # # Returns 1 if the match was successful. In this case the # variables of the pattern are bounded to values of the # match in the context of the calling procedure, so that # they can be used for evalling mesg cond and actions. # If matching fails 0 is returned. # proc uam_keyPattMatches {pattern match} { # indexcounter for pattern set ctp 0 # indexcounter for match set ctm 0 # counter for number of variables in pattern set ctVar 0 # get length of pattern and match set lenp [string length $pattern] set lenm [string length $match] # start matching while {$ctp <= $lenp} { set chp [cindex $pattern $ctp] set chm [cindex $match $ctm] if [ctype upper $chp] { # prefix of variable in pattern detected incr ctVar # read name of variable, # i. e. char of form a-z, A-Z, 0-9, _ while {([ctype alnum $chp] || [cequal $chp _])} { append varName($ctVar) $chp incr ctp set chp [cindex $pattern $ctp] } # $chp is now separator after varName # initialize variable named $varName($ctVar) at # one level up upvar $varName($ctVar) localVar$ctVar catch {unset localVar$ctVar} set varCont($ctVar) "" # read char from match until separator or end of match # is reached while {(![cequal $chm $chp]) && ($ctm <= $lenm)} { append varCont($ctVar) $chm incr ctm set chm [cindex $match $ctm] } # if end of match is reached befor separator is read # matching failed if {$ctm > $lenm} { return 0 } # else content for variable is examined and saved in # varCont($ctVar), so continue matching continue } # in case of no variable in pattern just compare the # actual characters if [cequal $chp $chm] { incr ctp incr ctm } else { return 0 } } # if strings are completely matched set varCont to its # variable at upper level for {set ct 1} {$ct <= $ctVar} {incr ct} { set localVar$ct $varCont($ct) } return 1 } ideas/uam_lbTools.tcl100640 764 764 3354 6050375557 14157 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_lbTools.tcl # # This file includes some procedures to handle with listboxes used # in 'ideas', 'uam_edActSrcFile', 'uam_edSystemFile', 'uam_edTypeFile' # and 'uam_newAgent'. # # uam_fillLb # # Fills the listbox 'lb' with a list of all the files matching 'filter' # in the actual directory . # proc uam_fillLb {lb filter} { $lb delete 0 [$lb size] catch { foreach i [lsort [eval "glob $filter"]] { $lb insert end [file tail $i] } } } # uam_insertLbSel # # Copies actual selected entry in listbox 'lb' into # entry-field 'inpt' # proc uam_insertLbSel {lb inpt} { $inpt delete 0 end if {![catch {set sel [$lb get active]}]} { $inpt insert 0 $sel } } # uam_selectLbEntry # # Selects an entry in listbox 'lb' relativ to argument 'i': # $i == #-1 prior entry # $i == #+1 next entry # else: select entry with index $i # proc uam_selectLbEntry {lb i} { set curInd 0 if {($i == "#-1") || ($i == "#+1")} { set curInd [lindex [$lb curselection] 0] incr curInd [crange $i 1 end] } else { set curInd $i } $lb selection clear 0 end $lb selection set $curInd } ideas/uam_registerAgt.tcl100640 764 764 14533 6052354671 15036 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_registerAgt # # When an agent has initialized or changed status it sends a statusmesg # to his UAM. # There is a UAM MesgRule to catch this mesg, which calls this proc # to register the agents status to UAM. # # Arguments: # # fid - filedesc on which the mesg arrived # agtIdfk - keyedList that includes the agents status # # Results: None. # proc uam_registerAgt {fid agtIdfk} { global agents uam_VarSystem # get name out of agents identifikation - includes a format check of keyedList # if {[catch {set result [keylget agtIdfk NAME agtName]}]} { uam_logText "WARNING - received wrong formatted\ status-message.\nMessage ignored!\n" return } if {$result == 0} { uam_logText "WARNING - received wrong formatted status-message:\nKey\ 'NAME' is missing in identifikation.\nMessage ignored!\n" return } if {[info exists agents($agtName)]} { # the UAM knows this agent already, so this is a status change # if {![cequal [keylget agents($agtName) FID] $fid]} { uam_logText "WARNING - received status-message on foreign FID:\ $fid\nMessage ignored!\n" return } if {[keylget agtIdfk STATUS agtStatus] == 0} { uam_logText "WARNING - received wrong formatted status-message:\nKey\ 'STATUS' is missing in identifikation.\nMessage ignored!\n" return } # save the new status and actualize the listbox entry for this agent # keylset agents($agtName) STATUS $agtStatus # search the listbox entry set size [expr [.frame1.list size]-1] for {set i 0} {$i <= $size} {incr i} { set listItem [.frame1.list get $i] if {[string match $agtName* $listItem]} { set listItem [lreplace $listItem 4 4 $agtStatus] .frame1.list insert $i $listItem .frame1.list delete [expr $i + 1] # select the entry after all .frame1.list selection set $i return } } return } # the agent is unknown to UAM till now # but then there is an entry in array 'agents' for this name without # '.portno' because the agent has been inited by this UAM. # So remove this old entry and register the new one. # set oldAgtName [crange $agtName 0 [string last . $agtName]-1] keylget agents($oldAgtName) FID agtFid if {![cequal $agtFid $fid]} { uam_logText "WARNING - received message on foreign FID:\ $fid\nMessage ignored!\n" return } # Re-set communication control on pipe to/from agent to full name # fileevent $agtFid readable "uam_commCtrl $agtFid $agtName" set agents($agtName) $agents($oldAgtName) unset agents($oldAgtName) keylset agents($agtName) NAME $agtName keylget agents($agtName) TYPE typeFile # insert new agent in agentslist # .frame1.list insert end "$agtName / $typeFile / deact" if {[.frame1.list size] == 1} { .frame1.list selection set 0 } # let the activate, delete and mesg-to button appear normal # .frame2.actB configure -state normal .frame2.delB configure -state normal .frame2.mesgB configure -state normal bind . {.frame2.actB flash;.frame2.actB invoke} bind . {.frame2.delB flash;.frame2.delB invoke} bind . {.frame2.mesgB flash;.frame2.mesgB invoke} uam_logText "Registered: $agents($agtName)\n" # if the agent is generated in an auto-built MAS remove it from # global array uam_VarSystem to remember that it has been initialized set oldAgtName [crange $agtName 0 [string first . $agtName]-1] if {[info exists uam_VarSystem($oldAgtName)]} { unset uam_VarSystem($oldAgtName) } # if all agents which were auto-built are initialized, we can send # handshakes to set the communication paths of the MAS. # The information about the path is stored in uam_VarSystem(CON). # (see uam_startMAS for details) # if {[array size uam_VarSystem] == 1} { if ![lempty $uam_VarSystem(CON)] { uam_logText "Trying to connect the MAS now...\n" } # get all the existing local agents # set existAgts [array names agents] foreach con $uam_VarSystem(CON) { set addrList "" # get the receiver of the handshake and search for his real name, # i.e. his specified name with host and portno # set agtName [lindex $con 0] set receiver [lindex $existAgts [lsearch $existAgts $agtName.*]] if [lempty $receiver] { uam_logText "MAS-connect-Error: Unknown local agent '$agtName'!\n" uam_conMASError $agtName continue } # do the same for the agents to connect to # foreach agtName [lreplace $con 0 0] { # get the name of a connection partner # set conPartner [lindex $existAgts [lsearch $existAgts $agtName.*]] if {[lempty $conPartner]} { uam_logText "MAS-connect-Error: Unknown local agent\ '$agtName'!\n\Cannot connect '$receiver' with\ '$agtName'.\n" uam_conMASError $agtName } else { # extract the address from name and append it to connect list # lappend addrList \ [crange $conPartner [string first . $conPartner]+1 end] } } if {![lempty $addrList]} { uam_logText "Auto-Connect '$receiver' with '$addrList':\n" keylset mesg :RECEIVER $receiver \ :TYPE command \ :COMMAND handshake \ :ADDRESS $addrList uam_sendMesg $mesg } } if ![lempty $uam_VarSystem(CON)] { uam_logText "...auto-connecting finished.\n" } # after initializing the connections remove the uam_VarSystem(CON) entry # set uam_VarSystem(CON) "" # special hack to reset the cursor in mbar after compilation # in some special cases... .mbar configure -cursor {} } } ideas/uam_rmAgt.tcl100640 764 764 3560 6052354671 13606 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_rmAgt # # Removes a agent from UAMs environment. # # Arguments: # # agtName - Name of an agent to remove # agtLbIndex - ListboxIndex of agent in uams agentlist, # maybe unspecified # # Results: # None # proc uam_rmAgt {agtName {agtLbIndex -1}} { global agents # wait for exited agentsProcess # catch {wait [keylget agents($agtName) PID]} # close pipe to agent # catch {close [keylget agents($agtName) FID]} set listB .frame1.list # examine listboxentry of agent if not specified # if {$agtLbIndex == -1} { for {set agtLbIndex 0} {$agtLbIndex <= [expr [$listB size]-1]} \ {incr agtLbIndex} { if {[lindex [$listB get $agtLbIndex] 0]==$agtName} { break } } } # delete agent from agentslist # .frame1.list delete $agtLbIndex .frame1.list selection set $agtLbIndex .frame1.list yview 0 # if Agent List is empty now, disable the activate, # delete and mesg-to button # if {[.frame1.list size] == 0} { .frame2.actB configure -state disabled .frame2.delB configure -state disabled .frame2.mesgB configure -state disabled bind . "" bind . "" bind . "" } # delete agents array entry # catch {unset agents($agtName)} update idletasks } ideas/uam_sendMesg.tcl100640 764 764 3604 6050144167 14273 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_sendMesg # # Sends a well formatted message to other agents. # If something is wrong, an error is displayed and # message is not sent. # # Arguments: # # mesg - message to send # # Results: # # None. # proc uam_sendMesg {mesg} { global agents uam_MesgCounter # fill in return sender of message # keylset mesg :SENDER UAM keylset mesg :REPLY-WITH $uam_MesgCounter # check format of message # if {[catch {set text [uam_formatMesg $mesg]} errorMesg]} { uam_logText "FORMAT-ERROR when trying to send:\n$mesg\nFailure:\ '$errorMesg'\n" break } if {[catch {keylget mesg :REPLY-TO}]} { keylset mesg :REPLY-TO none } incr uam_MesgCounter keylget mesg :RECEIVER receiverList foreach agtName $receiverList { if {([catch {keylget agents($agtName) FID agtFid}]) || \ ([cequal $agtName UAM])} { uam_logText "UNKNOWN-ADDRESS-ERROR when trying to send:\n$text" uam_sendMesgError "Unknown-Address-Error:\n\n'$agtName' \ in Message\n\n$text" } elseif {[catch {puts $agtFid $mesg; flush $agtFid}]} { uam_logText "WRITE-ERROR when trying to send:\n$text" } else { uam_logText "Message sent to $agtName\n$text" wm withdraw .mesgTo focus .mbar } } } ideas/uam_showShortHelp.tcl100640 764 764 5430 6050375557 15347 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_showShortHelp # # This procedure is invoked by pressing the right mouse button # on widgets in UAM. # It creates a shortHelp window and shows a helptext registered # for this widget. # # Arguments: # # helpItem - widget name to show help for # xPos - x-coordinate for help window # yPos - y-coordinate for help window # # Results: # # None. # proc uam_showShortHelp {helpItem xPos yPos} { global uam_ShortHelp # initialize shortHelp at first call # if {![info exists uam_ShortHelp]} { source uam_initShortHelp.tcl } if {![info exists uam_ShortHelp($helpItem)]} { return } set w .shortHelp catch {destroy $w} toplevel $w wm withdraw $w wm title $w "IDEAS - ShortHelp" wm iconname $w "ShortHelp" frame $w.f1 frame $w.f2 pack $w.f1 -padx 5 -pady 5 -fill both -expand yes pack $w.f2 -side bottom -padx 5 -pady 5 -fill x button $w.but1 -text Index \ -command "destroy $w uam_initHelp [lindex $uam_ShortHelp($helpItem) 1]" \ -width 8 pack $w.but1 -in $w.f2 -side left -expand 1 \ -padx 3m -ipadx 2m -ipady 1m button $w.but2 -text Close \ -command "destroy $w" \ -width 8 pack $w.but2 -in $w.f2 -side left -expand 1 \ -padx 3m -ipadx 2m -ipady 1m text $w.text -relief raised -bd 2 \ -yscrollcommand "$w.scroll set" \ -font -Adobe-Times-Medium-R-Normal-*-180-* \ -wrap word \ -height 8 \ -width 35 scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -in $w.f1 -side right -fill y pack $w.text -in $w.f1 -side left -fill both -expand yes bind $w "set uam_VarSafeFocus [focus]; focus $w" bind $w {focus $uam_VarSafeFocus} bind $w "$w.but1 invoke" bind $w "$w.but2 flash; $w.but2 invoke" update idletasks if {$xPos < 0} { set dad [winfo parent $w] set xPos [expr [winfo x $dad] + \ ([winfo reqwidth $dad] - [winfo reqwidth $w])/2] set yPos [expr round([winfo y $dad] + [winfo reqheight $dad]*0.3)] } wm geometry $w +$xPos+$yPos wm minsize $w [winfo reqwidth $w] [winfo reqheight $w] wm deiconify $w $w.text insert end [lindex $uam_ShortHelp($helpItem) 0] $w.text configure -state disabled } ideas/uam_stuff.tcl100640 764 764 6421 6050144167 13655 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_stuff.tcl # # This file concludes several procs that show messages in # a little toplevel to the user, using 'uam_dialog'. # # proc uam_notImpl {} { uam_dialog "Message" "This function is not implemented..." \ left info left 0 -1 OK } proc uam_noAgtIdf {} { BEEP uam_dialog "Error: No name specified" \ "You have to specify a name\nfor the new agent." \ left error left 0 -1 OK focus .init.top.inpt } proc uam_illegalAgtName {agtName} { BEEP uam_dialog "Error: Illegal name"\ "Illegal identifier for agent name:\n\n'$agtName'\n\nAgents\ names may consist of alpha-numerical\ characters only!\n\n\Please choose another identifier." \ center error left 0 -1 OK focus .init.top.inpt } proc uam_newNameExists {agtName} { BEEP uam_dialog "Error: Existing name" \ "The specifier '$agtName' is in use already.\ \n\nYou have to specify an other name\nfor the new agent."\ left error left 0 -1 OK focus .init.top.inpt } proc uam_notExType {typeName} { BEEP uam_dialog "Error: Script not exists" \ "There is no script file existing\n with name '$typeName'\ .\n\nPlease choose a file from the list."\ left error left 0 -1 OK } proc uam_notExSystem {systemName} { BEEP uam_dialog "Error: System not exists" \ "There is no system file existing\n with name '$systemName'\ .\n\nPlease choose a file from the list."\ left error left 0 -1 OK } proc uam_notExActSrc {fileName} { BEEP uam_dialog "Error: Action-C-Source not exists" \ "There is no Action-C-Source\ file existing with name '$fileName'\ .\n\nPlease choose a file from the list."\ left error left 0 -1 OK } proc uam_sendMesgError {text} { BEEP uam_dialog "Error: Send message" $text left error left 0 -1 OK } proc uam_startMASError {system} { BEEP uam_dialog "MAS Start-Error" "Error when starting the\ \nMulti-Agent-System\n\n'$system'\n\nSee UAM logfile\ for details !" \ left error left 0 -1 OK } proc uam_conMASError {agtName} { BEEP uam_dialog "MAS Connection-Error" "Error when trying to connect in\ \nMulti-Agent-System.\n\nCannot connect\ agent\n\n'$agtName'\n\nSee UAM logfile\ for details !" \ center error left 0 -1 OK } proc uam_actSrcError {agtType} { BEEP uam_dialog "Action-C-Source Error" \ "Action-C-Source Error\nwhen starting Agent \ with script\n\n'$agtType'\n\nSee UAM logfile\ for details !" \ center error left 0 -1 OK } ideas/README100640 764 764 6252 6526017221 12040 0ustar javierjavierThe Interactive Development Environment for Agent Systems IDEAS is a testbed for agent oriented programming. IDEAS provides the following features: - An interactive user plattform called the 'User Agent Manager (UAM)' under X-Windows environment. - An Agent Description Language (ASL) using Tcl/Tk for agent programming. - Extensionality with procedures written in C. - A Belief and message oriented approach for agent description. - Using Prolog for Belief representation and inferences. - Autonomity of the agents. - Real physical distribution by using TCP/IP sockets for communication. - Tools for controlling and debugging the activities of an agent. - Built-in Help-System. IDEAS 1.0b uses John Ousterhout's Tool Command Language Tcl with the X-Windows extension Tk in the versions Tcl 7.6 and Tk 4.2. Further it needs the Tcl/Tk extensions TclX 7.6 by Karl Lehenbauer and Mark Diekhans. Realization of Belief-Base is done with BinProlog 3.0 by Paul Tarau. (For Linux use BinProlog 3.45 or above !) IDEAS 1.0b was tested on Sun SPARCstations with Solaris 2.4, but it should work on any system Tcl/Tk and BinProlog are running on. How to install IDEAS 1.0b: 1. Retrieve and install Tcl 7.4 and Tk 4.0; original site: ftp://ftp.aud.alcatel.com/tcl some mirror sites: ftp://ftp.uu.net/languages/tcl ftp://ftp.ibp.fr/pub/tcl ftp://ftp.cs.tu-berlin.de/pub/tcl ftp://syd.dit.csiro.au/pub/tk/berkeley ftp://ftp2.fujixerox.co.jp/pub/tcl ftp://ftp.germany.eu.net/pub/programming/tools/tcl 2. Retrieve and install TclX 7.4; original site: ftp://ftp.neosoft.com/pub/tcl/distrib; (you find Tcl/Tk on this site, too) 3. Retrieve and install BinProlog 3.0; original site: ftp://clement.info.umoncton.ca also: ftp://ftp.informatik.uni-kiel.de/pub/languages/prolog 4. Retrieve IDEAS 1.0b; original site: ftp://ftp.informatik.uni-kiel.de/pub/kiel/ideas 5. Unzip and untar IDEAS 1.0b: % gunzip -c ideas-1b.tar.gz | tar xvf - This creates the following directories: ideas 350 KB main directory ideas/desc 6 KB directory for agent scripts ideas/help 50 KB help directoy ideas/logfiles 1 KB directory for agent Logfiles ideas/save 2 KB directory for saving Belief-Bases ideas/sources 6 KB directory for extensions written in C ideas/systems 1 KB directory for scripts defining Multi Agent Systems 8. Change working directory to 'ideas': % cd ideas 9. Set a link to BinProlog source directory on 'progs'; for example, if your source directory is '/home/prolog/BinProlog3.0/src' type: % ln -s /home/prolog/BinProlog3.0/src progs 10. Compile the file 'agt_prologServ.pl' using BinProlog: % bp ?- make(agt_prologServ). ?- halt. 11. Adapt the file 'init.tcl' to your local environment. You may wish to adapt the IDEAS X resource file '.ideasXdefaults', too. 12. Adapt the path of 'wishx' in the first line of the scriptfile 'ideas' to your local environment. 13. Start IDEAS: % ideas 14. Read the IDEAS Help-System for information about using IDEAS. Mention the IDEAS copyright notice. ideas/agt_logComm.tcl100640 764 764 3036 6050144165 14111 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_logComm # # Displays text in agents observer window and # writes it to the Communication Logfile. # # Arguments: # # text - text to display # nextLine - if '0' begin no newline after text, # default 1 # # Results: # # None. # proc agt_logComm {text {nextLine 1}} { global agents agt_VarCommScroll set logFile [keylget agents(SELF) CLGFID] if {[catch { .f5.text configure -state normal if {$nextLine != "0"} { puts $logFile $text .f5.text insert end "$text \n" } else { puts -nonewline $logFile $text .f5.text insert end "$text" } .f5.text configure -state disabled if {$agt_VarCommScroll} { .f5.text yview -pickplace end } }]} { # if user close the agent window, the agent process does # NOT stop, so an error occurs when trying to write in # the destroyed window; catch it and kill the process ! # kill [pid] } flush $logFile update } ideas/agt_displayBelBase.tcl100640 764 764 2302 6050144165 15372 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_displayBelBase # # Displays content of the Prolog Belief-Base in agents Belief-Base widget. # # Arguments: # # None. # # Results: # # None. # proc agt_displayBelBase {} { if {[catch { .f3.text configure -state normal .f3.text delete 0.0 end .f3.text insert end [agt_loudQuery listing] .f3.text configure -state disabled }]} { # if user close the agent window, the agent process does # NOT stop, so an error occurs when trying to write in # the destroyed window; catch it and kill the process ! # kill [pid] } update } ideas/agt_catchPrologCrash.tcl100640 764 764 3501 6050144165 15737 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_catchPrologCrash # # Tries to restart Prolog process and rebuilt the actual # Belief-Base after Prolog process break down. # Called on write error to Prolog from agt_writeProlog. # # Arguments: # # prologFd - filedescriptor of crashed process # # Results: # # 0, if Prolog process is re-established, # registers new Prolog process descriptor in agents(SELF); # 1, if process could not be establishes # proc agt_catchPrologCrash {prologFd} { global agents # wait for process to terminate catch {wait [pid $prologFd]} # close old Prolog filedescriptor catch {close $prologFd} agt_puts "Prolog-Process crashed !\nRebuilding now..." # start new Prolog process and register its fid # if {[agt_startProlog]} { keylset mesg :RECEIVER UAM :TYPE prolog-error agt_send $mesg agt_puts "Rebuilding failed!\n" return 1 } # save Belief-Base to a temp-file and read it back to Prolog # if {([agt_saveBelBase "agt_tmpFile"]) || \ ([agt_loadBelBase "agt_tmpFile"])} { keylset mesg :RECEIVER UAM :TYPE prolog-error agt_send $mesg agt_puts "Rebuilding failed!\n" return 1 } agt_puts "Belief-Base has been rebuilt now." catch {close $tmpFid} return 0 } ideas/systems/ 40750 764 764 0 6665020405 12566 5ustar javierjavierideas/systems/standard.mas100440 764 764 744 5740753303 15154 0ustar javierjavier# This is a standard file for a Multi-Agent-System description. # # It is read only, so save it under a new name ending with '.mas' # in directory 'systems' and use it to define a new MAS-description. # # # Syntax: # # To auto-create an agent with name based on scriptfile # insert a line # # Agent: # # To auto-connect an agent with other agents insert # # Con: ... # # ideas/systems/COPYRIGHT100440 764 764 1206 5765341067 14166 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # ideas/systems/sixbus.mas100664 764 764 452 6675703446 14710 0ustar javierjavierAgent: a_1 coala_sixbus_a_1.agt Agent: a_2 coala_sixbus_a_2.agt Agent: a_3 coala_sixbus_a_3.agt Agent: a_4 coala_sixbus_a_4.agt Agent: a_5 coala_sixbus_a_5.agt Agent: a_6 coala_sixbus_a_6.agt Con: a_1 a_2 a_3 a_4 a_5 a_6 Con: a_2 a_3 a_4 a_5 a_6 Con: a_3 a_4 a_5 a_6 Con: a_4 a_5 a_6 Con: a_5 a_6 ideas/systems/uam_shortcutsFile.tcl100664 764 764 1023 6664737511 17106 0ustar javierjavierset uam_Shortcuts(cmd.save) {{hotkey s} {content {:TYPE command :COMMAND save :FILE {} {} {} {} {}}}} set uam_Shortcuts(cmd.handshake) {{hotkey h} {content {:TYPE command :COMMAND handshake :ADDRESS {} {} {} {} {}}}} set uam_Shortcuts(cmd.reset) {{hotkey r} {content {:TYPE command :COMMAND reset {} {} {} {} {} {}}}} set uam_Shortcuts(cmd.load) {{hotkey l} {content {:TYPE command :COMMAND load :FILE {} {} {} {} {}}}} set uam_Shortcuts(cmd.testcon) {{hotkey t} {content {:TYPE command :COMMAND testcon :ADDRESS {} {} {} {} {}}}} ideas/agt_handshake.tcl100640 764 764 4635 6050144165 14450 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_handshake # # Tries to connect to a specified agent and initializes # a handshake. # # Arguments: # # agtAddr - address of the agent to connect to # # Results: # # 0 - connection established, handshake send # 1 - waiting for response already (i.e. for re-handshake) # 2 - connection exists already # 3 - connection refused # proc agt_handshake {hostportAddr} { global agents # transform the address in TCP/IP-integer form: set agtAddr [agt_hostport2addr $hostportAddr] # check if there is a connection to specified host and port # already existing # set agtList [array name agents] foreach name $agtList { if {[keylget agents($name) ADDR] == $agtAddr} { if {[catch {keylget agents($name) INFID}]} { agt_puts "Waiting for response of '$hostportAddr' already\ :\n\n$agents($name)\n" return 1 } else { agt_puts "Connection to '$hostportAddr' exists already\ :\n\n$agents($name)\n" return 2 } } } keylset agents($agtAddr) NAME $agtAddr \ ADDR $agtAddr # try to connect to specified address # if {[catch {keylset agents($agtAddr) OUTFID [agt_createCon $agtAddr]} errorMesg]} { # failure in creating connection # agt_puts "Connection to '$agtAddr' failed:\n$errorMesg\n" catch {unset agents($agtAddr)} return 3 } agt_puts "register: $agents($agtAddr)\n" # set SELF identifikation to send with handshake # keylset idfk NAME [keylget agents(SELF) NAME] \ TYPE [keylget agents(SELF) TYPE] \ ADDR [keylget agents(SELF) ADDR] keylset mesg :RECEIVER $agtAddr :TYPE handshake :IDFK $idfk agt_send $mesg agt_displAgtBitmap $agtAddr agt_drawWeak $agtAddr #agt_puts "Handshake to: $agents($agtAddr)\n" return 0 } ideas/agt_wish.c100755 764 764 11067 6665017520 13166 0ustar javierjavier/* * agt_wish.c -- Modified Version of tkXAppInit.c -- * * extends wish with tools for TCP-socket communication * see tcl_net.h for details * * Compilation: -I/usr/local/include -I/opt/X11R5/include * -ltkx -ltclx -ltk -ltcl -lm -lX11 -lsocket -lnsl * * ATTENTION: The libraries have to be linked in this order! */ /*----------------------------------------------------------------------------- * Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann * Computer Science Department, * Christian-Albrechts-University of Kiel, * Olshausenstr. 40, 24118 Kiel, Germany * * All rights reserved. * No warranties will be given on any issues arising out of the use * of this software product. * Permission to use, copy, modify and distribute this software * product for non-commercial purposes is hereby granted, provided * that the above copyright notice appears in all copies and * respective publications. * All commercial trades with this product outside the CAU Kiel * without specific written prior permission are prohibited. *----------------------------------------------------------------------------- */ /* * tkXAppInit.c -- * * Provides a default version of the Tcl_AppInit procedure for use with * applications built with Extended Tcl and Tk. This is based on the * the UCB Tk file tkAppInit.c * *----------------------------------------------------------------------------- * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans. * * Permission to use, copy, modify, and distribute this software and its * documentation for any purpose and without fee is hereby granted, provided * that the above copyright notice appear in all copies. Karl Lehenbauer and * Mark Diekhans make no representations about the suitability of this * software for any purpose. It is provided "as is" without express or * implied warranty. *----------------------------------------------------------------------------- * $Id: tkXAppInit.c,v 5.0 1995/07/25 06:00:44 markd Rel $ *----------------------------------------------------------------------------- */ #include "tclExtend.h" #include "tk.h" #include /* * The following variable is a special hack that insures the tcl * version of matherr() is used when linking against shared libraries * Even if matherr is not used on this system, there is a dummy version * in libtcl. */ EXTERN int matherr (); int (*tclDummyMathPtr)() = matherr; /* *---------------------------------------------------------------------- * * main -- * * This is the main program for the application. *---------------------------------------------------------------------- */ #ifdef __cplusplus int main (int argc, char **argv) #else int main (argc, argv) int argc; char **argv; #endif { TkX_Main(argc, argv, Tcl_AppInit); return 0; /* Needed only to prevent compiler warning. */ } /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * * This procedure performs application-specific initialization. * Most applications, especially those that incorporate additional * packages, will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error * message in interp->result if an error occurs. *---------------------------------------------------------------------- */ #ifdef __cplusplus int Tcl_AppInit (Tcl_Interp *interp) #else int Tcl_AppInit (interp) Tcl_Interp *interp; #endif { Tk_Window main; main = Tk_MainWindow(interp); /* * Call the init procedures for included packages. Each call should * look like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * * where "Mod" is the name of the module. */ if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } if (Tk_Init(interp) == TCL_ERROR) { return TCL_ERROR; } if (Tclx_Init(interp) == TCL_ERROR) { return TCL_ERROR; } if (main != NULL) { if ((Tkx_Init(interp) == TCL_ERROR)) { return TCL_ERROR; } } if (Ideas_ActSrc_Init(interp) == TCL_ERROR) { return TCL_ERROR; } /* * Specify a user-specific startup file to invoke if the application * is run interactively. Typically the startup file is "~/.apprc" * where "app" is the name of the application. If this line is deleted * then no user-specific startup file will be run under any conditions. */ /*tcl_RcFileName = "~/.tclrc";*/ return TCL_OK; } ideas/agt_logMesgEval.tcl100640 764 764 3057 6050144165 14724 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_logMesgEval # # Displays text in agents observer window and # writes it to the Message Evaluation logfile. # # Arguments: # # text - text to display # nextLine - if '0' begin no newline after text, # default 1 # # Results: # # None. # proc agt_logMesgEval {text {nextLine 1}} { global agents agt_VarMesgEvalScroll set logFile [keylget agents(SELF) MLGFID] if {[catch { .f4.text configure -state normal if {$nextLine != "0"} { puts $logFile $text .f4.text insert end "$text\n" } else { puts -nonewline $logFile $text .f4.text insert end "$text" } .f4.text configure -state disabled if {$agt_VarMesgEvalScroll} { .f4.text yview -pickplace end } }]} { # if user close the agent window, the agent process does # NOT stop, so an error occurs when trying to write in # the destroyed window; catch it and kill the process ! # kill [pid] } flush $logFile update } ideas/ideas100750 764 764 23445 6664734503 12231 0ustar javierjavier#!/usr/bin/wishx # # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # This is the start script for the User Agent Manager (UAM) in the IDEAS-System. # # arguments: # # -q Quiet-mode, doesn't show 'about'-message at the beginning. # -x the file .ideasXdefaults is not read # # You have to modify the value of the following variable, if your IDEAS # home directory is not "~/ideas" # set ideas_HomePath "$env(HOME)/COPOP/ideas" # the environment must include a HOST entry # if {[info exists env(HOST)]==0} { puts "IDEAS-Error: No Host defined in this environment!" exit } # get the creation time of the UAM # set creationTime [getclock] # set the path for auto-loading of procedures: # set auto_path "$ideas_HomePath $auto_path" cd $ideas_HomePath # # Read the ideasXdefaults for color etc. # if {([lsearch $argv -x] == -1)} { keylset agents(UAM) XDEFAULT 1 if {[catch {option readfile .ideasXdefaults} errorMesg]} { puts "Error reading \".ideasXdefaults\":\n$errorMesg" } } else { keylset agents(UAM) XDEFAULT 0 } # read the IDEAS initialization file # if {[catch {source init.tcl} errorMesg]} { puts "IDEAS-Error: $errorMesg" exit } # 'agents()' is a global array which stores information about all # agents local to this UAM in form of a keyedlist. # # possible keys: NAME TYPE STATUS HOST PID FID # # Initial setting: keylset agents(UAM) NAME UAM TYPE SUPER-AGENT STATUS act \ HOST $env(HOST) FID stdout # initialize message rules source uam_mesgRules.tcl wm withdraw . wm title . "User Agent Manager on Host '$env(HOST)'" wm iconname . "IDEAS-UAM" wm geometry . +300+200 wm minsize . 40 10 wm maxsize . 50 15 # create the main menu frame .mbar -relief ridge -bd 2 pack .mbar -side top -fill x # MENU exit: menubutton .mbar.exit -text Exit -underline 0 \ -menu .mbar.exit.menu menu .mbar.exit.menu .mbar.exit.menu ad command -label "Quit " -underline 0 \ -accelerator "Ctrl+q" -command uam_exit # MENU spec: menubutton .mbar.spec -text Specification -underline 0 \ -menu .mbar.spec.menu menu .mbar.spec.menu .mbar.spec.menu add cascade -label "Agents" -underline 0 \ -menu .mbar.spec.menu.agt bind .mbar.spec.menu {.mbar.spec.menu activate 0} menu .mbar.spec.menu.agt .mbar.spec.menu.agt add command -label "New ASL-Script" -underline 0 \ -command {uam_startEditor desc/standard.agt} bind .mbar.spec.menu {tk_mbUnpost .mbar.spec.menu.agt invoke 0} .mbar.spec.menu.agt add command -label "Edit ASL-Script" -underline 0 \ -command "uam_edScriptFile" bind .mbar.spec.menu {tk_mbUnpost .mbar.spec.menu.agt invoke 1} .mbar.spec.menu add cascade -label "Systems" -underline 0 \ -menu .mbar.spec.menu.mas bind .mbar.spec.menu {.mbar.spec.menu activate 1} menu .mbar.spec.menu.mas .mbar.spec.menu.mas add command -label "New System" -underline 2 \ -command {uam_startEditor systems/standard.mas} bind .mbar.spec.menu {tk_mbUnpost .mbar.spec.menu.mas invoke 0} .mbar.spec.menu.mas add command -label "Edit System" -underline 3 \ -command "uam_edSystemFile" bind .mbar.spec.menu {tk_mbUnpost .mbar.spec.menu.mas invoke 1} .mbar.spec.menu add cascade -label "Action-C-Sources" -underline 1 \ -menu .mbar.spec.menu.act bind .mbar.spec.menu {.mbar.spec.menu activate 2} menu .mbar.spec.menu.act .mbar.spec.menu.act add command -label "New Action-C-Source" -underline 7 \ -command {uam_startEditor sources/standard.c} bind .mbar.spec.menu {tk_mbUnpost .mbar.spec.menu.act invoke 0} .mbar.spec.menu.act add command -label "Edit Action-C-Source" -underline 9 \ -command "uam_edActSrcFile" bind .mbar.spec.menu {tk_mbUnpost .mbar.spec.menu.act invoke 1} # MENU view: menubutton .mbar.view -text View -underline 0 \ -menu .mbar.view.menu menu .mbar.view.menu .mbar.view.menu add checkbutton -label "Logfile" -underline 0 \ -variable uam_VarLogView \ -command {if {$uam_VarLogView} { pack .log -padx 3 -pady 5 -fill both -expand yes } else { pack forget .log } } # MENU help: menubutton .mbar.help -text Help -underline 0 \ -menu .mbar.help.menu menu .mbar.help.menu .mbar.help.menu add command -label "Index" -underline 0\ -command "uam_initHelp" .mbar.help.menu add command -label "ShortHelp" -underline 0\ -command "uam_showShortHelp .shortHelp -1 -1" .mbar.help.menu add command -label "Tcl-Help" -underline 0\ -command {lappend uam_VarSubProcs \ [exec $ideas_TclhelpPath &]} .mbar.help.menu add separator .mbar.help.menu add command -label "About" -underline 0\ -command "uam_aboutIdeas" pack .mbar.exit .mbar.spec .mbar.view -side left -padx 2m pack .mbar.help -side right -padx 2m tk_menuBar .mbar .mbar.exit .mbar.spec .mbar.view \ .mbar.help # Create two frames for managing the main window # this one is for the agents list and control buttons frame .ctrl pack .ctrl -fill both -expand yes # create now the content of the ctrl-frame # first divide it in two sub-frames frame .frame1 -bd 7 frame .frame2 -bd 7 pack .frame1 .frame2 -in .ctrl -side left -fill y -expand yes # Create a label in frame1 and a listbox with a scrollbar on the # right side label .frame1.lbl -text "Local Agent List:" pack .frame1.lbl -side top -anchor w scrollbar .frame1.scroll -command ".frame1.list yview" pack .frame1.scroll -side right -fill y listbox .frame1.list -yscroll ".frame1.scroll set" -relief raised \ -setgrid yes -height 10 -width 42 \ -selectmode extended\ -exportselection no pack .frame1.list -side left -fill both -expand no # Create in frame2 some buttons label .frame2.lbl -text "Agents:" pack .frame2.lbl -side top -anchor w button .frame2.newB -text "New" \ -underline 0 \ -command "uam_newAgt" button .frame2.actB -text "Activate/Deactivate" \ -underline 0 \ -command "uam_actAgt" \ -state disabled button .frame2.delB -text "Delete" \ -underline 0 \ -command "uam_delAgt" \ -state disabled button .frame2.mesgB -text "Message To" \ -underline 0 \ -command "uam_mesgTo" \ -state disabled pack .frame2.mesgB .frame2.delB .frame2.actB .frame2.newB \ -side bottom \ -pady 1 -ipadx 2m -ipady 1m -fill x # this is the frame for the logwidget frame .log -relief ridge -bd 2 label .log.label -text "Logfile:" \ -relief ridge -bd 2 frame .log.mbar -relief ridge -bd 2 checkbutton .log.mbar.scroll -text "Auto-Scroll" \ -relief flat \ -variable uam_VarLogScroll text .log.text -relief ridge -bd 2 \ -yscrollcommand ".log.scroll set" \ -wrap word \ -height 15 \ -width 65 scrollbar .log.scroll -relief ridge -command ".log.text yview" pack .log.label -side top -fill x pack .log.mbar -side top -fill x pack .log.mbar.scroll -side right -padx 2m pack .log.scroll -side right -fill y pack .log.text -side left -fill both -expand yes # set checkbutton variable for auto scrolling to on set uam_VarLogScroll 1 # set up bindings for the UAM bind all {uam_exit} bind . {.frame2.newB flash;.frame2.newB invoke} bind all {uam_showShortHelp %W %X %Y} bind all {uam_initHelp uam.hlp} bind all {uam_initHelp uam.hlp} # open logfile for agent # if {![file isdirectory logfiles]} { if {[catch {ecec [mkdir -path "logfiles"]} errorMesg]} { puts "IDEAS-Error: $errorMesg" exit } } keylget agents(UAM) HOST myHost for {set fileNo 0} {[file exists "logfiles/UAM.$myHost.$fileNo.log"]} \ {incr fileNo} {} if {[catch {set myLogFile [open "logfiles/UAM.$myHost.$fileNo.log" w]} \ errorMesg]} { puts "IDEAS-Error: $errorMesg" exit } keylset agents(UAM) LOGFID $myLogFile puts $myLogFile "Logfile for User Agent Manager\ on Host '$myHost' \ncreated at\ [fmtclock $creationTime "%a %b %d %Y, %T"]\n" flush $myLogFile update idletasks focus .mbar # initialize the .mesgTo window for messages to agents # it is unvisible at first and becomes visible when # button 'Message to' is pressed uam_initMesgTo # initialize the .short window for shortcuts in .mesgTo; # it is unvisible at first and becomes visible when # button 'Shortcut' in .mesgTo is pressed uam_initShortcuts # initialize the list of sub-processes # (for editors and tclhelp, not for agents) # set uam_VarSubProcs "" # initialize the list of connections to built for an autostart MAS # set uam_VarSystem(CON) "" # initialize the list of received messages # set uam_RecMesgList "" # initialize counter for outgoing messages # set uam_MesgCounter 0 if {([lsearch $argv -q] == -1) && !($tcl_interactive)} { uam_helloIdeas } wm deiconify . if {[file exists "first"]} { exec rm "first" uam_initHelp helpSystem.hlp } proc BEEP {} { puts -nonewline "\a" flush stdout } # enter main loop # while {1} { if [lempty $uam_RecMesgList] { tkwait variable uam_RecMesgList set uam_VarWorkMesg "" } else { set uam_VarWorkMesg [lvarpop uam_RecMesgList] uam_evalMesg [lindex $uam_VarWorkMesg 0] [lindex $uam_VarWorkMesg 1] } } ideas/uam_shortcutProcs.tcl100640 764 764 46551 6052354671 15445 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_initShortcuts # # Creates a toplevel widget for shortcuts in UAM when sending # a mesg to an agent. # # Arguments: None. # # Results: # # A widget .shorts is created but not shown. # proc uam_initShortcuts {} { global uam_Shortcuts ideas_KeyNumber global uam_VarShortKey uam_VarShortCont # create a new toplevel widget .shorts # catch {destroy .shorts} toplevel .shorts wm title .shorts "Shortcuts" wm iconname .shorts "Shorts" wm withdraw .shorts # divide .shorts vertical in two big frames # the right one is not shown yet; it will be shown on # buttonpress Edit or New defined next # frame .shorts.f1 -relief ridge -bd 3 frame .shorts.f2 -relief ridge -bd 3 pack .shorts.f1 -side left -fill both # create the left side first: # divide it horizontal in three more frames # frame .shorts.f1.t pack .shorts.f1.t -side top -fill x -pady 5 frame .shorts.f1.b pack .shorts.f1.b -side bottom -fill x -pady 5 frame .shorts.f1.m pack .shorts.f1.m \ -side top -fill both \ -padx 3m -expand 1 # create three buttons at the left top: # New, Edit, Remove # button .shorts.new -text New \ -width 8 \ -command {uam_newShortcut} button .shorts.edit -text Edit \ -width 8 \ -command {uam_editShortcut # show right frame in shorts # pack .shorts.f2 -side left -fill both focus .shorts.nameEnt } button .shorts.del -text Remove \ -width 8 \ -command {uam_removeShortcut} pack .shorts.new .shorts.edit .shorts.del \ -in .shorts.f1.t \ -side left \ -padx 2m -pady 1m -ipadx 2m -ipady 1m # create two buttons at the left bottom: # Select, Close # button .shorts.sel -text Select \ -width 8 \ -command {uam_selectShortcut} pack .shorts.sel \ -in .shorts.f1.b \ -side left \ -padx 2m -pady 2m -ipadx 2m -ipady 1m button .shorts.close -text Close \ -width 8 \ -command {wm withdraw .shorts; \ catch {pack forget .shorts.f2} uam_shortcutResetFocus} pack .shorts.close \ -in .shorts.f1.b \ -side right \ -padx 2m -pady 2m -ipadx 2m -ipady 1m # create two listboxes with a label at the left middle: # one for shortcuts and one for the hotkeys # label .shorts.f1.m.title \ -text Shortcuts: pack .shorts.f1.m.title \ -side top\ -fill x frame .shorts.listb # -bd 3 # -relief raised pack .shorts.listb \ -in .shorts.f1.m \ -fill both \ -expand 1 scrollbar .shorts.scroll \ -command "uam_shortsScrollCmd" pack .shorts.scroll \ -in .shorts.listb \ -side right \ -fill y listbox .shorts.hotk \ -yscroll ".shorts.scroll set" \ -height 8 -width 8 \ -relief raised \ -exportselection no pack .shorts.hotk \ -in .shorts.listb \ -side right \ -fill y listbox .shorts.name \ -yscroll ".shorts.scroll set" \ -relief raised \ -exportselection no pack .shorts.name \ -in .shorts.listb \ -side left \ -fill both \ -expand 1 bindtags .shorts.name {.shorts.name} bindtags .shorts.hotk {.shorts.hotk} bind .shorts.name { uam_selectLbEntry .shorts.name [.shorts.name nearest %y] uam_selectLbEntry .shorts.hotk [.shorts.name curselection] uam_editShortcut } bind .shorts.name { uam_selectLbEntry .shorts.name [.shorts.name nearest %y] uam_selectLbEntry .shorts.hotk [.shorts.name curselection] uam_selectShortcut } bind .shorts.name { uam_selectLbEntry .shorts.name [.shorts.name nearest %y] uam_selectLbEntry .shorts.hotk [.shorts.name curselection] uam_editShortcut } bind .shorts.hotk { uam_selectLbEntry .shorts.hotk [.shorts.hotk nearest %y] uam_selectLbEntry .shorts.name [.shorts.hotk curselection] uam_editShortcut } bind .shorts.hotk { uam_selectLbEntry .shorts.hotk [.shorts.hotk nearest %y] uam_selectLbEntry .shorts.name [.shorts.hotk curselection] uam_selectShortcut } bind .shorts.hotk { uam_selectLbEntry .shorts.hotk [.shorts.hotk nearest %y] uam_selectLbEntry .shorts.name [.shorts.hotk curselection] uam_editShortcut } bindtags .shorts.close {.shorts.close Button} bind .shorts.close { focus .shorts.new } # define global the variable uam_Shortcuts as an array # - special hack 8-) # set uam_Shortcuts(0) dummy unset uam_Shortcuts(0) # read file with saved shortcuts catch {source uam_shortcutsFile.tcl} # fill the listboxes and bind shortcuts # uam_fillShortcutLb # create now the right side : # divide it horizontal in three more frames # frame .shorts.f2.t pack .shorts.f2.t -side top -fill x -pady 5 frame .shorts.f2.b pack .shorts.f2.b -side bottom -fill x -pady 5 frame .shorts.f2.m pack .shorts.f2.m -side top -fill both -padx 1m -pady 3m # devide the rigth top vertical in two frames : # in each an entry widgets for the name and the hotkey of # the new shortcut # frame .shorts.f2.t.r pack .shorts.f2.t.r -side right -fill y -padx 2m -pady 2m frame .shorts.f2.t.l pack .shorts.f2.t.l -side left -fill both -expand 1 \ -padx 2m -pady 2m label .shorts.nameLbl -text Name: pack .shorts.nameLbl \ -in .shorts.f2.t.l \ -side left entry .shorts.nameEnt \ -textvariable uam_VarShortName \ -width 15 \ -relief sunken pack .shorts.nameEnt\ -in .shorts.f2.t.l \ -side left \ -fill x bind .shorts.nameEnt {focus .shorts.hotkEnt} bind .shorts.nameEnt {focus .shorts.c1} bind .shorts.nameEnt {.shorts.add flash .shorts.add invoke} bind .shorts.nameEnt {.shorts.done flash .shorts.done invoke } bind .shorts.nameEnt {uam_initHelp shortcuts.hlp} bind .shorts.nameEnt {uam_initHelp shortcuts.hlp} bind .shorts.nameEnt {uam_exit} label .shorts.hotkLbl -text "Hotkey: Alt+" pack .shorts.hotkLbl \ -in .shorts.f2.t.r \ -side left entry .shorts.hotkEnt \ -textvariable uam_VarShortHotk \ -width 2 \ -relief sunken pack .shorts.hotkEnt\ -in .shorts.f2.t.r \ -side left \ -fill x bindtags .shorts.hotkEnt {.shorts.hotkEnt} # the hotkey is only one char defined by user # bind .shorts.hotkEnt { if {[clength %K] == 1} { set uam_VarShortHotk [string tolower %K] } } bind .shorts.hotkEnt { set uam_VarShortHotk "" } bind .shorts.hotkEnt {uam_initHelp shortcuts.hlp} bind .shorts.hotkEnt {uam_initHelp shortcuts.hlp} bind .shorts.hotkEnt {focus .shorts.c1} bind .shorts.hotkEnt {focus .shorts.c1} bind .shorts.hotkEnt {focus .shorts.nameEnt} bind .shorts.hotkEnt {.shorts.add flash .shorts.add invoke} bind .shorts.hotkEnt {.shorts.done flash .shorts.done invoke } bind .shorts.hotkEnt {uam_exit} # create two buttons at the right bottom: # Add to List, Done Edit # button .shorts.add -text "Add to List" \ -width 8 \ -command {uam_addNewShortcut} frame .shorts.f2.default -relief sunken -bd 1 raise .shorts.add .shorts.f2.default button .shorts.done -text "Done Edit" \ -width 8 \ -command {uam_shortcutResetFocus pack forget .shorts.f2 } pack .shorts.f2.default \ -in .shorts.f2.b \ -side left \ -expand 1 \ -padx 3m -pady 2m pack .shorts.add \ -in .shorts.f2.default \ -padx 1m -pady 1m \ -ipadx 2m -ipady 1m pack .shorts.done \ -in .shorts.f2.b \ -side right \ -padx 2m -pady 1m -ipadx 2m -ipady 1m \ -expand 1 bindtags .shorts.add {.shorts.add Button} bindtags .shorts.done {.shorts.done Button} bind .shorts.add {focus .shorts.done} bind .shorts.done {focus .shorts.new} # create at the right middle the rows for the new shortcut: # # divide it vertical in two frames, the left one for the keys # the right one for the contents of the keys of then new shortcut # frame .shorts.f2.m.l -width 15 pack .shorts.f2.m.l -side left -padx 1m frame .shorts.f2.m.r pack .shorts.f2.m.r -side left -padx 1m -fill x -expand 1 label .shorts.keyLbl -text Key -anchor w pack .shorts.keyLbl -in .shorts.f2.m.l -side top -fill x label .shorts.contLbl -text Content -anchor w pack .shorts.contLbl -in .shorts.f2.m.r -side top -fill x # create entry widgets in rows for input of keys .k # and content .c set keyNumber [expr $ideas_KeyNumber-1] for {set i 1} {$i <= $keyNumber} {incr i} { catch {unset uam_VarShortKey($i); unset uam_VarShortCont($i)} entry .shorts.k$i -textvariable uam_VarShortKey($i) \ -width 15 \ -relief sunken pack .shorts.k$i -in .shorts.f2.m.l -side top -pady 1 entry .shorts.c$i -textvariable uam_VarShortCont($i)\ -exportselection 1 \ -relief sunken pack .shorts.c$i -in .shorts.f2.m.r -side top -pady 1 \ -fill x # set up the bindings for the entries: # jump from field to field with Tab or arrows, end with # Return or Escape bind .shorts.k$i {uam_initHelp shortcuts.hlp} bind .shorts.k$i {uam_initHelp shortcuts.hlp} bind .shorts.c$i {uam_initHelp shortcuts.hlp} bind .shorts.c$i {uam_initHelp shortcuts.hlp} bind .shorts.k$i {.shorts.done flash .shorts.done invoke } bind .shorts.c$i {catch {%W insert insert [selection get]}} bind .shorts.c$i {.shorts.done flash .shorts.done invoke } bind .shorts.c$i "focus .shorts.c[expr $i-1]" bind .shorts.k$i "focus .shorts.c$i" bind .shorts.k$i "focus .shorts.c$i" bind .shorts.k$i {.shorts.add invoke .shorts.add flash} bind .shorts.k$i "focus .shorts.c[expr $i-1]" bind .shorts.k$i "focus .shorts.k[expr $i-1]" bind .shorts.k$i "focus .shorts.k[expr $i+1]" bind .shorts.k$i {uam_exit} bind .shorts.c$i "focus .shorts.k[expr $i+1]" bind .shorts.c$i "focus .shorts.k[expr $i+1]" bind .shorts.c$i "focus .shorts.c[expr $i+1]" bind .shorts.c$i {.shorts.add invoke .shorts.add flash} bind .shorts.c$i "focus .shorts.k[expr $i]" bind .shorts.c$i {uam_exit} } bind .shorts.c1 "focus .shorts.c$keyNumber" bind .shorts.c1 "focus .shorts.nameEnt" bind .shorts.c$keyNumber "focus .shorts.nameEnt" bind .shorts.c$keyNumber "focus .shorts.c1" bind .shorts.c$keyNumber "focus .shorts.nameEnt" bind .shorts.k2 "focus .shorts.k$keyNumber" bind .shorts.k$keyNumber "focus .shorts.k2" # make entry :TYPE user should not edit unvisible # set uam_VarShortKey(1) ":TYPE" .shorts.k1 configure -state disabled -relief flat update idletasks } # # uam_shortsScrollCmd # # Used to adjust the view in the two listboxes in .shorts with # one scrollbar. # # Arguments: # a, b, c - possible arguments of the scrollbar # # Results: None. # proc uam_shortsScrollCmd {{a ""} {b ""} {c ""}} { eval ".shorts.name yview $a $b $c" eval ".shorts.hotk yview $a $b $c" } # # uam_fillShortcutLb # # Fills the shortcut listbox in .shorts and bind the hotkeys # to widget .mesgTo # # Arguments: None. # # Results: None. # proc uam_fillShortcutLb {} { global uam_Shortcuts ideas_KeyNumber .shorts.name delete 0 end .shorts.hotk delete 0 end # sort the listbox content # foreach key [lsort [array names uam_Shortcuts]] { keylget uam_Shortcuts($key) hotkey keyHotk .shorts.name insert end $key if {$keyHotk == ""} { .shorts.hotk insert end " " } else { .shorts.hotk insert end } # the shortcuts hotkeys are of the form Alt+char # bind them to .mesgTo # for {set i 1} {$i <= $ideas_KeyNumber} {incr i} { catch {bind .mesgTo.k$i \ "uam_shortcut2mesgTo $key"} errorM catch {bind .mesgTo.c$i \ "uam_shortcut2mesgTo $key"} } } update } # # uam_newShortcut # # Shows the right side of widget .shorts with empty entries; # allows the user to define a new shortcut. # # Arguments: None. # # Results: None. # proc uam_newShortcut {} { global uam_VarShortName uam_VarShortHotk global uam_VarShortKey uam_VarShortCont global ideas_KeyNumber # show right frame in shorts # # raise .shorts pack .shorts.f2 -side left -fill both # clear the entry widgets # set uam_VarShortName "" set uam_VarShortHotk "" set uam_VarShortCont(1) "" # attention: uam_VarShortKey(1) is :TYPE - do not edit set keyNumber [expr $ideas_KeyNumber-2] for {set i 2} {$i <= $keyNumber} {incr i} { set uam_VarShortKey($i) "" set uam_VarShortCont($i) "" } focus .shorts.nameEnt } # # uam_editShortcut # # Shows right frame of .shorts with entries filled with the # shortcut current selected in listbox .shorts, empty if no # selection is made. # # Arguments: None. # # Results: None. # proc uam_editShortcut {} { global uam_VarShortName uam_VarShortHotk global uam_VarShortKey uam_VarShortCont global uam_Shortcuts # get only the first of the selected entries # set index [.shorts.name curselection] # if no selection is made handle as new shortcut # if {$index == ""} { set index [lindex [.shorts.hotk curselection] 0] if {$index == ""} { uam_newShortcut return } } # get name of the shortcut and fill the entries on the right side # set name [.shorts.name get $index] set uam_VarShortName [string trimright [csubstr $name 0 20]] keylget uam_Shortcuts($uam_VarShortName) hotkey uam_VarShortHotk keylget uam_Shortcuts($uam_VarShortName) content list set i 1 while {$list != ""} { set uam_VarShortKey($i) [lvarpop list] set uam_VarShortCont($i) [lvarpop list] incr i } } # # uam_selectShortcut # # Handles a invoke on button 'Select'. # Gets current selection of listbox .shorts and calls a proc # to insert this shortcut in widget .mesgTo # # Arguments: None. # # Results: None. # proc uam_selectShortcut {} { # get only the first of the selected entries # set index [.shorts.name curselection] # if no selection is made do nothing # if {$index == ""} { set index [lindex [.shorts.hotk curselection] 0] if {$index == ""} { return } } # get name of the selected shortcut # set name [string trimright [csubstr [.shorts.name get $index] 0 20]] uam_shortcut2mesgTo $name } # # uam_shortcut2mesgTo # # Inserts a specified shortcut in widget .mesgTo. # # Arguments: # # name - name of shortcut to insert # # Results: None. # proc uam_shortcut2mesgTo {name} { global uam_Shortcuts uam_VarKey uam_VarCont keylget uam_Shortcuts($name) content mesgForm set i 3 while {$mesgForm != ""} { set key [lvarpop mesgForm] set uam_VarKey($i) $key set cont [lvarpop mesgForm] set uam_VarCont($i) $cont incr i } # if {[winfo ismapped .shorts.f2]} { # raise .mesgTo # } focus .mesgTo.c3 update } # # uam_removeShortcut # # Removes shortcuts selected in listbox from listbox and # global variable uam_Shortcuts. # # Arguments: None. # # Results: None. # proc uam_removeShortcut {} { global uam_Shortcuts ideas_KeyNumber set indexList [.shorts.name curselection] # if no selection is made do nothing # if {$indexList == ""} { set indexList [lindex [.shorts.hotk curselection] 0] if {$indexList == ""} { return } } while {$indexList != ""} { set index [lvarpop indexList end] set name [string trimright [csubstr [.shorts.name get $index] 0 20]] # remove a possibly existing binded hotkey to the shortcut # keylget uam_Shortcuts($name) hotkey keyHotk for {set i 1} {$i <= $ideas_KeyNumber} {incr i} { catch {bind .mesgTo.k$i {}} catch {bind .mesgTo.c$i {}} } .shorts.name delete $index .shorts.hotk delete $index unset uam_Shortcuts($name) } } # # uam_addNewShortcut # # Adds a specified shortcut to global variable uam_Shortcut, # inserts it in the listbox .shorts and bind it to .mesgTo # # Arguments: None. # # Results: None. # proc uam_addNewShortcut {} { global uam_VarShortName uam_VarShortHotk global uam_VarShortKey uam_VarShortCont global uam_Shortcuts ideas_KeyNumber # the new shortcut must have a name # if {$uam_VarShortName == ""} { focus .shorts.nameEnt BEEP return } # bound the name of the new shortcut to limits: # there must be no space in it and its length must be lower 20 # set uam_VarShortName [csubstr $uam_VarShortName \ 0 [string first " " $uam_VarShortName]] set uam_VarShortName [csubstr $uam_VarShortName 0 20] # check if there is no binding for the specified hotkey on another # shortcut name # set bindList [bind .mesgTo.c3] if {[set index [lsearch $bindList ]] != -1} { if {![cequal [bind .mesgTo.c3 [lindex $bindList $index]] \ "uam_shortcut2mesgTo $uam_VarShortName"]} { focus .shorts.hotkEnt BEEP return } } set keyNumber [expr $ideas_KeyNumber-2] # read out the elements of the new shortcut ; # built up a list mesgForm # for {set i 1} {$i <= $keyNumber} {incr i} { if {$uam_VarShortKey($i) != ""} { if {![cequal [cindex $uam_VarShortKey($i) 0] ":"]} { set uam_VarShortKey($i) [string toupper :$uam_VarShortKey($i)] } else { set uam_VarShortKey($i) [string toupper $uam_VarShortKey($i)] } } lappend mesgForm $uam_VarShortKey($i) $uam_VarShortCont($i) } # built up the listbox entry for the shortcut # set nameLen [clength $uam_VarShortName] # remove a possible existing binded hotkey to a shortcut # with this name # catch {keylget uam_Shortcuts($uam_VarShortName) hotkey keyHotk} for {set i 1} {$i <= $ideas_KeyNumber} {incr i} { catch {bind .mesgTo.k$i {}} catch {bind .mesgTo.c$i {}} } # register the new shortcut in global uam_Shortcuts in this # special format: # keylset uam_Shortcuts($uam_VarShortName) hotkey $uam_VarShortHotk keylset uam_Shortcuts($uam_VarShortName) content $mesgForm # update the .shorts listbox # uam_fillShortcutLb focus .shorts.nameEnt } proc uam_shortcutResetFocus {} { if {[winfo ismapped .mesgTo]} { focus .mesgTo.c3 } else { focus .mbar } } ideas/agt_checkaddr.tcl100640 764 764 2670 6050144165 14427 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_checkaddr # # Checks if a given agent address belongs to a name in global # array OTHER, i.e. if the agent is connected to this address. # # Arguments: # # agtAddr - address to check, form 'host.port' # # Results: # # 0, if not connected to agtAddr # name of agent, if address belongs to one agent in OTHER # # proc agt_checkaddr {agtAddr} { global agents OTHER SELF # transform the given address to TCP/IP integer form, # if it isn't in this form already: set agtAddr [agt_hostport2addr $agtAddr] # check if the address is that of the agent itSELF: if {[cequal [keylget agents(SELF) ADDR] $agtAddr]} { return $SELF } # search in array OTHER for this address: foreach name [array name OTHER] { if {[cequal $OTHER($name) $agtAddr]} { return $name } } return 0 } ideas/uam_newAgt.tcl100640 764 764 17355 6052354671 14010 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_newAgt # # This script generates a file browser, which lists the files of # type '.agt' in the 'desc'-directory. It allows the user to choose # one file by typing its identifier or selecting it from the list # and type a name for the new agent in an entry field. # # Further it provides a radiobutton to change the view of the # browser: It then shows all files of type '.mas' and allows to # select the description of a local Multi-Agent-System to start it. # # Arguments: None. # # Results: None. # proc uam_newAgt {} { global uam_VarInitType # create a new toplevel: catch {destroy .init} global agents toplevel .init wm title .init "Initialize New Agents" wm iconname .init "InitNew" wm withdraw .init # Create three frames for managing the main window frame .init.top -bd 7 frame .init.frame1 -bd 7 frame .init.frame2 -bd 7 pack .init.top -side top -fill x pack .init.frame1 .init.frame2 -side left \ -fill y # Create the entry label for the agent name with a description on # top of the window label .init.top.lbl -text "Name for new Agent: " entry .init.top.inpt -relief sunken pack .init.top.lbl .init.top.inpt -side left -fill x # Create a label in frame1 and a listbox with a scrollbar on the # left side label .init.frame1.lbl pack .init.frame1.lbl -side top -anchor w -fill x frame .init.frame1.listbox pack .init.frame1.listbox -side top -fill x scrollbar .init.frame1.scroll -command ".init.frame1.list yview" pack .init.frame1.scroll -in .init.frame1.listbox -side right -fill y listbox .init.frame1.list -yscroll ".init.frame1.scroll set" \ -relief raised \ -exportselection no pack .init.frame1.list -in .init.frame1.listbox -side left -fill both -expand no frame .init.frame1.choose pack .init.frame1.choose -side top -fill x -pady 3 # create the radiobuttons to change the view of the browser: # radiobutton .init.frame1.agt -text Agents \ -variable uam_VarInitType \ -value 1 \ -underline 0\ -command uam_newAgtChgView radiobutton .init.frame1.mas -text Systems \ -variable uam_VarInitType \ -value 2 \ -underline 0\ -command uam_newAgtChgView pack .init.frame1.agt -side left -in .init.frame1.choose pack .init.frame1.mas -side left -fill x \ -padx 5 -in .init.frame1.choose # Create in frame2 an entry for selected filename and # buttons for OK and CANCEL label .init.frame2.lbl entry .init.frame2.inpt -relief sunken pack .init.frame2.lbl .init.frame2.inpt -anchor w button .init.ok -text OK \ -width 15 \ -command "uam_initNewAgtOK" frame .init.default -relief sunken -bd 1 raise .init.ok .init.default button .init.cancel -text CANCEL \ -width 15 \ -command "destroy .init" pack .init.cancel -in .init.frame2 -side bottom \ -pady 1 -ipadx 2m -ipady 1m pack .init.default -in .init.frame2 \ -side bottom \ -pady 4m pack .init.ok -in .init.default \ -padx 1m -pady 1m \ -ipadx 2m -ipady 1m # Set up bindings for the browser bindtags .init.frame1.list {Listbox .init.frame1.list} bind .init {.init.frame1.agt invoke} bind .init {.init.frame1.mas invoke} bind .init.top.inpt {.init.ok flash; uam_initNewAgtOK} bind .init.top.inpt { .init.cancel flash .init.cancel invoke} bind .init.top.inpt {uam_initHelp initNewAgt.hlp} bind .init.top.inpt {uam_initHelp initNewAgt.hlp} bind .init.top.inpt {uam_exit} bind .init.frame1.list {uam_initHelp initNewAgt.hlp} bind .init.frame1.list {uam_initHelp initNewAgt.hlp} bind .init.frame1.list {uam_exit} bind .init.frame1.agt {uam_initHelp initNewAgt.hlp} bind .init.frame1.agt {uam_initHelp initNewAgt.hlp} bind .init.frame1.agt {uam_exit} bind .init.frame1.mas {uam_initHelp initNewAgt.hlp} bind .init.frame1.mas {uam_initHelp initNewAgt.hlp} bind .init.frame1.mas {uam_exit} bind .init.frame2.inpt {uam_initHelp initNewAgt.hlp} bind .init.frame2.inpt {uam_initHelp initNewAgt.hlp} bind .init.frame2.inpt {uam_exit} bindtags .init.frame1.list {Listbox .init.frame1.list} bind .init.frame1.list { uam_insertLbSel .init.frame1.list .init.frame2.inpt } bind .init.frame1.list { uam_insertLbSel .init.frame1.list .init.frame2.inpt .init.ok flash; .init.ok invoke} bind .init.frame1.list {focus .init.frame2.inpt} bind .init.frame1.list { uam_insertLbSel .init.frame1.list .init.frame2.inpt } bind .init.frame1.list { uam_insertLbSel .init.frame1.list .init.frame2.inpt } bind .init.frame1.list { if {[set sel [.init.frame1.list curselection]]!=""} { uam_insertLbSel .init.frame1.list .init.frame2.inpt } .init.ok flash; .init.ok invoke} bind .init.frame1.list {.init.cancel flash;.init.cancel invoke} bind .init.frame2.inpt {.init.ok flash; .init.ok invoke} bind .init.frame2.inpt {.init.cancel flash; .init.cancel invoke} bind .init.frame1.agt { .init.frame1.agt configure -state normal .init.ok flash; .init.ok invoke} bind .init.frame1.agt {.init.cancel flash; .init.cancel invoke} bind .init.frame1.mas { .init.frame1.mas deselect .init.ok flash; .init.ok invoke} bind .init.frame1.mas {.init.cancel flash; .init.cancel invoke} bind .init.frame1.mas { .init.frame1.mas deselect .init.frame1.mas invoke} # set globale variable 'uam_VarInitType' to 1, # i. e. show agent type files, # and call proc 'uam_newAgtChgView' to do so: # set uam_VarInitType 1 uam_newAgtChgView # update all the geometry information so we know how big # it wants to be, then place the window relative to its # parent and de-iconify it. update idletasks set dad [winfo parent .init] set x [expr [winfo x $dad] + \ ([winfo reqwidth $dad] - [winfo reqwidth .init])/2] set y [expr round([winfo y $dad] + [winfo reqheight $dad]*0.3)] wm geom .init +$x+$y wm deiconify .init tkwait window .init } # On OK do this: proc uam_initNewAgtOK {} { global agents uam_VarInitType if {$uam_VarInitType == 1} { set newName [.init.top.inpt get] # test if newName is not empty # if {[string length $newName]} { set newName \ [string tolower [string range [lindex $newName 0] 0 9]] } else { uam_noAgtIdf return } # test if newName includes non alphanumeric characters # if {![ctype alnum $newName]} { uam_illegalAgtName $newName return } # test if newName exists # set existAgts [array names agents] if {[lsearch $existAgts ${newName}.*] != -1} { uam_newNameExists $newName return } set typeFile [.init.frame2.inpt get] # test if selected filename exists # if {[lsearch [glob desc/*.agt] desc/$typeFile]==-1} { uam_notExType $typeFile return } destroy .init uam_startAgent $newName $typeFile } else { set systemFile [.init.frame2.inpt get] # test if selected filename exists # if {[lsearch [glob systems/*.mas] systems/$systemFile]==-1} { uam_notExSystem $systemFile focus .init.frame2.inpt return } destroy .init uam_startMAS $systemFile } } ideas/agent.tcl100640 764 764 47612 6115063171 13006 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # # agtProcess # # This is the main script initializing an agent. # # Arguments: # # initial information for the agent in form of a keyedlist including # the following keys: # # NAME, TYPE, STATUS, HOST, PORT, HOMEPATH, XDEFAULT # # # global tk_library # Redirect stderr to stdout to see errors of agent at UAM # dup stdout stderr # get the creation time of the agent: set creationTime [getclock] # get the agents basic information form arguments in global # array 'agents': set agents(SELF) $argv # 'agents()' is an global array which stores information about all # agents known by this agent in form of a keyedlist. # # possible keys: NAME - name of the agent format: idf.host.port or UAM # TYPE - type of the agent, name of file # STATUS - status of the agent (SELF only) # ADDR - address of the agent: host.port # HOSTIP - IP number of agents host # INFID - fileIdf for incoming pipe to this agent # OUTFID - fileIdf for outgoing pipe to this agent # SOCKET - fileIdf for base socket (SELF only) # LOGFID - fileIdf for standard Logfile (SELF only) # MLGFID - fileIdf for mesg-eval Logfile (SELF only) # CLGFID - fileIdf for communication Logfile (SELF only) # FILENO - file counter for the Logfiles (SELF only) # HOMEPATH - just for transferring the ideas_HomePath from UAM # XDEFAULT - decision to read/not read Xdefault file # # # copy the HOMEPATH information in global variable # 'ideas-HomePath' and remove the key HOMEPATH: keylget agents(SELF) HOMEPATH ideas_HomePath keyldel agents(SELF) HOMEPATH # read the IDEAS init file: if {[catch {source init.tcl} errorMesg]} { puts $errorMesg exit } # read the .ideasXdefaults file if {[keylget agents(SELF) XDEFAULT]} { catch {option readfile .ideasXdefaults} } keyldel agents(SELF) XDEFAULT # set the path for auto-loading procedures: set auto_path "$ideas_HomePath $auto_path" cd $ideas_HomePath # The global variable 'agt_VarTimeOffset' is a special hack # to work with UNIX-datestrings, which are long integers, # in BinProlog: # BinProlog cannot handle that long integers, so always when # a UNIX-datestring is copied to BinProlog, the offset is subtracted # before, to decrement the integer to a BinProlog-readable value. # On the other side a date coming from BinProlog is incremented # with this offset. # set agt_VarTimeOffset 790000000 # Initial setting about the agent itself and his UAM: # get the agents host out of the name: name.host # set agtHost [crange [keylget agents(SELF) NAME] \ [string first . [keylget agents(SELF) NAME]]+1 \ end] keylset agents(SELF) HOSTIP [lindex [server_info addresses $agtHost] 0] keylset agents(UAM) NAME UAM TYPE SUPER-AGENT \ ADDR [keylget agents(SELF) HOSTIP].none \ INFID stdin OUTFID stdout # create socket for listening to connections # and register its fileId # agt_openSocket catch {unset agtHost} # set agents name to global variable SELF, so that it can be used in actions # defined by user keylget agents(SELF) NAME SELF wm withdraw . wm title . "Observation: $SELF" wm iconname . "Agent $SELF" wm iconbitmap . questhead wm minsize . 500 260 frame .f0 pack .f0 -side top -fill x # create the main menu frame .mbar -relief ridge -bd 2 pack .mbar -in .f0 -side top -fill x # MENU view: menubutton .mbar.view -text View -underline 0 \ -menu .mbar.view.menu menu .mbar.view.menu .mbar.view.menu add checkbutton -label "Logfile" -underline 0 \ -variable agt_VarLogView \ -command {if {$agt_VarLogView} { pack .f1 -padx 3 -pady 3 -fill both -expand yes } else { pack forget .f1 } wm geometry . "" } .mbar.view.menu add checkbutton -label "Message-Evaluation" -underline 0 \ -variable agt_VarEvalView \ -command {if {$agt_VarEvalView} { pack .f4 -padx 3 -pady 3 -fill both -expand yes } else { pack forget .f4 } wm geometry . "" } .mbar.view.menu add checkbutton -label "Communication" -underline 0 \ -variable agt_VarCommView \ -command {if {$agt_VarCommView} { pack .f5 -padx 3 -pady 3 -fill both -expand yes } else { pack forget .f5 } wm geometry . "" } .mbar.view.menu add checkbutton -label "Communication-Paths" -underline 14 \ -variable agt_VarPathsView \ -command {if {$agt_VarPathsView} { pack .f2 -padx 3 -pady 3 -fill both -expand yes } else { pack forget .f2 } wm geometry . "" } .mbar.view.menu add checkbutton -label "Belief-Base" -underline 0 \ -variable agt_VarBelBaseView \ -command {if {$agt_VarBelBaseView} { pack .f3 -padx 3 -pady 3 -fill both -expand yes } else { pack forget .f3 } wm geometry . "" } # Button trace in menu - NO menubutton ! button .mbar.trace -text Trace -relief flat \ -underline 0 \ -command { if {!$agt_VarTraceEnable} { set agt_VarTraceEnable 1 pack .trace -in .f0 -side bottom \ -padx 3 -pady 3 -fill both -expand yes .mbar.trace configure -text Untrace bind . "" bind . {.mbar.trace invoke} } else { set agt_VarTraceEnable 0 pack forget .trace set agt_VarWakeUp 1 .mbar.trace configure -text Trace bind . "" bind . {.mbar.trace invoke} } } bind . {.mbar.trace invoke} # MENU exit - only shown if lost UAM menubutton .mbar.exit -text Exit -underline 0 -menu .mbar.exit.menu menu .mbar.exit.menu .mbar.exit.menu add command -label "Quit " -underline 0 \ -accelerator "Ctrl+q" -command agt_exit # MENU help: menubutton .mbar.help -text Help -underline 0 -menu .mbar.help.menu menu .mbar.help.menu .mbar.help.menu add command -label "ShortHelp" -underline 0\ -command "agt_showShortHelp .shortHelp -1 -1" pack .mbar.view .mbar.trace -side left -padx 2m pack .mbar.help -side right -padx 2m tk_menuBar .mbar .mbar.view .mbar.help # create frame for 'Wake Up'-button # frame .trace -relief ridge -bd 2 button .trace.wakeup -bitmap @alarmclock -width 20 -state disabled \ -command {set agt_VarWakeUp 1} pack .trace.wakeup -pady 3 -ipadx 10m # create view for logfile # frame .f1 -relief ridge -bd 2 pack .f1 -padx 3 -pady 3 -fill both -expand yes label .f1.label -text "Logfile:" \ -relief ridge -bd 2 frame .f1.mbar -relief ridge -bd 2 checkbutton .f1.mbar.scroll -text "Auto-Scroll" \ -relief flat \ -variable agt_VarLogScroll text .f1.text -relief ridge -bd 2 \ -yscrollcommand ".f1.scroll set" \ -wrap word \ -height 15 \ -width 65 scrollbar .f1.scroll -relief ridge -command ".f1.text yview" pack .f1.label -side top -fill x pack .f1.mbar -side top -fill x pack .f1.mbar.scroll -side right -padx 2m pack .f1.scroll -side right -fill y pack .f1.text -side left -fill both -expand yes # set checkbutton variable for message view to on set agt_VarLogView 1 # create view for mesg-evaluation # frame .f4 -relief ridge -bd 2 label .f4.label -text "Message-Evaluation:" \ -relief ridge -bd 2 frame .f4.mbar -relief ridge -bd 2 checkbutton .f4.mbar.scroll -text "Auto-Scroll" \ -relief flat \ -variable agt_VarMesgEvalScroll checkbutton .f4.mbar.save -text "Save" \ -relief flat \ -variable agt_VarMesgEvalSave text .f4.text -relief ridge -bd 2 \ -yscrollcommand ".f4.scroll set" \ -wrap word \ -height 15 \ -width 65 scrollbar .f4.scroll -relief ridge -command ".f4.text yview" pack .f4.label -side top -fill x pack .f4.mbar -side top -fill x pack .f4.mbar.scroll .f4.mbar.save -side right -padx 2m pack .f4.scroll -side right -fill y pack .f4.text -side left -fill both -expand yes # create view for communication observation # frame .f5 -relief ridge -bd 2 label .f5.label -text "Communication:" \ -relief ridge -bd 2 # logwidget for communication observation frame .f5.log frame .f5.mbar -relief ridge -bd 2 button .f5.mbar.filter -text Filter -relief flat \ -command { .f5.filter.list1 delete 0 end foreach elem $agt_VarComNotFilter { .f5.filter.list1 insert end $elem } set agt_VarTempComNotFilter $agt_VarComNotFilter .f5.filter.list1 selection set 0 .f5.filter.list2 delete 0 end foreach elem $agt_VarComFilter { .f5.filter.list2 insert end $elem } set agt_VarTempComFilter $agt_VarComFilter .f5.filter.list2 selection set 0 pack forget .f5.log pack .f5.filter -fill both -expand no } checkbutton .f5.mbar.scroll -text "Auto-Scroll" \ -relief flat \ -variable agt_VarCommScroll checkbutton .f5.mbar.save -text "Save" \ -relief flat \ -variable agt_VarCommSave text .f5.text -relief ridge -bd 2 \ -yscrollcommand ".f5.scroll set" \ -wrap word \ -height 15 \ -width 65 scrollbar .f5.scroll -relief ridge -command ".f5.text yview" pack .f5.label -side top -fill x pack .f5.mbar -in .f5.log -side top -fill x pack .f5.mbar.filter -side left -padx 2m pack .f5.mbar.scroll .f5.mbar.save -side right -padx 2m pack .f5.scroll -in .f5.log -side right -fill y pack .f5.text -in .f5.log -side left -fill both -expand yes # filter widget for communication observation frame .f5.filter -relief ridge -bd 2 \ -height 200 \ -width 480 label .f5.filter.a \ -text "Select agents to watch communication with." \ -anchor c pack .f5.filter.a -side top -fill x -pady 5 frame .f5.filter.b pack .f5.filter.b \ -side top -fill x -padx 1 -pady 5 frame .f5.filter.b.l -relief flat pack .f5.filter.b.l -side left frame .f5.filter.b.r -relief flat pack .f5.filter.b.r -side right label .f5.filter.lbl1 \ -text "Don't watch to:" \ -anchor w listbox .f5.filter.list1 \ -yscroll ".f5.filter.scroll1 set" \ -relief ridge \ -bd 2\ -height 6 -width 21 \ -exportselection no bind .f5.filter.list1 { set index [.f5.filter.list1 near %y] .f5.filter.list1 selection set $index .f5.filter.add flash .f5.filter.add invoke } scrollbar .f5.filter.scroll1 \ -relief ridge \ -command ".f5.filter.list1 yview" pack .f5.filter.lbl1 \ -in .f5.filter.b.l \ -side top \ -fill x pack .f5.filter.scroll1 \ -in .f5.filter.b.l\ -side right \ -fill y pack .f5.filter.list1 \ -in .f5.filter.b.l \ -fill both label .f5.filter.lbl2 \ -text "Watch to:" \ -anchor w listbox .f5.filter.list2 \ -yscroll ".f5.filter.scroll2 set" \ -relief ridge \ -bd 2\ -height 6 -width 21 \ -exportselection no bind .f5.filter.list2 { set index [.f5.filter.list2 near %y] .f5.filter.list2 selection set $index .f5.filter.rem flash .f5.filter.rem invoke } scrollbar .f5.filter.scroll2 \ -relief ridge \ -command ".f5.filter.list2 yview" pack .f5.filter.lbl2 \ -in .f5.filter.b.r \ -side top \ -fill x pack .f5.filter.scroll2 \ -in .f5.filter.b.r\ -side right \ -fill y pack .f5.filter.list2 \ -in .f5.filter.b.r \ -fill both button .f5.filter.add \ -text "Add ->" \ -width 8 \ -command { set sel [.f5.filter.list1 curselection] foreach index $sel { set elem [.f5.filter.list1 get $index] .f5.filter.list1 delete $index .f5.filter.list1 selection set $index .f5.filter.list2 insert end $elem .f5.filter.list2 selection set $index lappend agt_VarTempComFilter $elem set agt_VarTempComNotFilter \ [lreplace $agt_VarTempComNotFilter $index $index] .f5.filter.rem configure -state normal if {[.f5.filter.list1 size] == 0} { .f5.filter.add configure -state disabled } } update } button .f5.filter.rem \ -text "<- Remove" \ -width 8 \ -command { set sel [.f5.filter.list2 curselection] foreach index $sel { set elem [.f5.filter.list2 get $index] .f5.filter.list2 delete $index .f5.filter.list2 selection set $index .f5.filter.list1 insert end $elem .f5.filter.list1 selection set $index lappend agt_VarTempComNotFilter $elem set agt_VarTempComFilter \ [lreplace $agt_VarTempComFilter $index $index] .f5.filter.add configure -state normal if {[.f5.filter.list2 size] == 0} { .f5.filter.rem configure -state disabled } } update } .f5.filter.rem configure -state disabled pack .f5.filter.rem .f5.filter.add \ -side bottom \ -in .f5.filter.b \ -padx 10 -pady 5 -ipadx 2m -ipady 0m button .f5.filter.ok \ -text OK \ -width 8 \ -command { if {![cequal [lsort $agt_VarComFilter] \ [lsort $agt_VarTempComFilter]]} { agt_logComm "Logging communication with the\ following agents now:\n\{$agt_VarTempComFilter\}\n" } set agt_VarComFilter $agt_VarTempComFilter set agt_VarComNotFilter $agt_VarTempComNotFilter pack forget .f5.filter pack .f5.log -fill both -expand yes} button .f5.filter.cancel \ -text Cancel \ -width 8 \ -command {pack forget .f5.filter pack .f5.log -fill both -expand yes} pack .f5.filter.cancel .f5.filter.ok \ -side right \ -padx 5 -pady 10 -ipadx 2m -ipady 0m # initialize the global filter variables # set agt_VarComFilter "" set agt_VarComNotFilter "SELF UAM" .f5.mbar.filter invoke # create view for communication paths # frame .f2 -relief ridge -bd 2 label .f2.label -text "Communication Paths:" \ -relief ridge -bd 2 canvas .f2.c -relief ridge -bd 2 \ -yscrollcommand ".f2.scroll set" \ -height 200 scrollbar .f2.scroll -relief ridge -command ".f2.c yview" pack .f2.label -side top -fill x pack .f2.scroll -side right -fill y pack .f2.c -side left -fill both -expand yes agt_displAgtBitmap SELF agt_displAgtBitmap UAM agt_drawSolid UAM # create view for belief-base # frame .f3 -relief ridge -bd 2 label .f3.label -text "Belief-Base:" \ -relief ridge -bd 2 text .f3.text -relief ridge -bd 2 \ -yscrollcommand ".f3.scroll set" \ -wrap word \ -height 15 \ -width 65 scrollbar .f3.scroll -relief ridge -command ".f3.text yview" pack .f3.label -side top -fill x pack .f3.scroll -side right -fill y pack .f3.text -side left -fill both -expand yes bind all {agt_showShortHelp %W %X %Y} update idletasks wm deiconify . focus .mbar tkwait visibility .f1 # open logfiles for agent # # get a free number for file counting # for {set fileNo 0} {[file exists "logfiles/$SELF.$fileNo.log"]} \ {incr fileNo} {} keylset agents(SELF) FILENO $fileNo # open the standard logfile # keylset agents(SELF) LOGFID [open "logfiles/$SELF.$fileNo.log" w] agt_puts "Logfile for agent '$SELF'\ncreated at\ [fmtclock $creationTime "%a %b %d %Y, %T"]\n" # open the logfile for mesg-evaluation # keylset agents(SELF) MLGFID [open "logfiles/$SELF.$fileNo.msg" w] agt_logMesgEval "Message Evaluation Logfile for agent '$SELF'\ncreated at\ [fmtclock $creationTime "%a %b %d %Y, %T"]" # open the logfile for communication # keylset agents(SELF) CLGFID [open "logfiles/$SELF.$fileNo.com" w] agt_logComm "Communication Logfile for agent '$SELF'\ncreated at\ [fmtclock $creationTime "%a %b %d %Y, %T"]\n" # initialize variable for trace enabling with 'no' set agt_VarTraceEnable 0 # start agents prolog process # set agt_VarPrologError [agt_startProlog] # initialize counter for outgoing messages, # used for :REPLY-WITH key in messages # set agt_MesgCounter 0 # initialize list for messages to send # set agt_SendMesgList "" # initialize buffers for received messages # # agt_RecMesgList(-1) is for UAM-command-mesgs which have highest priority # agt_RecMesgList(0) is for intern messages of SELF, which have next priority # agt_RecMesgList(1), # agt_RecMesgList(2), # agt_RecMesgList(3) are for all the other messages; 3 has lowest priority # set agt_RecMesgList(-1) "" set agt_RecMesgList(0) "" set agt_RecMesgList(1) "" set agt_RecMesgList(2) "" set agt_RecMesgList(3) "" # use the procedure 'agt_chgStatus' to send an initial status # message to UAM; because 'agt_chgStatus' is changing the status # set it to active for this little moment now and it is changed # to deactive by the procedure - so it is correct for the start of # agent # agt_puts "STATUS: $agents(SELF)\n" keylset agents(SELF) STATUS act agt_chgStatus none # initialize global array OTHER that includes the # names of agents SELF if actually connected to # (special hack 8-) # set OTHER(dummy) "" unset OTHER(dummy) # set a trace on OTHER to mention a change on it and # updating the filter for watching special communications # trace variable OTHER w agt_updateComFilter trace variable OTHER u agt_updateComFilter trace variable agents(UAM) u agt_updateComFilter # do some more initials: # includes reading/evaluation of script file, inits prolog database # if {$agt_VarPrologError} { keylset mesg :RECEIVER UAM :TYPE prolog-error agt_send $mesg agt_sourceStdMesgRules } else { agt_doTypeInits } # set communication control on connection to UAM # fileevent stdin readable {agt_commCtrl stdin UAM} # open pipe to send messages to the agent himself # and set commCtrl on it # pipe in out keylset agents(SELF) INFID $in \ OUTFID $out fileevent $in readable "agt_commCtrl $in $SELF" # start detecting the socket for connections to other agents # fileevent [keylget agents(SELF) SOCKET] readable {agt_conDetected [keylget agents(SELF) SOCKET]} # send messages appended till now: # there is the statusinfo and maybe an ASL-error from agt_doTypeInits # agt_dispatchMesgs # enter main loop # while {1} { if {([set agt_VarBufferEmpty(-1) [lempty $agt_RecMesgList(-1)]]) && \ ([keylget agents(SELF) STATUS] == "deact")} { # there is no UAM-command-mesg and agent is deact, so wait # for an incomming mesg that could change this; # then start loop again tkwait variable agt_RecMesgList set agt_VarWorkMesg "" } elseif {!$agt_VarBufferEmpty(-1)} { # there is an UAM-command-mesg so eval it # because of highest priority # set agt_VarWorkMesg [lvarpop agt_RecMesgList(-1)] } elseif {![lempty $agt_RecMesgList(0)]} { # there is no UAM-command-mesg but a message from SELF # so eval this one next # set agt_VarWorkMesg [lvarpop agt_RecMesgList(0)] } elseif {![lempty $agt_RecMesgList(1)]} { # # set agt_VarWorkMesg [lvarpop agt_RecMesgList(1)] } elseif {![lempty $agt_RecMesgList(2)]} { # # set agt_VarWorkMesg [lvarpop agt_RecMesgList(2)] } elseif {![lempty $agt_RecMesgList(3)]} { # # set agt_VarWorkMesg [lvarpop agt_RecMesgList(3)] } else { # here the agent is active but there are no mesg in buffers, # so wait for an incoming message and then start loop again tkwait variable agt_RecMesgList set agt_VarWorkMesg "" } if {$agt_VarWorkMesg != ""} { # the message is evaluated here # agt_evalMesg [lindex $agt_VarWorkMesg 0] [lindex $agt_VarWorkMesg 1] # dispatch messages built up in evaluation # agt_dispatchMesgs update } } ideas/help/ 40750 764 764 0 5765341105 12012 5ustar javierjavierideas/help/helpSystem.hlp100640 764 764 1234 5741223224 14745 0ustar javierjavierThe use of the IDEAS - Help System is very simple: The listbox above shows all available help topics in alphabetical order. You can scroll through it and make your choice by clicking with the left mouse button on it. To have a look at the content invoke the 'Show'-button or just do a double click with left mouse button on the item in the listbox. After this the content of the topic is shown in this widget and its title appears on the headline. Invoke the 'Close'-button to close the Help System. There is a quick help also available. See 'Help: The IDEAS -ShortHelp' for details. For a short introduction to IDEAS have a look at 'Help: First Time in IDEAS'.ideas/help/listbox.hlp100640 764 764 1057 5741223225 14300 0ustar javierjavierThere are some little remarks to make about listboxes in IDEAS: When button 1 is pressed over a listbox, the ele- ment underneath the mouse cursor is selected. In the agent list of the UAM the mouse can be drag- ged to select a range of elements. The ends of the selection can be adjusted by drag- ging with mouse button 1 while the shift key is down; this will adjust the end of the selection that was nearest to the mouse cursor when button 1 was pressed. The view in the listbox can be adjusted by dragging with mouse button 2. ideas/help/scrollbar.hlp100640 764 764 3436 5741223225 14602 0ustar javierjavierOf course everybody knows about scrollbars but for completeness this is the description the of the scrollbars used here: A scrollbar widget is divided into five distinct areas. From top to bottom, they are: the top arrow, the top gap (the empty space between the arrow and the slider), the slider, the bottom gap, and the bottom arrow. Pressing mouse button 1 in each area has a different effect: top arrow Causes the view in the associated win- dow to shift up by one unit (i.e. the object appears to move down one unit in its window). If the button is held down the action will auto-repeat. top gap Causes the view in the associated win- dow to shift up by one less than the number of units in the window (i.e. the portion of the object that used to appear at the very top of the window will now appear at the very bottom). If the button is held down the action will auto-repeat. slider Pressing button 1 in this area has no immediate effect except to cause the slider to appear sunken rather than raised. However, if the mouse is moved with the button down then the slider will be dragged, adjusting the view as the mouse is moved. bottom gap Causes the view in the associated win- dow to shift down by one less than the number of units in the window (i.e. the portion of the object that used to appear at the very bottom of the win- dow will now appear at the very top). If the button is held down the action will auto-repeat. bottom arrow Causes the view in the associated win- dow to shift down by one unit (i.e. the object appears to move up one unit in its window). If the button is held down the action will auto-repeat. ideas/help/shortHelp.hlp100640 764 764 1171 5741223225 14561 0ustar javierjavierThe ShortHelp is the quick guide in IDEAS. It gives a little description to some elements in the UAM and the agents observation window. To invoke the ShortHelp all you have to do is to point with the mouse cursor on a element of a window, e. g. a button, and press the right button. If ShortHelp is available for the choosen object a new window will appear, including some words for helping. The window is remove by invoking the 'Close'-button. To see the full IDEAS-Help press the 'Index'-button in the ShortHelp-window. Maybe you want to test the Shorthelp, so just try to press the right mouse button down in this window... ideas/help/uam_helpIndex.tcl100640 764 764 3667 5765532622 15420 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # set uam_VarHelpIndex { {"ASL: The Agent Specification Language (ASL)" ASLSyntax.hlp} {"ASL: Beliefs and Time Expressions" timeExpr.hlp} {"ASL: Message Evaluation" mesgEval.hlp} {"ASL: The Standard ACTIONS of an Agent" stdActions.hlp} {"ASL: Defining a new Agent by writing an ASL-Script" newScript.hlp} {"ASL: Editing an Agent Script File" editScriptFile.hlp} {"C-Sources: The Action-C-Source (ACS)" ACS.hlp} {"C-Sources: Defining a new Action-C-Source (ACS)" newACS.hlp} {"C-Sources: Editing an Action-C-Source (ACS)" editACS.hlp} {"Help: First Time in IDEAS" ideas.hlp } {"Help: The IDEAS - Help System" helpSystem.hlp } {"Help: The IDEAS - ShortHelp" shortHelp.hlp } {"Help: How to use a Scrollbar" scrollbar.hlp} {"Help: How to use a Listbox" listbox.hlp} {"Help: How to use a Menu" menu.hlp} {"Help: How to use an Entry" entry.hlp} {"Help: Help about Tcl/Tk" tcl.hlp} {"MAS: Defining a new Multi Agent System (MAS)" newMAS.hlp} {"MAS: Editing a Multi Agent System (MAS)" editMAS.hlp} {"UAM: The User Agent Manager (UAM)" uam.hlp} {"UAM: Initializing new Agents" initNewAgt.hlp} {"UAM: Sending a Message from the UAM to an Agent" mesgTo.hlp} {"UAM: Standard Messages of the UAM" stdMesg.hlp} {"UAM: Using Shortcuts for UAM Messages" shortcuts.hlp} } ideas/help/uam.hlp100640 764 764 3632 5765000007 13374 0ustar javierjavierWhen you start IDEAS the first you get is the User Agent Manager (UAM). The UAM is the users interface to IDEAS. In its control window it provides a listbox called the Agent List, a row of buttons and a menu bar at the top. The menu bar first: The leftmost item is the 'Exit'-menu. It just contains a button to quit the UAM and so to leave IDEAS. You can use Ctrl+q , too. If you quit the UAM all agents local to this UAM will exit, too. The 'Specification'-menu includes three submenues: 'Agents' to define and edit agent type files, 'Systems' to define end edit Multi Agent System files, which allows you to create and connect some (local) agents in one step, and 'UserCommands' for adding new commands to the agents start process written in C. The 'View'-menu is another one-item-menue. You can set or unset a checkbutton to display or remove the UAM Logfile. In the Logfile the UAM takes the minute of his activities. The 'Help'-menu on the right side of the menu bar leads you to the IDEAS - Help System. The Agent List shows all agents defined and initialized by the user. An entry in the list is of the form 'Name / Type / Status'. You can select one or more agents from the list for further actions. The topmost of the buttons next to the Agent List is the 'init new'-button. It allows you to initialize a new agent and add it to the Agent List. After been in the Agent List you can activate an agent by selecting its entry in the Agent List and invoking the 'activate/deactivate'-button. Do the same to deactivate an active agent. The next button is 'delete'. It is to remove an agent from the agent list and so from the system. Select the agent from the list and then invoke the button. The last button in the row is 'Message to' and its used to send a message direct to the local agents. Again do a selection in the list and then invoke the button and you will get a tool do define your message. ideas/help/ideas.hlp100640 764 764 4744 5765571603 13723 0ustar javierjavierWellcome to the Interactive Development Environment for Agent Systems (IDEAS), a testbed for experimenting with Multi Agent Systems (MAS). IDEAS provides the following features: - An interactive user plattform called the 'User Agent Manager (UAM)'. - An Agent Description Language (ASL) which uses Tcl/Tk for agent programming. - Extensionality with procedures written in C. - A Belief and message oriented approach for agent description. - Using Prolog for Belief representation and inferences. - Autonomity of the agents; each agent has its own UNIX process. - Real physical distribution by using TCP/IP sockets for communication. - Tools for controlling and debugging the activities of an agent. - Built-in Help-System. When you are new in IDEAS it is a good idea to have a look at some files in the IDEAS Help-System. They describe how to work with IDEAS, how to specify your own agents, combine them to a net and controll their actions. You should know about the following steps to start a first simple MAS: 1. Write an ASL-Script in the UAM to specify an agent or just use 'standard.agt' which contains the standard parts of a description only. 2. Open the Logfile of the User Agent Manager to see what goes on. 3. Start some agents based on ASL-Scripts. 4. Activate the agents. 5. Connect the agents between each other by sending a 'handshake' message from UAM. 6. Have a look at the agents observation windows. You find the information to all those steps in files of the Help-System. For programming an agent you have to know about the use of Tcl/Tk. Because this Help-System doesn't include a programmers guide, you should have a look at 'Help: Help about Tcl/Tk' for literature about this subject. Further you should know a little bit about Prolog, used for the representation of the belief-base in IDEAS. Copyright notice: Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann Computer Science Department, Christian-Albrechts-University of Kiel, Olshausenstr. 40, 24118 Kiel, Germany All rights reserved. No warranties will be given on any issues arising out of the use of this software product. Permission to use, copy, modify and distribute this software product for non-commercial purposes is hereby granted, provided that the above copyright notice appears in all copies and respective publications. All commercial trades with this product outside the CAU Kiel without specific written prior permission are prohibited. ideas/help/COPYRIGHT100440 764 764 1206 5765341105 13400 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # ideas/help/entry.hlp100640 764 764 3376 6052105377 13766 0ustar javierjavierWhenever you have to type in an entry field you should realize this behaviour: Clicking mouse button 1 in an entry positions the insertion cursor just before the character underneath the mouse cursor and sets the input focus to this widget. Dragging with mouse button 1 strokes out a selection between the insertion cursor and the character under the mouse. The ends of the selection can be adjusted by dragging with mouse button 1 while the shift key is down; this will adjust the end of the selection that was nearest to the mouse cursor when button 1 was pressed. The view in the entry can be adjusted by dragging with mouse button 2. If the input focus is in an entry widget and characters are typed on the keyboard, the characters are inserted just before the insertion cursor. Control-h and the Backspace and Delete keys erase the character just before the insertion cursor. Control-w erases the word just before the insertion cursor. Control-u clears the entry to an empty string. Control-v inserts the current selection just before the insertion cursor. Control-d deletes the selected characters; an error occurs if the selection is not in this widget. ideas/help/initNewAgt.hlp100640 764 764 3153 5767050324 14672 0ustar javierjavierTo initialize a new agent in the system invoke the 'New'-button in the UAM window. It opens a toplevel window 'Initialize New Agents'. There are two alternative ways to create new agents. On the one hand you can create a single agent: For that the left checkbutton - 'Agents' - under the list must be choosen, then the above list will contain all agent description files with extensions '.agt' and '.desc' of the users 'ideas/desc' - directory. Type in a name for the new agent in the topmost entry, choose a type from the list and invoke the 'OK'-button. The names of the local agents should be clear, so if you try to add a name that is in use for an other agent already you will get an error. An agents name may consists of alpha-numerical characters only. Alternatively you can choose a local Multi Agent System (MAS) you have defined earlier. So you invoke several agents in one step and built connections between some of themautomatically: Choose the 'System'-checkbutton and the listbox will display all MAS-files with extension '.mas' in the directory 'ideas/systems'. Just select one entry of the list and invoke the 'OK'-button. There a some keyboard bindings you should know: Use to jump with the input focus between the entries, the listbox and the checkbuttons. You can use the arrow keys to move in the listbox if it has the input focus. Double clicking with left mouse button on a listbox entry will choose this entry and invoke 'OK'. Press to select an checkbutton if it has the input focus. will invoke 'OK' with the present entries. invokes 'Cancel'. ideas/help/mesgTo.hlp100640 764 764 3562 5741223225 14055 0ustar javierjavierTo send an message direct to local agents invoke the button 'Message to' in the UAM window. It shows a new window 'Message To' containing two columns of entry fields. A message in IDEAS consits of pairs, each pair of the form {:key_name content}. The left columns in the window, titled 'Key', is for the message keys and the right one, 'Content', is for the content of the key left of this entry. The three keys :SENDER, :RECEIVER and :TYPE are predefined, because they have to appear in each message an agent receives. The :SENDER is preset to UAM. If you select one or more agents from the Agent List before invoking 'Message To' their names will appear in the :RECEIVER field. If not you have to specify the receiver by typing in the name here. The :TYPE field should contain the type of the message you want to send. The rest of the keys and their contents belongs to your message, just type in the entry field. To send the message invoke the 'OK'-button, to forget it invoke 'Cancel'. You can save often used message bodies by defining a shortcut for it. Use the 'Shortcuts'-Button to call, define, edit or remove shortcuts. Realize the following rules: There must be a legal receiver definition containing a name out of the UAM Agent List. Otherwise you will get an error. There must be a content for each defined key. If not it will cause an error. You can leave out the ':'-character in the keys, they are set for you. You can used the arrow keys and to move the input focus arround in the entry fields. Pressing with the focus in the 'Key' column will set the focus to the content field of the key. Pressing with the focus in the 'Content' column will invoke 'OK' with the current entries. Pressing invokes 'Cancel'. will insert the message body which belongs to this shortcut. If no shortcut exist for 'k' it is ignored. ideas/help/shortcuts.hlp100640 764 764 3265 5741223225 14655 0ustar javierjavierWhen in the window 'Message To' you can define a shortcut for often used message bodies. After invoking the button 'Shortcuts' the window 'Shortcuts' is displayed. Its main part is the list of all currently available shortcuts. To insert one of this shortcuts in 'Message To' you can select it from the list and invoke 'Select'. The same effect occurs when double clicking a shortcut in the list. The button 'New' enlarges the shortcut window with an editing part. On the right side two columns of entry fields appears similar to that one in 'Message To'. Define a new shortcut by typing a name for it in the name entry and filling the body of a message in the fields. If you want to, give a character for a keyboard hotkey, too. To register the new shortcut invoke the button 'Add to List'. To close the edit window invoke 'Done Edit' You can edit an existing shortcut by selecting it from the list and invoking the 'Edit' button. In the same manner you can remove a shortcut from the list by invoking 'Remove'. Finally you can invoke the 'Close'-button to delete the 'Shortcuts'-window. Remember the following: Don't forget to specify a name for the new shortcut, otherwise you cannot register it. The hotkeys must be clear, so if you use an char that is in use already, you will get an error when trying to add the shortcut to the list. Use the arrow keys and to move the input focus arround in the editing part of the window. If the editing part is visible a selection in the shortcuts listbox will make the selected shortcut appearing in the editing part. pressed in an entry field will invoke 'Add to List'. pressed in an entry field will invoke 'Cancel'. ideas/help/newMAS.hlp100640 764 764 1771 5760107532 13754 0ustar javierjavierIn IDEAS you have the possibility to start several agents and connect them to a Multi Agent System (MAS) in one step. For this you have to define a description of the MAS and initialize the new agents by choosing this description later. To define a new (MAS) description invoke the UAM menu "Specification - Systems - New System". It will create an editor window containing the standard MAS description file 'standard.mas'. 'standard.mas' includes remarks on the syntax you have to use to specify the agents of the MAS and the connections that should be drawn between them. All you have to do is to save the file under a new name with extension '.mas' in the 'ideas/systems' directory. Because 'standard.mas' is write protected, you have to invoke the 'load'-button in the editor after saving the file under a new name. After that you can define your own MAS description. Don't forget to save the file before invoking a new MAS based on this description ! For starting a MAS see 'UAM: Initialize new Agents'. ideas/help/stdActions.hlp100640 764 764 14212 5760107532 14747 0ustar javierjavierThe following ACTIONS are predefined for use in an agent description: agt_break {} Breaks the evaluation of a received message. If 'agt_break' is called in an action of a Message-Rule, the evaluation of the actual message is stopped just after the action. So after a 'agt_break' call in 'if_Action' or 'else_Action' the 'standard_Action' will not be done. agt_checkaddr
Checks if a communication with the specified address exists.
must be in the form 'host.port'. Returns: 0, if no communication with
exists ; , if a communication with agent exists on
. agt_closecon
Closes the connection to
, if it exists and doesn't lead to SELF or to the UAM.
must be in the form 'host.port'. Returns: 0, if connection is closed ; 1, if no connection exists to
; 2, if the connection leads to SELF ; 3, if the connection leads to UAM. agt_delete Deletion of from the Belief-Base. Use as defined in the ASL-Syntax. Returns: 0, if deletetion is OK ; 1, if it failed . Shows a message of the result in the Logfile. agt_handshake
Builts a connection to
and initializes communication by sending a message of type 'handshake'.
must be in the form 'host.port'. Returns: 0, if everything is OK ; 1, if connection is existing already and waiting for response to handshake ; 2, if connection and communication are existing already; 3, if connection failed . Shows a message in the Logfile. agt_insert Insertion of in the Belief-Base. Use as defined in the ASL-Syntax. Returns: 0, if insertion is OK ; 1, if it failed . Shows a message of the result in the Logfile. agt_loadBelBase Loads a Belief-Base saved with 'agt_saveBelBase' from in directory 'ideas/save' in the Prolog-process. Returns: 0, if everything is OK ; 1, if an error occurred. Shows a message of the result in the Logfile. agt_puts [0] Writes the characters given by into the standard Logfile of the agent. 'agt_puts' normally outputs a newline character after . This can be suppressed by specifying the '0' as second argument. agt_query Queries the Belief-Base. Returns: -1, if a Prolog-Error occurred; shows a message in the Logfile; 0, if cannot be proved in Belief-Base ; 1, if is true in Belief-Base and contains no variables ; {{X1 } ... {Xn }} ... {{X1 } ... {Xn }}, if contains variables X1, ..., Xn, which are true under k values. Each of the k elements of these Tcl-list can be treated as a KeyedList. See Tcl-Help for dealing with KeyedLists. Remark: Do NOT use variables with name A, B or C in a 'agt_query' or you could get wrong answers. agt_saveBelBase Saves the actual Belief-Base in file in directory 'ideas/save'. If necessary extension '.pl' is appended to . Returns: 0, if everything is OK ; 1, if an error occurred when creating the file ; 2, if a write error occurred. Shows a message of the result in the Logfile. agt_send Appends to the list of messages to be sent after evaluation of the actual message. is a KeyedList, that MUST contain the keys ':TYPE' and ':RECEIVER'. The receiver is the name of an agent or may be a list of agents names. If the key ':SENDER' is not specified it will be set automatically to the agents own name. If the key ':REPLY-TO' is not specified it will be set to 'none'. See Tcl-Help for dealing with KeyedLists. Returns: , the number given to , that will be sent as key ':REPLY-WITH' with -1, if one of the keys ':TYPE' or ':RECEIVER' are missing in or a format error occurred in the KeyedList. In this case will not be sent. Shows a message in the Logfile. Remember that the result doesn't say anything about the real result of sending. The message is not sent when calling 'agt_send', but it is buffered and sent, at the end of the current loop, i. e. the evaluation of the actual message. If then, while trying to send, an error occurs, the agent sends a message to itself which has one of the following forms: {:TYPE error} {:CODE 1} {:COMMENT "message format error"} {:TYPE error} {:CODE 3} {:COMMENT "no connection error"} {:TYPE error} {:CODE 4} {:COMMENT "write error"} If the agent receives such a message, a remark is made in his Logfile and the message can be catched by a user defined Message-Rule. agt_tracepoint {} Sets a tracepoint where the agent stops if it is in Tracemode. agt_time {} Gets the actual time for the agent by reading the standard fact 'time' in Belief-Base. (s. 'ASL: Beliefs and Time Expressions') Returns: -1, if an error occurred; , the actual time in UNIX integer format. Remark: To get the current real-time use the TclX-command 'getclock' to read the systems clock. agt_valid [log] Checks the time range in which is valid. Returns: -1, if an error occurred, shows a message in Logfile 0, if doesn't exist in Belief-Base. { }, if is valid from till . and are integer clock values, which can be converted in a human readable form with Tcl-command 'fmtclock'. If is less than , is forever valid after . If 'log' is specified a message is shown in Logfile. ideas/help/tcl.hlp100640 764 764 1654 5742710516 13406 0ustar javierjavierThe easiest way to get help about special Tcl/Tk commands is to call the 'Tcl-Help' in the UAM 'Help'-menu. It invokes a simple and easy to use tool to read the Tcl/Tk manual pages. A text book by John K. Ousterhout is available from Addison Wesley. It's title is 'Tcl and the Tk Toolkit' and it has an ISBN of 0-201-63337-X. The book primarily covers Tcl 7.3 and Tk 3.6. Another book is called "Practical Programming in TCL and TK" by Brent Welch and appears under ISBN 0-13-182007-9 at Prentice Hall in May 1995. The book deals with an introduction to Tcl/Tk in an easy fashion, along with tips on development and discussions of several of the extensions such as incr tcl , TclX, BLT, etc. It covers Tk4.0 and Tcl7.4, and includes a chapter on porting Tk3.6 applications to Tk4.0. There exists a Usenet news group , created for the discussion of the Tcl programming language and tools that use some form of Tcl.ideas/help/mesgEval.hlp100640 764 764 12074 5765533247 14416 0ustar javierjavierThe agent model used in IDEAS is message oriented, i. e. the agent reacts to received messages and starts his actions when evaluating a message. A received message M is a KeyedList of the form {{Key_1 Cont_1} ... {Key_m Cont_m}} and always contains the following keys: :TYPE type of the message; :SENDER sender of the message; :RECEIVER receiver of the message, maybe a list of receiver; :REPLY-TO number of the message this message responds to, maybe 'none'; :REPLY-WITH number of this message, can be used to reply to this message; After initialization the agent is deactive and you have to activate it from UAM by using the 'Activate/Deactivate' button. This causes the UAM to send a command message to the agent, the agent evals the message and changes its status. Command messages from the UAM are the only messages an agent evaluates when it is deactive. All other messages are buffered and evaluated after activation of the agent. Besides that command messages from the UAM have highest priority, i. e. they are evaluated before all other messages, even if the other ones were buffered long before receiving the command. In addition to the keys above, a message could have the key :PRIORITY. :PRIORITY can have the values 0, 1, 2 or 3 and makes the receiver of the message to put it in different priority classes, where class 0 has highest and class 3 lowest priority. :PRIORITY 0 is allowed for messages an agent sends to itself, only. If an agent receives a message without or with an illegal priority specification it sets it to 0, if message is from itself, 1, if it is from UAM and no command, 3, if it is from any other agent. Between messages in the same priority class the 'first-in-first-out' principle is valid. When a message is received, the agent tries to match it with his message- rules, starting with some standard rules, invisible to the user, followed by the message-rules defined in the ASL-script. The evaluation order is the specification order in the script file. A message-rule MR is of the form ((), (), (), (), ()) where is of the form {KeyPatt_1 MatchExpr_1} ... {KeyPatt_n MatchExpr_n} The message M matches the rule MR, if - {KeyPatt_i| i = 1,..,n} is a subset of {Key_i| i = 1,...,m} - Cont_i matches MatchExpr_j, if Key_i = KeyPatt_j, i. e. each character of Cont_i corresponds to the same character in KeyPatt_j or is reprimanded to a variable in the pattern. Especially the order of the keys in the message and the rule is unimportant. For an example of message matching imagine a message-rule with the : ({:TYPE test} {:QUERY Var_subject} {:NAME ~Smith}) The following message would match to that rule: ({:TYPE test} {:QUERY age} {:NAME Smith} {:SENDER joe.alf.1201} ...) ({:NAME Smith} {:RECEIVER jane.gogol.1200} {:TYPE test} {:QUERY heigth} ...) Remember, that 'Var_subject' is a variable and gets the values 'age' and 'heigth' here, but '~Smith' is not a variable and matches only against the string 'Smith'. So the following messages wouldn't match to the rule: ({:TYPE query} {:QUERY price} {:NAME Smith} ...) ({:NAME Johns} {:TYPE test} {:SUBJECT name} ...) If M matches MR the following actions are executed: - , if is evaluated to a value NOT 0, e. g. 1; - , if is evaluated to 0; - , whenever 'agt_break' is not called in or . If 'agt_break' is called in one of the actions, the agent stops the message evaluation _AFTER_ the end of the action, otherwise it tries to match the next message-rule, if the previous one was not the last in type file. If an error occurs while executing one of the actions, the error-message is shown in the Logfile and the agent falls asleep if it is in Tracemode. If it isn't possible to evaluate a received message, the agent sends an error-message back to the sender of the message. This error-message has one of the following forms: {:TYPE error} {:CODE 1} {:COMMENT "message format error"} {:TYPE error} {:CODE 2} {:COMMENT "no match for message"} If an agent receives such a message, a remark is made in his Logfile and the message can be catched by a user defined message-rule. After matching the message with all message-rules or reaching the 'agt_break' signal the evaluation of this message is finished. At this point all messages that were generated while evaluation are sent and then the next message is got from the buffer and evaluated, i. e. the agent is in a new loop. At the beginning of each new loop, i. e. when the next message is got from the buffer, the actual time is read from the system clock and this time is valid for the beliefs until the next loop begins, the next message is got from the buffer. After initialization the agent sends a message to itself of the form {:TYPE initialization} A message of this type is evaluated only once after the first activation of the agent or after a reset and can be caught by a message-rule to start an initial activity of the agent. ideas/help/timeExpr.hlp100640 764 764 6445 5741223225 14417 0ustar javierjavierA belief can be specified with one or two time expressions (< from_time_expr > and < till_time_expr >) to describe the validity of the belief. The belief if valid, if the actual time is greater or equal < from_time_expr > and less or equal < till_time_expr >. The actual time is read from the system clock when starting evaluation of a new message and it is valid until evaluation of this message is done. If < till_time_expr> is not specified or is lower than < from_time_expr >, the belief is valid forever since < from_time_expr>. If no time is specified, the belief is valid at any time. Time expressions will be converted (using Tcl-command 'convertclock') as follows: When inserting a new belief, is converted to an integer clock value. The system can parse and convert virtually any standard date and/or time string, which can include standard time zone mnemonics. If only a time is specified, the current date is assumed. If the string does not contain a time zone mnemonic, the local time zone is assumed, unless the GMT argument is specified, in which case the clock value is calculated assuming that the speci- fied time is relative to Greenwich Mean Time. If baseClock is specified, it is taken as the current clock value. This is useful for determining the time on a specific day. The character string consists of zero or more spec- ifications of the following form: time - A time of day, which is of the form hh[:mm[:ss]] [meridian] [zone] or hhmm [meridian] [zone]. If no meridian is specified, hh is inter- preted on a 24-hour clock. date - A specific month and day with optional year. The acceptable formats are mm/dd[/yy], yyyy/mm/dd, monthname dd[, yy], dd monthname [yy], and day, dd monthname yy. The default year is the current year. If the year is less then 100, then 1900 is added to it. relative time - A specification relative to the current time. The format is number unit; accept- able units are year, fortnight, month, week, day, hour, minute (or min), and second (or sec). The unit can be specified as a singular or plural, as in 3 weeks. These modifiers may also be specified: tomorrow, yesterday, today, now, last, this, next, ago. The actual date is calculated according to the fol- lowing steps. First, any absolute date and/or time is processed and converted. Using that time as the base, day-of-week specifications are added. Next, relative specifications are used. If a date or day is specified, and no absolute or relative time is given, midnight is used. Finally, a correction is applied so that the correct hour of the day is pro- duced after allowing for daylight savings time dif- ferences. Cases are ignored when parsing all words. The names of the months and days of the week can be abbreviated to their first three letters, with optional trailing period. Periods are ignored in any timezone or meridian values. Note that symbolic timezone names will be converted, but these are not standardized and there are conflicts with various parts of the world. Use GMT when trying to produce a portable time that can then be converted back to a numeric value. Only dates in the range 1902 and 2037 may be converted. Some examples are: "14 Feb 92" "Feb 14, 1992 12:20 PM PST" "12:20 PM Feb 14, 1992" "NOW 30 sec" "tomorrow 11:30" ideas/help/menu.hlp100640 764 764 3223 6052370613 13555 0ustar javierjavierThere are some things you should remember when using the menus: If is typed, then the first menu button in the list for the top-level window is posted and the first entry within that menu is selected. If is pressed, then the menu button that has key as its underlined character is posted and the first entry within that menu is selected. The comparison between key and the underlined charac- ters ignores case differences. If no menu button matches key then the keystroke has no effect. Clicking mouse button 1 on a menu button posts that menu and selects its first entry. Once a menu has been posted the following actions are possible: Typing or clicking mouse button 1 outside the menu button or its menu will unpost the menu. If is pressed, then the entry in the posted menu whose underlined character is key is invoked. This causes the menu to be unposted, and the entry's action to be taken. The comparison between key and underlined characters ignores case differences. If no menu entry matches key then the keystroke is ignored. The arrow keys may be used to move among entries and menus. The left and right arrow keys move cir- cularly among the available menus and the up and down arrow keys move circularly among the entries in the current menu. If is pressed, the selected entry in the posted menu is invoked, which causes the menu to be unposted and the entry's action to be taken. If the separating line in the menu is selected with mouse button 1, the menu gets his own toplevel window and can be repositioned on the screen. ideas/help/ACS.hlp100640 764 764 7230 5765533247 13237 0ustar javierjavierIn general and as defined in the Agent Specification Language (ASL) an action for an agent in IDEAS is a Tcl procedure and is specified in the agents ASL-Script. The Tcl interpreter is written in C and provides the possibility of extension with new commands written in C. This feature is used in IDEAS to write actions for the agents in C, too. To do so, you have to write 'Action-C-Source' (ACS). There you specify a C procedure for each new action in a special form described later. The ACS is saved in the directory 'ideas/sources' and then it can be included in every agents script as defined in the ASL. The actions written in C can be used in the same way as those specified in Tcl. The ACS is compiled automatically when starting a new agent process based on such a script. Compilation errors are shown in the UAM Logfile. To simplify the specifcation of the C source, there exists the file 'standard.c' in the directory 'ideas/sources'. It contains the basic elements of an ACS and a few remarks on the syntax you have to use. For each action written in C you have to provide a command procedure in the ACS. This procedure must have a head of the form int cmdProc(ClientData clientData, Tcl_interp *interp, int argc, char *argv[]) 'cmdProc' stands for a free choosen specifier. To avoid conflicts with existing commands you should use a name beginning with 'usr_'. Further it is a good idea to use a name with suffix 'Cmd' and to start with a capital letter after the underline, e. g. 'usr_TestCmd', to make clear that this is the name of a command procedure for a new Tcl command. 'clientData' is used to pass a word-size argument to the command procedure - usually the address of a data structure. But it the most applications you won't need it. 'Tcl_interp' is the data type describing a Tcl-interpreter. In IDEAS each agent is using only one interpreter. 'argc' and 'argv' are used as usually in C for a list of argument strings. An example for a full command procedure head is int usr_TestCmd(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) The body of the command procedure is written as normal in C. But there are some special features to correspond with the Tcl-interpreter by calling predefined procedures. Because it would be to complex to describe this commands here, I advice you to have a look at special information about Tcl. See 'Help: Help about Tcl/Tk' in the Help-Index. To register the new command procedure in the Tcl-interpreter, you have to make a call of 'Tcl_CreateCommand'. For it 'standard.c' includes the procedure 'Ideas_ActSrc_Init'. All you have to do is to extend it with one call of 'Tcl_CreateCommand' for each command procedure. Such a call must be of the form Tcl_CreateCommand(interp, char *cmdName, TclCmdProc *cmdProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); 'cmdName' is the name for the new Tcl command, i. e. the name you have to use later in the ASL-script to call this action. It should be the same as the name of the command procedure but without the suffix 'Cmd' and a non-capital letter after the underline (in our example 'usr_test'), to differ it from the specifier of the command procedure. 'cmdProc' is the name of the command procedure, 'clientData' and 'deleteProc' can be specified as 'NULL' in most cases (for further information about this arguments have a look at the Tcl documentation, too). So in our example we could use Tcl_CreateCommand(interp, "usr_test", usr_TestCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); For defining a new Action-C-Source in IDEAS see 'ACS: Defining a new Action-C-Source (ACS)'. ideas/help/editACS.hlp100640 764 764 747 5741223224 14054 0ustar javierjavierTo edit an existing Action-C-Source (ACS) invoke the UAM menu 'Specification - Action-C-Source - Edit Action-C-Source'. This will open a simple browser window, containing a list of all existing Action-C-Sources with extension '.c' in directory 'ideas/sources'. All you have to do is to select one entry and invoke the 'OK'-button. Then an editor window containing the Action-C-Source will appear. You can shortcut this by doing a double click with left mouse button on a list entry.ideas/help/ASLSyntax.hlp100640 764 764 16470 5774216161 14476 0ustar javierjavierIt follows the definition of the Agent Specification Language (ASL) in an extended BNF where we use the following notations: < > Non-Terminal-Symbols ::= Definition-Symbol | Alternativ-Symbol [ ] Optional-Symbols * n-times Repetition of the previous expression, n = 0, 1, 2, ... All other characters are Terminal-Symbols. ASL-Syntax: < program > ::= [< action-C-source >] [< initial-beliefs >] [< belief-rules >] [< mesg-rules >] [< action-decl >] < action-C-source > ::= ACTION-C-SOURCE {[< filename >]} < initial-beliefs > ::= BELIEFS {(< belief >)*} < belief > ::= < prolog-fact > | (< prolog-fact >), < from-time-expr > [, < till-time-expr >] < prolog-fact > ::= < regular Prolog fact not including ':-' and without a '.' at the end > < from-time-expr > ::= < time-expr > < till-time-expr > ::= < time-expr > < time-expr > ::= < see 'ASL: Beliefs and Time Expressions' in Help-Index > < belief-rules > ::= BELIEF-RULES {(< prolog-rule >)*} < prolog-rule > ::= < regular Prolog rule with ':-' but without a '.' at the end > < mesg-rules > ::= MESSAGE-RULES {< m-rule >*} < m-rule > ::= ((< mesg-form >), (< mesg-cond >), ([< if-action >]), ([< else-action >]), ([< std-action >])) < mesg-form > ::= {:< key-string > < match-expr >}* < key-string > ::= < string of capital letters > < match-expr > ::= < string of characters, may include < variable > , if it should contain spaces you have to set "" around it ! > < variable > ::= < character string starting with a capital letter > < mesg-cond > ::= < Tcl-expression > < if-action> ::= < action > < else-action> ::= < action > < std-action> ::= < action > < action > ::= < Tcl-commandblock > < action-decl > ::= ACTIONS {(< Tcl-proc-declaration >)*} For the specification of the Tcl-parts in this syntax see the Tcl/Tk-documentation ('Help: Help about Tcl/Tk.'). In addition to the syntax you can use the command load < filename > somewhere in an ASL-script outside of ( )-brackets to insert a part of the description from a foreign file < filename > in the directory 'ideas/desc'. The content of < filename > is inserted at the position of the 'load' command and it is read as normal. So you can use the same parts of description in different scripts and changes in the included file are valid for all scripts at the same time. You should use the extension '.desc' for files including a part of a description used with 'load' in several agent scripts. Write a description part in the same manner you write an normal ASL-script. See 'ASL: Defining a new Agent by writing an ASL-Script'. Lines in a script outside of ( )-brackets and in every action beginning with a # -character are interpreted as remarks, as usual in Tcl. Also as usual the sequence backslash-newline can be used to spread a long Tcl-command in the actions across multiple lines. Because the ( )-brackets in an ASL-script must be balanced, you ALWAYS have to set a \-character in front of a bracket you use in a unbalanced position, e.g. when comparing characters like in 'if [cequal $a \(] {...}'. If you ignore this rule you will get an ASL-syntax error when the agent is parsing the script. In the < match-expr > of a message-rule a capital letter is interpreted as the beginning of a variable name. The name ends at the first non-alphanumerical character after that letter. The '_'-character may be used in variable names, too. When evaluating a message with the rule, the variable gets an actual value, belonging to the content of the message. For further details see 'ASL: Message Evaluation'. A ~-character before a capital prevents this mechanism from working and the letter is just seen as what it is and an incoming message must match this letter exactly, if the message-rule should work on the message. A double ~-character sets one fixed ~-character, that must match exactly. The string '$SELF' in BELIEFS, BELIEF-RULES and the < mesg-form > of the MESSAGE-RULES is replaced with the content of the global variable 'SELF' automatically, which contains the full name of the agent, when parsing the ASL-script. It has the form 'name.host.port', where 'name' is given by the user, 'host' is the name of the host the agent process is running on and 'port' is the port number for agents communication. The port is set by the system when starting a new agent and cannot be influenced by the user. A few remarks on specifying an agent: IDEAS is based on Tcl and Tk to have all the advantages of this interpreted language as there are fast editing and testing without compiling, the possibility to create X-Windows in a simple way, extensionality, easy list and string handling etc. But we have to live with the disadvantages, too. One of it is that we use only one interpreter for each agent and so the user could influence the agents 'standard' behaviour in changing global variables or other Tcl/Tk internals. In other words, an agent is not saved against his programmer... To avoid conflicts you should remember some simple rules: - Choose specifiers for your variables and procedures not having the prefix 'agt_'. It is a good idea to use the prefix 'usr_' for actions and 'Usr_' or 'Var_' for variables. Especially never use the variables A, B and C when querying a BELIEF if you want to get correct results ! - Do not change any global variable you didn't create on your own. - Use standard actions to influence the agent and avoid the use of Tcl internals. Especially do not use Tcl-command 'puts' to do an output, because this would sent the text to the UAM. Use the standard action 'agt_puts' for outputs of the agent. It shows the output in the standard Logfile. - The global variable 'SELF' contains the name of the agent itself. You can get its content in an action by derefferenzing with '$SELF'. The string '$SELF' is substituted with the agents name automatically in Beliefs, Belief-Rules and the in Message-Rules. When using '$SELF' or other agent names in a Belief or Belief-Rule you have to set ''-characters around it. Otherwise Prolog handles the name of the agent as a Prolog list (e. g. test.gimli.1200 is [test,gimli|1200] in Prolog). - The global array 'OTHER' contains all agents SELF is connected to at the moment - except 'SELF' and 'UAM'. So you can query the names of that agents with Tcl-command '[array names OTHER]' in an agents action. The content of each array entry is the address of the agent, e. g. 'OTHER(test.gimli.1200)' could contain the address '134.245.57.15.1200'. - Be carefull when using Beliefs with variabels, as in 'name(X)'. When inserting a new Belief all old Beliefs Prolog can match on it are deleted. E. g. if you insert 'name(X)' Beliefs like 'name(olaf)', 'name(joe)', 'name(anne)' and so on are removed from the Belief-Base. On the other hand 'name(X)' will be removed if you insert 'name(olaf)' later. - Initially the Belief-Base contains some standard Prolog-clauses that are used to realize the time in the system (i.e. time, set_time, valid, invalid). Your should not modify these clauses on your own and not use it in an agent script directly. Further you should not use a Prolog-clause 'validity' in a Belief-Base. For defining an ASL-script see 'ASL: Defining a new Agent by writing an ASL-Script'. ideas/help/editMAS.hlp100640 764 764 743 5741223224 14062 0ustar javierjavierTo edit an existing Multi Agent System (MAS) description invoke the UAM menu 'Specification - Systems - Edit System'. This will open a simple browser window, containing a list of all existing system files with extension '.mas' in directory 'ideas/systems'. All you have to do is to select one entry and invoke the 'OK'-button. Then an editor window containing the MAS description will appear. You can shortcut this by doing a double click with left mouse button on a list entry.ideas/help/newACS.hlp100640 764 764 1215 5760107532 13733 0ustar javierjavierTo define a new Action-C-Source (ACS) invoke the UAM menu "Specification - Action-C-Source - New Action-C-Source". It will create an editor window containing the standard ACS file 'standard.c'. 'standard.c' includes remarks on the syntax you have to use to specify a ACS. All you have to do is to save the file under a new name with extension '.c' in the 'ideas/sources' directory. Because 'standard.c' is write protected, you have to invoke the 'load'-button in the editor after saving the file under a new name. After that you can define your own Action-C-Source. Don't forget to save the file before invoking a new agent based on this source ! ideas/help/newScript.hlp100640 764 764 2203 5767050324 14572 0ustar javierjavierTo define a new agent script invoke the UAM menu 'Specification - Agents - New ASL-Script'. It will create an editor window containing the standard script file 'standard.agt'. 'standard.agt' includes the main parts of a agent script and a few remarks on the syntax of the Agent Specification Language (ASL). All you have to do is to save the file under a new name with extension '.agt' in the 'ideas/desc' directory. Because 'standard.agt' is write protected, you have to invoke the 'load'-button in the editor after saving the file under a new name. After that you can fill in your own agent description in the new file. Don't forget to save the file before trying to create a new agent based on this script ! If you only want to write a part of an agent description to include with the 'load'-command in other ASL-files (see 'ASL: The Agent Specification Language (ASL)'), you can use 'standard.agt', too. Just save 'standard.agt' under a new name that should have the extension '.desc' to show that it isn't a full agent script, which have the extension '.agt'. Then delete that parts of the body, you don't need in the part of the description. ideas/help/editScriptFile.hlp100640 764 764 656 5741223224 15511 0ustar javierjavierTo edit an existing script file invoke the UAM menu 'Specification - Agents - Edit ASL-Script'. This will open a simple browser window, containing a list of all existing files in directory 'ideas/desc'. All you have to do is to select one entry and invoke the 'OK'-button. Then an editor window containing the choosen file will appear. You can shortcut this by doing a double click with the left mouse button on a list entry.ideas/help/stdMesg.hlp100640 764 764 2646 5741223225 14227 0ustar javierjavierThe following message types each agent accepts from his UAM by default: {:TYPE command} {:COMMAND handshake} {:ADDRESS
} Send a message of this type to an agent to connect it with the agent on the address
. The address of an agent is his host and his port number in the form 'host.port'. The host may be specified with his name in form of a character string or with its IP-number (e. g. 'gimli.1200' or '134.245.57.15.1200'). This provides you to connect your agents with that of other users on hosts somewhere in the net. {:TYPE command} {:COMMAND reset} Resets the receiving agent, i. e. it clears its belief-base and reads its ASL-script again. The connection to other agents are not broken. {:TYPE command} {:COMMAND chg_status} Makes the receiver to change his status. The UAM button 'Activate/Deactivate' is a shortcut for this message type. {:TYPE command} {:COMMAND exit} Makes the receiver to exit. You should use UAM button 'Delete' to remove an agent. Otherwise the UAM handles the exit of the agent as an 'abnormal exit'. {:TYPE command} {:COMMAND save} {:FILE } Makes the agent to save its actual Belief-Base in a file in directory 'ideas/save'. {:TYPE command} {:COMMAND load} {:FILE } Makes the agent to load a Belief-Base saved before in file in directory 'ideas/save'. ideas/agt_closecon.tcl100640 764 764 4357 6050144165 14330 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_closecon # # Closes a connection to a specified address. # # Arguments: # # addr - addr of agent to close connection to # # Results: # # Returns # # 0 - if connection is closed # 1 - if no connection to addr is existing or waiting for response # 2 - if specified addr belongs to SELF # 3 - if specified addr belongs to UAM # # Removes all entries about the agent belonging to addr in arrays 'agents' # and 'OTHER' # proc agt_closecon {addr} { global agents OTHER global agt_VarComFilter # transform address to TCP/IP-integer form: set addr [agt_hostport2addr $addr] # search for an entry with this address in array 'agents': set found 0 foreach agtName [array name agents] { if {[cequal [keylget agents($agtName) ADDR] $addr]} { set found 1 break } } if {!$found} { agt_puts "No connection to address '$addr' !\n" return 1 } # do not remove SELF ! if {[cequal $agtName SELF]} { agt_puts "Cannot remove connection to SELF !\n" return 2 } # do not remove connection to UAM ! if {[cequal $agtName UAM]} { agt_puts "Cannot remove connection to UAM !\n" return 3 } # remove pipes from/to agent # catch {set inFid [keylget agents($agtName) INFID]} catch {removeinput $inFid} catch {close $inFid} catch {close [keylget agents($agtName) OUTFID]} agt_puts "Connection to agent '$agtName' closed!\n" if {[lsearch $agt_VarComFilter $agtName] != -1} { agt_logComm "Communication with agent '$agtName' closed!\n" } # forget all about this agent # catch {unset OTHER($agtName)} agt_delAgtBitmap $agtName catch {unset agents($agtName)} return 0 } ideas/uam_startAgent.tcl100640 764 764 4334 6115013757 14645 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_startAgent # # Starts a new agent of a given type with a given name. # # Arguments: # # agtName - name of new agent # agtType - name of type file to use # # Results: # # Shows a message of the result in UAM logfile. # proc uam_startAgent {agtName agtType} { global agents env ideas_HomePath uam_VarCompileAdds # get the Action-C-Source specification from the agents type file # if {[catch {set actSrcSpecif [uam_getActSrcFile $agtType]} errorMesg]} { uam_logText "ADL Syntax Error - ACTION-C-SOURCE:\n$errorMesg\n" uam_actSrcError $agtType return } set actSrcFile [lindex $actSrcSpecif 0] set compileAdds [lrange $actSrcSpecif 1 end] # change the working directory to # $ideas_HomePath/sources # set save_path [pwd] cd sources # compile the Action-C-Source if necessary: # if {[catch {uam_compileActSrc $actSrcFile $compileAdds}]} { uam_actSrcError $agtType cd $save_path return } cd $save_path # initialize new agents array entry # append agtName ".$env(HOST)" keylset agents($agtName) NAME $agtName \ TYPE $agtType STATUS deact SOURCE $actSrcFile \ HOMEPATH $ideas_HomePath XDEFAULT [keylget agents(UAM) XDEFAULT] # create new agents process # set newFile [open "| sources/[file rootname $actSrcFile] -f agent.tcl \ $agents($agtName)" r+] set newPid [pid $newFile] keyldel agents($agtName) HOMEPATH keylset agents($agtName) PID $newPid FID $newFile uam_logText "Created: $agents($agtName)\n" # set communication control on pipe to/from new agent # fileevent $newFile readable "uam_commCtrl $newFile $agtName" } ideas/uam_startMAS.tcl100640 764 764 15243 6526027101 14242 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_startMAS # # Reads a Multi-Agent-System description from a file, starts the # described agents and provides later sets of communication paths. # Called by 'uam_newAgt'. # # Arguments: # # systemFile - name of the MAS-description file # # Results: # # Side effect: sets global array uam_VarSystem to recognize the agents # of the MAS later, when they are initialized # proc uam_startMAS {systemFile} { global agents uam_VarSystem uam_logText "Starting Multi-Agent-System '$systemFile'...\n" # try to open the desc file # if {[catch {set fid [open systems/$systemFile r]} errorMesg]} { uam_logText "MAS-Error: $errorMesg\n\nStart of '$systemFile' failed!\n" uam_startMASError $systemFile return } # read the desc and divide it in lines # if {[catch {set desc [split [read $fid] "\n"]} errorMesg]} { uam_logText "MAS-Error: $errorMesg\n\nStart of '$systemFile' failed!\n" uam_startMASError $systemFile return } close $fid # initialize local_VarSystem(CON); it will include a list of lists the # described connections # set local_VarSystem(CON) "" # initialize variable previous; it is used to save the content of a line # if there is a '\'-character at the end # set previous "" # parse the file # foreach line $desc { # look for a '\'-char at the end of line, so the next line belongs # to this one; save this one in previous # if {[cindex $line end] == "\\"} { append previous "[crange $line 0 end-1] " continue } # add previous lines to this one, if there were '\' at the end # set line ${previous}${line} set previous "" # get the keyWord of the line: i.e. the first word # set keyWord [string tolower [lindex $line 0]] # ignore if its a remark or line is empty # if {[regexp ^$|# [cindex $keyWord 0]]} { continue } # check if the line is a agent specification # if {[cequal $keyWord agent:]} { # the it must have 3 elements: 'agent: name type' # if {[llength $line] != 3} { uam_logText "MAS-Syntax-Error in file '$systemFile':\nwrong # args:\ should be \"Agent: agtName typeName\"\n\nStart of '$systemFile'\ failed!\n" uam_startMASError $systemFile return } # get the specified name # set agtName [string tolower [lindex $line 1]] # test if newName is already existing in real agents or in the # list of specified names before; # if it exists add '_no' to the name, where 'no' is a number not # used at this position untill now (1, 2, ...) # set existAgts [concat [array names agents] [array names local_VarSystem]] set renamed 0 set old_agtName $agtName for {set i 1} \ {[lsearch -regexp $existAgts ^${agtName}.*$|^${agtName}$] != -1} \ {incr i} { catch {set agtName [crange $agtName 0\ [string first _[expr $i-1] $agtName]-1]} set agtName ${agtName}_$i set renamed 1 } # save the renaming in a array alias, so we can remember when # checking for the connections to set # if {$renamed} { set alias($old_agtName) $agtName } # get the name of the agents type # set typeFile [string tolower [lindex $line 2]] # possibly we have to add the correct extension '.agt' # if {![cequal [file extension $typeFile] .agt]} { append typeFile .agt } # test if selected filename exists # if {[lsearch [glob desc/*.agt] desc/$typeFile]==-1} { uam_logText "MAS-Error in file '$systemFile':\nType '$typeFile' does\ not exists in directory 'systems'.\n\nStart of \ '$systemFile' failed!\n" uam_startMASError $systemFile return } # save the correct parsed agent name and type in the local array # set local_VarSystem($agtName) $typeFile continue } # test if the line includes a connection description # if {[cequal $keyWord con:]} { # then it must have 3 elements minimum: 'con: recName agtName ...' # if {[llength $line] < 3} { uam_logText "MAS-Syntax-Error in file '$systemFile':\nwrong # args:\ should be \"Con: agtName agtName ?agtName ...?\"\n\nStart\ of '$systemFile' failed!\n" uam_startMASError $systemFile return } set conList "" # get the list of the specified agents in con: and replace names # if they were renamed, i.e. saved in alias array # foreach agtName [lreplace $line 0 0] { set agtName [string tolower $agtName] if {[info exists alias($agtName)]} { lappend conList $alias($agtName) } else { lappend conList $agtName } } # append the list as an element to local array in field CON # lappend local_VarSystem(CON) $conList continue } # in this case there is a keyWord not agent: or cont:, so error # uam_logText "MAS-Syntax-Error in file '$systemFile':\nunknown command\ 'keyWord': should be 'Agent:' or 'Con:'\n\nStart of \ '$systemFile' failed!\n" uam_startMASError $systemFile return } # at this point parsing is done # if there is after end of file parsing a unevaled rest in variable # previous it is an error # if {$previous != ""} { uam_logText "MAS-Syntax-Error in file '$systemFile':\nunexpected end\ of file\n\nStart of '$systemFile' failed!\n" uam_startMASError $systemFile return } # copy the information from the local array in the global uam_VarSystem; # show a remark of renamings in logfile and start the specified agents # foreach name [array names local_VarSystem] { set uam_VarSystem($name) $local_VarSystem($name) if {[info exists alias($name)]} { uam_logText "MAS-Information:\nThere is existing an agent with name\ '$alias($name)'\nCreating agent '$name' instead.\n" } if {![cequal $name CON]} { uam_startAgent $name $uam_VarSystem($name) } } uam_logText "...all agents of MAS started.\n" } ideas/uam_edSystemFile.tcl100640 764 764 10636 6052366507 15154 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_edSystemSile # # This script generates a file browser, which lists the files of # type ".mas"in the 'systems' directory, allows user to choose # one by typing, selecting or double-clicking and opens an editor to # edit it. # # Arguments: None. # # Results: None. # proc uam_edSystemFile {} { global ideas_HomePath catch {destroy .fl} toplevel .fl wm title .fl "Select Multi-Agent-System For Editing" wm iconname .fl "SystemSelect" wm withdraw .fl # Create two frames for managing the main window frame .fl.frame1 -bd 7 frame .fl.frame2 -bd 7 pack .fl.frame1 .fl.frame2 -side left -fill y # Create a label in frame1 and a listbox with a scrollbar on the # right side label .fl.frame1.lbl -text "Systems in directory:" pack .fl.frame1.lbl -side top -anchor w scrollbar .fl.frame1.scroll -command ".fl.frame1.list yview" pack .fl.frame1.scroll -side right -fill y listbox .fl.frame1.list -yscroll ".fl.frame1.scroll set" \ -relief raised \ -exportselection no pack .fl.frame1.list -side left -fill both -expand no # Create in frame2 an entry for selected filename and # buttons for OK and CANCEL label .fl.frame2.lbl -text "selected file:" entry .fl.frame2.inpt -relief sunken pack .fl.frame2.lbl .fl.frame2.inpt -anchor w button .fl.ok -text OK \ -width 15 \ -command "uam_edSystemFileOK" frame .fl.default -relief sunken -bd 1 raise .fl.ok .fl.default button .fl.cancel -text CANCEL \ -width 15 \ -command "destroy .fl; focus .mbar" pack .fl.cancel -in .fl.frame2 -side bottom \ -pady 1 -ipadx 2m -ipady 1m pack .fl.default -in .fl.frame2 \ -side bottom \ -pady 4m pack .fl.ok -in .fl.default \ -padx 1m -pady 1m \ -ipadx 2m -ipady 1m # Set up bindings for the browser bindtags .fl.frame1.list {Listbox .fl.frame1.list} bind .fl.frame1.list { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } bind .fl.frame1.list { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt .fl.ok flash .fl.ok invoke} bind .fl.frame1.list {focus .fl.frame2.inpt} bind .fl.frame1.list {uam_insertLbSel .fl.frame1.list .fl.frame2.inpt} bind .fl.frame1.list {uam_insertLbSel .fl.frame1.list .fl.frame2.inpt} bind .fl.frame1.list { if {[set sel [.fl.frame1.list curselection]]!=""} { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } .fl.ok flash .fl.ok invoke} bind .fl.frame1.list {.fl.cancel flash .fl.cancel invoke} bind .fl.frame2.inpt {.fl.ok flash .fl.ok invoke} bind .fl.frame2.inpt {focus .fl.frame1.list} bind .fl.frame2.inpt {.fl.cancel flash .fl.cancel invoke} bind .fl.frame1.list {uam_initHelp editMAShlp} bind .fl.frame1.list {uam_initHelp editMAS.hlp} bind .fl.frame1.list {uam_exit} bind .fl.frame2.inpt {uam_initHelp editMAS.hlp} bind .fl.frame2.inpt {uam_initHelp editMAS.hlp} bind .fl.frame2.inpt {uam_exit} # fill the listbox with files with extension '.mas' in directory 'systems': uam_fillLb .fl.frame1.list "$ideas_HomePath/systems/*.mas" uam_selectLbEntry .fl.frame1.list 0 uam_insertLbSel .fl.frame1.list .fl.frame2.inpt update idletasks # place the window on its parent window: set dad [winfo parent .fl] set x [expr [winfo x $dad] + \ ([winfo reqwidth $dad] - [winfo reqwidth .fl])/2] set y [expr round([winfo y $dad] + [winfo reqheight $dad]*0.3)] wm geom .fl +$x+$y wm deiconify .fl focus .fl.frame2.inpt tkwait window .fl } # On OK do this: proc uam_edSystemFileOK {} { global uam_EditProcs uam_Editor set file [.fl.frame2.inpt get] if {[lsearch [glob systems/*.mas] systems/$file]>=0} { destroy .fl focus .mbar uam_startEditor systems/$file } else { uam_notExSystem $file .fl.frame2.inpt delete 0 end } } ideas/agt_hostport2addr.tcl100640 764 764 2446 6115063171 15316 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_hostport2addr # # Transforms an agents address of form host.port to form # inet_addr.port , i.e. point notation, if possible. # # Arguments: # # addr - address if host.port form # # Results: # # address in form inet_addr.port or addr if transforming is impossible # proc agt_hostport2addr {addr} { # get agents host and port from addr by splitting it: # Form: host.port # set a [expr [string last . $addr ]-1] set agtHost [string range $addr 0 $a] incr a 2 set agtPort [string range $addr $a end] # try to replace the host in address by internet Name # catch {set addr [lindex [server_info addresses $agtHost] 0].$agtPort} return $addr } ideas/agt_updateComFilter.tcl100640 764 764 5502 6050144166 15604 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_updateComFilter # # This function is called automatically by Tcl-command 'trace' # whenever the global arra OTHER is changed, i.e. is written # or unset. # agt_updateComFilter checks which element of the array is new # or deleted and if the communication to the agent with this name # is filtered for communication logfile, i.e. if this name is in # global list agt_VarComFilter or in agt_VarComNotFilter. # These lists and their two help lists, agt_VarTempComFilter and # agt_VarTempComNotFilter, are updated. # Also the entry in the filter selection widget in agents observation # window are updated. # # Arguments: # # varname - name of the traced variable (here always OTHER) # element - element of array that is modified # operator - operations that happend to the element: # w for writing, # u for unsetting the element # Results: None. # proc agt_updateComFilter {varname element operator} { global OTHER agt_VarComFilter agt_VarTempComFilter global agt_VarComNotFilter agt_VarTempComNotFilter if {[cequal $operator w]} { # when operation is writing it is always a new element; # append it always to the NotFilter list # .f5.filter.list1 insert end $element lappend agt_VarComNotFilter $element lappend agt_VarTempComNotFilter $element } else { if {[cequal $operator u]} { # when a element is unset, check in which list it appears # and remove it from there and from the list in filter widget # if {[set index [lsearch $agt_VarComFilter $element]] != -1} { set agt_VarComFilter [lreplace $agt_VarComFilter $index $index] } else { if {[set index [lsearch $agt_VarComNotFilter $element]] != -1} { set agt_VarComNotFilter [lreplace $agt_VarComNotFilter $index $index] } } if {[set index [lsearch $agt_VarTempComFilter $element]] != -1} { set agt_VarTempComFilter [lreplace $agt_VarTempComFilter $index $index] .f5.filter.list2 delete $index } else { if {[set index [lsearch $agt_VarTempComNotFilter $element]] != -1} { set agt_VarTempComNotFilter \ [lreplace $agt_VarTempComNotFilter $index $index] .f5.filter.list1 delete $index } } } } update } ideas/uam_newAgtChgView.tcl100640 764 764 3554 6052366507 15242 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_newAgtChgView # # Changes the view in the widget for selecting new agents to initialize # between the list of agent-types and the list of MAS. # # Arguments: None. # # Results: None. # # proc uam_newAgtChgView {} { global uam_VarInitType ideas_HomePath # value of global variable 'uam_VarInitType' shows which view is actual: # 1 agent types # 2 Multi-Agent-Systems if {$uam_VarInitType == 1} { .init.top.inpt configure -state normal .init.top.lbl configure -foreground black .init.frame1.lbl configure -text "Scripts in Directory:" .init.frame2.lbl configure -text "Selected Script:" uam_fillLb .init.frame1.list $ideas_HomePath/desc/*.agt uam_selectLbEntry .init.frame1.list 0 uam_insertLbSel .init.frame1.list .init.frame2.inpt focus .init.top.inpt update } else { .init.top.inpt configure -state disabled .init.top.lbl configure -foreground slategray3 .init.frame1.lbl configure -text "Systems in Directory:" .init.frame2.lbl configure -text "Selected System:" uam_fillLb .init.frame1.list $ideas_HomePath/systems/*.mas uam_selectLbEntry .init.frame1.list 0 uam_insertLbSel .init.frame1.list .init.frame2.inpt focus .init.frame2.inpt update } } ideas/agt_initShortHelp.tcl100640 764 764 17346 6050144165 15341 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_initShortHelp # # This file initializes the ShortHelp for UAM. # The array 'agt_Shorthelp' is filled with help text for # specified widgets. # # Entries have the following format: # # set agt_ShortHelp(widgetName) helpText # # This causes 'helpText' to been shown as shortHelp # for widget 'widgetName'. # set agt_ShortHelp(.shortHelp) \ "The IDEAS - ShortHelp :\n\nThe ShortHelp is\ invoked by pointing with the cursor on a detail of an IDEAS-window\ and pressing the right mouse button.\n\nIf ShortHelp is available for\ this item a window like this appears and gives you a short description." set agt_ShortHelp(.mbar.help.menu) $agt_ShortHelp(.shortHelp) set agt_ShortHelp(.f0) \ "The Agent Observation Window :\n\nEach agent has its own Observation\ Window which provides several possibilities to control its activities." set agt_ShortHelp(.mbar) $agt_ShortHelp(.f0) set agt_ShortHelp(.mbar.view) \ "The View Menu :\n\nContains menubuttons to show or to hide\n\n - the\ standard Logfile\n - the Logfile for Message-Evaluation\n - the Logfile\ for selected Communication\n - the actual Communication-Paths\n\ - the\ actual Belief-Base." set agt_ShortHelp(.mbar.view.menu) $agt_ShortHelp(.mbar.view) set agt_ShortHelp(.mbar.trace) \ "The Trace/Untrace Button :\n\nThe activation\ of this button sets the agent in 'Trace-Mode'.\n\nIn this mode the agent\ will recognize tracepoints in his script created with the standard action\ 'agt_tracepoint' and falls asleep whenever running in one of them.\n\nThe\ user has to awake it by pressing the 'Wake Up'-button which will appear\ in the observation window.\n\nIf the agent is in Trace-Mode invoking\ this menubutton switches of the tracing." set agt_ShortHelp(.mbar.exit) \ "The Exit Menu :\n\nIf the Exit menu is visible\ the agent lost the connection to his UAM.\n\nIn this case you can close\ the agent correctly by invoking this menu or using 'Ctrl-q' as a shortcut." set agt_ShortHelp(.trace.wakeup) \ "The Wake Up Button :\n\nIf this button is\ visible the agent is in Trace-Mode.\n\nWhenever running on a tracepoint\ it falls asleep and you have to awake it by pressing this button to\ continue working.\n\nYou can leave the Trace-Mode by invoking the 'untrace'\ menubutton." set agt_ShortHelp(.trace) $agt_ShortHelp(.trace.wakeup) set agt_ShortHelp(.f1) \ "The Logfile Widget :\n\nIn this widget you can control\ agents activities by having a look in his standard Logfile.\n\nThe\ standard Logfile takes the minute of all communication and user can add\ text to logfile by calling the standard action 'agt_puts' in agents\ ASL-script.\n\nThe whole Logfile is written to a file with extension\ '.log' in directory 'logfiles'.\n\nThe 'Auto-Scroll'-checkbutton is used\ to see always the latest entry in the widget." set agt_ShortHelp(.f1.label) $agt_ShortHelp(.f1) set agt_ShortHelp(.f1.mbar) $agt_ShortHelp(.f1) set agt_ShortHelp(.f1.mbar.scroll) $agt_ShortHelp(.f1) set agt_ShortHelp(.f1.text) $agt_ShortHelp(.f1) set agt_ShortHelp(.f2) \ "The Communication-Paths Widget :\n\nThis widget shows\ you the current communication paths of your agent in a graphical\ form.\n\nTo get informations about the displayed agents set the cursor\ on the bitmap and press the left button.\nBy holding the middle button\ pressed on a bitmap - not SELF - you can move it around in the\ widget.\n\nIf a connection is drawn in grey colour it is waiting for a\ response of the specified address.\nIf SELF is deactive its bitmap is\ drawn in grey, too." set agt_ShortHelp(.f2.label) $agt_ShortHelp(.f2) set agt_ShortHelp(.f2.c) $agt_ShortHelp(.f2) set agt_ShortHelp(.f3) \ "The Belief Base Widget :\n\nThis widget shows\ you the current status of the Belief-Base.\n\nProlog-clauses are sorted\ and each group of facts has a headline signed with a '%'-character." set agt_ShortHelp(.f3.label) $agt_ShortHelp(.f3) set agt_ShortHelp(.f3.text) $agt_ShortHelp(.f3) set agt_ShortHelp(.f4) \ "The Message-Evaluation Widget :\n\nThis widget gives you a look at the\ Message-Evaluation Logfile.\n\nIn spite of the standard Logfile this one\ only takes the minutes of the evaled Message-Rules.\n\nIt shows which rule\ is evaled and whats the current values of its match-variables are when it\ matches a message.\n\nThe whole Message-Evaluation Logfile is written to a\ file with extension '.msg' in directory 'logfiles', but it is deleted with\ deleting the agent if you don't invoke the 'Save'-checkbutton on the\ Message-Evaluation menubar.\n\nThe 'Auto-Scroll'-checkbutton is used to\ see always the latest entry in the widget." set agt_ShortHelp(.f4.label) $agt_ShortHelp(.f4) set agt_ShortHelp(.f4.mbar) $agt_ShortHelp(.f4) set agt_ShortHelp(.f4.mbar.scroll) $agt_ShortHelp(.f4) set agt_ShortHelp(.f4.mbar.save) $agt_ShortHelp(.f4) set agt_ShortHelp(.f4.text) $agt_ShortHelp(.f4) set agt_ShortHelp(.f5) \ "The Communication Widget :\n\nThis widget allows you to have a nearer\ look on the messages the agent sends and receives.\nIt enables you to\ watch the communication of this agent with selected agents it is connected\ to.\n\nTo select these other agent use the Communication Filter which is\ invoke by the 'filter'-button on the Communication menubar.\n\nThe\ 'Auto-Scroll'-checkbutton is used to see always the latest entry in the\ widget." set agt_ShortHelp(.f5.label) $agt_ShortHelp(.f5) set agt_ShortHelp(.f5.mbar) $agt_ShortHelp(.f5) set agt_ShortHelp(.f5.mbar.filter) $agt_ShortHelp(.f5) set agt_ShortHelp(.f5.mbar.save) $agt_ShortHelp(.f5) set agt_ShortHelp(.f5.mbar.scroll) $agt_ShortHelp(.f5) set agt_ShortHelp(.f5.text) $agt_ShortHelp(.f5) set agt_ShortHelp(.f5.filter) \ "The Communication Filter :\n\nIn this widget you can select which\ communication you want to watch in the Communication widget.\n\nAll\ messages from and to the agents in the right listbox are shown\ in the Communication Logfile.\n\nYou can move an agent name from one\ listbox to the other by pressing the 'Add'/'Remove'- button (resp.) or\ just doing a double click with the mouse cursor on the selected\ name.\n\nPress 'OK' to agree and 'Cancel' to forget your choice.\n\nThe\ whole Communication Logfile is written to a file with extension '.com'\ in directory 'logfiles', but it is deleted with deleting the agent if\ you don't invoke the 'Save'-checkbutton on the Communication\ menubar." set agt_ShortHelp(.f5.filter.a) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.b) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.lbl1) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.lbl2) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.list1) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.list2) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.add) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.rem) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.ok) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.f5.filter.cancel) $agt_ShortHelp(.f5.filter) set agt_ShortHelp(.mbar.help) "The Help Menu :\n\nIt leads you to the IDEAS-Help-System." ideas/agt_showShortHelp.tcl100640 764 764 5207 6050144166 15330 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_showShortHelp # # This procedure is invoked by pressing the right mouse button # on widgets in UAM. # It creates a shortHelp window and shows a helptext registered # for this widget in global array 'agt_ShortHelp' # done in 'agt_initShortHelp.tcl'. # # Arguments: # # helpItem - widget name to show help for # xPos - x-coordinate for help window # yPos - y-coordinate for help window # # Results: # # None. # proc agt_showShortHelp {helpItem xPos yPos} { global agt_ShortHelp # initialize shortHelp at first call # if {![info exists agt_ShortHelp]} { source agt_initShortHelp.tcl } if {![info exists agt_ShortHelp($helpItem)]} { return } # create the ShortHelp-window # set w .shortHelp catch {destroy $w} toplevel $w wm withdraw $w wm title $w "IDEAS - ShortHelp" wm iconname $w "ShortHelp" frame $w.f1 frame $w.f2 pack $w.f1 -padx 5 -pady 5 -fill both -expand yes pack $w.f2 -side bottom -padx 5 -pady 5 -fill x button $w.but1 -text Close \ -command "destroy $w" \ -width 10 pack $w.but1 -in $w.f2 -expand 1 \ -padx 3m -ipadx 2m -ipady 1m text $w.text -relief raised -bd 2 \ -yscrollcommand "$w.scroll set" \ -font -Adobe-Times-Medium-R-Normal-*-180-* \ -wrap word \ -height 8 \ -width 35 scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -in $w.f1 -side right -fill y pack $w.text -in $w.f1 -side left -fill both -expand yes bind $w "set agt_VarSafeFocus [focus]; focus $w" bind $w {focus $agt_VarSafeFocus} bind $w "$w.but1 invoke" bind $w "$w.but2 flash; $w.but2 invoke" update idletasks if {$xPos < 0} { set dad [winfo parent $w] set xPos [expr [winfo x $dad] + \ ([winfo reqwidth $dad] - [winfo reqwidth $w])/2] set yPos [expr round([winfo y $dad] + [winfo reqheight $dad]*0.3)] } wm geometry $w +$xPos+$yPos wm minsize $w [winfo reqwidth $w] [winfo reqheight $w] wm deiconify $w $w.text insert end $agt_ShortHelp($helpItem) $w.text configure -state disabled } ideas/uam_helpSystemProcs.tcl100640 764 764 12336 6052362331 15711 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_helpSystemProcs # # This file contains the procedures for the IDEAS HelpSystem. # # # uam_initHelp # # Initializes the window for the help system. # # Arguments: # # fileName - name of helpfile to show in widget (standard: "") # # Results: None. # proc uam_initHelp {{fileName ""}} { global uam_VarHelpTopic uam_VarHelpIndex ideas_HomePath set w .help # create a new toplevel: # catch {destroy $w} toplevel $w wm withdraw $w wm title $w "IDEAS - Help System" wm iconname $w "IDEAS - Help" # create a listbox for the list of available help topics: # frame $w.f0 -relief ridge -bd 2 pack $w.f0 -padx 3 -pady 3 -side top -fill x -expand yes label $w.f0.lbl -text "Topics:" \ -relief ridge -bd 2 listbox $w.f0.list -relief ridge \ -yscroll "$w.f0.scroll set" \ -height 8 -width 65 \ -exportselection no scrollbar $w.f0.scroll -command "$w.f0.list yview" pack $w.f0.lbl -side top -fill x pack $w.f0.scroll -side right -fill y pack $w.f0.list -side left -fill both -expand yes bind $w.f0.list "$w.f1.show flash; $w.f1.show invoke" bind $w.f0.list "$w.f1.show flash; $w.f1.show invoke" bind $w "$w.f1.close flash; $w.f1.close invoke" # create two buttons: # 'Show' to watch a topic # 'Close' to exit the HelpSystem # frame $w.f1 -relief ridge -bd 2 pack $w.f1 -padx 3 -pady 3 -side top -fill x -expand yes button $w.f1.show -text Show \ -width 8 \ -command "uam_showHelpFile" button $w.f1.close -text Close \ -width 8 \ -command "destroy $w" pack $w.f1.show -side left -expand yes\ -padx 15m -pady 1m -ipadx 2m -ipady 1m pack $w.f1.close -side left -expand yes\ -padx 15m -pady 1m -ipadx 2m -ipady 1m # create a text widget for displaying the content of a topic: # frame $w.f2 -relief ridge -bd 2 pack $w.f2 -padx 3 -pady 3 -side top -fill x -expand yes frame $w.f2.fr -relief ridge -bd 2 pack $w.f2.fr -side top -fill x -expand yes label $w.f2.fr.lbl1 -relief flat\ -padx 2m label $w.f2.fr.lbl2 -textvariable uam_VarHelpTopic \ -relief flat -anchor w pack $w.f2.fr.lbl1 -side left pack $w.f2.fr.lbl2 -side left -fill x -expand yes text $w.f2.text -relief ridge -bd 2 \ -yscrollcommand "$w.f2.scroll set" \ -wrap word \ -height 25 \ -width 65 \ -padx 1m \ -state disabled \ -font "-adobe-new century schoolbook-medium-r-*--14-100-*" scrollbar $w.f2.scroll -relief ridge -command "$w.f2.text yview" pack $w.f2.scroll -side right -fill y pack $w.f2.text -side left -fill both -expand yes # read the HelpIndex: # source $ideas_HomePath/help/uam_helpIndex.tcl # fill the list of topics: # foreach topic $uam_VarHelpIndex { $w.f0.list insert end [lindex $topic 0] } # show the specified HelpFile in the text widget: # uam_showHelpFile $fileName wm deiconify $w } # # uam_showHelpFile # # Shows a specified HelpFile in the text widget of the IDEAS # HelpSystem window. # The file is specified as an argument to this proc. If argument is # unspecified or empty , the current selection in topics-listbox of # the HelpSystem is got. # If no HelpFile is specified, it shows the standard inforamtion # for the HelpSystem. # # Arguments: # # fileName - name of the HelpFile to show (standard: empty) # # Results: None. # proc uam_showHelpFile {{fileName ""}} { global uam_VarHelpTopic uam_VarHelpIndex ideas_HomePath if {$fileName == ""} { # get the current selection in listbox 'Topics' of HelpSystem: set sel [.help.f0.list curselection] if {$sel == ""} { set uam_VarHelpTopic "Help: The IDEAS - Help System" set fileName helpSystem.hlp } else { # get the HelpFile for the selected topic: # set uam_VarHelpTopic [.help.f0.list get $sel] set fileName [lindex [lindex $uam_VarHelpIndex $sel] 1] } } else { set uam_VarHelpTopic \ [lindex [lindex $uam_VarHelpIndex \ [lsearch $uam_VarHelpIndex *$fileName*]] 0] } set error 0 if {$fileName == ""} { set errorMesg "No help file specified for '$uam_VarHelpTopic' in\ HelpIndex." set error 1 } # open the HelpFile and read the content: # if {$error || ([catch {set fid [open $ideas_HomePath/help/$fileName r]} \ errorMesg])} { set content "Sorry, this topic is not available ...\n\nError: $errorMesg" } else { set content [read $fid] } catch {close $fid} # show the content of HelpFile in text widget: # .help.f2.text configure -state normal .help.f2.text delete 1.0 end .help.f2.text insert end $content .help.f2.text configure -state disabled update } ideas/agt_valid.tcl100640 764 764 4623 6050144166 13617 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_valid # # Returns the valid time interval of a belief. # # Arguments: # # belief - belief to check # option - if specified as 'log' a human readable time is printed to Logfile, # by default not done # # Results: # # -1 - if Prolog error occurs # 0 - if belief is not in Belief-Base # {from till} - if belief is valid from 'from' and till 'till' # where 'from' and 'till' are UNIX datestrings # # proc agt_valid {belief {option no}} { global agt_VarTimeOffset if {[set result [agt_listQuery "validity($belief,FROM, TILL)"]] == -1} { return -1 } if {$result == 0} { if {[cequal $option "log"]} { agt_puts "No Belief '$belief'.\n" } return 0 } # the result is a list where each element is a KeyedList; # for an unique result only deal with the first list element: # set result [lindex $result 0] keylget result FROM timeFrom keylget result TILL timeTill # correct the Prolog-time with the time offset used to make # a UNIX datestring Prolog readable: incr timeFrom $agt_VarTimeOffset incr timeTill $agt_VarTimeOffset if {[cequal $option "log"]} { agt_puts "Belief '$belief' valid\nfrom\ ([fmtclock $timeFrom])\ntill\ ([fmtclock $timeTill]).\nCurrent time:\ ([fmtclock [getclock]])\n" } return "$timeFrom $timeTill" } # # agt_time # # Returns the actual time of the agent by reading # the standard Prolog-fact time/1 of Belief-Base. # # Arguments: None. # # Results: # # The actual time in integer format or # -1 if an error occured. # proc agt_time {} { global agt_VarTimeOffset if {[set result [agt_listQuery "time(Time)"]] == -1} { return -1 } set actTime [lindex $result 0] keylget actTime Time actTime return [incr actTime $agt_VarTimeOffset] } ideas/agt_prologServ.pl100640 764 764 6216 6664734406 14530 0ustar javierjavier% % Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann % Computer Science Department, % Christian-Albrechts-University of Kiel, % Olshausenstr. 40, 24118 Kiel, Germany % % All rights reserved. % No warranties will be given on any issues arising out of the use % of this software product. % Permission to use, copy, modify and distribute this software % product for non-commercial purposes is hereby granted, provided % that the above copyright notice appears in all copies and % respective publications. % All commercial trades with this product outside the CAU Kiel % without specific written prior permission are prohibited. % % % agt_prologServ.pl % % BinProlog side of a Tcl/BinProlog interface % used in IDEAS. % % Based on 'server.pl' by Paul Tarau. % Modified for IDEAS by Olaf Scheew, 1995 % % The BinProlog process is in IDEAS a child of the % Tcl process of an agent and is subordinated to Tcl. % BinProlog gets the input from Tcl on stdin and % writes the output to stdout. % Tcl sends queries integrated in one of three % special string which are 'call_prolog', 'query_prolog' % and 'query_prolog_list'. Prolog reacts on this strings % as defined later. :-[oper]. :-[init]. :-[lib]. :-[builtins]. :-[dcg]. :-[read]. :-[write]. :-[bin]. :-[co]. :-[extra]. :-op(200,fx,('$')). % start predicate for the Prolog Tcl-server % main(X):-prolog_server(X). % main loop of the server: % initializes the server when starting, repeats % reading input from stdin and evaling it by using % the predicate 'react' % prolog_server(X):- init_server, repeat, in(X,Vs), react(X,Vs), !. % initialization of server: % shuts of interactivity and sends a EOPA % - End Of Prolog Answer - to Tcl for initialization % confirmation % init_server:- interactive(no), end_symbol. % the predicate 'react': react(end_of_file,_):-!. % 'call_prolog' is used to do a quite Prolog evaluation, % i.e. there is no result given back to Tcl except errors % react(call_prolog(X),_):-!,X,!,end_symbol,fail. % 'query_prolog' gives back all the results of the Prolog % evaluation in the standard BinProlog format % react(query_prolog(X),Vs):-query_prolog(X,Vs),fail. % 'query_prolog_list' gives back the result in a special form: % all values for variables in the query X are divided from each % other by a '|' symbol. % If the result of query is TRUE, a single '|' is sent. % If the result is FALSE, just the EOPA is sent. % This format is catched on the Tcl side of this interface and % used to build up a Tcl list of the result. % 'query_prolog_list' is the standard form used for all queries % to the Belief-Base. % react(query_prolog_list(X),Vs):-query_prolog_list(X,Vs),fail. query_prolog(X,Vs):-X,nl,member(A,Vs),write(A),nl,fail. query_prolog(_,_):-end_symbol. query_prolog_list(X,Vs):-X,write('|'),nl,member(A,Vs),write(A),nl,fail. query_prolog_list(_,_):-end_symbol. % 'EOPA' marks the end of the prolog answer and is sent at % the end of each query evaluation to Tcl. end_symbol :- write('EOPA'),nl. % predicates 'in' and 'in1' for reading input from % stdin into a Prolog variable in(T):-in(T,_). in(T,Vs):-read_term(L,Vs),!,in1(L,T). in1([X|Xs],T):-!,member(T,[X|Xs]). in1(T,T). ideas/agt_timeSet.tcl100640 764 764 1740 6050144166 14127 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_timeSet # # Set the time-fact in Belief-Base to current time. # # Arguments: None. # # Results: None. # proc agt_timeSet {} { global agt_VarTimeOffset if {[catch {agt_quietQuery "set_time([expr [getclock]-$agt_VarTimeOffset])"}\ errorMesg]} { agt_puts "Error - TimeSet: $errorMesg\n" return } agt_displayBelBase } ideas/agt_parseActSrc.tcl100640 764 764 5604 6050144165 14731 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_parseActSrc # # Used to read the ACTION-C-SOURCE specification from type file. # # Arguments: # typeFile (referenz) - list of lines of agt type file not # scanned till now # actLine (referenz) - actual line to scan # # Results: # # 'typeFile' is scanned for the specification in balanced # brackets, read lines are popped. # 'actLine' contains the unscanned rest of the actual line to scan. # Returns an error with an errorMesg if a scan error occurs # proc agt_parseActSrc {typeFile actLine} { upvar $typeFile file \ $actLine line # variable 'actSrcFile' will contain the name of the source file set actSrcFile "" # The next character in this line must be an open bracket # if {[cindex $line 0] != "\{"} { return -code error "'\{' expected at '$line'" } # initialize counter for open brackets set brackets 1 # first character in $line is now a \{-bracket # remove the bracket and following spaces set line [string trimleft [csubstr $line 1 end]] # initialize a character counter for 'line' set chCt -1 # run through file until brackets are balanced while {$brackets != 0} { incr chCt set char [cindex $line $chCt] switch -glob -- $char { \{ {incr brackets 1} \} {incr brackets -1} "" { # if last character in line is "\" remove it before # appending the line to actSrcFile and poping next line # from file; # if {[cequal "\\" [cindex $line $chCt-1]]} { if {$chCt >= 2} { append actSrcFile [crange $line 0 $chCt-2] } append actSrcFile " " } if {[cequal $file ""]} {break} # get the next line from file set line [string trim [lvarpop file]] set chCt -1 } # { # this is a remark, so forget this line and # get the next line from file set line [string trim [lvarpop file]] set chCt -1} } } if {$chCt} { append actSrcFile [crange $line 0 $chCt-1] } if {$brackets} { return -code error "'\}' expected at '$line'." } # character under 'chCt' is now a \}-bracket; # remove the chars till 'chCt' inclusive the bracket and following # white spaces # set line [string trimleft [crange $line $chCt+1 end]] } ideas/uam_compileActSrc.tcl100640 764 764 7412 6117237047 15263 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_compileActSrc # # Compile the Action-C-Source file befor starting an agent, # if necessary. # # Arguments: # # fileName - name of C-source file # # Results: # # Shows a message in UAM logfile, generates an error, # if compilation failed. # proc uam_compileActSrc {fileName compileAdds} { global ideas_Compiler ideas_ExtraCompilerOptions \ ideas_TclIncludes ideas_X11Includes \ ideas_TclLibraries ideas_CompLibraries # the current directory is set in calling procedure to # $ideas_HomePath/sources # # if objectfile for 'agt_wish' does not exist, built it by compilation # of 'agt_wish.c' : # if {![file exists ../agt_wish.o]} { set CC "$ideas_Compiler ../agt_wish.c \ -o ../agt_wish.o -c \ -I$ideas_TclIncludes -I$ideas_X11Includes" # start the compilation of 'agt_wish.c': # uam_logText "Compiling agent base ...\n$CC" # change the cursor to watch while compiling # foreach widget [winfo children .] { catch {$widget configure -cursor watch} } .log.text configure -cursor watch update if {[catch {eval "exec $CC"} errorMesg]} { uam_logText "$errorMesg\nCompilation failed!\n\nWARNING:\ This is a basic error. You should check the entries in file\ 'init.tcl'. If they are correct reinstall the files\ 'agt_wish.c' in IDEAS home directory to\ make IDEAS working !\n" # reset the cursor # foreach widget [winfo children .] { catch {$widget configure -cursor {}} } .log.text configure -cursor {} .mbar configure -cursor {} update return -code error } else { uam_logText "...ready.\n" } } # and now the Action-C-Source: set fileRootName [file rootname $fileName] set CC "$ideas_Compiler $fileName ../agt_wish.o \ $compileAdds -o $fileRootName \ -I$ideas_TclIncludes -I$ideas_X11Includes \ -L$ideas_TclLibraries $ideas_CompLibraries \ $ideas_ExtraCompilerOptions" # check if its necessary to compile the source, i. e. if the source is # change after the last compilation, if there was one, or the agents base # 'agt_wish' is compiled new: # if {[file exists $fileRootName] && \ !([file mtime ../agt_wish.o] > [file mtime $fileRootName])} { if {[file mtime $fileRootName] > [file mtime $fileName]} { uam_logText "No change in Action-C-Source '$fileName', not compiling.\n" return } } # start the compilation of Action-C-Source: # uam_logText "Compiling Action-C-Source '$fileName' ...\n$CC" # change the cursor to watch during compilation # foreach widget [winfo children .] { catch {$widget configure -cursor watch} } .log.text configure -cursor watch update if {[set errorNo [catch {eval "exec $CC"} errorMesg]]} { uam_logText "$errorMesg\nCompilation failed!\n" set error 1 } else { uam_logText "...ready.\n" set error 0 } # reset the cursor # foreach widget [winfo children .] { catch {$widget configure -cursor {}} } .log.text configure -cursor {} .mbar configure -cursor {} update if {$error} { return -code error } return } ideas/uam_edActSrcFile.tcl100640 764 764 10607 6052366507 15045 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_edActSrcFile # # This script generates a file browser, which lists the files of # type '.c' in the 'sources' directory, allows user to choose # one by typing, selecting or double-clicking and opens an editor to # edit it. # # Arguments: None. # # Results: None. # proc uam_edActSrcFile {} { global ideas_HomePath catch {destroy .fl} toplevel .fl wm title .fl "Select Action-C-Source For Editing" wm iconname .fl "ActSrcSelect" wm withdraw .fl # Create two frames for managing the main window frame .fl.frame1 -bd 7 frame .fl.frame2 -bd 7 pack .fl.frame1 .fl.frame2 -side left -fill y # Create a label in frame1 and a listbox with a scrollbar on the # right side label .fl.frame1.lbl -text "C-Sources in directory:" pack .fl.frame1.lbl -side top -anchor w scrollbar .fl.frame1.scroll -command ".fl.frame1.list yview" pack .fl.frame1.scroll -side right -fill y listbox .fl.frame1.list -yscroll ".fl.frame1.scroll set" \ -relief raised \ -exportselection no pack .fl.frame1.list -side left -fill both -expand no # Create in frame2 an entry for selected filename and # buttons for OK and CANCEL label .fl.frame2.lbl -text "selected file:" entry .fl.frame2.inpt -relief sunken pack .fl.frame2.lbl .fl.frame2.inpt -anchor w button .fl.ok -text OK \ -width 15 \ -command "uam_edActSrcFileOK" frame .fl.default -relief sunken -bd 1 raise .fl.ok .fl.default button .fl.cancel -text CANCEL \ -width 15 \ -command "destroy .fl; focus .mbar" pack .fl.cancel -in .fl.frame2 -side bottom \ -pady 1 -ipadx 2m -ipady 1m pack .fl.default -in .fl.frame2 \ -side bottom \ -pady 4m pack .fl.ok -in .fl.default \ -padx 1m -pady 1m \ -ipadx 2m -ipady 1m # Set up bindings for the browser bindtags .fl.frame1.list {Listbox .fl.frame1.list} bind .fl.frame1.list { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } bind .fl.frame1.list { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt .fl.ok flash .fl.ok invoke} bind .fl.frame1.list {focus .fl.frame2.inpt} bind .fl.frame1.list { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } bind .fl.frame1.list { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } bind .fl.frame1.list { if {[set sel [.fl.frame1.list curselection]]!=""} { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } .fl.ok flash .fl.ok invoke} bind .fl.frame1.list {.fl.cancel flash .fl.cancel invoke} bind .fl.frame2.inpt {.fl.ok flash .fl.ok invoke} bind .fl.frame2.inpt {focus .fl.frame1.list} bind .fl.frame2.inpt {.fl.cancel flash .fl.cancel invoke} bind .fl.frame1.list {uam_initHelp editACShlp} bind .fl.frame1.list {uam_initHelp editACS.hlp} bind .fl.frame1.list {uam_exit} bind .fl.frame2.inpt {uam_initHelp editACS.hlp} bind .fl.frame2.inpt {uam_initHelp editACS.hlp} bind .fl.frame2.inpt {uam_exit} # fill the listbox with files with extension '.c' in directory 'sources': uam_fillLb .fl.frame1.list "$ideas_HomePath/sources/*.c" uam_selectLbEntry .fl.frame1.list 0 uam_insertLbSel .fl.frame1.list .fl.frame2.inpt update idletasks # place the window on its parent window: set dad [winfo parent .fl] set x [expr [winfo x $dad] + \ ([winfo reqwidth $dad] - [winfo reqwidth .fl])/2] set y [expr round([winfo y $dad] + [winfo reqheight $dad]*0.3)] wm geom .fl +$x+$y wm deiconify .fl focus .fl.frame2.inpt tkwait window .fl } # On OK do this: proc uam_edActSrcFileOK {} { global uam_EditProcs uam_Editor set file [.fl.frame2.inpt get] if {[lsearch [glob sources/*.c] sources/$file]>=0} { destroy .fl focus .mbar uam_startEditor sources/$file } else { uam_notExActSrc $file .fl.frame2.inpt delete 0 end } } ideas/uam_getActSrcFile.tcl100640 764 764 11636 6050144166 15230 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_getActSrcFile # # Gets the Action-C-Source file specification out of the ADL type file # of an agent. # Called when starting a new agent from 'uam_startAgent'. # # Arguments: # # agtType - name of type file (in directory 'desc') # # Results: # # Name of the Action-C-Source file for the new agent or an error # with error message if an ADL-error occurrs in type file. # proc uam_getActSrcFile {agtType} { # try to open 'agtType' for reading set fid [open desc/$agtType] # read file and split it in lines set file [split [read $fid] \n] close $fid set error 0 set actSrcFile "" # start parsing the type file for the Agent-C-Specification: # pop the first line from file and remove leading and # succeeding white spaces set line [string trim [lvarpop file]] while {1} { switch -regexp $line { ^$|^# {if {[llength $file] == 0} { return -code ok } set line [string trim [lvarpop file]] } ^load {set fileName [string trim [csubstr $line 4 end]] if {[catch {set fid [open desc/$fileName]} errorMesg]} { uam_logText "Error when loading '$fileName': $errorMesg" return } uam_logText "Loaded: $fileName\n" set data [split [read $fid] \n] close $fid set file [concat $data $file] set line [string trim [lvarpop file]] } ^ACTION-C-SOURCE { set line [string trim [crange $line 15 end]] # initialize a counter for \{\}--brackets # set brackets 0 set chCt -1 while {$brackets == 0} { incr chCt set char [cindex $line $chCt] switch -glob -- $char { \{ {incr brackets 1} \} {incr brackets -1} "" { # if last character in line is "\" remove it before # appending the line to actSrcFile and poping next line # from file; # if {[cequal "\\" [cindex $line $chCt-1]]} { if {$chCt >= 2} { append actSrcFile [crange $line 0 $chCt-2] } append actSrcFile " " } if {[cequal $file ""]} {break} set line [string trim [lvarpop file]] set chCt -1 } default {return -code error "'\{' expected at '$line'."} } } if {$brackets == -1} { return -code error "'\{' expected at '$line'." } set line [string trimleft [csubstr $line 1 end]] set chCt -1 while {$brackets == 1} { incr chCt set char [cindex $line $chCt] switch -glob -- $char { \{ {incr brackets 1} \} {incr brackets -1} "" { # if last character in line is "\" remove it before # appending the line to actSrcFile and poping next line # from file; # if {[cequal "\\" [cindex $line $chCt-1]]} { if {$chCt >= 2} { append actSrcFile [crange $line 0 $chCt-2] } append actSrcFile " " } if {[cequal $file ""]} {break} set line [string trim [lvarpop file]] set chCt -1 } # {set line [string trim [lvarpop file]] set chCt -1} } } if {$chCt} { append actSrcFile [crange $line 0 $chCt-1] } if {$brackets} { return -code error "'\}' expected at '$line'." } break } default {break} } } # if no Action-C-Source is defined use the standard source: # if {$actSrcFile == ""} { set actSrcFile standard.c uam_logText "No ACTION-C-SOURCE definition found in '$agtType';\ using 'standard.c'\n" } return [string trimright $actSrcFile] } ideas/init.tcl100755 764 764 4264 6665014552 12647 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # This is the initialization file for IDEAS. # # You have to adapt the values of some variables to your # system specific values. # # insert here the path of the directory that include the # BinProlog startfile 'bp': # set ideas_PrologPath "/home/javier/COPOP/BinProlog3.45/bin" # insert here your favourite editor you wish to start when # editing specification files in IDEAS: # set ideas_Editor "emacs \ -fn -adobe-courier-bold-r-normal--14-100-100-100-m-90-iso8859-1" # insert here the path of Tcl help program 'tclhelp' # comming with the TclX-package: # set ideas_TclhelpPath "/usr/bin/tclhelp" # specify the number of keys maximum shown when specifying # a message in UAM using the 'Message To'-button: # (should be greater than 7) # set ideas_KeyNumber 10 # # following specifications for compilation of C-sources # # insert the name of your cc-compatible ANSI-C compiler here: # set ideas_Compiler "gcc" # insert extra options for compilation here (e. g. optimization): # set ideas_ExtraCompilerOptions "-O" # insert the path of the Tcl/Tk include files here: # set ideas_TclIncludes "/usr/include/tcl" # insert the path of the Tcl/Tk library files here: # set ideas_TclLibraries "/usr/lib" # insert the path of the X11 include files here: # set ideas_X11Includes "/usr/X11/include" # it follows the compiler libraries # set ideas_CompLibraries "-L/usr/lib -ltkx8.0.3 -ltclx8.0.3 -ltk8.0 -ltcl8.0 -lm -L/usr/X11/lib -lX11 -lbsd -ldl" # # # Do not forget to adapt the 'wishx'-path in the first line # of the file 'ideas' to your system ! # # ideas/uam_edScriptFile.tcl100640 764 764 10676 6052366507 15140 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_edScriptFile # # This script generates a file browser, which lists the files of # in the 'desc'-directory, allows user to choose one by typing, # selecting or double-clicking and opens editor to edit it. # # Arguments: None. # # Results: None. # proc uam_edScriptFile {} { global ideas_HomePath catch {destroy .fl} toplevel .fl wm title .fl "Select Scriptfile For Editing" wm iconname .fl "FileSelect" wm withdraw .fl # Create two frames for managing the main window frame .fl.frame1 -bd 7 frame .fl.frame2 -bd 7 pack .fl.frame1 .fl.frame2 -side left -fill y # Create a label in frame1 and a listbox with a scrollbar on the # right side label .fl.frame1.lbl -text "Scripts in 'desc'-Directory:" pack .fl.frame1.lbl -side top -anchor w scrollbar .fl.frame1.scroll -command ".fl.frame1.list yview" pack .fl.frame1.scroll -side right -fill y listbox .fl.frame1.list -yscroll ".fl.frame1.scroll set" \ -relief raised \ -exportselection no pack .fl.frame1.list -side left -fill both -expand yes # Create in frame2 an entry for selected filename and # buttons for OK and CANCEL label .fl.frame2.lbl -text "Selected Type:" entry .fl.frame2.inpt -relief sunken pack .fl.frame2.lbl .fl.frame2.inpt -anchor w button .fl.ok -text OK \ -width 15 \ -command "uam_edTypeFileOK" frame .fl.default -relief sunken -bd 1 raise .fl.ok .fl.default button .fl.cancel -text CANCEL \ -width 15 \ -command "destroy .fl; focus .mbar" pack .fl.cancel -in .fl.frame2 -side bottom \ -pady 1 -ipadx 2m -ipady 1m pack .fl.default -in .fl.frame2 \ -side bottom \ -pady 4m pack .fl.ok -in .fl.default \ -padx 1m -pady 1m \ -ipadx 2m -ipady 1m # Set up bindings for the browser bindtags .fl.frame1.list {Listbox .fl.frame1.list} bind .fl.frame1.list { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } bind .fl.frame1.list { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt .fl.ok flash .fl.ok invoke } bind .fl.frame1.list {focus .fl.frame2.inpt} bind .fl.frame1.list {uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } bind .fl.frame1.list {uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } bind .fl.frame1.list { if {[set sel [.fl.frame1.list curselection]]!=""} { uam_insertLbSel .fl.frame1.list .fl.frame2.inpt } .fl.ok flash .fl.ok invoke} bind .fl.frame1.list {.fl.cancel flash .fl.cancel invoke} bind .fl.frame2.inpt {.fl.ok flash .fl.ok invoke} bind .fl.frame2.inpt {focus .fl.frame1.list} bind .fl.frame2.inpt {.fl.cancel flash .fl.cancel invoke} bind .fl.frame1.list {uam_initHelp editScriptFile.hlp} bind .fl.frame1.list {uam_initHelp editScriptFile.hlp} bind .fl.frame1.list {uam_exit} bind .fl.frame2.inpt {uam_initHelp editScriptFile.hlp} bind .fl.frame2.inpt {uam_initHelp editScriptFile.hlp} bind .fl.frame2.inpt {uam_exit} # fill the listbox with the files in directory 'desc': # uam_fillLb .fl.frame1.list \ "$ideas_HomePath/desc/*.agt $ideas_HomePath/desc/*.desc" uam_selectLbEntry .fl.frame1.list 0 uam_insertLbSel .fl.frame1.list .fl.frame2.inpt update idletasks # place the window on its parent window: set dad [winfo parent .fl] set x [expr [winfo x $dad] + \ ([winfo reqwidth $dad] - [winfo reqwidth .fl])/2] set y [expr round([winfo y $dad] + [winfo reqheight $dad]*0.3)] wm geom .fl +$x+$y wm deiconify .fl focus .fl.frame2.inpt tkwait window .fl } # On OK do this: proc uam_edTypeFileOK {} { global uam_EditProcs uam_Editor set file [.fl.frame2.inpt get] if {[lsearch [glob desc/*.agt desc/*.desc] desc/$file]>=0} { destroy .fl focus .mbar uam_startEditor desc/$file } else { uam_notExType $file .fl.frame2.inpt delete 0 end } } ideas/progs120777 764 764 0 6664767465 20272 2/home/javier/COPOP/BinProlog3.45/srcustar javierjavierideas/uam_mesgRules.tcl100640 764 764 4227 6050144167 14476 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # These are the message rules of the UAM. # # The message-rules are stored in global array 'uam_MesgRules' # and this piece of Tcl-Code is 'sourced' by 'ideas' # when initializing the IDEAS system. # set uam_MesgRules(1) [list {} \ {[.log.text index end] >= 500} \ {.log.text configure -state normal .log.text delete 1.0 100.0 .log.text configure -state disabled } \ {} \ {}] set uam_MesgRules(2) [list {{:TYPE statusinfo} \ {:IDFK Idfk} \ {:SENDER Send} \ {:RECEIVER UAM}} \ 1 \ {uam_registerAgt $fid $Idfk} \ {} \ {uam_break}] set uam_MesgRules(3) [list {{:TYPE asl-error} \ {:SENDER Send} \ {:RECEIVER UAM}} \ 1 \ {uam_handleASLError $fid $Send} \ {} \ {uam_break}] set uam_MesgRules(4) [list {{:TYPE prolog-error} \ {:SENDER Send} \ {:RECEIVER UAM}} \ 1 \ {uam_handlePrologError $fid $Send} \ {} \ {uam_break}] ideas/uam_exit.tcl100640 764 764 3543 6050144166 13500 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_exit # # Procedure to exit the UAM and so all agents belonging to it. # # Arguments: # # askUser - if specified with 1 the user is asked for confirmation # (default 1) # # Results: none # proc uam_exit {{askUser 1}} { global agents uam_VarSubProcs uam_Shortcuts if {$askUser} { set no_exit [uam_dialog "Exit User Agent Manager" \ "Do you really want to exit\n\ the User Agent Manager ?" \ left question left 0 1 OK Cancel ] if {$no_exit} {return} } # send an exit mesg to all agents belonging to this UAM # for_array_keys agtName agents { if {![cequal $agtName UAM]} { fileevent [keylget agents($agtName) FID] readable "" keylset mesg :RECEIVER $agtName :TYPE command :COMMAND exit uam_sendMesg $mesg } } # save array uam_Shortcuts to file uam_shortcutsFile.tcl # set fid [open "uam_shortcutsFile.tcl" w] for_array_keys key uam_Shortcuts { puts $fid "set uam_Shortcuts($key) {$uam_Shortcuts($key)}" flush $fid } close $fid # close all open editors # foreach pid $uam_VarSubProcs { catch {exec kill -9 $pid} } set logFile [keylget agents(UAM) LOGFID] puts $logFile "Logfile closed at [fmtclock [getclock] "%a %b %d %Y, %T"]\n" exit } ideas/uam_handlePrologError.tcl100640 764 764 2776 6050144166 16166 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_handlePrologError # # When an agent cannot cretae a Prolog-process it sends an error message to # the UAM. The UAM catches the message by a message-rule, which # calls this procedure to show a warning to the user. # # Arguments: # # realFid - filedesc the mesg arrived on # agtName - sender of mesg # # Results: None. # proc uam_handlePrologError {realFid agtName} { global agents # check if the mesg really arrived on the file belonging to this agent # if {[catch {keylget agents($agtName) FID agtFid}]} { uam_logText "WARNING - received Prolog-Error-Message on foreign FID:\ $fid\nMessage ignored!\n" return } # show a mesg in a toplevel widget # BEEP uam_dialog "Prolog Error" "Prolog-Error\n\n received from \ agent\n\n $agtName\n\nSee agents logfile for details!" \ center error left 0 -1 OK } ideas/sources/ 40750 764 764 0 6675703471 12556 5ustar javierjavierideas/sources/test.c100640 764 764 3657 5760111754 14001 0ustar javierjavier /* * * test.c * * * * Simple ACTION-C-SOURCE which defines just one action in C. * * This action is named 'usr_test'. It gets a string as argument * * and writes it 5 times in the Logfile of the agent. * * */ #include /* * * command procedure 'usr_TestCmd': * * */ int usr_TestCmd(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int i; for (i = 1; i <= 5; i++) { /* Call Tcl-function 'Tcl_VarEval': * * concatenates the argument strings to one string; evals this * * string in the Tcl-interpreter; returns the result of the * * evaluation. */ if (Tcl_VarEval(interp, "agt_puts ", argv[1], (char *) NULL) != TCL_OK) { return TCL_ERROR; }; } return TCL_OK; } /* * * initialization procedure: * * calls Tcl-function 'Tcl_CreateCommand' to create the new com- * * mand 'usr_test', which is defined by the function 'usr_TestCmd' * * above. * * */ int Ideas_ActSrc_Init (Tcl_Interp *interp) { Tcl_CreateCommand(interp, "usr_test", usr_TestCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; } ideas/sources/standard.c100440 764 764 7422 5734303426 14612 0ustar javierjavier/* */ /* standard.c */ /* */ /* This is the standard dummy file for AGENT-C-SOURCEs, */ /* a user defined command package written in C */ /* for extending agents actions in IDEAS. */ /* */ /* It is read only, so save it under a new name ending with '.c' */ /* in directory 'actSrc' and use it to define a new action procedures */ /* */ /* Defining a new action written in C concludes two steps: */ /* */ /* 1. Define the C procedure for the new action, */ /* use the procedure head syntax shown below. */ /* You should use a specifier starting with 'usr_' follow by a capital */ /* letter and with suffix 'Cmd' to avoid name conflicts. */ /* */ /* 2. Register the new procedure just defined in the Tcl-interpreter */ /* by calling 'Tcl_CreateCommand' in the 'Ideas_ActSrc_Init'-procedure */ /* below with the specified syntax. */ /* For 'cmdName' you should use the same specifier as for the */ /* command procedure, but leaving the 'Cmd' at the end. */ /* */ #include /* --------------------------------------------------------------------------*/ /* */ /* Define here command procedures for extending agents commands. */ /* */ /* Syntax: int cmdProc(ClientData clientData, Tcl_interp *interp, */ /* int argc, char *argv[]); */ /* */ /* Example: int usr_TestCmd(ClientData clientData, Tcl_Interp *interp, */ /* int argc, char *argv[]) */ /* */ /* --------------------------------------------------------------------------*/ /* --------------------------------------------------------------------------*/ /* */ /* Initialization procedure for the package */ /* */ /* --------------------------------------------------------------------------*/ int Ideas_ActSrc_Init (Tcl_Interp *interp) { /* Call here Tcl_CreateCommand for each command procedures defined above */ /* to register it in the Tcl-interpreter. */ /* */ /* Syntax: Tcl_CreateCommand(interp, char *cmdName, TclCmdProc *cmdProc, */ /* ClientData clientData, Tcl_CmdDeleteProc *deleteProc); */ /* */ /* Example: Tcl_CreateCommand(interp, "usr_test", usr_TestCmd, */ /* (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); */ return TCL_OK; } ideas/sources/COPYRIGHT100440 764 764 1206 5765341115 14134 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # ideas/sources/standard100775 764 764 24531 6665020277 14430 0ustar javierjavierELF †44 (44€4€  ÔÔ€Ô€€€œœœœ˜œ˜ $üü˜ü˜ÀÀ/lib/ld-linux.so.2     ü˜ñÿ(´˜ñÿ>€…hD€ˆ1 J,†kSÌ…}\\†>s †‹‰Ü…E—<†¬|†à±L†Q¹¼…LØð‡ ë †p ü†ì…@ü…D"ˆ *¼™!3¼™=¼™!El†M ˆ&" RxˆñÿY¼™ñÿ`¼™ñÿlÀ™ñÿ__gmon_start__libtkx8.0.3.so_DYNAMIC_GLOBAL_OFFSET_TABLE__init_finiTkx_InitTkX_Mainatexitlibtclx8.0.3.soTclx_Initlibtk8.0.soTk_MainWindowTk_Initlibtcl8.0.soexitmatherrTcl_Initlibm.so.6libX11.so.6getpgrplibdl.so.2_startlibc.so.6__libc_init_first__getpgid__setpgidsetpgrp_environ__environenviron__xstatstat_etext_edata__bss_start_endø˜¼™À˜ĘȘ ̘ИÔ˜ ؘܘà˜ ä˜ è˜ì˜ð˜ ô˜U‰åSè[Ã+ƒ»Dtèî‰ö裋]ü‰ì]Ãÿ5¸˜ÿ%¼˜ÿ%À˜héàÿÿÿÿ%ĘhéÐÿÿÿÿ%ȘhéÀÿÿÿÿ%̘hé°ÿÿÿÿ%Иh é ÿÿÿÿ%Ô˜h(éÿÿÿÿ%ؘh0é€ÿÿÿÿ%ܘh8épÿÿÿÿ%à˜h@é`ÿÿÿÿ%ä˜hHéPÿÿÿÿ%è˜hPé@ÿÿÿÿ%ì˜hXé0ÿÿÿÿ%ð˜h`é ÿÿÿÿ%ô˜hhéÿÿÿ1í…ÒtRè°ÿÿÿXèjÿÿÿ^D´£¼™‰âƒäøPPRVè¶þÿÿh€ˆèˆÿÿÿXèBPèœÿÿÿôU‰åS»°˜ƒ=°˜t‰ö‹ÿЃÃƒ;uô‹]üÉÃvU‰åÉÃU‰å1ÀÉÃU‰åh<‡‹E P‹EPè›þÿÿƒÄ 1ÀëÉÉöU‰åƒì‹EPè‘þÿÿƒÄ‰À‰Eü‹EPè`þÿÿƒÄ‰Àƒøu ¸ë{v‹EPèÃþÿÿƒÄ‰Àƒøu ¸ë^‰ö‹EPèwþÿÿƒÄ‰Àƒøu ¸ëB‰öƒ}üt‹EPèuþÿÿƒÄ‰Àƒøu¸ë ‹EPèCÿÿÿƒÄ‰Àƒøu ¸ë‰ö1ÀëÉÃU‰å‹EPèðýÿÿ‰ì]ÃU‰å‹U‹E PRèìýÿÿ‰ì]ÃU‰åSè[Ë‹U‹E PRjè-þÿÿ‹]ü‰ì]ÃU‰åS»¤˜ƒ=¤˜ÿt‰ö‹ÿЃÃüƒ;ÿuô‹]üÉÃvU‰åÉÃU‰åSè[Ã+èOþÿÿ‹]ü‰ì]ÃL†ÿÿÿÿÿÿÿÿü˜Â…Ò…â…ò…††"†2†B†R†b†r†‚†’†c}ŸÂÌàò €… €ˆè€Œƒ¬ q ´˜p……¶Â dð‡dð‡1<@€b€t€›€´€Ò€€Z€x€š€·€Ó€å€ø€€>€Y€u€—€£€â€)€c€”€Æ€ €8€b€n€š€§€²€¾€Ì€Ø€*é€,ô€-ÿ€. €/€0!€1.€29€3E€4P€5]€:†€=“€>¡€?­€@º€BÇ€EÔ€T€W€Y€!*€"5€#>€$H€%R€&^€'i€*r€+{€,„€-Ž€.™€/¢€0¬€1µ€2¾€5É€:Ô€;à€?é€Nó€¦ý€J€K€L€g#€h0€i;€jH€kS€l`€mk€nx€p†€µ€-À€0Ë$ð‡Ö ÝDÝDÝD Þ@å$#ˆÖ "ð " ÝD#ÝD$ ÝD%Þ@"ø@"Ýdˆd ˆ"d ˆ1<@€b€t€›€´€Ò€€Z€x€š€·€Ó€å€ø€€>€Y€u€—€£€â€)€c€”€Æ€ €8€b€n€š€§€²€¾€Ì€Ø€*é€,ô€-ÿ€. €/€0!€1.€29€3E€4P€5]€:†€=“€>¡€?­€@º€BÇ€EÔ€T€W€Y)€T€ˆ€»€ò€, €e €  $) ˆª  (¶  ( ÝD)ÝD*ÝD+ÝdFˆbsd-compat.c/usr/src/bs/BUILD/glibc-2.0.7/misc/gcc2_compiled.int:t1=r1;-2147483648;2147483647;char:t2=r2;0;127;long int:t3=r1;-2147483648;2147483647;unsigned int:t4=r1;0;-1;long unsigned int:t5=r1;0;-1;long long int:t6=r1;01000000000000000000000;0777777777777777777777;long long unsigned int:t7=r1;0000000000000;01777777777777777777777;short int:t8=r1;-32768;32767;short unsigned int:t9=r1;0;65535;signed char:t10=r1;-128;127;unsigned char:t11=r1;0;255;float:t12=r1;4;0;double:t13=r1;8;0;long double:t14=r1;12;0;complex int:t15=s8real:1,0,32;imag:1,32,32;;complex float:t16=r16;4;0;complex double:t17=r17;8;0;complex long double:t18=r18;12;0;void:t19=19lconv:T20=s48decimal_point:21=*2,0,32;thousands_sep:21,32,32;\grouping:21,64,32;int_curr_symbol:21,96,32;currency_symbol:21,128,32;\mon_decimal_point:21,160,32;mon_thousands_sep:21,192,32;\mon_grouping:21,224,32;positive_sign:21,256,32;\negative_sign:21,288,32;int_frac_digits:2,320,8;\frac_digits:2,328,8;p_cs_precedes:2,336,8;p_sep_by_space:2,344,8;\n_cs_precedes:2,352,8;n_sep_by_space:2,360,8;\p_sign_posn:2,368,8;n_sign_posn:2,376,8;;locale_t:t22=ar1;0;5;23=*24=xslocale_data:__u_char:t11__u_short:t9__u_int:t4__u_long:t5__u_quad_t:t7__quad_t:t6__qaddr_t:t25=*6__dev_t:t7__uid_t:t4__gid_t:t4__ino_t:t5__mode_t:t4__nlink_t:t4__off_t:t3__loff_t:t6__pid_t:t1__ssize_t:t1__fsid_t:t26=s8__val:27=ar1;0;1;1,0,64;;__daddr_t:t1__caddr_t:t21__time_t:t3__swblk_t:t3__clock_t:t3__fd_mask:t5__fd_set:t28=s128fds_bits:29=ar1;0;31;5,0,1024;;__key_t:t1__ipc_pid_t:t9u_char:t11u_short:t9u_int:t4u_long:t5quad_t:t6u_quad_t:t7fsid_t:t26dev_t:t7gid_t:t4ino_t:t5mode_t:t4nlink_t:t4off_t:t3loff_t:t6pid_t:t1uid_t:t4ssize_t:t1daddr_t:t1caddr_t:t21key_t:t1time_t:t3size_t:t4ulong:t5ushort:t9uint:t4int8_t:t10u_int8_t:t11int16_t:t8u_int16_t:t9int32_t:t1u_int32_t:t4int64_t:t6u_int64_t:t7register_t:t1timespec:T30=s8tv_sec:3,0,32;tv_nsec:3,32,32;;fd_mask:t5fd_set:t28getpgrp:F1pid:p1pid:r1setpgrp:F1pgrp:p1pgrp:r1/usr/src/bs/BUILD/glibc-2.0.7/io/stat.cstat:T30=s88st_dev:7,0,64;__pad1:9,64,16;\st_ino:5,96,32;st_mode:4,128,32;st_nlink:4,160,32;\st_uid:4,192,32;st_gid:4,224,32;st_rdev:7,256,64;\__pad2:9,320,16;st_size:3,352,32;st_blksize:5,384,32;\st_blocks:5,416,32;st_atime:3,448,32;__unused1:5,480,32;\st_mtime:3,512,32;__unused2:5,544,32;st_ctime:3,576,32;\__unused3:5,608,32;__unused4:5,640,32;__unused5:5,672,32;;__stat:F1file:p31=*2buf:p32=*30GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.301.0101.0101.0101.0101.0101.0101.0101.01.symtab.strtab.shstrtab.interp.hash.dynsym.dynstr.rel.got.rel.bss.rel.plt.init.plt.text.fini.data.ctors.dtors.got.dynamic.bss.stab.stabstr.comment.noteÔ€Ô#è€èÄ) ¬¬à1ŒƒŒq9 …B …K …p T€…€,Z¬…¬ð_ † Øe€ˆ€kœ˜œq¤˜¤x¬˜¬´˜´H„ü˜üÀ¼™¼ ’¼ ” ˜P ¡ ª ² R°ì!@1 ,'-Ԁ耬Œƒ………€…¬…  † €ˆ œ˜ ¤˜ ¬˜´˜ü˜¼™ ñÿ ä† ñÿ Hˆ &Hˆ <¨˜ Ipˆ T¤˜ b°˜ñÿ xˆ ñÿ ä† oä† …¬˜“ ‡ T ˜ ž¤˜ ¬ñÿ ‡ ·ñÿ ‡ ÂñÿÏñÿÖü˜ñÿßxˆñÿæ¼…Lï ˆ& ö ˜ ¼™!Ì…}¼™"Ü…E0ì…@:€…h@ð‡ Hü…DR †‹\ †p c†u,†k~ˆ †¼™ñÿ’‡ —<†ŸL†Q§<‡® ³œ˜ ¾€ˆ1 Ä\†>ˇ Ý ˆ&" â¼™ñÿél†ñ´˜ñÿÀ™ñÿ |†àœ˜  initfini.cgcc2_compiled.crtstuff.c__do_global_ctors_aux__CTOR_END__init_dummyforce_to_data__DTOR_END____do_global_dtors_aux__DTOR_LIST__fini_dummy__CTOR_LIST__standard.cagt_wish.cbsd-compat.cstat.c_DYNAMIC_etextTcl_Init__stattclDummyMathPtr_environTkX_Main__environTk_MainWindow__getpgid_initgetpgrp__setpgidTclx_Init_start__libc_init_firstTkx_Initsetpgrp__bss_startmainTk_InitmatherrTcl_AppInitdata_start_finiatexitIdeas_ActSrc_Initstat_edata__xstat_GLOBAL_OFFSET_TABLE__endexit__data_start__gmon_start__ideas/sources/coala_sixbus_bsca.h100664 764 764 273 6675456507 16466 0ustar javierjavier/* ===== global defines */ /* ===== number of agents */ #define N 6 /* ===== min/max size of coalitions */ #define csizemin 1 #define csizemax 6 #define VALUE_C_FILE "coala_sixbus_v_c.c" ideas/sources/coala_sixbus_v_c.c100664 764 764 1335 6675703446 16335 0ustar javierjavierFloat v(bit* coal) { long i, index; long ex; static Float v_array [] = {0.0, 0, -90, -100000, 0, -100000, -100000, -100000, -60, -100000, -100000, -100000, -100000, -100000, -100000, -100000, -40, -100000, -100000, -100000, -40, -20, -100000, -100000, -100000, -100000, -100000, -100000, -100000, -100000, -100000, -100000, -60, -100000, -90, -60, -100000, -100000, -60, -30, -60, -60, -150, -120, -100000, -100000, -120, -90, -183, -183, -334, -273, -101, -100000, -100, -80, -304, -243, -100000, -272, -161, -100000, -160, -130, 0.0 }; /* dummy */ ex = 1; index = 0; for (i=0; i < N; i++) { if (ba_value(coal, i)) index=index+ex; ex *= 2; } return (v_array[index]); } ideas/sources/bitarr.c100644 764 764 60610 6664735677 14345 0ustar javierjavier /* bitarr.c */ /************************************************************************** Bit Vectors in C FILENAME: bitarr.c LANGUAGE: ANSI C REQUIRES: "types.h" (see below for minimal contents) AUTHOR: James Blustein CREATED: 22 March 1995 MODIFIED: 20 July 1996 (see http://www.csd.uwo.ca/~jamie/BitVectors/changes.html for a record of changes). 21 January 1997 ba_equal(..) added by Torsten Vielhak IMPORTANT NOTE: A version of this code appeared in Dr. Dobb's Journal issue #233 (August 1995) Volume 20 Issue 8 in an article entitled `Implementing Bit Vectors in C' by James Blustein Pages 42, 44, 46 (article) and pages 96, 98-100 (code) The code is (c) copyright 1995 by Miller Freeman, Inc. DESCRIPTION: Functions to create and manipulate arrays of bits, i.e. `bit vectors'. Functions to: dynamically create arrays, access (read and write) elements; convert from numbers to bit vectors and bit vectors to strings. Additional mathematical functions (union, intersection, complement, number of set bits) are provided that are more efficient than naive implementations. The module was designed to be robust enough to work with machines of different word sizes. Only a couple of minor changes are required to change it from using unsigned char for `bits' to another integer type. See ba_init() and the definition of BITS_SZ for details. Only minimal optimization has been attempted. It is the caller's responsibility to know the size of the bit vector. One way to keep track of the size is to wrap the bit vector in a data structure like the one below. Note that the // is used to mark a single line comment. Only the first two items are necessary -- the others are included for illustration only. typedef struct { elem_t size; // how many items in selected bits * selected; // bit vector recording which // elements are selected elem_t max; // maximum possible size char ** name; // array of names of items elem_t max_len; // maximum possible length of a name char * title; // what data is represented // by this struct? } chose_t; TYPEDEF NAMES "types.h" must include definitions of the following 4 types bool = a Boolean type (0 == FALSE, !0 == TRUE) string = char * elem_t = a number (used as a count, i.e. never < 0, throughout). bit = an unsigned integer + If this is not unsigned char then the #define of BITS_SZ as CHAR_BIT should be changed. + If this is not internally represented by 8 bits then the lookup table in ba_count() must be replaced. + SEE NOTE dated 13 August 1996 in changes.html for a better solution. ***************************************************************************/ #include #include #include #include "types.h" #include "bitarr.h" /* exported prototypes */ #ifdef NEED_FPUTS_PROTO int fputs(char *s, FILE *stream); #endif typedef struct {elem_t size; bit *vector;} BitVector; static void first_is_biggest(BitVector bv[2], unsigned *, unsigned *); /* *\ ---------------------------------------------------------------- Macros ---------------------------------------------------------------- \* */ /* macro NELEM() The number of elements, nelem, in an array of N bits can be computed using the formula: if (0 == (N % BITS_SZ)) nelem = N/BITS_SZ else nelem = N/BITS_SZ + 1 This can be represented in any of these ways: nelem = N/(BITS_SZ) + 1 - (0 == (N %(BITS_SZ))) nelem = N/(BITS_SZ) + !(0 == (N %(BITS_SZ))) nelem = N/(BITS_SZ) + (0 != (N %(BITS_SZ))) The macro NELEM used this last form until Frans F.J. Faase suggested the form below (see changes.html). */ #define NELEM(N,ELEMPER) ((N + (ELEMPER) - 1) / (ELEMPER)) /* macro CANONIZE() Array is an array of `NumInts' type `bit' representing `NumElem' bits Forces `Array' into canonical form, i.e. all unused bits are set to 0 */ #define CANONIZE(Array,NumInts,NumElem) \ (Array)[NumInts - 1] &= (bit)~0 >> (BITS_SZ - ((NumElem % BITS_SZ) \ ? (NumElem % BITS_SZ) \ : BITS_SZ)); /* BITS_SZ BITS_SZ is the number of bits in a single `bits' type. */ /* Definition of BITS_SZ */ #ifdef CHAR_BIT /* assumes typedef unsigned char bits */ #define BITS_SZ (CHAR_BIT) /** SEE 13 August 1996 note in changes.html for suggested improvement **/ #else static elem_t bits_size(void); elem_t BITS_SZ = 0; /* until it is initialized by ba_init() */ static elem_t bits_size(void) { /* Adapted from the wordlength() function on page 54 (Exercise 2-8) of _The C Answer Book_ (2nd ed.) by Clovis L. Tondo and Scott E. Gimpel. Prentice-Hall, Inc., 1989. */ elem_t i; bit v = (bit)~0; for (i=1; (v = v >> 1) > 0; i++) ; /* EMPTY */ return (i); } #endif /* *\ ---------------------------------------------------------------- Initialization and Creation Code ---------------------------------------------------------------- \* */ elem_t ba_init(void) { /* ba_init() PRE: Must be called before use of any other ba_ functions. Should only be called once. POST: Returns the number of values that can be stored in one variable of type `bit'. If does not define `CHAR_BIT' then the module global variable `BITS_SZ' has been set to the appropriate value. */ #ifndef BITS_SZ if (!BITS_SZ) { BITS_SZ = bits_size(); } #endif return (BITS_SZ); } /* ba_init() */ bit *ba_new(const elem_t nelems) { /* ba_new() PURPOSE: dynamically allocate space for an array of `nelems' bits and initalize the bits to all be zero. PRE: nelems is the number of Boolean values required in an array POST: either a pointer to an initialized (all zero) array of bit OR space was not available and NULL was returned NOTE: calloc() guarantees that the space has been initialized to 0. Used by: ba_ul2b(), ba_intersection() and ba_union(). */ size_t howmany = NELEM(nelems,(BITS_SZ)); return ((bit *)calloc(howmany, sizeof(bit))); } /* ba_new() */ void ba_copy( bit dst[], const bit src[], const elem_t size) { /* ba_copy() PRE: `dst' has been initialized to hold `size' elements. `src' is the array of bit to be copied to `dst'. POST: `dst' is identical to the first `size' bits of `src'. `src' is unchanged. Used by: ba_union() */ elem_t nelem = NELEM(size,(BITS_SZ)); register elem_t i; for (i=0; i < nelem; i++) { dst[i] = src[i]; } } /* ba_copy() */ /* *\ --------------------------------------------------------------- Assigning and Retrieving Values --------------------------------------------------------------- \* */ void ba_assign( bit arr[], elem_t elem, const bool value) { /* ba_assign() PURPOSE: set or clear the bit in position `elem' of the array `arr' PRE: arr[elem] is to be set (assigned to 1) if value is TRUE, otherwise it is to be cleared (assigned to 0). POST: PRE fulfilled. All other bits unchanged. SEE ALSO: ba_all_assign() Used by: ba_ul2b() */ if (value) { arr[elem / BITS_SZ] |= (1 << (elem % BITS_SZ)); } else { arr[elem / BITS_SZ] &= ~(1 << (elem % BITS_SZ)); } } /* ba_assign() */ bool ba_value(const bit arr[], const elem_t elem) { /* ba_value() PRE: arr must have at least elem elements POST: The value of the `elem'th element of arr has been returned (as though `arr' was just a 1-dimensional array of bit) Used by: ba_b2str() and ba_count() */ return( (arr[elem / BITS_SZ] & (1 << (elem % BITS_SZ))) ?TRUE :FALSE ); } /* ba_value() */ void ba_toggle( bit arr[], const elem_t elem) { /* ba_toggle() PRE: arr must have at least elem elements POST: The value of the `elem'th element of arr has been flipped, i.e. if it was 1 it is 0; if it was 0 it is 1. SEE ALSO: ba_complement() */ arr[elem / BITS_SZ] ^= (1 << (elem % BITS_SZ)); } /* ba_toggle() */ void ba_all_assign( bit arr[], const elem_t size, const bool value) { /* ba_all_assign() PRE: arr has been initialized to have *exactly* size elements. POST: All `size' elements of arr have been set to `value'. The array is in canonical form, i.e. trailing elements are all 0. NOTE: The array allocated by ba_new() has all elements 0 and is therefore in canonical form. SEE ALSO: ba_assign() Used by: ba_ul2b() */ elem_t nelem = NELEM(size,(BITS_SZ)); bit setval = (value) ?~0 :0; register elem_t i; for (i=0; i < nelem; i++) { arr[i] = setval; } /* force canonical form */ CANONIZE(arr,nelem,size); } /* ba_all_assign() */ /* *\ ---------------------------------------------------------------- Conversion Routines ---------------------------------------------------------------- \* */ bit * ba_ul2b(unsigned long num, bit * arr, elem_t * size) { /* ba_ul2b() PRE: Either `arr' points to space allocated to hold enough `bit's to represent `num' (namely the ceiling of the base 2 logarithm of `num'). `size' points to the number of bit to use. OR `arr' is NULL and the caller is requesting that enough space be allocated to hold the representation before the translation is made. `size' points to space allocated to hold the count of the number of bit needed for the conversion (enough for MAXLONG). POST: A pointer to a right-aligned array of bits representing the unsigned value num has been returned and `size' points to the number of `bit's needed to hold the value. OR the request to allocate space for such an array could not be granted NOTES: - The first argument is unsigned. - It is bad to pass a `size' that is too small to hold the bit array representation of `num' [K&R II, p.100]. - Should the `size' be the maximum size (if size > 0) even if more bits are needed? The user can always use a filter composed of all 1s (see ba_all_assign()) intersected with result (see ba_intersection()). */ register elem_t i; if (NULL != arr) { ba_all_assign(arr, *size, 0); } else { *size = NELEM(sizeof(num),sizeof(bit)); *size *= BITS_SZ; if (NULL == (arr = ba_new(*size))) { return (arr); } } /* usual base conversion algorithm */ for (i=0; num; num >>= 1, i++) { ba_assign(arr, (*size - i - 1), (1 == (num & 01))); } return (arr); } /* ba_ul2b() */ char * ba_b2str(const bit arr[], const elem_t size, char * dest) { /* ba_b2str() PRE: `arr' is a bit array with at least `size' elements. Either `dest' points to enough allocated space to hold `size' + 1 characters or `dest' is NULL and such space is to be dynamically allocated. POST: Either `dest' points to a null-terminated string that contains a character representation of the first `size' elements of the bit array `arr'; OR `dest' is NULL and a request to dynamically allocate memory for a string to hold a character representation of `arr' was not be granted. Used by: ba_print() */ register elem_t i; if ((NULL != dest) || \ (NULL != (dest = (char *)malloc(size + 1)))) { for (i=0; i < size; i++) { dest[i] = (ba_value(arr,i) ?'1' :'0'); } dest[size] = '\0'; } return (dest); } /* ba_b2str() */ /* *\ ---------------------------------------------------------------- Mathematical Applications ---------------------------------------------------------------- \* */ unsigned long ba_count(const bit arr[], const elem_t size) { /* ba_count() PRE: `arr' is an allocated bit array with at least `size' elements POST: The number of 1 bits in the first `size' elements of `arr' have been returned. NOTE: if arr is not in canonical form, i.e. if some unused bits are 1, then an unexpected value may be returned. */ register unsigned long count; register elem_t i; elem_t nelem = NELEM(size,(BITS_SZ)); static const unsigned bitcount[256] = {0, 1, 1, 2, 1, 2, 2, 3, 1, \ 2, 2, 3, 2, 3, 3, 4, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, \ 4, 4, 5, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, \ 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 1, 2, 2, 3, 2, \ 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, \ 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, \ 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 1, \ 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, \ 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, \ 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, \ 6, 6, 7, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, \ 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 3, 4, 4, 5, 4, \ 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, \ 6, 6, 7, 6, 7, 7, 8}; if (bitcount[(sizeof bitcount / sizeof bitcount[0]) - 1] == BITS_SZ) { /* lookup table will speed this up a lot */ for (count = 0L, i = 0; i < nelem; i++) { count += bitcount[arr[i]]; } } else { for (count = 0L, i = 0; i < size; i++) { if (ba_value(arr, i)) { count++; } } } return (count); } /* ba_count() */ bool ba_intersection( bit first[], bit second[], bit * result[], const elem_t size_first, const elem_t size_second) { /* ba_intersection() PRE: `first' is a bit array of at least `size_first' elements. `second' is a bit array of at least `size_second' elements. `result' points to enough space to hold the as many elements as the smallest of `size_first' and `size_second'; OR `result' points to NULL and such space is to be dynamically allocated. POST: TRUE has been returned and `result' points to a bit array containing the intersection of the two arrays up to the smallest of the two sizes; OR FALSE has been returned and `result' pointed to NULL (a request was made to allocate enough memory to store the intersection) but the required memory could not be obtained. NOTE: This runs faster if the `first' array is not smaller than `second'. */ register elem_t i; elem_t numints; unsigned largest=0, smallest=1; BitVector bv[2]; bv[largest].size = size_first; bv[largest].vector = first; bv[smallest].size = size_second; bv[smallest].vector = second; first_is_biggest(bv, &largest, &smallest); /* allocate space if *result is NULL */ if ((NULL == *result) && \ (NULL == (*result = ba_new(bv[largest].size)))) { return(FALSE); /* can't get memory, so can't continue */ } else { numints = NELEM(size_second,(BITS_SZ)); for (i=0; i < numints; i++) { (*result)[i] = (bv[smallest].vector[i] & \ bv[largest].vector[i]); } /* bits beyond size_second should be zero -- canonical form */ CANONIZE(*result, numints, size_second); return(TRUE); } } /* ba_intersection() */ bool ba_union( bit first[], bit second[], bit * result[], const elem_t size_first, const elem_t size_second) { /* ba_union() PRE: `first' is a bit array of at least `size_first' elements. `second' is a bit array of at least `size_second' elements. `result' points to enough space to hold the as many elements as the largest of `size_first' and `size_second'; OR `result' points to NULL and such space is to be dynamically allocated. POST: TRUE has been returned and `result' points to a bit array containing the union of the two arrays (up to the size of the largest of the two sizes); OR FALSE has been returned and `result' pointed to NULL (a request was made to allocate enough memory to store the union) but the required memory could not be obtained. NOTE: This runs faster if the `first' array is not smaller than `second'. */ register elem_t i; elem_t numints; unsigned largest=0, smallest=1; BitVector bv[2]; bv[largest].size = size_first; bv[largest].vector = first; bv[smallest].size = size_second; bv[smallest].vector = second; first_is_biggest(bv, &largest, &smallest); if ((NULL == *result) && \ (NULL == (*result = ba_new(bv[largest].size)))) { return(FALSE); } else { ba_copy(*result, bv[largest].vector, bv[largest].size); numints = NELEM(bv[smallest].size,(BITS_SZ)); for (i=0; i < numints; i++) { (*result)[i] |= bv[smallest].vector[i]; } CANONIZE(*result, numints, bv[largest].size); return(TRUE); } } /* ba_union() */ bool ba_diff( bit first[], bit second[], bit * diff[], const elem_t size_first, const elem_t size_second) { /* ba_diff() PRE: `first' is a bit array of at least `size_first' elements. `second' is a bit array of at least `size_second' elements. `diff' points to enough space to hold the as many elements as the largest of `size_first' and `size_second'; OR `diff' points to NULL and such space is to be dynamically allocated. POST: TRUE has been returned and `diff' points to a bit array containing the union of the two arrays (up to the size of the largest of the two sizes); OR FALSE has been returned and `result' pointed to NULL (a request was made to allocate enough memory to store the result) but the required memory could not be obtained. NOTE: This runs faster if the `first' array is not smaller than `second'. */ register elem_t i; elem_t numints; unsigned largest=0, smallest=1; BitVector bv[2]; bv[largest].size = size_first; bv[largest].vector = first; bv[smallest].size = size_second; bv[smallest].vector = second; first_is_biggest(bv, &largest, &smallest); if ((NULL == *diff) && \ (NULL == (*diff = ba_new(bv[largest].size)))) { return(FALSE); } else { ba_copy(*diff, bv[largest].vector, bv[largest].size); numints = NELEM(bv[smallest].size,(BITS_SZ)); for (i=0; i < numints; i++) { (*diff)[i] ^= bv[smallest].vector[i]; } CANONIZE(*diff, numints, bv[largest].size); return(TRUE); } } /* ba_diff() */ bool ba_equal( bit first[], bit second[], const elem_t size_first, const elem_t size_second) { /* ba_equal() PRE: `first' is a bit array of at least `size_first' elements. `second' is a bit array of at least `size_second' elements. POST: TRUE has been returned if 'first' = 'second' OR FALSE has been returned otherwise NOTE: This runs faster if the `first' array is not smaller than `second'. */ register elem_t i; elem_t numints; BitVector bv[2]; if (size_first != size_second) { return(FALSE); } bv[0].size = size_first; bv[0].vector = first; bv[1].size = size_second; bv[1].vector = second; numints = NELEM(bv[1].size,(BITS_SZ)); for (i=0; i < numints; i++) { if (bv[0].vector[i] != bv[1].vector[i]) return(FALSE); } return(TRUE); } /* ba_equal() */ void ba_complement( bit arr[], const elem_t size) { /* ba_complement() PRE: `arr' is a bit array composed of *exactly* `size' elements. POST: All the bits in `arr' have been flipped and `arr' is in canonical form. SEE ALSO: ba_toggle() */ elem_t nelem = NELEM(size,(BITS_SZ)); register elem_t i; for (i=0; i < nelem; i++) { arr[i] = ~arr[i]; } /* force canonical form */ CANONIZE(arr, nelem, size); } /* ba_complement() */ unsigned long ba_dotprod(const bit first[], const bit second[], const elem_t size_first, const elem_t size_second) { /* ba_dotprod() PRE: `first' is an array of at least `size_first' bits. `second' is an array of at least `size_second' bits. POST: The scalar product of the two vectors represented by the first `size_first' elements of `first' and the first `size_second' elements of `second' have been returned. */ register elem_t i, j; register unsigned long sum = 0L; for (i=0; i < size_first; i++) { for (j=0; j < size_second; j++) { sum += (first[i/BITS_SZ] & (1<<(i % BITS_SZ))) \ && \ (second[j/BITS_SZ] & (1<<(j % BITS_SZ))); } } return (sum); } /* ba_dotprod() */ /* *\ ---------------------------------------------------------------- Internal Function ---------------------------------------------------------------- \* */ static void first_is_biggest(BitVector bv[2], unsigned * big, unsigned * small) { if (bv[*big].size < bv[*small].size) { unsigned temp; temp = *big; *big = *small; *small = temp; } } /* first_is_biggest() */ /* *\ ---------------------------------------------------------------- Miscellaneous ---------------------------------------------------------------- \* */ bool ba_print(const bit arr[], const elem_t size, FILE * dest) { char * to_print = ba_b2str(arr, size, NULL); if (NULL != to_print) { bool status = (EOF != fputs(to_print, dest) ); free(to_print); return (status); } else { return (FALSE); } } /* ba_print() */ ideas/sources/bitarr.h100644 764 764 3331 6664735677 14327 0ustar javierjavier#ifndef bitarr_h #define bitarr_h /* bitarr.h */ /* Prototypes for bitarr.c IMPORTANT NOTE: A version of this code appeared in Dr. Dobb's Journal issue #233 (August 1995) Volume 20 Issue 8 in an article entitled `Implementing Bit Vectors in C' by James Blustein Pages 42, 44, 46 (article) and pages 96, 98-100 (code) The code is (c) copyright 1995 by Miller Freeman, Inc. See "bitarr.c" for further details. */ elem_t ba_init(void); bit *ba_new(const elem_t nelems); void ba_copy(bit dst[], const bit src[], const elem_t size); void ba_assign(bit arr[], elem_t elem, const bool value); bool ba_value(const bit arr[], const elem_t elem); void ba_toggle(bit arr[], const elem_t elem); void ba_all_assign(bit arr[], const elem_t lsize, const bool value); bit *ba_ul2b(unsigned long num, bit *arr, elem_t *size); unsigned long ba_count(const bit arr[], const elem_t size); bool ba_intersection(bit first[], bit second[], \ bit * result[], const elem_t size_first, const elem_t size_second); bool ba_union(bit first[], bit second[], bit * result[], \ const elem_t size_first, const elem_t size_second); bool ba_diff(bit first[], bit second[], bit * result[], \ const elem_t size_first, const elem_t size_second); void ba_complement(bit arr[], const elem_t lsize); bool ba_equal(bit first[], bit second[], const elem_t size_first, \ const elem_t size_second); unsigned long ba_dotprod(const bit first[], const bit second[], \ const elem_t size_first, const elem_t size_second); char * ba_b2str(const bit arr[], const elem_t size, char * dest); bool ba_print(const bit arr[], const elem_t size, FILE * dest); #endif ideas/sources/coala_bsca.c100644 764 764 17727 6664735677 15144 0ustar javierjavier/*----------------------------------------------------------------------------- * Copyright (c) 1997/8 by Matthias Klusch, Torsten Vielhak * Computer Science Department, * Christian-Albrechts-University of Kiel, * Olshausenstr. 40, 24118 Kiel, Germany * * All rights reserved. * No warranties will be given on any issues arising out of the use * of this software product. * Permission to use, copy, modify and distribute this software * product for non-commercial purposes is hereby granted, provided * that the above copyright notice appears in all copies and * respective publications. * All commercial trades with this product outside the CAU Kiel * without specific written prior permission are prohibited. *----------------------------------------------------------------------------- */ /* ===== coala_bsca.c */ /* ===== This file is used by COALA to create IDEAS agents using the BSCA */ #include #include #include #include #include #include "types.h" #include "bitarr.h" INCLUDE bsca /* ===== Outputformat for float-value (printf) */ #define OUTPUT_FORMAT "%-.10lf" /* ===== round error */ #define arch_eps 0.0000001 /* ===== IR (eal) */ typedef double Float; #define MINFloat -MAXDOUBLE /* ===== coalition (subset of _A_) */ typedef bit* coalition; /* ===== coalition structure _C_ */ struct coalition_structure { /* ===== number of coaltions in coalition_structure */ int size; /* ===== array of coalitions */ coalition coal[N]; }; /* ===== payoff configuration */ struct payoff_configuration { /* ===== pointer to the coalition structure */ struct coalition_structure* coal_struct; /* ===== array of payoffs for each agent */ Float payoff[N]; }; /* ===== global variables */ /* ===== list of all agents */ char *agent_list; /* ===== number of coalitions */ int n_of_coals; /* ===== coalitions as bitvectors */ char *coal[N]; #include "bitarr.c" #include VALUE_C_FILE /* ===== coalition payoff function */ Float x(Float* xz_1, coalition coal) { Float result = 0.0; int i; for (i=0; iresult = "bsca_initialize: cannot get list 'all'"; return TCL_ERROR; } if ((value = Tcl_GetVar(interp, "coal_struct", 0)) == NULL) { interp->result = "bsca_initialize: cannot get list 'coal_struct'"; return TCL_ERROR; } if (Tcl_SplitList(interp, value, &n_of_coals, &coal_list) != TCL_OK) { interp->result = "bsca_initialize: cannot split 'coal_struct'"; return TCL_ERROR; } for (i=0; i < n_of_coals; i++) { coal[i] = ba_new(N); if (Tcl_SplitList(interp, coal_list[i], &n, &agents) != TCL_OK) { interp->result = "bsca_initialize: cannot split 'coal_list[i]'"; return TCL_ERROR; } for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "bsca_initialize: cannot find agent in all"; return TCL_ERROR; } index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "bsca_initialize: cannot find agent in all"; return TCL_ERROR; } ba_assign(coal[i], index, 1); } } interp->result = ""; free((char *) agents); return TCL_OK; } char *name_of_agent(Tcl_Interp *interp, int j, char *str) { char command[200]; sprintf(command, "lindex $all %d", j); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { return "name_of_agent: cannot find agent in all"; } strcpy(str, interp->result); return str; } int bsca_get_coals (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int i,j,k; char *(str_coals[N+1]); j = atoi(argv[1]); k=0; for (i=0; i < N; i++) { if (ba_value(coal[j], i)) { str_coals[k] = malloc (200); name_of_agent(interp, i, str_coals[k]); k++; } } str_coals[k] = 0; interp->result = Tcl_Merge(k, str_coals); return TCL_OK; } /* ===== gives value of a coalition */ int bsca_value (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { coalition coal; int n, index,j; char **agents; Float val; char command[200]; /* ===== initialize coalition */ coal = ba_new(N); /* ===== split coalition */ if (Tcl_SplitList(interp, argv[1], &n, &agents) != TCL_OK) { interp->result = "bsca_value: cannot split argument"; return TCL_ERROR; } /* ===== foreach agent in this coalition */ for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "bsca_value: cannot find agent in all"; return TCL_ERROR; } /* ===== get index in $all */ index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "bsca_value: cannot find agent in all"; return TCL_ERROR; } /* ===== mark position in bitvector */ ba_assign(coal, index, 1); } /* ===== get value of coalition */ val = v(coal); sprintf(interp->result, OUTPUT_FORMAT, val); /* ===== cleanup */ free((char*) agents); return TCL_OK; } /* ===== gives system time in ticks (ms) */ int bsca_times (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { struct tms buf; clock_t timer; timer = times(&buf); sprintf(interp->result, "%d", timer); return TCL_OK; } /* ===== executes argv[2] after argv[1] seconds */ /* ===== gives back the pid of the forked process (for */ /* ===== killing it) */ int bsca_timeout_cmd (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int seconds; int pid; if (Tcl_GetInt(interp, argv[1], &seconds) != TCL_OK) { return TCL_ERROR; } if ((pid = fork()) == 0) { sleep(seconds); Tcl_Eval(interp, argv[2]); exit(0); } sprintf(interp->result, "%d", pid); return TCL_OK; } /* --------------------------------------------------------------------------*/ /* */ /* Initialization procedure for the package */ /* */ /* --------------------------------------------------------------------------*/ int Ideas_ActSrc_Init (Tcl_Interp *interp) { char command[200]; /* Call here Tcl_CreateCommand for each command procedures defined above */ /* to register it in the Tcl-interpreter. */ Tcl_CreateCommand(interp, "bsca_initialize", bsca_initialize, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "bsca_get_coals", bsca_get_coals, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "bsca_value", bsca_value, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "bsca_times", bsca_times, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "bsca_timeout_cmd", bsca_timeout_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); sprintf(command,"global tcl_precision; set tcl_precision 14"); Tcl_VarEval(interp, command, (char *)NULL); return TCL_OK; } ideas/sources/coala_kca.c100644 764 764 43213 6664735677 14757 0ustar javierjavier/*----------------------------------------------------------------------------- * Copyright (c) 1997/8 by Matthias Klusch, Torsten Vielhak * Computer Science Department, * Christian-Albrechts-University of Kiel, * Olshausenstr. 40, 24118 Kiel, Germany * * All rights reserved. * No warranties will be given on any issues arising out of the use * of this software product. * Permission to use, copy, modify and distribute this software * product for non-commercial purposes is hereby granted, provided * that the above copyright notice appears in all copies and * respective publications. * All commercial trades with this product outside the CAU Kiel * without specific written prior permission are prohibited. *----------------------------------------------------------------------------- */ /* ===== coala_kca.c */ /* ===== This file is used by COALA to create IDEAS agents using the KCA*/ /* ===== Mainly the functions are used to calculate pKs solutions */ #include #include #include #include #include #include "types.h" #include "bitarr.h" INCLUDE kca /* #include "coala_kca.h" */ /* ===== Outputformat for float-value (printf) */ #define OUTPUT_FORMAT "%-.10lf" /* ===== round error */ #define arch_eps 0.0000001 /* ===== IR (eal) */ typedef double Float; #define MINFloat -MAXDOUBLE /* ===== coalition (subset of _A_) */ typedef bit* coalition; /* ===== coalition structure _C_ */ struct coalition_structure { /* ===== number of coaltions in coalition_structure */ int size; /* ===== array of coalitions */ coalition coal[N]; }; /* ===== payoff configuration */ struct payoff_configuration { /* ===== pointer to the coalition structure */ struct coalition_structure* coal_struct; /* ===== array of payoffs for each agent */ Float payoff[N]; }; /* ===== global variables */ /* ===== list of all agents */ char *agent_list; /* ===== number of coalitions */ int n_of_coals; /* ===== coalitions as bitvectors */ char *coal[N]; #include "bitarr.c" #include VALUE_C_FILE /* ===== coalition payoff function */ Float x(Float* xz_1, coalition coal) { Float result = 0.0; int i; for (i=0; icmax) \ || (ba_value(coal,ak)==FALSE) || (ba_value(coal,al)==TRUE) \ /* not needed: || coal_in_structure(coal, coal_struct) */ ); } /* ===== testing if payoff configuration is K-stable */ bool K_Condition (coalition coal, Float* surplus, Float* xz_1) { int ak,al; coalition single_al, single_ak; single_al = ba_new(N); single_ak = ba_new(N); for (ak=0; ak surplus[al*N+ak]) && (abs(xz_1[al]-v(single_al))coal_struct->coal; R = ba_new(N); single_al = ba_new(N); /* ===== line 1 */ z = 0; /* ===== line 2 */ xz = payoff->payoff; PCz = payoff; /* ===== line 3 */ eps = 0.01; /* ===== line 4 */ do { /* ===== FIXED !!! */ pKConfig = TRUE; KConfig = TRUE; /* ===== line 5 */ DemandSet = MINFloat; z = z+1; /* ===== save old payoffs in x(z-1) */ for (i=0; icoal_struct->size; C++) { /* ===== line 8 */ kEquilibrium[C] = TRUE; /* ===== line 9 */ for (ak=0; akcoal_struct); if (ba_count(R,N)>0) { for (; ba_count(R, N)>0; next_coal(R, cmin, cmax, ak, al, payoff->coal_struct)) { /* ===== line 15-20 */ if ((v(R)-x(xz_1, R)) > surplus[ak][al]) { surplus[ak][al] = v(R)-x(xz_1, R); } } } } } } } /* ===== line 21 */ if (!K_Condition(coals[C], (Float *)surplus, xz_1)) { kEquilibrium[C] = FALSE; } } /* ===== end for each C in _C_ (line 6) */ SurplusSet = MINFloat; /* ===== line 23 for each C in _C_ */ for (C=0; Ccoal_struct->size; C++) { /* ===== line 25 */ for (ai=0; aiSurplusSet) { SurplusSet = fabs(surplus[ai][aj]-surplus[aj][ai]); } } } /* ===== end for each aj in C */ } } /* ===== end for each ai in C */ /* ===== line 28 & 29 */ if (!kEquilibrium[C]) { KConfig = FALSE; break; /* ===== breaking for each C in _C_ */ } } /* ===== end for each C in _C_ */ ba_all_assign(R,N,1); /* ===== line 31 */ if ((!KConfig) && (fabs((SurplusSet/x(xz_1, R)))>eps)) { /* ===== line 32 */ pKConfig = FALSE; DemandSet = MINFloat; /* ===== line 33 for each C in _C_ */ for (C=0; Ccoal_struct->size; C++) { /* ===== line 34 */ /* ===== line 35 */ for (ak=0; ak surplus[al][ak]) { /* ===== line 38 */ if (((surplus[ak][al]-surplus[al][ak])/2)<(xz_1[al]-v(single_al)) || ((xz_1[al]-v(single_al)<0))) { demand[ak][al]=(surplus[ak][al]-surplus[al][ak])/2; } else { demand[ak][al]=(xz_1[al]-v(single_al)); } } else { /* ===== line 39 */ demand[ak][al] = 0; } /* ===== line 42 & 45 */ if (demand[ak][al] > DemandSet) { DemandSet = demand[ak][al]; ai=ak; aj=al; } } } } } } /* ===== end for each C in _C_ line 33 */ /* ===== line 46 */ sidepayment = DemandSet; for (ak=0; akresult = "kca_initialize: cannot get list 'all'"; return TCL_ERROR; } if ((value = Tcl_GetVar(interp, "coal_struct", 0)) == NULL) { interp->result = "kca_initialize: cannot get list 'coal_struct'"; return TCL_ERROR; } if (Tcl_SplitList(interp, value, &n_of_coals, &coal_list) != TCL_OK) { interp->result = "kca_initialize: cannot split 'coal_struct'"; return TCL_ERROR; } for (i=0; i < n_of_coals; i++) { coal[i] = ba_new(N); if (Tcl_SplitList(interp, coal_list[i], &n, &agents) != TCL_OK) { interp->result = "kca_initialize: cannot split 'coal_list[i]'"; return TCL_ERROR; } for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "kca_initialize: cannot find agent in all"; return TCL_ERROR; } index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "kca_initialize: cannot find agent in all"; return TCL_ERROR; } ba_assign(coal[i], index, 1); } } interp->result = ""; free((char *) agents); return TCL_OK; } char *name_of_agent(Tcl_Interp *interp, int j, char *str) { char command[200]; sprintf(command, "lindex $all %d", j); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { return "name_of_agent: cannot find agent in all"; } strcpy(str, interp->result); return str; } int kca_get_coals (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int i,j,k; char *(str_coals[N+1]); j = atoi(argv[1]); k=0; for (i=0; i < N; i++) { if (ba_value(coal[j], i)) { str_coals[k] = malloc (200); name_of_agent(interp, i, str_coals[k]); k++; } } str_coals[k] = 0; interp->result = Tcl_Merge(k, str_coals); return TCL_OK; } int kca_calculate_pc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { struct coalition_structure test; struct payoff_configuration payoff; char command[200]; char **coal_list, **agents; char **payoff_vector; int i,n,j; int index; /* ===== get first argument (coalitions) and split it */ if (Tcl_SplitList(interp, argv[1], &n_of_coals, &coal_list) != TCL_OK) { interp->result = "kca_calculate_pc: cannot split 'coal_struct'"; return TCL_ERROR; } /* ===== foreach coalition do */ for (i=0; i < n_of_coals; i++) { test.coal[i] = ba_new(N); /* ===== split coalition */ if (Tcl_SplitList(interp, coal_list[i], &n, &agents) != TCL_OK) { interp->result = "kca_calculate_pc: cannot split 'coal_list[i]'"; return TCL_ERROR; } /* ===== foreach agent in this coalition */ for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "kca_calculate_pc: cannot find agent in all"; return TCL_ERROR; } /* ===== get index in $all */ index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "kca_calculate_pc: cannot find agent in all"; return TCL_ERROR; } /* ===== mark position in bitvector */ ba_assign(test.coal[i], index, 1); } } /* ===== get second argument (payoff vector) and split it */ if (Tcl_SplitList(interp, argv[2], &n, &payoff_vector) != TCL_OK) { interp->result = "kca_calculate_pc: cannot split 'payoff vector'"; return TCL_ERROR; } /* ===== payoff_vector corrupt ? */ if (n!=N) { interp->result = "kca_calculate_pc: corrupt 'payoff vector'"; return TCL_ERROR; } /* ===== set size of the considered coalition */ test.size=n_of_coals; /* ===== build initial payoff configuration */ payoff.coal_struct = &test; for (i=0; i < N; i++) { payoff.payoff[i] = atof(payoff_vector[i]); } /* ===== calculate pK-stable payoff configuration */ Calc_pKs_PC(&payoff,csizemin,csizemax,interp); /* ===== free initial payoff_vector */ free((char *) payoff_vector); /* ===== make new payoff vector */ if ((payoff_vector = malloc((N+2)*sizeof(char*))) == NULL) { interp->result = "kca_calculate_pc: cannot allocate memory for 'payoff vector'"; return TCL_ERROR; } /* ===== fill the new vector with values */ for (i=0; i < N; i++) { if ((payoff_vector[i]=malloc(40)) == NULL) { interp->result = "kca_calculate_pc: cannot allocate memory for 'payoff vector component'"; return TCL_ERROR; } sprintf(payoff_vector[i], OUTPUT_FORMAT, payoff.payoff[i]); } /* ===== build result for Tcl/TK-Interpreter */ interp->result = Tcl_Merge(N, payoff_vector); interp->freeProc = (Tcl_FreeProc *) free; /* ===== cleanup */ free((char *) coal_list); free((char *) agents); return TCL_OK; } /* ===== gives value of a coalition */ int kca_value (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { coalition coal; int n, index,j; char **agents; Float val; char command[200]; /* ===== initialize coalition */ coal = ba_new(N); /* ===== split coalition */ if (Tcl_SplitList(interp, argv[1], &n, &agents) != TCL_OK) { interp->result = "kca_value: cannot split argument"; return TCL_ERROR; } /* ===== foreach agent in this coalition */ for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "kca_value: cannot find agent in all"; return TCL_ERROR; } /* ===== get index in $all */ index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "kca_value: cannot find agent in all"; return TCL_ERROR; } /* ===== mark position in bitvector */ ba_assign(coal, index, 1); } /* ===== get value of coalition */ val = v(coal); sprintf(interp->result, OUTPUT_FORMAT, val); /* ===== cleanup */ free((char*) agents); return TCL_OK; } /* ===== gives system time in ticks (ms) */ int kca_times (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { struct tms buf; clock_t timer; timer = times(&buf); sprintf(interp->result, "%d", timer); return TCL_OK; } /* ===== executes argv[2] after argv[1] seconds */ /* ===== gives back the pid of the forked process (for */ /* ===== killing it) */ int kca_timeout_cmd (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int seconds; int pid; if (Tcl_GetInt(interp, argv[1], &seconds) != TCL_OK) { return TCL_ERROR; } if ((pid = fork()) == 0) { sleep(seconds); Tcl_Eval(interp, argv[2]); exit(0); } sprintf(interp->result, "%d", pid); return TCL_OK; } /* --------------------------------------------------------------------------*/ /* */ /* Initialization procedure for the package */ /* */ /* --------------------------------------------------------------------------*/ int Ideas_ActSrc_Init (Tcl_Interp *interp) { char command[200]; /* Call here Tcl_CreateCommand for each command procedures defined above */ /* to register it in the Tcl-interpreter. */ Tcl_CreateCommand(interp, "kca_initialize", kca_initialize, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_get_coals", kca_get_coals, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_calculate_pc", kca_calculate_pc, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_value", kca_value, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_times", kca_times, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_timeout_cmd", kca_timeout_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); sprintf(command,"global tcl_precision; set tcl_precision 14"); Tcl_VarEval(interp, command, (char *)NULL); return TCL_OK; } ideas/sources/types.h100644 764 764 1302 6664735677 14204 0ustar javierjavier/* "types.h" */ #ifndef types_h #define types_h /* IMPORTANT NOTE: This is part of the code that appeared in Dr. Dobb's Journal issue #233 (August 1995) Volume 20 Issue 8 in an article entitled `Implementing Bit Vectors in C' by James Blustein Pages 42, 44, 46 (article) and pages 96, 98-100 (code) The code is (c) copyright 1995 by Miller Freeman, Inc. See "bitarr.c" for further details. */ #include typedef enum bool {FALSE, TRUE} bool; typedef size_t elem_t; typedef unsigned char bit; typedef char * string; #endif ideas/sources/coala_sixbus_bsca.c100664 764 764 17752 6675456507 16533 0ustar javierjavier/*----------------------------------------------------------------------------- * Copyright (c) 1997/8 by Matthias Klusch, Torsten Vielhak * Computer Science Department, * Christian-Albrechts-University of Kiel, * Olshausenstr. 40, 24118 Kiel, Germany * * All rights reserved. * No warranties will be given on any issues arising out of the use * of this software product. * Permission to use, copy, modify and distribute this software * product for non-commercial purposes is hereby granted, provided * that the above copyright notice appears in all copies and * respective publications. * All commercial trades with this product outside the CAU Kiel * without specific written prior permission are prohibited. *----------------------------------------------------------------------------- */ /* ===== coala_bsca.c */ /* ===== This file is used by COALA to create IDEAS agents using the BSCA */ #include #include #include #include #include #include "types.h" #include "bitarr.h" #include "coala_sixbus_bsca.h" /* ===== Outputformat for float-value (printf) */ #define OUTPUT_FORMAT "%-.10lf" /* ===== round error */ #define arch_eps 0.0000001 /* ===== IR (eal) */ typedef double Float; #define MINFloat -MAXDOUBLE /* ===== coalition (subset of _A_) */ typedef bit* coalition; /* ===== coalition structure _C_ */ struct coalition_structure { /* ===== number of coaltions in coalition_structure */ int size; /* ===== array of coalitions */ coalition coal[N]; }; /* ===== payoff configuration */ struct payoff_configuration { /* ===== pointer to the coalition structure */ struct coalition_structure* coal_struct; /* ===== array of payoffs for each agent */ Float payoff[N]; }; /* ===== global variables */ /* ===== list of all agents */ char *agent_list; /* ===== number of coalitions */ int n_of_coals; /* ===== coalitions as bitvectors */ char *coal[N]; #include "bitarr.c" #include VALUE_C_FILE /* ===== coalition payoff function */ Float x(Float* xz_1, coalition coal) { Float result = 0.0; int i; for (i=0; iresult = "bsca_initialize: cannot get list 'all'"; return TCL_ERROR; } if ((value = Tcl_GetVar(interp, "coal_struct", 0)) == NULL) { interp->result = "bsca_initialize: cannot get list 'coal_struct'"; return TCL_ERROR; } if (Tcl_SplitList(interp, value, &n_of_coals, &coal_list) != TCL_OK) { interp->result = "bsca_initialize: cannot split 'coal_struct'"; return TCL_ERROR; } for (i=0; i < n_of_coals; i++) { coal[i] = ba_new(N); if (Tcl_SplitList(interp, coal_list[i], &n, &agents) != TCL_OK) { interp->result = "bsca_initialize: cannot split 'coal_list[i]'"; return TCL_ERROR; } for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "bsca_initialize: cannot find agent in all"; return TCL_ERROR; } index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "bsca_initialize: cannot find agent in all"; return TCL_ERROR; } ba_assign(coal[i], index, 1); } } interp->result = ""; free((char *) agents); return TCL_OK; } char *name_of_agent(Tcl_Interp *interp, int j, char *str) { char command[200]; sprintf(command, "lindex $all %d", j); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { return "name_of_agent: cannot find agent in all"; } strcpy(str, interp->result); return str; } int bsca_get_coals (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int i,j,k; char *(str_coals[N+1]); j = atoi(argv[1]); k=0; for (i=0; i < N; i++) { if (ba_value(coal[j], i)) { str_coals[k] = malloc (200); name_of_agent(interp, i, str_coals[k]); k++; } } str_coals[k] = 0; interp->result = Tcl_Merge(k, str_coals); return TCL_OK; } /* ===== gives value of a coalition */ int bsca_value (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { coalition coal; int n, index,j; char **agents; Float val; char command[200]; /* ===== initialize coalition */ coal = ba_new(N); /* ===== split coalition */ if (Tcl_SplitList(interp, argv[1], &n, &agents) != TCL_OK) { interp->result = "bsca_value: cannot split argument"; return TCL_ERROR; } /* ===== foreach agent in this coalition */ for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "bsca_value: cannot find agent in all"; return TCL_ERROR; } /* ===== get index in $all */ index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "bsca_value: cannot find agent in all"; return TCL_ERROR; } /* ===== mark position in bitvector */ ba_assign(coal, index, 1); } /* ===== get value of coalition */ val = v(coal); sprintf(interp->result, OUTPUT_FORMAT, val); /* ===== cleanup */ free((char*) agents); return TCL_OK; } /* ===== gives system time in ticks (ms) */ int bsca_times (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { struct tms buf; clock_t timer; timer = times(&buf); sprintf(interp->result, "%d", timer); return TCL_OK; } /* ===== executes argv[2] after argv[1] seconds */ /* ===== gives back the pid of the forked process (for */ /* ===== killing it) */ int bsca_timeout_cmd (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int seconds; int pid; if (Tcl_GetInt(interp, argv[1], &seconds) != TCL_OK) { return TCL_ERROR; } if ((pid = fork()) == 0) { sleep(seconds); Tcl_Eval(interp, argv[2]); exit(0); } sprintf(interp->result, "%d", pid); return TCL_OK; } /* --------------------------------------------------------------------------*/ /* */ /* Initialization procedure for the package */ /* */ /* --------------------------------------------------------------------------*/ int Ideas_ActSrc_Init (Tcl_Interp *interp) { char command[200]; /* Call here Tcl_CreateCommand for each command procedures defined above */ /* to register it in the Tcl-interpreter. */ Tcl_CreateCommand(interp, "bsca_initialize", bsca_initialize, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "bsca_get_coals", bsca_get_coals, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "bsca_value", bsca_value, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "bsca_times", bsca_times, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "bsca_timeout_cmd", bsca_timeout_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); sprintf(command,"global tcl_precision; set tcl_precision 14"); Tcl_VarEval(interp, command, (char *)NULL); return TCL_OK; } ideas/sources/coala_sixbus_bsca100775 764 764 43351 6675456521 16303 0ustar javierjavierELF€Š4p64 (44€4€  ÔÔ€Ô€€€±±´´®´®l`!`±`±ÀÀ/lib/ld-linux.so.2%/&$',  )( -#. + "!*% `±ñÿ(Ô°ñÿ>PˆhD ˜1 J|‰kSüˆ}\ŒˆÛf\ŠÃ"k܉(sœ‰)~ì‰>•ŠžÜˆ0"¥œˆ'¬\‰ˆºL‰‹Ä̉$Ïü‰ƒᬈ@"çìˆT팉8"þ¼ˆ ‰E¬‰&LŠ€?,ŠàD¼‰QL̈L_<Š“"q,‰"x˜ ‹€Šp œl‰®‰@¸<‰D ˜ Ê ²!Ó ²Ý ²!å Ší@˜&" ò˜˜ñÿù ²ñÿ ²ñÿ D²ñÿ__gmon_start__libtkx8.0.3.so_DYNAMIC_GLOBAL_OFFSET_TABLE__init_finiTkx_InitTkX_MainTcl_MergefreesprintfTcl_GetVaratexitlibtclx8.0.3.soTcl_EvalmallocstrcpyTcl_SplitListTclx_InitTcl_GetIntTcl_CreateCommandtimessleepforklibtk8.0.so__strtol_internalTk_MainWindowTk_InitTcl_VarEvallibtcl8.0.soexitmatherrTcl_Initlibm.so.6fputslibX11.so.6callocgetpgrplibdl.so.2_startlibc.so.6__libc_init_first__getpgid__setpgidsetpgrp_environ__environenviron__xstatstat_etext_edata__bss_start_end\± ²'à°ä°è°ì°ð°ô°ø°ü°±±#± ±$±±±"± ±$± (±,±0±4± 8± <±@±)D± H±L±P±T± X±U‰åSè[Ã{(ƒ»ˆtèþ‰öèó‹]ü‰ì]Ãÿ5Ø°ÿ%Ü°ÿ%à°héàÿÿÿÿ%ä°héÐÿÿÿÿ%è°héÀÿÿÿÿ%ì°hé°ÿÿÿÿ%ð°h é ÿÿÿÿ%ô°h(éÿÿÿÿ%ø°h0é€ÿÿÿÿ%ü°h8épÿÿÿÿ%±h@é`ÿÿÿÿ%±hHéPÿÿÿÿ%±hPé@ÿÿÿÿ% ±hXé0ÿÿÿÿ%±h`é ÿÿÿÿ%±hhéÿÿÿÿ%±hpéÿÿÿÿ%±hxéðþÿÿÿ% ±h€éàþÿÿÿ%$±hˆéÐþÿÿÿ%(±héÀþÿÿÿ%,±h˜é°þÿÿÿ%0±h é þÿÿÿ%4±h¨éþÿÿÿ%8±h°é€þÿÿÿ%<±h¸épþÿÿÿ%@±hÀé`þÿÿÿ%D±hÈéPþÿÿÿ%H±hÐé@þÿÿÿ%L±hØé0þÿÿÿ%P±hàé þÿÿÿ%T±hèéþÿÿÿ%X±hðéþÿÿ1í…ÒtRè`ÿÿÿXèÚþÿÿ^D´£ ²‰âƒäøPPRVè¦ýÿÿh ˜è8ÿÿÿXè~ PèlÿÿÿôU‰åS»Ð°ƒ=аt‰ö‹ÿЃÃƒ;uô‹]üÉÃvU‰åÉÃU‰å¸ÉÉöU‰å‹EƒÀÁèjPèþÿÿÉÉöU‰åVS‹u‹] ‹MƒÁÁé1Ò9Ês ‰öŠˆ2B9Êrõeø[^ÉÉöU‰åS‹]‹E ƒ}t‰ÂÁê‰Áƒá¸Óàë‰ö‰ÂÁê‰Áƒá¸þÿÿÿÓÀ ‹]üÉÃvU‰å‹M‹U ‰ÐÁ趉уáÓøƒàÉÉöU‰åS‹E ‰ÂÁê‰Áƒá¸Óà‹]0‹]üÉÃU‰åWVS‹u‹} WÁê0Ƀ}t±ÿ1À9Ðs ‰öˆ 0@9Ðrø¶\ÿ‰øƒàt¹)Á¸ÿÓø ؈Dÿë‰öˆ\ÿeô[^_ÉÃU‰åWVS‹]‹} …ÿu ‹UÇ j è´þÿÿ‰ÇƒÄ…ÿu1Àë=vj‹Uÿ2WègÿÿÿƒÄ 1ö…Ût"‰ö‰ØƒàP‹U‹)ðHPWè¿þÿÿƒÄ ÁëF…Ûuà‰øeô[^_ÉÉöU‰åWVS‹} ‹u…öuGPè#üÿÿ‰ÆƒÄ…öt&1Û9ûsSÿuè»þÿÿƒÄ²0…Àt²1ˆ3C9ûräÆ7‰ðeô[^_ÉÉöU‰åWVS‹} WÁêƒ=¸œu 1ö1Û9Ös6‹M¶ 4…¼˜C9Óríë!v1ö1Û9þsSÿuèOþÿÿƒÄ…ÀtFC9ûrê‰ðeô[^_ÉÃU‰åƒìWVS‹U‹M ‹EÇEìÇEè]ð‰Eð‰Uô‹}‰}ø‰MüEèPEìPSèƒÄ ‹}ƒ?u%‹}ìýÿ4èOýÿÿ‹}‰…Àu 1Àé„v‹uƒÆÁî1Û9ós>}ð‰}äv‹}‹‹}èý‹}ä‹T8‹}ìý‹}ä‹D8Š"ˆ C9órË‹}‹¶\2ÿ‹Eƒàt¹)Á¸ÿÓø ؈D2ÿëvˆ\2ÿ¸eØ[^_ÉÃvU‰åƒìWVS‹M‹] ‹E‹UÇEìÇEèuð‰Eð‰Mô‰Uø‰]üEèPEìPVèƒÄ ‹}ƒ?u%‹}ìýÿ40èSüÿÿ‹}‰ƒÄ…Àu1Àé—‹}ìý]ðÿ4ÿt‹}ÿ7è:üÿÿ‹}èý‹ƒÃÁë1É9Ùs#uð‰ö‹}‹‹}èý‹T2ŠA9Ùrâ‹}‹7¶Tÿ‹}ìý‹D(ðƒàt¹)Á¸ÿÓø ÐëvˆÐˆDÿ¸eÜ[^_ÉÃU‰åƒìWVS‹M‹] ‹E‹UÇEìÇEèuð‰Eð‰Mô‰Uø‰]üEèPEìPVèôƒÄ ‹}ƒ?u%‹}ìýÿ40èCûÿÿ‹}‰ƒÄ…Àu1Àé—‹}ìý]ðÿ4ÿt‹}ÿ7è*ûÿÿ‹}èý‹ƒÃÁë1É9Ùs#uð‰ö‹}‹‹}èý‹T2Š0A9Ùrâ‹}‹7¶Tÿ‹}ìý‹D(ðƒàt¹)Á¸ÿÓø ÐëvˆÐˆDÿ¸eÜ[^_ÉÃU‰åƒìVS‹M‹] ‹E‹U9Ðt1Àë6‰Eð‰Mô‰Uø‰]ü‹MøƒÁÁé1Ò9Ês‹uô‹]üvŠ28uÐB9Êró¸eè[^ÉÃvU‰åWVS‹]‹} WÁê1À9Ðsö@9Ðrø¶tÿ‰øƒàt¿)Ǹÿ‰ùÓø‰ñ Áë‰ö‰ñˆLÿeô[^_ÉÉöU‰åƒìWVS1ÿ1ö9}vU‰ö1Û9]vF‰ðÁè‹U¶‰ñƒáÓøƒà‰Eü1Ƀ}üt‰ØÁè‹U ¶‰Eø‰Øƒà‹Uø£ÂsAÏC9]wÓF9uw­‰øeì[^_ÉÃvU‰åWVS‹U‹u ‹}‹‹‹Ú9Êv‰‰eô[^_ÉÃU‰åVSjÿu ÿuèÒúÿÿ‰ÃƒÄ …Ûu1ÀëÿuSèWøÿÿƒÄƒøÿ•À¶ðSèeøÿÿ‰ðeø[^ÉÃU‰åWVS¾1ÿ1ÛSÿuèsùÿÿƒÄ…Àt÷öCƒû~æÝý¸®eô[^_ÉÃvU‰åƒìWVS‹}‹u ÇEøÇEü1ÛSVè)ùÿÿƒÄƒøu ÝEøÜßÝ]øCƒû~âÝEøeì[^_ÉÃvU‰åìØWVS‹} jh¼œWèøöÿÿ£@²ƒÄ …ÀuÇÀœ¸ébjhçœWèÏöÿÿ‰ÂƒÄ …ÒuÇóœ¸é<‰ö…4ÿÿÿPh<²RWèaöÿÿƒÄ…ÀtBÇ"¸é‰öÇN¸éþ…8ÿÿÿPÿ7èjõÿÿÇŒ¸éà‰ö1ö95<²Ž½8ÿÿÿ‰(ÿÿÿ‰öjè™÷ÿÿ‰µ$²…,ÿÿÿP…0ÿÿÿP‹…4ÿÿÿÿ4°WèÑõÿÿƒÄ…Àu‚1Û90ÿÿÿ~f‹…,ÿÿÿÿ4˜h{ÿµ(ÿÿÿè'öÿÿjÿµ(ÿÿÿWè‰öÿÿƒÄ…À…dÿÿÿjj jÿ7èáôÿÿƒÄƒøÿ„=ÿÿÿjPÿ4µ$²èR÷ÿÿƒÄ C90ÿÿÿšF95<²QÿÿÿǶÿµ,ÿÿÿè<öÿÿ1À¥ÿÿÿ[^_ÉÃvU‰åìÈWVS‹u‹}ÿu h·8ÿÿÿSè†õÿÿjSVèíõÿÿƒÄ…Àuÿ6Wè.ôÿÿ‰øë‰ö¸Æ¥,ÿÿÿ[^_ÉÃU‰åƒìWVS‹Ejj jÿpèôÿÿƒÄ‰Ç1ö1ÛSÿ4½$²è×öÿÿƒÄ…ÀthÈèôÿÿ‰DµäPSÿu è\ÿÿÿFƒÄCƒû~ÊÇDµäEäPVèœóÿÿ‹U ‰1ÀeØ[^_ÉÃU‰åìÔWVS‹} ‹]jèçõÿÿ‰…,ÿÿÿ…0ÿÿÿP…4ÿÿÿPÿsWè&ôÿÿƒÄ…Àt3Çî¸é°v…8ÿÿÿPÿ7è>óÿÿÇž¸é‰ö1Û94ÿÿÿ~Yµ8ÿÿÿ‹…0ÿÿÿÿ4˜h{VèHôÿÿjVWè¯ôÿÿƒÄ…Àuºjj jÿ7è óÿÿƒÄƒøÿt—jPÿµ,ÿÿÿèõÿÿƒÄ C94ÿÿÿ­ÿµ,ÿÿÿè"üÿÿƒìÝ$h5žÿ7èìóÿÿÿµ0ÿÿÿèaôÿÿ1À¥ ÿÿÿ[^_ÉÃU‰åƒìS‹] EðPè‘òÿÿPh=žÿ3è´óÿÿ1À‹]ìÉÃU‰åƒìVS‹] ‹uEüPÿvSèóÿÿƒÄ …Àt ¸ë6vè+óÿÿ…ÀuÿuüèòÿÿÿvSè¦óÿÿjè¯óÿÿvPh=žÿ3èOóÿÿ1Àeô[^ÉÉöU‰åìÈVS‹ujjhˆ’h@žVèBóÿÿjjh„”hPžVè.óÿÿƒÄ(jjh•h_žVèóÿÿjjh–hjžVèóÿÿƒÄ(jjh0–hužVèìòÿÿh†ž8ÿÿÿSè»òÿÿjSVè"óÿÿ1À¥0ÿÿÿ[^ÉÃU‰åhX—‹E P‹EPè¯ñÿÿƒÄ 1ÀëÉÉöU‰åƒì‹EPè¥ñÿÿƒÄ‰À‰Eü‹EPèTñÿÿƒÄ‰Àƒøu ¸ë{v‹EPèòÿÿƒÄ‰Àƒøu ¸ë^‰ö‹EPè›ñÿÿƒÄ‰Àƒøu ¸ëB‰öƒ}üt‹EPè©ñÿÿƒÄ‰Àƒøu¸ë ‹EPè«þÿÿƒÄ‰Àƒøu ¸ë‰ö1ÀëÉÃU‰å‹EPèñÿÿ‰ì]ÃU‰å‹U‹E PRè ñÿÿ‰ì]ÃU‰åSè[Ë‹U‹E PRjè­ñÿÿ‹]ü‰ì]ÃU‰åS»Ä°ƒ=Ä°ÿt‰ö‹ÿЃÃüƒ;ÿuô‹]üÉÃvU‰åÉÃU‰åSè[Ã+èòÿÿ‹]ü‰ì]Ãallbsca_initialize: cannot get list 'all'coal_structbsca_initialize: cannot get list 'coal_struct'bsca_initialize: cannot split 'coal_struct'bsca_initialize: cannot split 'coal_list[i]'lsearch $all %s*bsca_initialize: cannot find agent in alllindex $all %dname_of_agent: cannot find agent in allbsca_value: cannot split argumentbsca_value: cannot find agent in all%-.10lf%dbsca_initializebsca_get_coalsbsca_valuebsca_timesbsca_timeout_cmdglobal tcl_precision; set tcl_precision 14€VÀjøÀjøÀjøÀjøÀNÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀDÀjøÀjøÀjøÀDÀ4ÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀNÀjøÀ€VÀNÀjøÀjøÀNÀ>ÀNÀNÀÀbÀ^ÀjøÀjøÀ^À€VÀàfÀàfÀàtÀqÀ@YÀjøÀYÀTÀsÀ`nÀjøÀqÀ dÀjøÀdÀ@`À¼‰ÿÿÿÿÿÿÿÿ`±’ˆ¢ˆ²ˆˆÒˆâˆòˆ‰‰"‰2‰B‰R‰b‰r‰‚‰’‰¢‰²‰‰Ò‰â‰ò‰ŠŠ"Š2ŠBŠRŠbŠrŠ…ò2Ue€’ Pˆ  ˜è€0…@‚  Ô°øT‡D‡¶Â d˜d˜1<@€b€t€›€´€Ò€€Z€x€š€·€Ó€å€ø€€>€Y€u€—€£€â€)€c€”€Æ€ €8€b€n€š€§€²€¾€Ì€Ø€*é€,ô€-ÿ€. €/€0!€1.€29€3E€4P€5]€:†€=“€>¡€?­€@º€BÇ€EÔ€T€W€Y€!*€"5€#>€$H€%R€&^€'i€*r€+{€,„€-Ž€.™€/¢€0¬€1µ€2¾€5É€:Ô€;à€?é€Nó€¦ý€J€K€L€g#€h0€i;€jH€kS€l`€mk€nx€p†€µ€-À€0Ë$˜Ö ÝDÝDÝD Þ@å$# ˜Ö "ð " ÝD#ÝD$ ÝD%Þ@"ø@"Ýd4˜d@˜"d@˜1<@€b€t€›€´€Ò€€Z€x€š€·€Ó€å€ø€€>€Y€u€—€£€â€)€c€”€Æ€ €8€b€n€š€§€²€¾€Ì€Ø€*é€,ô€-ÿ€. €/€0!€1.€29€3E€4P€5]€:†€=“€>¡€?­€@º€BÇ€EÔ€T€W€Y)€T€ˆ€»€ò€, €e €  $)@˜ª  (¶  ( ÝD)ÝD*ÝD+Ýdf˜bsd-compat.c/usr/src/bs/BUILD/glibc-2.0.7/misc/gcc2_compiled.int:t1=r1;-2147483648;2147483647;char:t2=r2;0;127;long int:t3=r1;-2147483648;2147483647;unsigned int:t4=r1;0;-1;long unsigned int:t5=r1;0;-1;long long int:t6=r1;01000000000000000000000;0777777777777777777777;long long unsigned int:t7=r1;0000000000000;01777777777777777777777;short int:t8=r1;-32768;32767;short unsigned int:t9=r1;0;65535;signed char:t10=r1;-128;127;unsigned char:t11=r1;0;255;float:t12=r1;4;0;double:t13=r1;8;0;long double:t14=r1;12;0;complex int:t15=s8real:1,0,32;imag:1,32,32;;complex float:t16=r16;4;0;complex double:t17=r17;8;0;complex long double:t18=r18;12;0;void:t19=19lconv:T20=s48decimal_point:21=*2,0,32;thousands_sep:21,32,32;\grouping:21,64,32;int_curr_symbol:21,96,32;currency_symbol:21,128,32;\mon_decimal_point:21,160,32;mon_thousands_sep:21,192,32;\mon_grouping:21,224,32;positive_sign:21,256,32;\negative_sign:21,288,32;int_frac_digits:2,320,8;\frac_digits:2,328,8;p_cs_precedes:2,336,8;p_sep_by_space:2,344,8;\n_cs_precedes:2,352,8;n_sep_by_space:2,360,8;\p_sign_posn:2,368,8;n_sign_posn:2,376,8;;locale_t:t22=ar1;0;5;23=*24=xslocale_data:__u_char:t11__u_short:t9__u_int:t4__u_long:t5__u_quad_t:t7__quad_t:t6__qaddr_t:t25=*6__dev_t:t7__uid_t:t4__gid_t:t4__ino_t:t5__mode_t:t4__nlink_t:t4__off_t:t3__loff_t:t6__pid_t:t1__ssize_t:t1__fsid_t:t26=s8__val:27=ar1;0;1;1,0,64;;__daddr_t:t1__caddr_t:t21__time_t:t3__swblk_t:t3__clock_t:t3__fd_mask:t5__fd_set:t28=s128fds_bits:29=ar1;0;31;5,0,1024;;__key_t:t1__ipc_pid_t:t9u_char:t11u_short:t9u_int:t4u_long:t5quad_t:t6u_quad_t:t7fsid_t:t26dev_t:t7gid_t:t4ino_t:t5mode_t:t4nlink_t:t4off_t:t3loff_t:t6pid_t:t1uid_t:t4ssize_t:t1daddr_t:t1caddr_t:t21key_t:t1time_t:t3size_t:t4ulong:t5ushort:t9uint:t4int8_t:t10u_int8_t:t11int16_t:t8u_int16_t:t9int32_t:t1u_int32_t:t4int64_t:t6u_int64_t:t7register_t:t1timespec:T30=s8tv_sec:3,0,32;tv_nsec:3,32,32;;fd_mask:t5fd_set:t28getpgrp:F1pid:p1pid:r1setpgrp:F1pgrp:p1pgrp:r1/usr/src/bs/BUILD/glibc-2.0.7/io/stat.cstat:T30=s88st_dev:7,0,64;__pad1:9,64,16;\st_ino:5,96,32;st_mode:4,128,32;st_nlink:4,160,32;\st_uid:4,192,32;st_gid:4,224,32;st_rdev:7,256,64;\__pad2:9,320,16;st_size:3,352,32;st_blksize:5,384,32;\st_blocks:5,416,32;st_atime:3,448,32;__unused1:5,480,32;\st_mtime:3,512,32;__unused2:5,544,32;st_ctime:3,576,32;\__unused3:5,608,32;__unused4:5,640,32;__unused5:5,672,32;;__stat:F1file:p31=*2buf:p32=*30GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.301.0101.0101.0101.0101.0101.0101.0101.01.symtab.strtab.shstrtab.interp.hash.dynsym.dynstr.rel.got.rel.bss.rel.plt.init.plt.text.fini.rodata.data.ctors.dtors.got.dynamic.bss.stab.stabstr.comment.noteÔ€Ô#è€èX) @‚@ð10…09 D‡DB L‡LK T‡Tø TPˆP,Z|ˆ|_€Š€ e ˜ k¼˜¼õs´®´yÄ°Ä €Ì°Ì ‡Ô°Ô ŒŒ`±`!À• ² "$š "”  ´* ©v4 ² 5 ¶5¸€:P5 ÐBÔ€è€@‚0…D‡L‡T‡Pˆ|ˆ €Š  ˜ ¼˜ ´® Ä°Ì°Ô°`± ² ñÿ ÄŠ ñÿ h˜ &h˜ <È°I˜ TÄ° bаñÿ ˜˜ ñÿ ÄŠ oÄŠ …Ì°“ìŠ T¸® žÄ°¬ñÿ ôŠ À¼˜ Ì”‘' ݸ® èñÿ 8— óñÿñÿŒˆÛœˆ'–' #0–f 4$²9 ‘q D¬‹# N<’I P` X`±ñÿa¬ˆ@"g˜˜ñÿn¼ˆ€̈L‰H‹A “,Œr ›܈0"¢@˜& ©ìˆT¯À° ¿<²Ê ²!Óüˆ}Ü ²æ0”T ô ‰E‰@ Pˆh˜ Tù *,‰"1<‰D;L‰‹E¼‘D N\‰ˆ\Œ‹ e€Šp ll‰~• ‰ˆ’¥ ™|‰k¢ ˜ ª’9 ¬Œ‰8"±œ‰)¼ ²ñÿÈ8— ͬ‰Õ‹. ݼ‰QåX—® ñ´® ü̉$ ˜1 ܉(ì‰> ŒR %ü‰ƒ7„”{ F˜–ž XÌR f@˜&" k ²ñÿr ŠzÔ°ñÿD²ñÿ•ôŠ  Š¦,Šà«ôŒ` ´PŽ ½@²ÈpY ÑЋ\ ß<Š“"å´® òLŠ€þ‹ \ŠÃ"  initfini.cgcc2_compiled.crtstuff.c__do_global_ctors_aux__CTOR_END__init_dummyforce_to_data__DTOR_END____do_global_dtors_aux__DTOR_LIST__fini_dummy__CTOR_LIST__coala_sixbus_bsca.cbitcount.42first_is_biggestv_array.61agt_wish.cbsd-compat.cstat.cTcl_Mergestrcpybsca_timesbsca_timeout_cmdcoalba_dotprodba_togglexba_diff_DYNAMICtimes_etext__strtol_internalTcl_Initba_assignba_ul2bmalloc__statsleeptclDummyMathPtrn_of_coals_environTkX_Main__environname_of_agentTk_MainWindow__getpgid_initgetpgrpba_intersectioncalloc__setpgidTclx_Initba_printTcl_SplitListba_value_start__libc_init_firstbsca_valuebsca_initializeTkx_InitsetpgrpvforkTcl_GetVar__bss_startmainTk_Initba_copymatherrTcl_AppInitdata_startTcl_GetInt_finisprintfatexitba_b2strTcl_CreateCommandbsca_get_coalsIdeas_ActSrc_Initba_complementstat_edata__xstat_GLOBAL_OFFSET_TABLE__endba_initTcl_Evalexitba_countba_unionagent_listba_equalba_all_assignfputs__data_startTcl_VarEvalba_newfree__gmon_start__ideas/sources/coala_sixbus_kca.h100664 764 764 273 6675703446 16311 0ustar javierjavier/* ===== global defines */ /* ===== number of agents */ #define N 6 /* ===== min/max size of coalitions */ #define csizemin 1 #define csizemax 6 #define VALUE_C_FILE "coala_sixbus_v_c.c" ideas/sources/coala_sixbus_kca.c100664 764 764 43236 6675703447 16353 0ustar javierjavier/*----------------------------------------------------------------------------- * Copyright (c) 1997/8 by Matthias Klusch, Torsten Vielhak * Computer Science Department, * Christian-Albrechts-University of Kiel, * Olshausenstr. 40, 24118 Kiel, Germany * * All rights reserved. * No warranties will be given on any issues arising out of the use * of this software product. * Permission to use, copy, modify and distribute this software * product for non-commercial purposes is hereby granted, provided * that the above copyright notice appears in all copies and * respective publications. * All commercial trades with this product outside the CAU Kiel * without specific written prior permission are prohibited. *----------------------------------------------------------------------------- */ /* ===== coala_kca.c */ /* ===== This file is used by COALA to create IDEAS agents using the KCA*/ /* ===== Mainly the functions are used to calculate pKs solutions */ #include #include #include #include #include #include "types.h" #include "bitarr.h" #include "coala_sixbus_kca.h" /* #include "coala_kca.h" */ /* ===== Outputformat for float-value (printf) */ #define OUTPUT_FORMAT "%-.10lf" /* ===== round error */ #define arch_eps 0.0000001 /* ===== IR (eal) */ typedef double Float; #define MINFloat -MAXDOUBLE /* ===== coalition (subset of _A_) */ typedef bit* coalition; /* ===== coalition structure _C_ */ struct coalition_structure { /* ===== number of coaltions in coalition_structure */ int size; /* ===== array of coalitions */ coalition coal[N]; }; /* ===== payoff configuration */ struct payoff_configuration { /* ===== pointer to the coalition structure */ struct coalition_structure* coal_struct; /* ===== array of payoffs for each agent */ Float payoff[N]; }; /* ===== global variables */ /* ===== list of all agents */ char *agent_list; /* ===== number of coalitions */ int n_of_coals; /* ===== coalitions as bitvectors */ char *coal[N]; #include "bitarr.c" #include VALUE_C_FILE /* ===== coalition payoff function */ Float x(Float* xz_1, coalition coal) { Float result = 0.0; int i; for (i=0; icmax) \ || (ba_value(coal,ak)==FALSE) || (ba_value(coal,al)==TRUE) \ /* not needed: || coal_in_structure(coal, coal_struct) */ ); } /* ===== testing if payoff configuration is K-stable */ bool K_Condition (coalition coal, Float* surplus, Float* xz_1) { int ak,al; coalition single_al, single_ak; single_al = ba_new(N); single_ak = ba_new(N); for (ak=0; ak surplus[al*N+ak]) && (abs(xz_1[al]-v(single_al))coal_struct->coal; R = ba_new(N); single_al = ba_new(N); /* ===== line 1 */ z = 0; /* ===== line 2 */ xz = payoff->payoff; PCz = payoff; /* ===== line 3 */ eps = 0.01; /* ===== line 4 */ do { /* ===== FIXED !!! */ pKConfig = TRUE; KConfig = TRUE; /* ===== line 5 */ DemandSet = MINFloat; z = z+1; /* ===== save old payoffs in x(z-1) */ for (i=0; icoal_struct->size; C++) { /* ===== line 8 */ kEquilibrium[C] = TRUE; /* ===== line 9 */ for (ak=0; akcoal_struct); if (ba_count(R,N)>0) { for (; ba_count(R, N)>0; next_coal(R, cmin, cmax, ak, al, payoff->coal_struct)) { /* ===== line 15-20 */ if ((v(R)-x(xz_1, R)) > surplus[ak][al]) { surplus[ak][al] = v(R)-x(xz_1, R); } } } } } } } /* ===== line 21 */ if (!K_Condition(coals[C], (Float *)surplus, xz_1)) { kEquilibrium[C] = FALSE; } } /* ===== end for each C in _C_ (line 6) */ SurplusSet = MINFloat; /* ===== line 23 for each C in _C_ */ for (C=0; Ccoal_struct->size; C++) { /* ===== line 25 */ for (ai=0; aiSurplusSet) { SurplusSet = fabs(surplus[ai][aj]-surplus[aj][ai]); } } } /* ===== end for each aj in C */ } } /* ===== end for each ai in C */ /* ===== line 28 & 29 */ if (!kEquilibrium[C]) { KConfig = FALSE; break; /* ===== breaking for each C in _C_ */ } } /* ===== end for each C in _C_ */ ba_all_assign(R,N,1); /* ===== line 31 */ if ((!KConfig) && (fabs((SurplusSet/x(xz_1, R)))>eps)) { /* ===== line 32 */ pKConfig = FALSE; DemandSet = MINFloat; /* ===== line 33 for each C in _C_ */ for (C=0; Ccoal_struct->size; C++) { /* ===== line 34 */ /* ===== line 35 */ for (ak=0; ak surplus[al][ak]) { /* ===== line 38 */ if (((surplus[ak][al]-surplus[al][ak])/2)<(xz_1[al]-v(single_al)) || ((xz_1[al]-v(single_al)<0))) { demand[ak][al]=(surplus[ak][al]-surplus[al][ak])/2; } else { demand[ak][al]=(xz_1[al]-v(single_al)); } } else { /* ===== line 39 */ demand[ak][al] = 0; } /* ===== line 42 & 45 */ if (demand[ak][al] > DemandSet) { DemandSet = demand[ak][al]; ai=ak; aj=al; } } } } } } /* ===== end for each C in _C_ line 33 */ /* ===== line 46 */ sidepayment = DemandSet; for (ak=0; akresult = "kca_initialize: cannot get list 'all'"; return TCL_ERROR; } if ((value = Tcl_GetVar(interp, "coal_struct", 0)) == NULL) { interp->result = "kca_initialize: cannot get list 'coal_struct'"; return TCL_ERROR; } if (Tcl_SplitList(interp, value, &n_of_coals, &coal_list) != TCL_OK) { interp->result = "kca_initialize: cannot split 'coal_struct'"; return TCL_ERROR; } for (i=0; i < n_of_coals; i++) { coal[i] = ba_new(N); if (Tcl_SplitList(interp, coal_list[i], &n, &agents) != TCL_OK) { interp->result = "kca_initialize: cannot split 'coal_list[i]'"; return TCL_ERROR; } for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "kca_initialize: cannot find agent in all"; return TCL_ERROR; } index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "kca_initialize: cannot find agent in all"; return TCL_ERROR; } ba_assign(coal[i], index, 1); } } interp->result = ""; free((char *) agents); return TCL_OK; } char *name_of_agent(Tcl_Interp *interp, int j, char *str) { char command[200]; sprintf(command, "lindex $all %d", j); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { return "name_of_agent: cannot find agent in all"; } strcpy(str, interp->result); return str; } int kca_get_coals (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int i,j,k; char *(str_coals[N+1]); j = atoi(argv[1]); k=0; for (i=0; i < N; i++) { if (ba_value(coal[j], i)) { str_coals[k] = malloc (200); name_of_agent(interp, i, str_coals[k]); k++; } } str_coals[k] = 0; interp->result = Tcl_Merge(k, str_coals); return TCL_OK; } int kca_calculate_pc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { struct coalition_structure test; struct payoff_configuration payoff; char command[200]; char **coal_list, **agents; char **payoff_vector; int i,n,j; int index; /* ===== get first argument (coalitions) and split it */ if (Tcl_SplitList(interp, argv[1], &n_of_coals, &coal_list) != TCL_OK) { interp->result = "kca_calculate_pc: cannot split 'coal_struct'"; return TCL_ERROR; } /* ===== foreach coalition do */ for (i=0; i < n_of_coals; i++) { test.coal[i] = ba_new(N); /* ===== split coalition */ if (Tcl_SplitList(interp, coal_list[i], &n, &agents) != TCL_OK) { interp->result = "kca_calculate_pc: cannot split 'coal_list[i]'"; return TCL_ERROR; } /* ===== foreach agent in this coalition */ for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "kca_calculate_pc: cannot find agent in all"; return TCL_ERROR; } /* ===== get index in $all */ index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "kca_calculate_pc: cannot find agent in all"; return TCL_ERROR; } /* ===== mark position in bitvector */ ba_assign(test.coal[i], index, 1); } } /* ===== get second argument (payoff vector) and split it */ if (Tcl_SplitList(interp, argv[2], &n, &payoff_vector) != TCL_OK) { interp->result = "kca_calculate_pc: cannot split 'payoff vector'"; return TCL_ERROR; } /* ===== payoff_vector corrupt ? */ if (n!=N) { interp->result = "kca_calculate_pc: corrupt 'payoff vector'"; return TCL_ERROR; } /* ===== set size of the considered coalition */ test.size=n_of_coals; /* ===== build initial payoff configuration */ payoff.coal_struct = &test; for (i=0; i < N; i++) { payoff.payoff[i] = atof(payoff_vector[i]); } /* ===== calculate pK-stable payoff configuration */ Calc_pKs_PC(&payoff,csizemin,csizemax,interp); /* ===== free initial payoff_vector */ free((char *) payoff_vector); /* ===== make new payoff vector */ if ((payoff_vector = malloc((N+2)*sizeof(char*))) == NULL) { interp->result = "kca_calculate_pc: cannot allocate memory for 'payoff vector'"; return TCL_ERROR; } /* ===== fill the new vector with values */ for (i=0; i < N; i++) { if ((payoff_vector[i]=malloc(40)) == NULL) { interp->result = "kca_calculate_pc: cannot allocate memory for 'payoff vector component'"; return TCL_ERROR; } sprintf(payoff_vector[i], OUTPUT_FORMAT, payoff.payoff[i]); } /* ===== build result for Tcl/TK-Interpreter */ interp->result = Tcl_Merge(N, payoff_vector); interp->freeProc = (Tcl_FreeProc *) free; /* ===== cleanup */ free((char *) coal_list); free((char *) agents); return TCL_OK; } /* ===== gives value of a coalition */ int kca_value (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { coalition coal; int n, index,j; char **agents; Float val; char command[200]; /* ===== initialize coalition */ coal = ba_new(N); /* ===== split coalition */ if (Tcl_SplitList(interp, argv[1], &n, &agents) != TCL_OK) { interp->result = "kca_value: cannot split argument"; return TCL_ERROR; } /* ===== foreach agent in this coalition */ for (j=0; j < n; j++) { sprintf(command, "lsearch $all %s*", agents[j]); if ((Tcl_VarEval(interp, command, (char *) NULL)) != TCL_OK) { interp->result = "kca_value: cannot find agent in all"; return TCL_ERROR; } /* ===== get index in $all */ index = atoi(interp->result); if (index == -1) { strcpy(interp->result, command); interp->result = "kca_value: cannot find agent in all"; return TCL_ERROR; } /* ===== mark position in bitvector */ ba_assign(coal, index, 1); } /* ===== get value of coalition */ val = v(coal); sprintf(interp->result, OUTPUT_FORMAT, val); /* ===== cleanup */ free((char*) agents); return TCL_OK; } /* ===== gives system time in ticks (ms) */ int kca_times (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { struct tms buf; clock_t timer; timer = times(&buf); sprintf(interp->result, "%d", timer); return TCL_OK; } /* ===== executes argv[2] after argv[1] seconds */ /* ===== gives back the pid of the forked process (for */ /* ===== killing it) */ int kca_timeout_cmd (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { int seconds; int pid; if (Tcl_GetInt(interp, argv[1], &seconds) != TCL_OK) { return TCL_ERROR; } if ((pid = fork()) == 0) { sleep(seconds); Tcl_Eval(interp, argv[2]); exit(0); } sprintf(interp->result, "%d", pid); return TCL_OK; } /* --------------------------------------------------------------------------*/ /* */ /* Initialization procedure for the package */ /* */ /* --------------------------------------------------------------------------*/ int Ideas_ActSrc_Init (Tcl_Interp *interp) { char command[200]; /* Call here Tcl_CreateCommand for each command procedures defined above */ /* to register it in the Tcl-interpreter. */ Tcl_CreateCommand(interp, "kca_initialize", kca_initialize, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_get_coals", kca_get_coals, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_calculate_pc", kca_calculate_pc, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_value", kca_value, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_times", kca_times, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "kca_timeout_cmd", kca_timeout_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); sprintf(command,"global tcl_precision; set tcl_precision 14"); Tcl_VarEval(interp, command, (char *)NULL); return TCL_OK; } ideas/sources/coala_sixbus_kca100775 764 764 52414 6675703472 16131 0ustar javierjavierELFÀŠ4D4 (44€4€  ÔÔ€Ô€€€A,A,D,D¼D¼p”ô.ô¾ô¾ÀÀ/lib/ld-linux.so.2%0'%(-  *) .$ / ,!#"+& ô¾ñÿ(d¾ñÿ>€ˆhD°¤1 J¼‰kS<‰}\¼ˆÛfœŠÃ"kŠ(s܉)~,Š>•\Šž‰0"¥Ìˆ'¬œ‰ˆºŒ‰‹Ä Š$Ï<Šƒáìˆ@"ç,‰Tí̉8"þüˆ܈·>"L‰E0ì‰8ŒŠ€QlŠàVü‰Q^ ‰Lq|Š“"ƒl‰"Š ¤ ÀŠp ®¬‰À\‰@Ê|‰DÔ0¤ Ü´¿!å´¿ï´¿!÷LŠÿP¤&" ¨¤ñÿ ´¿ñÿ´¿ñÿØ¿ñÿ__gmon_start__libtkx8.0.3.so_DYNAMIC_GLOBAL_OFFSET_TABLE__init_finiTkx_InitTkX_MainTcl_MergefreesprintfTcl_GetVaratexitlibtclx8.0.3.soTcl_EvalmallocstrcpyTcl_SplitListTclx_InitTcl_GetIntTcl_CreateCommandtimessleepforklibtk8.0.so__strtol_internal__strtod_internalTk_MainWindowTk_InitTcl_VarEvallibtcl8.0.soexitmatherrTcl_Initlibm.so.6fputslibX11.so.6callocgetpgrplibdl.so.2_startlibc.so.6__libc_init_first__getpgid__setpgidsetpgrp_environ__environenviron__xstatstat_etext_edata__bss_start_endð¾´¿(p¾t¾x¾|¾€¾„¾ˆ¾Œ¾¾”¾˜¾$œ¾  ¾%¤¾¨¾¬¾#°¾´¾¸¾ ¼¾À¾ľȾ ̾ оÔ¾*ؾ ܾà¾ä¾è¾ ì¾U‰åSè[ÃÛ5ƒ»Œtè‰öèÓ‹]ü‰ì]Ãÿ5h¾ÿ%l¾ÿ%p¾héàÿÿÿÿ%t¾héÐÿÿÿÿ%x¾héÀÿÿÿÿ%|¾hé°ÿÿÿÿ%€¾h é ÿÿÿÿ%„¾h(éÿÿÿÿ%ˆ¾h0é€ÿÿÿÿ%Œ¾h8épÿÿÿÿ%¾h@é`ÿÿÿÿ%”¾hHéPÿÿÿÿ%˜¾hPé@ÿÿÿÿ%œ¾hXé0ÿÿÿÿ% ¾h`é ÿÿÿÿ%¤¾hhéÿÿÿÿ%¨¾hpéÿÿÿÿ%¬¾hxéðþÿÿÿ%°¾h€éàþÿÿÿ%´¾hˆéÐþÿÿÿ%¸¾héÀþÿÿÿ%¼¾h˜é°þÿÿÿ%À¾h é þÿÿÿ%ľh¨éþÿÿÿ%Ⱦh°é€þÿÿÿ%̾h¸épþÿÿÿ%оhÀé`þÿÿÿ%Ô¾hÈéPþÿÿÿ%ؾhÐé@þÿÿÿ%ܾhØé0þÿÿÿ%à¾hàé þÿÿÿ%ä¾hèéþÿÿÿ%è¾hðéþÿÿÿ%ì¾høéðýÿÿ1í…ÒtRè`ÿÿÿXèÚþÿÿ^D´£´¿‰âƒäøPPRVè–ýÿÿh°¤è8ÿÿÿXèVPèlÿÿÿôU‰åS»`¾ƒ=`¾t‰ö‹ÿЃÃƒ;uô‹]üÉÃvU‰åÉÃU‰å¸ÉÉöU‰å‹EƒÀÁèjPèþÿÿÉÉöU‰åVS‹u‹] ‹MƒÁÁé1Ò9Ês ‰öŠˆ2B9Êrõeø[^ÉÉöU‰åS‹]‹E ƒ}t‰ÂÁê‰Áƒá¸Óàë‰ö‰ÂÁê‰Áƒá¸þÿÿÿÓÀ ‹]üÉÃvU‰å‹M‹U ‰ÐÁ趉уáÓøƒàÉÉöU‰åS‹E ‰ÂÁê‰Áƒá¸Óà‹]0‹]üÉÃU‰åWVS‹u‹} WÁê0Ƀ}t±ÿ1À9Ðs ‰öˆ 0@9Ðrø¶\ÿ‰øƒàt¹)Á¸ÿÓø ؈Dÿë‰öˆ\ÿeô[^_ÉÃU‰åWVS‹]‹} …ÿu ‹UÇ j è´þÿÿ‰ÇƒÄ…ÿu1Àë=vj‹Uÿ2WègÿÿÿƒÄ 1ö…Ût"‰ö‰ØƒàP‹U‹)ðHPWè¿þÿÿƒÄ ÁëF…Ûuà‰øeô[^_ÉÉöU‰åWVS‹} ‹u…öuGPè#üÿÿ‰ÆƒÄ…öt&1Û9ûsSÿuè»þÿÿƒÄ²0…Àt²1ˆ3C9ûräÆ7‰ðeô[^_ÉÉöU‰åWVS‹} WÁêƒ=Ȩu 1ö1Û9Ös6‹M¶ 4…̤C9Óríë!v1ö1Û9þsSÿuèOþÿÿƒÄ…ÀtFC9ûrê‰ðeô[^_ÉÃU‰åƒìWVS‹U‹M ‹EÇEìÇEè]ð‰Eð‰Uô‹}‰}ø‰MüEèPEìPSèƒÄ ‹}ƒ?u%‹}ìýÿ4èOýÿÿ‹}‰…Àu 1Àé„v‹uƒÆÁî1Û9ós>}ð‰}äv‹}‹‹}èý‹}ä‹T8‹}ìý‹}ä‹D8Š"ˆ C9órË‹}‹¶\2ÿ‹Eƒàt¹)Á¸ÿÓø ؈D2ÿëvˆ\2ÿ¸eØ[^_ÉÃvU‰åƒìWVS‹M‹] ‹E‹UÇEìÇEèuð‰Eð‰Mô‰Uø‰]üEèPEìPVèƒÄ ‹}ƒ?u%‹}ìýÿ40èSüÿÿ‹}‰ƒÄ…Àu1Àé—‹}ìý]ðÿ4ÿt‹}ÿ7è:üÿÿ‹}èý‹ƒÃÁë1É9Ùs#uð‰ö‹}‹‹}èý‹T2ŠA9Ùrâ‹}‹7¶Tÿ‹}ìý‹D(ðƒàt¹)Á¸ÿÓø ÐëvˆÐˆDÿ¸eÜ[^_ÉÃU‰åƒìWVS‹M‹] ‹E‹UÇEìÇEèuð‰Eð‰Mô‰Uø‰]üEèPEìPVèôƒÄ ‹}ƒ?u%‹}ìýÿ40èCûÿÿ‹}‰ƒÄ…Àu1Àé—‹}ìý]ðÿ4ÿt‹}ÿ7è*ûÿÿ‹}èý‹ƒÃÁë1É9Ùs#uð‰ö‹}‹‹}èý‹T2Š0A9Ùrâ‹}‹7¶Tÿ‹}ìý‹D(ðƒàt¹)Á¸ÿÓø ÐëvˆÐˆDÿ¸eÜ[^_ÉÃU‰åƒìVS‹M‹] ‹E‹U9Ðt1Àë6‰Eð‰Mô‰Uø‰]ü‹MøƒÁÁé1Ò9Ês‹uô‹]üvŠ28uÐB9Êró¸eè[^ÉÃvU‰åWVS‹]‹} WÁê1À9Ðsö@9Ðrø¶tÿ‰øƒàt¿)Ǹÿ‰ùÓø‰ñ Áë‰ö‰ñˆLÿeô[^_ÉÉöU‰åƒìWVS1ÿ1ö9}vU‰ö1Û9]vF‰ðÁè‹U¶‰ñƒáÓøƒà‰Eü1Ƀ}üt‰ØÁè‹U ¶‰Eø‰Øƒà‹Uø£ÂsAÏC9]wÓF9uw­‰øeì[^_ÉÃvU‰åWVS‹U‹u ‹}‹‹‹Ú9Êv‰‰eô[^_ÉÃU‰åVSjÿu ÿuèÒúÿÿ‰ÃƒÄ …Ûu1ÀëÿuSèWøÿÿƒÄƒøÿ•À¶ðSèeøÿÿ‰ðeø[^ÉÃU‰åWVS¾1ÿ1ÛSÿuèsùÿÿƒÄ…Àt÷öCƒû~æÝýH¼eô[^_ÉÃvU‰åƒìWVS‹}‹u ÇEøÇEü1ÛSVè)ùÿÿƒÄƒøu ÝEøÜßÝ]øCƒû~âÝEøeì[^_ÉÃvU‰åWVS‹u‹}1Û‰öSVèíøÿÿƒÄ…ÀujSVè™øÿÿƒÄ ëjSVè‹øÿÿƒÄ Cƒû~Òƒût?jVè!úÿÿƒÄ9E w¹jVèúÿÿƒÄ9Er©ÿuVè˜øÿÿƒÄ…Àt™WVèŠøÿÿƒÄƒøtŠeô[^_ÉÉöU‰åƒì WVSjèÜ÷ÿÿ‰ÇjèÓ÷ÿÿ‰Eô1öƒÄvVÿuèKøÿÿƒÄƒø…™1Û¶‰E𠶉M춉EèvSÿuèøÿÿƒÄƒø…c9Þ„[jjWèEøÿÿjjÿuôè9øÿÿjSWè¨÷ÿÿƒÄ$jVÿuôèš÷ÿÿ‹UðòÚ ›‰MàÙñ‹E ÝÐÜ$ÈÙ}ü‹Müµ ‰MøÙmøƒìÛ$ZÙmü…Ò}÷ÚƒÄ Ý̨RÚ$ƒÄßà€äE„Û‹UìòÚ›‰EàØð‹M ÝÑÜÁßà€äEuAWèØýÿÿ‹MÜ,ÙÙ}ü‹Eü´ ‰EøÙmøƒìÛ$ZÙmü…Ò}÷ÚƒÄÝ̨RÚ$ƒÄßà€äEty‹UèòÚ›‰EàØð‹M ÝÑÜÁßà€äE€üuCÿuôèqýÿÿ‹MÜ,ñÙ}ü‹Eü´ ‰EøÙmøƒìÛ$ZÙmü…Ò}÷ÚƒÄÝ̨RÚ$ƒÄßà€äEtWèŒõÿÿÿuôè„õÿÿ1Àë'CƒûŽ~þÿÿFƒþŽHþÿÿWèfõÿÿÿuôè^õÿÿ¸eÔ[^_ÉÃU‰åì¸WVSÇ…ˆüÿÿ‰öÇ…„üÿÿ‹•ˆüÿÿRÁà„Ðýÿÿv‹„üÿÿÇÈÿÿÿÿÇDÈÿÿïÿA‰„üÿÿƒù~ßÿ…ˆüÿÿƒ½ˆüÿÿ~°‹U‹ƒÂ‰•üÿÿjèwõÿÿ‰…Œüÿÿjèjõÿÿ‰…€üÿÿ‹MƒÁ‰¤üÿÿƒÄ•ÿÿÿ‰•püÿÿÇ…¬üÿÿÇ…¨üÿÿ1Û‰ö‹¤üÿÿ‹Ù‰„Ýÿÿÿ‹DÙ‰„Ý ÿÿÿCƒû~ß1ÿ‹U‹98Ž«Ç„½ðþÿÿ1övV‹üÿÿÿ4¹èmõÿÿƒÄƒø…;1ÛvÁà„Ðýÿÿ‰…|üÿÿS‹•üÿÿÿ4ºè=õÿÿƒÄƒø…‹|üÿÿÇÙÿÿÿÿÇDÙÿÿïÿjjÿµŒüÿÿèQõÿÿ‹Uÿ2SVÿuÿu ÿµŒüÿÿèñûÿÿƒÄ$jÿµŒüÿÿèMöÿÿƒÄ…À„ª‰öjÿµŒüÿÿè3öÿÿƒÄ…À„ÿµŒüÿÿè)ûÿÿÝtüÿÿÿµŒüÿÿÿµpüÿÿèNûÿÿÜ­tüÿÿƒÄ ‹|üÿÿÜÙßà€äEu4ÿµŒüÿÿèîúÿÿÝhüÿÿÿµŒüÿÿÿµpüÿÿèûÿÿÜ­hüÿÿ‹•|üÿÿÝÚƒÄ ‹Mÿ1SVÿuÿu ÿµŒüÿÿè5ûÿÿƒÄéYÿÿÿCƒûŽÚþÿÿFƒþŽ þÿÿÿµpüÿÿ…ÐýÿÿP‹•üÿÿÿ4ºè‰ûÿÿƒÄ …Àu Ç„½ðþÿÿG‹M‹98UþÿÿÇ…”üÿÿÿÿÿÿÇ…˜üÿÿÿÿïÿ1ÿé߉öÇ…ˆüÿÿ‰öÿµˆüÿÿ‹üÿÿÿ4¹è¤óÿÿƒÄƒø……Ç…„üÿÿ‹•ˆüÿÿRÁàœÐýÿÿvÿµ„üÿÿ‹üÿÿÿ4¹èdóÿÿƒÄƒøu:‹•„üÿÿRÁà„ÐýÿÿÝÓ‹ˆüÿÿÜ$ÈÙáÜ•”üÿÿßà€äEu Ý”üÿÿë‰öÝØÿ…„üÿÿƒ½„üÿÿ~›ÿ…ˆüÿÿƒ½ˆüÿÿŽHÿÿÿƒ¼½ðþÿÿuÇ…¨üÿÿë‰öG‹U‹98ÿÿÿjjÿµŒüÿÿèóÿÿƒÄ ƒ½¨üÿÿ…ÂÿµŒüÿÿÿµpüÿÿèZùÿÿܽ”üÿÿÙáƒÄÜÔ¨ßà€äE…•Ç…¬üÿÿÇ…œüÿÿÿÿÿÿÇ… üÿÿÿÿïÿ1ÿ‹M‹‹•¬üÿÿ9Žÿv1ö‰öV‹üÿÿÿ4¹èEòÿÿƒÄƒø…Å1Ûv‰•\üÿÿ v‰Xüÿÿv‰•Tüÿÿ v‰PüÿÿvS‹•üÿÿÿ4ºèòÿÿƒÄƒø…wjjÿµ€üÿÿè*òÿÿjSÿµ€üÿÿè”ñÿÿvÁà„Ðýÿÿ‰…Lüÿÿ[Áà„Ðýÿÿ‰…HüÿÿƒÄ‹LüÿÿÝÙ‰ÂÜòßà€äE…ÂÝÙ‹HüÿÿÜ$ñÝܨÞùÝ`üÿÿÿµ€üÿÿèå÷ÿÿܬÝÿÿÿƒÄÜ`üÿÿßà€äEt ÿµ€üÿÿèÃ÷ÿÿܬÝÿÿÿƒÄÙîÞÙßà€äEu:‹•\üÿÿÁâꊰüÿÿÂÐýÿÿ[Áà„ÐýÿÿÝÚÜ$ðÝܨÞùÝÙëNvÿµ€üÿÿèi÷ÿÿ‹…XüÿÿÁà„°üÿÿܬÝÿÿÿÝ؃Äë!‰ö‹…TüÿÿÁà„°üÿÿÇØÇDØ‹…PüÿÿÁà„°üÿÿÝØÜ•œüÿÿßà€äEuÝœüÿÿ‰µˆüÿÿ‰„üÿÿëÝØCƒûŽdþÿÿFƒþŽþÿÿG‹U‹98þÿÿÝ…œüÿÿ1ö9µˆüÿÿuÙÀÜ„õÿÿÿ‹¤üÿÿÝñë79µ„üÿÿuÝ„õÿÿÿØá‹•¤üÿÿÝò다üÿÿ‹„õÿÿÿ‰ñ‹„õ ÿÿÿ‰DñFƒþ~§Ý؃½¬üÿÿ„úÿÿÿµŒüÿÿè±îÿÿÿµ€üÿÿè¦îÿÿ¥<üÿÿ[^_ÉÃvU‰åìØWVS‹} jhä¨Wè¼íÿÿ£Ô¿ƒÄ …ÀuÇ訸ébjh©Wè“íÿÿ‰ÂƒÄ …ÒuÇ©¸é<‰ö…4ÿÿÿPhпRWè%íÿÿƒÄ…ÀtBÇH©¸é‰öÇs©¸éþ…8ÿÿÿPÿ7èìÿÿÇ°©¸éà‰ö1ö95пŽ½8ÿÿÿ‰(ÿÿÿ‰öjè]îÿÿ‰µ¸¿…,ÿÿÿP…0ÿÿÿP‹…4ÿÿÿÿ4°Wè•ìÿÿƒÄ…Àu‚1Û90ÿÿÿ~f‹…,ÿÿÿÿ4˜hŸ©ÿµ(ÿÿÿèëìÿÿjÿµ(ÿÿÿWèMíÿÿƒÄ…À…dÿÿÿjj jÿ7è¥ëÿÿƒÄƒøÿ„=ÿÿÿjPÿ4µ¸¿èîÿÿƒÄ C90ÿÿÿšF95пQÿÿÿÇÙ©ÿµ,ÿÿÿèíÿÿ1À¥ÿÿÿ[^_ÉÃvU‰åìÈWVS‹u‹}ÿu hÚ©8ÿÿÿSèJìÿÿjSVè±ìÿÿƒÄ…Àuÿ6Wèâêÿÿ‰øë‰ö¸é©¥,ÿÿÿ[^_ÉÃU‰åƒìWVS‹Ejj jÿpèâêÿÿƒÄ‰Ç1ö1ÛSÿ4½¸¿è›íÿÿƒÄ…ÀthÈèÚêÿÿ‰DµäPSÿu è\ÿÿÿFƒÄCƒû~ÊÇDµäEäPVèPêÿÿ‹U ‰1ÀeØ[^_ÉÃU‰åì,WVS‹} …äþÿÿPhп‹MÿqWèùêÿÿƒÄ…ÀtǪ¸é;‰ö1Û9пŽ¾èþÿÿ‰Ôþÿÿ‰öjèaìÿÿ‰Dè…ÜþÿÿP…àþÿÿP‹…äþÿÿÿ4˜WèœêÿÿƒÄ…À…91ö9µàþÿÿ~fv‹…Üþÿÿÿ4°hŸ©ÿµÔþÿÿèëêÿÿjÿµÔþÿÿWèMëÿÿƒÄ…À…jj jÿ7è¥éÿÿƒÄƒøÿ„ñjPÿtèèìÿÿƒÄ F9µàþÿÿC9пPÿÿÿ…ØþÿÿP…àþÿÿP‹MÿqWèúéÿÿƒÄ…ÀtÇ—ª¸é<vƒ½àþÿÿtÇƪ¸é v¡Ð¿‰EäMä‰M°1Û‹…Øþÿÿjjÿ4˜èâèÿÿƒÄ Ý\Ý´Cƒû~áWjjE°Pè7õÿÿÿµØþÿÿè|êÿÿj èõèÿÿ‰…ØþÿÿƒÄ…ÀuPÇðª¸é±Ç>ª¸é¡…èþÿÿPÿ7èjèÿÿÇlª¸郉öÇ-«¸ëtv1Û‰öj(èèÿÿ‰Â‹…Øþÿÿ‰˜ƒÄ…ÒtÓ‹Dݸ‹TÝ´PRht«‹…Øþÿÿÿ4˜è^éÿÿƒÄCƒû~ÁÿµØþÿÿjèèçÿÿ‰ÇGœŠÿµäþÿÿè´éÿÿÿµÜþÿÿè©éÿÿ1À¥Èþÿÿ[^_ÉÃU‰åìÔWVS‹} ‹]jè'êÿÿ‰…,ÿÿÿ…0ÿÿÿP…4ÿÿÿPÿsWèfèÿÿƒÄ…Àt3Ç|«¸é°v…8ÿÿÿPÿ7ènçÿÿÇ«¸é‰ö1Û94ÿÿÿ~Yµ8ÿÿÿ‹…0ÿÿÿÿ4˜hŸ©VèˆèÿÿjVWèïèÿÿƒÄ…Àuºjj jÿ7èKçÿÿƒÄƒøÿt—jPÿµ,ÿÿÿèÁéÿÿƒÄ C94ÿÿÿ­ÿµ,ÿÿÿèbðÿÿƒìÝ$ht«ÿ7è,èÿÿÿµ0ÿÿÿè¡èÿÿ1À¥ ÿÿÿ[^_ÉÃU‰åƒìS‹] EðPèÑæÿÿPhÁ«ÿ3èôçÿÿ1À‹]ìÉÃU‰åƒìVS‹] ‹uEüPÿvSèÁçÿÿƒÄ …Àt ¸ë6vèkçÿÿ…Àuÿuüè¿æÿÿÿvSèæçÿÿjèïçÿÿvPhÁ«ÿ3èçÿÿ1Àeô[^ÉÉöU‰åìÈVS‹ujjhœhÄ«Vè‚çÿÿjjhžhÓ«VènçÿÿƒÄ(jjh|žhá«VèWçÿÿjjh¡hò«VèCçÿÿƒÄ(jjh¢hü«Vè,çÿÿjjh0¢h¬VèçÿÿƒÄ(h¬8ÿÿÿSèäæÿÿjSVèKçÿÿ1À¥0ÿÿÿ[^ÉÃU‰åhp£‹E P‹EPè×åÿÿƒÄ 1ÀëÉÉöU‰åƒì‹EPèÍåÿÿƒÄ‰À‰Eü‹EPè|åÿÿƒÄ‰Àƒøu ¸ë{v‹EPè?æÿÿƒÄ‰Àƒøu ¸ë^‰ö‹EPèÃåÿÿƒÄ‰Àƒøu ¸ëB‰öƒ}üt‹EPèÑåÿÿƒÄ‰Àƒøu¸ë ‹EPè“þÿÿƒÄ‰Àƒøu ¸ë‰ö1ÀëÉÃU‰å‹EPè0åÿÿ‰ì]ÃU‰å‹U‹E PRè<åÿÿ‰ì]ÃU‰åSè[à ‹U‹E PRjèÝåÿÿ‹]ü‰ì]ÃU‰åS»T¾ƒ=T¾ÿt‰ö‹ÿЃÃüƒ;ÿuô‹]üÉÃvU‰åÉÃU‰åSè[ëè?æÿÿ‹]ü‰ì]ÃH¯¼šò×z>{®Gáz„?@allkca_initialize: cannot get list 'all'coal_structkca_initialize: cannot get list 'coal_struct'kca_initialize: cannot split 'coal_struct'kca_initialize: cannot split 'coal_list[i]'lsearch $all %s*kca_initialize: cannot find agent in alllindex $all %dname_of_agent: cannot find agent in allkca_calculate_pc: cannot split 'coal_struct'kca_calculate_pc: cannot split 'coal_list[i]'kca_calculate_pc: cannot find agent in allkca_calculate_pc: cannot split 'payoff vector'kca_calculate_pc: corrupt 'payoff vector'kca_calculate_pc: cannot allocate memory for 'payoff vector'kca_calculate_pc: cannot allocate memory for 'payoff vector component'%-.10lfkca_value: cannot split argumentkca_value: cannot find agent in all%dkca_initializekca_get_coalskca_calculate_pckca_valuekca_timeskca_timeout_cmdglobal tcl_precision; set tcl_precision 14€VÀjøÀjøÀjøÀjøÀNÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀDÀjøÀjøÀjøÀDÀ4ÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀjøÀNÀjøÀ€VÀNÀjøÀjøÀNÀ>ÀNÀNÀÀbÀ^ÀjøÀjøÀ^À€VÀàfÀàfÀàtÀqÀ@YÀjøÀYÀTÀsÀ`nÀjøÀqÀ dÀjøÀdÀ@`Àü‰ÿÿÿÿÿÿÿÿô¾ˆÒˆâˆòˆ‰‰"‰2‰B‰R‰b‰r‰‚‰’‰¢‰²‰‰Ò‰â‰ò‰ŠŠ"Š2ŠBŠRŠbŠrŠ‚Š’Š¢Š²Š…òDgw’¤ €ˆ °¤è€D…D‚ # d¾x‡h‡¶Â d ¤d ¤1<@€b€t€›€´€Ò€€Z€x€š€·€Ó€å€ø€€>€Y€u€—€£€â€)€c€”€Æ€ €8€b€n€š€§€²€¾€Ì€Ø€*é€,ô€-ÿ€. €/€0!€1.€29€3E€4P€5]€:†€=“€>¡€?­€@º€BÇ€EÔ€T€W€Y€!*€"5€#>€$H€%R€&^€'i€*r€+{€,„€-Ž€.™€/¢€0¬€1µ€2¾€5É€:Ô€;à€?é€Nó€¦ý€J€K€L€g#€h0€i;€jH€kS€l`€mk€nx€p†€µ€-À€0Ë$ ¤Ö ÝDÝDÝD Þ@å$#0¤Ö "ð " ÝD#ÝD$ ÝD%Þ@"ø@"ÝdD¤dP¤"dP¤1<@€b€t€›€´€Ò€€Z€x€š€·€Ó€å€ø€€>€Y€u€—€£€â€)€c€”€Æ€ €8€b€n€š€§€²€¾€Ì€Ø€*é€,ô€-ÿ€. €/€0!€1.€29€3E€4P€5]€:†€=“€>¡€?­€@º€BÇ€EÔ€T€W€Y)€T€ˆ€»€ò€, €e €  $)P¤ª  (¶  ( ÝD)ÝD*ÝD+Ýdv¤bsd-compat.c/usr/src/bs/BUILD/glibc-2.0.7/misc/gcc2_compiled.int:t1=r1;-2147483648;2147483647;char:t2=r2;0;127;long int:t3=r1;-2147483648;2147483647;unsigned int:t4=r1;0;-1;long unsigned int:t5=r1;0;-1;long long int:t6=r1;01000000000000000000000;0777777777777777777777;long long unsigned int:t7=r1;0000000000000;01777777777777777777777;short int:t8=r1;-32768;32767;short unsigned int:t9=r1;0;65535;signed char:t10=r1;-128;127;unsigned char:t11=r1;0;255;float:t12=r1;4;0;double:t13=r1;8;0;long double:t14=r1;12;0;complex int:t15=s8real:1,0,32;imag:1,32,32;;complex float:t16=r16;4;0;complex double:t17=r17;8;0;complex long double:t18=r18;12;0;void:t19=19lconv:T20=s48decimal_point:21=*2,0,32;thousands_sep:21,32,32;\grouping:21,64,32;int_curr_symbol:21,96,32;currency_symbol:21,128,32;\mon_decimal_point:21,160,32;mon_thousands_sep:21,192,32;\mon_grouping:21,224,32;positive_sign:21,256,32;\negative_sign:21,288,32;int_frac_digits:2,320,8;\frac_digits:2,328,8;p_cs_precedes:2,336,8;p_sep_by_space:2,344,8;\n_cs_precedes:2,352,8;n_sep_by_space:2,360,8;\p_sign_posn:2,368,8;n_sign_posn:2,376,8;;locale_t:t22=ar1;0;5;23=*24=xslocale_data:__u_char:t11__u_short:t9__u_int:t4__u_long:t5__u_quad_t:t7__quad_t:t6__qaddr_t:t25=*6__dev_t:t7__uid_t:t4__gid_t:t4__ino_t:t5__mode_t:t4__nlink_t:t4__off_t:t3__loff_t:t6__pid_t:t1__ssize_t:t1__fsid_t:t26=s8__val:27=ar1;0;1;1,0,64;;__daddr_t:t1__caddr_t:t21__time_t:t3__swblk_t:t3__clock_t:t3__fd_mask:t5__fd_set:t28=s128fds_bits:29=ar1;0;31;5,0,1024;;__key_t:t1__ipc_pid_t:t9u_char:t11u_short:t9u_int:t4u_long:t5quad_t:t6u_quad_t:t7fsid_t:t26dev_t:t7gid_t:t4ino_t:t5mode_t:t4nlink_t:t4off_t:t3loff_t:t6pid_t:t1uid_t:t4ssize_t:t1daddr_t:t1caddr_t:t21key_t:t1time_t:t3size_t:t4ulong:t5ushort:t9uint:t4int8_t:t10u_int8_t:t11int16_t:t8u_int16_t:t9int32_t:t1u_int32_t:t4int64_t:t6u_int64_t:t7register_t:t1timespec:T30=s8tv_sec:3,0,32;tv_nsec:3,32,32;;fd_mask:t5fd_set:t28getpgrp:F1pid:p1pid:r1setpgrp:F1pgrp:p1pgrp:r1/usr/src/bs/BUILD/glibc-2.0.7/io/stat.cstat:T30=s88st_dev:7,0,64;__pad1:9,64,16;\st_ino:5,96,32;st_mode:4,128,32;st_nlink:4,160,32;\st_uid:4,192,32;st_gid:4,224,32;st_rdev:7,256,64;\__pad2:9,320,16;st_size:3,352,32;st_blksize:5,384,32;\st_blocks:5,416,32;st_atime:3,448,32;__unused1:5,480,32;\st_mtime:3,512,32;__unused2:5,544,32;st_ctime:3,576,32;\__unused3:5,608,32;__unused4:5,640,32;__unused5:5,672,32;;__stat:F1file:p31=*2buf:p32=*30GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.3GCC: (GNU) 2.7.2.301.0101.0101.0101.0101.0101.0101.0101.01.symtab.strtab.shstrtab.interp.hash.dynsym.dynstr.rel.got.rel.bss.rel.plt.init.plt.text.fini.rodata.data.ctors.dtors.got.dynamic.bss.stab.stabstr.comment.noteÔ€Ô#è€è\) D‚D1D…D#9 h‡hB p‡pK x‡x T€ˆ€,Z¬ˆ¬_ÀŠÀ èe°¤°$k̤Ì$usD¼D,yT¾T.€\¾\.‡d¾d.Œô¾ô.À•´¿´/$š´/”  H8 © B ² ªB JC¸H 5 ´PXÔ€è€D‚D…h‡p‡x‡€ˆ¬ˆ ÀŠ °¤ ̤ D¼ T¾\¾d¾ô¾´¿ ñÿ ‹ ñÿ x¤ &x¤ <X¾I ¤ TT¾ b`¾ñÿ ¨¤ ñÿ ‹ o‹ …\¾“,‹ TH¼ žT¾¬ñÿ 4‹ ¿Ì¤ ËÔ‘' ÜH¼ çñÿ P£ òñÿÿñÿ¼ˆÛ̈'L•µ #܈·>5¸¿:`‘q Eì‹# O|’I Q  Y¡ cô¾ñÿlT“÷ xìˆ@"~¨¤ñÿ…üˆ— ‰L ˆ‹A ªlŒr ²‰0"¹P¤& À,‰TÆP¾ Öпá´¿!ê<‰}ó´¿ý¬T L‰E\‰@#€ˆh) ¤ 1”ù Al‰"Hž{ V|‰D`Œ‰‹jü‘D sœ‰ˆÌ‹ ŠÀŠp ‘¬‰£¼‰k¬0¤ ´@’9 ¶̉8"»܉)Æ´¿ñÿÒP£ ×ì‰ßX‹. çü‰Qïp£® ûD¼  Š$|ž„ "°¤1 (Š(0,Š>7àŒR @<ŠƒRœ¥ a˜¢µ s ‘R P¤&" †0¢f –´¿ñÿLŠ¥d¾ñÿ»Ø¿ñÿÀ4‹  È\ŠÑlŠàÖ4` ߎ èÔ¿ó°Y üŒ\ ¢' |Š“"D¼ 'ŒŠ€3@‹ :œŠÃ"? NÈ’Š initfini.cgcc2_compiled.crtstuff.c__do_global_ctors_aux__CTOR_END__init_dummyforce_to_data__DTOR_END____do_global_dtors_aux__DTOR_LIST__fini_dummy__CTOR_LIST__coala_sixbus_kca.cbitcount.42first_is_biggestv_array.61agt_wish.cbsd-compat.cstat.cTcl_MergestrcpyCalc_pKs_PC__strtod_internalcoalba_dotprodba_togglexba_diffkca_value_DYNAMICK_Conditiontimes_etext__strtol_internalTcl_Initba_assignba_ul2bmalloc__statsleeptclDummyMathPtrn_of_coals_environTkX_Main__environname_of_agentTk_MainWindow__getpgid_initgetpgrpba_intersectioncallockca_get_coals__setpgidTclx_Initba_printTcl_SplitListba_value_start__libc_init_firstTkx_InitsetpgrpvforkTcl_GetVar__bss_startmainTk_Initba_copymatherrTcl_AppInitdata_startTcl_GetIntkca_calculate_pc_finisprintfatexitba_b2strTcl_CreateCommandkca_initializeIdeas_ActSrc_Initba_complementstatkca_timeout_cmd_edata__xstat_GLOBAL_OFFSET_TABLE__endba_initTcl_Evalexitba_countba_unionagent_listba_equalba_all_assignkca_timesfputs__data_startTcl_VarEvalba_newfree__gmon_start__next_coalideas/sources/uam_shortcutsFile.tcl100664 764 764 1023 6664742175 17064 0ustar javierjavierset uam_Shortcuts(cmd.save) {{hotkey s} {content {:TYPE command :COMMAND save :FILE {} {} {} {} {}}}} set uam_Shortcuts(cmd.handshake) {{hotkey h} {content {:TYPE command :COMMAND handshake :ADDRESS {} {} {} {} {}}}} set uam_Shortcuts(cmd.reset) {{hotkey r} {content {:TYPE command :COMMAND reset {} {} {} {} {} {}}}} set uam_Shortcuts(cmd.load) {{hotkey l} {content {:TYPE command :COMMAND load :FILE {} {} {} {} {}}}} set uam_Shortcuts(cmd.testcon) {{hotkey t} {content {:TYPE command :COMMAND testcon :ADDRESS {} {} {} {} {}}}} ideas/agt_sourceStdMesgRules.tcl100640 764 764 2363 6050144166 16321 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # agt_sourceStdMesgRules # # Just calls Tcl-Command 'source' to read the standard # Message-Rules from the file 'agt_stdMesgRules.tcl' in # a global variable 'agt_MesgRules'. # The global variable 'agt_VarStdMesgRuleNo' is set to the # number of read messages. # proc agt_sourceStdMesgRules {} { global agt_MesgRules agt_VarStdMesgRuleNo # read agents standard mesgRules in array agt_MesgRules # agt_puts "Reading Standard-Message-Rules..." 0 catch {unset agt_MesgRules} source agt_stdMesgRules.tcl set agt_VarStdMesgRuleNo [array size agt_MesgRules] agt_puts "OK, $agt_VarStdMesgRuleNo rules read.\n" } ideas/logfiles/ 40750 764 764 0 6675704736 12704 5ustar javierjavierideas/logfiles/UAM.PCJAVIER.0.log100664 764 764 206 6675704746 15454 0ustar javierjavierLogfile for User Agent Manager on Host 'PCJAVIER' created at Tue Mar 23 1999, 13:32:30 Logfile closed at Tue Mar 23 1999, 13:32:38 ideas/uam_aboutIdeas.tcl100640 764 764 11662 6526017020 14624 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_aboutIdeas # # This procedure displays a window with information about IDEAS. # # proc uam_aboutIdeas {} { global tk_priv # 1. Create the top-level window and divide it into top # and bottom parts. set w .dialog catch {destroy $w} toplevel $w -class Dialog wm title $w "About IDEAS" wm iconname $w Dialog wm minsize $w 460 565 wm maxsize $w 460 565 frame $w.top pack $w.top -side top -fill both -padx 5m -pady 5m frame $w.bot pack $w.bot -side bottom -fill both -expand yes # 2. Fill the top part with message. message $w.msg1 \ -text "IDEAS\n\nInteractive Development Environment\nfor Agent\ Systems\n\nVersion 1.0b, 1995\n\nComputer Science\ Department\nUniversity of Kiel, Kiel, Germany\n" \ -font -Adobe-Times-Medium-R-Normal-*-180-* \ -justify center pack $w.msg1 -in $w.top -side top -expand 1 -fill x message $w.msg2 \ -font -Adobe-Times-Medium-R-Normal-*-140-* \ -justify left pack $w.msg2 -in $w.top -ipadx 5m -expand 1 -fill both # 3. Create a button at the bottom of the dialog. button $w.button1 -text OK \ -command "set tk_priv(button) 1; destroy $w" \ -width 10 frame $w.default -relief sunken -bd 1 raise $w.button1 $w.default pack $w.default -in $w.bot -side left -padx 15m -pady 2m pack $w.button1 -in $w.default -padx 1m -pady 1m \ -ipadx 2m -ipady 1m bind $w "$w.button1 flash $w.button1 invoke" bind $w "$w.button1 flash $w.button1 invoke" button $w.button2 -text Copyright \ -width 10 pack $w.button2 -padx 15m -pady 1m \ -ipadx 2m -ipady 1m -in $w.bot -side right # 4. Withdraw the window, then update all the geometry information # so we know how big it wants to be, then place the window relative # to its parent and de-iconify it. uam_showAbout wm withdraw $w update idletasks set dad [winfo parent $w] if {([set dadX [winfo x $dad]] == 0) || ([set dadY [winfo y $dad]] == 0)} { set x 300 set y 200 } else { set x [expr $dadX + ([winfo reqwidth $dad] - [winfo reqwidth $w])/2] set y [expr round($dadY + [winfo reqheight $dad]*0.3)] } wm geom $w +$x+$y wm deiconify $w # 5. Set a grab and claim the focus too. catch {grab $w} set oldFocus [focus] focus $w # 6. Wait for the user to respond, then restore the focus and # return the index of the selected button. set tk_priv(button) -1 tkwait window $w grab release $w focus $oldFocus update idletasks } proc uam_showCopyright {} { .dialog.msg2 configure \ -text "Copyright (c) 1995 by\n\tMatthias Klusch, Olaf Scheew, Bernd\ Grossmann\n\tComputer Science Department,\n\tChristian-Albrechts-University\ of Kiel,\n\tOlshausenstr. 40, 24118 Kiel, Germany\n\n\nAll rights\ reserved.\nNo warranties will be given on any issues arising out\ of the use\nof this software product.\nPermission to use, copy, modify\ and distribute this software\nproduct for non-commercial purposes is\ hereby granted, provided that the above copyright notice appears in\ all copies and respective publications.\nAll commercial trades with\ this product outside the CAU Kiel\nwithout specific written prior\ permission are prohibited.\n" .dialog.button2 configure -text Back \ -command "set tk_priv(button) 2; uam_showAbout" } proc uam_showAbout {} { .dialog.msg2 configure \ -text "This tool has been developed within the FCSI-Project:\n'A\ federative agent system for a recognition of interdatabase\ dependencies' by Matthias Klusch.\n\nIt was implemented\ using Tcl/Tk and BinProlog by Olaf Scheew.\nThe Agent\ Specification Language ASL was designed by Bernd\ Grossmann.\n\nPlease take any further requests to\n\n\ \tDipl.-Inform. M. Klusch\n\ \tComputer Science Dept.\ \tCAU Kiel\n\ \tOlshausenstr. 40, 24118 Kiel\n\ \tGermany\n\n\ \tE-Mail: mkl@informatik.uni-kiel.d400.de" .dialog.button2 configure -text Copyright \ -command "set tk_priv(button) 2; uam_showCopyright" } ideas/uam_helloIdeas.tcl100640 764 764 6463 6526017035 14606 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # # # uam_helloIdeas # # This procedure displays the IDEAS startwindow. # # proc uam_helloIdeas {} { global tk_priv set lastchg "last change: 06/03/96" # 1. Create the top-level window and divide it into top # and bottom parts. set w .dialog catch {destroy $w} toplevel $w -class Dialog wm title $w "About IDEAS" wm iconname $w Dialog frame $w.top pack $w.top -side top -fill both -padx 5m -pady 5m frame $w.bot pack $w.bot -side bottom -fill both # 2. Fill the top part with message. label $w.bitmap -bitmap @questionbulb pack $w.bitmap -in $w.top -side top message $w.msg1 \ -text "IDEAS\n\nInteractive Development Environment\nfor Agent\ Systems\n\nVersion 1.0b, 1995\n\nComputer Science\ Department\nUniversity of Kiel, Kiel, Germany" \ -font -Adobe-Times-Medium-R-Normal-*-180-* \ -width 400 \ -justify center pack $w.msg1 -in $w.top -side top -expand 1 -fill x message $w.msg2 \ -text "\n Copyright (c) 1995 by\n\ Matthias Klusch, Olaf Scheew, Bernd Grossmann\n\ Computer Science Dept., Christian-Albrechts-University of Kiel,\n\ Olshausenstr. 40, 24118 Kiel, Germany\n\n\ \t\t$lastchg" \ -font -Adobe-Times-Medium-R-Normal-*-120-* \ -width 400 \ -justify left pack $w.msg2 -in $w.top -ipadx 5m -expand 1 -fill both # 3. Create a button at the bottom of the dialog. button $w.button1 -text OK \ -command "set tk_priv(button) 1; destroy $w" \ -width 8 frame $w.default -relief sunken -bd 1 raise $w.button1 $w.default pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m pack $w.button1 -in $w.default -padx 2m -pady 1m \ -ipadx 2m -ipady 1m bind $w "$w.button1 flash $w.button1 invoke" bind $w "$w.button1 flash $w.button1 invoke" # 4. Withdraw the window, then update all the geometry information # so we know how big it wants to be, then place the window relative # to its parent and de-iconify it. wm withdraw $w update idletasks set dad [winfo parent $w] if {([set dadX [winfo x $dad]] == 0) || ([set dadY [winfo y $dad]] == 0)} { set x 300 set y 200 } else { set x [expr $dadX + ([winfo reqwidth $dad] - [winfo reqwidth $w])/2] set y [expr round($dadY + [winfo reqheight $dad]*0.3)] } wm geom $w +$x+$y wm deiconify $w # 5. Wait for the user to respond, then restore the focus and # return the index of the selected button. set tk_priv(button) -1 tkwait window $w update idletasks } ideas/uam_shortcutsFile.tcl100640 764 764 1023 6675704746 15377 0ustar javierjavierset uam_Shortcuts(cmd.reset) {{hotkey r} {content {:TYPE command :COMMAND reset {} {} {} {} {} {}}}} set uam_Shortcuts(cmd.handshake) {{hotkey h} {content {:TYPE command :COMMAND handshake :ADDRESS {} {} {} {} {}}}} set uam_Shortcuts(cmd.save) {{hotkey s} {content {:TYPE command :COMMAND save :FILE {} {} {} {} {}}}} set uam_Shortcuts(cmd.testcon) {{hotkey t} {content {:TYPE command :COMMAND testcon :ADDRESS {} {} {} {} {}}}} set uam_Shortcuts(cmd.load) {{hotkey l} {content {:TYPE command :COMMAND load :FILE {} {} {} {} {}}}} ideas/COPYRIGHT100440 764 764 1206 5765340742 12456 0ustar javierjavier# # Copyright (c) 1995 by Matthias Klusch, Olaf Scheew, Bernd Grossmann # Computer Science Department, # Christian-Albrechts-University of Kiel, # Olshausenstr. 40, 24118 Kiel, Germany # # All rights reserved. # No warranties will be given on any issues arising out of the use # of this software product. # Permission to use, copy, modify and distribute this software # product for non-commercial purposes is hereby granted, provided # that the above copyright notice appears in all copies and # respective publications. # All commercial trades with this product outside the CAU Kiel # without specific written prior permission are prohibited. # ideas/.ideasXdefaults100640 764 764 1675 6052357670 14143 0ustar javierjavier!------------------------------------------------------------------------ ! ! .ideasXdefaults ! ! X-resource file for IDEAS ! !------------------------------------------------------------------------ ! The standard font for the application: *font :-adobe-helvetica-*-r-normal--12-120-75-75-p-70-iso8859-1 ! The font used in text widgets as standard: *Text.font :-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1 ! The normal background color: *background : bisque1 ! The normal foreground color: *foreground : black ! The background when a mouse will take an action: *activeBackground : bisque2 ! The foreground when the mouse is over an active widget: *activeForeground : black ! The Background of selected items *selectBackground : LightBlue2 ! The color of the selector indicator: *selectColor : red3 ! The through part of scales and scrollbars: *troughColor : bisque3 ! The background of scrollbars: *Scrollbar.background : bisque1 ideas/agt_prologServ.bp100664 764 764 435520 6664734406 14570 0ustar javierjavier¯$bin_cut°$cut? ?true¯fail°_B?true¯cwrite°_ ?B? ?true¯cnl°_B?true¯var°_ ?B? ?true¯nonvar°_ ?B? ?true¯integer°_ ?B? ?true¯atomic°_ ?B? ?true¯is_compiled°_ ?B? ?true¯+°_??J1 ?true¯-°_??J1 ?true¯*°_??J1 ?true¯mod°_??J1 ?true¯//°_??J1 ?true¯/°_??J1 ?true¯random°_J1 ?true¯get0°_J1 ?true¯put°_?J0 ?true¯less°_??J 0 ?true¯greater°_??J 0 ?true¯less_eq°_??J 0 ?true¯greater_eq°_??J 0 ?true¯arith_eq°_??J 0 ?true¯arith_dif°_??J0 ?true¯<<°_??J1 ?true¯>>°_??J1 ?true¯/\°_??J1 ?true¯\/°_??J1 ?true¯#°_??J1 ?true¯\°_??J1 ?true¯compare0°_??J1 ?true¯arg°_??J1 ?true¯setarg°_???J0 ?true¯change_arg°_???J0 ?true¯def°_???J0 ?true¯rm°_??J0 ?true¯set°_???J0 ?true¯val°_??J1 ?true¯lval°_??J1 ?true¯symcat°_??J1 ?true¯dcg_connect°_J1 ?true¯list2term°_?J 1 ?true¯term2list°_???J!1 ?true¯self_info°_J"1 ?true¯add_instr°_????J#0 ?true¯lift_heap°_??J$0 ?true¯det_append0°_??J%1 ?true¯copy_term°_??J&1 ?true¯bb_list0°_??J'1 ?true¯older_file°_??J(0 ?true¯seeing_telling°_?J)1 ?true¯see_tell°_??J*0 ?true¯seen_told°_?J+0 ?true¯seeing_telling_at°_?J,1 ?true¯see_tell_at°_??J-0 ?true¯string_op°_??J.1 ?true¯op0°_???J/0 ?true¯term_append°_??J01 ?true¯float_fun2°_???J11 ?true¯float_fun°_??J21 ?true¯input_float°_???J31 ?true¯write_float°_?J40 ?true¯strip_cont0°_?J51 ?true¯dcg_def°_?J60 ?true¯dcg_val°_J71 ?true¯dcg_tell°_?J80 ?true¯dcg_telling°_J91 ?true¯iso_open_stream°_??J:1 ?true¯iso_close_stream°_??J;0 ?true¯iso_write_term°_???J<0 ?true¯iso_read_term°_??J=1 ?true¯iso_put_byte°_??J>0 ?true¯iso_get_byte°_?J?1 ?true¯iso_peek_byte°_?J@1 ?true¯iso_eof°_?JA0 ?true¯iso_lseek°_???JB1 ?true¯bb_put°_??JC0 ?true¯bb_get°_???JD1 ?true¯bb_op°_??JE1 ?true¯setref°_??JF0 ?true¯unix_argc°_JG1 ?true¯unix_argv°_?JH1 ?true¯unix_getenv°_?JI1 ?true¯unix_access°_??JJ0 ?true¯unix_cd°_?JK0 ?true¯unix_kill°_??JL0 ?true¯quiet°_JM1 ?true¯create_engine°_???JN1 ?true¯destroy_engine°_?JO0 ?true¯load_engine°_???JP0 ?true¯ask_engine°_?JQ1 ?true¯multitask_engines°_?JR0 ?true¯suspend_engine°_?JS0 ?true¯new_builtin°_??JT1 ?true¯halt°_?JU0 ?true¯true°_ ?true¯call°_ ?true¯abort°_ ?true¯restart°_ ?true¯findall_store_heap°_ ?true¯findall_load_heap°_ ?true¯functor°_ ?true¯name°_ ?true¯shell°_ ?true¯stat0°_  ?true¯list_asm°_  ?true¯bb_reset°_  ?true¯profile°_  ?true¯if0°_  ?true±1000 xfy ,±1100 xfy ;±1200 xfx -->±1200 xfx :-±1200 fx :-±700 xfx is±700 xfx =±500 yfx -±500 fx -±500 yfx +±500 fx +±400 yfx /±400 yfx *±650 xfy .±660 xfy ++±700 xfx >=±700 xfx >±700 xfx =<±700 xfx <±700 xfx =\=±700 xfx =:=±300 fy ~±200 xfy ^±300 xfx mod±400 yfx >>±400 yfx <<±400 yfx //±500 yfx #±500 fx #±500 yfx \/±500 yfx /\±500 yfx \±500 fx \±700 xfx @>=±700 xfx @=<±700 xfx @>±700 xfx @<±700 xfx \==±700 xfx ==±700 xfx =..±700 xfx \=±900 fy not±900 fy \+±900 fx spy±900 fx nospy±1050 xfy ->±1050 xfx @@±1150 fx dynamic±1150 fx public±1150 fx module±1200 xfx ::-±900 yfx :±600 xfx :=:±950 xfy -:±950 xfy =>±600 xfx <=±700 xfx =:±700 xfx :=¯stat_dict°runtimeruntime0 ?true¯stat_dict°global_stackglobal_stack1 ?true¯stat_dict°local_stacklocal_stack2 ?true¯stat_dict°trailtrail3 ?true¯stat_dict°codecode4 ?true¯stat_dict°stringsstrings5 ?true¯stat_dict°symbolssymbols6 ?true¯stat_dict°htablehtable7 ?true¯stat_dict°bboardbboard8 ?true¯user_error°_ ? ? ? basic ? ?error_message¯errmes°_ ? ? ? pretty ? ?error_message¯error_message° _JM0?5J 01J)0 portray_error???$bin_cut?tell?fail? user ?tell¯quietmes°_JM0?4J 0?ttyprint¯quietmes°_ ?true¯portray_error°basicbasic ? >>> B? ?B? : B? ?B?B?true¯portray_error°prettypretty write?write: cnlportray_clause?? *** ?write¯member°_.?? ?true¯member°_.??member¯nth_member°_ ? ? 1 ?member_i¯member_i°_ ?.?? ?true¯member_i°_.???1J0member_i¯:°_module_call¯module_call°_ ? $bin_cut?call??is_public¯module_call°_ call?? ?module_predicate¯module_predicate° _ .?? module_name??? =..?4 ??3 .?? ? ?  ?=..¯module_name° _ ?B? ?B?? .?[] ? ?.58[] name?? det_append?4 ? ? name? ??3 .?? ?name¯module_name°_ ? .?.?[] should_be_nonvar ?user_error¯module°_ ? bb_letmodule_name??? current module_namebb_let¯module°_ member??public0?fail? ?module¯module°_ ?true¯current_module°_ $bin_cut?=??? current module_namebb_val¯current_module°useruser ?true¯is_module°_ ? ? ?B?? module_name ? ?bb_val¯is_module°_ bb_element4???3=4?>?3+4?/?03/module_name0 ? ?bb_list¯modules°_ ? ? is_module?findall¯hide_atom°_ $bin_cut?? ?hide_atom0¯hide_atom°_ ? ?true¯hide_atom0°_ $bin_cut?fail? usercurrent_module¯hide_atom0°_ $bin_cut?fail?is_public¯hide_atom0°_ module_predicate???? ? ?current_module¯public0° //?? current_module?bb_defpublic??$bin_cut?? ?functor¯public0°_ ? public? bad or repeated declarationerrmes¯public°,,??? public?? ?public¯public°_public0¯is_public°_ ? ?is_public¯is_public°_ ? $bin_cut?=??? public ? ?bb_val¯is_public°_ ?is_builtin¯init_gensym°_ ? ? gensym ? 0bb_let¯gensym°_ symcat???? ? ?gensym_no¯gensym_no°_gensym?J0??1J1gensym??J0 ?true¯gensym_no°_ ?1gensym??J0 ?true¯current_op°_ ? ? ?B?? ?get_op¯current_op° _ if4?4?4 ??3valopmark??3get_op???3 ,4 ?fail3 $bin_cut? ? 0 10000 ?for¯op°_???J/0 ?true¯get_op°_ get_op0????? ? ? ?op_type¯get_op0°_??J1??J1?0J 0 ?true¯op_type°xfyxfyinfixop ?true¯op_type°xfxxfxinfixop ?true¯op_type°yfxyfxinfixop ?true¯op_type°fxfxprefixop ?true¯op_type°fyfyprefixop ?true¯op_type°xfxfpostfixop ?true¯op_type°yfyfpostfixop ?true¯is_dynamic°_?$firstJ0 ?true¯is_assumed°_$assumed?J0 ?B? ?true¯spy_goal°_trace¯spying°_ yes ?spying?J1 ?true¯spy° //?? \+4?$bin_cut?bb_letspying?yes?3is_builtin? ?functor¯spy°_ ? ? unable_to_spy_on ?user_error¯nospy°//??? bb_rmspying?? ?functor¯is_builtin_nonvar°_ bu1? $bin_cut?? ? ?metacall¯is_builtin_nonvar°_ cont>? bu?>?? ?termcat¯is_builtin_var°_ bu1? ?metacall¯is_builtin_var°_ strip_cont??>?? ? ? ?bu¯is_builtin°_ ?B??is_builtin_nonvar¯is_builtin°_is_builtin_var¯interactive°_ ? ?B?? =?yes =?no is_interactiveif¯interactive°_ ?B?interactive0¯is_interactive°_ ? current_op1199fx?-\+¯interactive0°yesyes ? 1200 fx ?-op¯interactive0°nono ? 1199 fx ?-op¯expand_term°_portable_expand_term¯std_expand_term°_portable_expand_term¯strip_cont°_ -???J51 ?true¯metatrue°_ metacall??strip_cont¯metacall°_ ? meta_interpreter? call_ifdef?user_errorno meta_interpreter for undefined goal? ?call_ifdef¯otherwise°_true¯false°_B?true¯call_ifdef°_ ? ?B??call¯call_ifdef°_ ? ?call¯=°_ ? ?true¯->°_ $bin_cut?call?? ?call¯;°->->?? ? ?? ? ?if¯;°_ ?call¯;°_ ? ?call¯or°_ ?call¯or°_ ? ?call¯if°_ $bin_cut?call?? ?call¯if°_ ? ?call¯,°_ call?? ?call¯\+°_ $bin_cut?fail? ?call¯\+°_ ?true¯\=°_ ? ??B?true¯\=°_ ?true¯halt°_0JU0true¯repeat°_true¯repeat°_repeat¯findall_workhorse° _??J$0 findall_store_heap?? ? ?call¯findall_workhorse°_ ? ?findall_load_heap¯findall°_ ? .?? . 0findall_workhorse¯findall°_ ? []findall¯findall_conj°_ ? truefindall_conj¯findall_conj°_ ? ,?? , 0findall_workhorse¯findall_disj°_ ? failfindall_disj¯findall_disj°_ ? ;?? ; 0findall_workhorse¯while°_ if4?true4??3call?3,4?fail3$bin_cut? ? ?call¯skip_until°_ if4?fail4??3call?3$bin_cut? ? ?call¯skip_when°_ if4?failtrue?3call? ? ?call¯nth_answer°_?1J0 ? ?s? has_fuel?skip_until¯take_at_most°_ ? ?s? has_fuel?while¯drop_at_least°_ ? ?s? has_fuel?skip_when¯has_fuel°_1?J0?0J 0?1J01??J0 ?true¯find_while°_ while?? ? ? ? ?findall¯find_at_most°_ take_at_most?? ? ? ? ?findall¯all_but_at_least°_ drop_at_least?? ? ? ? ?findall¯all° _ findall4?4? ? share_vars ? ???3-? ?3call?  ? ?are_shared¯are_shared° _vars?? free_variables??[]?? [] ?free_variables¯share_vars°[][][] ?true¯share_vars°..??-?? ?.?? ?share_vars¯gc_read°_ ? read? .?[] ?findall¯gc_read_clause°_ ? read_clause? .?[] ?findall¯gc_call°_ call? member??? ?findall¯for°_ ???J 0 ?true¯for°_??J 0?1J0for¯argn°_ ?B????J1 ?true¯argn° _ for?1?arg???? ? ? ? ?functor¯numbervars°$VAR$VAR? ? ???1J1true¯numbervars°_ ?B?? ? ? ?true¯numbervars°..??? numbervars???? ? ?numbervars¯numbervars°_ numbervars0????? ? ? ?functor¯numbervars°_ ? ?? ? ?true¯numbervars° _?1J0??J0 numbervars?????? ?  ?numbervars¯ground°_ greater?0$bin_cut?fail? 0numbervars¯ground°_ ?true¯copy_term°_0?J&1 ?true¯save_term°_1?J&1 ?true¯flush°_2J+0true¯see_or_fail°_0?J*0 ?true¯exists_file°_ seen? ?see_or_fail¯sread°_0?J.1 ?true¯swrite°_1?J.1 ?true¯system°[][] ??true¯system°..??? .?? shell?? ?name¯system°_ ?B?shell¯.°_[] ?compile¯include°_compile¯compile°_ compile_mem?abort? ?find_file¯file_search_path°..[]?.??.??.?[].109?.121?.112?.114?.111?.103?.115?.47[] .46.46.47.115.114.99[] getenv_path4???3.112.114.111.103.115[] ?getenv_path¯file_extension_list°..??.??.[][].46?.112?.114?.111[].46?.112?.108[] ?true¯file_library°..?[].?[].46?.112?.108[] .46.46.47.108.105.98.114.97.114.121[] ?getenv_path¯getenv_path° _ ? ?.47[] unix_getenvBP_PATH? ,4 ? det_append ?? ?3 name? ? = ?[] det_append???det_append ???? ?  ?  ?if¯make_file_name° _ ? member ?? name? ? det_append ? ? ? det_append? ? ? name? ?? ? ?member¯statistics°_.??.?[] stat0???? ?stat_dict¯statistics°_ cwrite?cwrite=cwrite?cnlfail? ?statistics¯statistics°_true¯atom°_ ?B??B? ?true¯atom°_ ?B? ?true¯float°_ ?B? ? ?$float=? ?true¯number°_ ?B?? ?true¯number°_float¯compound°_ ?B? atomic? ?\+¯=..°_ ?B???J 1 ?true¯=..°_?.[]J!1 ?true¯term2list°_?.[]J!1 ?true¯term2dlist°_?.?J!1 ?true¯det_append°_ ->????J%1 ?true¯det_append°_ -????J%1 ?true¯appendN°_ ? []appendN¯appendN°[][] ? ?true¯appendN° ..?? ->???2?J%1appendN¯append_body°_ ? ?append_body¯append_body° _ det_append0??4 ? if4 ?4 ?4 ??3 compare0 ??=3 =??3 =..?.? . ? .?[]3 - ?? ? 2 ?functor¯append_conj° _ ? ,?? ,?? ?  ? trueappend_body¯append_disj° _ ? ;?? ;?? ?  ? failappend_body¯.°_.?? ?true¯++°_ -[]???J%1 ?true¯append°_ -???2?J%1 ?general_append¯general_append°[][] ? ?true¯general_append°..??.??general_append¯length°_ ? ? ?B?? 0 ?get_length¯length°_ ? ? 0 ?make_length¯get_length°[][] ? ?true¯get_length°..???1J0get_length¯make_length°[][] ? ??true¯make_length°..????J 0?1J0make_length¯tab°_ integer?$bin_cut?tab0?? ?expr¯tab°_ ? ? in tab/1: should evaluate to an integer ?user_error¯tab0°_ ? put32fail? ? 1for¯tab0°_ ?true¯get° _ get0?or4?4?$bin_cut?=???3greater?323less?0 ?repeat¯is°_ $bin_cut?=??? ? ? ?expr¯is°_ is?? error_in_is ?errmes¯expr°_ ?B?? ? ? ?true¯expr°_ $bin_cut?=??? ?float¯expr°_ ? ?B?? variable_in_is ?user_error¯expr° _ $bin_cut?arg1??arg2??expr??expr??=..?4 ? call?$bin_cut??3 . ?.?.?.?[]  ? 2functor¯expr° _ arg1??expr??=..?4? call?$bin_cut??3.?.?.?[] ? 1functor¯compare°_??J1 ?true¯+°_ ? ?true¯-°_0?J1 ?true¯\°_0?J1 ?true¯==°_ = ???J1 ?true¯\==°_??J0 ?$noteq¯@<°_ < ???J1 ?true¯@>°_ > ???J1 ?true¯@=<°_??J0 ?$lesseq¯@>=°_??J0 ?$gteq¯<°_ expr??less??? ?expr¯>°_ expr??greater??? ?expr¯=<°_ expr??less_eq??? ?expr¯>=°_ expr??greater_eq??? ?expr¯=:=°_ expr??arith_eq??? ?expr¯=\=°_ expr??arith_dif??? ?expr¯$lesseq°<< ?true¯$lesseq°== ?true¯$gteq°>> ?true¯$gteq°== ?true¯$noteq°<< ?true¯$noteq°>> ?true¯bb_def°_ def???? ? ?saved¯bb_set°_ set???? ? ?saved¯bb_val°_??J0 ? ?copy_term¯bb_rm°_??J0 ?true¯bb_change_arg° _ let???change_arg???? ? ? ?saved¯bb_let°_??J0?bb_set¯bb_let°_bb_def¯bb_def°_ ? ? ? ? ? ?bb_def¯bb_set°_ ? ? ? ? ? ?bb_set¯bb_val°_ ? ? ? ? ? ?bb_val¯bb_rm°_ ? ? ? ?bb_rm¯bb_let°_ ? ? ? ? ? ?bb_let¯bb_default_val°_ ? $bin_cut??bb_val¯bb_default_val°_ ? ?true¯saved°_ $bin_cut?=??? ?save_term¯saved°_ save_term??$bin_cut?=??? ?bb_gc¯saved°_ ? /saved2bb_fail¯saved°_ abort?restart¯let°_???J0? ?true¯let°_???J0 ?true¯def°_???J0 ?true¯set°_???J0 ?true¯val°_??J1 ?true¯let°_ ? ? ? ? ? ?let¯rm°_??J0 ?true¯#°_J1 ?true¯dcg_phrase°_ ? ? ? 1 ? ?dcg_phrase¯dcg_phrase° _J90?J80?J60 dcg_val[]dcg_tell?? ? ?call¯:=:°##?? ????J1true¯:=:°_??J1 ?true¯bb_gc°_31J'0 bb_resetbb_put_back?? ?copy_term¯bb_put_back°[][] ?true¯bb_put_back° ..??.??.??.??.? ? functor ???bb_put_1? ??bb_put_back ?? ?functor¯bb_put_1°_ set???$bin_cut?=??? ? ?save_term¯bb_put_1°_ +?? ? ?bb_fail¯bb_fail° _ .>?.?[] user_error4?4??3blackboard overflow, left only?3culprit? bboard ?statistics¯try_float° _.??.??integer?box??atom..??atom?? name ??input_float? ????try_float_exp¯try_float°_.??integer?box?? ?true¯try_float_exp°..??atome $bin_cut?? ?try_float_exp1¯try_float_exp°..??atom? ? .?[] ? ?.101[] .?? name??integer?$bin_cut?? ?name¯try_float_exp°_ ?0 ?true¯try_float_exp1° ..??.??integer?box??atom- ? ??0?J1true¯try_float_exp1° ..??.??integer?box??atom+ ? ? ?true¯float_minus°_ $float000??J1 ?true¯pow°_pow??J11 ?true¯log°_log??J11 ?true¯sqrt°_pow? $float00267911168?J11 ?true¯exp°_exp?J21 ?true¯log°_log?J21 ?true¯sin°_sin?J21 ?true¯cos°_cos?J21 ?true¯tan°_tan?J21 ?true¯atan°_T?J21 ?true¯asin°_S?J21 ?true¯acos°_C?J21 ?true¯integer°_integer?J21 ?true¯float°_ $float000??J1 ?true¯ctime°_ ? .?.>?[] runtimestatistics¯is_predicate°_ ?B?? ?true¯is_predicate°_ $bin_cut?? ?is_dynamic¯is_predicate°_is_assumed¯predicate_property°_ ?B??predicate_property0¯predicate_property° _ functor???predicate_property0??? ? ? ?generate_a_predicate¯predicate_property0°_ $bin_cut?or4?4??3=?dynamic3=?interpreted ?is_dynamic¯predicate_property0°_ $bin_cut?or4?4??3=?assumed3=?interpreted ?is_assumed¯predicate_property0°_built_in $bin_cut??is_builtin¯predicate_property0°_compiled ?B? ?true¯current_predicate°_ ?B?? functor??>?? ? ?is_predicate¯current_predicate°_ functor???? ?generate_a_predicate¯current_predicate°//?? ?B? ?B?? is_predicate?$bin_cut?? ?functor¯current_predicate°//?? ? ?generate_a_predicate¯predicate_key0°//$assumed0 ? ? ?B?true¯predicate_key0°_ ? ?/$first0true¯predicate_key0° //predmark0predmark ?/??/???0J 0?1J1true¯generate_a_predicate° _00J'0 =4??3+? ? predicate_key0? ??4??3/?? ? ?  ?bb_element¯help°_apropos¯apropos° _ apropos?? sort??member??write?cnlfail? ?findall¯apropos°_ ?true¯apropos° _-??/?? predicate_property ??functor ???name??near_match??? ?name¯near_match°_ ? ??true¯near_match°_ ? $bin_cut?? ? ?append3¯near_match° _ ? append3?4??? $bin_cut??3.>?? ?append3¯append3°_ append???? ? ?append¯unix_cd°_HOMEJI0?JK0true¯unix_argv° _ ? ?JG0?1J0 ,4?unix_argv??3for?1?findall¯unix°argcargc? ?JG1true¯unix°argvargv?unix_argv¯unix°getenvgetenv?? ? unix_getenv?? errmesno such environment variable? trueif¯unix°accessaccess?? ???JJ0true¯unix°cdcd? ??JK0true¯unix°cdcd ?unix_cd¯unix°killkill?? ???JL0true¯bu0°failfail?0in_body ?true¯bu0°cwritecwrite=?1in_body ?true¯bu0°cnlcnl?2in_body ?true¯bu0°varvar=?3in_body ?true¯bu0°nonvarnonvar=?4in_body ?true¯bu0°integerinteger=?5in_body ?true¯bu0°atomicatomic=?6in_body ?true¯bu0°is_compiledis_compiled=?7in_body ?true¯bu0°++=?in_body ?arith01true¯bu0°--=?in_body ?arith11true¯bu0°**=?in_body ?arith21true¯bu0°modmod=?in_body ?arith31true¯bu0°////=?in_body ?arith41true¯bu0°//=?in_body ?arith51true¯bu0°randomrandom=?in_body ?arith61true¯bu0°get0get0=?in_body ?arith71true¯bu0°putput=?in_body ?arith80true¯bu0°lessless=?in_body ?arith90true¯bu0°greatergreater=?in_body ?arith100true¯bu0°less_eqless_eq=?in_body ?arith110true¯bu0°greater_eqgreater_eq=?in_body ?arith120true¯bu0°arith_eqarith_eq=?in_body ?arith130true¯bu0°arith_difarith_dif=?in_body ?arith140true¯bu0°<<<<=?in_body ?arith151true¯bu0°>>>>=?in_body ?arith161true¯bu0°/\/\=?in_body ?arith171true¯bu0°\/\/=?in_body ?arith181true¯bu0°##=?in_body ?arith191true¯bu0°\\=?in_body ?arith201true¯bu0°compare0compare0=?in_body ?arith211true¯bu0°argarg=?in_body ?arith221true¯bu0°setargsetarg=?in_body ?arith230true¯bu0°change_argchange_arg=?in_body ?arith240true¯bu0°defdef=?in_body ?arith250true¯bu0°rmrm=?in_body ?arith260true¯bu0°setset=?in_body ?arith270true¯bu0°valval=?in_body ?arith281true¯bu0°lvallval=?in_body ?arith291true¯bu0°symcatsymcat=?in_body ?arith301true¯bu0°dcg_connectdcg_connect=?in_body ?arith311true¯bu0°list2termlist2term=?in_body ?arith321true¯bu0°term2listterm2list=?in_body ?arith331true¯bu0°self_infoself_info=?in_body ?arith341true¯bu0°add_instradd_instr=?in_body ?arith350true¯bu0°lift_heaplift_heap=?in_body ?arith360true¯bu0°det_append0det_append0=?in_body ?arith371true¯bu0°copy_termcopy_term=?in_body ?arith381true¯bu0°bb_list0bb_list0=?in_body ?arith391true¯bu0°older_fileolder_file=?in_body ?arith400true¯bu0°seeing_tellingseeing_telling=?in_body ?arith411true¯bu0°see_tellsee_tell=?in_body ?arith420true¯bu0°seen_toldseen_told=?in_body ?arith430true¯bu0°seeing_telling_atseeing_telling_at=?in_body ?arith441true¯bu0°see_tell_atsee_tell_at=?in_body ?arith450true¯bu0°string_opstring_op=?in_body ?arith461true¯bu0°op0op0=?in_body ?arith470true¯bu0°term_appendterm_append=?in_body ?arith481true¯bu0°float_fun2float_fun2=?in_body ?arith491true¯bu0°float_funfloat_fun=?in_body ?arith501true¯bu0°input_floatinput_float=?in_body ?arith511true¯bu0°write_floatwrite_float=?in_body ?arith520true¯bu0°strip_cont0strip_cont0=?in_body ?arith531true¯bu0°dcg_defdcg_def=?in_body ?arith540true¯bu0°dcg_valdcg_val=?in_body ?arith551true¯bu0°dcg_telldcg_tell=?in_body ?arith560true¯bu0°dcg_tellingdcg_telling=?in_body ?arith571true¯bu0°iso_open_streamiso_open_stream=?in_body ?arith581true¯bu0°iso_close_streamiso_close_stream=?in_body ?arith590true¯bu0°iso_write_termiso_write_term=?in_body ?arith600true¯bu0°iso_read_termiso_read_term=?in_body ?arith611true¯bu0°iso_put_byteiso_put_byte=?in_body ?arith620true¯bu0°iso_get_byteiso_get_byte=?in_body ?arith631true¯bu0°iso_peek_byteiso_peek_byte=?in_body ?arith641true¯bu0°iso_eofiso_eof=?in_body ?arith650true¯bu0°iso_lseekiso_lseek=?in_body ?arith661true¯bu0°bb_putbb_put=?in_body ?arith670true¯bu0°bb_getbb_get=?in_body ?arith681true¯bu0°bb_opbb_op=?in_body ?arith691true¯bu0°setrefsetref=?in_body ?arith700true¯bu0°unix_argcunix_argc=?in_body ?arith711true¯bu0°unix_argvunix_argv=?in_body ?arith721true¯bu0°unix_getenvunix_getenv=?in_body ?arith731true¯bu0°unix_accessunix_access=?in_body ?arith740true¯bu0°unix_cdunix_cd=?in_body ?arith750true¯bu0°unix_killunix_kill=?in_body ?arith760true¯bu0°quietquiet=?in_body ?arith771true¯bu0°create_enginecreate_engine=?in_body ?arith781true¯bu0°destroy_enginedestroy_engine=?in_body ?arith790true¯bu0°load_engineload_engine=?in_body ?arith800true¯bu0°ask_engineask_engine=?in_body ?arith811true¯bu0°multitask_enginesmultitask_engines=?in_body ?arith820true¯bu0°suspend_enginesuspend_engine=?in_body ?arith830true¯bu0°new_builtinnew_builtin=?in_body ?arith841true¯bu0°halthalt=?in_body ?arith850true¯bu0°truetrue?0in_head ?true¯bu0°callcall=?1in_head ?true¯bu0°abortabort?2in_head ?true¯bu0°restartrestart?3in_head ?true¯bu0°findall_store_heapfindall_store_heap=?4in_head ?true¯bu0°findall_load_heapfindall_load_heap=?5in_head ?true¯bu0°functorfunctor=?6in_head ?true¯bu0°namename=?7in_head ?true¯bu0°shellshell=?8in_head ?true¯bu0°stat0stat0=?9in_head ?true¯bu0°list_asmlist_asm=?10in_head ?true¯bu0°bb_resetbb_reset?11in_head ?true¯bu0°profileprofile?12in_head ?true¯bu0°if0if0=?13in_head ?true¯bu_ctr°n_inlinen_inline66 ?true¯bu_ctr°n_arithn_arith74 ?true¯bu_ctr°n_builtinn_builtin160 ?true¯bu_ctr°n_nopn_nop174 ?true¯bu1°!! ?true¯bu1°..=? ?true¯bu1°compilecompile? ?true¯bu1°includeinclude? ?true¯bu1°oror=? ?true¯bu1°ifif=? ?true¯bu1°strip_contstrip_cont=? ?true¯bu1°termcattermcat=? ?true¯bu1°add_contadd_cont=? ?true¯bu1°asmasm ?true¯bu1°asmasm? ?true¯bu1°=..=..=? ?true¯bu1°::-::-=? ?true¯bu1°statisticsstatistics ?true¯bu1°interactiveinteractive? ?true¯bu1°metacallmetacall? ?true¯bu1°metatruemetatrue? ?true¯bu1°expand_termexpand_term=? ?true¯bu1°===? ?true¯bu1°->->=? ?true¯bu1°;;=? ?true¯bu1°,,=? ?true¯bu1°repeatrepeat ?true¯bu1°\+\+? ?true¯bu1°\=\==? ?true¯bu1°findall_workhorsefindall_workhorse=? ?true¯bu1°findallfindall=? ?true¯bu1°findallfindall=? ?true¯bu1°findall_conjfindall_conj=? ?true¯bu1°findall_conjfindall_conj=? ?true¯bu1°findall_disjfindall_disj=? ?true¯bu1°findall_disjfindall_disj=? ?true¯bu1°allall=? ?true¯bu1°whilewhile=? ?true¯bu1°skip_untilskip_until=? ?true¯bu1°skip_whenskip_when=? ?true¯bu1°find_whilefind_while=? ?true¯bu1°nth_answernth_answer=? ?true¯bu1°take_at_mosttake_at_most=? ?true¯bu1°drop_at_leastdrop_at_least=? ?true¯bu1°has_fuelhas_fuel? ?true¯bu1°find_at_mostfind_at_most=? ?true¯bu1°all_but_at_leastall_but_at_least=? ?true¯bu1°forfor=? ?true¯bu1°argnargn=? ?true¯bu1°appendappend=? ?true¯bu1°membermember=? ?true¯bu1°det_appenddet_append=? ?true¯bu1°..=? ?true¯bu1°++++=? ?true¯bu1°lengthlength=? ?true¯bu1°make_cmdmake_cmd=? ?true¯bu1°numbervarsnumbervars=? ?true¯bu1°gc_callgc_call? ?true¯bu1°groundground? ?true¯bu1°atomatom? ?true¯bu1°floatfloat? ?true¯bu1°numbernumber? ?true¯bu1°compoundcompound? ?true¯bu1°appendNappendN=? ?true¯bu1°append_conjappend_conj=? ?true¯bu1°append_disjappend_disj=? ?true¯bu1°tabtab? ?true¯bu1°getget? ?true¯bu1°isis=? ?true¯bu1°exprexpr=? ?true¯bu1°comparecompare=? ?true¯bu1°=====? ?true¯bu1°\==\===? ?true¯bu1°@<@<=? ?true¯bu1°@>@>=? ?true¯bu1°@=<@=<=? ?true¯bu1°@>=@>==? ?true¯bu1°<<=? ?true¯bu1°>>=? ?true¯bu1°=<=<=? ?true¯bu1°>=>==? ?true¯bu1°=:==:==? ?true¯bu1°=\==\==? ?true¯bu1°++=? ?true¯bu1°--=? ?true¯bu1°\\=? ?true¯bu1°bb_defbb_def=? ?true¯bu1°bb_setbb_set=? ?true¯bu1°bb_valbb_val=? ?true¯bu1°bb_rmbb_rm=? ?true¯bu1°bb_letbb_let=? ?true¯bu1°bb_change_argbb_change_arg=? ?true¯bu1°letlet=? ?true¯bu1°bb_defbb_def=? ?true¯bu1°bb_setbb_set=? ?true¯bu1°bb_valbb_val=? ?true¯bu1°bb_rmbb_rm? ?true¯bu1°bb_letbb_let=? ?true¯bu1°dcg_phrasedcg_phrase=? ?true¯bu1°dcg_phrasedcg_phrase=? ?true¯bu1°:=::=:=? ?true¯bu1°##? ?true¯bu1°powpow=? ?true¯bu1°loglog=? ?true¯bu1°sqrtsqrt=? ?true¯bu1°expexp=? ?true¯bu1°loglog=? ?true¯bu1°sinsin=? ?true¯bu1°coscos=? ?true¯bu1°tantan=? ?true¯bu1°asinasin=? ?true¯bu1°atanatan=? ?true¯bu1°acosacos=? ?true¯bu1°integerinteger=? ?true¯bu1°floatfloat=? ?true¯bu1°statisticsstatistics=? ?true¯bu1°predicate_propertypredicate_property=? ?true¯bu1°current_predicatecurrent_predicate=? ?true¯bu1°current_predicatecurrent_predicate? ?true¯bu1°ctimectime? ?true¯bu1°helphelp? ?true¯bu1°aproposapropos? ?true¯bu1°aproposapropos=? ?true¯bu1°unixunix? ?true¯bu1°systemsystem? ?true¯bu1°meta_interpretermeta_interpreter? ?true¯bu1°tracetrace? ?true¯bu1°dynamicdynamic? ?true¯bu1°assertaasserta? ?true¯bu1°assertzassertz? ?true¯bu1°assertassert? ?true¯bu1°retractretract? ?true¯bu1°retractallretractall? ?true¯bu1°instanceinstance=? ?true¯bu1°eraseerase? ?true¯bu1°clauseclause=? ?true¯bu1°abolishabolish=? ?true¯bu1°debugdebug? ?true¯bu1°consultconsult? ?true¯bu1°reconsultreconsult? ?true¯bu1°listinglisting ?true¯bu1°listinglisting? ?true¯bu1°listinglisting=? ?true¯bu1°=>=>=? ?true¯bu1°assumeiassumei? ?true¯bu1°assumelassumel? ?true¯bu1°assumedassumed? ?true¯bu1°assumed_clauseassumed_clause=? ?true¯bu1°assumed_clauseassumed_clause=? ?true¯bu1°-:-:=? ?true¯bu1°is_assumedis_assumed? ?true¯bu1°is_dynamicis_dynamic? ?true¯bu1°bbbb ?true¯bu1°bbbb? ?true¯bu1°bb_listbb_list? ?true¯bu1°bb_elementbb_element=? ?true¯bu1°sortsort=? ?true¯bu1°keysortkeysort=? ?true¯bu1°bagofbagof=? ?true¯bu1°setofsetof=? ?true¯bu1°^^=? ?true¯bu1°free_variablesfree_variables=? ?true¯bu1°notnot? ?true¯bu1°term_charsterm_chars=? ?true¯bu1°vars_ofvars_of=? ?true¯bu1°user_erroruser_error=? ?true¯bu1°errmeserrmes=? ?true¯bu1°quietmesquietmes? ?true¯bu1°mainmain ?true¯bu1°mainmain? ?true¯bu1°topleveltoplevel ?true¯bu1°is_prologis_prolog? ?true¯bu1°get_codeget_code? ?true¯bu1°put_codeput_code? ?true¯bu1°nlnl ?true¯bu1°readread? ?true¯bu1°read_termread_term=? ?true¯bu1°top_read_termtop_read_term=? ?true¯bu1°warn_singletonswarn_singletons=? ?true¯bu1°read_with_singletonsread_with_singletons=? ?true¯bu1°read_clauseread_clause? ?true¯bu1°read_tokensread_tokens=? ?true¯bu1°writewrite? ?true¯bu1°printprint? ?true¯bu1°writeqwriteq? ?true¯bu1°portable_displayportable_display? ?true¯bu1°displaydisplay? ?true¯bu1°portrayportray? ?true¯bu1°portray_clauseportray_clause? ?true¯bu1°pp_clausepp_clause? ?true¯bu1°pp_termpp_term? ?true¯bu1°fast_writefast_write? ?true¯bu1°ttyinttyin? ?true¯bu1°ttyoutttyout? ?true¯bu1°ttyputttyput? ?true¯bu1°ttynlttynl ?true¯bu1°ttyprinttyprin? ?true¯bu1°ttyprintttyprint? ?true¯bu1°ttycwritettycwrite? ?true¯bu1°ttycwritelnttycwriteln? ?true¯bu1°seesee? ?true¯bu1°seeingseeing? ?true¯bu1°seenseen ?true¯bu1°telltell? ?true¯bu1°tellingtelling? ?true¯bu1°toldtold ?true¯bu1°see_atsee_at? ?true¯bu1°seeing_atseeing_at? ?true¯bu1°tell_attell_at? ?true¯bu1°telling_attelling_at? ?true¯bu1°file_search_pathfile_search_path? ?true¯bu1°file_extension_listfile_extension_list? ?true¯bu1°file_libraryfile_library=? ?true¯bu1°make_file_namemake_file_name=? ?true¯bu1°find_filefind_file=? ?true¯bu1°exists_fileexists_file? ?true¯bu1°see_or_failsee_or_fail=? ?true¯bu1°flushflush ?true¯bu1°sreadsread=? ?true¯bu1°swriteswrite=? ?true¯bu1°bu0bu0=? ?true¯bu1°bu1bu1? ?true¯bu1°current_opcurrent_op=? ?true¯bu1°opop=? ?true¯bu1°is_builtinis_builtin? ?true¯bu1°editedit=? ?true¯bu1°my_editmy_edit? ?true¯bu1°editedit ?true¯bu1°eded ?true¯bu1°textedittextedit ?true¯bu1°emacsemacs ?true¯bu1°picopico ?true¯bu1°notepadnotepad ?true¯bu1°vivi ?true¯bu1°coco ?true¯bu1°current_user_filecurrent_user_file? ?true¯bu1°lsls ?true¯bu1°dirdir ?true¯bu1°make_applmake_appl? ?true¯bu1°make_executable_unix_applmake_executable_unix_appl=? ?true¯bu1°makemake ?true¯bu1°makemake? ?true¯bu1°makemake=? ?true¯bu1°makemake=? ?true¯bu1°makemake=? ?true¯bu1°make0make0=? ?true¯bu1°cmakecmake ?true¯bu1°cmakecmake? ?true¯bu1°cmakecmake=? ?true¯bu1°kmakekmake ?true¯bu1°kcmakekcmake ?true¯bu1°tmaketmake ?true¯bu1°tmaketmake? ?true¯bu1°tmaketmake=? ?true¯bu1°ctracectrace ?true¯bu1°bootboot ?true¯bu1°add_trueadd_true=? ?true¯bu1°gc_readgc_read? ?true¯bu1°gc_read_clausegc_read_clause? ?true¯bu1°do_bodydo_body? ?true¯bu1°tr_bodytr_body=? ?true¯bu1°ith_clauseith_clause=? ?true¯bu1°char_in_cmdchar_in_cmd=? ?true¯bu1°show_code0show_code0=? ?true¯bu1°bu_ctrbu_ctr=? ?true¯bu1°patch_itpatch_it=? ?true¯bu1°lwritelwrite? ?true¯bu1°module_callmodule_call=? ?true¯bu1°modulemodule? ?true¯bu1°modulemodule=? ?true¯bu1°is_moduleis_module? ?true¯bu1°modulesmodules? ?true¯bu1°current_modulecurrent_module? ?true¯bu1°module_predicatemodule_predicate=? ?true¯bu1°module_namemodule_name=? ?true¯bu1°publicpublic? ?true¯bu1°is_publicis_public? ?true¯bu1°gensymgensym=? ?true¯bu1°init_gensyminit_gensym? ?true¯bu1°spy_goalspy_goal? ?true¯bu1°spyspy? ?true¯bu1°spyingspying? ?true¯bu1°nospynospy? ?true¯bu1°otherwiseotherwise ?true¯bu1°falsefalse ?true¯bu1°copy_termcopy_term=? ?true¯bu1°phrasephrase=? ?true¯bu1°phrasephrase=? ?true¯bu1°nth_membernth_member=? ?true¯bu1°member_imember_i=? ?true¯bu1°savedsaved=? ?true¯bu1°stat_dictstat_dict=? ?true¯bu1°set_c_thresholdset_c_threshold? ?true¯bu1°set_c_thresholdset_c_threshold=? ?true¯bu1°set_c_traceset_c_trace? ?true¯bu1°CC=? ?true¯bu1°halthalt ?true¯bu1°::=? ?true¯try_dcg_expansion°_ -->?? $bin_cut?? ? ? ?dcg_rule¯try_dcg_expansion°_ ? ? dcg expansion error-> ?errmes¯dcg_rule° -->-->?? dcg_body???? dcg_conj ??? =?4 ??3 :-??  ?dcg_head¯dcg_head° @@@@??true ?@@? ?? dcg_body? ????  ?dcg_body¯dcg_head°_true ? ? ?dcg_goal¯dcg_head° ,,??? dcg_body????? ? ?  ?dcg_goal¯dcg_head°_true ? ? ?dcg_goal¯dcg_goal°_? +???J01 ?true¯dcg_body°_ ?B?? ? ?phrase??? ?true¯dcg_body° ,,??? dcg_body?? ?? dcg_conj ????  ?  ? ?dcg_body¯dcg_body° ->->??->??? dcg_body????? ?  ?dcg_body¯dcg_body° ;;??;??? dcg_disj?????  ?dcg_disj¯dcg_body°{}{}? ? ? ??true¯dcg_body°!!! ? ??true¯dcg_body°[][]true ? ??true¯dcg_body° ..??? dcg_body?? ?? dcg_conj ????  ?  ? ?dcg_term¯dcg_body°_dcg_goal¯dcg_term°_C??? ?true¯dcg_disj° _ dcg_disj0?????? ? ?dcg_body¯dcg_disj0° _ = ???J1? =?? ? ? ? ?dcg_conj¯dcg_disj0°_ ? ? ?true¯dcg_conj°_true ? ??true¯dcg_conj°_dcg_CONJ¯dcg_CONJ°truetrue ? ??true¯dcg_CONJ°,,??,???dcg_CONJ¯dcg_CONJ°_,?? ?true¯C°..?? ? ? ?true¯phrase°_ ? []phrase¯phrase° _ =??=?? call?? ? ?dcg_body¯portable_expand_term°-->-->?? ? ?? ? ?try_dcg_expansion¯portable_expand_term°-->>-->>??? ? ?try_edcg_expansion??? errmesexpected_to_expand?call_ifdef¯portable_expand_term°_ ? ?true¯default_prolog°binprologbinprolog ?true¯peval_io°get_codeget_code? ?get0?true¯peval_io°put_codeput_code? ?put?true¯peval_io°nlnlcnl ?true¯peval_io°seeingseeing? ?seeing_telling0?true¯peval_io°tellingtelling? ?seeing_telling1?true¯peval_io°seeing_atseeing_at? ?seeing_telling_at0?true¯peval_io°telling_attelling_at? ?seeing_telling_at1?true¯peval_io°fast_writefast_write? ?cwrite?true¯fast_write°_ ?B? ?true¯get_code°_J1 ?true¯put_code°_?J0 ?true¯nl°_B?true¯see°_0?J*0? ?true¯see°_ ? ? unable_to_see ?user_error¯seeing°_0J)1 ?true¯telling°_1J)1 ?true¯tell°_1?J*0? ?true¯tell°_ ? ? unable_to_tell ?user_error¯seen°_0J+0true¯told°_1J+0true¯see_at°_0?J-0? ?true¯see_at°_ ? ? unable_to_see_at ?user_error¯tell_at°_1?J-0? ?true¯tell_at°_ ? ? unable_to_tell_at ?user_error¯seeing_at°_0J,1 ?true¯telling_at°_1J,1 ?true¯find_file° _ $bin_cut?file_search_path?file_extension_list?find_file1????? ?atom¯find_file° librarylibrary? $bin_cut?file_library??find_file1????? ?atom¯find_file°_ ? bad file name ?user_error¯find_file1° _ ? ? ? ? ?0J)0 ?  ?  ?  ?find_file2¯find_file2° _ $bin_cut? see?? ? ? ? ?see_a_file¯find_file2°_ findall ?4 ? ? findall ?4 ? ?errmes4?4??3file_not_found?3+4? ?3+ ??3 ,4 ? name ? ?3 member ??3 ,4 ? name ? ?3 member ?? ?see¯see_a_file° _ see_or_fail?seen? ?make_file_name¯read_clause°_ warn_singletons???? ?read_with_singletons¯read_with_singletons°_ singletons??? ?r_term¯warn_singletons° ..?? ? ?J M0 ?1J 0 .?? fail? ? ?warn_singletons1¯warn_singletons°_ ?true¯warn_singletons1°:-:-? ??true¯warn_singletons1°_ :-?>? seeing_telling_at0 ? melt_varnames? ttyout4 ? $bin_cut??3 ,4 ? ,4 ? ,nl ,4 ? ,4 ?,4?,nlnl3cwrite:-...3 print?3 print=> 3 print ** warning singleton_variables, byte=> ?3 print? ? ?add_true¯melt_varnames°[][] ?true¯melt_varnames°..??var???melt_varnames¯read°_ ? ?r_term¯top_read_term°_read_term¯read_term°_ r_vars??? ? ?r_term¯r_vars°[][][] ?true¯r_vars°..??var???.??=??r_vars¯singletons° _ ? ? member4??3var?>?s0 ? ?findall¯print°_portable_print¯write°_portable_write¯writeq°_portable_writeq¯ttyin°_0J)0 call?see?? user ?see¯ttyout°_1J)0 call?flushtell?? user ?tell¯ttyprin°_ write? ?ttyout¯ttyprint°_ ,4?nl3write? ?ttyout¯ttycwrite°_ cwrite? ?ttyout¯ttycwriteln°_ ,4?nl3cwrite? ?ttyout¯ttynl°_ ? nlttyout¯ttyput°_ put? ?ttyout¯display°_ portable_display? ?ttyout¯r_term°_ read_tokens??r_and_check??$bin_cut?=??? ?repeat¯r_and_check°_ ? all_read?? 1200 ?rt¯r_and_check°_ ?syntax_error¯all_read°[][] ??true¯all_read°_ ? ? .operator.expected.after.expression[] ?syntax_error¯expect°_.??? ?true¯expect°_ ? .?.or.operator.expected[] ?syntax_error¯prefixop°_ ? ? $bin_cut?? prefixop fy ?get_op0¯prefixop°_ ? -?1?? prefixop fx ?get_op0¯postfixop°_ ? ? $bin_cut?? postfixop yf ?get_op0¯postfixop°_ ? -?1?? postfixop xf ?get_op0¯infixop° _ ? ? $bin_cut? -?1?? infixop xfx ? ?get_op0¯infixop° _ ? ? $bin_cut? -?1?? infixop xfy ? ?get_op0¯infixop° _ ? ? -?1?? infixop yfx ? ?get_op0¯ambigop° _ infixop????? ? ?  ?postfixop¯rt°[][] ? .expression.expected[] []syntax_error¯rt° ..?? ? ? ? ? ?  ?  ?  ?rts¯rts°varvar??.(?? r_args ? ? ? $bin_cut? exprtl0 ?4 ?????3 apply?.? ? 999  ?  ?rt¯rts° varvar?? ?? ?exprtl0¯rts° atomatom-.??integer?box? ?0?J0?exprtl0¯rts° atomatom-.? ?atom? float_minus?? $bin_cut? exprtl0 ??????float¯rts°atomatom?.(?? r_args ? ? ? =.. ?4?$bin_cut?exprtl0 ? ?????3.?.? ? 999  ?  ?rt¯rts° atomatom? $bin_cut? after_prefix_op? ? ??????  ?  ? ?prefixop¯rts° atomatom? ?? ?exprtl0¯rts° integerinteger?box?? ?? ?exprtl0¯rts°[[.]?? []exprtl0¯rts° [[ ?? r_list ? ? ? $bin_cut? exprtl0 ?4 ?????3 .? ? 999  ? ?rt¯rts° (( ?? expect) ? ? $bin_cut? exprtl0 ? ????? 1200  ?  ? ?rt¯rts° (((( ?? expect) ? ? $bin_cut? exprtl0 ? ????? 1200  ?  ? ?rt¯rts°{{.}?? {}exprtl0¯rts° {{ ?? expect} ? ? $bin_cut? exprtl0 ?4 ?????3 {}? 1200  ? ?rt¯rts° stringstring? ?? ?exprtl0¯rts° _ ? .? .cannot .start .an .expression[] ?syntax_error¯r_args° ..,?.??? $bin_cut? r_args ???? 999 ?  ?rt¯r_args°..)?[] ? ??true¯r_args°_ ? ? .,).expected.in.arguments[] ?syntax_error¯r_list° ..,?.??? $bin_cut? r_list ???? 999 ?  ?rt¯r_list° ..|? ?? $bin_cut?expect]??? 999 ? ?rt¯r_list°..]?[] ? ??true¯r_list°_ ? ? .|].expected.in.list[] ?syntax_error¯after_prefix_op° _ ???J 0? .prefix .operator .? .in .context .with .precedence .?[]  ? ?syntax_error¯after_prefix_op° _ prefix_is_atom ?? exprtl ??????? ?  ?peepop¯after_prefix_op°_ =.. ?4 ? $bin_cut? exprtl ?? ?????3 .? . ?[] ? ?  ?  ?  ?rt¯peepop° ..??.(?atom? ?.??.(?atom??true¯peepop° ..??atom? ?.??infixop????infixop¯peepop°..??atom? ?.??postfixop???postfixop¯peepop°_ ? ?true¯prefix_is_atom°..??prefix_is_atom¯prefix_is_atom°infixopinfixop??=? ???J 0true¯prefix_is_atom°postfixoppostfixop??? ???J 0true¯prefix_is_atom°)) ?true¯prefix_is_atom°]] ?true¯prefix_is_atom°}} ?true¯prefix_is_atom°|| ?1100?J 0true¯prefix_is_atom°,, ?1000?J 0true¯prefix_is_atom°[][] ?true¯exprtl0°..? ?atom? $bin_cut? or4 ?4 ??3 exprtl4 ?0????3 .4 ? ?3 infixop? ? ? ?3 exprtl4 ?0????3 .4 ? ?3 postfixop???  ?  ?  ?ambigop¯exprtl0° ..??atom? $bin_cut? exprtl4 ?0?????3 .4 ??3 infixop????  ?infixop¯exprtl0° ..??atom? $bin_cut? exprtl4 ?0?????3 .4 ??3 postfixop???  ?postfixop¯exprtl0° ..,??1000J 0? $bin_cut? exprtl ?10004 ?????3 ,?? 1000  ? ?rt¯exprtl0° ..|??1100J 0? $bin_cut? exprtl ?11004 ?????3 ;?? 1100  ? ?rt¯exprtl0° ..?? $bin_cut? syntax_error4 ?4 ??3 .? .follows .expression[]3 .??cant_follow_expr¯exprtl0°_ ? ? ?true¯cant_follow_expr°atomatom?atom ?true¯cant_follow_expr°varvar=?variable ?true¯cant_follow_expr°integerinteger?integer ?true¯cant_follow_expr°stringstring?string ?true¯cant_follow_expr°((((bracket ?true¯cant_follow_expr°((bracket ?true¯cant_follow_expr°[[bracket ?true¯cant_follow_expr°{{bracket ?true¯exprtl°..??infixop? ? ? ?? ?J 0? ?J 0? =.. ?4?exprtl? ? ?????3.?.?.?[]  ? ?  ?rt¯exprtl°..? ?postfixop? ? ?? ?J 0? ?J 0? .?.?[] peepop ? ?exprtl ? ??????=..¯exprtl° ..,??1000J 0?1000J 0? $bin_cut? exprtl ?10004 ?????3 ,?? 1000  ?  ?rt¯exprtl° ..|??1100J 0?1100J 0? $bin_cut? exprtl ?11004 ?????3 ;?? 1100  ?  ?rt¯exprtl° _ ? ? ?true¯syntax_error°_0J)00J,0 start_syntax_error???see?fail? user ?see¯start_syntax_error° _B? display?display_list?length??bb_letsyntax_errorlength?$bin_cut?? ** SYNTAX ERROR: byte= ?display¯start_syntax_error°_ ?true¯syntax_error°_0J)0 finish_syntax_error?see?fail? user ?see¯finish_syntax_error°_syntax_errorlengthJ0 -???display_list??$bin_cut?? ?length¯display_list°..?? display_token?$bin_cut?display_list?? 32 ?ttyput¯display_list°[][] ?ttynl¯display_list°_0 $bin_cut?display_list?99999?  display¯display_list° ..?? ttyput32-?1?$bin_cut?display_list??? ?display_token¯display_list°[][] ?ttynl¯display_token°atomatom? $bin_cut?write_float?? ?float¯display_token°atomatom??display¯display_token°varvar???display¯display_token°integerinteger?box???display¯display_token° stringstring?? .?[] ? ?.34[] .?? .?[] name??display?? ?det_append¯display_token°_display¯read_tokens°_ append?[]?$bin_cut?=??=??? 32 ? ?r_toks¯read_tokens°..?[]atomend_of_file[] ?true¯r_toks°-1-1 ??B?true¯r_toks°_?32J 0?J0r_toks¯r_toks°3737? get0?is_terminator?$bin_cut?arith_dif?-1get0?r_toks????repeat¯r_toks°4747?J0r_solidus¯r_toks°3333.??atom!?J0r_after_atom¯r_toks°4040.((??J0r_toks¯r_toks°4141.)??J0r_toks¯r_toks°4444.,??J0r_toks¯r_toks°5959.??atom;?J0r_toks¯r_toks°9191.[??J0r_toks¯r_toks°9393.]??J0r_toks¯r_toks°123123.{??J0r_toks¯r_toks°124124.|??J0r_toks¯r_toks°125125.}??J0r_toks¯r_toks°4646?J0r_fullstop¯r_toks°3434.??string?? r_toks???? 34 ?r_string¯r_toks° 3939.??atom?? name??r_after_atom???? 39 ?r_string¯r_toks°_.??var?? $bin_cut? r_name? ? ? or4 ?4 ?$bin_cut?r_toks ????3 ,4 ?=?_3 = ? .95[]3 ,4 ? ,4 ?r_lookup????3 name? ?3 = ? .?>?  ?is_maj¯r_toks° _ $bin_cut?r_integer??? ? r_toks??? try_float ????? ?is_num¯r_toks° _.??atom? $bin_cut? r_name? ? ? name? ? r_after_atom ???? ?is_min¯r_toks° _.??atom?J0 name?4? r_after_atom????3.?? ?  ?r_symbol¯r_after_atom°4040.(??J0r_toks¯r_after_atom°_r_toks¯r_string° _ ? ? ? ?J0 ? ?  ?r_string¯r_string°-1-1-1 ttyput?displaytokenttyput?ttynl$bin_cut?fail? ! end of file in: display¯r_string° _ ? ? ??J0 ? ?more_string¯r_string°_.?? ? ? ?r_string¯more_string°_ ? ?.??? ? ? ?r_string¯more_string°_[] ? ?true¯patch_slash°..((? ?.(??true¯patch_slash°_ ? ?true¯r_solidus°4242?J0 r_toks???? ? ?r_solidus¯r_solidus° _.??atom? name?4? r_toks?? ? patch_slash ???3.47? ?r_symbol¯r_solidus°-1-1-1? ttynl? ! end_of_file in /*.. commentdisplay¯r_solidus°4242J0?47J0?r_solidus¯r_solidus°424232 ??true¯r_solidus°_J0r_solidus¯r_name° _.?? $bin_cut?get0?r_name????is_alpha_num¯r_name°_[] ? ?true¯r_symbol° _.?? get0?r_symbol????is_spec¯r_symbol°_[] ? ?true¯r_fullstop°-1-1? ttynlfail? ! end_of_file just after full_stopdisplay¯r_fullstop°_[]?32J 0? ?true¯r_fullstop° _.??atom? name?4? r_toks????3.46? ?r_symbol¯r_integer° _ ? ??48J0J 0 . ?[] ? ? .46[] =?4 ??3 . ? .??  ? ?  ?r_int¯r_int° -1-1 ??B?true¯r_int° 39390 ?.39?.?[]?J1?-1J0J1true¯r_int° 3939 $bin_cut?? 0 ?r_digits¯r_int° _ ? ? ? ? 10  ?  ?  ?r_digs¯r_digits°_ ? ? ? ? ? ?J0?-1J0 ?  ?  ?  ?  ?r_digs¯r_digs° _.? ??48J 0?57J 0???J 0 ?48J 0 ??J0 ? ? ?  ? ?r_digits¯r_digs° _ ? ?[] ?true¯r_lookup° ..??var??? ? ? ??r_varcount¯r_lookup°..??r_lookup¯r_varcount°_ .?[] ? ?.95[]? ? ?s1 ?true¯r_varcount°_ ?B?? ? ?s? ?true¯r_varcount°ss1 ?true¯is_alpha_num°_?97J 0?122J 0 ?true¯is_alpha_num°_?65J 0?90J 0 ?true¯is_alpha_num°_?48J 0?57J 0 ?true¯is_alpha_num°9595 ?true¯is_alpha_num°_is_latin1_min¯is_alpha_num°_is_latin1_maj¯is_maj°_?65J 0?90J 0 ?true¯is_maj°9595 ?true¯is_maj°_is_latin1_maj¯is_min°_?97J 0?122J 0 ?true¯is_min°_is_latin1_min¯is_num°_?48J 0?57J 0 ?true¯is_latin1_maj°_?192J 0?214J 0 ?true¯is_latin1_maj°_?216J 0?222J 0 ?true¯is_latin1_min°_?223J 0?246J 0 ?true¯is_latin1_min°_?248J 0?255J 0 ?true¯is_terminator°1010 ?true¯is_terminator°1313 ?true¯is_terminator°-1-1 ?true¯is_spec°3535 ?true¯is_spec°3636 ?true¯is_spec°3838 ?true¯is_spec°4242 ?true¯is_spec°4343 ?true¯is_spec°4545 ?true¯is_spec°4646 ?true¯is_spec°4747 ?true¯is_spec°5858 ?true¯is_spec°6060 ?true¯is_spec°6161 ?true¯is_spec°6262 ?true¯is_spec°6363 ?true¯is_spec°6464 ?true¯is_spec°9292 ?true¯is_spec°9494 ?true¯is_spec°9696 ?true¯is_spec°126126 ?true¯portable_display°_ ? displayw_out¯portable_print°_ ? printw_out¯portable_write°_ ? writew_out¯portable_writeq°_ ? writeqw_out¯w_out°_ fail? 1200 punct ?w_out¯w_out°_ ?true¯maybe_paren° _punct??J 0??J0 ?true¯maybe_paren°_ ? ?true¯maybe_space°punctpunct ??true¯maybe_space°_ ? ??32J0true¯maybe_space°quotequotealpha ??32J0true¯maybe_space°_ ?true¯put_string°[][] ?true¯put_string°..???J0put_string¯put_string°[][] ??J0true¯put_string°..?? ???J0?J0 ?put_string¯put_string°..???J0put_string¯w_variable°_ ?B? ?true¯portray°_write¯w_out° _alpha ?B?? w_variable?? ? alphamaybe_space¯w_out°$VAR$VAR? ? ? ??w_VAR¯w_out° _alpha ?B? ,4 ? maybe_space?other3 less?0 maybe_space?alpha $bin_cut? cwrite?? ?or¯w_out°_printalpha $bin_cut??portray¯w_out° _punct current_op ?>?? greater ?? $bin_cut? put40 or4 ?4 ? $bin_cut? put41?3 ,4 ? w_atom??punct>?3 =?writeq3 cwrite? ?atom¯w_out° _ $bin_cut? w_atom????? ?atom¯w_out° _displaypunct? w_atom?display?>? w_args0??40display? ?functor¯w_out° {}{}?punct?123J0 put125? 1200 punct ? ?w_out¯w_out° ..??punct?91J 0 w_tail??? 999 punct ?  ?w_out¯w_out° ,,??? w_out??999?>? put44 w_out??1000punct? maybe_paren1000?41??? 1000 ? 40 ?  ?maybe_paren¯w_out° _alpha or4?4 ? $bin_cut? write_float??3,4? maybe_space?other3less?03 maybe_space?alphafloat¯w_out° _ w_out ? ???????  ?  ? ?functor¯w_out°11 ,4 ? - ?1 ?3 current_op ?fx? ,4 ?= ? ?3 current_op ?fy? $bin_cut?maybe_paren ??40??w_atom????arg1??w_out?? ??? maybe_paren ??41???  ?  ?or¯w_out°11 ,4 ? - ?1 ?3 current_op ?xf? ,4 ?= ? ?3 current_op ?yf? $bin_cut?maybe_paren ??40??arg1??w_out?? ??? w_atom???? maybe_paren ??41???  ?  ?or¯w_out°22 ,4 ? ,4 ? = ? ?3 - ?1 ?3 current_op ?xfy? or4?,4?,4?= ? ?3- ?1 ?3current_op ?yfx?3,4?,4?= ? ?3- ?1 ?3current_op ?xfx? $bin_cut?maybe_paren ??40??arg1??w_out?? ??? w_oper? ???? arg2? ?w_out ?? ??? maybe_paren ??41???  ? ?or¯w_out° _punct w_args0??40?? ? ? ? ?w_atom¯w_oper° _?700J 0? ? ? ? ?w_atom¯w_oper° _ ?punct32J0 put32? punct ?w_atom¯w_VAR° _alpha ?B??0J 0? mod?26? +?65? put?or4?4 ? $bin_cut??3less?263 ,4 ?cwrite?3 //?26? ? alpha ?maybe_space¯w_VAR°_ $bin_cut?w_atom?write???atom¯w_VAR° _punct w_args014?40??3$VAR? $VAR ? ?w_atom¯w_atom°!!punct ??33J0true¯w_atom°;;punct ??59J0true¯w_atom°[][]punct ??91J093J0true¯w_atom°{}{}punct ??123J0125J0true¯w_atom°..writeqquote ?? .39.46.39[]put_string¯w_atom°_ or4?4 ? $bin_cut??3,4? ,4 ? put_string ?3 maybe_space??3classify_name ??3 or4 ?,4? put_string ?3=?alpha3 ,4 ?,4? ,4 ? ,4 ? put_string ?393 put393 maybe_space??3=?quote3 =?writeq  ? ?name¯classify_name°..??alpha $bin_cut?classify_alpha_tail??is_min¯classify_name°..??other classify_other_tail??is_spec¯classify_alpha_tail°[][] ?true¯classify_alpha_tail°..?? classify_alpha_tail?? ?is_alpha_num¯classify_other_tail°[][] ?true¯classify_other_tail°..?? classify_other_tail?? ?is_spec¯w_args° _ ? ??41J0true¯w_args° _?J0?1J0??J0 w_args???44?? ? 999 punct ?  ?w_out¯w_tail°_ ?B??124J0 put93?w_variable¯w_tail°[][] ??93J0true¯w_tail° ..???44J 0 w_tail??? 999 punct ?w_out¯w_tail° _124J0 put93? 999 punct ?w_out¯pp_term°_ write?cnlfail? 0 ?numbervars¯pp_term°_ ?true¯pp_clause°_portray_clause¯portray_clause°_ fail? ?pp_clause0¯portray_clause°_ ?true¯pp_clause0°:-:-??B? l_clauses?028? 0 ?numbervars¯pp_clause0°:-:-?? +?? portable_writeq?l_clauses?028$bin_cut?? 0 ?numbervars¯pp_clause0°_ :-?true ?pp_clause0¯l_clauses° ,,??? $bin_cut? l_clauses?1??? 1 ?l_clauses¯l_clauses° truetrue2 ?? .?[] ? ?.46[]?J0B?true¯l_clauses° ;;??? l_magic4 ?02? l_magic_nl?.?3 ;?? fail ?  ?l_magic¯l_clauses° ->->??? $bin_cut? l_clauses?5??? 5 ?l_clauses¯l_clauses° _ portable_writeq?l_magic_nl?.? ? ?l_magic¯l_magic°!!0 ?? :- B?true¯l_magic°!!1 ?? , B?true¯l_magic°_0 ? ?? :- B?B?tab¯l_magic°_1 ? ?? .?[] ? ?.44[]?J0B?tab¯l_magic°_3 ?? ( B?true¯l_magic°_4 ?? ; B?true¯l_magic°_5 ? ?? ->B?B?tab¯l_magic°_ ? cwrite:- cwrite?cnltab??atom¯l_magic_nl°22 ?? ?B?B?true¯l_magic_nl°_ ?true¯l_magic° ;;??? $bin_cut? l_magic?1??? 1 ?l_magic¯l_magic° _?8J0?3J0 cnl tab? l_magic2?)? 1 ? ?l_clauses¯l_magic2°22 ?? ?B?true¯l_magic2°_ ?true¯compile_binary°_cc_bincomp¯compile_builtins°_cc_builtins¯cc_must_have_builtins°wamwam ?true¯cc_must_have_builtins°cc wam.hc_chunk_file¯cc_builtins°_ bin_builtin?cc_bincomp??fail? ?cc_must_have_builtins¯cc_builtins°_ ?true¯cc_bincomp°binbin ?? fail?portray_clause¯cc_bincomp°asmasm cnlportray_clause?cnlfail? BINARY: ?write¯cc_bincomp°_ cc_compile_clause??gg_emit??$bin_cut?? ?newpred¯cc_bincomp°_ failing_to_compile_clause? ?errmes¯bin_builtin°:-:-??true?$bin_cut??cutp¯bin_builtin°_ bu_body???? ? ?bu¯bu_body°in_headin_head ?:-??true? arg???? ? ?functor¯bu_body°in_bodyin_body ?:-??true¯cc_compile_clause°_ ?.??.??.?[]cc_clause¯firstarg°_1?J0classif_first¯classif_first°_ ?B?? ? ?/?0 ?true¯classif_first°_ ?B?? ? ?/_0 ?true¯classif_first°_ ?/??functor¯cc_clause°_.??.?[]iifirstarg?? ?iiclause?? ?. ?[] iiexecute? ? ? :-?? firstarg??cc_h_b?4??4?getput?max ? ??+?1?vars??functor?dict?fill_info??collapse_args?1?allocate_regs?4?4??3-4?[]3/??3-4?>?3/? ?3/? ?3/ ? ?  ?add_true¯cc_h_b°_/ ? ?/ ? ? / ? ? -4 ??3 /? ? -4??3/?? cc_b?4?4?4?$bin_cut??3/ ? ?3-4??3/??3-4?[]3/? ?  ?cc_h¯begin_chunk° _ ? iic_chunk>?4??3len? hidden_var4 ? ???3 +?? ?  ?emit¯end_chunk° _ ? iic_chunk>?4??3len? hidden_var4 ? ???3 +?? ?  ?emit¯emit°_-??.??-?? ?true¯get_mode°_ ? ? ?-??/?? ?true¯set_mode° _-??/??-??/?? ?true¯hidden_var°_ ? ? ?-??/?? ?true¯cc_h°_cc_h0¯cc_b° _ end_chunk??? ? ?cc_b0¯cc_h0° _/?? $bin_cut? functor???arg???emit4?? ? begin_chunk ???3iibuiltin??? in_head  ?bu¯cc_h0° _/?? greater?0 $bin_cut? functor ??? emit_head_top_term?? ???? ? ?functor¯cc_h0°_ ? ? ? unexpected_head_atom ?errmes¯emit_head_top_term°_ ? ? ? cc_top_arg11 ? ? ? ?begin_chunk ? ?emit_top_args2? ? ? ? ?cc_top_arg2? ? ? ??? 1 1  ?  ?  ?  ?emit_top_args¯cc_b0°_ ?B?? true? ?cc_b0¯cc_b0°truetrue ? ?/true0?true¯cc_b0° $bin_cut$bin_cut??? iiput>?4 ??3 cutarg1 cc_b0????? ? ?  ?emit¯cc_b0° ==???? cc_b0????? ? ?  ?cc_eq¯cc_b0° _ $bin_cut?cc_builtin?????? ? in_body ?bu¯cc_b0° _/?? greater?0 $bin_cut? functor ??? emit_body_top_term?? ???? ? ?functor¯cc_b0°_ ? ? ? unexpected_body_atom ?errmes¯emit_body_top_term° _ ? ? ? $bin_cut? emit_top_args1? ?? ??? 1 ?  ?  ?  ?cc_top_arg¯cc_eq° _ ? ? ?B? ?B?? ?cc_eq1¯cc_eq°_cc_eq1¯cc_eq1°_ =?? emit4 ? ? ? emit4 ? ? ?set_modeget ? ?cc_top_t4? ? ?set_modeput ???3=??3 iiget>?4 ??3 temp03 iiput>?4 ??3 temp0 ? ?  ?  ?cc_top_t¯out_reg°000 ?true¯out_reg°11 ? ?true¯cc_builtin°aritharith?? ?? arg ?? ? - ?1 ?arg ???out_reg???- ?? ?functor?? ?handle_constant_res?4???emit_top_bargs1 ?????emit4??? cc_b0 ?????3iiarith>???3=??  ?  ?functor¯cc_builtin°_ - ?1 ? arg ?? ? arg1? ? cc_b_args ? ?? ? emit4 ? ? ? cc_b0 ?? ???3 iiinline>??>? ? ?  ? ?functor¯handle_constant_res°00 ? ??true¯handle_constant_res° 11 ? ?=?? ?B ?? ? ?true¯handle_constant_res° 11=?? ?B ?? iiput>?4 ??3 temp0 emit4? ???3iiget>?4??3temp0 ?  ?  ?emit¯handle_constant_res° 11=??? =?? ? ? ?cc_top_t¯classif_load° _ ? ?B?? ? ? ?true¯classif_load° _constant ? ?B?? ? ? ?true¯classif_load° _ ? =?? ? ? ?cc_top_t¯cc_b_args°00 ? ?true¯cc_b_args° 11 =?? emit4 ? ???3 iiput>?4 ??3 temp0 ?  ? ?cc_top_t¯emit_top_bargs° _ ???J 0? ?true¯emit_top_bargs°_??J 0?1J 0??J 0??J 0 emit4 ???emit_top_bargs ???????3 iiload?? ?  ?  ? ? ?  ?classif_load¯emit_top_bargs° _??J 0??J 0??J 0? = ? ? +?1 ? emit_top_bargs ???????  ? ?  ?cc_top_t¯emit_top_args° _ ???J 0? ?true¯emit_top_args°_??J 0??J 0??J 0 $bin_cut? get_mode ?? ?emit4? ? ?+?1?emit_top_args???? ???3ii ??4 ? ?3 arg?  ?  ?  ?classif_arg¯cc_top_arg° _ ???J 0? ?true¯cc_top_arg° _??J 0??J 0??J 0?1J 0? = ? ? cc_top_arg ??????? ?  ?cc_top_t¯cc_top_t° ==?? ? ? ?B?? ? ?true¯cc_top_t° ==?? ? ? ?B?? ? ?true¯cc_top_t° ==?? greater?0 $bin_cut? functor ? ?? emit_top_structure? ??? ??? cc_args? ?????  ? ? ?functor¯emit_top_structure°_ emit4 ? ? ?emit_args??? ???3 ii ?structure4 ??3 /??  ? ?  ?  ?get_mode¯cc_arg° _ ???J 0? ?true¯cc_arg° _??J 0??J 0??J 0?1J 0? = ? ? cc_arg ??????? ?  ?cc_t¯cc_t° ==?? ? ? ?B?? ? ?true¯cc_t° ==?? ? ? ?B?? ? ?true¯cc_t° ==?? greater?0 $bin_cut? functor ? ?? emit_structure? ??? ??? cc_args? ?????  ? ? ?functor¯cc_args° _?1J 0??1J0??J 0??J 0 = ? ? cc_arg1?????? ?  ?cc_t¯cc_args°_ ? ? ? ? ? ? 1 ?  ?  ?  ?  ?cc_arg¯emit_structure°_ deep_structure_op ? ? emit4 ???emit_args??????3 ii ?structure4 ??3 /??  ? ? ?  ?get_mode¯emit_args°_ ? ? ? ? ? ? 1 ?  ?  ?  ?  ?emit_args0¯emit_args0° _ ???J 0? ?true¯emit_args0°_??J 0??J 0??J 0 $bin_cut? get_mode ?? ?emit4? ? ?unify_op ? ??+?1?emit_args0???? ???3ii?? ? ?  ?  ?  ?classif_arg¯unify_op°getgetunify ?true¯unify_op°putput ? ? ?deep_var_op¯deep_var_op°_push $bin_cut??compound¯deep_var_op°_write ?true¯deep_structure_op°getgetget ?true¯deep_structure_op°putputpush ?true¯classif_arg°_ ?B?? ? ? ?true¯classif_arg°_constant ?B?? ? ? ?true¯classif_arg°_ ?true¯max°_??J 0? ? ? ?true¯max°_ ? ?true¯add_true°:-:-?? ?:-???true¯add_true°_:-?true ?true¯vars°_ call?? ? truefind_occurrences¯find_occurrences°[][][] ? ?true¯find_occurrences° ..??ii?? ??. ? ? ii?? ?? find_occurrences? ? ???  ?  ?occurrence¯occurrence°_ ? ? ?B?? ?true¯occurrence° _ ? ? ?var ?? ?B ?? ? ? $OCC ?? 1 ?  ?newvar¯occurrence°$OCC$OCC?? ? ?var???oldvar¯occurrence° _ ? ? at4? =occ?3=var? bad_occurrence ?errmes¯oldvar°_/?? ? ?=???1J11??J0 ?true¯newvar° _,?? ? ? =?? ? ? /?? ?true¯fill_info°_ ? 0 ?fill_all¯tpoint°_ ??1J1 ?true¯fill_all°[][] ? ?true¯fill_all° ..?? fill_one??? ? fill_all?? ??? ?fill_var_type¯fill_var_type°iiii????var?? ? ?B?? ?get_var_type¯fill_var_type°_ ?true¯get_var_type°//11unifyvoid ??true¯get_var_type°//11writevoid ??true¯get_var_type°//1?variable ??true¯get_var_type°//??value ???J 0?true¯fill_one° iiii?constant??arg?? mark_arg???4???3var4?/113->?/?? ? ?  ?tpoint¯fill_one°iiii?constant=? ? ? ?? ?tpoint¯fill_one° iiii????arg?? mark_arg?????mark_var??? ? ?  ?tpoint¯fill_one° iiii=??var?? ? ?? mark_var?4 ??3 var??tpoint¯mark_arg° getget ? -4 ? /?>?3 *?>???J1true¯mark_arg° putput ? -4 ? />??3 *>????J1true¯mark_var°_var??/11-??/??? ?true¯mark_var°_var??/1?-??/??1?J 0? ?true¯mark_var°_var??/??-??/??1?J 0? ?true¯mark_var°_ ?var??/=?-??/=?true¯collapse_args°_ ???J 0?true¯collapse_args° _??J 0??J0 +?1? collapse_args???? ? ? ?collapse_them¯default°//?? set_to99999?? 0 ?set_to¯set_to°_ ? ??true¯set_to°_ ?true¯collapse_them° _-??*??var??-??var? ?-? ? default? default? check_lifetimes4 ?4 ?4 ??3 -? ?3 -??3 -??  ?default¯check_lifetimes°--??-??-?? check_var_var??check_var_arg??$bin_cut??check_var_arg¯check_lifetimes°--??-?? $bin_cut??check_var_arg¯check_lifetimes°_-??-?? $bin_cut??check_var_arg¯check_lifetimes°_ ?true¯check_var_var°//?? ?/????J 0?true¯check_var_var°//?? ?/????J 0true¯check_var_arg° //?? ?/????J 0??J 0true¯allocate_regs°[][] ? ??true¯allocate_regs°..?? allocate_regs???? ? ?allocate1¯allocate1° iiii=??var??-?? ? ? $bin_cut?? ? ?  ?allocate_reg¯allocate1°_ ? ?true¯allocate_reg° _/11 ?B?? free_reg???? ? ? ?get_reg¯allocate_reg° _/1? ?B?1?J 0? ? ? ?get_reg¯allocate_reg°_/??1?J 0? ? ? ?free_reg¯free_reg° _-??/??- ? ? .?? /????J 0? ?true¯free_reg°_ ? ?true¯get_reg° _-??.??/??- ?? /??? ?true¯get_reg° _-??/??-??/???1J1 ?true¯mdef_to_def°:-:-??:-?? repl_body??? ?hide_atom¯mdef_to_def°:-:-?:-? $bin_cut?call?fail? ?repl_body¯repl_body°_call? ?B?? ?true¯repl_body°_ $bin_cut?? ?repl_macro¯repl_body°_ $bin_cut?strip_nil??? ? ?split_op¯repl_body°_ peval_io??$bin_cut?? binprolog ?is_prolog¯repl_body°_ $bin_cut?=?4?ttyprint4??3spying_on?3spy_goal? ?spying¯repl_body°_hide_atom¯is_prolog°_ $bin_cut?=??? is prologbb_val¯is_prolog°_default_prolog¯cutp°_ ? .36.99.117.116[]name¯repl_macro°!!$bin_cut? ?cutp¯repl_macro°varvar? ?B? var?repl_known¯repl_macro°nonvarnonvar? ?B? nonvar?repl_known¯repl_macro°atomicatomic? ?B? atomic?repl_known¯repl_macro°floatfloat? ?B? float?repl_known¯repl_macro°atomicatomic? ?B? atomic?repl_known¯repl_macro°,,?? ? ? ? ?repl_conj¯repl_macro°;;?? ? ? ? ?repl_disj¯repl_macro°->->??->?? repl_body??? ?repl_body¯repl_macro°comparecompare??? ?compare0???true¯repl_macro°====?? ?compare0??=true¯repl_macro°@<@<?? ?compare0??<true¯repl_macro°@>@>?? ?compare0??>true¯repl_macro°:=::=:?? ?lval???repl_lval¯repl_macro°##? ?dcg_connect?true¯repl_macro°::?? ?module_call??true¯repl_macro°findallfindall???findall???repl_body¯repl_macro°bagofbagof???bagof???repl_body¯repl_macro°setofsetof???setof???repl_body¯repl_macro°allall???setof???repl_body¯repl_macro°^^??^??repl_body¯repl_macro°callcall?repl_body¯repl_macro°\+\+?\+?repl_body¯repl_macro°notnot?not?repl_body¯repl_conj° _ ?B? $bin_cut?repl_body??app_body???? ?split_op¯repl_conj°_,?? repl_body??? ?repl_body¯repl_disj° _if??? ?B ? ? ? ->? ?? repl_body ??repl_body??? ?repl_body¯repl_disj°_or?? repl_body??? ?repl_body¯repl_lval°##?? ? ? ??true¯repl_lval°_ ? ? ?true¯repl_known°_true $bin_cut??call¯repl_known°_fail ?true¯split_op°isis?? ? ? ? ?split_is_rel¯split_op° <<?? ? ? less ? ?split_rel¯split_op° >>?? ? ? greater ? ?split_rel¯split_op° =<=<?? ? ? less_eq ? ?split_rel¯split_op° >=>=?? ? ? greater_eq ? ?split_rel¯split_op° =:==:=?? ? ? arith_eq ? ?split_rel¯split_op° =\==\=?? ? ? arith_dif ? ?split_rel¯split_is_rel°_.?[]expr?? ?B?? ?true¯split_is_rel°_.?[]+?0? ?B?? ?true¯split_is_rel°_.?[]+?0? $bin_cut?? ? ?float¯split_is_rel° _.?[]+?0? ground?$bin_cut?expr??? binprolog ?is_prolog¯split_is_rel°_ ? []split_is¯app_body°[][] ? ??true¯app_body°..??,??app_body¯strip_nil°..?[] ? ??true¯strip_nil°..??,??strip_nil¯split_rel°_ ? []split_rel_1¯split_rel_1°_ split_is ?? ? ? =.. ?4 ?emit_is ? ???3 .? .? . ?[] ?  ? ?split_is¯split_is°_ ? ?B?? ? ? ?true¯split_is°_ ? ?B?? ? ? ?true¯split_is° _ ? $bin_cut?=??? ? ?float¯split_is°_ .? . ? . ?[] $bin_cut? split_is ? ?? ? split_is ? ? ? ? =.. ?4?emit_is ? ???3.?. ? . ? .?[] ? ?  ?=..¯split_is°_ .? . ?[] split_is ? ?? ? =.. ?4 ?emit_is ? ???3 .?. ? .?[] ? ?  ?=..¯emit_is°_.?? ?true¯def_to_mbin°:-:-?? ? ?? ? ?def_to_mbin0¯def_to_mbin°_ ? ? true ?def_to_mbin0¯def_to_mbin0° @@@@??:-?? ?B?? add_upper_cont????? ?termcat¯def_to_mbin0°_:-?? add_cont???? ?termcat¯add_upper_cont° _ ?B?? add_cont???? ? ? ?add_cont¯add_upper_cont° _ ,4??3strip_cont??? ? ? ?add_cont¯add_cont°,,true??add_cont¯add_cont°,,fail? ?fail??true¯add_cont°,,??? term_append?4???3cont? ?add_cont¯add_cont°_? cont??J01 ?true¯termcat°_? cont??J01 ?true¯show_code° _ show_code0?? length? ? write4 ? cnl nth_member?? ? show_instr ?? fail?3 BRUT WAM-ASSEMBLER:4 ? =length ?3 =mode? ? ? ?findall¯show_code° _B? POST TERM-COMPRESSION CODE:=mode? cnlmc_all_instr??nth_member??? show_instr??fail? ? ?write¯show_code°_B? FINAL CODE:=mode? cnlgen_code??fail? ? ?write¯show_code°_ ?B?true¯show_code0°_ ? member??show_or_skip?? ? ?member¯show_or_skip°iiiigetvariable??var??-??arg? ??B?true¯show_or_skip°iiiiputvalue??var??-??arg? ??B?true¯show_or_skip°_ ?true¯show_instr° _ ? ?ii???? .?[] write  write?write_write?write show_fun?show_info?cnl?  ?write¯show_fun°putput ??true¯show_fun°getget ??true¯show_fun°_write¯show_info°_ ? ?var??-??? write4?put9put9put9write% write??3var?  ?write¯show_info°_ write??  ?write¯show_steps° asmasm ,cnl,4?,4?,cnl,4? ,cnlfail3portray_clause?3writeEXPANDED:3\==?? ,4?,cnl,4?,cnlfail3portray_clause?3writeDEFINITE: ?or¯show_steps°_ ?true¯bind_c_chunk_length°wamwam ? ??true¯bind_c_chunk_length°memmem ? ??true¯bind_c_chunk_length° _ ? ? ? ? ? 0 []bind_length¯bind_length° [][] ? ?true¯bind_length°..? ? ? ? ? ? ? ?  ?  ?  ?  ? ? ?make_anti_call¯make_anti_call° iiii ? ? ? ? ?c_chunk_variable? ii ?4 ? ?3 len? =?? bind_length???????  ?  ?C¯make_anti_call° iiii ? ? ? ? ?c_chunk_value? ii ?4 ? ?3 len? -??? bind_length?>?0???  ?  ?C¯make_anti_call°_ ?B ? ? ? ii ? ? ? $bin_cut?-???C?4??C???bind_length4?>?0???3.4??3iic_chunk_variable>?03iic_chunk_value4?03len?  ?  ?  ?  ?antigenic¯make_anti_call° _ ? ??1J 0 bind_length??? ????  ?  ?C¯gen_code° _ bind_c_chunk_length???member??write_instr???=?no$bin_cut?fail? ? ? ?mc_all_instr¯gen_code°_ ?true¯maxarity°256256 ?true¯temparg°_ ? ?true¯gen_instr° iiii???? ? $bin_cut?? ? ?beautify¯write_instr° iiii?? ? ? $bin_cut? =?yes? ? ? ?  ?encode¯write_instr°_no ?true¯mc_all_instr°_ ? ? mc_one_instr?? ?findall¯mc_one_instr° _ ? mc_peephole??instr_cat??? ? ?member¯instr_cat° iiii???? ?ii ?????J 1true¯beautify°argarg??encode_arg¯beautify° temptemp?? encode_arg ??????  ? ?temparg¯beautify°cutargcutarg??encode_arg¯beautify° _ ? ? ?var ? ? -? ?? ?encode2¯beautify° putputwriteconstant ? $bin_cut?encode2pushcut????cutp¯beautify° _ ? ? ? ?encode2¯encode_arg° _getvariableempty_opvar? ?-??? ?true¯encode_arg° _putvalueempty_opvar? ?-??? ?true¯encode_arg° _ ? ? ?var ? ? -? ?? ?encode2¯encode_arg° 11constant ? $bin_cut? encode2?cut???? ?cutp¯encode_arg° _ ? ?constant ? constant ?encode2¯encode2°_ii???? ?true¯mc_peephole°_mc_top¯mc_input°_mc_input0¯mc_input0° _.?? mc_empty????? ? ?gen_instr¯mc_empty°empty_opempty_op ? ? ? ??mc_input0¯mc_empty°_ ? ? ?true¯mc_top°_ ? mc0???? ? ?mc_input¯mc0° _ mc1?????? ? ? ? ?op_type¯mc1° pushpushvariable ? ? $bin_cut? mc5???? ?mc_push¯mc1° c_chunkc_chunkvariable ? ?? mc5???? ?mc_chunk¯mc1° _void ?? mc3????? 1 ?mc_sel¯mc1°_ ? ? ? ?mc5¯mc_push° _ ? ? op_type?pushstructure mc_transform_push?? ? $bin_cut? =? ?? ? ?  ?mc_input¯mc_push°_ ? ? ?true¯mc_chunk° _ ? op_type?c_chunkvalue $bin_cut? mc_input???? ? ?mc_input¯mc_chunk°_ ? ? ?true¯mc_sel° _ ? op_type?>?void $bin_cut? +?1 ? mc_sel?? ??? ? ?mc_input¯mc_sel°_ ? ? ?true¯mc3°_ ? ? ?mc4¯mc3° _ ? mc0???? ? ?mc_input¯mc4°_ $bin_cut?? ?mc_transform_void¯mc4°11 ? ?true¯mc5°_ ? ?true¯mc5° _ ? mc0???? ? ? ?mc_input¯op_type°iiii??=? ?? ? ? ? ?true¯op_type°_ ? ? expected/ii4 ?errmes¯mc_transform_void°11 ?iiunifyvoid??iiunifyvariable???true¯mc_transform_void° _ii?void??ii?void?? ?true¯mc_transform_push°iiiipushvariable?? ?iipushstructure??iipushconstant??true¯encode° unify_variableunify_variableget ? ? 1 ? 0wcode¯encode° write_variablewrite_variableput ? ? 2 ? 0wcode¯encode° unify_valueunify_valueget ? ? 3 ? 0wcode¯encode° write_valuewrite_valueput ? ? 4 ? 0wcode¯encode° unify_constantunify_constantget ? ? ? 5 0  ? 0wcode¯encode° write_constantwrite_constantput ? ? ? 6 0  ? 0wcode¯encode° push_constantpush_constant ? ?/?? 6wcode¯encode° get_constantget_constant ? ? ? 7  ? 0wcode¯encode° get_structureget_structure ? ?/?? 8wcode¯encode° put_constantput_constant ? ? ? 9  ? 0wcode¯encode° put_structureput_structure ? ?/?? 10wcode¯encode° get_variableget_variable ? ? ? ? 11  ? ?  ?wcode¯encode° put_valueput_value ? ? ? 11 ?  ?wcode¯encode° put_variableput_variable ? ? ? ? 12  ? ?  ?wcode¯encode° get_valueget_value ? ? ? ? 13  ? ?  ?wcode¯encode° push_cutpush_cut?? ? ? 14 0 ? 0wcode¯encode° put_cutput_cut?? ? ? 15 0 ? 0wcode¯encode° get_cutget_cut?? ? ? 16 0 ? 0wcode¯encode° execute_?execute_? ? ? ? ? 17 0  ?  ?wcode¯encode° load_constantload_constant ? ? ? ? 28  ?  ? 0wcode¯encode° load_variableload_variable ? ? ? ? 50  ? ?  ?wcode¯encode° load_valueload_value ? ? ? ? 29  ? ?  ?wcode¯encode° push_structurepush_structure ? ?/?? 51wcode¯encode° push_variablepush_variableput ? ? 52 ? 0wcode¯encode° unify_voidunify_void ? ? 61 ? 0wcode¯encode° write_voidwrite_void ? ? 62 ? 0wcode¯encode° c_chunk_variablec_chunk_variable ? ? ? 63 ?  ?write_or_skip¯encode° c_chunk_valuec_chunk_value ? ? ? 64 ?  ?write_or_skip¯encode° clause_?clause_? +?1 ? wcode?? ?0??? ?n_nop¯encode° firstarg_?firstarg_?/? ? +?2 ? wcode?? ??? ??  ?n_nop¯encode° end_?end_? ? ? ? ? 0  ?  ? 0wcode¯encode° inline_variableinline_variable wcode??????? ?n_inline¯encode° arith_variablearith_variable wcode????0?? ?n_arith¯encode° arith_valuearith_value wcode????1?? ?n_arith¯encode° builtin_?builtin_? wcode??????? ?n_builtin¯encode_op°_ ?op + ?3 ? make_cmd4 ? ? wcode?? ?0 ?0?3 .? .4 ? .? .4 ? .?[]3 .32[]3 .32[]  ? ?n_nop¯n_inline°_ bu_ctrn_inline? ?metacall¯n_arith°_ bu_ctrn_arith? ?metacall¯n_builtin°_ bu_ctrn_builtin? ?metacall¯n_nop°_ bu_ctrn_nop? ?metacall¯bu°_ bu0??? ? ?metacall¯write_or_skip° wamwam ??true¯write_or_skip° memmem ??true¯write_or_skip°_len ? greater_eq ? ? less ? ? $bin_cut? write_or_skip0????? ??  ?  ?  ?c_threshold¯write_or_skip° _ ?true¯write_or_skip0° wamwam $bin_cut? wcodewam?????? c_flag begin_end yes  ?bb_val¯write_or_skip0° cc ? ? ? ? ?? 0wspec_c¯write_or_skip0°asmasm? bb_valc_flagbegin_endyes = ?c = ?n wcodeasm?4 ?????3 +? ?  ?  ?  ?if¯write_or_skip0° _ ?true¯wcode° memmem ?????J #0true¯wcode° wamwam ??J 0?J 0?J 0 put0?write¯wcode° cc ? ? ? ? ? ?wcode_c¯wcode° asmasm ? ? ? ? ? ?wcode_asm¯wcode_asm° _ .? .? .? .?[] write? write--> put9 put9 write? cnl? ?=..¯let_c_chunk_file°_ ? ? c_chunk file_namebb_let¯c_chunk_file°_ ? ? c_chunk file_namebb_val¯newpred°cc? ? ?:-?? ?newpred0¯newpred°_ ?true¯newpred0° _ bb_valpredicatename?bb_valpredicatearity?$bin_cut?bb_valpredicateclause?+?1?bb_setpredicateclause?bb_letpredicateoffset0? ?functor¯newpred0°_ bb_letpredicatename?bb_letpredicatearity?bb_letpredicateclause1bb_letpredicateoffset0? ?functor¯currpred° --??/??/?? bb_valpredicatearity?bb_valpredicateclause?bb_valpredicateoffset?? predicate namebb_val¯compile_mem° _ ?mem compiling4??...3to? ctime?survive_cleanup?? mcomp_file?? maincomp?4 ? terminate_file?$end11$bin_cut?ctime? -???quietmes4??3compile_time?3 current_user_file? ? ?quietmes¯compile_mem°_ restart? compilation aborted ?ttyprint¯survive_cleanup°_ restartcall_ifdefinit_iotruename??init_cmd? ?name¯mcomp_file°_ .?.>?[] statisticsstrings4? statisticssymbols4 ? statisticshtable4 ? translate_all?? statisticscode4 ? - ??? statisticsstrings4 ?-???statisticssymbols4?-???statisticshtable4?-???+???+???+???quietmes4??3bytes_used4?4?4?4?total?3code?3strings?3symbols?3htable?3.?.>?[]3.?.>?[]3 .?.>?[]3 . ? .>?[]3 .?.>?[]3 .?.>?[]3.?.>?[] code ? ?statistics¯compile0°_.??? .??compile1¯compile0°_ .?[] ?compile1¯compile1° _? ctime?xcompile???ctime? -???write4? cnl?3total_compile_time? ?init_cmd¯xcompile° _ decorate_fileheader?compile_builtins?member??quietmes4? ctime ? comp_file?? ctime ? - ? ? ? quietmes4 ? fail?3 compile_time ?3compiling4??...3to? ? ?tell¯xcompile°_ decorate_filefooter?fail? $end0 0 ?terminate_file¯xcompile°_ ?told¯decorate_file°_c ??c_decorate_file¯decorate_file°_ ?true¯terminate_file° _ gg_emit?4?close_c_chunk_file??3.4?[]3.4?[]3iiend??? ?make_dummy_end¯make_dummy_end°cc $bin_cut?? wam.hc_chunk_file¯make_dummy_end°_maincomp¯close_c_chunk_file°cc? toldwrite_c_chunk¯close_c_chunk_file°_ ?true¯gg_emit°memmem memgen_code¯gg_emit°wamwam wamgen_code¯gg_emit°cc cgen_code¯gg_emit°asmasm asmshow_code¯comp_file°_ .wam.asm.bin.c[] $bin_cut?translate_all??? ? ?member¯translate_all°_translate_all0¯memoing_translate_all° _ ?wam \+4?memoable_file???$bin_cut?if4?true4 ? include_memoed_file??3\+older_file??3 make_memo_file???3current_moduleprolog binprolog ?is_prolog¯memoing_translate_all°_translate_all0¯memoable_file°_ ? ?.??.??.?[] append ?? ? $bin_cut? =?4? name? ? append ?4 ? ? name? ??3 .? ?3.46.112.108[] ?  ? ?name¯make_memo_file° _ ?wam1J)0 translate_all0??toldtell?? ? ?tell¯include_memoed_file°_0J)0 repeatget0?put_to_eof?$bin_cut?seensee?? ?see¯put_to_eof°-1-1 ??true¯put_to_eof°_?J0B? ?true¯translate_all0° _0J)0 repeatread_clause?translate??$bin_cut?seensee?? ?see¯translate°end_of_fileend_of_file ??true¯translate°:-:-?? fail? ?translate_cmd¯translate°::-::-?? ?? :-?? fail? ?compile_binary¯translate°_ $bin_cut?translate_cmd4??fail?3assert? ?is_dynamic_clause¯translate°_ ? ? fail? ? ?maincomp¯is_dynamic_clause°:-:-???is_dynamic¯is_dynamic_clause°_is_dynamic¯maincomp° _ show_steps??? compile_binary??? ? ? ?preprocess¯translate_cmd°..?[]?include_file¯translate_cmd°compilecompile??include_file¯translate_cmd°ensure_loadedensure_loaded??include_file¯translate_cmd°consultconsult??include_file¯translate_cmd°reconsultreconsult??include_file¯translate_cmd°dynamicdynamic? ??dynamic¯translate_cmd°interactiveinteractive? ??interactive¯translate_cmd°spyspy? ??spy¯translate_cmd° opop???? if4?4 ?true?3member?.wam.c[]3 encode_op???? ? ?op¯translate_cmd°_exec_cmd¯exec_cmd°_ maincomp??fail? ?cmd2clause¯cmd_root°$run_time_command$run_time_command ?true¯init_cmd°_ get_cmd_no?? ?cmd_root¯get_cmd_no°_ ? bb_setgensym?0$bin_cut?? gensym ? ?bb_val¯get_cmd_no°_ ?true¯cmd2clause° _:-?? gensym??quietmes% !!! action delayed after compilation, for command:quietmes4?if4?truetrue?3public/?03:-? ?cmd_root¯exec_run_time_commands°_ exec_run_time_commands0?fail? ?cmd_root¯exec_run_time_commands°_true¯exec_run_time_commands0° _ ?10000 symcat???if4?4?true $bin_cut??3is_compiled?3,4?fail3call? 1for¯include_file° _0J)0 quietmes4?memoing_translate_all?? seeing_telling0 ? quietmes4 ??3 end4 ? in ?3 including?3begin4? in?3including? ? ?find_file¯preprocess° _ fact2rule?? mdef_to_def?? def_to_mbin??? ? ?std_expand_term¯fact2rule°:-:-? ?:-??true¯fact2rule°:-:-?? ?:-???true¯fact2rule°_:-?true ?true¯make_cmd°_ name??? ?make_cmd0¯make_cmd0°_ ? ? char_in_cmd?? ? ?findall¯char_in_cmd° _ listify??member??? ? ?member¯listify°..?? ?.???true¯listify°_name¯make_appl°_ ? .?.init.pl.oper.pl.lib.pl.read.pl.write.pl.dcg.pl[] wam newappl.bpcompile0¯make_executable_unix_appl°_ make_cmd4?? system??3.4?.4? .4 ? .? .4 ? .4 ? .? .4 ? .?[]3 .32 .59 .32 .99 .104 .109 .111 .100 .32 .43 .120 .32[]3 .32 .59 .32 .99 .97 .116 .32 .110 .101 .119 .97 .112 .112 .108 .46 .98 .112 .41 .32 .62 .32[]3 .32 .36 .48 .39[]3 .59 .32 .101 .99 .104 .111 .32 .39 .101 .120 .101 .99 .32[]3.59.32.101.99.104.111.32.39.66.80.95.65.82.71.83.61.36.42.59.32.101.120.112.111.114.116.32.66.80.95.65.82.71.83.39[]3.40.101.99.104.111.32.39.35.33.32.47.98.105.110.47.115.104.32.39[] ? ?make_appl¯cparser°_ ? is prolog bin_prolog_with_cparserbb_def¯kmake°_ makewam? ?cparser¯kcmake°_ cmakewam? ?cparser¯tmake°_ ? 12 60tmake¯tmake°_ ? 10000tmake¯tmake°_ cmake? ?set_c_threshold¯cmake°_ ? wamcmake¯cmake°_ ? usercmake¯cmake°_ ? c .cmake¯make°_ ? wammake¯make°_ ? usermake¯make°_ ? wam .bpmake¯make° _ ? ? ? ?make¯make° _ module? if4 ?true4 ? module ??3 make0????3 \+ errmesunable_to_make .4 ? .4 ? .4 ?[]3 in_module?3 project??3 mode?  ? ?current_module¯make0° _ find_file?? make_cmd4 ? ? make_include?? compile0?? ? ctime ?- ? ?? write4 ? cnl?3 =? time?3 .? .?[]  ? ?ctime¯make_include°cc? .?.4?[]3.46.104[] let_c_chunk_file?? ?make_cmd¯make_include°_ ?true¯asm°_ ? asm usercomp_file¯asm°_ ? user asm .asm BinWAM intermediate codemake¯boot°_ ? wam prologmake¯uboot°_ ? wam usermake¯ls°_ ? ls -tFsystem¯dir°_ ? dirsystem¯edit° _ make_cmd4??system?compile??3.?.4?.?[]3.32[] ? ? ?find_file¯get_editor°_ unix_getenvEDITOR? unix_getenvVISUAL? $bin_cut?? ? ?or¯get_editor°_ ? ?true¯my_edit°_ current_user_file? edit??? ? failcall_ifdef¯my_defedit°_ current_user_file? defedit??? ? failcall_ifdef¯defedit°_ edit??? ? ?get_editor¯ed°_ ? emacsmy_defedit¯edit°_ ? editmy_defedit¯textedit°_ ? texteditmy_edit¯emacs°_ ? emacsmy_edit¯notepad°_ ? notepadmy_edit¯pico°_ ? picomy_edit¯vi°_ ? vimy_edit¯co°_ current_user_file? compile?? ? failcall_ifdef¯s°_statistics¯c_root°xxxx ?true¯set_c_threshold°_ ? 100000set_c_threshold¯set_c_threshold°_ ? bb_letc_flagc_threshold_max?? c_flag c_threshold_min ?bb_let¯set_c_trace°_ ? ? c_flag tracebb_let¯c_threshold°_ ? bb_valc_flagc_threshold_max?$bin_cut?? c_flag c_threshold_min ?bb_val¯c_threshold°110 $bin_cut?? wam.hc_chunk_file¯c_threshold°55500 ?true¯meta_interpreter°_do_body¯do_body°_ ? ? ?B?? unbound_goal ?user_error¯do_body° _ or4?4??3,4?,4? do_body?3$bin_cut?3=?yes3=?nodo_body¯do_compiled°callcall?? ?B?do_body¯do_compiled°\+\+? $bin_cut?fail? ?do_body¯do_compiled°\+\+? ??true¯do_compiled°bagofbagof??? ?? do_body?bagof¯do_compiled°setofsetof??? ?? do_body?setof¯do_compiled°findallfindall??? ?? do_body?findall¯do_compiled°_call¯do_goal°_ $bin_cut?spy_goal?? ?spying¯do_goal° _ $bin_cut?assumed_clause??do_body???or4?4??3,4? ,4 ? do_body?3 $bin_cut?3=?yes3=?no ?is_assumed¯do_goal° _ $bin_cut?clause??do_body???or4?4??3,4? ,4 ? do_body?3 $bin_cut?3=?yes3=?no ?is_dynamic¯do_goal°_ ?B??do_compiled¯do_goal°_ $bin_cut?do_apply??do_goal?? call ?functor¯do_goal°_do_undef¯do_undef°_ errmes4?4??3=undefined_predicate/??3=culprit?functor¯do_apply° _ .>?.?? =..?? det_append???=..??? ? ?=..¯do_body° ,,?? ? ? ?? ? ?  ?do_conj¯do_body° ;;?? ? ? ?? ? ?  ?do_disj¯do_body°!!trueyes ?true¯do_body°_trueno ?do_goal¯do_conj°!! ?yes ??true¯do_conj°_ do_body???? ?do_body¯do_disj° ->->?? ? ? ? ?? ?  ?  ?  ?do_if_then_else¯do_disj°_do_disj0¯do_if_then_else° _ $bin_cut? do_body???? ?do_body¯do_if_then_else°_ ? ? ? ?do_body¯do_disj0°_ ? ? ?do_body¯do_disj0°_ ? ? ? ?do_body¯trace°_ ? 0tr_body¯tr_body°_ ? ?B?? unbound_goal ?user_error¯tr_body° _ or4?4??3,4? ,4 ? ,4 ? ,4 ? ,cnl tr_body??3 writeCUT3 tab?3 $bin_cut?3=?yes3=?notr_body¯tr_body° ,,?? ? ? ? ?? ?  ?  ?  ?tr_body¯tr_body°!!trueyes ??true¯tr_body° ;;?? ? ? ? ?? ?  ?  ?  ?tr_disj1¯tr_body°truetruetrueno ??true¯tr_body°_trueno ?tr_goal¯tr_disj1°->->?? ? ? ? ? ?? ?  ?  ?  ?  ?tr_if1¯tr_disj1°_ ? ? ? ?tr_body¯tr_disj1°_ ? ? ? ? ?tr_body¯tr_if1° _ do_body? tr_body???? tr_body????  ?  ?  ? ?if¯tr_body°!! ?yes ??true¯tr_body° ,,??? ,??  ?tr_body¯tr_body°;;?? ? ? ? ? ?? ?  ?  ?  ?  ?tr_disj2¯tr_body°truetrue ? ? ? ? ??tr_body¯tr_body° _ tr_body????? ? ?tr_goal¯tr_disj2°->->? ? ? ? ? ? ? ??  ?  ?  ?  ? ? ?tr_if2¯tr_disj2° _ ? ? ? ? ?tr_body¯tr_disj2° _ ? ? ? ? ? ?tr_body¯tr_if2° _ do_body? tr_body????? tr_body?????  ?  ?  ? ?if¯tr_goal°callcall??tr_body¯tr_goal°\+\+? $bin_cut?fail? ?tr_body¯tr_goal°\+\+? ??true¯tr_goal°_ ,4?,4?,4? or4 ? ortrue ,4 ? ,4 ? ,4 ? ,cnlfail3 print?3 writeRedo: 3 tab?3 ,4 ? ,4 ? ,4 ? ,cnlfail3 print?3 writeExit: 3 tab?3if4?4 ? ,4 ? tr_call? ?3 +1? ?3,4? \+ spying?3arith_eq?103 metacall?3ifis_interactive4? ,4 ?cnl3 =?323,4? if4 ?true get0>?3 arith_eq?103get0?3or4?or4?true3,is_interactive,4?fail3write : 3,4?,4?,4?fail3print?3writeCall: 3tab? ,4?,4? ,4 ? ,cnlfail3 print?3writeFail: 3tab? ? ?or¯tr_call° bagofbagof??? ?? tr_body?? ? ?bagof¯tr_call° setofsetof??? ?? tr_body?? ? ?setof¯tr_call° findallfindall??? ?? tr_body?? ? ?findall¯tr_call°_ $bin_cut?tab?functor???write4? cnl assumed_clause? ? tr_body ?? ? ? or4 ?4 ??3 ,4 ? ,4 ?,4?,4?,cnltr_body ??3writeCUT3tab?3 $bin_cut?3 = ?yes3 = ?no3!!! assumed/?? ?is_assumed¯tr_call°_ $bin_cut?tab?functor???write4? cnl clause? ? tr_body ?? ? ? or4 ?4 ??3 ,4 ? ,4 ?,4?,4?,cnltr_body ??3writeCUT3tab?3 $bin_cut?3 = ?yes3 = ?no3!!! dynamic/?? ?is_dynamic¯tr_call° _ ?B?? functor???write4? cnl call??3!!! compiled/?? ? ?tab¯tr_call°_ $bin_cut?do_apply??tr_call??? call ?functor¯tr_call°_do_undef¯dynamic°_ fail? ?make_dynamic¯dynamic°_ ?true¯make_dynamic°,,??? make_dynamic?? ?make_dynamic¯make_dynamic° //?? check_dynamic?4?define_dynamic??3/?? ?functor¯check_dynamic°_ ?B?? WARNING: dynamic code will shadow compiled predicate? cnl?write¯check_dynamic°_ $bin_cut?errmesdynamic code would shadow assumed predicate?? ?is_assumed¯check_dynamic°_ ?true¯define_dynamic°_ bb_def?$last0? $first 0bb_def¯ensure_dynamic°_ $bin_cut?? ?is_dynamic¯ensure_dynamic°_ make_dynamic4??3/??functor¯add_clause°_ $bin_cut?? ?add_clause0¯add_clause° _ add_clause0????$bin_cut?? ? ?ensure_dynamic¯add_clause°_ :-?? unable to assert clause ?errmes¯add_clause0° _??J0??J0???J0 :-?? set???? ? ?bb_def¯add_clause0°_??J0 :-?? ? ? ?bb_def¯asserta°_ :-?? add_clause$first-1??? ?add_true¯assertz°_ :-?? add_clause$last1??? ?add_true¯assert°_assertz¯assert_it°end_of_fileend_of_file ??true¯assert_it°_assertz¯retract° _ =?4?clause0?? ? erase0? ??3:-?? ?add_true¯retractall° _ :-?>? val?$first?val?$last? for ???val? ?>?erase0? ? fail? ?add_true¯retractall°_ ?true¯collect_slot°_?$firstJ1?$lastJ0??J 0??1J0?$first?J0 ?true¯collect_slot°_ ?true¯instance°$dbref$dbref????J0copy_term¯erase°$dbref$dbref?? ? ?erase0¯erase0°_ collect_slot??? ?bb_rm¯clause°_ ? ?clause0¯clause°_$dbref??clause0¯clause0° _?$firstJ0?$lastJ0 ith_clause? ??? member4? ??3-?:-??  ? ?  ? ?findall¯ith_clause°_-????J1 ?true¯ith_clause°_??J 0?1J0ith_clause¯abolish° _ ? ? is_dynamic?$bin_cut?abolish0???? ? ?functor¯abolish°_ found/?? abolish_expects_dynamic_clauses ?errmes¯abolish0°_ retractall?fail? ?functor¯abolish0°_ ??$firstJ0?$lastJ0define_dynamic¯debug°_reconsult¯consult_warning°_ ? % using compile/1 is MUCH fasterquietmes¯consult°_ consult_warningconsult0?? ?find_file¯reconsult°_ consult_warningsurvive_cleanup??consult0?? ?find_file¯consult0° _ quietmes4?see?repeatread_clause?consult_embedded?=?end_of_file$bin_cut?seenctime?-???quietmes4??3consulted?time?3consulting? ? ?ctime¯consult_included°_0J)0 consult0?see?? ?find_file¯consult_embedded°:-:-??consult_cmd¯consult_embedded°_ assert_it?? ?expand_term¯consult_cmd°..?[]?consult_included¯consult_cmd°consultconsult??consult_included¯consult_cmd°reconsultreconsult??consult_included¯consult_cmd°_metacall¯listing° _ ? ? is_dynamic?$bin_cut?write% write4? write: cnl listing0??3/?? ? ?functor¯listing° _ ? ? is_assumed?$bin_cut?write% assumed write4? write: cnl listing1??3/?? ? ?functor¯listing0°_ portray_clause4?fail?3:-??clause¯listing0°_ ?B?true¯listing1°_ portray_clause4?fail?3:-??assumed_clause¯listing1°_ ?B?true¯listing°_ listing??fail? 0 255for¯listing°_ ?B?true¯generate_run_time_predicate° _ or4?4?bb_element4? ? nonvar ??3=4? ?3+? ?3,4? = ? /??3=?/$assumed03,4?= ? /$first03=?/??  ? ?bb_list¯listing°_ listing??fail? ?generate_run_time_predicate¯listing°_true¯=>° _ ? intuitionistic? metacall?=?$closed? ? ?assume¯-:° _ ? linear?>? metacall?=?$closed? ? ?assume¯add_hint_ll° _clause?? ? ?:-?? ? ? ?add_true¯assumel°_ ? ? linear>? ?assume¯assumei°_ ? ? intuitionistic>? ?assume¯assume°_ ?B?? bad_clause? error_in_assume ?errmes¯assume°_assume1¯assume1°_.?[]?assume_file¯assume1°_assume_ll¯assume_ll° _ lval$assumed?? assume_with_hint_ll??? ?add_hint_ll¯assume_with_hint_ll°_ ? ? ?B?? ?insert_ll¯assume_with_hint_ll°..?[] ? ?true¯assumed°_ call?? ?assumed_clause¯assumed_clause°_ ? ?assumed_clause¯assumed_clause° _ ? ? ?$assumed?J0 ?B ? ? ?get_assumed_clause¯get_assumed_clause° _ ? ? ?. ? ? clause?? ? ?copy_or_delete_ll¯get_assumed_clause°_.??get_assumed_clause¯copy_or_delete_ll° linearlinear?? ?:-?? ?B? ?B? ?$usedtrue¯copy_or_delete_ll°intuitionisticintuitionistic? ? ? ?B? :-?? ?copy_term¯insert_ll°_ ? ?.?[]?2? .?[]?J0 ?true¯insert_ll°_.??insert_ll¯assume_file° _ seeing_telling0?see?assume_all?seensee?? ? ? ?find_file¯assume_all°_ assume_all0??? ? ?gc_read_clause¯assume_all0°end_of_fileend_of_file ??true¯assume_all0°_ gc_read_clause?assume_all0??? ?assume_one¯assume_one°:-:-?.?[] ?? ?assume_file¯assume_one°:-:-? ?? consult_cmd? true trueif¯assume_one°_ ? ? ?assume_ll¯bb_element° ==??+??/??/?? ?.??.??.??.??.??true¯bb_element°_.??.??.??.??.??bb_element¯bb_list°_30J'1 ?true¯bb°_ ? unsortedbb¯bb°_ ? ,4?,4?,cnl,4? ,4 ? ,4 ? ,4 ? ,4 ? ,cnlfail3 write ?3 bb_orig ? ?3 member ? ?3 if4 ?4 ? = ? ?3 \==?sorted3 ,4 ? sort ? ?3 findall ?4 ? ?3 bb_element ? ?3bb_list ?3write-bboard?3statisticsbboard? ? cnlor¯bb_orig° ==??+??/??/??= ? ? + ? ? /?? /?? functor ???or4?4? $bin_cut??3val? ? ?3lval? ? ? ? ?functor¯sort°_ ? remdup??? < ? ?merge_sort¯remdup°[][][] ?true¯remdup° ..??.?? = ???J1? .??remdup¯remdup°..??.??remdup¯merge_sort°_ merge_sort1????[]? ? ? ?length¯merge_sort1°00[] ? ??true¯merge_sort1° 11 ?.??.?[]?true¯merge_sort1° _?1J0??J 0 merge_sort1 ?? ? ?? merge_2 ?? ??? ?  ?  ?  ?merge_sort1¯merge_2°[][] ? ??true¯merge_2° ..??.? ?.????J1? .? ?merge_2¯merge_2° _ ?.??.?? ?merge_2¯ksort°_ $bin_cut?=??? -1 ? []keysort¯ksort°_ keysort?? illegal_arguments ?user_error¯keysort° ..??? ?B ? ? ? -=? ? ? .?? keysort?1? ????  ?  ?  ? ?samkeyrun¯keysort°_[] ? ?true¯keysort°..????J 0? ?B ? ? ? -=? ? ? .?? keysort ?1? ? ??keymerge? ? ?+???keysort??? ????  ?  ?  ?  ? ?samkeyrun¯keysort° _ ? ? ?true¯samkeyrun°..?? ?B ? ? ? - ? ? ? ? . ? ? -? ? $bin_cut? = ?4 ? samkeyrun?? ????3 .?>?  ?@=<¯samkeyrun° ..?? ?B ? ? ? - ? ? ? ? . ? ? - ? ? < ? ? ?J 1? .??  ?samkeyrun¯samkeyrun° _ ? ? ?.?[]true¯keymerge°[][] ?? ? ?true¯keymerge° ..?? ? ?.? ?-? ? ? ? -? ? $bin_cut? =?4 ? keymerge????3 .?? ?  ?@=<¯keymerge°_.??? ? ?.??keymerge¯keymerge°_ ? ?true¯setof° _ call? sort??? ? ? ?bagof¯bagof°_ ? ? \==?[] $bin_cut? =.. ?4 ? functor ?. ? findall4 ?4 ??replace_instance? ? ? ?keysort ? ?$bin_cut?concordant_subset ? ? ?=? ??3 - ??3 call?3 ..? ? [] ?free_variables¯bagof° _.?? call? .?? ?findall¯^°_ ? ?call¯replace_instance°[][][] ??true¯replace_instance° ..??-?? ?. ? ? -?? $bin_cut?replace_instance??? ?? ?replace_key_variables¯replace_key_variables°00 ??true¯replace_key_variables°_??J0 ?B???1J0replace_key_variables¯replace_key_variables°_??J0??J1?1J0replace_key_variables¯concordant_subset° ..??-?? concordant_subset ??4 ????3 .?? ?  ?concordant_subset¯concordant_subset° ..??-??.?? = ???J1?concordant_subset¯concordant_subset°_[] ? ?true¯concordant_subset°[][] ? ? ??true¯concordant_subset°_ ? ? ?true¯concordant_subset°_ ? ? ?concordant_subset¯free_variables° _ ? ?.?? ?B? list_is_free_of?? $bin_cut?? ? ?term_is_free_of¯free_variables°_ ? ?B?? ?true¯free_variables° _ $bin_cut?free_variables? ???? ?  ? ?explicit_binding¯free_variables° _ free_variables?????? ? ? ?functor¯free_variables°00 ? ??true¯free_variables° _??J0 -?1 ? $bin_cut? free_variables ??? ??? ? ? ?  ?  ?free_variables¯explicit_binding°\+\+?fail ? ?true¯explicit_binding°notnot?fail ? ?true¯explicit_binding° ^^?? ? ?+??true¯explicit_binding° setofsetof??? ?-??+??true¯explicit_binding° bagofbagof??? ?-??+??true¯term_is_free_of°_ ?B??\==¯term_is_free_of°_ term_is_free_of???? ? ?functor¯term_is_free_of°00 ??true¯term_is_free_of° _??J0 -?1? $bin_cut? term_is_free_of???? ? ? ?term_is_free_of¯list_is_free_of°[][] ?true¯list_is_free_of°..?? list_is_free_of??? ?\==¯keysort°_ksort¯not°_ call? $bin_cut?? ? ?\+¯not°_ $bin_cut?fail? ?ground¯not°_ ? user_errorshould be groundnot? ? fail abortif¯term_chars°_ ?B?? name??? ? ?swrite¯term_chars°_ sread??? ? ?name¯vars_of°_ ? ? [] []free_variables±200 fx $¯main°_prolog_server¯prolog_server°_ repeatin??react??$bin_cut?? ?init_server¯init_server°_ end_symbol? nointeractive¯react°end_of_fileend_of_file ??true¯react°call_prologcall_prolog?? $bin_cut?end_symbolfail?call¯react°query_prologquery_prolog? fail? ?query_prolog¯react°query_prolog_listquery_prolog_list? fail? ?query_prolog_list¯query_prolog°_ cnlmember??write?cnlfail? ?call¯query_prolog°_ ?end_symbol¯query_prolog_list°_ write|cnlmember??write?cnlfail? ?call¯query_prolog_list°_ ?end_symbol¯end_symbol°_ cnl? EOPAwrite¯in°_ ? ?in¯in°_ $bin_cut?in1??? ? ?read_term¯in1°..?? ?? .??member¯in1°_ ? ?true¯$end0°_truewamideas/agt_wish.o100664 764 764 2504 6665020276 13157 0ustar javierjavierELF€4( U‰åh‹E P‹EPèüÿÿÿƒÄ 1ÀëÉÉöU‰åƒì‹EPèüÿÿÿƒÄ‰À‰Eü‹EPèüÿÿÿƒÄ‰Àƒøu ¸ë{v‹EPèüÿÿÿƒÄ‰Àƒøu ¸ë^‰ö‹EPèüÿÿÿƒÄ‰Àƒøu ¸ëB‰öƒ}üt‹EPèüÿÿÿƒÄ‰Àƒøu¸ë ‹EPèüÿÿÿƒÄ‰Àƒøu ¸ë‰ö1ÀëÉÃ01.01GCC: (GNU) 2.7.2.3.symtab.strtab.shstrtab.text.rel.text.data.rel.data.bss.note.comment4Î! ü@ +1 < ;@F0O80  h‘ñÿ +38 ®DM[dlvagt_wish.cgcc2_compiled.tclDummyMathPtrmatherrmainTcl_AppInitTkX_MainTk_MainWindowTcl_InitTk_InitTclx_InitTkx_InitIdeas_ActSrc_Init  + <Yu—±