Model Railroad System  2.2.1
SR4_C4TSR4_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 : Fri Jul 24 20:07:30 2015
11 # Last Modified : <150725.0839>
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 Azatrax;# require the Azatrax package
45 package require snit;# require the SNIT OO framework
46 
47 snit::type SR4_C4TSR4_Switch {
48  ##
49  # @brief Switch (turnout) operation using 1/2 of a SR4
50  #
51  # @image html switch-SR4-C4TSR4-thumb.png
52  # @image latex switch-SR4-C4TSR4.png "Switch controlled by a SR4 with a Circuits4Tracks OS detection using a second SR4" width=5in
53  #
54  # Above is a typical switch (turnout) using an Azatrax SR4 to control a
55  # Circuitron Tortoise Switch Machine and to sense the point position and
56  # a Circuits4Track quad occupancy detector and a second SR4 to sense
57  # occupation of the switch.
58  #
59  # Typical usage:
60  #
61  # @code
62  # SR4 turnoutControl1 \
63  # -this [Azatrax_OpenDevice 0400001234 $::Azatrax_idSR4Product]
64  # SR4 quadsense1 \
65  # -this [Azatrax_OpenDevice 0400001235 $::Azatrax_idSR4Product]
66  #
67  # # Disable inputs controlling outputs.
68  # turnoutControl1 OutputRelayInputControl 0 0 0 0
69  # quadsense1 OutputRelayInputControl 0 0 0 0
70  # # Switch 1 is controlled and sensed by the lower 1/2 of turnoutControl1
71  # SR4_C4TSR4_Switch switch1 -motorobj turnoutControl1 -motorhalf lower \
72  # -pointsenseobj turnoutControl1 \
73  # -pointsensehalf lower -plate SwitchPlate1 \
74  # -ossensorobj quadsense1 -bit 0
75  # # Switch2 is controlled and sensed by the upper 1/2 of turnoutControl1
76  # SR4_C4TSR4_Switch switch2 -motorobj turnoutControl1 -motorhalf upper \
77  # -pointsenseobj turnoutControl1 \
78  # -pointsensehalf upper -plate SwitchPlate2 \
79  # -ossensorobj quadsense1 -bit 1
80  # @endcode
81  #
82  # For the track work elements use "switchN occupiedp" for the track work
83  # elements' occupied script and use "switchN pointstate" for the track
84  # work elements' state script. For the switch plate use
85  # "switchN motor normal" for the normal script and "switchN motor reverse"
86  # for the reverse script.
87  #
88  # Then in the Main Loop, you would have:
89  # @code
90  # while {true} {
91  # MainWindow ctcpanel invoke Switch1
92  # MainWindow ctcpanel invoke Switch2
93  # MainWindow ctcpanel invoke SwitchPlate1
94  # MainWindow ctcpanel invoke SwitchPlate2
95  # update;# Update display
96  # }
97  # @endcode
98  #
99  # @author Robert Heller \<heller\@deepsoft.com\>
100 
101  # Azatrax related options
102  # Motor control (SR4 relays)
103  option -motorobj -readonly yes -default {}
104  option -motorhalf -readonly yes -default lower \
105  -type {snit::enum -values {lower upper}}
106  # Point sense (SR4 inputs)
107  option -pointsenseobj -readonly yes -default {}
108  option -pointsensehalf -readonly yes -default lower \
109  -type {snit::enum -values {lower upper}}
110  # Occupancy (OS) sensor
111  option -ossensorobj -readonly yes -default {}
112  option -bit -readonly yes -default 0 -type {snit::integer -min 0 -max 3}
113 
114 
115  # Signal related options
116  # The forward direction means entering at the point end.
117  option -direction -type {snit::enum -values {forward reverse}} \
118  -default forward -configuremethod _settruedirection \
119  -cgetmethod _gettruedirection
120  # If the switch is installed opposite the overall traffic flow (eg it is
121  # a frog facing switch), then -forwarddirection needs to be set for
122  # reverse operation.
123  option -forwarddirection \
124  -type {snit::enum -values {forward reverse}} -default forward \
125  -readonly yes
126  # The forward signal is the signal protecting the points
127  option -forwardsignalobj -readonly yes -default {}
128  # The previous block is the block connected to the points
129  option -previousblock -default {}
130  # The reverse main signal is the signal protecting the straight frog end
131  option -reversemainsignalobj -readonly yes -default {}
132  # The next main block is the block connected to the main frog end
133  option -nextmainblock -default {}
134  # The reverse divergent signal is the signal protecting the divergent frog end
135  option -reversedivergentsignalobj -readonly yes -default {}
136  # The next divergent block is the block connected to the divergent frog end
137  option -nextdivergentblock -default {}
138  # Switch Plate name (if any).
139  option -plate -default {}
140 
141  component motor
142  ## @private Motor device (SR4 outputs)
143  component pointsense
144  ## @private Point sense device (SR4 inputs)
145  component ossensor
146  ## @private SR4 object
147  variable isoccupied no
148  ## @private Saved occupation state.
149  typevariable sensemap -array {
150  0 Sense_1_Latch
151  1 Sense_2_Latch
152  2 Sense_3_Latch
153  3 Sense_4_Latch
154  }
155  ## @private Sensor bit mapping to sensor functions.
156 
157  typemethod validate {object} {
158  ## Type validating code
159  # Raises an error if object is not either the empty string or a SR4_C4TSR4_Switch
160  # type.
161  # @param object Some object.
162 
163  if {$object eq ""} {
164  return $object;# Empty or null objects are OK
165  } elseif {[catch {$object info type} itstype]} {
166  error "$object is not a $type";# object is not a SNIT type
167  } elseif {$itstype eq $type} {
168  return $object;# Object is of our type (SR4_C4TSR4_Switch)
169  } else {
170  error "$object is not a $type";# object is something else
171  }
172  }
173 
174  constructor {args} {
175  ## @brief Constructor: initialize the switch object.
176  #
177  # Create a low level sensor object and install it as a component.
178  # Install the switch's signals, motor, and point sense objects.
179  #
180  # @param name Name of the switch object
181  # @param ... Options:
182  # @arg -motorobj Object (SR4) that controls the motor.
183  # @arg -motorhalf Which half: lower means Q1 and Q2, upper means Q3
184  # and Q4.
185  # @arg -pointsenseobj Object (SR4) that senses the point state.
186  # @arg -pointsensehalf Which half: lower means I1 and I2, upper means
187  # I3 and I4.
188  # @arg -ossensorobj Object (SR4) that senses occupation (via the C4T)
189  # @arg -bit This defines the input bit on the SR4 for this block as an
190  # integer from 0 to 3, inclusive. This option is read-only and can
191  # only be set at creation time. The default is 0.
192  # @arg -direction The current direction of travel. Forward always
193  # means entering at the point end.
194  # @arg -forwarddirection The @e logial forward direction. Set this
195  # to reverse for a frog facing switch. Default is forward and it
196  # is readonly and can only be set during creation.
197  # @arg -forwardsignalobj The signal object protecting the points.
198  # Presumed to be a two headed signal, with the upper head relating to
199  # the main (straight) route and the lower head relating to the
200  # divergent route. The upper head has three colors: red, yellow, and
201  # green. The lower head only two: red and green.
202  # @arg -reversemainsignalobj The signal object protecting the straight
203  # frog end. Presumed to be single headed (with number plate).
204  # @arg -reversedivergentsignalobj The signal object protecting the
205  # divergent frog end. Presumed to be single headed (with number plate).
206  # @arg -previousblock The block connected to the point end.
207  # @arg -nextmainblock The block connected to the straight frog end.
208  # @arg -nextdivergentblock The block connected to the divergent frog
209  # end.
210  # @arg -plate The name of the switch plate for this switch.
211 
212  # Prefetch the -forwarddirection option.
213  set options(-forwarddirection) [from args -forwarddirection]
214  ## Process any other options
215  $self configurelist $args
216  set ossensor [from args -ossensorobj]
217  if {$ossensor eq {}} {
218  error "The -ossensorobj option is required!"
219  }
220  set motor [$self cget -motorobj]
221  if {$motor eq {}} {
222  error "The -motor option is required!"
223  }
224  set pointsense [$self cget -pointsenseobj]
225  set forwardsignal [$self cget -forwardsignalobj]
226  set reversemainsignal [$self cget -reversemainsignalobj]
227  set reversedivergentsignal [$self cget -reversedivergentsignalobj]
228  }
229 
230  method _settruedirection {option value} {
231  ## @private A method to fake direction for frog facing switches.
232  # @param option This is always -direction.
233  # @param value Either forward or reverse.
234  switch $options(-forwarddirection) {
235  forward {
236  set options($option) $value
237  }
238  reverse {
239  switch $value {
240  forward {set options($option) reverse}
241  reverse {set options($option) forward}
242  }
243  }
244  }
245  }
246  method _gettruedirection {option} {
247  ## @private A method to fake direction for frog facing switches.
248  # @param option This is always -direction.
249  # @returns Either forward or reverse.
250 
251  switch $options(-forwarddirection) {
252  forward {return $options($option)}
253  reverse {
254  switch $options($option) {
255  forward {return reverse}
256  reverse {return forward}
257  }
258  }
259  }
260  }
261 
262  method occupiedp {} {
263  ## The occupiedp method returns yes or no (true or false) indicating
264  # block (OS) occupation.
265  # @returns Yes or no, indicating whether the OS is occupied.
266 
267  # First read the current sensor state.
268  $ossensor GetSenseData
269  if {[$ossensor $sensemap($options(-bit))]} {
270  if {$isoccupied} {
271  # Already entered the OS.
272  return $isoccupied
273  } else {
274  # Just entered the OS
275  set isoccupied yes
276  $self _entering
277  return $isoccupied
278  }
279  } else {
280  if {$isoccupied} {
281  # Just left the OS
282  set isoccupied no
283  $self _exiting
284  return $isoccupied
285  } else {
286  # OS still unoccupied
287  return $isoccupied
288  }
289  }
290  }
291  method pointstate {} {
292  ## The pointstate method returns normal if the points are aligned to
293  # the main route and reverse if the points are aligned to the divergent
294  # route. If the state cannot be determined, a value of unknown is
295  # returned.
296  # @returns Normal or reverse, indicating the point state.
297 
298  # Assume point state is unknown.
299  set result unknown
300 
301  # Check for a point sensor. If none, use motor position instead.
302  if {$pointsense eq {}} {
303  # No point sense object -- use motor position instead.
304  $motor GetStateData
305  if {[$self cget -motorhalf] eq "lower"} {
306  if {[$motor Q1_State]} {
307  set result normal
308  } elseif {[$motor Q2_State]} {
309  set result reverse
310  } else {
311  set result unknown
312  }
313  } else {
314  if {[$motor Q3_State]} {
315  set result normal
316  } elseif {[$motor Q4_State]} {
317  set result reverse
318  } else {
319  set result unknown
320  }
321  }
322  } else {
323  # Fetch state
324  $pointsense GetStateData
325  if {[$self cget -pointsensehalf] eq "lower"} {
326  if {[$pointsense Sense_1_Live]} {
327  set result normal
328  } elseif {[$pointsense Sense_2_Live]} {
329  set result reverse
330  } else {
331  set result unknown
332  }
333  } else {
334  if {[$pointsense Sense_3_Live]} {
335  set result normal
336  } elseif {[$pointsense Sense_4_Live]} {
337  set result reverse
338  } else {
339  set resultunknown
340  }
341  }
342  }
343  if {[$self cget -plate] ne {}} {
344  set plate [$self cget -plate]
345  switch $result {
346  normal {
347  MainWindow ctcpanel seti $plate N on
348  MainWindow ctcpanel seti $plate C off
349  MainWindow ctcpanel seti $plate R off
350  }
351  reverse {
352  MainWindow ctcpanel seti $plate N off
353  MainWindow ctcpanel seti $plate C off
354  MainWindow ctcpanel seti $plate R on
355  }
356  unknown {
357  MainWindow ctcpanel seti $plate N off
358  MainWindow ctcpanel seti $plate C on
359  MainWindow ctcpanel seti $plate R off
360  }
361  }
362  }
363  return $result
364  }
365  typevariable _routes
366  ## @private Route check validation object.
367  typeconstructor {
368  set _routes [snit::enum _routes -values {normal reverse}]
369  }
370 
371  method motor {route} {
372  ## The motor method sets the switch motor to align the points for the
373  # specificed route.
374  # @param route The desired route. A value of normal means align the
375  # points to the main (straight) route and a value of reverse means
376  # align the points to the divergent route.
377 
378  $_routes validate $route
379  switch $route {
380  normal {
381  if {[$self cget -motorhalf] eq "lower"} {
382  $motor RelaysOff 1 1 0 0
383  $motor RelaysOn 1 0 0 0
384  } else {
385  $motor RelaysOff 0 0 1 1
386  $motor RelaysOn 0 0 1 0
387  }
388  if {$reversedivergentsignal ne {}} {
389  $reversedivergentsignal setaspect red
390  }
391  }
392  reverse {
393  if {[$self cget -motorhalf] eq "lower"} {
394  $motor RelaysOff 1 1 0 0
395  $motor RelaysOn 0 1 0 0
396  } else {
397  $motor RelaysOff 0 0 1 1
398  $motor RelaysOn 0 0 0 1
399  }
400  if {$reversemainsignal ne {}} {
401  $reversemainsignal setaspect red
402  }
403  }
404  }
405  }
406  method _entering {} {
407  ## @protected Code to run when just entering the OS
408  # Sets the signal aspects and propagates signal state.
409 
410  switch $options(-direction) {
411  forward {
412  # Forward direction, set point end signal and propagate back
413  # from the points.
414  if {$forwardsignal ne {}} {$forwardsignal setaspect {red red}}
415  if {[$self cget -previousblock] ne {}} {
416  [$self cget -previousblock] propagate yellow $self -direction [$self cget -direction]
417  }
418  }
419  reverse {
420  # Reverse direction.
421  switch [$self pointstate] {
422  normal {
423  # Set the main frog end signal and propagate down the
424  # main.
425  if {$reversemainsignal ne {}} {
426  $reversemainsignal setaspect red
427  }
428  if {[$self cget -nextmainblock] ne {}} {
429  [$self cget -nextmainblock] propagate yellow $self -direction [$self cget -direction]
430  }
431  }
432  reverse {
433  # Set the divergent frog end signal and propagate down
434  # the divergent route.
435  if {$reversedivergentsignal ne {}} {
436  $reversedivergentsignal setaspect red
437  }
438  if {[$self cget -nextdivergentblock] ne {}} {
439  [$self cget -nextdivergentblock] propagate yellow $self -direction [$self cget -direction]
440  }
441  }
442  }
443  }
444  }
445  }
446  method _exiting {} {
447  ## @protected Code to run when about to exit the OS
448  }
449  method propagate {aspect from args} {
450  ## @publicsection Method used to propagate distant signal states back down the line.
451  # @param aspect The signal aspect that is being propagated.
452  # @param from The propagating block.
453  # @param ... Options:
454  # @arg -direction The direction of the propagation.
455 
456  set from [regsub {^::} $from {}]
457  $self configurelist $args
458  if {[$self occupiedp]} {return}
459 
460  switch $options(-direction) {
461  forward {
462  # Propagate back from the points.
463  switch [$self pointstate] {
464  normal {
465  # Points are normal, upper head is a logical block
466  # signal, but don't propagate against the points.
467  if {$from ne [regsub {^::} [$self cget -nextmainblock] {}]} {return}
468  if {$forwardsignal ne {}} {
469  $forwardsignal setaspect [list $aspect red]
470  }
471  }
472  reverse {
473  # Points are reversed, lower head is the controling
474  # head, but has no yellow.
475  # But don't propagate against the points.
476  if {$from ne [regsub {^::} [$self cget -nextdivergentblock] {}]} {return}
477  if {$forwardsignal ne {}} {
478  $forwardsignal setaspect [list red green]
479  }
480  }
481  }
482  # Propagate back from the points.
483  if {$aspect eq "yellow"} {
484  if {[$self cget -previousblock] ne {}} {
485  [$self cget -previousblock] propagate green $self -direction [$self cget -direction]
486  }
487  }
488  }
489  reverse {
490  # Reverse direction, propagate towards the frog end.
491  switch [$self pointstate] {
492  normal {
493  # Points normal, propagate down the main.
494  if {$reversemainsignal ne {}} {
495  $reversemainsignal setaspect $aspect
496  }
497  if {$aspect eq "yellow"} {
498  if {[$self cget -nextmainblock] ne {}} {
499  [$self cget -nextmainblock] propagate green $self -direction [$self cget -direction]
500  }
501  }
502  }
503  reverse {
504  # Points reversed, propagate down the divergent route.
505  if {$reversedivergentsignal ne {}} {
506  $reversedivergentsignal setaspect $aspect
507  }
508  if {$aspect eq "yellow"} {
509  if {[$self cget -nextdivergentblock] ne {}} {
510  [$self cget -nextdivergentblock] propagate green $self -direction [$self cget -direction]
511  }
512  }
513  }
514  }
515  }
516  }
517  }
518 }
519 
520 package provide SR4_C4TSR4_Switch 1.0
SR4_C4TSR4_Switch
Switch (turnout) operation using 1/2 of a SR4.
Definition: SR4_C4TSR4_Switch.tcl:57