Model Railroad System  2.2.2
TB_Switch.tcl
1 #*****************************************************************************
2 #
3 # System :
4 # Module :
5 # Object Name : $RCSfile$
6 # Revision : $Revision$
7 # Date : $Date$
8 # Author : $Author$
9 # Created By : Robert Heller
10 # Created : Sat Aug 1 14:05:17 2015
11 # Last Modified : <150816.1401>
12 #
13 # Description
14 #
15 # Notes
16 #
17 # History
18 #
19 #*****************************************************************************
20 #
21 # Copyright (C) 2015 Robert Heller D/B/A Deepwoods Software
22 # 51 Locke Hill Road
23 # Wendell, MA 01379-9728
24 #
25 # This program is free software; you can redistribute it and/or modify
26 # it under the terms of the GNU General Public License as published by
27 # the Free Software Foundation; either version 2 of the License, or
28 # (at your option) any later version.
29 #
30 # This program is distributed in the hope that it will be useful,
31 # but WITHOUT ANY WARRANTY; without even the implied warranty of
32 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
33 # GNU General Public License for more details.
34 #
35 # You should have received a copy of the GNU General Public License
36 # along with this program; if not, write to the Free Software
37 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
38 #
39 #
40 #
41 #*****************************************************************************
42 
43 
44 package require CTIAcela;# require the CTIAcela package
45 package require snit;# require the SNIT OO framework
46 
47 snit::type TB_Switch {
48  ##
49  # @brief Switch (turnout) operation using a CTI Train Brain and Yardmaster
50  #
51  # @image html switch-CTITB-thumb.png
52  # @image latex switch-CTITB.png "Switch controlled by CTI's Yardmaster and Train Brain" width=5in
53  #
54  # Above is a typical switch (turnout) using a CTI Yardmaster to control a
55  # Circuitron Tortoise Switch Machine and a CTI Train Brain to sense the
56  # point position and a Circuits4Track quad occupancy detector to sense
57  # occupation of the switch.
58  #
59  # Typical usage:
60  #
61  # @code
62  # # Connect to the CTI network via a CTI Acela at /dev/ttyACM0
63  # ctiacela::CTIAcela acela /dev/ttyACM0
64  # # Switch 1 is controled by bits 0 and 1 of the Yardmaster, and sensed
65  # # with bits 0 (occupation), 1 and 2 (point position).
66  # TB_Switch switch1 -acelaobj acela -motoraddress 0 -osaddress 0 \
67  # -pointsense 1 -plate SwitchPlate1
68  # # Switch 2 is controled by bits 2 and 3 of the Yardmaster, and sensed
69  # # with bits 3 (occupation), 4 and 5 (point position).
70  # TB_Switch switch2 -acelaobj acela -motoraddress 2 -osaddress 3 \
71  # -pointsense 4 -plate SwitchPlate2
72  # @endcode
73  #
74  # For the track work elements use "switchN occupiedp" for the track work
75  # elements' occupied script and use "switchN pointstate" for the track
76  # work elements' state script. For the switch plate use
77  # "switchN motor normal" for the normal script and "switchN motor reverse"
78  # for the reverse script.
79  #
80  # Then in the Main Loop, you would have:
81  # @code
82  # while {true} {
83  # MainWindow ctcpanel invoke Switch1
84  # MainWindow ctcpanel invoke Switch2
85  # MainWindow ctcpanel invoke SwitchPlate1
86  # MainWindow ctcpanel invoke SwitchPlate2
87  # update;# Update display
88  # }
89  # @endcode
90  #
91  # @author Robert Heller \<heller\@deepsoft.com\>
92 
93  # CTI Options:
94  option -acelaobj -readonly yes -default {} -type ::ctiacela::CTIAcela
95  option -motoraddress -readonly yes -default 0 -type ::ctiacela::addresstype
96  option -osaddress -readonly yes -default 0 -type ::ctiacela::addresstype
97  option -pointsense -readonly yes -default 0 -type ::ctiacela::addresstype
98  # Signal related options
99  # The forward direction means entering at the point end.
100  option -direction -type {snit::enum -values {forward reverse}} \
101  -default forward -configuremethod _settruedirection \
102  -cgetmethod _gettruedirection
103  # If the switch is installed opposite the overall traffic flow (eg it is
104  # a frog facing switch), then -forwarddirection needs to be set for
105  # reverse operation.
106  option -forwarddirection \
107  -type {snit::enum -values {forward reverse}} -default forward \
108  -readonly yes
109  # The forward signal is the signal protecting the points
110  option -forwardsignalobj -readonly yes -default {}
111  # The previous block is the block connected to the points
112  option -previousblock -default {}
113  # The reverse main signal is the signal protecting the straight frog end
114  option -reversemainsignalobj -readonly yes -default {}
115  # The next main block is the block connected to the main frog end
116  option -nextmainblock -default {}
117  # The reverse divergent signal is the signal protecting the divergent frog end
118  option -reversedivergentsignalobj -readonly yes -default {}
119  # The next divergent block is the block connected to the divergent frog end
120  option -nextdivergentblock -default {}
121  # Switch Plate name (if any).
122  option -plate -default {}
123 
124  typemethod validate {object} {
125  ## Type validating code
126  # Raises an error if object is not either the empty string or a TB_Switch
127  # type.
128 
129  if {$object eq ""} {
130  return $object;# Empty or null objects are OK
131  } elseif {[catch {$object info type} itstype]} {
132  error "$object is not a $type";# object is not a SNIT type
133  } elseif {$itstype eq $type} {
134  return $object;# Object is of our type (Block)
135  } else {
136  error "$object is not a $type";# object is something else
137  }
138  }
139  component acela
140  ## @private Acela object
141  component forwardsignal
142  ## @private Signal object (typically a three color, one head block signal
143  component reversesignal
144  ## @private Signal object (typically a three color, one head block signal
145  variable isoccupied no
146  ## @private Saved occupation state.
147 
148  constructor {args} {
149  ## @brief Constructor: initialize the block object.
150  #
151  # Install an CTIAcela object as a component created elsewhere).
152  # Install the blocks signal (created elsewhere).
153  #
154  # @param name Name of the block object
155  # @param ... Options:
156  # @arg -acelaobj This is the CTIAcela object.
157  # This option is read-only and must be set at creation time.
158  # @arg -motoraddress The address of the motor control bits (two
159  # successive bits).
160  # This is an integer from 0 to 65535 inclusive. This option is
161  # read-only and can only be set at creation time. The default is 0.
162  # @arg -osaddress The address of the sensor bit for this block.
163  # This is an integer from 0 to 65535 inclusive. This option is
164  # read-only and can only be set at creation time. The default is 0.
165  # @arg -pointsense The address of the sensor bits for the point state
166  # sense (two successive bits).
167  # This is an integer from 0 to 65535 inclusive. This option is
168  # read-only and can only be set at creation time. The default is 0.
169  # @arg -direction The current direction of travel. Forward always
170  # means entering at the point end.
171  # @arg -forwarddirection The @e logial forward direction. Set this
172  # to reverse for a frog facing switch. Default is forward and it
173  # is readonly and can only be set during creation.
174  # @arg -forwardsignalobj The signal object protecting the points.
175  # Presumed to be a two headed signal, with the upper head relating to
176  # the main (straight) route and the lower head relating to the
177  # divergent route. The upper head has three colors: red, yellow, and
178  # green. The lower head only two: red and green.
179  # @arg -reversemainsignalobj The signal object protecting the straight
180  # frog end. Presumed to be single headed (with number plate).
181  # @arg -reversedivergentsignalobj The signal object protecting the
182  # divergent frog end. Presumed to be single headed (with number plate).
183  # @arg -previousblock The block connected to the point end.
184  # @arg -nextmainblock The block connected to the straight frog end.
185  # @arg -nextdivergentblock The block connected to the divergent frog
186  # end.
187  # @arg -plate The name of the switch plate for this switch.
188  # @par
189 
190  # Prefetch the -forwarddirection option.
191  set options(-forwarddirection) [from args -forwarddirection]
192  # Process any options
193  $self configurelist $args
194  set acela [$self cget -acelaobj]
195  if {$acela eq {}} {
196  error "The -acelaobj is required!"
197  }
198  # Install the signal component.
199  set forwardsignal [$self cget -forwardsignalobj]
200  set reversemainsignal [$self cget -reversemainsignalobj]
201  set reversedivergentsignal [$self cget -reversedivergentsignalobj]
202  }
203 
204  method _settruedirection {option value} {
205  ## @private A method to fake direction for frog facing switches.
206  # @param option This is always -direction.
207  # @param value Either forward or reverse.
208  switch $options(-forwarddirection) {
209  forward {
210  set options($option) $value
211  }
212  reverse {
213  switch $value {
214  forward {set options($option) reverse}
215  reverse {set options($option) forward}
216  }
217  }
218  }
219  }
220  method _gettruedirection {option} {
221  ## @private A method to fake direction for frog facing switches.
222  # @param option This is always -direction.
223  # @returns Either forward or reverse.
224 
225  switch $options(-forwarddirection) {
226  forward {return $options($option)}
227  reverse {
228  switch $options($option) {
229  forward {return reverse}
230  reverse {return forward}
231  }
232  }
233  }
234  }
235 
236  method occupiedp {} {
237  ## The occupiedp method returns yes or no (true or false) indicating
238  # block occupation.
239 
240  # First read the current sensor state.
241  set bit [$acela Read [$self cget -osaddress]]
242  if {$bit == 1} {
243  if {$isoccupied} {
244  # Already entered the block.
245  return $isoccupied
246  } else {
247  # Just entered the block
248  set isoccupied yes
249  $self _entering
250  return $isoccupied
251  }
252  } else {
253  if {$isoccupied} {
254  # Just left the block
255  set isoccupied no
256  $self _exiting
257  return $isoccupied
258  } else {
259  # Block still unoccupied
260  return $isoccupied
261  }
262  }
263  }
264 
265  typevariable _pointsense -array {
266  0x00 unknown
267  0x01 normal
268  0x02 reverse
269  0x03 unknown
270  }
271  ## @private Point sense bit values
272 
273  method pointstate {} {
274  ## The pointstate method returns normal if the points are aligned to
275  # the main route and reverse if the points are aligned to the divergent
276  # route. If the state cannot be determined, a value of unknown is
277  # returned.
278  # @returns Normal or reverse, indicating the point state.
279 
280  # Assume point state is unknown.
281  set result unknown
282  set bit0 [$acela Read [$self cget -pointsense]]
283  set bit1 [$acela Read [expr {[$self cget -pointsense] + 1}]]
284  set bits [expr {$bit0 | ($bit1 << 1)}]
285  set result $_pointsense($bits)
286  if {[$self cget -plate] ne {}} {
287  set plate [$self cget -plate]
288  switch $result {
289  normal {
290  MainWindow ctcpanel seti $plate N on
291  MainWindow ctcpanel seti $plate C off
292  MainWindow ctcpanel seti $plate R off
293  }
294  reverse {
295  MainWindow ctcpanel seti $plate N off
296  MainWindow ctcpanel seti $plate C off
297  MainWindow ctcpanel seti $plate R on
298  }
299  unknown {
300  MainWindow ctcpanel seti $plate N off
301  MainWindow ctcpanel seti $plate C on
302  MainWindow ctcpanel seti $plate R off
303  }
304  }
305  }
306  return $result
307  }
308  typevariable _routes
309  ## @private Route check validation object.
310  typeconstructor {
311  set _routes [snit::enum _routes -values {normal reverse}]
312  }
313 
314  method motor {route} {
315  ## The motor method sets the switch motor to align the points for the
316  # specificed route.
317  # @param route The desired route. A value of normal means align the
318  # points to the main (straight) route and a value of reverse means
319  # align the points to the divergent route.
320 
321  $_routes validate $route
322  $acela Deactivate [$self cget -motoraddress]
323  $acela Deactivate [expr {[$self cget -motoraddress] + 1}]
324  switch $route {
325  normal {
326  $acela Activate [$self cget -motoraddress]
327  }
328  reverse {
329  $acela Activate [expr {[$self cget -motoraddress] + 1}]
330  }
331  }
332  }
333  method _entering {} {
334  ## @protected Code to run when just entering the OS
335  # Sets the signal aspects and propagates signal state.
336 
337  switch $options(-direction) {
338  forward {
339  # Forward direction, set point end signal and propagate back
340  # from the points.
341  if {$forwardsignal ne {}} {$forwardsignal setaspect {red red}}
342  if {[$self cget -previousblock] ne {}} {
343  [$self cget -previousblock] propagate yellow $self -direction [$self cget -direction]
344  }
345  }
346  reverse {
347  # Reverse direction.
348  switch [$self pointstate] {
349  normal {
350  # Set the main frog end signal and propagate down the
351  # main.
352  if {$reversemainsignal ne {}} {
353  $reversemainsignal setaspect red
354  }
355  if {[$self cget -nextmainblock] ne {}} {
356  [$self cget -nextmainblock] propagate yellow $self -direction [$self cget -direction]
357  }
358  }
359  reverse {
360  # Set the divergent frog end signal and propagate down
361  # the divergent route.
362  if {$reversedivergentsignal ne {}} {
363  $reversedivergentsignal setaspect red
364  }
365  if {[$self cget -nextdivergentblock] ne {}} {
366  [$self cget -nextdivergentblock] propagate yellow $self -direction [$self cget -direction]
367  }
368  }
369  }
370  }
371  }
372  }
373  method _exiting {} {
374  ## @protected Code to run when about to exit the OS
375  }
376  method propagate {aspect from args} {
377  ## @publicsection Method used to propagate distant signal states back down the line.
378  # @param aspect The signal aspect that is being propagated.
379  # @param from The propagating block.
380  # @param ... Options:
381  # @arg -direction The direction of the propagation.
382 
383  set from [regsub {^::} $from {}]
384  $self configurelist $args
385  if {[$self occupiedp]} {return}
386 
387  switch $options(-direction) {
388  forward {
389  # Propagate back from the points.
390  switch [$self pointstate] {
391  normal {
392  # Points are normal, upper head is a logical block
393  # signal, but don't propagate against the points.
394  if {$from ne [regsub {^::} [$self cget -nextmainblock] {}]} {return}
395  if {$forwardsignal ne {}} {
396  $forwardsignal setaspect [list $aspect red]
397  }
398  }
399  reverse {
400  # Points are reversed, lower head is the controling
401  # head, but has no yellow.
402  # But don't propagate against the points.
403  if {$from ne [regsub {^::} [$self cget -nextdivergentblock] {}]} {return}
404  if {$forwardsignal ne {}} {
405  $forwardsignal setaspect [list red green]
406  }
407  }
408  }
409  # Propagate back from the points.
410  if {$aspect eq "yellow"} {
411  if {[$self cget -previousblock] ne {}} {
412  [$self cget -previousblock] propagate green $self -direction [$self cget -direction]
413  }
414  }
415  }
416  reverse {
417  # Reverse direction, propagate towards the frog end.
418  switch [$self pointstate] {
419  normal {
420  # Points normal, propagate down the main.
421  if {$reversemainsignal ne {}} {
422  $reversemainsignal setaspect $aspect
423  }
424  if {$aspect eq "yellow"} {
425  if {[$self cget -nextmainblock] ne {}} {
426  [$self cget -nextmainblock] propagate green $self -direction [$self cget -direction]
427  }
428  }
429  }
430  reverse {
431  # Points reversed, propagate down the divergent route.
432  if {$reversedivergentsignal ne {}} {
433  $reversedivergentsignal setaspect $aspect
434  }
435  if {$aspect eq "yellow"} {
436  if {[$self cget -nextdivergentblock] ne {}} {
437  [$self cget -nextdivergentblock] propagate green $self -direction [$self cget -direction]
438  }
439  }
440  }
441  }
442  }
443  }
444  }
445 
446 
447 }
448 
449 package provide TB_Switch 1.0
Switch (turnout) operation using a CTI Train Brain and Yardmaster.
Definition: TB_Switch.tcl:49