Model Railroad System  2.2.1
Azatrax_Signals.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 26 09:16:15 2015
11 # Last Modified : <150728.1943>
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 namespace eval azatrax_signals {
48 ## @defgroup Azatrax_Signals Using SR4s to Operate Signals
49 # @brief Classes to operate signals using SR4s.
50 #
51 # This file contains code to operate various sorts of signals using Azatrax
52 # SR4s.
53 #
54 # Typical wiring for LED common anode signals:
55 # @image html Azatrax_Signals-thumb.png
56 # @image latex Azatrax_Signals.png "Connecting a three LED common anode signal to a SR4." width=5in
57 # See the specific classes for how they expect the signals to be wired.
58 # @{
59 
60 snit::enum signalcolors -values {
61  ## @enum signalcolors
62  # @brief Basic signal colors.
63  # The four values are dark, red, yellow, and green.
64 
65  dark
66  ## Dark, all lamps off, implies red.
67 
68  red
69  ## Red, generally stop or stop and proceed.
70 
71  yellow
72  ## Yellow, generally approach.
73 
74  green
75  ## Green, generally clear.
76 }
77 
78 snit::type OneHead3Color {
79  ## @brief Single head signals, 3 color.
80  #
81  # Typically used for simple block signals. One SR4, with Q1 connected to
82  # the top lamp (green), Q2 connected to the middle lamp (yellow), and
83  # Q3 connected to the bottom lamp (red).
84  #
85  # Typical usage:
86  #
87  # @code
88  # azatrax_signals::OneHead3Color blocksignal1 -signalsn 0400001234 -signalname Signal1
89  # @endcode
90  #
91  # @author Robert Heller \<heller\@deepsoft.com\>
92 
93  # Azatrax related options
94  option -signalsn -readonly yes -default {}
95  # Signal name
96  option -signalname -readonly yes -default {}
97 
98  component signal
99  ## @private Signal driver (SR4)
100 
101  typemethod validate {object} {
102  ## Type validating code
103  # Raises an error if object is not either the empty string or a
104  # OneHead3Color type object.
105  # @param object Some object.
106 
107  if {$object eq ""} {
108  return $object;# Empty or null objects are OK
109  } elseif {[catch {$object info type} itstype]} {
110  error "$object is not a $type";# object is not a SNIT type
111  } elseif {$itstype eq $type} {
112  return $object;# Object is of our type.
113  } else {
114  error "$object is not a $type";# object is something else
115  }
116  }
117 
118  constructor {args} {
119  ## @brief Constructor: initialize the signal object.
120  #
121  # Create a low level actuator object and install it as a component.
122  #
123  # @param name Name of the signal object.
124  # @param ... Options:
125  # @arg -signalsn Serial number of the SR4 that controls this signal.
126  # @arg -signalname Name of the signal on the track work schematic.
127  # @par
128 
129  # Prefetch the -signalsn option.
130  set options(-signalsn) [from args -signalsn]
131  if {$options(-signalsn) eq {}} {
132  error "The -signalsn option is required!"
133  }
134  install signal using Azatrax_OpenDevice $options(-signalsn) \
135  $::Azatrax_idSR4Product
136  # Disconnect relays from inputs.
137  $signal OutputRelayInputControl 0 0 0 0
138  # Turn off all relays (set signal to dark aspect).
139  $signal RelaysOff 1 1 1 0
140  }
141 
142  method setaspect {aspect} {
143  ## Set signal aspect.
144  #
145  # @param aspect New aspect color.
146 
147  signalcolors validate $aspect
148  $signal RelaysOff 1 1 1 0
149  set sig [$self cget -signalname]
150  if {$sig ne {}} {MainWindow ctcpanel setv $sig $aspect}
151  switch $aspect {
152  red {
153  $signal RelaysOn 0 0 1 0
154  }
155  yellow {
156  $signal RelaysOn 0 1 0 0
157  }
158  green {
159  $signal RelaysOn 1 0 0 0
160  }
161  }
162  }
163 }
164 
165 snit::listtype twoaspectlist -minlen 2 -maxlen 2 -type signalcolors
166 ## @typedef twoaspectlist
167 # @brief Aspects for two headed signals.
168 # This is a list of two aspect colors, the first element for the upper head
169 # and the second element for the lower head.
170 
171 snit::type TwoHead3over2 {
172  ## @brief Two head signals, 3 over 2.
173  #
174  # Typically used for simple interlocking signals. Two SR4s, with one
175  # driving the top head: with Q1 connected to the top lamp (green), Q2
176  # connected to the middle lamp (yellow), and Q3 connected to the bottom
177  # lamp (red). The second SR4 wired to the lower head, its Q1 connected to
178  # the top lamp (green or yellow), and Q2 to the bottom lamp (red).
179  #
180  # Typical usage:
181  #
182  # @code
183  # azatrax_signals::TwoHead3over2 interlocksignal1 \
184  # -signalsnupper 0400001234 \
185  # -signalsnlower 0400001235 \
186  # -signalname Signal1
187  # @endcode
188  #
189  # @author Robert Heller \<heller\@deepsoft.com\>
190 
191  # Azatrax related options
192  option -signalsnupper -readonly yes -default {}
193  option -signalsnlower -readonly yes -default {}
194  # Signal name
195  option -signalname -readonly yes -default {}
196 
197  component signalupper
198  ## @private Signal driver (SR4)
199  component signallower
200  ## @private Signal driver (SR4)
201 
202  typemethod validate {object} {
203  ## Type validating code
204  # Raises an error if object is not either the empty string or a
205  # TwoHead3over2 type object.
206  # @param object Some object.
207 
208  if {$object eq ""} {
209  return $object;# Empty or null objects are OK
210  } elseif {[catch {$object info type} itstype]} {
211  error "$object is not a $type";# object is not a SNIT type
212  } elseif {$itstype eq $type} {
213  return $object;# Object is of our type.
214  } else {
215  error "$object is not a $type";# object is something else
216  }
217  }
218 
219  constructor {args} {
220  ## @brief Constructor: initialize the signal object.
221  #
222  # Create a low level actuator object and install it as a component.
223  #
224  # @param name Name of the signal object.
225  # @param ... Options:
226  # @arg -signalsnupper Serial number of the SR4 that controls the upper
227  # head of this signal.
228  # @arg -signalsnlower Serial number of the SR4 that controls the lower
229  # head of this signal.
230  # @arg -signalname Name of the signal on the track work schematic.
231  # @par
232 
233  # Prefetch the -signalsnupper and -signalsnlower options.
234  set options(-signalsnupper) [from args -signalsnupper]
235  if {$options(-signalsnupper) eq {}} {
236  error "The -signalsnupper option is required!"
237  }
238  set options(-signalsnlower) [from args -signalsnlower]
239  if {$options(-signalsnlower) eq {}} {
240  error "The -signalsnlower option is required!"
241  }
242  install signalupper using Azatrax_OpenDevice $options(-signalsnupper) \
243  $::Azatrax_idSR4Product
244  install signallower using Azatrax_OpenDevice $options(-signalsnlower) \
245  $::Azatrax_idSR4Product
246  # Disconnect relays from inputs.
247  $signalupper OutputRelayInputControl 0 0 0 0
248  $signallower OutputRelayInputControl 0 0 0 0
249  # Turn off all relays (set signal to dark aspect).
250  $signalupper RelaysOff 1 1 1 0
251  $signallower RelaysOff 1 1 0 0
252  }
253 
254  method setaspect {aspect} {
255  ## Set signal aspect.
256  #
257  # @param aspect New aspect color.
258 
259  twoaspectlist validate $aspect
260  $signalupper RelaysOff 1 1 1 0
261  $signallower RelaysOff 1 1 0 0
262  set sig [$self cget -signalname]
263  if {$sig ne {}} {MainWindow ctcpanel setv $sig $aspect}
264  switch [lindex $aspect 0] {
265  red {
266  $signalupper RelaysOn 0 0 1 0
267  }
268  yellow {
269  $signalupper RelaysOn 0 1 0 0
270  }
271  green {
272  $signalupper RelaysOn 1 0 0 0
273  }
274  }
275  switch [lindex $aspect 1] {
276  red {
277  $signallower RelaysOn 0 1 0 0
278  }
279  green -
280  yellow {
281  # upper color (of lower head) is either green or yellow.
282  $signallower RelaysOn 1 0 0 0
283  }
284  }
285  }
286 
287 }
288 
289 snit::type TwoHead2over2 {
290  ## @brief Two head signals, 2 over 2.
291  #
292  # Typically used for simple interlocking signals. One SR4, driving both
293  # heads: with Q1 connected to the top lamp (green) or the top head, Q2
294  # connected to the bottom lamp (red) of the top head. Then Q3 connected to
295  # the top lamp (green or yellow) of othe lower head, and Q4 to the bottom
296  # lamp (red) of the lower head.
297  #
298  # Typical usage:
299  #
300  # @code
301  # azatrax_signals::TwoHead2over2 interlocksignal1 -signalsn 0400001234 \
302  # -signalname Signal1
303  # @endcode
304  #
305  # @author Robert Heller \<heller\@deepsoft.com\>
306 
307  # Azatrax related options
308  option -signalsn -readonly yes -default {}
309  # Signal name
310  option -signalname -readonly yes -default {}
311 
312  component signal
313  ## @private Signal driver (SR4)
314 
315  typemethod validate {object} {
316  ## Type validating code
317  # Raises an error if object is not either the empty string or a
318  # TwoHead2over2 type object.
319  # @param object Some object.
320 
321  if {$object eq ""} {
322  return $object;# Empty or null objects are OK
323  } elseif {[catch {$object info type} itstype]} {
324  error "$object is not a $type";# object is not a SNIT type
325  } elseif {$itstype eq $type} {
326  return $object;# Object is of our type.
327  } else {
328  error "$object is not a $type";# object is something else
329  }
330  }
331 
332  constructor {args} {
333  ## @brief Constructor: initialize the signal object.
334  #
335  # Create a low level actuator object and install it as a component.
336  #
337  # @param name Name of the signal object.
338  # @param ... Options:
339  # @arg -signals Serial number of the SR4
340  # @arg -signalname Name of the signal on the track work schematic.
341  # @par
342 
343  # Prefetch the -signalsn option.
344  set options(-signalsn) [from args -signalsn]
345  if {$options(-signalsn) eq {}} {
346  error "The -signalsn option is required!"
347  }
348  install signal using Azatrax_OpenDevice $options(-signalsn) \
349  $::Azatrax_idSR4Product
350  # Disconnect relays from inputs.
351  $signal OutputRelayInputControl 0 0 0 0
352  # Turn off all relays (set signal to dark aspect).
353  $signal RelaysOff 1 1 1 1
354  }
355 
356  method setaspect {aspect} {
357  ## Set signal aspect.
358  #
359  # @param aspect New aspect color.
360 
361  twoaspectlist validate $aspect
362  $signal RelaysOff 1 1 1 1
363  set sig [$self cget -signalname]
364  if {$sig ne {}} {MainWindow ctcpanel setv $sig $aspect}
365  switch [lindex $aspect 0] {
366  red {
367  $signal RelaysOn 0 1 0 0
368  }
369  yellow {}
370  green {
371  # upper color (of the upper head) is green.
372  $signal RelaysOn 1 0 0 0
373  }
374  }
375  switch [lindex $aspect 1] {
376  red {
377  $signal RelaysOn 0 0 0 1
378  }
379  green -
380  yellow {
381  # upper color (of the lower head) is either green or yellow.
382  $signal RelaysOn 0 0 1 0
383  }
384  }
385  }
386 
387 }
388 
389 snit::listtype threeaspectlist -minlen 3 -maxlen 3 -type signalcolors
390 ## @typedef threeaspectlist
391 # @brief Aspects for three headed signals.
392 # This is a list of three aspect colors, the first element for the upper head
393 # and the second element for the middle head, and finally the third element
394 # for the bottom head.
395 
396 snit::type ThreeHead3over2over2 {
397  ## @brief Three head signals, 3 over 2 over 2.
398  #
399  # Typically used for simple interlocking signals. Two SR4s, with one
400  # driving the top head: with Q1 connected to the top lamp (green), Q2
401  # connected to the middle lamp (yellow), and Q3 connected to the bottom
402  # lamp (red). The second SR4 wired to the middle and lower heads, its Q1
403  # connected to the top lamp (green or yellow) of the middle head, and Q2
404  # to the bottom lamp (red) of the middle head. Then Q3 is connected to the
405  # top lamp (green or yellow) of the bottom head, and Q4 connected to the
406  # bottom lamp (red) of the bottom head.
407  #
408  # Typical usage:
409  #
410  # @code
411  # azatrax_signals::TwoHead3over2over2 interlocksignal1 \
412  # -signalsnupper 0400001234 \
413  # -signalsnlower 0400001235 \
414  # -signalname Signal1
415  # @endcode
416  #
417  # @author Robert Heller \<heller\@deepsoft.com\>
418 
419  # Azatrax related options
420  option -signalsnupper -readonly yes -default {}
421  option -signalsnlower -readonly yes -default {}
422  # Signal name
423  option -signalname -readonly yes -default {}
424 
425  component signalupper
426  ## @private Signal driver (SR4)
427  component signallower
428  ## @private Signal driver (SR4)
429 
430  typemethod validate {object} {
431  ## Type validating code
432  # Raises an error if object is not either the empty string or a
433  # TwoHead3over2over2 type object.
434  # @param object Some object.
435 
436  if {$object eq ""} {
437  return $object;# Empty or null objects are OK
438  } elseif {[catch {$object info type} itstype]} {
439  error "$object is not a $type";# object is not a SNIT type
440  } elseif {$itstype eq $type} {
441  return $object;# Object is of our type.
442  } else {
443  error "$object is not a $type";# object is something else
444  }
445  }
446 
447  constructor {args} {
448  ## @brief Constructor: initialize the signal object.
449  #
450  # Create a low level actuator object and install it as a component.
451  #
452  # @param name Name of the signal object.
453  # @param ... Options:
454  # @arg -signalsnupper Serial number of the SR4 that controls the upper
455  # head of this signal.
456  # @arg -signalsnlower Serial number of the SR4 that controls the lower
457  # two heads of this signal.
458  # @arg -signalname Name of the signal on the track work schematic.
459  # @par
460 
461  # Prefetch the -signalsnupper and -signalsnlower options.
462  set options(-signalsnupper) [from args -signalsnupper]
463  if {$options(-signalsnupper) eq {}} {
464  error "The -signalsnupper option is required!"
465  }
466  set options(-signalsnlower) [from args -signalsnlower]
467  if {$options(-signalsnlower) eq {}} {
468  error "The -signalsnlower option is required!"
469  }
470  install signalupper using Azatrax_OpenDevice $options(-signalsnupper) \
471  $::Azatrax_idSR4Product
472  install signallower using Azatrax_OpenDevice $options(-signalsnlower) \
473  $::Azatrax_idSR4Product
474  # Disconnect relays from inputs.
475  $signalupper OutputRelayInputControl 0 0 0 0
476  $signallower OutputRelayInputControl 0 0 0 0
477  # Turn off all relays (set signal to dark aspect).
478  $signalupper RelaysOff 1 1 1 0
479  $signallower RelaysOff 1 1 1 1
480  }
481 
482  method setaspect {aspect} {
483  ## Set signal aspect.
484  #
485  # @param aspect New aspect color.
486 
487  threeaspectlist validate $aspect
488  $signalupper RelaysOff 1 1 1 0
489  $signallower RelaysOff 1 1 1 1
490  set sig [$self cget -signalname]
491  if {$sig ne {}} {MainWindow ctcpanel setv $sig $aspect}
492  # Top head
493  switch [lindex $aspect 0] {
494  red {
495  $signalupper RelaysOn 0 0 1 0
496  }
497  yellow {
498  $signalupper RelaysOn 0 1 0 0
499  }
500  green {
501  $signalupper RelaysOn 1 0 0 0
502  }
503  }
504  # Middle head
505  switch [lindex $aspect 1] {
506  red {
507  $signallower RelaysOn 0 1 0 0
508  }
509  green -
510  yellow {
511  # upper color (of lower head) is either green or yellow.
512  $signallower RelaysOn 1 0 0 0
513  }
514  }
515  # Bottom head
516  switch [lindex $aspect 2] {
517  red {
518  $signallower RelaysOn 0 0 0 1
519  }
520  green -
521  yellow {
522  # upper color (of lower head) is either green or yellow.
523  $signallower RelaysOn 0 0 1 0
524  }
525  }
526  }
527 }
528 
529 
530 
531 ## @}
532 
533 }
534 
535 package provide Azatrax_Signals 1.0
azatrax_signals::green
@ green
Green, generally clear.
Definition: Azatrax_Signals.tcl:40
azatrax_signals::red
@ red
Red, generally stop or stop and proceed.
Definition: Azatrax_Signals.tcl:32
azatrax_signals::twoaspectlist
listtype twoaspectlist
Aspects for two headed signals. This is a list of two aspect colors, the first element for the upper ...
Definition: Azatrax_Signals.tcl:97
azatrax_signals::signalcolors
signalcolors
Definition: Azatrax_Signals.tcl:23
azatrax_signals::threeaspectlist
listtype threeaspectlist
Aspects for three headed signals. This is a list of three aspect colors, the first element for the up...
Definition: Azatrax_Signals.tcl:219
azatrax_signals
Definition: Azatrax_Signals.tcl:16
azatrax_signals::OneHead3Color
Single head signals, 3 color.
Definition: Azatrax_Signals.tcl:57
azatrax_signals::dark
@ dark
Dark, all lamps off, implies red.
Definition: Azatrax_Signals.tcl:28
azatrax_signals::yellow
@ yellow
Yellow, generally approach.
Definition: Azatrax_Signals.tcl:36