1# BEGIN LICENSE BLOCK
2# Version: CMPL 1.1
3#
4# The contents of this file are subject to the Cisco-style Mozilla Public
5# License Version 1.1 (the "License"); you may not use this file except
6# in compliance with the License.  You may obtain a copy of the License
7# at www.eclipse-clp.org/license.
8#
9# Software distributed under the License is distributed on an "AS IS"
10# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11# the License for the specific language governing rights and limitations
12# under the License.
13#
14# The Original Code is  The ECLiPSe Constraint Logic Programming System.
15# The Initial Developer of the Original Code is  Cisco Systems, Inc.
16# Portions created by the Initial Developer are
17# Copyright (C) 2006 Cisco Systems, Inc.  All Rights Reserved.
18#
19# Contributor(s):
20#
21# END LICENSE BLOCK
22
23#
24# $Id: tkmulti.tcl,v 1.2 2012/03/01 12:49:21 jschimpf Exp $
25#
26
27package provide eclipse_peer_multitask 1.0
28
29set tkecl(multi_state) not_registered
30
31proc ec_multi:peer_register { {mtcommands {}} } {
32    global tkecl
33
34    if {$tkecl(multi_state) != "not_registered"} {
35	error "Calling ec_multi:peer_register when peer is already registered for multitasking."
36    }
37
38    set res [ec_rpcq [list peer_register_multitask [ec_peer_name] _] {(()_)}]
39    switch $res {
40	fail -
41	throw {
42	    error "Unable to establishing a multitasking link with ECLiPSe."
43	}
44	default {
45	    set tkecl(multi_fromec) [lindex $res 2]
46	    set tkecl(multi_state) off
47	    ec_set_queue_handler $tkecl(multi_fromec) fromec ec_multi:fromec_handler
48	}
49    }
50
51    foreach commandtype [list multi_start_command \
52			     multi_end_command multi_timeslice_command] {
53	set tkecl($commandtype) {}
54    }
55
56    foreach {type command} $mtcommands {
57	switch $type {
58	    start {
59		set tkecl(multi_start_command) $command
60	    }
61	    end {
62		set tkecl(multi_end_command) $command
63	    }
64	    interact {
65		set tkecl(multi_timeslice_command) $command
66	    }
67	    default {
68		error "Unknown command type $type given in"
69		" ec_multi:peer_register"
70	    }
71	}
72    }
73}
74
75
76proc ec_multi:peer_deregister {} {
77    global tkecl
78
79    if {$tkecl(multi_state) == "not_registered"} {
80	error "Calling ec_multi:peer_deregister when peer is not registered for multitasking."
81    }
82
83    set res [ec_rpcq [list peer_deregister_multitask [ec_peer_name]] {(())}]
84    switch $res {
85	fail -
86	throw {
87	    error "Unable to deregister multitasking link with ECLiPSe."
88	}
89	default {
90	    set tkecl(multi_fromec) ""
91	    set tkecl(multi_state) not_registered
92	}
93    }
94}
95
96
97proc ec_multi:fromec_handler {multi_fromec_stream_nr {size 0}} {
98
99    set message [ec_read_exdr [ec_streamnum_to_channel $multi_fromec_stream_nr]]
100    set state [lindex $message 0]
101    set arg  [lindex $message 1]   ;# could be empty if no argument
102    ec_multi:state_action $state $arg
103
104}
105
106proc ec_multi:state_action {state {arg {}}} {
107    global tkecl
108
109    switch $state {
110	start_multitask {
111	    if {$tkecl(multi_state) != "off"} {
112		set peername [ec_peer_name]
113		tk_messageBox -icon error -type ok -message "peer_multitask error ($peername): Told to start multitasking during multitasking."
114		return -code error
115	    }
116
117	    set tkecl(multi_type) $arg
118	    set tkecl(multi_state) on
119	    if {$tkecl(multi_start_command) != {}} {
120		switch [eval [list $tkecl(multi_start_command) $arg]]  {
121		    continue {
122			ec_rpcq peer_multitask_confirm ()
123		    }
124		    terminate {
125			ec_multi:terminate_phase
126		    }
127		}
128	    }
129	    update
130	}
131	end_multitask {
132	    ;# ignore message if not multitasking...
133	    if {$tkecl(multi_state) != "off"} {
134
135		update
136		set tkecl(multi_state) off
137		if {$tkecl(multi_end_command) != {}} {
138		    eval [list $tkecl(multi_end_command) $tkecl(multi_type)]
139		}
140		update ;# allow handler's changes to occur
141	    }
142	}
143	interact {
144	    if {$tkecl(multi_state) == "off"} {
145		set peername [ec_peer_name]
146		tk_messageBox -type ok -icon error -message "peer_multitask error ($peername): Trying to multitask while not multitasking."
147		return -code error
148	    }
149
150	    update
151	    if {$tkecl(multi_timeslice_command) != {}} {
152		if {[catch [eval [list $tkecl(multi_timeslice_command) \
153				      $tkecl(multi_type)]] result] == 1} {
154		    # need to check for == 1 to avoid catching break/continue
155		    # something went wrong, just return error
156		    return -code error
157		}
158		switch $result  {
159		    terminate {
160			ec_multi:terminate_phase
161		    }
162		}
163	    }
164	}
165	default {
166	    set peername [ec_peer_name]
167	    tk_messageBox -icon error -type ok -message "peer_multitask error ($peername): unknown multitasking state message from ECLiPSe: $state."
168	    return -code error
169	}
170    }
171}
172
173proc ec_multi:terminate_phase {} {
174    global tkecl
175
176    if {$tkecl(multi_state) == "on"} {
177	ec_rpcq peer_multitask_terminate ()
178    }
179}
180
181
182proc ec_multi:get_multi_status {} {
183    global tkecl
184
185    return $tkecl(multi_state)
186
187}
188