Model Railroad System  2.2.1
MRD2_Block.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 : Sun Jul 12 11:27:53 2015
11 # Last Modified : <150726.1009>
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 
45 package require Azatrax;# require the Azatrax package
46 package require snit;# require the SNIT OO framework
47 
48 
49 
50 
51 snit::type MRD2_Block {
52  ##
53  # @brief Block occupation detection using Azatrax MRD2Us
54  #
55  # @image html MRD2_Block-thumb.png
56  # @image latex MRD2_Block.png "Block detection using a MRD2" width=5in
57  #
58  # Above is a simple diagram for using Azatrax MRD2Us for block occupation
59  # detection. The Azatrax MRD2U has two IR sensors and one can be use to test
60  # for entering a block and one for leaving a block.
61  #
62  # Typical usage:
63  #
64  #
65  # Four blocks in a loop:
66  #
67  # @code
68  # MRD2_Block block1 -sensorsn 0200001234 -forwardsignalobj signal1
69  # MRD2_Block block2 -sensorsn 0200001235 -forwardsignalobj signal2 -previousblock block1
70  # MRD2_Block block3 -sensorsn 0200001236 -forwardsignalobj signal3 -previousblock block2
71  # MRD2_Block block4 -sensorsn 0200001237 -forwardsignalobj signal4 -previousblock block3
72  # block1 configure -previousblock block4
73  # @endcode
74  # A Schematic of the layout would look like this:
75  # @image html 4circleblocks.png
76  # @image latex 4circleblocks.png "Four block circle" width=3in
77  # For the track work elements use "blockN occupiedp" for the track work
78  # elements' occupied command:
79  # eg Block1 would have 'block1 occupiedp' as its occupied command, that is
80  # its edit window would look like:
81  # @image html EditingBlock1.png
82  # @image latex EditingBlock1.png "Editing Block1" width=5in
83  # The other three blocks would be similar.
84  #
85  #
86  # Then in the Main Loop, you would have:
87  # @code
88  # while {true} {
89  # MainWindow ctcpanel invoke Block1
90  # MainWindow ctcpanel invoke Block2
91  # MainWindow ctcpanel invoke Block3
92  # MainWindow ctcpanel invoke Block4
93  # update;# Update display
94  # }
95  # @endcode
96  #
97  # @author Robert Heller \<heller\@deepsoft.com\>
98 
99 
100  option -sensorsn -readonly yes -default {}
101  option -forwardsignalobj -readonly yes -default {}
102  option -reversesignalobj -readonly yes -default {}
103  option -previousblock -type MRD2_Block -default {}
104  option -nextblock -type MRD2_Block -default {}
105  option -direction -type {snit::enum -values {forward reverse}} -default forward
106  typemethod validate {object} {
107  ## Type validating code
108  # Raises an error if object is not either the empty string or a MRD2_Block
109  # type.
110 
111  if {$object eq ""} {
112  return $object;# Empty or null objects are OK
113  } elseif {[catch {$object info type} itstype]} {
114  error "$object is not a $type";# object is not a SNIT type
115  } elseif {$itstype eq $type} {
116  return $object;# Object is of our type (Block)
117  } else {
118  error "$object is not a $type";# object is something else
119  }
120  }
121  component sensor
122  ## @privatesection MRD2 object
123  component forwardsignal
124  ## Signal object (typically a three color, one head block signal
125  component reversesignal
126  ## Signal object (typically a three color, one head block signal
127 
128  constructor {args} {
129  ## @publicsection @brief Constructor: initialize the block object.
130  #
131  # Create a low level sensor object and install it as a component.
132  # Install the blocks signal (created elsewhere).
133  #
134  # @param name Name of the block object
135  # @param ... Options:
136  # @arg -sensorsn Serial number of the MRD2U for this block.
137  # This option is read-only and must be set at creation time.
138  # @arg -forwardsignalobj This block's forward signal. This option is
139  # read-only and can only be set at creation time. The default is the
140  # empty string.
141  # @arg -reversesignalobj This block's reverse signal. This option is
142  # read-only and can only be set at creation time. The default is the
143  # empty string.
144  # @arg -previousblock Previous block (next block in reverse) -- used
145  # for 'propagating' signal aspects and must be a MRD2_Block type
146  # object. The default is the empty string.
147  # @arg -nextblock Next block (previous block in reverse) -- used for
148  # 'propagating' signal aspects and must be a MRD2_Block type object.
149  # The default is the empty string.
150  # @arg -direction Current running direction, either the word forward
151  # or reverse. The default is forward.
152  # @par
153 
154  set options(-sensorsn) [from args -sensorsn];# prefetch the MRD2U's
155  # serial number
156  if {$options(-sensorsn) eq {}} {
157  error "The -sensorsn is required!"
158  }
159  # Create a MRD object and install it as a component
160  install sensor using Azatrax_OpenDevice $options(-sensorsn) \
161  $::Azatrax_idMRDProduct
162  ## Process any other options
163  $self configurelist $args
164  # Install the signal components.
165  set forwardsignal [$self cget -forwardsignalobj]
166  set reversesignal [$self cget -reversesignalobj]
167  }
168  method occupiedp {} {
169  ## The occupiedp method returns yes or no (true or false) indicating
170  # block occupation.
171 
172  # First read the current sensor state.
173  $sensor GetSenseData
174  if {[$self cget -direction] eq "forward"} {
175  if {[$sensor Sense_1]} {
176  # Sensor one is covered -- a train is entering the block
177  # Run the entering code and return yes
178  $self _entering
179  return yes
180  } elseif {[$sensor Sense_2]} {
181  # Sensor two is covered -- a train is leaving the block.
182  # Run the exit code and return yes
183  $self _exiting
184  return yes
185  } elseif {[$sensor Latch_1]} {
186  # Neither sensor is covered, but the first sensor's latch is set.
187  # This means that there is a train between the sensors -- the
188  # train is fully in the block.
189  return yes
190  } else {
191  # All other cases: block is unoccupied.
192  return no
193  }
194  } else {
195  if {[$sensor Sense_2]} {
196  # Sensor one is covered -- a train is entering the block
197  # Run the entering code and return yes
198  $self _entering
199  return yes
200  } elseif {[$sensor Sense_1]} {
201  # Sensor two is covered -- a train is leaving the block.
202  # Run the exit code and return yes
203  $self _exiting
204  return yes
205  } elseif {[$sensor Latch_2]} {
206  # Neither sensor is covered, but the first sensor's latch is set.
207  # This means that there is a train between the sensors -- the
208  # train is fully in the block.
209  return yes
210  } else {
211  # All other cases: block is unoccupied.
212  return no
213  }
214  }
215  }
216  method _entering {} {
217  ## @privatesection Method for entering a block.
218 
219  if {[$self cget -direction] eq "forward"} {
220  # Set a red (stop and proceed) aspect.
221  if {$forwardsignal ne ""} {$forwardsignal setaspect red}
222  # Now propagate the signal to the previous block (if any)
223  if {$options(-previousblock) ne {}} {
224  # Set a yellow (approach) aspect on the previous block.
225  $options(-previousblock) propagate yellow $self -direction forward
226  }
227  } else {
228  if {$reversesignal ne ""} {$reversesignal setaspect red}
229  # Now propagate the signal to the previous block (if any)
230  if {$options(-nextblock) ne {}} {
231  # Set a yellow (approach) aspect on the previous block.
232  $options(-nextblock) propagate yellow $self -direction reverse
233  }
234  }
235  }
236  method _exiting {} {
237  ## Method for exiting a block.
238 
239  # Nothing here -- could be used for any sort of exit handling.
240  }
241  method propagate {aspect from args} {
242  ## @publicsection Method used to propagate distant signal states back down the line.
243  # @param aspect The signal aspect that is being propagated.
244  # @param from The propagating block (not used).
245  # @param ... Options:
246  # @arg -direction The direction of the propagation.
247 
248  ## First process any options
249  $self configurelist $args
250  ## If we are already occupiedp, don't do anything else.
251  if {[$self occupiedp]} {return}
252  if {[$self cget -direction] eq "forward"} {
253  # Set signal aspect
254  if {$forwardsignal ne ""} {$forwardsignal setaspect $aspect}
255  # If the new aspect was yellow, propagate a green (clear) signal
256  if {$aspect eq "yellow"} {
257  if {$options(-previousblock) ne {}} {
258  $options(-previousblock) propagate green $self -direction forward
259  }
260  }
261  } else {
262  # Set signal aspect
263  if {$reversesignal ne ""} {$reversesignal setaspect $aspect}
264  # If the new aspect was yellow, propagate a green (clear) signal
265  if {$aspect eq "yellow"} {
266  if {$options(-nextblock) ne {}} {
267  $options(-nextblock) propagate green $self -direction reverse
268  }
269  }
270  }
271  }
272 }
273 
274 
275 package provide MRD2_Block 1.0
MRD2_Block
Block occupation detection using Azatrax MRD2Us.
Definition: MRD2_Block.tcl:51