#!
use strict; # Can't use strict. Doesn't like the Object modules
#----------------------------------------------------------------------------------------------
# Wx.pl
# A Perl script to extract weather information from Weather Underground
#
# Can run stand-alone or with HAL2000. If stand-alone, will capture the data and
# create text files in a directory named 'C:\HALogs\'. If HAL2000 is present, TTS
# files will be placed in 'C:\Program files\HAL\Data\', although some files will
# still go in the logs directory.
#
# Uses HALi, if available to set/clear flags in HAL. If HALi is not available
# the flags are ignored.
#
# There are several related blocks of code.
# Menubox and it's related subroutines such as Initialize(), and many subs related to drawing
# menus and so forth, is responsible for drawing the GUI user interface.
#
# Within this block of code and closely related to it are the routines
# that manage the animation. These all start with the letters 'ani' and are all together.
#
# Following the animation subs are the Display subs. Mostly these related to the graphical
# display, but code to display the scrolling text window is here too.
#
# Following the display subroutines are various subs related to editing config data, and then
# comes the code that executes the Action buttons. All of this code is contained within the
# Menubox block.
#
# Outside the Menubox brackets are the various subs related to actually processing the
# weather info, as well as HALi and other handlers.
#
# Following the HALi code is the code for loading and saving the INI file information.
#
# The following flags are the flags expected to be available in HAL for set/clear to
# give HAL awareness of the weather conditions. This list may change, as new possible
# weather conditions are discovered. Adding a new item to the list is as simple as
# adding the flag in HAL. This program examines HAL for flags and updates itself.
my $halFlags= " WEATHER CLEAR , WEATHER SUNNY , WEATHER PARTLY CLEAR , WEATHER MOSTLY CLEAR ,
WEATHER MOSTLY SUNNY , WEATHER CLOUDY ,
WEATHER PARTLY SUNNY , WEATHER PARTLY CLOUDY , WEATHER MOSTLY CLOUDY
WEATHER RAIN , WEATHER LIGHT RAIN , WEATHER HEAVY RAIN , WEATHER WINDY
WEATHER FOG , WEATHER LIGHT FOG, WEATHER DENSE FOG, WEATHER SNOW , WEATHER OVERCAST
WEATHER LIGHT SNOW , WEATHER SNOW FLURRIES , WEATHER SCATTERED CLOUDS";
# The following flags are Extended weather conditions to give HAL a subjective view
# of the weather,
my $halExtFlags = "WX HOT, WX WARM, WX COLD, WX COOL, and WX WINDY.";
#
my $credits = "Based on an old script for extracting AccuWeather data
developed with input from several participants of the
HAL support forums. Special recognition given to
Todd Garfield, Tony MacDonald and William Running.
Updated to use Weather Underground in May 2007.";
###############################################################################################
# TO-DO List
#(6) (PARTIAL) Allow user adjustment of thresholds (can now do from INI)
#(6a) Change thresholds based on season.
#(7) (PARTIAL)Allow changing of update intervals. Allow each of the 4 radio buttons to be
# defined explicitly from the UI. Can now be changed from INI file. Still must write GUI
#(10) Figure out how to minimize to the system tray. For some reason I've never got
# that to work.
#(11) Produce an EXE file using the Perl2EXE compiler.
#(12) Figure out how to incorporate precip data. For some reason the WU Perl module
# does not seem to give precip data, although my local weather station does.
# Gotta look into that.
#(18) (Tabled) Fix bug with repeated location and/or zipcode changes.
# This one is hard, as it appears to be a TK bug. I have changed the logic to
# disable the menu once the setting is edited so it can only be edited once.
#(21) Cosmetic enhancement of voice menu toggles. Need graphic bitmap.
#(35) Add Dewpoint animated overlay when relevant
#(36) Add Precipitation Display when relevant
#(37) Re-write sub HotOrCold so comfort changes are spoken by SAPI if HAL not available
# This was an oversight, as we want to speak this via SAPI too.
#(38) Draw a circle to occult the moon to simulate the phases.
#(39) Add "Quiet Sensor" light/dark sensor feature
#(40) (DONE) Remove Profile code
#(41) Add earthquake tracking
#(42) Look at issues around setting the display fonts to large, see if can compensate.
###############################################################################################
# C H A N G E L O G
#---------------------
# Changes of 6/30/2007
#---------------------
# Remove more unused gifs, clean up cosmetics
# release to Beta 19
#---------------------
# Changes of 6/26/2007
#---------------------
# Changed Heartbeat routine to more reliably detect and display updates to sun/moon rise and set
#---------------------
# Changes of 6/21/2007
#---------------------
# Added Humidity Display overlay sub aniOverlayHumidity()
#---------------------
# Changes of 6/19/2007
#---------------------
# Trap condition where WU reports No Moon Set and force moon set time to a reasonable default.
# Removed numerous unused graphic file references. Deleted unused files from archive
# Corrected update timer to ensure high and low temperatures are properly cleared after 24 hrs
#---------------------
# Changes of 6/16/2007
#---------------------
# Fixed error in sub removeTrailingZeros() that cause it to ignore decimal point sometimes.
# Cleaned up menu configurations for keyboard take focus order
#---------------------
# Changes of 6/15/2007
#---------------------
# Slight change to Wx Warm and Wx Cool logic to prevent inappropriate announcement
#---------------------
# Changes of 6/14/2007
#---------------------
# Fixed issue with Dewpoint subroutine causing Dewpoint to sometimes not be parsed.
# Changed visibility to speak 'Unlimited' when reported 10 miles
# Fixed minor issue with animation timers not being stopped at program end
# Updated editINI to re-read the INI file after it has been edited
# Added Mutex Lock to ensure only one instance of the program is running
#---------------------
# Changes of 6/13/2007
#---------------------
# Fixed typo preventing proper reload of the INI file data for StartStop voice boolean
# Moved creation of \HALogs and \HAScripts to Initialization subroutine
# Updated sub getCSVdata to fill the WxData array and pass to HALi Weather station
# Added logic to clear the high and low temperatures after 20 hours.
#---------------------
# Changes of 6/11/2007
#---------------------
# Added aniOverlay subroutines to display temp Hi, Low and Dewpoint. Still need to reset.
#---------------------
# Changes of 6/10/2007
#---------------------
# Bump version to 0.19
# Remove Change Log entries prior to 0.19
# Remove DONE items from To-Do list
# Remove Profile Code
# Change $console to $Display for cosmetic purposes
#---------------------
# Changes of 7/8/2008
#---------------------
# Bump version to 0.191
# Incorporate change to initSunMoonDisplay to make initialization more reliable
# This fixes the issue with the Sun sometimes not being shown on startup.
###############################################################################################
my $instructions = "Wx is a general purpose weather monitoring program
and extension plug-in for HAL 2000 Home Automation.
In the most basic use, Wx polls WeatherUnderground.com
for current weather conditions. It creates several small
text files that are intended to be spoken by a Text-to-Speech
engine, intended for the HAL2000 Home Automation system.
It also creates a Comma Separated Values file that can
be manipulated by any spreadsheet or database program.
These data files are stored in several possible locations
on the C: drive, including \\HALogs and \\HAScripts.
If the program detects the HAL2000 Home Automation program,
most of the data files will be stored in the data directory
used by HAL, C:\\Program files\\HAL\\Data to be used more easily
by HAL for speech output.
If running with HAL2000, the program scans the HAL Database
for software flags with a name beginning with the keyword
'WEATHER', followed by various possible weather conditions
returned by Weather Underground. If a flag is found matching
the current conditions, that flag is set to TRUE.
There are also five possible Extended Weather Flags, starting
with the Keyword 'WX'. They are 'WX HOT', 'WX WARM', 'WX COLD
'WX COOL' and 'WX WINDY'. These are set, if available to give
HAL a bit more of a subjective view of the weather.
The program is intended to interact with HAL2000 using the HALi
ActiveX Controls. However in the event that HALi is not present,
it will attempt to run using Jim Lipsit's HAL_Interface program
to set those flags.
Ideally, It should be invoked as a startup program in the HAL
Personal Assistant. Using the command 'c:/Perl/wperl wx.pl run'
will start Wx using the 'Windows Perl' interpreter.
The wperl interpreter avoids having an open Dos Box on the desktop.
The commandline parameter 'run' effectively pushes the RUN button
after it displays the User Interface.
When first run, it will ask for the location from which to retrieve
weather information. This should be the Weather Underground name for
your location.
This program is distributed in the form of Perl Source Code.
If you have Perl on your computer, you can run the Perl version
and tweak the source code to as you please. It expects the
ActiveStates Perl, plus the Win32-OLE, TK, and Weather-Underground
code libraries. These may be installed using the PPM system.
Most of the functions, and uses of the program should be self-evident
by reading the comments in the Perl code. This program is provided
for free, as an educational exercise and to demonstrate the power
and simplicity of Perl for complex tasks.";
my $license = "Wx is freely distributed in source code form as an educational
exercise. It may be freely used by individuals to augment their
personal home automation system, or simply as a convenient desktop
weather monitoring application. The user may freely use and modify
Wx to suit their individal needs.
The use of Wx in any commercial or public venue, or incorporation of Wx
code into any commercial application requires both permission of the
author, and acknowledgement of the contribution of the original
author to the project. The author credit in the 'Help|About' box
must be left intact.";
#----------------------------------------------------------------------------------------------
# Define the external modules we are using. All modules are in the Perl Pacakage Manager
# and can be installed from the GUI PPM program with minimal fuss
use Win32::SAPI5; # Microsoft SAPI interface
use Win32::OLE; # OLE is the Perl interface to ActiveX controls
use Win32::Mutex;
use Weather::Underground; # Perl Weather Underground interface
use Config::IniFiles; # Store information in Windows INI file.
use Tie::Handle::CSV; # CSV File Manipulator
use WWW::Mechanize; # Mechanize is used to retrieve CSV weather data
use Tk; # Tk is the graphics toolkit for drawing windows
use Tk::PNG; # Need this toolkit to display PNG files
# Make sure we're not already running
my $mutexname="Wx";
if(Win32::Mutex->open($mutexname)) {exit};
# If not, make sure next copy to start knows we are
my $mutex=Win32::Mutex->new(1,$mutexname);
$mutex->wait(3);
# Declare some global variables to keep strict happy (Strict ain't never happy here anyway)
# Note: I have started (too late) a convention that global variables start with
# an uppercase letter while local variables are lowercase. Not all follow this
# convention (yet) but that's the longer term plan.
# Intentional Exceptions: Variables which are actually handles to objects
# (e.g. $Display, $runTimer, $agent) usually remain lowercase.
my $speakTemperature; # Controls regularly speaking the temperature
my $speakComfort; # Controls announcing changes in comfort levels
my $speakConditions; # Controls announcing sky conditions
my $speakStartStop; # Controls announcement of program start and stop
my $Scroll; # Controls whether text display scrolls or not.
my $Graphics; # Controls whether display is graphic or text
my $Sky; # Weather Conditions (CLEAR, OVERCAST, etc)
my $Running; # Tracks run state. True when running
my $MoonLight; # Tracks when the moon is in the sky
my $SunLight; # Tracks when the sun is in the sky
my $LastDate; # Date of previous date so we can detect stale data
my $LastPressure; # Previous Barometric Pressure, so we can detect when it changes
my $LastFlag; # Last Flag set, so we can detect when it changes.
my $Timestamp; # Global Time variable
my $NxtUpd;
my $Dp;
my $Hum;
my ($HiUpdateCounter, $LoUpdateCounter);
my $Buttons = 0;
my ($Button1, $Button2, $Button3, $Button4);
my ($hal_menu, $action_menu, $voice_menu, $config_menu, $display_menu, $help_menu);
my ($run_button,$action_button,$config_button,$voice_button,$display_button,$help_button,$hal_button,$HALiButton,$DctButton);
my ($zip_entry, $zip_label);
my ($Hour_button, $Hours_button, $Half_button, $Third_button);
my ($interval_label, $IntMin1, $IntMin2, $IntMin3, $IntMin4);
my ($LOC_entry, $LOC_label);
my ($TIM_entry, $TIM_label);
my $NXT_entry;
my $NXT_Label;
my $NXT_label;
my ($stop_button, $now_button, $exit_button);
my ($hiTempTimer, $loTempTimer);
my ($dewTimer, $humTimer);
my $Tp;
my $M;
my $winDir;
my ($cloud0, $cloud1, $cloud2);
my $nact;
my ($moon, $littleMoon, $MoonPct, $sun, $blankSun);
my $Tbox;
my ($rain, $lightRain);
my $speech;
my $clear;
my $snow;
my ($fog1, $fog2, $fog3);
my $barom;
my $barLine;
my @wxData;
# Some pre-defined speech text. This will be stored in INI file
# for ease of changing.
my $WxWarmTxt = "It's Warming Up outside!!";
my $WxHotTxt = "It's HOT outside!!";
my $WxCoolTxt = "It's getting cool outside!!";
my $WxColdTxt = "It's COLD outside!!";
my $WxWindyTxt = "It's getting WINDY outside.";
# Fonts may be changed by editing the INI file (Config|Edit INI)
my $WindSpeedFont; # Font used to display the wind speed in the graphic screen
my $BarometerFont; # Font used to display the barometer reading in the graphic screen
my $TemperatureFont; # Font used to display the temperature in the graphic screen
my $UpdateFont; # Font used to display the Update Countdown data
my $FontUpdateColor; # Font Color for the Update Countdown display
my $FontDataColor; # Font Color for the graphical display
# Global variables used for animation
my $BP = 2900; # Use Barometric Pressure to drive demo animation
my $N; # Pointer to array element to display next
my $X; # Pointer to array element to display next
my @Arrows = ('ar-n','ar-nne','ar-ne','ar-ene','ar-e','ar-ese','ar-se','ar-sse',
'ar-s','ar-ssw','ar-sw','ar-wsw','ar-w','ar-wnw','ar-nw','ar-nnw');
my $LastArrow = @Arrows[0]; # Arrow to erase before drawing new one
my $TrendUp; # Tracks Barometric Pressure Trend
my $CloudRight; # Tracks cloud animation movement
my @fadedLines; # Array of lines to fade out (code not currently used)
my @riseSetTimes; # Array holds today's sunrise, sunset, moonrise and moonset
my @FlagsList; # List of valid HAL Flags
my $runTimer; # Handle to timer object used to call weather site every nn minutes
my $aniTimer; # Handle to timer object used to drive animations
my $locEdited; # Track when location has been edited. Can only edit once per session
my $zipEdited; # Track when zip has been edited. Can only edit once per session
my $HALi1; # Handle to HALi Control Object.
my $Display; # Handle to the display (same used for Text or Graphical)
my $agent; # Handle to agent used to parse the CSV data from direct station access
my $arrayref; # Handle to weather data array
my $weather; # Our 'Weather' object
# Help|About box data stored here
my $author = "Author: Nathan Gregory\n";
my $version = "Version: Beta 0.19\n";
my $release = "Released to Beta 6/30/2007\n";
my $purpose = "Purpose: Manage access to Weather Underground data for HAL2000.\n";
my $usage = "Usage: Place the command 'wperl wx.pl run' in the Personal Assistant Startup\n";
# Variables used to control display of debugging information
# Can be set on from command line for testing/debuging purposes
# Value is retained in the .INI file
my $Debug = 0; # Set to true (1) to display debug messages on the console
my $time;
# Other misc settings stored in the INI file
my $useHALi; # Tracks whether HALi is to be used
my $useSAPI; # Alternative, use SAPI for speech
my $Direct; # Ignores location and zip and use stationID
my $ini; # Handle to the INI file object
# Polling Interval values. May be edited in the INI file.
my $interval = 1200; # Default Update interval, may be changed in the GUI buttons
my $intval1 = 1200; # Default value for first radio button
my $intval2 = 1800; # Default value for second radio button
my $intval3 = 3600; # Default value for third radio button
my $intval4 = 7200; # default value for 4th button
# Define some thresholds for subjective decisions.
my $Threshold_Hot = 80; # Default threshold to consider weather as being hot
my $Threshold_Warm = 75; # Default threshold to consider weather as being warm
my $Threshold_Cold = 60; # Default threshold to consider weather as being cold
my $Threshold_Cool = 65; # Default threshold to consider weather as being hot
my $Threshold_Windy = 14; # Default threshold to consider weather as being Windy
my $HiTemp;
my $LoTemp = 100;
# Predefine some paths we want to use. If you want files to be written elsewhere
# Change paths here. Paths are also stored in the INI file and what is read from there
# will over-ride these values.
my $DataPath; # The path where our data files are stored
my $Zip = ""; # Our ZipCode
my $Place = ""; # Preferred Location Search String
my $PlaceStr = ""; # Location returned by the search string
my $PlInstance = 0; # Weather Instance. Not currently used.
# Define the directory paths where we keep our data
my $LogDir = "C:/HALogs/"; # Log Directory Path
my $ScriptDir = "C:/HAScripts/"; # Scripts Directory Path
my $HALDataDir = "C:/Program files/HAL/Data/"; # HAL Data Path
if (-e "$HALDataDir/Device.dbf") { # If HAL on this machine, use HAL Data Dir
$DataPath = $HALDataDir;
} else { # If no HAL, store files in HALogs directory.
$DataPath = $LogDir;
}
# Define the Location of our required external programs
my $HALiOCX = "C:/Program files/HAL/HALi.ocx";
my $HALIntProg = "C:/Perl/HAL_Interface.EXE";
if (!-e $HALIntProg) { # If HAL_Interface does not exist
$HALIntProg = ""; # Set to NUL so we won't try to use
}
# Define the various files we want to use
my $INIfile = "$ScriptDir/Wx.ini"; # Where Wx keeps various info it needs to track
my $ErrorFile = "$LogDir/WeatherError.txt"; # We write the last error message here
my $LOGFile = "$LogDir/WeatherLog.CSV"; # Write a .CSV historical file here
my $TTSFile = "$DataPath/Weather.TXT"; # HAL's primary TTX file
my $TemFile = "$DataPath/Temperature.TXT"; # Plus TTX files for each weather
my $WindFile = "$DataPath/Wind.TXT"; # Condition we track.
my $HumidFile = "$DataPath/Humidity.TXT"; # These are formatted for a Text to
my $BaromFile = "$DataPath/Barometer.TXT"; # Speech engine to read
my $DewFile = "$DataPath/Dewpoint.TXT";
my $VisiFile = "$DataPath/Visibility.TXT";
my $HALiStat = "Uninitialized";
# Information needed for direct CSV retrieval from specific weather station.
my $pageURL = "http://www.weatherunderground.com/cgi-bin/findweather/getForecast?query=";
my $csvURL = "http://www.wunderground.com/weatherstation/WXDailyHistory.asp?ID=";
my $csvID = "KCABELMO5"; # May be edited in the INI file
my $csvFormat = "&format=1";
my $WU;
### B E G I N P r o g r a m E x e c u t i o n ##############################################
# Initialize All the stuff which has values stored in the INI file
readINIfile(); # Retrieve configuration data from the .INI file.
# If it doesn't exist, create with default values
# Prompt for some necessary information if not in the INI file
GetStationcode();
getPlace(); # Our location, as known by Weather Underground
getZipcode(); # Our Zip Code. Also used as a search string
#Draw the GUI and start cranking.
MenuBox(); # All the work is dispatched from the GUI Menu Box
#end; # End of program. All else is Subroutines.
## E N D O F P R O G R A M ##### S U B R O U T I N E S F O L L O W ########################
###############################################################################################
# The following logic draws the GUI and handles all it's menus and windows
###############################################################################################
sub MenuBox { # Uses the Tk library to build a GUI interface for our program
###############################################################################################
my $w = MainWindow->new();
$w->configure(-title => 'Wx - The Weather Extension', -background => 'gray');
$w->minsize(qw(535 270)); # Lock the window size parameters
$w->maxsize(qw(535 270)); # so we control minimize/maximize functions
# Windows passes events related to keystrokes, mouse-clicks and so forth. These can be
# trapped and redirected to our own functions, using the object calls from Win32::OLE
# Clicking on the Close box (the little X in the upper right of the window) generates
# the Windows Message to Delete Window. In this case, we intercept that delete
# window message and call our own 'end' routine.
$w->protocol('WM_DELETE_WINDOW',\&end);
$w->protocol('WM_RESIZE_WINDOW',\&normal);
# Control Keys, and other keystrokes can be captured in a similar fashion.
# We have defined accelerator keys for many functions as follows.
# Action Menu and Action Button Accellerators
$w->bind('', \ &run);
$w->bind('', \ &stop);
$w->bind('', \ &getWeather);
$w->bind('', \ &end);
# Toggle between normal and compact modes
$w->bind('', \ &compact); # This gets redefined in sub compact()
# Toggle Voice Menu options
$w->bind('', \ &toggleTemperature);
# Cause the top-level menus to post on alt key
$w->bind('', \ &openActionMenu);
$w->bind('', \ &openConfigMenu);
$w->bind('', \ &openVoiceMenu);
$w->bind('', \ &openDisplayMenu);
$w->bind('', \ &openHelpMenu);
## Create Frames for our various widgets ##
my $menu_bar_frm = $w->Frame(-relief=> 'groove',-borderwidth=>3, -background=>'gray')->pack(-side => 'top', -fill=>'x');
my $w_interval_frm = $w->Frame(-relief=> 'groove',-borderwidth=>2, -background=>'gray')->pack(-side => 'top', -fill=>'x');
my $location_frame = $w->Frame(-relief=> 'sunken',-borderwidth=>0, -background=>'gray')->pack(-side => 'top', -fill=>'x');
my $w_button_frm = $w->Frame(-relief=> 'groove',-borderwidth=>10,-background=>'gray')->pack(-side => 'left',-fill=>'x');
## Populate the frames with widgets
menuBarFrame(); # Draw in the menu buttons
intervalFrame(); # Draw in the options on the Interval Frame
locationFrame(); # Draw in the options on the Location Frame
menuFrame(); # Draw in the options on the Menu Frame.
Initialize(); # Button frame gets drawn in display logic because we have to draw console first.
MainLoop;
#----------------------------------------------------------------------------------------------
sub Initialize { # Call this routine upon displaying the GUI.
# This is the first block of code called, before RUN.
#----------------------------------------------------------------------------------------------
# Process Commandline Arguments
while (<@ARGV>) {
my $c = uc($_);
if ($c eq 'DEBUG') { # User passes Debug command on the commandline
$Debug = 1;
}
if ($c eq '-DEBUG') { # User passes !Debug command on the commandline
$Debug = 0;
}
if (($c eq 'ACTIVEX')||($c eq 'HALI')) { # User passes ACTIVEX command on the commandline
$useHALi = 1;
}
if (($c eq '-ACTIVEX')||($c eq '-HALI')){ # User passes !ACTIVEX command on the commandline
$useHALi = 0;
}
if ($c eq 'SAPI') { # Enable SAPI use if HALi not available
$useSAPI = 1;
}
if ($c eq '-SAPI') { # Force to not use SAPI
$useSAPI = 0;
}
if ($c eq 'GRAPHICS'){ # Start in graphical mode
$Graphics = 1;
}
if (($c eq '-GRAPHICS')||($c eq 'TEXT')) { # Start in text mode
$Graphics = 0;
}
}
# Pick which screen gets displayed based on what was last displayed.
if ($Graphics) {
displayGraphics(); # Display the graphical screen
aniStart(); # and start the animation
} else {
displayText(); # Otherwise just display the text screen
}
# Start HALi only once
if (-e $HALiOCX) { # Don't even try to start HALi if not present
$HALiStat = StartHALi(); # this gives a Invalid Class String error to stderr if it fails
} else {
initWindowsSpeech();
$HALiStat = "NOT Present!";
}
# Create needed directories.
if (!-e $LogDir) { # if needed dirs do not exist
mkdir($LogDir,); # Create them
}
if (!-e $ScriptDir) { # Verify that C:\HAScripts directory exists,
mkdir($ScriptDir,); # If Not, Create it
}
# Verify HAL data files are on the machine. If not, assume no HAL.
if (!-e "$HALDataDir/Device.dbf") {
Console("HAL2000 is not found on this system.\n");
}
#Verify HALi initialized and is running
if (index($HALiStat,"running") == 0) {
$time = localtime(time());
Console("HALi will not be used!\n");
}
if (index($HALiStat,"running") == 0) {
Console("\nHALi is Online\n");
$HALIntProg = " ";
}
if (length($HALIntProg) < 10) {
Console("HAL_Interface program is not available.\n");
}
initCSVagent(); # Object modules to parse CSV data from the weather station.
# Initialize $LastDate as on Startup, $LastDate from the INI file may be stale
$LastDate = `date /T`; # Returns day/date, e.g. 'Sat 04/23/2005'
chop($LastDate); # Remove trailing CRLF
$LastDate = substr($LastDate,4); # Grab date only
chop($LastDate); # Remove trailing space.
$ini->setval('Flags','LastDate',$LastDate);
$ini->RewriteConfig; # Update INI file
# Process Commandline Run Command
while (<@ARGV>) {
my $c = uc($_);
if ($c eq 'RUN') { # User passes RUN command on the commandline
run();
}
if ($c eq 'COMPACT') { # User passes COMPACT command on the commandline
compact();
}
}
} # Initialize
1;
#==============================================================================================
# Menu handling subroutines
#----------------------------------------------------------------------------------------------
sub compact { # Shrink running display to console screen only.. (Control-C Key toggle)
# Compact Mode!
#----------------------------------------------------------------------------------------------
if (Exists($run_button)) { # if the RUN button exists,
removeActionButtons(); # assume they all exist
removeLocationFrame(); # and remove them all
removeIntervalFrame();
$w->bind('', \ &normal); # Rebind keys to restore
$w->bind('', \ &normal);
}
# Likewise remove the buttons and widgets of the Interval Frame
if (Exists($action_button)) {$action_button->destroy};
if (Exists($config_button)) {$config_button->destroy};
if (Exists($voice_button)) {$voice_button->destroy};
if (Exists($display_button)) {$display_button->destroy};
if (Exists($help_button)) {$help_button->destroy};
if (Exists($hal_button)) {$hal_button->destroy};
$menu_bar_frm->configure(-height => 1 );
# Lock the Screen Size
$w->minsize(qw(490 185)); # Reduce Minimum size so resizing doesn't change window.
$w->maxsize(qw(490 185)); # Reduce Maximum size so resizing doesn't change window.
}
1;
#----------------------------------------------------------------------------------------------
sub normal { # Restore to Normal mode. (Control-C key toggle, or Escape to restore)
#----------------------------------------------------------------------------------------------
if (!Exists($run_button)) { # if the RUN button doesn't exist,
# assume none exist and restore
intervalFrame(); # Redraw the frames and widgets
locationFrame();
actionButtons();
menuBarFrame();
$w->bind('', \ &compact);
$w->bind(''); # Change the key bindings back
# Lock the Screen Size
$w->maxsize(qw(535 270)); # Reset min size to the larger size
$w->minsize(qw(535 270)); # Reset max size to the larger size
}
}
1;
#----------------------------------------------------------------------------------------------
sub viewErrorLog { # Display the program's error log
#----------------------------------------------------------------------------------------------
# This is one way to call an external program from within a Perl script
open (EP,"Notepad.exe $ErrorFile |");
close(EP);
}
1;
#----------------------------------------------------------------------------------------------
sub faq { # Display the Frequently Asked Questions help page.
#----------------------------------------------------------------------------------------------
# This is one way to call an external program from within a Perl script
# In this case, we simply call the document and trust that the PC
# knows how to open it.
open (EP,"WX_FAQ.html |");
close(EP);
}
1;
#----------------------------------------------------------------------------------------------
sub openActionMenu { # Cause the menu to post when the Atl Key associated with it is pressed
#----------------------------------------------------------------------------------------------
if (Exists($action_button)) {$action_button->Post()};
}
1;
#----------------------------------------------------------------------------------------------
sub openConfigMenu { # Cause the menu to post when the Atl Key associated with it is pressed
#----------------------------------------------------------------------------------------------
if (Exists($config_button)) {$config_button->Post()};
#$config_menu->grabRelease;
}
1;
#----------------------------------------------------------------------------------------------
sub openVoiceMenu { # Cause the menu to post when the Atl Key associated with it is pressed
#----------------------------------------------------------------------------------------------
if (Exists($voice_button)) {$voice_button->Post()};
}
1;
#----------------------------------------------------------------------------------------------
sub openDisplayMenu { # Cause the menu to post when the Atl Key associated with it is pressed
#----------------------------------------------------------------------------------------------
if (Exists($display_button)) {$display_button->Post()};
}
1;
#----------------------------------------------------------------------------------------------
sub openHelpMenu { # Cause the menu to post when the Atl Key associated with it is pressed
#----------------------------------------------------------------------------------------------
if (Exists($help_button)) {$help_button->Post()};
}
1;
#----------------------------------------------------------------------------------------------
sub unPost { # This should cause the menu to be de-selected on hitting escape. Isn't working right.
#----------------------------------------------------------------------------------------------
$config_menu->Leave;
}
1;
#----------------------------------------------------------------------------------------------
sub menuFrame {
#----------------------------------------------------------------------------------------------
# if does NOT exist $HALiOCX and do NOT use SAPI. ! means NOT
if ((!-e $HALiOCX) && (!$useSAPI)){ ## if the HALi control module is not present ##
## and don't want to use SAPI, gray out menu ##
$voice_menu->delete(1);
$voice_menu->insert(1,'command',-state=>'disabled',-command => \&toggleTemperature,
-label => " Temperature ", -underline => 2, -accelerator => '^T');
$voice_menu->delete(2);
$voice_menu->insert(2,'command',-state=>'disabled',-command => \&toggleComfort,
-label => " Comfort ", -underline => 2);
$voice_menu->delete(3);
$voice_menu->insert(3,'command',-state=>'disabled',-command => \&toggleStartStop,
-label => " Start/Stop ", -underline => 2 );
$voice_menu->delete(4);
$voice_menu->insert(4,'command',-state=>'disabled',-command => \&toggleConditions,
-label => " Conditions ", -underline => 3 );
}
}
1;
#----------------------------------------------------------------------------------------------
sub menuBarFrame {
#----------------------------------------------------------------------------------------------
## Create Action Menu ##
$action_button = $menu_bar_frm->Menubutton(-text=> 'Action', -takefocus=>1,-underline=> 0, -background=> 'gray', -activebackground=> 'white', -foreground=> 'blue')->pack(-side => 'left');
$action_menu = $action_button->Menu();
if (!$Running) {
## Create Action Menu Option Run ##
$action_menu->command(-state=>'normal',-command => [\&run], -label => "Run", -underline => 0, -accelerator => "Alt-R");
$action_button->configure(-menu=>$action_menu);
## Create Action Menu Option Stop ##
$action_menu->command(-state=>'disabled',-command => \&stop, -label => "Stop", -underline => 1, -accelerator => "Alt-T");
$action_button->configure(-menu=>$action_menu);
## Create Action Menu Option Now ##
$action_menu->command(-state=>'disabled',-command => \&getWeather, -label => "Now!", -underline => 1, -accelerator => "Alt-O");
$action_button->configure(-menu=>$action_menu);
## Create Action Menu Option Exit ##
$action_menu->command(-state=>'normal',-command => \&end, -label => "Exit", -underline => 1, -accelerator => "Alt-X");
$action_button->configure(-menu=>$action_menu);
} else {
## Create Action Menu Option Run ##
$action_menu->command(-state=>'disabled',-command => [\&run], -label => "Run", -underline => 0, -accelerator => "Alt-R");
$action_button->configure(-menu=>$action_menu);
## Create Action Menu Option Stop ##
$action_menu->command(-state=>'normal',-command => \&stop, -label => "Stop", -underline => 1, -accelerator => "Alt-T");
$action_button->configure(-menu=>$action_menu);
## Create Action Menu Option Now ##
$action_menu->command(-state=>'normal',-command => \&getWeather, -label => "Now!", -underline => 1, -accelerator => "Alt-O");
$action_button->configure(-menu=>$action_menu);
## Create Action Menu Option Exit ##
$action_menu->command(-state=>'disabled',-command => \&end, -label => "Exit", -underline => 1, -accelerator => "Alt-X");
$action_button->configure(-menu=>$action_menu);
}
## Create Config Menu ##
$config_button = $menu_bar_frm->Menubutton(-text=> 'Config',-takefocus=>1, -underline=> 0, -background=> 'gray', -activebackground=> 'white', -foreground=> 'blue')->pack(-side => 'left');
$config_menu = $config_button->Menu();
if (!$Running) {
## Create Config Option Station ##
$config_menu->command(-state=>'normal',-command => \&getStationID, -label => "StationID...", -underline => 1 );
$config_button->configure(-menu=>$config_menu);
## Create Config Option Place ##
$config_menu->command(-state=>'normal',-command => \&getLocation, -label => "Location...", -underline => 1 );
$config_button->configure(-menu=>$config_menu);
## Create Config Option Intervals ##
$config_menu->command(-state=>'normal',-command => \&editIntervals, -label => "Intervals", -underline => 1);
$config_button->configure(-menu=>$config_menu);
## Create Config Option Zipcode ##
$config_menu->command(-state=>'normal',-command => \&getZip, -label => "Zipcode...", -underline => 1);
$config_button->configure(-menu=>$config_menu);
## Create Config Option Thresholds ##
$config_menu->command(-state=>'normal',-command => \&editThresholds, -label => "Thresholds", -underline => 1);
$config_button->configure(-menu=>$config_menu);
} else {
## Create Config Option Station ##
$config_menu->command(-state=>'disabled',-command => \&getStationID, -label => "StationID...", -underline => 1 );
$config_button->configure(-menu=>$config_menu);
## Create Config Option Place ##
$config_menu->command(-state=>'disabled',-command => \&getLocation, -label => "Location...", -underline => 1 );
$config_button->configure(-menu=>$config_menu);
## Create Config Option Intervals ##
$config_menu->command(-state=>'disabled',-command => \&editIntervals, -label => "Intervals", -underline => 1);
$config_button->configure(-menu=>$config_menu);
## Create Config Option Zipcode ##
$config_menu->command(-state=>'disabled',-command => \&getZip, -label => "Zipcode...", -underline => 1);
$config_button->configure(-menu=>$config_menu);
## Create Config Option Thresholds ##
$config_menu->command(-state=>'disabled',-command => \&editThresholds, -label => "Thresholds", -underline => 1);
$config_button->configure(-menu=>$config_menu);
}
## Create Config Option Edit INI file ##
$config_menu->command(-state=>'normal',-command => \&editINI, -label => "Edit INI", -underline => 1);
$config_button->configure(-menu=>$config_menu);
## Create Voice Menu ##
$voice_button = $menu_bar_frm->Menubutton(-text=> 'Voice',-takefocus=>1, -underline=> 0, -background=> 'gray',
-activebackground=> 'white', -foreground=> 'blue')->pack(-side => 'left');
$voice_menu = $voice_button->Menu();
## Create Voice Option Temperature ##
if (!$speakTemperature) {
$voice_menu->command(-state=>'normal',-command => \&toggleTemperature, -label => " Temperature ",
-underline => 2, -accelerator => '^T');
$voice_button->configure(-menu=>$voice_menu);
} else {
$voice_menu->command(-state=>'normal',-command => \&toggleTemperature, -label => "X Temperature ",
-underline => 2, -accelerator => '^T');
$voice_button->configure(-menu=>$voice_menu);
}
## Create Voice Option Comfort ##
if (!$speakComfort) {
$voice_menu->command(-state=>'normal',-command => \&toggleComfort, -label => " Comfort ", -underline => 2 );
$voice_button->configure(-menu=>$voice_menu);
} else {
$voice_menu->command(-state=>'normal',-command => \&toggleComfort, -label => "X Comfort ", -underline => 2 );
$voice_button->configure(-menu=>$voice_menu);
}
## Create Voice Option Start/Stop ##
if (!$speakStartStop) {
$voice_menu->command(-state=>'normal',-command => \&toggleStartStop, -label => " Start/Stop ", -underline => 2 );
$voice_button->configure(-menu=>$voice_menu);
} else {
$voice_menu->command(-state=>'normal',-command => \&toggleStartStop, -label => "X Start/Stop ", -underline => 2 );
$voice_button->configure(-menu=>$voice_menu);
}
## Create Voice Option Conditions ##
if (!$speakConditions) {
$voice_menu->command(-state=>'normal',-command => \&toggleConditions, -label => " Conditions ", -underline => 3 );
$voice_button->configure(-menu=>$voice_menu);
} else {
$voice_menu->command(-state=>'normal',-command => \&toggleConditions, -label => "X Conditions ", -underline => 3 );
$voice_button->configure(-menu=>$voice_menu);
}
## Create Display Menu ##
$display_button = $menu_bar_frm->Menubutton(-text=> 'Display',-takefocus=>1, -underline=> 0, -background=> 'gray',
-activebackground=> 'white', -foreground=> 'blue')->pack(-side => 'left');
$display_menu = $display_button->Menu();
## Create Display Option Scroll/NoScroll ##
if (!$Graphics) {
if (!$Scroll) {
$display_menu->command(-state=>'normal',-command => \&toggleScroll, -label => "Scroll", -underline => 1 );
$display_button->configure(-menu=>$display_menu);
} else {
$display_menu->command(-state=>'normal',-command => \&toggleScroll, -label => "NoScroll", -underline => 1 );
$display_button->configure(-menu=>$display_menu);
}
} else {
if (!$Scroll) {
$display_menu->command(-state=>'disabled',-command => \&toggleScroll, -label => "Scroll", -underline => 1 );
$display_button->configure(-menu=>$display_menu);
} else {
$display_menu->command(-state=>'disabled',-command => \&toggleScroll, -label => "NoScroll", -underline => 1 );
$display_button->configure(-menu=>$display_menu);
}
}
## Create Display Option Icon ##
if (!$Graphics) {
if ($Running) {
$display_menu->command(-state=>'disabled',-command => \&toggleDisplay, -label => "Graphic ", -underline => 1 );
$display_button->configure(-menu=>$display_menu);
} else {
$display_menu->command(-state=>'normal',-command => \&toggleDisplay, -label => "Graphic ", -underline => 1 );
$display_button->configure(-menu=>$display_menu);
}
} else {
if ($Running) {
$display_menu->command(-state=>'disabled',-command => \&toggleDisplay, -label => "Text ", -underline => 1 );
$display_button->configure(-menu=>$display_menu);
} else {
$display_menu->command(-state=>'normal',-command => \&toggleDisplay, -label => "Text ", -underline => 1 );
$display_button->configure(-menu=>$display_menu);
}
}
## Create Display Option View Error Log ##
$display_menu->command(-state=>'normal',-command => \&viewErrorLog, -label => "Error Log", -underline => 0 );
$display_button->configure(-menu=>$display_menu);
## Create Display Option Compact Mode ##
$display_menu->command(-state=>'normal',-command => \&compact, -label => "Compact", -underline => 0, -accelerator => '^C' );
$display_button->configure(-menu=>$display_menu);
if (($Buttons) && (-e $HALiOCX)){
# Create Hal Buttons Menu ##
$hal_button = $menu_bar_frm->Menubutton(-text=>"Buttons", -takefocus=>1,-underline => 0, -background=> 'gray',
-activebackground=> 'white',-foreground=>'blue')->pack(-side => 'left');
$hal_menu = $hal_button->Menu();
## Create First Button ##
if ($Button1 eq "Undefined") {
$hal_menu->command(-command => \&button_1, -label => $Button1, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
} else {
$hal_menu->command(-command => \&setButton1, -label => $Button1, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
}
## Create Second Button ##
if ($Button1 eq "Undefined") {
$hal_menu->command(-state=>'disabled',-command => \&button_2, -label => $Button2, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
} else {
if ($Button2 eq "Undefined") {
$hal_menu->command(-state=>'normal',-command => \&button_2, -label => $Button2, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
} else {
$hal_menu->command(-state=>'normal',-command => \&setButton2, -label => $Button2, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
}
}
## Create Third Button ##
if ($Button2 eq "Undefined") {
$hal_menu->command(-state=>'disabled',-command => \&button_3, -label => $Button3, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
} else {
if ($Button3 eq "Undefined") {
$hal_menu->command(-state=>'normal',-command => \&button_3, -label => $Button3, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
} else {
$hal_menu->command(-state=>'normal',-command => \&setButton3, -label => $Button3, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
}
}
## Create Fourth Button ##
if ($Button3 eq "Undefined") {
$hal_menu->command(-state=>'disabled',-command => \&button_4, -label => $Button4, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
} else {
if ($Button4 eq "Undefined") {
$hal_menu->command(-state=>'normal',-command => \&button_4, -label => $Button4, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
} else {
$hal_menu->command(-state=>'normal',-command => \&setButton4, -label => $Button4, -underline => 0);
$hal_button->configure(-menu=>$hal_menu);
}
}
} # if (($Buttons) && (-e $HALiOCX)){
# Create Help Menu ##
$help_button = $menu_bar_frm->Menubutton(-text=>"Help", -underline => 0, -background=> 'gray', -activebackground=> 'white',
-foreground=>'blue')->pack(-side => 'right');
$help_menu = $help_button->Menu();
## Create Help Option Instructions ##
$help_menu->command(-command => \&instructions, -label => "Instructions", -underline => 0);
$help_button->configure(-menu=>$help_menu);
## Create Help Option About ##
$help_menu->command(-command => \&about, -label => "About", -underline => 0);
$help_button->configure(-menu=>$help_menu);
## Create Help Option Flaglist ##
$help_menu->command(-command => \&flagList, -label => "Flags", -underline => 1);
$help_button->configure(-menu=>$help_menu);
## Create Help Option dirlist ##
$help_menu->command(-command => \&dirList, -label => "Dirs", -underline => 0);
$help_button->configure(-menu=>$help_menu);
$help_menu->separator();
## Create Help Option Credits ##
$help_menu->command(-command => \&credits, -label => "Credits", -underline => 0);
$help_button->configure(-menu=>$help_menu);
## Create Help Option License ##
$help_menu->command(-command => \&license, -label => "License", -underline => 0);
$help_button->configure(-menu=>$help_menu);
## Create Help Option FAQ ##
$help_menu->command(-command => \&faq, -label => "F.A.Q.", -underline => 0);
$help_button->configure(-menu=>$help_menu);
} # end sub menuBarFrame
1;
#----------------------------------------------------------------------------------------------
sub removeIntervalFrame {
#----------------------------------------------------------------------------------------------
if (Exists($HALiButton)) {$HALiButton->destroy};
if (Exists($DctButton)) {$DctButton->destroy};
if (Exists($zip_entry)) {$zip_entry->destroy};
if (Exists($zip_label)) {$zip_label->destroy};
if (Exists($Hours_button)) {$Hours_button->destroy};
if (Exists($Hour_button)) {$Hour_button->destroy};
if (Exists($Half_button)) {$Half_button->destroy};
if (Exists($Third_button)) {$Third_button->destroy};
if (Exists($interval_label)) {$interval_label->destroy};
$w_interval_frm->configure(-height => 1 ); # Shrink Frame to 1 pixel high
}
1;
#----------------------------------------------------------------------------------------------
sub intervalFrame { # draw frame where update interval, Zip, Direct and HALi options display
#----------------------------------------------------------------------------------------------
## Create Update Interval Label ##
$interval_label = $w_interval_frm->Label(-text => 'Update Interval', -background => 'gray',
-foreground => 'blue')->pack(-side => 'left');
## Calculate the intervals to display ##
$IntMin1 = $intval1/60; # Intervals are specified in Seconds, not minutes
$IntMin2 = $intval2/60; # so divide by 60 to get minutes
$IntMin3 = $intval3/60;
$IntMin4 = $intval4/60;
## Draw the radio buttons ##
$Third_button = $w_interval_frm->Radiobutton(-text=>"$IntMin1 Min",-value=> $intval1,
-variable=> \$interval)->pack(-side => 'left');
$Half_button = $w_interval_frm->Radiobutton(-text=>"$IntMin2 Min",-value=> $intval2,
-variable=> \$interval)->pack(-side => 'left');
$Hour_button = $w_interval_frm->Radiobutton(-text=>"$IntMin3 Min",-value=> $intval3,
-variable=> \$interval)->pack(-side => 'left');
$Hours_button = $w_interval_frm->Radiobutton(-text=>"$IntMin4 Min",-value=> $intval4,
-variable=> \$interval)->pack(-side => 'left');
if ($Running) {
$Third_button->configure(-state=>'disabled');
$Half_button->configure( -state=>'disabled');
$Hour_button->configure( -state=>'disabled');
$Hours_button->configure(-state=>'disabled');
}
## Create the Zip code label and entry field ##
$zip_label = $w_interval_frm->Label(-text => ' Zip:', -background => 'gray',
-foreground => 'blue')->pack(-side => 'left');
if ($Running) {
$zip_entry = $w_interval_frm->Entry(-textvariable => \$Zip, -width => '5',
-state=>'readonly')->pack(-side => 'left');
} else {
$zip_entry = $w_interval_frm->Entry(-textvariable => \$Zip, -width => '5',
-state=>'normal')->pack(-side => 'left');
}
## Create the Direct checkbox ##
$DctButton = $w_interval_frm->Checkbutton(-variable =>\$Direct, -text=>"Direct",
-background=>'gray')->pack(-side => 'left');
## Create the HALi/SAPI checkbox ##
if (!-e $HALiOCX) { ## if the HALi control module is not present ##
$HALiButton = $w_interval_frm->Checkbutton( -state=>'normal',-variable =>\$useSAPI,
-text=>"SAPI", -background=>'gray')->pack(-side => 'left');
} else {
$HALiButton = $w_interval_frm->Checkbutton( -state=>'normal',-variable =>\$useHALi,
-text=>"HALi", -background=>'gray')->pack(-side => 'left');
}
}
1;
#----------------------------------------------------------------------------------------------
sub removeLocationFrame { # Undraw the frame that holds the location/station and update clock
#----------------------------------------------------------------------------------------------
if (Exists($LOC_entry)) {$LOC_entry->destroy};
if (Exists($LOC_label)) {$LOC_label->destroy};
if (Exists($TIM_entry)) {$TIM_entry->destroy};
if (Exists($TIM_label)) {$TIM_label->destroy};
if (Exists($NXT_label)) {$NXT_label->destroy};
if (Exists($NXT_entry)) {$NXT_entry->destroy};
if (Exists($NXT_Label)) {$NXT_Label->destroy};
$location_frame->configure(-height => 1 );
}
1;
#----------------------------------------------------------------------------------------------
sub locationFrame { # Draw the frame that holds the location/station and update clock
#----------------------------------------------------------------------------------------------
$LOC_label = $location_frame->Label(-text => 'Location:', -background => 'gray',
-foreground => 'blue')->pack(-side => 'left');
$LOC_entry = $location_frame->Entry(-textvariable => \ $PlaceStr, -width => '38',
-state=>'normal')->pack(-side => 'left');
if ($Running) {
$LOC_entry->configure(-textvariable => \ $PlaceStr,-state=>'readonly');
}
$TIM_label = $location_frame->Label(-text => ' Last Update', -background => 'gray',
-takefocus=>0,-foreground => 'blue')->pack(-side => 'left');
$TIM_entry = $location_frame->Entry(-textvariable => \ $Timestamp, -width => '5',-justify=>'right',
-state=>'readonly',-relief => 'sunken',-foreground => $FontUpdateColor,
-takefocus=>0,-background => 'gray',-font => $UpdateFont)->pack(-side => 'left');
$NXT_label = $location_frame->Label(-text => ' Next Update in', -background => 'gray',
-takefocus=>0,-foreground => 'blue')->pack(-side => 'left');
$NXT_entry = $location_frame->Entry(-textvariable => \ $NxtUpd, -width => '3',-justify=>'right',
-takefocus=>0,-state=>'readonly',-relief => 'sunken',
-foreground => $FontUpdateColor,-font => $UpdateFont,
-background => 'gray')->pack(-side => 'left');
$NXT_Label= $location_frame->Label(-text => 'Min', -background => 'gray',
-takefocus=>0,-foreground => 'blue')->pack(-side => 'left');
}
1;
#----------------------------------------------------------------------------------------------
sub removeActionButtons {
#----------------------------------------------------------------------------------------------
if (Exists($run_button)) {$run_button->destroy};
if (Exists($stop_button)) {$stop_button->destroy};
if (Exists($now_button)) {$now_button->destroy};
if (Exists($exit_button)) {$exit_button->destroy};
}
1;
#----------------------------------------------------------------------------------------------
sub actionButtons { # Draw the Action Buttons on the screen and set to 'running' status
# if the $runTimer is running. When $runTimer is running, we are getting weather data.
#----------------------------------------------------------------------------------------------
## Create the Action Buttons ##
$run_button = $w_button_frm->Button(-text=>'Run', -background=>'gray',-underline=> 0,-activebackground=>'gray',
-foreground=>'blue', -state=>"normal", -command => \ &run
)->pack(-side => 'top',-pady =>6,-padx =>4, -anchor=> 'nw');
$stop_button = $w_button_frm->Button(-text=>'Stop',-background=>'gray',-underline=> 1,-activebackground=>'gray',
-foreground=>'red',-activeforeground=>'red',-state=>'disabled',
-command=> \ &stop)->pack(-side =>'top',-pady =>6,-padx =>4,
-anchor=> 'nw');
$now_button = $w_button_frm->Button(-text=>'Now',-background=>'gray',-underline=> 1,-activebackground=>'gray',
-foreground=>'blue',-state=>'disabled',-command=> \ &getWeather
)->pack(-side =>'top',-pady =>6,-padx =>4, -anchor=> 'nw');
$exit_button = $w_button_frm->Button(-text=>'EXIT',-background=>'gray',-underline=> 1,-activebackground=>'gray',
-foreground=>'blue',-state=>'normal',-command => \ &end
)->pack(-side =>'top',-pady =>6,-padx =>4, -anchor=> 'nw');
if ($Running) {
$stop_button->configure(-state=>'normal',-foreground=>'red');
$run_button->configure( -state=>'disabled');
$now_button->configure( -state=>'normal');
$exit_button->configure(-state=>'disabled');
}
}
1;
#----------------------------------------------------------------------------------------------
sub instructions { # Display the instructions
#----------------------------------------------------------------------------------------------
my $mesg = $w->messageBox(
-title => 'Instructions',
-message => "$instructions",
-type => 'OK'
);
}
1;
#----------------------------------------------------------------------------------------------
sub license { # Display the License
#----------------------------------------------------------------------------------------------
my $mesg = $w->messageBox(
-title => 'License',
-message => "$license",
-type => 'OK'
);
}
1;
#----------------------------------------------------------------------------------------------
sub about { # Display the about box
#----------------------------------------------------------------------------------------------
my $mesg = $w->messageBox(
-title => 'About The Weather Extension',
-message => "$author$version$release$purpose$usage",
-type => 'OK'
);
}
1;
#----------------------------------------------------------------------------------------------
sub flagList { # Display the list of HAL Flags required
#----------------------------------------------------------------------------------------------
my $mesg = $w->messageBox(
-title => 'HAL Flags required',
-message => "This program expects these HAL flags:\n$halFlags \nAdditional Flags are:\n$halExtFlags",
-type => 'OK'
);
}
1;
#----------------------------------------------------------------------------------------------
sub credits { # Display the list of HAL Flags required
#----------------------------------------------------------------------------------------------
my $mesg = $w->messageBox(
-title => 'Author Credits',
-message => "$credits",
-type => 'OK'
);
}
1;
#----------------------------------------------------------------------------------------------
sub dirList { # Display the list of directories Weather Monitor requires
#----------------------------------------------------------------------------------------------
my $mesg = $w->messageBox(
-title => 'Directories required',
-message => "Two directories are used to store data. They are $LogDir and $ScriptDir\n".
"They are created automatically if they don't already exist.\n",
-type => 'OK'
);
}
1;
#==============================================================================================
# End of Menu Handling subroutines
#==============================================================================================
#==============================================================================================
# Animation related subroutines. Each sub starts with 'ani' and is involved in animation
#----------------------------------------------------------------------------------------------
sub aniStart { # Start the animation running using a timer to update regularly
#----------------------------------------------------------------------------------------------
if ($Graphics) { # If we're displaying graphics
$aniTimer = $Display->repeat (100, # Start the animation timer
sub {
aniArrow(); # Animate the Wind Direction Arrowa
aniBarometer(); # Animate the Barometer Scale
aniCloud(); # Animate the clouds
});
hideBarometer($LastPressure);
$Display->itemconfigure('Sun', -state => 'normal');
$Display->itemconfigure('Cloud0',-state => 'normal');
$Display->itemconfigure('Cloud1',-state => 'normal');
$Display->itemconfigure('Cloud2',-state => 'normal');
$Display->itemconfigure('littleMoon', -state => 'normal');
$Display->itemconfigure('bigMoon',-state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniStop {
#----------------------------------------------------------------------------------------------
if ($aniTimer) {
$aniTimer->cancel();
aniErase();
}
if ($hiTempTimer) {
$hiTempTimer->cancel();
}
if ($loTempTimer) {
$loTempTimer->cancel();
}
if ($dewTimer) {
$dewTimer->cancel();
}
if ($humTimer) {
$humTimer->cancel();
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniOverlayHumidity {
#----------------------------------------------------------------------------------------------
if ($Graphics) {
if ($Hum) {
$humTimer = $Display->after(45000,
sub {
$Display->itemconfigure('TempF',-fill =>'green',-text=>$Hum);
$Display->itemconfigure('HmLabel', -state=>'normal');
$Display->itemconfigure('Hum%', -state=>'normal');
$humTimer = $Display->after(3000,
sub {
$Display->itemconfigure('TempF',-fill=>'red',-text=>$Tp);
$Display->itemconfigure('HmLabel',-state=>'hidden');
$Display->itemconfigure('Hum%', -state=>'hidden');
$humTimer->cancel();
});
});
}
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniOverlayHighTemp {
#----------------------------------------------------------------------------------------------
$HiUpdateCounter++;
if ($Graphics) {
if ($HiTemp > $Tp) {
$hiTempTimer = $Display->after(15000,
sub {
$Display->itemconfigure('TempF',-fill=>'red',-text=>$HiTemp);
$Display->itemconfigure('HiLabel',-state=>'normal');
$hiTempTimer->cancel();
$hiTempTimer = $Display->after(3000,
sub {
$Display->itemconfigure('TempF',-fill=>'red',-text=>$Tp);
$Display->itemconfigure('HiLabel',-state=>'hidden');
$hiTempTimer->cancel();
});
});
}
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniOverlayLowTemp {
#----------------------------------------------------------------------------------------------
$LoUpdateCounter++;
if ($Graphics) {
if ($LoTemp < $Tp) {
$loTempTimer = $Display->after(30000,
sub {
$Display->itemconfigure('TempF',-fill=>'red',-text=>$LoTemp);
$Display->itemconfigure('LoLabel',-state=>'normal');
$loTempTimer->cancel();
$loTempTimer = $Display->after(3000,
sub {
$Display->itemconfigure('TempF',-fill=>'red',-text=>$Tp);
$Display->itemconfigure('LoLabel',-state=>'hidden');
$loTempTimer->cancel();
});
});
}
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniOverlayDewpoint {
#----------------------------------------------------------------------------------------------
if ($Graphics) {
if ($Dp > 0) {
$Display->itemconfigure('TempF',-fill =>'green',-text=>$Dp);
$Display->itemconfigure('DpLabel', -state=>'normal');
$dewTimer = $Display->after(3000,
sub {
$Display->itemconfigure('TempF',-fill=>'red',-text=>$Tp);
$Display->itemconfigure('DpLabel',-state=>'hidden');
$dewTimer->cancel();
});
}
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniCloud { # Move the cloud glyphs across the screen tracking the Baormeter animation
#----------------------------------------------------------------------------------------------
$Display->coords('Cloud0',$BP-2500,20);
$Display->coords('Cloud1',$BP-2600,20+$M);
$Display->coords('Cloud2',$BP-2700,20-$M);
if ($TrendUp) {$M++}; # Advance Pointer
if (!$TrendUp) {$M--}; # or Retard Pointer
$Display->coords('littleMoon',380+$M,$BP-2800);
occultMoon();
}
1;
#----------------------------------------------------------------------------------------------
sub aniArrow { # Rotate thru the Wind Direction Arrows in response to animation calls
#----------------------------------------------------------------------------------------------
# This gets called by the $aniTimer when it fires.
if ($Graphics) { # If we're displaying graphics
$Display->itemconfigure(@Arrows[$N],-state => 'hidden'); # Hide displayed arrow
if ($TrendUp) {$N++}; # Advance Pointer
if (!$TrendUp) {$N--}; # or Retard Pointer
if ($N > 15) {$N = 0}; # Wrap pointer going up
if ($N < 0) {$N = 15}; # Wrap pointer going down
$Display->itemconfigure(@Arrows[$N],-state => 'normal'); # Display next in the array
$LastArrow = @Arrows[$N]; # Remember last arrow so when
} # User hits run it will erase
}
1;
#----------------------------------------------------------------------------------------------
sub aniBarometer { # Move the Barometer pointer up and down in response to animation calls
#----------------------------------------------------------------------------------------------
# This gets called by the $aniTimer when it fires.
if ($Graphics) { # If we're displaying graphics
hideBarometer($BP); # Hide the mark from last time
if ($BP > 3130) { # Wrap the pointer
$TrendUp--;
$BP = 3130;
}
if ($BP < 2790) { # within the boundaries
$TrendUp++;
$BP = 2790;
}
if ($TrendUp) { # Advance the pointer
$BP++;#$BP++;$BP++;
} # or
if (!$TrendUp) {
$BP--;#$BP--;$BP--; # Retard the pointer
}
displayBarometer($BP); # Display the mark
# Display our demo "Barometric Pressure" in the animated numeric display
$LastPressure = substr($BP,0,2).'.'.substr($BP,2,2); # Remember the last pressure
$Display->itemconfigure('Baro-in',-text =>$LastPressure);# so it is erased on run()
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniErase { # Erase all the animated icons when the animation is stopped
#----------------------------------------------------------------------------------------------
if ($Graphics) { # If we're displaying graphics
$Display->itemconfigure("Baro-in",-text => ' ');
hideBarometer($LastPressure);
$Display->coords('Cloud0',345,10);
$Display->itemconfigure('Cloud0', -state => 'hidden');
$Display->coords('Cloud1',345,20);
$Display->itemconfigure('Cloud1', -state => 'hidden');
$Display->coords('Cloud2',345,10);
$Display->itemconfigure('Cloud2', -state => 'hidden');
$Display->coords('littleMoon',405,1);
$Display->itemconfigure('littleMoon', -state => 'hidden');
$Display->itemconfigure('bigMoon',-state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniStartProg { # Erase all the animated icons when the program is started
#----------------------------------------------------------------------------------------------
if ($Graphics) {
GetSunMoonRiseSet(); # Initialize the sun and moon rise and set times
initSunMoonDisplay(); # Figure out if sun or moon is in sky
$aniTimer = $Display->repeat (60000,# Start the animation timer, run once per minute
sub {
aniHeartbeat(); # Call heartbeat program
});
}
}
1;
#----------------------------------------------------------------------------------------------
sub aniHeartbeat { # Once per minute heartbeat while program is running
#----------------------------------------------------------------------------------------------
$time = localtime(time()); # retrieve system time
$time =~ m/\d\d:\d\d/; # Match just the time hh:mm
$time = $&; # Retrieve the match
$time =~ s/://; # and remove the colon
# so we can do a simple compare
if (index($time,'0') == 0) { # Chop off any leading zero
$time = substr($time,1,4); # e.g. 08:25 => 8:25
}
if ($arrayref) { # Refresh rise/set array if we are using the WU module
$riseSetTimes[0] = Hour12Convert24($arrayref->[$PlInstance]->{sunrise});
$riseSetTimes[1] = Hour12Convert24($arrayref->[$PlInstance]->{sunset});
$riseSetTimes[2] = Hour12Convert24($arrayref->[$PlInstance]->{moonrise});
$riseSetTimes[3] = Hour12Convert24($arrayref->[$PlInstance]->{moonset});
}
my $t0 = $riseSetTimes[0]; # Sunrise
$t0 =~ s/://; # Create a local copy without a colon
my $t1 = $riseSetTimes[1]; # Sunset
$t1 =~ s/://; # Create a local copy without a colon
my $t2 = $riseSetTimes[2]; # Moon rise
$t2 =~ s/://; # Create a local copy without a colon
my $t3 = $riseSetTimes[3]; # Moon Set
$t3 =~ s/://; # Create a local copy without a colon
#$Debug=1;
DebugDisplay("Time = $time - ");
DebugDisplay("Sunrise = $t0 - ");
DebugDisplay("Sunset = $t1 - ");
DebugDisplay("Moon rise = $t2 - ");
DebugDisplay("Moon Set = $t3 \n");
aniOverlayDewpoint();
aniOverlayHighTemp();
aniOverlayLowTemp();
aniOverlayHumidity();
if (($time == $t0) && (!$SunLight)) { # Match against sunrise time
$SunLight++;
$Display->itemconfigure("Sun", -state => 'normal');
$Display->itemconfigure("NightSky", -state => 'hidden');
if ($MoonLight) {
$Display->itemconfigure("bigMoon", -state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
$Display->itemconfigure("littleMoon",-state => 'normal');
} else {
$Display->itemconfigure("bigMoon", -state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
$Display->itemconfigure("littleMoon",-state => 'hidden');
$Display->itemconfigure("NightSky", -state => 'normal');
}
}
if (($time == $t1) && ($SunLight)){ # ditto sunset
$SunLight--;
$Display->itemconfigure("Sun", -state => 'hidden');
if ($MoonLight) {
$Display->itemconfigure("bigMoon", -state => 'normal');
#$Display->itemconfigure("earthShadow",-state => 'normal');
$Display->itemconfigure("littleMoon", -state => 'hidden');
} else {
$Display->itemconfigure("bigMoon", -state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
$Display->itemconfigure("littleMoon", -state => 'hidden');
$Display->itemconfigure("NightSky", -state => 'normal');
}
}
if (($time == $t2) && (!$MoonLight)) { # Moon rise
$MoonLight++;
$Display->itemconfigure("NightSky", -state => 'hidden');
if (!$SunLight) {
$Display->itemconfigure("bigMoon", -state => 'normal');
#$Display->itemconfigure("earthShadow",-state => 'normal');
$Display->itemconfigure("littleMoon",-state => 'hidden');
} else {
$Display->itemconfigure("bigMoon", -state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
$Display->itemconfigure("littleMoon",-state => 'normal');
}
}
if (($time == $t3) && ($MoonLight)){ # Moon set
$MoonLight--;
$Display->itemconfigure("bigMoon", -state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
$Display->itemconfigure("littleMoon",-state => 'hidden');
if (!$SunLight) {
$Display->itemconfigure("NightSky", -state => 'normal');
} else {
$Display->itemconfigure("Sun", -state => 'normal');
}
}
$NxtUpd--;
#$Debug=0;
}
1;
#==============================================================================================
# End of Animation subroutines
#==============================================================================================
#============================================================================
# Graphical display logic. A collection of related subroutines |
# Various functions related to drawing the graphic widgets. |
#----------------------------------------------------------------------------
sub toggleDisplay { # Toggle Display between Graphical and/or Text Mode |
#----------------------------------------------------------------------------
if (!$Graphics) {
clrConsole(); # Clear the console and remove the Action buttons
$Graphics++;
$display_menu->delete(2); # Reset the Display menu
$display_menu->insert(2,'command',-state=>'normal',-command => \&toggleDisplay,
-label => "Text", -underline => 0);
$ini->setval('Settings','Mode',$Graphics); # Write the mode to the INI
displayGraphics(); # Draw the screen
aniStart();
} else { # set to text mode
$Graphics--;
aniStop();
$display_menu->delete(2);
$display_menu->insert(2,'command',-state=>'normal',-command => \&toggleDisplay,
-label => "Graphic ", -underline => 0);
$ini->setval('Settings','Scroll',$Graphics);
displayText();
}
}
1;
#= subset of graphical display subroutines dealing with pure text display ===
#----------------------------------------------------------------------------
sub displayText { # Return the display mode to text after having been in graphical mode.
# Clear away all the graphics icons and the canvas and create a scrolled text box
#----------------------------------------------------------------------------
# Set the option for the Text display back to normal (may have been grayed out)
$display_menu->delete(1);
if (!$Scroll) {
$display_menu->insert(1,'command',-state=>'normal',-command => \&toggleScroll, -label => "Scroll", -underline => 1);
} else {
$display_menu->insert(1,'command',-state=>'normal',-command => \&toggleScroll, -label => "NoScroll", -underline => 1);
}
clearConsole(); # If previous mode was Graphical, clear away the GUI elements
## Create a Scrolled Text Console Display Box ##
$Display = $w_button_frm->Scrolled('Text', -width => '64', -height => '10'
)->pack(-side => 'right');
actionButtons(); # and display the action buttons on the left side of it.
return;
}
1;
#----------------------------------------------------------------------------
sub toggleScroll { # Scroll or don't scroll the display
#----------------------------------------------------------------------------
if (!$Scroll) {
clrConsole();
$Scroll++;
$display_menu->delete(1);
$display_menu->insert(1,'command',-state=>'normal',-command => \&toggleScroll, -label => "NoScroll", -underline => 0);
$ini->setval('Settings','Scroll',$Scroll);
} else {
$Scroll--;
$display_menu->delete(1);
$display_menu->insert(1,'command',-state=>'normal',-command => \&toggleScroll, -label => "Scroll", -underline => 0);
$ini->setval('Settings','Scroll',$Scroll);
}
}
1;
#----------------------------------------------------------------------------
sub clrConsole { # Erase the console display
#----------------------------------------------------------------------------
$Display->delete('1.0','end'); # Clear the console screen
}
1;
#=== End subset of display subroutines dealing with pure text display =======
#----------------------------------------------------------------------------
sub displayGraphics {
#----------------------------------------------------------------------------
# Remove the scrolled text area
if ($Display) { # If we have a canvas named $Display
clearConsole();
} else {
$display_menu->delete(2);
$display_menu->insert(2,'command',-state=>'normal',-command => \&toggleDisplay,
-label => "Text", -underline => 0);
}
$display_menu->delete(1);
if (!$Scroll) {
$display_menu->insert(1,'command',-state=>'disabled',-command => \&toggleScroll, -label => "Scroll", -underline => 1);
} else {
$display_menu->insert(1,'command',-state=>'disabled',-command => \&toggleScroll, -label => "NoScroll", -underline => 1);
}
# Create a drawing Canvas
$Display = $w_button_frm -> Canvas(-width => 470, -height => 162,
-takefocus=>0,-relief=>"sunken", -background=>"white");
$Display->pack(-expand => 1, -fill => 'none');
actionButtons(); # Draw the action buttons on the canvas before we display image
# Display the image on the canvas
$winDir = $w_button_frm->Photo(-width => 150, -height => 138,
-file => 'c:/perl/wx/icons/WindDirection.gif',
-format => 'gif');
$Display->createImage(10,20, -image => $winDir, -anchor => "nw");
$Display->pack(-side => 'right');
$cloud0 = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/cloud0.png',
-format => 'png');
$cloud1 = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/cloud1.png',
-format => 'png');
$cloud2 = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/cloud2.png',
-format => 'png');
$nact = $w_button_frm->Photo(-width => 71, -height => 67,
-file => 'c:/perl/wx/Icons/clearnight.png',
-format => 'png');
$moon = $w_button_frm->Photo(-width => 71, -height => 67,
-file => 'c:/perl/wx/Icons/Moon.png',
-format => 'png');
$littleMoon = $w_button_frm->Photo(-width => 71, -height => 67,
-file => 'c:/perl/wx/Icons/Smallmoon.png',
-format => 'png');
# $cloudy = $w_button_frm->Photo(-width => 81, -height => 122,
# -file => 'c:/perl/wx/icons/Cloudy.gif',
# -format => 'gif');
# $mostCloud = $w_button_frm->Photo(-width => 81, -height => 122,
# -file => 'c:/perl/wx/icons/MostlyCloudy.gif',
# -format => 'gif');
$rain = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/rain.png',
-format => 'png');
$lightRain = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/lightrain.png',
-format => 'png');
# $heavyRain = $w_button_frm->Photo(-width => 81, -height => 122,
# -file => 'c:/perl/wx/icons/heavyrain.gif',
# -format => 'gif');
# $overcast = $w_button_frm->Photo(-width => 81, -height => 122,
# -file => 'c:/perl/wx/icons/overcast.gif',
# -format => 'gif');
# $mostSun = $w_button_frm->Photo(-width => 81, -height => 122,
# -file => 'c:/perl/wx/icons/MostlySunny.gif',
# -format => 'gif');
$sun = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/Sun.gif',
-format => 'gif');
$blankSun = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/sun.gif',
-format => 'gif');
$Tbox = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/tempbox.gif',
-format => 'gif');
$clear = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/Sun.gif',
-format => 'gif');
$snow = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/snow4.png',
-format => 'png');
$fog1 = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/fog1.png',
-format => 'png');
$fog2 = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/fog2.png',
-format => 'png');
$fog3 = $w_button_frm->Photo(-width => 81, -height => 122,
-file => 'c:/perl/wx/icons/fog3.png',
-format => 'png');
$Display->createImage(343,20, -image => $sun, -anchor => "nw",-tag=>'Sun');
$Display->createImage(343,106,-image => $Tbox, -anchor => "nw",-tag=>'Tbox');
$Display->pack(-side => 'right');
$Display->createImage(343,20, -image => $moon, -anchor => "nw",-tag=>'bigMoon');
$Display->pack(-side => 'right');
$Display->createImage(343,20, -image => $nact, -anchor => "nw",-tag=>'NightSky',-state => 'hidden');
$Display->pack(-side => 'right');
$Display->createImage(343,20, -image => $sun, -anchor => "nw",-tag=>'Sun',-state => 'hidden');
$Display->pack(-side => 'right');
#$Display->createRectangle(345,15,415,115, -fill=>'white',-outline=>'white',-tag=>'earthShadow',-state=>'normal');
$barom = $w_button_frm->Photo(-width => 133, -height => 132,
-file => 'c:/perl/wx/icons/Barometer.gif',
-format => 'gif');
$Display->createImage(185,20, -image => $barom, -anchor => "nw");
$Display->pack(-side => 'right');
$Display->createImage(325,20,-image => $cloud0, -anchor => "nw",-state => 'normal',-tag=>'Cloud0');
$Display->createImage(325,20,-image => $cloud1, -anchor => "nw",-state => 'normal',-tag=>'Cloud1');
$Display->createImage(325,10,-image => $cloud2, -anchor => "nw",-state => 'normal',-tag=>'Cloud2');
$Display->createImage(325,20,-image => $rain, -anchor => "nw",-state => 'hidden',-tag=>'Rain');
$Display->createImage(325,20,-image => $lightRain,-anchor => "nw",-state => 'hidden',-tag=>'LightRain');
$Display->createImage(345,15,-image => $fog2,-anchor => "nw",-state => 'hidden',-tag=>'LightFog');
$Display->createImage(345,15,-image => $fog1,-anchor => "nw",-state => 'hidden',-tag=>'Fog');
$Display->createImage(345,15,-image => $fog3,-anchor => "nw",-state => 'hidden',-tag=>'DenseFog');
$Display->createImage(345,15,-image => $snow,-anchor => "nw",-state => 'hidden',-tag=>'Snow');
$Display->createImage(416,10, -image => $littleMoon, -anchor => "nw",-tag=>'littleMoon');
$Display->pack(-side => 'right');
defineArrows(); # Define all 16 arrows needed to display Wind Direction
defineBarometer(); # Define the Barometer Display
# Display defaults for the text fields
$Display->createText(87,64, -font=>$WindSpeedFont, -fill =>$FontDataColor, -text=>" ",-tag=>'Wind-mph');
$Display->createText(281,60, -font=>$BarometerFont, -fill =>$FontDataColor, -text=>" ", -tag=>'Baro-in');
$Display->createText(325,66, -font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"in", -tag=>'BaroUnit');
$Display->createText(193,40, -font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"31", -tag=>'BaroUnit');
$Display->createText(193,72, -font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"30", -tag=>'BaroUnit');
$Display->createText(193,104,-font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"29", -tag=>'BaroUnit');
$Display->createText(193,136,-font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"28", -tag=>'BaroUnit');
$Display->createText(218,40, -font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"DRY", -tag=>'BaroDry');
$Display->createText(220,72, -font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"FAIR", -tag=>'BaroFair');
$Display->createText(220,104,-font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"RAIN", -tag=>'BaroRain');
$Display->createText(232,136,-font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"STORMY", -tag=>'BaroStormy');
$Display->createText(381,124,-font=>$TemperatureFont,-fill =>$FontDataColor, -text=>"98.6", -tag=>'TempF');
# Create a tiny white rectangle to cover the red 'F' in the TempBox icon, so we can display a green '%' sign instead
$Display->create('rectangle',416,135,426,125, -fill=>'white',-outline=>'white',-tag=>'Hum%',-state=>'hidden');
$Display->createText(424,130,-font=>'TimesNewRoman 10 bold',-fill =>'green', -text=>"% ",-tag=>'Hum%', -state=>'hidden');
$Display->createText(436,118,-font=>'TimesNewRoman 10 bold',-fill =>'green', -text=>"Humid", -tag=>'HmLabel',-state=>'hidden');
$Display->createText(436,118,-font=>'TimesNewRoman 10 bold',-fill =>'green', -text=>"Dewpt", -tag=>'DpLabel',-state=>'hidden');
$Display->createText(431,118,-font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"High", -tag=>'HiLabel',-state=>'hidden');
$Display->createText(431,118,-font=>'TimesNewRoman 10 bold',-fill =>'red', -text=>"Low", -tag=>'LoLabel',-state=>'hidden');
}
1;
#----------------------------------------------------------------------------
sub clearConsole { # Mostly cosmetic sub to remove the graphical display and elements
#----------------------------------------------------------------------------
if ($Display) {
removeActionButtons();
$Display->destroy;
}
}
1;
#----------------------------------------------------------------------------
sub defineBarometer {
#
# FUNCTION: Called during initialization to define all the possible Barometer
# lines, and name them using a numeric tag.
# Mark them all hidden, and un-hide the desired one by calculation
# using the actual barometric pressure in a formula.
#
# SECTION: Graphics Display Logic
# INPUT: none
# GLOBALS: none
# LOCALS: $b
# OUTPUT: Collection of invisible lines that may be addressed individually
# calculation.
#
# USAGE: defineBarometer();
#
#----------------------------------------------------------------------------
my ($b) = 28;
while ($b < 142) { # Step thru them one at a time.
$barLine = $Display->createLine(186,$b,200,$b,-fill =>'blue',
-width => 4.0,-state=>'hidden',
-tag=>"barLine"."$b");
$b++;
}
}
1;
#----------------------------------------------------------------------------
sub displayBarometer {
#
# FUNCTION: Called to display the barometer line corresponding to the
# barometric pressure reported by weather station.
# Also display the text nearest to the actual mark.
#
# SECTION: Graphics Display Logic
# INPUT: Barometric Pressure in the form '29.88'
# GLOBALS: $Graphics, $Display
# LOCALS: $bp
# OUTPUT: Display of appropriate indicators on the barometer graphic
#
# USAGE: displayBarometer($barometricPressure);
#
#----------------------------------------------------------------------------
my ($bp) = @_; # $bp is the local version of global $BP
if ($Graphics) {
if (index($bp,".") == 2) { # If there's a decimal point, remove it.
$bp = substr($bp,0,2).substr($bp,3,2);
}
if (($bp > 2925) && ($bp < 3075)) {
$Display->itemconfigure('BaroFair',-fill => 'red',-font => 'TimesNewRoman 10 bold');
} else {
$Display->itemconfigure('BaroFair',-fill => 'light gray',-font => 'TimesNewRoman 10');
}
if (($bp > 3025) && ($bp < 3150)) {
$Display->itemconfigure('BaroDry',-fill => 'red',-font => 'TimesNewRoman 10 bold');
} else {
$Display->itemconfigure('BaroDry',-fill => 'light gray',-font => 'TimesNewRoman 10');
}
if (($bp > 2850) && ($bp < 2950)) {
$Display->itemconfigure('BaroRain',-fill => 'red',-font => 'TimesNewRoman 10 bold');
} else {
$Display->itemconfigure('BaroRain',-fill => 'light gray',-font => 'TimesNewRoman 10');
}
if (($bp > 2750) && ($bp < 2880)) {
$Display->itemconfigure('BaroStormy',-fill => 'red',-font => 'TimesNewRoman 10 bold');
} else {
$Display->itemconfigure('BaroStormy',-fill => 'light gray',-font => 'TimesNewRoman 10');
}
# Each .031 inches of mercury closely matches one pixel in our image. Divide
# and subtract to calculate the line to uncover. Append to 'barLine'
$bp = "barLine".int((3225-$bp)/3.1); # Convert to a range suitable for display
# use the results as the tag for the line we wish to uncover.
$Display->itemconfigure($bp,-state => 'normal',
-fill => 'blue',
-width => 8.0); # and show it.
}
}
1;
#----------------------------------------------------------------------------
sub hideBarometer { # Hide the current Barometer marker
#
# FUNCTION: Called to hide the current (actually previous) barometer line
#
# SECTION: Graphics Display Logic
# INPUT: Previous Barometric Pressure in the form '29.88'
# GLOBALS: $Graphics, $Display
# LOCALS: $b
# OUTPUT: Removeal of indicators on the barometer graphic
#
# USAGE: hideBarometer($barometricPressure);
#
#----------------------------------------------------------------------------
my ($b) = @_;
if ($Graphics) {
if (index($b,".") == 2) {
$b = substr($b,0,2).substr($b,3,2);
}
$b = int((3225-$b)/3.1);
$Display->itemconfigure("barLine"."$b",-state => 'hidden');
}
}
1;
#----------------------------------------------------------------------------
sub fadeBarometer { #
# Intended to cause individual lines to slowly fade. Can't quite get it to
# work the way I want.
# Not used, and will probably be deleted if I can't make it work correctly.
#----------------------------------------------------------------------------
my ($b) = @_;
if ($Graphics) {
if (index($b,".") == 2) { # Remove the decimal point
$b = substr($b,0,2).substr($b,3,2);
}
$b = "barLine".int((3225-$b)/3.1); # Convert to a coordinate
push(@fadedLines,$b); # put it on top of the stack
$Display->itemconfigure($b,-fill => 'light blue',
-width=>0.1); # make it light blue and thin
if ($#fadedLines > 0) {
$b = shift(@fadedLines); # take one from the bottom
push(@fadedLines,$b); # stuff it back on the top
$Display->itemconfigure($b,-fill => 'gray',
-state => 'normal',
-width => 0.1); # make it gray and thin
$b = shift(@fadedLines); # take one from the bottom
push(@fadedLines,$b); # stuff it back on the top
$Display->itemconfigure($b,-fill => 'light gray',
-state => 'normal',
-width => 0.1); # make it gray and thinner
$b = shift(@fadedLines); # Take another from the bottom
$Display->itemconfigure($b,-state => 'hidden',
-fill => 'blue',
-width => 4.0); # and hide it.
}
}
}
1;
#----------------------------------------------------------------------------
sub defineArrows {
#
# FUNCTION: Called during initialization to define all the possible arrows needed
# to display every possible wind direction.
# All arrows are created invisible, and turned visible when ready to
# display.
#
# SECTION: Graphics Display Logic
# INPUT: none
# GLOBALS: none
# LOCALS: none
# OUTPUT: Quiver of 16 invisible arrows that may be addressed individually by
# name, the name being predefined as 'ar-' followed by the direction.
#
# USAGE: defineArrows();
#
#----------------------------------------------------------------------------
## --------------------------------------------------------------
### Define the various arrows used to indicate Wind Direction ###
# Define the arrow for North
$Display->createLine(87,34,87,30,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-n',-state => 'hidden');
$Display->createLine(87,34,87,8,-fill =>'black', -width => 0.2,
-arrow=>'last',-tag=>'ar-n',-state => 'hidden');
$Display->createLine(87,14,87,8,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-n',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for North North East
$Display->createLine(111,41,126,16,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-nne',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for Wind Dir North East
$Display->createLine(126,55,134,48,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-ne',-state => 'hidden');
$Display->createLine(126,55,150,30,-fill =>'black', -width => 0.2,
-arrow=>'last',-tag=>'ar-ne',-state => 'hidden');
$Display->createLine(144,36,150,30,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-ne',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for East North East
$Display->createLine(138,70,172,53,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-ene',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for EAST
$Display->createLine(142,87,150,87,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-e',-state => 'hidden');
$Display->createLine(146,87,174,87,-fill =>'black', -width => 0.2,
-arrow=>'last',-tag=>'ar-e',-state => 'hidden');
$Display->createLine(164,87,174,87,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-e',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for EAST SOUTH EAST
$Display->createLine(138,108,168,122,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-ese',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for South East
$Display->createLine(126,126,132,132,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-se',-state => 'hidden');
$Display->createLine(126,126,152,146,-fill =>'black', -width => 0.2,
-arrow=>'last',-tag=>'ar-se',-state => 'hidden');
$Display->createLine(146,140,152,146,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-se',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for SOUTH SOUTH EAST
$Display->createLine(108,136,122,162,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-sse',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for SOUTH
$Display->createLine(87,144,87,144,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-s',-state => 'hidden');
$Display->createLine(87,142,87,162,-fill =>'black', -width => 0.1,
-arrow=>'last',-tag=>'ar-s',-state => 'hidden');
$Display->createLine(87,162,87,164,-fill =>'black', -width => 3.0,
-arrow=>'last',-tag=>'ar-s',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for South South West
$Display->createLine(66,139,54,162,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-ssw',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for South West
$Display->createLine(45,124,39,130,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-sw',-state => 'hidden');
$Display->createLine(45,124,18,146,-fill =>'black', -width => 0.2,
-arrow=>'last',-tag=>'ar-sw',-state => 'hidden');
$Display->createLine(24,140,18,146,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-sw',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for West South West
$Display->createLine(37,107,6,120,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-wsw',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for West
$Display->createLine(30,87,24,87,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-w',-state => 'hidden');
$Display->createLine(30,87,1,87,-fill =>'black', -width => 0.2,
-arrow=>'last',-tag=>'ar-w',-state => 'hidden');
$Display->createLine(8,87,1,87,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-w',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for West North West
$Display->createLine(37,71,6,56,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-wnw',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for North West
$Display->createLine(45,55,39,49,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-nw',-state => 'hidden');
$Display->createLine(45,55,20,30,-fill =>'black', -width => 0.2,
-arrow=>'last',-tag=>'ar-nw',-state => 'hidden');
$Display->createLine(26,36,20,30,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-nw',-state => 'hidden');
## --------------------------------------------------------------
# Define the arrow for North North West
$Display->createLine(62,42,46,16,-fill =>'black', -width => 5.0,
-arrow=>'last',-tag=>'ar-nnw',-state => 'hidden');
# That's all of them
## --------------------------------------------------------------
}
1;
#----------------------------------------------------------------------------
sub GetSunMoonRiseSet {
#
# FUNCTION: Called at program start and once a day thereafter just
# after midnight to discover the times the Sun and Moon
# rise and set. Does so by screen-scraping the WU web page
# using the zip code as search criteria.
#
# This information is used to sync the sun and moon
# animations with the real sky. Since this is fairly critical
# to the graphics, we also return bogus but reasonable values
# if we do not have valid data.
#
# Note: the WU module returns the same data. If available, this
# data is refreshed once a minute from the WU source.
#
# SECTION: Graphics Display Logic
# INPUT: Uses Zip code and WU web page as data source
# GLOBALS: $Zip, @riseSetTimes, $WU, $pageURL
# LOCALS: $c
# OUTPUT: Global array populated with time stamps in 24 hr format.
#
# USAGE: GetSunMoonRiseSet();
#
#----------------------------------------------------------------------------
my $c;
if ( (length($Zip) == 5) ) { # Only do this if we have a zipcode
if (!$WU) {
$WU = WWW::Mechanize->new(); # Only on the first pass
} # !$WU
$WU->get($pageURL.$Zip);
$WU->{content} =~ m/Rise<\/h4>/;
$c = substr($',0,5000); #' # Grab 5000 chrs starting at 'Rise'
$c = substr($c,index($c,"Actual")+61,index($c,"Moon")-105);
# We now have a block of text that starts approximately with Sunrise
# and Sunset times, and ends with Moon rise and set times.
$riseSetTimes[0] = Hour12Convert24(substr($c,index($c,">")+1,index($c,"T")-4));
$c = substr($c,index($c,">")+30,length($c));
$riseSetTimes[1] = Hour12Convert24(substr($c,index($c,">")+1,
(index($c,"<")-index($c,">"))+5));
$c = substr($c,index($c,">Moon<")+55,length($c));
$c =~ s/<\/td>//;
$c =~ s/<\/td>//;
$riseSetTimes[2] = Hour12Convert24(substr($c,index($c,">")+1,index($c,"M")));
$c = substr($c,index($c,"style"),length($c));
$c = substr($c,index($c,">"),length($c));
$riseSetTimes[3] = Hour12Convert24(substr($c,index($c,">")+1,index($c,"T")-4));
if ($riseSetTimes[3] == "NOMO" ) {
$riseSetTimes[3] = "23:59";
}
#$Debug=1;
DebugDisplay("Sunrise = $riseSetTimes[0] \n");
DebugDisplay("Sunset = $riseSetTimes[1] \n");
DebugDisplay("Moon rise = $riseSetTimes[2] \n");
DebugDisplay("Moon Set = $riseSetTimes[3] \n");
#$Debug=0;
} else {# if $Zip
# if no zip, give bogus but reasonable default sun/moon rise/set times
# just in case, so program does not behave terribly strangely.
# Otherwise it is prone to deciding the sun is not up at noon
$riseSetTimes[0] = "7:00"; # Sunrise 7 AM
$riseSetTimes[1] = "20:00"; # Sunset 8 PM
$riseSetTimes[2] = "16:00"; # Moon rise 4 PM
$riseSetTimes[3] = "3:00"; # Moon set 3 AM
} # if No zip
}
1;
#----------------------------------------------------------------------------
sub initSunMoonDisplay {
#
# FUNCTION: Called at program start to initialize the display of the
# sun and moon to match the actual state of the sky
#
# SECTION: Graphics Display Logic
# INPUT: System time, rise and set times for sun and moon
# GLOBALS: @riseSetTimes, $MoonLight, $SunLight
# LOCALS: $ti, $t0, $t1, $t2, $t3
# OUTPUT: Nothing returned. Display is configured to match the sky
#
# USAGE: initSunMoonDisplay();
#
#----------------------------------------------------------------------------
my $ti = `time /T`; # Returns system time, e.g.'09:08 AM'
DebugDisplay($ti);
$ti = Hour12Convert24($ti); # we want it in 24 hour format
$ti =~ s/://; # and without a colon in the middle
# so we can do a simple compare
###########
getWeather();
if ($arrayref) { # Refresh rise/set array if we are using the WU module
$riseSetTimes[0] = Hour12Convert24($arrayref->[$PlInstance]->{sunrise});
$riseSetTimes[1] = Hour12Convert24($arrayref->[$PlInstance]->{sunset});
$riseSetTimes[2] = Hour12Convert24($arrayref->[$PlInstance]->{moonrise});
$riseSetTimes[3] = Hour12Convert24($arrayref->[$PlInstance]->{moonset});
}
my $t0 = $riseSetTimes[0]; # Sunrise
$t0 =~ s/://; # Create a local copy without a colon
my $t1 = $riseSetTimes[1]; # Sunset
$t1 =~ s/://; # Create a local copy without a colon
my $t2 = $riseSetTimes[2]; # Moon rise
$t2 =~ s/://; # Create a local copy without a colon
my $t3 = $riseSetTimes[3]; # Moon Set
$t3 =~ s/://; # Create a local copy without a colon
## This block of code replaces the block below to correct initialization problems
## sometimes seen on starting Wx after sunrise. Depending on the weather station
## previous version may have missed getting proper timestamps.
#######
# DebugDisplay($ti);
# my $t0 = $riseSetTimes[0]; # Sunrise
# $t0 =~ s/://; # Create a local copy without a colon
# my $t1 = $riseSetTimes[1]; # Sunset
# $t1 =~ s/://; # Create a local copy without a colon
# my $t2 = $riseSetTimes[2]; # Moon rise
# $t2 =~ s/://; # Create a local copy without a colon
# my $t3 = $riseSetTimes[3]; # Moon Set
# $t3 =~ s/://; # Create a local copy without a colon
if (($t3 < $t2) && ($ti < $t3)) { # Watch out for time wrap
$t2 = $t2-2400; # at midnight screwing up
} # moon display on morning start
if ($t3 < $t2) { # or on Evening Start
$t3 = $t3+2400;
}
#$Debug=1;
DebugDisplay($ti." ".$t0." ".$t1." ".$t2." ".$t3);
# if between moonrise and moon set, place a moon in the sky
if (($ti > $t2) && ($ti < $t3)) { # if moon is up
DebugDisplay("\nMoon is up ".$t2." ".$ti." ".$t3);
$Display->itemconfigure("bigMoon", -state => 'normal');
#$Display->itemconfigure("earthShadow",-state => 'normal');
$MoonLight++;
} else { # If moon not up show night sky icon
$Display->itemconfigure("NightSky", -state => 'normal');
DebugDisplay("\nMoon is NOT up ".$ti." ".$t2." ".$t3);
}
# if the sun is up, place the sun, and if necessary move the moon
if (($ti > $t0) && ($ti < $t1)) { # if sun is up
DebugDisplay("\nThe Sun is UP $t0 $ti $t1 \n");
$Display->itemconfigure("Sun", -state => 'normal');
$Display->itemconfigure("NightSky", -state => 'hidden');
if ($MoonLight) {
$Display->itemconfigure("bigMoon", -state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
$Display->itemconfigure("littleMoon",-state => 'normal');
} else {
$Display->itemconfigure("bigMoon", -state => 'hidden');
$Display->itemconfigure("earthShadow",-state => 'hidden');
$Display->itemconfigure("littleMoon",-state => 'hidden');
}
$SunLight++;
} else { # Sun is not up, make sure not displayed.
$Display->itemconfigure("Sun", -state => 'hidden');
DebugDisplay("\nThe Sun is NOT up $ti $t0 $t1 \n");
if ($MoonLight) {
$Display->itemconfigure("bigMoon", -state => 'normal');
} else {
$Display->itemconfigure("NightSky", -state => 'normal');
}
}
#$Debug=0;
}
1;
#============================================================================
# End of Graphical Display subroutines
#============================================================================
#==============================================================================================
# Speech subroutines
#----------------------------------------------------------------------------------------------
sub toggleConditions { # Whether to have HAL speak the weather conditions when they change
#----------------------------------------------------------------------------------------------
if ($speakConditions == 0) {
$speakConditions = 1;
$voice_menu->delete(4);
$voice_menu->insert(4,'command',-state=>'normal',-command => \&toggleConditions,
-label => "X Conditions ", -underline => 3);
} else {
$speakConditions = 0;
$voice_menu->delete(4);
$voice_menu->insert(4,'command',-state=>'normal',-command => \&toggleConditions,
-label => " Conditions ", -underline => 3);
}
}
1;
#----------------------------------------------------------------------------------------------
sub toggleStartStop { # Whether to have HAL announce the start and stop of weather monitoring
#----------------------------------------------------------------------------------------------
if ($speakStartStop == 0) {
$speakStartStop = 1;
$voice_menu->delete(3);
$voice_menu->insert(3,'command',-state=>'normal',-command => \&toggleStartStop,
-label => "X Start/Stop ", -underline => 2);
} else {
$speakStartStop = 0;
$voice_menu->delete(3);
$voice_menu->insert(3,'command',-state=>'normal',-command => \&toggleStartStop,
-label => " Start/Stop ", -underline => 2);
}
}
1;
#----------------------------------------------------------------------------------------------
sub toggleComfort {
#----------------------------------------------------------------------------------------------
if ($speakComfort == 0) {
$speakComfort = 1;
$voice_menu->delete(2);
$voice_menu->insert(2,'command',-state=>'normal',-command => \&toggleComfort, -label => "X Comfort ", -underline => 2);
} else {
$speakComfort = 0;
$voice_menu->delete(2);
$voice_menu->insert(2,'command',-state=>'normal',-command => \&toggleComfort, -label => " Comfort ", -underline => 2);
}
}
1;
#----------------------------------------------------------------------------------------------
sub toggleTemperature {
#----------------------------------------------------------------------------------------------
if ($speakTemperature == 0) {
$speakTemperature = 1;
$voice_menu->delete(1);
$voice_menu->insert(1,'command',-state=>'normal',-command => \&toggleTemperature,
-label => "X Temperature ", -underline => 2, -accelerator => '^T');
} else {
$speakTemperature = 0;
$voice_menu->delete(1);
$voice_menu->insert(1,'command',-state=>'normal',-command => \&toggleTemperature,
-label => " Temperature ", -underline => 2, -accelerator => '^T');
}
}
1;
#----------------------------------------------------------------------------------------------
sub speak {
#----------------------------------------------------------------------------------------------
my ($ttx) = @_;
if (($useHALi) && (-e $HALiOCX)) {
if (!$HALi1->TTS->Speak($ttx)) {
Display("HALi is not working!! \n");
}
} else {
if ($useSAPI) {
$speech->Speak($ttx);
}
}
}
1;
#----------------------------------------------------------------------------------------------
sub initWindowsSpeech {
#----------------------------------------------------------------------------------------------
if ($useSAPI) {
$speech = Win32::SAPI5::SpVoice->new();
$speech->Speak( "Microsoft Sam is On Line" );
}
}
1;
#==============================================================================================
# End of Speech subroutines
#==============================================================================================
#==============================================================================================
# editing subroutines
#----------------------------------------------------------------------------------------------
sub editIntervals {
#----------------------------------------------------------------------------------------------
# Let's draw a window on the screen
my $dlg = MainWindow->new;
$dlg->Label(-text => 'Intervals may be edited by editing the INI File')->pack;
$dlg->configure(-takefocus => 1);
# Define the save button and what happens when it's hit.
my $but = $dlg->Button(-text => 'OK',
-command => sub {$dlg->destroy}, # Terminate Entry Dialog Box.
)->pack;
MainLoop;
}
1;
#----------------------------------------------------------------------------------------------
sub editThresholds {
#----------------------------------------------------------------------------------------------
# Let's draw a window on the screen
my $dlg = MainWindow->new;
$dlg->Label(-text => 'Thresholds may be edited by editing the INI File')->pack;
$dlg->configure(-takefocus => 1);
# Define the save button and what happens when it's hit.
my $but = $dlg->Button(-text => 'OK',
-command => sub {$dlg->destroy}, # Terminate Entry Dialog Box.
)->pack;
MainLoop; # End of Widget building. Subroutine follows.
}
1;
#----------------------------------------------------------------------------------------------
sub getZip {
#----------------------------------------------------------------------------------------------
askZipcode();
$config_menu->delete(4);
$config_menu->insert(4,'command',-state=>'disabled',-command => \&askZipcode, -label => "Zipcode", -underline => 1);
$zipEdited = 1;
}
1;
#----------------------------------------------------------------------------------------------
sub editINI {
#----------------------------------------------------------------------------------------------
open (IP,"Notepad.exe $INIfile |");
close(IP);
readINIfile(); # Read the modified file
}
1;
#----------------------------------------------------------------------------------------------
sub getStationID {
#----------------------------------------------------------------------------------------------
# Let's draw a window on the screen
my $dlg = MainWindow->new;
$dlg->Label(-text => 'Station ID may be edited by editing the INI File')->pack;
$dlg->configure(-takefocus => 1);
# Define the save button and what happens when it's hit.
my $but = $dlg->Button(-text => 'OK',
-command => sub {$dlg->destroy}, # Terminate Entry Dialog Box.
)->pack;
MainLoop; # End of Widget building. Subroutine follows.
}
1;
#----------------------------------------------------------------------------------------------
sub getLocation {
#----------------------------------------------------------------------------------------------
askPlaceName();
$config_menu->delete(2);
$config_menu->insert(2,'command',-state=>'disabled',-command => \&getLocation, -label => "Location", -underline => 1 );
$locEdited = 1;
}
1;
#==============================================================================================
# END editing subroutines
#==============================================================================================
#==============================================================================================
# Action Subroutines. These subs handle the action commands
#----------------------------------------------------------------------------------------------
sub run { # Come here when the RUN button is pressed. This starts the whole cycle of
# retrieving the weather data from the web.
#----------------------------------------------------------------------------------------------
my $time = localtime(time());
$Running++;
if (Exists($Third_button)) {$Third_button->configure(-state=>'disabled')};
if (Exists($Half_button)) {$Half_button->configure( -state=>'disabled')};
if (Exists($Hour_button)) {$Hour_button->configure( -state=>'disabled')};
if (Exists($Hours_button)) {$Hours_button->configure(-state=>'disabled')};
$NxtUpd = $interval/60;
if ($Graphics) {
aniStop(); # Erase all the animations
if (Exists($display_menu)) {
$display_menu->delete(2);
$display_menu->insert(2,'command',-state=>'disabled',-command => \&toggleDisplay,
-label => "Text", -underline => 0);
} # if (Exists($display_menu)) {
} else {
if (Exists($display_menu)) {
$display_menu->delete(2);
$display_menu->insert(2,'command',-state=>'disabled',-command => \&toggleDisplay,
-label => "Graphic ", -underline => 0);
} # if (Exists($display_menu)) {
} # if ($Graphics) {
aniStartProg(); # Start the once per minute tick
if (Exists($stop_button)) {$stop_button->configure(-state=>'normal',-foreground=>'red')};
if (Exists($run_button)) { $run_button->configure(-state=>'disabled')};
if (Exists($now_button)) { $now_button->configure(-state=>'normal')};
if (Exists($exit_button)) {$exit_button->configure(-state=>'disabled')};
# Adjust the Action menu for RUN state
if (Exists($action_menu)) {
$action_menu->delete(1);
$action_menu->insert(1,'command',-state=>'disabled',-command => \&run, -label => "Run", -underline => 0, -accelerator => "Alt-R");
$action_menu->delete(2);
$action_menu->insert(2,'command',-state=>'normal',-command => \&stop, -label => "Stop", -underline => 1, -accelerator => "Alt-T");
$action_menu->delete(3);
$action_menu->insert(3,'command',-state=>'normal',-command => \&getWeather, -label => "Now!", -underline => 1);
$action_menu->delete(4);
$action_menu->insert(4,'command',-state=>'disabled',-command => \&exit, -label => "Exit", -underline => 1);
}
# Adjust the Config menu for the RUN state
if (Exists($config_menu)) {
$config_menu->delete(1);
$config_menu->insert(1,'command',-state=>'disabled',-command => \&getStationID, -label => "StationID", -underline => 1 );
$config_menu->delete(2);
$config_menu->insert(2,'command',-state=>'disabled',-command => \&getLocation, -label => "Location", -underline => 1 );
$config_menu->delete(3);
$config_menu->insert(3,'command',-state=>'disabled',-command => \&editIntervals, -label => "Intervals", -underline => 1);
$config_menu->delete(4);
$config_menu->insert(4,'command',-state=>'disabled',-command => \&askZipcode, -label => "Zipcode", -underline => 1);
$config_menu->delete(5);
$config_menu->insert(5,'command',-state=>'disabled',-command => \&editThresholds, -label => "Thresholds", -underline => 1);
}
if (Exists($zip_entry)) {
$zip_entry->configure(-state=>'readonly'); # Make the zip box read only
$Zip = $zip_entry->get(); # Grab the zipcode from it
$ini->setval('Location','ZipCode',$Zip);
$ini->RewriteConfig;
}
if (Exists($LOC_entry)) {
$Place = $LOC_entry->get(); # Grab the location from it
$LOC_label->configure(-text => ' Station:'); # Update the text field
$LOC_entry->configure(-textvariable => \ $PlaceStr,-state=>'readonly'); # Make the LOCATION box read only
}
if (!$Direct) {
initWeatherAgent(); # Start the Weather agent using the location
}
InitFlagList(); # Create our list of Weather Flags
clearDatabase(); # Clear residual information from HAL
getWeather(); # do it immediately
if ($speakStartStop == 1) {
speak("Weather Station $PlaceStr is reporting.");
}
$runTimer = $Display->repeat ($interval*1000,
sub {$time = localtime(time());
getWeather(); # and repeat every $interval seconds
});
}
1;
#----------------------------------------------------------------------------------------------
sub stop { # Come here when the stop button is pressed
#----------------------------------------------------------------------------------------------
my ($lerr);
$Running--;
aniStop(); # Stop the tick
if (Exists($Third_button)) {$Third_button->configure(-state=>'normal')};
if (Exists($Half_button)) {$Half_button->configure(-state=>'normal')};
if (Exists($Hour_button)) {$Hour_button->configure(-state=>'normal')};
if (Exists($Hours_button)) {$Hours_button->configure(-state=>'normal')};
$NxtUpd = 0;
if ($Graphics) { # If we're displaying graphics
$Display->itemconfigure('TempF',-text => ' ');
$Display->itemconfigure('Baro-in',-text => ' ');
$Display->itemconfigure('Wind-mph',-text => ' ');
}
if (Exists($stop_button)) {$stop_button->configure(-state=>'disabled')};
if (Exists($run_button)) {$run_button->configure(-state=>'normal',-foreground=>'blue')};
if (Exists($now_button)) {$now_button->configure(-state=>'disabled',-foreground=>'blue')};
if (Exists($exit_button)) {$exit_button->configure(-state=>'normal',-foreground=>'blue')};
if (Exists($action_button)){$action_button->configure(-state=>'normal')};
# Adjust the file menu for Stop state
if (Exists($action_menu)) {
$action_menu->delete(1);
$action_menu->insert(1,'command',-state=>'normal',-command => \&run, -label => "Run", -underline => 0, -accelerator => "Alt-R");
$action_menu->delete(2);
$action_menu->insert(2,'command',-state=>'disabled',-command => \&stop, -label => "Stop", -underline => 1, -accelerator => "Alt-T");
$action_menu->delete(3);
$action_menu->insert(3,'command',-state=>'disabled',-command => \&getWeather, -label => "Now!", -underline => 1);
$action_menu->delete(4);
$action_menu->insert(4,'command',-state=>'normal',-command => \&exit, -label => "Exit", -underline => 1);
}
# Adjust the Config menu for the STOP state
if (Exists($config_menu)) {
$config_menu->delete(1);
$config_menu->insert(1,'command',-state=>'normal',-command => \&getStationID, -label => "StationID", -underline => 1 );
if ($locEdited <=> 1) {
$config_menu->delete(2);
$config_menu->insert(2,'command',-state=>'normal',-command => \&getLocation, -label => "Location", -underline => 1 );
}
$config_menu->delete(3);
$config_menu->insert(3,'command',-state=>'normal',-command => \&editIntervals, -label => "Intervals", -underline => 1);
if ($zipEdited <=> 1) {
$config_menu->delete(4);
$config_menu->insert(4,'command',-state=>'normal',-command => \&askZipcode, -label => "Zipcode", -underline => 1);
}
$config_menu->delete(5);
$config_menu->insert(5,'command',-state=>'normal',-command => \&editThresholds, -label => "Thresholds", -underline => 1);
}
if (Exists($zip_entry)) {$zip_entry->configure(-state=>'normal')}; # Make the zip box normal
if (Exists($LOC_label)) {$LOC_label->configure(-text => 'Location:')}; # Update the text field
if (Exists($LOC_entry)) {$LOC_entry->configure(-state=>'normal'); # Make the LOCATION box normal
$LOC_entry->configure(-textvariable => \ $Place); # Restore the Place
}
clearDatabase(); # Clear residual information from HAL
if ($Graphics) {
if (Exists($display_menu)) {$display_menu->delete(2);
$display_menu->insert(2,'command',-state=>'normal',-command => \&toggleDisplay,
-label => "Text", -underline => 0);
}
} else {
if (Exists($display_menu)) {$display_menu->delete(2);
$display_menu->insert(2,'command',-state=>'normal',-command => \&toggleDisplay,
-label => "Graphic ", -underline => 0);
}
}
my $time = localtime(time());
Console("Stop at $time.\n");
if ($speakStartStop == 1) {
speak("Weather Station monitoring is disabled.");
}
$runTimer->cancel();
$lerr = Win32::OLE->LastError(); # Check for any errors
if ($lerr > 0 ) { # If any HALi errors were encountered, display @ exit
Console("OLE Error detected: error number $lerr \n");
}
aniStart(); # (re)start the animation
} # End Stop
1;
#----------------------------------------------------------------------------------------------
sub end { # Come here when the eXit button is pressed.
#----------------------------------------------------------------------------------------------
if ($Running) {stop()};
aniStop(); # Stop any Animations
if (index($HALiStat,"running") > 0) {
$HALi1->UnInit(); # Clean up the HALi processes and
$HALi1->DESTROY(); # Free up the memory they used.
$HALiStat = "Stopped";
}
writeINIfile(); # Update the INI file
$mutex->release;
exit;
}
1;
} # END of Menubox Code
1;
###############################################################################################
# END of the GUI / Menubox related code.
###############################################################################################
#========================================================================================
# Weather Information Processing Subroutines
#========================================================================================
sub getWeather { # This is the main workhorse part of the program. It pulls the weather
# data from the Internet and parses it out into all the places it belongs. It runs at
# regular intervals driven by a timer object. It can also be called immediately by
# pressing the NOW button.
#========================================================================================
my (@tmp);
if (!$Scroll) {
clrConsole();
}
if (!$weather) { # If weather object not good, try initing
initWeatherAgent(); # Start the Weather agent using the location
}
if (!$weather) { # if still not good, just return with nothing
Console("No Valid Weather Sources\n");
return();
}
$NxtUpd = $interval/60;
# Get the weather data
$arrayref = $weather->get_weather($PlInstance)
|| die "Error, calling get_weather() failed: $@\n";
# This error handling needs to be better
if ($Direct) { # If Direct, skip the rest of getWeather
getCSVdata(); # but the data is available to CSV functions
return;
}
$PlaceStr = $arrayref->[$PlInstance]->{place}; # Retrieve the full place name from the site
my($InTemp,$OutTemp,$InHum,$OutHum,$Barom,$Trend,$WSpeed,$WDir,$Rain);
@wxData = ($InTemp,$OutTemp,$InHum,$OutHum,$Barom,$Trend,$WSpeed,$WDir,$Rain);
# Open our primary files for writing
open (EL, ">>$LOGFile") || die "Error! Problem with log file\n";
open (TTS, ">$TTSFile") || die "ERROR! Problem opening $TTSFile.\n";
# Process the Weather data
$Timestamp = "As of ".$arrayref->[$PlInstance]->{updated};
DebugDisplay($arrayref->[$PlInstance]->{updated});
Console("$Timestamp"); # Display on the console
$Timestamp = ExpandDaylight($Timestamp);
print (TTS $Timestamp); # Write 'As of 11:59 PM' to the TTS file
LogDate();
$Timestamp = Hour12Convert24($Timestamp);
print (EL $Timestamp.","); # Write military timestamp to 'Weatherlog.csv'
$Sky = skyConditions($arrayref->[$PlInstance]->{conditions}); # Process the current conditions
$wxData[2] = Temperature($arrayref->[$PlInstance]->{temperature_fahrenheit});
@tmp = Wind($arrayref->[$PlInstance]->{wind_direction},$arrayref->[$PlInstance]->{wind_milesperhour});
$wxData[7] = $tmp[0];
$wxData[8] = $tmp[1];
print(EL ",$Sky,"); # Write the sky condition
$wxData[4] = Humidity($arrayref->[$PlInstance]->{humidity}); # Check the relative Humidity
$Hum = $wxData[4];
@tmp = Barometer($arrayref->[$PlInstance]->{pressure}); # Check the Barometric Pressure
$wxData[5] = $tmp[0];
$wxData[6] = $tmp[1];
$Dp = Dewpoint($arrayref->[$PlInstance]->{dewpoint_fahrenheit});# Check the Dewpoint
Visibility($arrayref->[$PlInstance]->{visibility_miles}); # Check the Visibility
fullMoon($arrayref->[$PlInstance]->{moonphase}); # Check for a full moon
DebugDisplay("Temp = ".$wxData[2]." Hum =".$wxData[4]." Press =".$wxData[5].
" Tren =".$wxData[6]." Spd =".$wxData[7]." Dir =".$wxData[8]);
# Write the data into the HALi Weather Station Interface
setHALiWSdata(@wxData);
# Close files and sleep until timer calls us again.
if (!$Graphics) { # Scroll the screen
$Display->yview('moveto',90);
}
print (EL "\n"); # Append a newline to the logfile
close(EL); # Close the logfile
close(TTS); # Close the TTS File
#} # not Direct
#--------------------------------------------------------------------------
sub LogDate { # write the date into the log file 'Weatherlog.csv'
# and when date changes at midnight do other 'start-of-day' tasks
# uses global $LastDate to track date from previous call.
# updates INI file variable LastDate
#--------------------------------------------------------------------------
my $da = `date /T`; # Returns system day/date, e.g.'Sat 04/23/2005'
chop($da); # Remove trailing CRLF
$da = substr($da,4); # Grab date only
chop($da); # Remove trailing space.
if ($da ne $LastDate) { # When midnight passes
GetSunMoonRiseSet(); # Get the new sun and moon rise and set times
clrConsole(); # clear the display
$LastDate = $da; # Save this date as the new LastDate
$ini->setval('Flags','LastDate',$LastDate);
$ini->RewriteConfig; # Update the INI file
}
print (EL $da.","); # Write date to 'Weatherlog.csv'
}
1;
#--------------------------------------------------------------------------
sub ExpandDaylight { # Expand 'PDT' etc into 'Daylight Time'
#--------------------------------------------------------------------------
my ($tstamp) = @_;
$tstamp =~ s/PDT/Daylight Time/; # Expand for TTS file
$tstamp =~ s/EDT/Daylight Time/; # Expand for TTS file
$tstamp =~ s/CDT/Daylight Time/; # Expand for TTS file
$tstamp =~ s/MDT/Daylight Time/; # Expand for TTS file
return($tstamp);
}
1;
#--------------------------------------------------------------------------
sub Hour12Convert24 {
#
# FUNCTION: Convert a timestamp in form nn:nn AM|PM to 24 hr military format
#
# SECTION: General Logic
# INPUT: String with a time value.
# Sample Input: 01:05 AM, 1:05 AM, 2:25 PM, 02:25 PM
# 'as of 1:05 AM'
# GLOBALS: None
# LOCALS: $tstamp
# OUTPUT: String with a time value in 24 hour format
#
# USAGE: $var = Hour12Convert24($string);
#
# COMMENTARY: There are an immense number of ways the time can be
# represented. This module attempts to take whatever is thrown
# at it, and convert to a 5 character string representing 24 hr
# military style format. This has been a painful source of
# ongoing problems as I test the code as invariably something
# seems to find a new way to present the time. If the calling
# program is doing something odd, the problem may well be here,
#--------------------------------------------------------------------------
my ($tstamp) = @_;
$tstamp =~ s/a//; # remove lowercase 'a' if any
$tstamp =~ s/\n//; # remove newline if any
$tstamp =~ s/p/PM/; # change 3:47p to 3:47PM
while (index($tstamp,' ') == 0) { # remove any leading spaces
$tstamp = substr($tstamp,1,12);
}
$tstamp = uc($tstamp);
$tstamp =~ s/AS OF //; # remove 'As of' if present
while (index($tstamp,' ') == 0) { # remove leading spaces (again)
$tstamp = substr($tstamp,1,12);
}
if (index($tstamp,'AM') > 0) {
$tstamp =~ s/AM//; # remove 'AM'
$tstamp =~ s/12:/00:/; # Add 12 hours to Hour
if (length($tstamp) > 5) { # Truncate to five characters
$tstamp = substr($tstamp,0,5);
$tstamp =~ s/ //; # remove trailing space, if any
}
if (index($tstamp,'0') == 0) { # Remove leading zero
$tstamp = substr($tstamp,1,4);
}
return($tstamp); # if it was AM, we're done
# Returned number looks like '5:47', '11:22'
}
# Convert 12 hr PM format to 24 hr format.
# input looks like '1:59 PM', '01:59 PM' or '10:47 PM'
if (index($tstamp,'P') > 0) {
if (index($tstamp,":") < 2) { # if only one digit before the colon
$tstamp = '0'.$tstamp; # prepend a zero
$tstamp =~ m/\d\d:\d\d/;
}
$tstamp =~ s/PM//; # remove 'PM'
$tstamp =~ s/10:/22:/; # Add 12 hours to Hour
$tstamp =~ s/11:/23:/; # Add 12 hours to Hour
$tstamp =~ s/12:/12:/; # Add 12 hours to Hour
$tstamp =~ s/09:/21:/; # Add 12 hours to Hour
$tstamp =~ s/08:/20:/; # Add 12 hours to Hour
$tstamp =~ s/07:/19:/; # Add 12 hours to Hour
$tstamp =~ s/06:/18:/; # Add 12 hours to Hour
$tstamp =~ s/05:/17:/; # Add 12 hours to Hour
$tstamp =~ s/04:/16:/; # Add 12 hours to Hour
$tstamp =~ s/03:/15:/; # Add 12 hours to Hour
$tstamp =~ s/02:/14:/; # Add 12 hours to Hour
$tstamp =~ s/01:/13:/; # Add 12 hours to Hour
$tstamp =~ s/ //; # remove space, if any
}
if (length($tstamp) > 5) {
$tstamp = substr($tstamp,0,5); # Truncate to five characters only
$tstamp =~ s/ //; # remove space, if any
}
# Output looks like '13:59' '01:56', or '10:47'
if (index($tstamp,'0') == 0) { # Remove leading zero, if any
$tstamp = substr($tstamp,1,4);
}
return($tstamp);
}
1;
#--------------------------------------------------------------------------
sub displaySkyConditions {
#
# FUNCTION: Takes the Sky Conditions passed by the calling program and
# updates the graphical display to match those conditions
#
# SECTION: Weather Information Processing Subroutines
# INPUT: Sky conditions passed via @_
# GLOBALS: $Graphics, $Display,
# LOCALS: $skyFlag
# OUTPUT: Updated graphical display, nothing returned
#
# USAGE: displaySkyConditions($skyFlag);
#--------------------------------------------------------------------------
my ($skyFlag) = @_;
# Change the display based on reported sky conditions
if ($Graphics) {
# First clear the display of all icons
$Display->itemconfigure("Cloud0", -state => 'hidden');
$Display->itemconfigure("Cloud1", -state => 'hidden');
$Display->itemconfigure("Cloud2", -state => 'hidden');
$Display->itemconfigure("Rain", -state => 'hidden');
$Display->itemconfigure("LightRain",-state => 'hidden');
$Display->itemconfigure("Snow", -state => 'hidden');
$Display->itemconfigure("Fog", -state => 'hidden');
$Display->itemconfigure("LightFog", -state => 'hidden');
$Display->itemconfigure("DenseFog", -state => 'hidden');
if (index($skyFlag,"WEATHER CLEAR") > -1 ) {
}
if (index($skyFlag,"WEATHER SUNNY") > -1 ) {
}
if (index($skyFlag,"WEATHER OVERCAST") > -1 ) {
$Display->itemconfigure("Cloud0", -state => 'normal');
$Display->itemconfigure("Fog",-state => 'normal');
$Display->itemconfigure("Cloud1", -state => 'normal');
$Display->itemconfigure("Cloud2", -state => 'normal');
}
if (index($skyFlag,"WEATHER CLOUDY") > -1 ) {
$Display->itemconfigure("Cloud0", -state => 'normal');
}
if (index($skyFlag,"WEATHER PARTLY CLOUDY") > -1 ) {
$Display->itemconfigure("Cloud0", -state => 'normal');
$Display->itemconfigure("Cloud1", -state => 'normal');
}
if (index($skyFlag,"WEATHER MOSTLY CLOUDY") > -1 ) {
$Display->itemconfigure("Cloud1", -state => 'normal');
}
if (index($skyFlag,"WEATHER SCATTERED CLOUDS") > -1 ) {
$Display->itemconfigure("Cloud2", -state => 'normal');
}
if (index($skyFlag,"WEATHER RAIN") > -1 ) {
$Display->itemconfigure("Rain", -state => 'normal');
}
if (index($skyFlag,"WEATHER LIGHT RAIN") > -1 ) {
$Display->itemconfigure("LightRain",-state => 'normal');
}
if (index($skyFlag,"WEATHER HEAVY RAIN") > -1 ) {
$Display->itemconfigure("Rain", -state => 'normal');
$Display->itemconfigure("LightRain",-state => 'normal');
}
if (index($skyFlag,"WEATHER SNOW") > -1 ) {
$Display->itemconfigure("Snow",-state => 'normal');
}
if (index($skyFlag,"WEATHER LIGHT SNOW") > -1 ) {
$Display->itemconfigure("Snow",-state => 'normal');
}
if (index($skyFlag,"WEATHER FOG") > -1 ) {
$Display->itemconfigure("Fog",-state => 'normal');
}
if (index($skyFlag,"WEATHER LIGHTFOG") > -1 ) {
$Display->itemconfigure("LightFog",-state => 'normal');
}
if (index($skyFlag,"WEATHER DENSEFOG") > -1 ) {
$Display->itemconfigure("DenseFog",-state => 'normal');
}
} # if ($Graphics)
}
1;
#--------------------------------------------------------------------------
sub skyConditions {
#
# FUNCTION: Takes the Sky Conditions returned by WU (CLEAR, CLOUDY, etc)
# writes the verbiage to the text files for speech, and returns
# the parsed condition to the calling program.
#
# SECTION: Weather Information Processing Subroutines
# INPUT: weather conditions passed via @_
# GLOBALS: @FlagsList, $LastFlag, $speakComfort, TTS, $ini
# LOCALS: $sky, $skyTTX, $skyFlag
# OUTPUT: Error Log update, TTS File update
# Returns current Sky Conditions
#
# USAGE: $Sky = skyConditions($arrayref->[$PlInstance]->{conditions});
#--------------------------------------------------------------------------
my ($sky) = @_; # Local copy of GLOBAL $Sky
my $skyTTX = " the sky is ".$sky."."; # $skyTTX is spoken by the TTX
my $skyFlag = uc("WEATHER ".$sky); # $skyFlag is the HAL Flag set
# when the condition is true.
print (TTS $skyTTX); # Write it to the TTS file
Console($skyTTX); # and also to the console display
DebugDisplay("\nLooking to update HAL Flag $skyFlag");
$LastFlag = $ini->val('Flags','LastFlag'); # Grab the last flag from .INI
# We know the value of the last flag set and the one about to be set.
# If they are the same, do nothing.
# Otherwise clear the last one and set the new one.
# This minimizes calls to HALi and makes for a faster program
if ($skyFlag ne $LastFlag) { # adjust flags
# The array @FlagsList was created at startup, and is a list of every valid
# HAL Flag that starts with 'WEATHER ' or 'WX '. We then use this array to
# Validate any flag that we wish to touch in HAL. Otherwise, we may crash if
# we try to access a HAL Flag that does not exist.
if ($#FlagsList > 0) { # If HAL is running.
if (grep /$skyFlag/,@FlagsList) { # And this flag in in the list.
DebugDisplay(" $skyFlag is valid\n");
} else { # Flag not in list
DebugDisplay(" $skyFlag is NOT valid\n");
# Record in ErrorFile.
open(ER, ">$ErrorFile") || die "ERROR! Problem opening TXT file.";
print (ER "Unable to find $skyFlag in HAL Flag list");
close(ER);
} # if (grep /$skyFlag/, @FlagsList)
} # if ($#FlagsList > 0)
if (index($HALiStat,"running") > 0) {
if ($speakComfort ==1) {speak($skyTTX)};
if (length($LastFlag) > 7) {clrHALflag($LastFlag)};
DebugDisplay("\nChanging Data $LastFlag to $skyFlag\n");
if (grep /$skyFlag/, @FlagsList) { # Only if we actually got a Match!
DebugDisplay("\nSetting $skyFlag to TRUE.\n");
setHALflag($skyFlag);
} # if (grep /$skyFlag/, @FlagsList)
} else { # if (index($HALiStat,"running")
DebugDisplay("\nCan not change $skyFlag HAL Not Running\n");
} # else ! if (index($HALiStat,"running")
displaySkyConditions($skyFlag);
$ini->setval('Flags','LastFlag',$skyFlag); # Save updated Flag
} else { # if ($skyFlag ne $LastFlag)
DebugDisplay("\n$skyFlag is already set to ");
DebugDisplay($LastFlag."\n")
}
return($sky);
} # skyConditions
1;
#--------------------------------------------------------------------------
sub Temperature { # Retrieve the temperature and process it
#
# FUNCTION: Processes the Temperature reading returned passes from caller.
# Writes the verbiage to the text files for speech, sets any
# any HAL flags required, displays the temperature on the
# screen and finally returns the parsed temperature to the
# calling program.
#
# SECTION: Weather Information Processing Subroutines
# INPUT: Temperature reading passed via @_
# GLOBALS: $Graphics, $Display, $speakTemperature
# LOCALS: $t, $lt
# OUTPUT: TTS File update
#
#
# USAGE: $T = Temperature($arrayref->[$PlInstance]->{temperature});
#--------------------------------------------------------------------------
my $lt;
my ($t) = @_;
$lt = $ini->val('Flags','LastTemperature',"42");
$ini->newval('Flags','LastTemperature',$t);
if ($t > $HiTemp) {
$HiTemp = $t;
$HiUpdateCounter = 0;
# print "HiTemp = $HiTemp \n";
};
if ($t < $LoTemp) {
$LoTemp = $t;
$LoUpdateCounter = 0;
# print "LoTemp = $LoTemp \n";
};
#print "Hi Ctr = $HiUpdateCounter \n";
if ($HiUpdateCounter > 1320) { # 22 hours since last high temp
$HiUpdateCounter = 0;
$HiTemp = $t;
# print "HiTemp = $HiTemp \n";
}
#print "Lo Ctr = $LoUpdateCounter \n";
if ($LoUpdateCounter > 1320) { # 22 hours since last low temp
$LoUpdateCounter = 0;
$LoTemp = $t;
# print "LoTemp = $LoTemp \n";
}
print (EL $t.","); # Write to the .csv log file
#$Debug = 1;
DebugDisplay("Temperature = $t \n");
$t = removeTrailingZeros($t);
DebugDisplay("Temperature = $t \n");
#$Debug = 0;
my $ts = "The outside temperature is $t degrees.";
if ($Graphics) {
$Display->itemconfigure('TempF', -text=>$t);
}
if (( $ts ne $t) && ($speakTemperature == 1)) {
speak($ts);
}
print (TTS "\n$ts");# Write to TTS file
if (!$Graphics) {
Console("\n$ts"); # and display for debugging
}
# Write the temperature to Temperature.txt
open(TX, ">$TemFile") || die "ERROR! Cannot open Temperature.txt";
print (TX $ts);
close(TX);
HotOrCold($t);
$Tp = $t;
return($t);
#------------------------------------------------------------------------
sub HotOrCold { # Set the flags HOT and COLD if temp is outside our comfort
# range. Check states of flags before setting since it takes a lot longer
# to set than to simply test. Don't ever set any flag unless absolutely
# necessary because it's very slow!
#------------------------------------------------------------------------
my ($flag, $f); #????
my ($t) = @_;
#--WX-WARM------------------------------------------------------------
$flag = "WX WARM";
DebugDisplay("\nTesting $flag .. ");
$f = testHALflag($flag);
DebugDisplay("$flag is $f \n");
# If temperature is above threshold_warm and below threshold_HOT
# declare it to be WARM. Unless already declared WARM!
if ($t > $Threshold_Warm ) {
DebugDisplay("Warm \n");
Console(" (Warm!)");
if ($f eq "FALSE") { # If it's false, set it to true and
setHALflag($flag);
if ($speakComfort ==1) { # if enabled, speak it.
speak($WxWarmTxt);
}
}
} # if > threshold_Warm
else { # if $f < threshold
if ($f eq "TRUE") {
clrHALflag($flag);
}
} # else
#--WX-WARM------------------------------------------------------------
#--WX-HOT-------------------------------------------------------------
$flag = "WX HOT";
DebugDisplay("\nTesting $flag .. ");
$f = testHALflag($flag);
DebugDisplay("$flag is $f \n");
# If temperature is above threshold declare it to be HOT.
# Unless already declared HOT!
if ($t > $Threshold_Hot ) {
Console(" (HOT!)");
DebugDisplay("Hot \n");
if ($f eq "FALSE") {
setHALflag($flag);
if ($speakComfort ==1) {
speak($WxHotTxt);
}
}
} # if > threshold
else { # if $f < threshold
if ($f eq "TRUE") {
clrHALflag($flag);
}
} # else
#--WX-HOT-------------------------------------------------------------
#--WX-COOL------------------------------------------------------------
$flag = "WX COOL";
DebugDisplay("\nTesting $flag .. ");
$f = testHALflag($flag);
DebugDisplay("$flag is $f \n");
# If temperature is below threshold, declare it to be COOL.
# Unless already declared COOL!
if ($t < $Threshold_Cool ) {
Console(" (Cool!)");
DebugDisplay("Cool \n");
if ($f eq "FALSE") {
setHALflag($flag);
if ($speakComfort == 1) {
speak($WxCoolTxt);
} # Speak
} # if ($f eq "FALSE")
}# if < threshold
else { # if $f > threshold
if ($f eq "TRUE") {
clrHALflag($flag);
} # clrHALflag
} # else
#--WX-COOL------------------------------------------------------------
#--WX-COLD------------------------------------------------------------
$flag = "WX COLD";
DebugDisplay("\nTesting $flag .. ");
$f = testHALflag($flag);
DebugDisplay("$flag is $f \n");
# If temperature is below threshold, declare it to be COLD.
# Unless already declared COLD!
if ($t < $Threshold_Cold ) {
Console(" (Brrr!)");
DebugDisplay("Cold \n");
if ($f eq "FALSE") {
setHALflag($flag);
if ($speakComfort == 1) {
speak($WxColdTxt);
}
}
}# if < threshold
else { # if $f > threshold
if ($f eq "TRUE") {
clrHALflag($flag);
}
} # else
#--WX-COLD------------------------------------------------------------
#------
# Possible future enhancement: Adjust comfort ranges based on
# season. Since HAL tracks the season, this should be easy.
#------
} # End of HotOrCold
1;
} # End of Temperature subroutine
1;
#--------------------------------------------------------------------------
sub Wind {
#--------------------------------------------------------------------------
my ($wd,$sp) = @_;
my ($pos);
$sp = removeTrailingZeros($sp);
#Write the Wind Speed into the log file
print (EL $sp.",");
my $Fl = "WX WINDY";
# If wind speed is above threshold, declare it to be windy
if ($sp > $Threshold_Windy ) {
Console("(WINDY!)");
if ($speakComfort ==1) {
speak($WxWindyTxt);
}
} # if windy
else { # not Windy
my $value = testHALflag($Fl);
if (($pos = index($value,"TRUE",0)) > -1 ) {
clrHALflag($Fl);
} # if
}
DebugDisplay("Wind is $sp from the $wd \n");
my $ws = $wd;
if ($Graphics) {$Display->itemconfigure($LastArrow,-state => 'hidden')}; # erase arrow
if ($sp > 0) {
print (TTS "\nWind is $sp Miles Per Hour "); # Write to the TTS File
Console("\nWind is $sp Miles Per Hour ",""); # And console
#------------------------------------------------------------------------
# Parse the Wind Direction
#------------------------------------------------------------------------
if (index($wd,"WSW") > -1 ) {
$wd = "West South West";
if ($Graphics) {
$Display->itemconfigure('ar-wsw',-state => 'normal');
$LastArrow = 'ar-wsw';
}
};
if (index($wd,"SSW") > -1 ) {
$wd = "South South West";
if ($Graphics) {
$Display->itemconfigure('ar-ssw',-state => 'normal');
$LastArrow = 'ar-ssw';
}
};
if (index($wd,"SSE") > -1 ) {
$wd = "South South East";
if ($Graphics) {
$Display->itemconfigure('ar-sse',-state => 'normal');
$LastArrow = 'ar-sse';
}
};
if (index($wd,"ESE") > -1 ) {
$wd = "East South East" ;
if ($Graphics) {
$Display->itemconfigure('ar-ese',-state => 'normal');
$LastArrow = 'ar-ese';
}
};
if (index($wd,"ENE") > -1 ) {
$wd = "East North East";
if ($Graphics) {
$Display->itemconfigure('ar-ene',-state => 'normal');
$LastArrow = 'ar-ene';
}
};
if (index($wd,"NNW") > -1 ) {
$wd = "North North West";
if ($Graphics) {
$Display->itemconfigure('ar-nnw',-state => 'normal');
$LastArrow = 'ar-nnw';
}
};
if (index($wd,"NNE") > -1 ) {
$wd = "North North East";
if ($Graphics) {
$Display->itemconfigure('ar-nne',-state => 'normal');
$LastArrow = 'ar-nne';
}
};
if (index($wd,"WNW") > -1 ) {
$wd = "West North West";
if ($Graphics) {
$Display->itemconfigure('ar-wnw',-state => 'normal');
$LastArrow = 'ar-wnw';
}
};
if (index($wd,"SW" ) > -1 ) {
$wd = "South West";
if ($Graphics) {
$Display->itemconfigure('ar-sw',-state => 'normal');
$LastArrow = 'ar-sw';
}
};
if (index($wd,"NW" ) > -1 ) {
$wd = "North West";
if ($Graphics) {
$Display->itemconfigure('ar-nw',-state => 'normal');
$LastArrow = 'ar-nw';
}
};
if (index($wd,"SE" ) > -1 ) {
$wd = "South East";
if ($Graphics) {
$Display->itemconfigure('ar-se',-state => 'normal');
$LastArrow = 'ar-se';
}
};
if (index($wd,"NE" ) > -1 ) {
$wd = "North East";
if ($Graphics) {
$Display->itemconfigure('ar-ne',-state => 'normal');
$LastArrow = 'ar-ne';
}
};
if ((index($ws,"North" ) > -1 ) && (length($wd) < 8)) {
if ($Graphics) {
$Display->itemconfigure('ar-n',-state => 'normal');
$LastArrow = 'ar-n';
}
};
if ( (index($ws,"West" ) > -1) && (length($wd) < 8) ) {
if ($Graphics) {
$Display->itemconfigure('ar-w',-state => 'normal');
$LastArrow = 'ar-w';
}
};
if ( (index($ws,"East" ) > -1) && (length($wd) < 8) ) {
if ($Graphics) {
$Display->itemconfigure('ar-e',-state => 'normal');
$LastArrow = 'ar-e';
}
};
if ( (index($ws,"South" ) > -1) && (length($wd) < 8) ) {
if ($Graphics) {
$Display->itemconfigure('ar-s',-state => 'normal');
$LastArrow = 'ar-s';
}
};
if (index($ws,"Variable") > -1) {
$wd = "from various directions";
if ($Graphics) {
$Display->itemconfigure($LastArrow,-state => 'hidden');
}
} else {
$wd = "from the ".$wd;
}
print (TTS "$wd.\n");
Console("$wd.\n");
} else { # $sp > 0
print (TTS "\nThere is no measurable wind.\n");
Console("\nThere is no measurable wind.\n");
}
# Write the Wind Direction short form to the log
print (EL $ws);
# Write the Wind Info to Wind.txt
open(TX, ">$WindFile") || die "ERROR! Cannot open Wind.txt";
if ($sp > 0) {
print (TX "The Wind speed is $sp Miles Per Hour $wd");
} else {
print (TX "There is no measurable wind.");
}
close(TX);
if ($Graphics) {
if ($sp > 0) {
$Display->itemconfigure('Wind-mph', -text=>$sp);
} else {
$Display->itemconfigure('Wind-mph', -text=>"0");
}
}
return($sp,$ws);
}
1;
#--------------------------------------------------------------------------
sub Humidity {
#
# FUNCTION: Processes the Humidity reading passed from caller.
# Writes the verbiage to the text file for speech.
# Finally returns the parsed humidity to the caller.
#
# SECTION: Weather Information Processing Subroutines
# INPUT: Humidity reading passed via @_
# GLOBALS: none
# LOCALS: $h
# OUTPUT: TTS File update, Humidity
#
#
# USAGE: $H = Humidity($arrayref->[$PlInstance]->{humidity});
#--------------------------------------------------------------------------
my ($h) = @_;
# Test $h for a valid humidity number
$h =~ m/\d\d/; # Match for two digits
$h = $&; # Retrieve the match
# No matter what is returned, if it has two digits we will filter the digits
# Otherwise, the value returned will be so wildly wrong we can throw it out.
#Tag the humidity into the log and TTS files
if (length($h) == 2) {
print (EL "$h,");
print (TTS "The Humidity is $h Percent.\n");
Console("The Humidity is $h Percent.\n");
# Write the Humidity to Humidity.txt
open(TX, ">$HumidFile") || die "ERROR! Cannot open Humidity.txt";
print (TX "The Humidity is $h Percent.");
close(TX);
} else {
print (EL " ,");
print (TTS "The Humidity is not available.\n");
Console("The Humidity is not available.\n");
open(TX, ">$HumidFile") || die "ERROR! Cannot open Humidity.txt";
print (TX "The Humidity is not available.");
close(TX);
}
return($h);
} # End Humidity
1;
#--------------------------------------------------------------------------
sub Barometer {
#
# FUNCTION: Processes the Barometric reading passed from caller.
# Writes the verbiage to the text file for speech.
# Finally returns the parsed pressure and trend to the caller.
#
# SECTION: Weather Information Processing Subroutines
# INPUT: Barometric Pressure reading passed via @_
# GLOBALS: $LastPressure
# LOCALS: $pressure_text, $p1, $p2, $p3, $p4, $l, $trend, $trendtxt
# OUTPUT: TTS File update
#
#
# USAGE: @P = Barometer($arrayref->[$PlInstance]->{pressure});
#--------------------------------------------------------------------------
my ($pressure) = @_;
my ($pressure_text, $p1, $p2, $p3, $p4, $l, $trend, $trendtxt);
$p3 = length($pressure);
DebugDisplay("\n BP length is $p3 chars\n");
DebugDisplay("Barometric Pressure is $pressure \n");
if ( $p3 > 10 ) {
$p1 = index($pressure,'(');
$p2 = index($pressure,')');
$l = $p2-$p1;
$trend = substr($pressure,$p1+1,$l-1);
$pressure =~ m/\d\d.\d\d/;
$pressure = $&;
}
# if the weather station did not give us a pressure trend
# compare this pressure to previous report and guess the trend
if ( length($trend) < 3 ) {
Console("Trend not reported. Estimating...\n");
if ($LastPressure eq $pressure) {
$trend = "Steady";
}
if ($LastPressure gt $pressure) {
$trend = "Falling";
}
if ($LastPressure lt $pressure) {
$trend = "Rising";
}
}
hideBarometer($LastPressure);
$LastPressure = $pressure;
displayBarometer($pressure);
if ($Graphics) {
$Display->itemconfigure('Baro-in', -text=>$pressure);
}
DebugDisplay("Barometric Pressure is $pressure and trend is $trend \n");
my $p4 = length($trend);
if (index($pressure,".") < 1) {
$pressure = "UNAVAILABLE";
$pressure_text = "The Barometric Pressure is not available\n";
} else {
if ( length($trend) > 2 ) {
$trendtxt = " and ".$trend;
}
$pressure_text = "The Barometric Pressure is ".
$pressure." inches of Mercury". $trendtxt .".\n";
}
#Tag the pressure into the log file
print (EL substr($pressure,0,5).",");
Console($pressure_text);
print (TTS $pressure_text);
# Write the Barometer to Barometer.txt
open(TX, ">$BaromFile") || die "ERROR! Cannot open Barometer.txt";
print (TX $pressure_text);
close(TX);
return($pressure, $trend);
} # End of Barometer subroutine
1;
#--------------------------------------------------------------------------
sub Dewpoint {
#
# FUNCTION: Parses the Dewpoint reading value passed from caller.
# Writes the verbiage to the text file for speech.
#
# SECTION: Weather Information Processing Subroutines
# INPUT: Dewpoint reading passed via @_
# GLOBALS: none
# LOCALS: $s
# OUTPUT: TTS File update, Dewpoint
#
#
# USAGE: $Dp = Dewpoint($arrayref->[$PlInstance]->{dewpoint});
#--------------------------------------------------------------------------
my ($s) = @_;
# Test $h for a valid humidity number
$s =~ m/\d\d/; # Match for two digits
$s = $&; # Retrieve the match
# No matter what is returned, if it has two digits we will filter the digits
# Otherwise, the value returned will be so wildly wrong we will throw it out.
#Tag the Dewpoint into the log file
if (length($s) == 2) {
print (EL "$s,");
Console("The Dewpoint is $s degrees.\n");
print (TTS "The Dewpoint is $s degrees.");
# Write the Dewpoint Info to Dewpoint.txt
open(TX, ">$DewFile") || die "ERROR! Cannot open Dewpoint.txt";
print (TX "The Dewpoint is $s degrees.");
close(TX);
} else {
$s = 0;
print (EL " ,");
Console("The Dewpoint is not available.\n");
print (TTS "The Dewpoint is not available.");
open(TX, ">$DewFile") || die "ERROR! Cannot open Dewpoint.txt";
print (TX "The Dewpoint is not available.");
close(TX);
}
return($s);
} # end of Dewpoint subroutine
1;
#--------------------------------------------------------------------------
sub Visibility {
#
# FUNCTION: Parses the Visibility reading value passed from caller.
# Writes the verbiage to the text file for speech.
#
# SECTION: Weather Information Processing Subroutines
# INPUT: Visibility reading passed via @_
# GLOBALS: none
# LOCALS: $s
# OUTPUT: TTS File update, Dewpoint
#
#
# USAGE: Visibility($arrayref->[$PlInstance]->{visibility});
#--------------------------------------------------------------------------
my ($s) = @_;
$s = removeTrailingZeros($s);
#Tag the Visibility into the log file
print (EL "$s");
if ($s = 10) {
$s = "unlimited";
} else {
$s = $s." miles.";
}
Console("Visibility is $s \n");
print (TTS "\nVisibility is $s \n");
# Write the Visibility to Visibility.txt
open(TX, ">$VisiFile") || die "ERROR! Cannot open Visibility.txt";
print (TX "Visibility is $s ");
close(TX);
}
1;
#--------------------------------------------------------------------------
sub fullMoon { # Check for a full moon
# If the Weather screen says tonight is a full moon, post a warning about it
# to the console and the TTS file
#--------------------------------------------------------------------------
my ($t) = @_;
Console("Moon Phase is $t \n");
if (index($t,"Full") > 1) {
Console("Tonight is the full moon. Beware of Werewolves.\n");
print (TTS "\nTonight is the full moon. Beware of werewolves.\n");
if ($speakComfort ==1) {
speak("Tonight is the full moon. Beware of Werewolves.");
}
}
} # End Full Moon subroutine
1;
} # End of getWeather subroutine
1;
#========================================================================================
sub InitFlagList { # Create a list of all HAL Weather Flags
#========================================================================================
my $Ct;
DebugDisplay("\nIniting FlagList ..");
Console("Hali Status is $HALiStat \n");
my ($ct, $Flag);
if (index($HALiStat,"running") > 0) {
for ($Ct = 1;$Ct<=$HALi1->{'Sensors'}->{Count};$Ct++) { # Loop thru all sensors
$Flag = $HALi1->{'Sensors'}->Item($Ct)->Name; # retrieve each name
if (index($Flag,"WEATHER ") == 0) { # that starts with "Weather"
push @FlagsList,$Flag; # Add it to the array
DebugDisplay("$Flag\n");
} # if
if (index($Flag,"WX ") == 0) { # that starts with "WX"
push @FlagsList,$Flag; # Add it to the array
DebugDisplay("$Flag\n");
} # if
} # for
DebugDisplay("Done. \n");
} else {
DebugDisplay("\nUnable to create HAL Flag list because HALi is not available\n");
}
}
1;
#========================================================================================
sub clearDatabase { # Set all HAL Weather flags to FALSE
# Used if we cannot reach Weather Underground and presume serious problems to erase
# any residual HAL knowledge of weather conditions.
#========================================================================================
my ($ct, $value, $pos, $flag);
my @flags = @FlagsList;
while ($#flags > -1) {
$flag = pop(@flags);
$value = testHALflag($flag);
if (($pos = index($value,"TRUE",0)) > -1 ) {
clrHALflag($flag);
} # if
}
# Clear LastWeather.dat
$ini->newval('Flags','LastFlag',$LastFlag);
$ini->RewriteConfig;
# Clear Temperature.txt
open(TX, ">$TemFile") || die "ERROR! Cannot open Temperature.txt";
print (TX 'I do not have the current outside temperature');
close(TX);
# Clear Humidity.txt
open(TX, ">$HumidFile") || die "ERROR! Cannot open Humidity.txt";
print (TX 'I do not have the current humidity reading');
close(TX);
# Clear Barometer.txt
open(TX, ">$BaromFile") || die "ERROR! Cannot open Barometer.txt";
print (TX 'I do not have the current Barometer Readings');
close(TX);
# Clear Wind.txt
open(TX, ">$WindFile") || die "ERROR! Cannot open Wind.txt";
print (TX 'I do not have the current Wind speed');
close(TX);
# Clear Dewpoint.txt
open(TX, ">$DewFile") || die "ERROR! Cannot open Dewpoint.txt";
print (TX "I do not have the current Dewpoint information");
close(TX);
# Clear Visibility.txt
open(TX, ">$VisiFile") || die "ERROR! Cannot open Visibility.txt";
print (TX "I do not have the current Visibility information");
close(TX);
}
1;
#========================================================================================
sub initWeatherAgent {
# Initialize the Weather Underground Objects. Only called once, upon displaying the GUI
#========================================================================================
if (length($Place) > 4) {
$weather = Weather::Underground->new(
place => $Place,
debug => 0
);
$arrayref = $weather->get_weather($PlInstance);
} else {
#$Display->insert('end',"No valid Place Name\n");
Console("No valid Place Name\n");
} # $Place > "none"
if ( (length($Zip) == 5) ) {
if (!$arrayref) { # If the $Place failed
#$Display->insert('end',"Searching for weather using zip code\n");
Console("Searching for weather using zip code\n");
$weather = Weather::Underground->new(
place => $Zip,
debug => 0
) || die "Error, could not create new weather object: $@\n";
}
$arrayref = $weather->get_weather($PlInstance);
} else {
#$Display->insert('end',"No Zip Code\n");
Console("No Zip Code\n");
} # ZIP = 5 chars
if (!$arrayref) { # If we fail on zip too
#die "Error, could not create new weather object 2: $@\n";
$Direct = 1; # Force to attempt to use CSV method.
#$Display->insert('end',"Trying Station ID and CSV method.\n");
Console("Trying Station ID and CSV method.\n");
}
}
1;
#########################################################################
sub setHALiWSdata {
# Set data passed as an argument to the HAL Weather Station
# Usage 'setHALiWSdata(*f);' where *f points to an array of data
#########################################################################
my(@data)=@_;
$Debug=0;
#DebugDisplay($HALiStat); # Will say "HALi is Running every time the WS updates.
if (index($HALiStat,"running") > 0) {
# DebugDisplay("\nCall to set Weather Station Data.\n");
# DebugDisplay("Temp = ".$data[2]." Hum =".$data[4]." Press =".$data[5].
# " Tren =".$data[6]." Spd =".$data[7]." Dir =".$data[8]."\n");
#Usage:
#HALi1->WeatherStation->SetReadings(InTemp,OutTemp,InHum,OutHum,Barom,
# Trend,WSpeed,WDirection,Rain)
$HALi1->WeatherStation->SetReadings(72,$data[2],70,$data[4],$data[5],
$data[6],$data[7],$data[8],0);
# my $myHALi = $HALi1->WeatherStation->GetReadings();
# DebugDisplay($myHALi . "\n");
}
$Debug=0;
}
1;
#########################################################################
# Comma Separated Values Data Files Logic. Logic in this section
# manipulates data retrieved from a weather station in CSV format.
#########################################################################
sub initCSVagent {
# FUNCTION: Initializes the Mech object for retrieving CSV Data
# Must only be called once.
#
# SECTION: CSV Logic
# INPUT: None
# GLOBALS: $agent
# LOCALS: none
# OUTPUT: Global $agent becomes valid handle to mech data
#
# USAGE: initCSVagent();
#########################################################################
$agent = WWW::Mechanize->new(); # Initialize WWW::Mechanize
}
1;
#########################################################################
sub getCSVdata { # Retrieve the data directly from a specific weather
# station. The Weather Underground module retrieves data from the first
# weather station that matches the search engine
#########################################################################
# FUNCTION: Retrieve the data directly from a specific weather station.
# Data returned in a Comma Seperated Values format with first
# line holding column names. We extract only the last (most
# recent) and decode the data fields.
#
# SECTION: CSV Logic
# INPUT: None
# GLOBALS: $PlaceStr,$csvURL.$csvID.$csvFormat, $Timestamp
# LOCALS: @x,$c,$cnt,$l,$tf,$ti,$td,$th,$ws,$wd,$sk,$bp,$dataValid
# OUTPUT: Data written to log file and displayed on screen.
# Various HAL Flags set to match weather conditions.
#
# USAGE: getCSVdata();
#########################################################################
my (@tmp, $c, @x, $cnt, $l, $tf, $ti, $td, $th, $ws, $wd, $sk, $bp, $dataValid);
$PlaceStr = $csvID;
if ( length($csvID) > 4 ) {
$agent->get($csvURL.$csvID.$csvFormat);
$agent->{content} =~ m/\n/;
open(TX, ">test.csv") || die "ERROR! Cannot open test.txt";
$c = $';
if (length($c) > 250 ) {
$dataValid = 'true';
print (TX $c);
}
close(TX);
if ($dataValid) {
if (-e "test.csv") {
open(RX, ") { # grab the last line of the file
$l = $_;
if (length($l) > 20) {
$x[$cnt] = $l;
$cnt++;
}
}
close(RX);
}
open(TX, ">test2.csv") || die "ERROR! Cannot open test.txt";
print(TX $x[0]);
print(TX $x[$cnt-1]);
close(TX);
my @dattim = parseCSVTimeAndDate($x[$cnt-1]);
$Timestamp = Hour12Convert24($dattim[1]);
if (-e "test2.csv") {
my $csv_fh = Tie::Handle::CSV->new("test2.csv", header => 1);
while (my $csv_line = <$csv_fh>)
{
$ti = $csv_line->{'Time'};
$tf = $csv_line->{'TemperatureF'};
$td = $csv_line->{'DewpointF'};
$th = $csv_line->{'Humidity'};
$ws = $csv_line->{'WindSpeedMPH'};
$wd = $csv_line->{'WindDirection'};
$sk = $csv_line->{'Conditions'};
$bp = $csv_line->{'PressureIn'};
}
close $csv_fh;
# Open our files for writing
open (EL, ">>$LOGFile") || die "Error! Problem with log file\n";
open (TTS, ">$TTSFile") || die "ERROR! Problem opening $TTSFile.\n";
# Got to write a sub to parse out the timestamp into our log file format
Console("As of $Timestamp ");
print (TTS "As of $Timestamp "); # Write 'As of 11:59 PM' to the TTS file
print (EL $dattim[0].","); # Write date to 'Weatherlog.csv'
print (EL $dattim[1].","); # Write time to 'Weatherlog.csv'
if ($sk eq "") { # if Direct didn't return Sky conditions
$sk = skyConditions($arrayref->[$PlInstance]->{conditions});
} else { # get via indirect method instead
skyConditions($sk);
};
#Console("The Sky is $sk "); # Our sky data is a problem. Not there, usually
#print (TTS "The Sky is $sk ");
$wxData[2] = Temperature($tf);
DebugDisplay("Wind Speed is $ws and Wind Direction is $wd");
@tmp = Wind($wd,$ws); # Most everything else is working
$wxData[7] = $tmp[0];
$wxData[8] = $tmp[1];
print (EL ","); # Write date to 'Weatherlog.csv'
print (EL $sk.","); # Write Conditions to 'Weatherlog.csv'
$wxData[4] = Humidity($th);
@tmp = Barometer($bp);
$wxData[5] = $tmp[0];
$wxData[6] = $tmp[1];
Dewpoint($td);
setHALiWSdata(@wxData);
if (!$Graphics) { # Scroll the screen
$Display->yview('moveto',90);
}
print (EL "\n"); # Append a newline to the logfile
close(EL); # Close the logfile
close(TTS); # Close the TTS File
}
} else {
Console("No valid data returned by weather station $csvID \n");
aniErase(); # Erase any data displayed
}
} else {
Console("No valid weather station ID. Cannot retrieve any data.\n");
aniErase(); # Erase any data displayed
$Direct = 0; # Shut down direct method
}
}
1;
#########################################################################
sub parseCSVTimeAndDate {
# FUNCTION: Takes the data line returned by the CSV data call and
# parses out the time and date.
#
# SECTION: CSV Logic
# INPUT: String with date and time. e.g. 2007-06-01 08:57:00,56.7,47
# GLOBALS: None
# LOCALS: $dataString, $comma, $year, $moday, $dat, $colon
# OUTPUT: Two element array containing date and time
#
# USAGE: my @dattim = parseCSVTimeAndDate($x);
# print "CSV DATE = $dattim[0] <-\n";
# print "CSV TIME = $dattim[1] <-\n";
#
#########################################################################
my($dataString)=@_;
if ( (length($dataString) > 18) ) { # Make sure length is reasonable
# e.g. 2007-06-01 08:57:00
my $comma = index($dataString,","); # Find the comma
$dataString = substr($dataString,0,$comma); # Grab everything
# before the comma
$dataString =~ s/-/\//; # Replace the dashes with slashes
$dataString =~ s/-/\//; # 2007-06-01 = 2007/06/01
my $year = substr($dataString,0,4); # Grab the year
my $moday = substr($dataString,5,5); # Month and day
my $dat = $moday."/".$year; # put em back together
# 2007/06/01 = 06/01/2007
my $colon = index($dataString,":"); # Find the colon ':'
# Grab hour and minute
my $timeString = substr($dataString,$colon-2,5);
# Return the result as a two element array.
return($dat,$timeString);
} # if ()
}
1;
###############################################################################################
# END of the Weather related code.
###############################################################################################
#==============================================================================================
# HALi Processing Code
#----------------------------------------------------------------------------------------------
sub StartHALi { # Now let's crank up HALi. This is a slow and painful process, because HALi
# needs to inventory HAL's resources, every device, sensor, mode, macro, etc.
# This process takes about 20 seconds on my (admittedly slow) system.
#----------------------------------------------------------------------------------------------
# Create a new OLE object using the Root Name of HALiCnt.HALi
# Note that the misspelling 'Contol' is intentional. UNDOCUMENTED!!
$HALi1 = Win32::OLE->new('HALiContol.HALi') || return("\nHALi Start Failure!!!\n");
# Test that the COM server was really created. Although should
# have died if it had failed. So strictly speaking this is redundant
if (Win32::OLE->QueryObjectType($HALi1) eq "_HALi"){
Console("HALi loaded! Initializing...");
} else {
Console("No HALi COM Server");
return("No HALi COM Server\n");
}
# Init HALi objects. This is the VERY slow part. Takes 20 seconds on "George"
if ( $HALi1->Init() ) { # This will fail if HAL is not running. Also
Console("HALi is running\n");
return("HALi is running"); # HALi does not allow us to handle this error,
} else { # instead throwing up a dialog that MUST be clicked,
Console("HALi Init Failed");
if ($useSAPI) { # Alternatively use SAPI speech
initWindowsSpeech(); # 'Microsoft SAM is online'
}
return("No HALi Init\n"); # and bringing the machine to a halt until clicked
} # This has been reported to A.L.
}
1;
#----------------------------------------------------------------------------------------------
sub setHALflag {
# Set the flag passed as an argument to TRUE
# Usage 'setHALflag(*f);' where *f points to flag $f
# IF HALi is available, use HALi. If not, then attempt to use Jim
# Lipsit'sHAL_Interface program if that's available.
# If neither available, return without doing anything.
#----------------------------------------------------------------------------------------------
my ($flag)=@_;
if ($#FlagsList > 0) { # If -1, assume HAL not on machine
DebugDisplay("Call setHALflag() to set $flag to TRUE....");
if (grep /$flag/, @FlagsList) {
$HALi1->ExecuteAction("","","$flag", "FLAG","","TRUE","","","",0);
DebugDisplay("Set with HALi.\n");
} else { # (grep
DebugDisplay("Not a Valid Flag.\n");
}
}
}
1;
#----------------------------------------------------------------------------------------------
sub clrHALflag {
# Clear the flag passed as an argument to FALSE
# Usage 'clrHALflag(*f);' where *f points to flag $f
# IF HALi is available, use HALi. If not, then attempt to use Jim
# Lipsit's HAL_Interface program if that's available.
# If neither available, return without doing anything.
#----------------------------------------------------------------------------------------------
my ($flag)=@_;
if ($#FlagsList > 0) { # If -1, assume HAL not on machine
DebugDisplay("\nCall clrHALflag() to set $flag to FALSE....");
if (grep /$flag/, @FlagsList) {
$HALi1->ExecuteAction("","","$flag", "FLAG","","FALSE","","","",0);
DebugDisplay("Set with HALi.\n");
} else { # (grep
DebugDisplay("Not a Valid Flag.\n");
}
}
}
1;
#----------------------------------------------------------------------------------------------
sub testHALflag {
# Test the flag passed as an argument. Return the value
# Usage '$t = testHALflag(*f);' where *f points to flag $f
# IF HALi is available, use HALi.
# If not available, returns FALSE.
# May enhance to use CDBFLite in a future version.
#----------------------------------------------------------------------------------------------
my ($flag)=@_;
my ($c);
$c = "NOEXIST";
if ($#FlagsList > 0) { # If -1, assume HAL not on machine
$HALi1->Sensors->Flag->Init;
DebugDisplay("Call testHALflag() to test $flag....");
if (grep /$flag/, @FlagsList) {
# $c=uc($HALi1->{'Sensors'}->ItemByName($flag)->State);
$c=uc($HALi1->Sensors->flag->GetState($flag));
DebugDisplay("$c \n");
} else { # (grep
DebugDisplay("Not a Valid Flag.\n");
}
}
return($c) # TRUE, FALSE or NOEXIST
}
1;
#==============================================================================================
# END HALi Processing Code
#==============================================================================================
###############################################################################################
# INI File Subroutines. Come here to manipulate the data stored in the INI file
# This replaces the descrete files that were used to store data at various points
# including Placefile and ZipcodeFile
#==============================================================================================
sub readINIfile { # Read the file at program start
#----------------------------------------------------------------------------------------------
if (!-e $INIfile) { # We're using Windows style INI files to store all data
createINIfile(); # Create initial file with default data
}
if (-e $INIfile) {
$ini= new Config::IniFiles( -file => "$INIfile" );
$Zip = $ini->val('Location','ZipCode');
$Place = $ini->val('Location','Place');
$Threshold_Hot = $ini->val('Threshold','Hot');
$Threshold_Cold = $ini->val('Threshold','Cold');
$Threshold_Warm = $ini->val('Threshold','Warm');
$Threshold_Cool = $ini->val('Threshold','Cool');
$Threshold_Windy = $ini->val('Threshold','Windy');
$Debug = $ini->val('Settings','Debug');
$interval = $ini->val('Settings','Interval');
$useHALi = $ini->val('Settings','HALi');
$intval1 = $ini->val('Settings','IntvButton1',$intval1);
$intval2 = $ini->val('Settings','IntvButton2',$intval2);
$intval3 = $ini->val('Settings','IntvButton3',$intval3);
$intval4 = $ini->val('Settings','IntvButton4',$intval4);
$Scroll = $ini->val('Settings','Scroll');
$Graphics = $ini->val('Settings','Mode');
$useSAPI = $ini->val('Speech','SAPI');
$speakConditions = $ini->val('Speech','Conditions');
$speakTemperature = $ini->val('Speech','Temperature');
$speakComfort = $ini->val('Speech','Comfort');
$speakStartStop = $ini->val('Speech','StartStop');
$WxWarmTxt = $ini->val('Speech','WxWarmTxt',$WxWarmTxt);
$WxHotTxt = $ini->val('Speech','WxHotTxt',$WxHotTxt);
$WxCoolTxt = $ini->val('Speech','WxCoolTxt',$WxCoolTxt);
$WxColdTxt = $ini->val('Speech','WxColdTxt',$WxColdTxt);
$WxWindyTxt = $ini->val('Speech','WxWindyTxt',$WxWindyTxt);
$LogDir = $ini->val('Directories','LogDir',$LogDir);
$ScriptDir = $ini->val('Directories','ScriptDir',$ScriptDir);
$HALDataDir = $ini->val('Directories','HALDataDir',$HALDataDir);
$csvURL = $ini->val('Station','StationURL',$csvURL);
$csvID = $ini->val('Station','StationID');
$csvFormat = $ini->val('Station','StationFormat',$csvFormat);
$Direct = $ini->val('Station','Direct');
$LastFlag = $ini->val('Flags','LastFlag',"WEATHER xxxxx");
$LastDate = $ini->val('Flags','LastDate',"05/16/1997");
$WindSpeedFont = $ini->val('Fonts','Wind Speed Font','Tahoma 14 bold');
$BarometerFont = $ini->val('Fonts','Barometer Font','Tahoma 12 bold');
$TemperatureFont = $ini->val('Fonts','Temperature Font','Tahoma 14 bold');
$UpdateFont = $ini->val('Fonts','Update Font','Tahoma 10 bold');
$FontDataColor = $ini->val('Fonts','Update Color','red');
$FontUpdateColor = $ini->val('Fonts','Data Color','red');
$Button1 = $ini->val('Commands','Button1','Undefined');
$Button2 = $ini->val('Commands','Button2','Undefined');
$Button3 = $ini->val('Commands','Button3','Undefined');
$Button4 = $ini->val('Commands','Button4','Undefined');
}
#----------------------------------------------------------------------------
sub createINIfile { # Create the INI file with default values if not existing
#----------------------------------------------------------------------------
if (!-e $INIfile) {
print("Creating INI File");
$ini= new Config::IniFiles();
$ini->newval('Location','ZipCode',$Zip);
$ini->newval('Location','Place',$Place);
$ini->newval('Threshold','Hot',$Threshold_Hot);
$ini->newval('Threshold','Cold',$Threshold_Cold);
$ini->newval('Threshold','Windy',$Threshold_Windy);
$ini->newval('Threshold','Warm',$Threshold_Warm);
$ini->newval('Threshold','Cool',$Threshold_Cool);
$ini->newval('Settings','Debug',$Debug);
$ini->newval('Settings','HALi', $useHALi);
$ini->newval('Settings','Interval',$interval);
$ini->newval('Settings','IntvButton1',$intval1);
$ini->newval('Settings','IntvButton2',$intval2);
$ini->newval('Settings','IntvButton3',$intval3);
$ini->newval('Settings','IntvButton4',$intval4);
$ini->newval('Settings','Scroll',$Scroll);
$ini->newval('Settings','Mode',$Graphics);
$ini->newval('Speech','SAPI',$useSAPI);
$ini->newval('Speech','Conditions',$speakConditions);
$ini->newval('Speech','Temperature',$speakTemperature);
$ini->newval('Speech','Comfort',$speakComfort);
$ini->newval('Speech','StartStop',$speakStartStop);
$ini->newval('Speech','WxWarmTxt',$WxWarmTxt);
$ini->newval('Speech','WxHotTxt',$WxHotTxt);
$ini->newval('Speech','WxCoolTxt',$WxCoolTxt);
$ini->newval('Speech','WxColdTxt',$WxColdTxt);
$ini->newval('Speech','WxWindyTxt',$WxWindyTxt);
$ini->newval('Directories','LogDir', $LogDir);
$ini->newval('Directories','ScriptDir',$ScriptDir);
$ini->newval('Directories','HALDataDir',$HALDataDir);
$ini->newval('Station','StationID', $csvID);
$ini->newval('Station','StationURL', $csvURL);
$ini->newval('Station','StationFormat',$csvFormat);
$ini->newval('Station','Direct',$Direct);
$ini->newval('Flags','LastFlag',"WEATHER xxxxx");
$ini->newval('Flags','LastDate',"05/16/1997");
$ini->newval('Fonts','Wind Speed Font',$WindSpeedFont);
$ini->newval('Fonts','Barometer Font',$BarometerFont);
$ini->newval('Fonts','Temperature Font',$TemperatureFont);
$ini->newval('Fonts','Update Font',$UpdateFont);
$ini->newval('Fonts','Update Color',$FontDataColor);
$ini->newval('Fonts','Data Color',$FontUpdateColor);
$ini->newval('Commands','Button1',$Button1);
$ini->newval('Commands','Button2',$Button2);
$ini->newval('Commands','Button3',$Button3);
$ini->newval('Commands','Button4',$Button4);
$ini->WriteConfig($INIfile);
}
}
1;
#----------------------------------------------------------------------------
}
1;
#----------------------------------------------------------------------------------------------
sub writeINIfile { # Save INI file contents after changes
#----------------------------------------------------------------------------------------------
if (-e $INIfile) {
$ini= new Config::IniFiles( -file => "$INIfile" );
$ini->setval('Location','ZipCode',$Zip);
$ini->setval('Location','Place',$Place);
$ini->setval('Threshold','Hot',$Threshold_Hot);
$ini->setval('Threshold','Cold',$Threshold_Cold);
$ini->setval('Threshold','Warm',$Threshold_Warm);
$ini->setval('Threshold','Cool',$Threshold_Cool);
$ini->setval('Threshold','Windy',$Threshold_Windy);
$ini->setval('Settings','Debug',$Debug);
$ini->newval('Settings','HALi', $useHALi);
$ini->setval('Settings','Interval',$interval);
$ini->setval('Settings','IntvButton1',$intval1);
$ini->setval('Settings','IntvButton2',$intval2);
$ini->setval('Settings','IntvButton3',$intval3);
$ini->setval('Settings','IntvButton4',$intval4);
$ini->newval('Speech','SAPI',$useSAPI);
$ini->newval('Speech','Conditions',$speakConditions);
$ini->newval('Speech','Temperature',$speakTemperature);
$ini->newval('Speech','Comfort',$speakComfort);
$ini->newval('Speech','StartStop',$speakStartStop);
$ini->newval('Speech','WxWarmTxt',$WxWarmTxt);
$ini->newval('Speech','WxHotTxt',$WxHotTxt);
$ini->newval('Speech','WxCoolTxt',$WxCoolTxt);
$ini->newval('Speech','WxColdTxt',$WxColdTxt);
$ini->newval('Speech','WxWindyTxt',$WxWindyTxt);
$ini->newval('Settings','Scroll',$Scroll);
$ini->newval('Settings','Mode',$Graphics);
$ini->setval('Directories','LogDir', $LogDir);
$ini->setval('Directories','ScriptDir',$ScriptDir);
$ini->setval('Directories','HALDataDir',$HALDataDir);
$ini->setval('Station','StationID', $csvID);
$ini->setval('Station','StationURL', $csvURL);
$ini->setval('Station','StationFormat',$csvFormat);
$ini->setval('Station','Direct',$Direct);
$ini->setval('Flags','LastFlag',$LastFlag);
$ini->setval('Flags','LastDate',$LastDate);
$ini->setval('Fonts','Wind Speed Font',$WindSpeedFont);
$ini->setval('Fonts','Barometer Font',$BarometerFont);
$ini->setval('Fonts','Temperature Font',$TemperatureFont);
$ini->newval('Fonts','Update Font',$UpdateFont);
$ini->newval('Fonts','Update Color',$FontDataColor);
$ini->newval('Fonts','Data Color',$FontUpdateColor);
$ini->newval('Commands','Button1',$Button1);
$ini->newval('Commands','Button2',$Button2);
$ini->newval('Commands','Button3',$Button3);
$ini->newval('Commands','Button4',$Button4);
$ini->RewriteConfig;
}
}
1;
#####################################################################################
sub getPlace { # Here. First verify that required directories exist,
# creating them if not. Then verify $Place is defined. If not, create it.
# returns with the GLOBAL variable $Zip set to the current zip code
#####################################################################################
if (! $Place) { # If Place is not defined
if (!-e $LogDir) { # If $Place doesn't exist maybe dirs
mkdir($LogDir,); # do not either. If Not, Create them
}
if (!-e $ScriptDir) { # Verify that C:\HAScripts directory exists,
mkdir($ScriptDir,); # If Not, Create it
}
askPlaceName(); # now put up a dialog and ask for Place Code
} else { # or if it does
$Place = $ini->val('Location','Place');
$PlaceStr = $Place;
}
}
1;
#-----------------------------------------------------------------------
sub askPlaceName { # Let's *ASK* for the Place ID.
# Draw a dialog box asking for a search term to submit to Weather
# Underground to find the location.
#-----------------------------------------------------------------------
#$SIG{ CHLD } = sub{ wait };
# Let's draw a window on the screen
my $dlg = new MainWindow;
$dlg->Label(-text => 'Please enter a Weather Underground')->pack;
$dlg->Label(-text => 'search term to find your location.')->pack;
my $PlacCode = $dlg->Entry(-width => 22,
-textvariable=>\$Place)->pack; # Create a text input box
# Define the save button and what happens when it's hit.
my $but = $dlg->Button(-text => 'OK',
-command => \&savePlaceCode
)->pack;
MainLoop; # End of Widget building. Subroutine follows.
#----------------------------------------------------------------------
sub savePlaceCode { # User has entered some text into the PlaceCode box
# and hit save. In this sub, we write the contents to the data file
# and then exit.
# Sets GLOBAL variable $Place to the value returned
#----------------------------------------------------------------------
$Place = $PlacCode->get(); # Grab the data entered by the user
$PlaceStr = $Place;
$dlg->destroy; # Terminate Entry Dialog Box.
$ini->newval('Location','Place',$Place);
$ini->RewriteConfig;
} # savePlaceCode
}
#####################################################################################
sub getZipcode { # Here. First verify that required directories exist,
# creating them if not. Then verify $Zip exists. If not, create it.
# returns withe GLOBAL variable $Zip set to the current zip code
#####################################################################################
if (! $Zip) {
if (!-e $LogDir) { # If $Zip doesn't exist maybe dirs
mkdir($LogDir,); # do not either. If Not, Create them
}
if (!-e $ScriptDir) { # Verify that C:\HAScripts directory exists,
mkdir($ScriptDir,); # If Not, Create it
}
askZipcode(); # now put up a dialog and ask for zip
} else { # or if ZipFile DOES exist
$Zip = $ini->val('Location','ZipCode');
}
}
1;
#-----------------------------------------------------------------------
sub askZipcode { # If the Zipfile was not found, assume this is the first
# first timeprogram is being run on this machine. So let's *ASK* for
# the zip code. Use the library to draw a dialog box asking for the zip
#-----------------------------------------------------------------------
$SIG{ CHLD } = sub{ wait }; # Force program to halt until dialog dismissed
# Let's draw a window on the screen
my $top = new MainWindow;
$top->Label(-text => 'Please Enter Your Zip Code')->pack;
# Create a text input box
my $ZipCode = $top->Entry(-width => 5,
-textvariable=>\$Zip)-> pack();
# Define the save button and what happens when it's hit.
my $btn = $top->Button(-text => 'OK',
-command => \&saveZipCode
)->pack;
MainLoop; # End of Widget building. Subroutines follow.
#------------------------------------------------------------------------
sub saveZipCode { # User has entered five digits into the ZipCode box
# and hit save. In this sub, we check for five characters and if length
# matches our expectations, we write the contents to the data file and
# then exit.
# Sets GLOBAL variable $Zip to the value returned
#------------------------------------------------------------------------
$Zip = $ZipCode->get(); # Grab the data entered by the user
$top->destroy; # Terminate Window.
if (length($Zip)==5) { # Make sure it is five characters only.
$ini->newval('Location','ZipCode',$Zip);
$ini->RewriteConfig;
}
}
}
#####################################################################################
sub GetStationcode { # Here. First verify that required directories exist,
# creating them if not. Then verify $StationFile exists. If not, create it.
# returns with the GLOBAL variable $Zip set to the current zip code
#####################################################################################
if (! $csvID) { # If StationID is not defined
noStationCode(); # now put up a dialog and ask for Station Code
} else { # or if it does
$csvID = $ini->val('Station','StationID');
}
}
1;
#-----------------------------------------------------------------------
sub noStationCode { # If the Station was not found, assume this is the first
# first time program is being run on this machine. So let's *ASK* for
# the Station ID. Use the library to draw a dialog box asking for the zip
#-----------------------------------------------------------------------
$SIG{ CHLD } = sub{ wait };
# Let's draw a window on the screen
my $top = new MainWindow;
$top->Label(-text => 'No Station Code Found')->pack;
$top->Label(-text => 'Enter Your Station Code')->pack;
my $StationCode = $top->Entry(-width => 11); # Create a text input box
$StationCode->pack;
# Define the save button and what happens when it's hit.
$top->Button(-text => 'Save',
-command => \&saveStationCode
)->pack;
MainLoop; # End of Widget building. Subroutines follow.
#---------------------------------------------------------------------
sub saveStationCode { # User has entered data into the StationCode box
# Sets GLOBAL variable $csvID to the value returned
#------------------------------------------------------------------------
$csvID = $StationCode->get(); # Grab the data entered by the user
$ini->newval('Station','StationID', $csvID);
$ini->newval('Station','StationURL', $csvURL);
$ini->newval('Station','StationFormat',$csvFormat);
$ini->RewriteConfig;
$top->destroy; # Terminate Window.
}
}
#########################################################################
sub removeTrailingSpaces {
# remove trailing whitespace from any text line.
#########################################################################
my($flag)=@_;
my ($poc,$c);
$c = substr($flag,(length($flag)-1),1);
while ($c eq " ") { # Remove trailing spaces
chop($flag);
$c = substr($flag,(length($flag)-1),1);
}# while
while ($c eq chr(9)) { # Remove trailing tab
chop($flag);
$c = substr($flag,(length($flag)-1),1);
}# while
}
1;
#########################################################################
sub Console { # Display on the console if permission granted.
# This subroutine is mainly cosmetic to allow the code to be cleaner
#########################################################################
my($msg)=@_;
if (!$Graphics) {
if ($Display) {$Display->insert('end', $msg)};
}
}
1;
#########################################################################
# The following subroutines are generic program modules that are not a
# part of Menubox or Weather processing
#########################################################################
sub DebugDisplay { # Display on the console if permission granted.
# This subroutine is mainly cosmetic to allow the code to be cleaner
#########################################################################
my($msg)=@_;
if ($Debug) { # If Debug flag is true, print message
print $msg;
}
}
1;
#########################################################################
sub errorHandler { # Master Error Handler
# If an error occurs, come here and post a message to the console
# also write a message to the WeatherError.TXT file so HAL can speak
# it using Text To Speech
#########################################################################
my($errNum)=@_;
my (@consoleMessage, @TTS_Message);
@consoleMessage[11] = "Error, could not create new weather object: $@\n";
@TTS_Message[11] = "I cannot understand the information returned by Weather Underground.\n";
@consoleMessage[12] = "Weather started but HAL permission flag was false\n";
@TTS_Message[12] = "I cannot run Weather right now.\n";
Console( $consoleMessage[$errNum]); # Print to console
open(TTS, ">$TTSFile"); # Print to TTSFile
print (TTS $TTS_Message[$errNum]);
close(TTS);
# And print to ErrorFile. Probably redundant.
open(ER, ">$ErrorFile") || die "ERROR! Problem opening TXT file.";
print (ER $TTS_Message[$errNum]);
close(ER);
}
1;
#########################################################################
sub removeTrailingZeros {
# remove trailing Zeros from the right side of the decimal point.
# Usage 'removeTrailingZeros(*s);' where *s points to value $s
#########################################################################
my($flag)=@_;
my ($c);
$c = substr($flag,(length($flag)-1),1);
while ((index($flag,".") && ($c eq "0") > 0 )) { # Only while there is a decimal point
if ($c eq "0") { # Remove trailing Zeros
chop($flag);
$c = substr($flag,(length($flag)-1),1);
if ($c eq ".") { # Remove trailing Decimal point
chop($flag);
}
}# while
$c = substr($flag,(length($flag)-1),1);
}# while
return($flag);
}
1;
sub button_1 {
my ($ct, $name);
# Let's draw the window on the screen
my ($box) = MainWindow->new;
my $frm = $box -> Frame();
my $ListBox = $frm -> Scrolled('Listbox',-height=>4,-width=>0,-scrollbars=>'osoe');
$ListBox->bind('', sub{
my $index = $ListBox->curselection();
$name = $ListBox -> get($index);
$Button1 = $name;
$hal_menu->delete(1);
$hal_menu->insert(1,'command',-command => \&setButton1,
-label => $Button1, -underline => 0);
$hal_menu->delete(2);
$hal_menu->insert(2,'command',-command => \&button_2,
-label => $Button2, -underline => 0,-state=>'normal');
});
for ($ct = 1;$ct<=$HALi1->{'Sensors'}->{Count};$ct++) { # Loop thru all sensors
$ListBox->insert('end',$HALi1->{'Sensors'}->Item($ct)->Name); # retrieve each name
} # for
$ListBox -> grid(-row=>2,-column=>1)->pack;
$frm->pack(qw/-side left -fill y/);
my $but = $box->Button(-text => 'OK',
-command => sub {Confirm("$name");
$box->destroy;
})->pack;
MainLoop;
}
1;
sub button_2 {
my ($ct, $name);
# Let's draw the window on the screen
my ($box) = MainWindow->new;
my $frm = $box -> Frame();
my $ListBox = $frm -> Scrolled('Listbox',-height=>4,-width=>0,-scrollbars=>'osoe');
$ListBox->bind('', sub{
my $index = $ListBox->curselection();
$name = $ListBox -> get($index);
$Button2 = $name;
$hal_menu->delete(2);
$hal_menu->insert(2,'command',-command => \&setButton2,
-label => $Button2, -underline => 0);
$hal_menu->delete(3);
$hal_menu->insert(3,'command',-command => \&button_3,
-label => $Button3, -underline => 0,-state=>'normal');
});
for ($ct = 1;$ct<=$HALi1->{'Sensors'}->{Count};$ct++) { # Loop thru all sensors
$ListBox->insert('end',$HALi1->{'Sensors'}->Item($ct)->Name); # retrieve each name
} # for
$ListBox -> grid(-row=>2,-column=>1)->pack;
$frm->pack(qw/-side left -fill y/);
my $but = $box->Button(-text => 'OK',
-command => sub {Confirm("$name");
$box->destroy;
})->pack;
MainLoop;
}
1;
sub button_3 {
my ($ct, $name);
# Let's draw the window on the screen
my ($box) = MainWindow->new;
my $frm = $box -> Frame();
my $ListBox = $frm -> Scrolled('Listbox',-height=>4,-width=>0,-scrollbars=>'osoe');
$ListBox->bind('', sub{
my $index = $ListBox->curselection();
$name = $ListBox -> get($index);
$Button3 = $name;
$hal_menu->delete(3);
$hal_menu->insert(3,'command',-command => \&setButton3,
-label => $Button3, -underline => 0);
$hal_menu->delete(4);
$hal_menu->insert(4,'command',-command => \&button_4,
-label => $Button4, -underline => 0,-state=>'normal');
});
for ($ct = 1;$ct<=$HALi1->{'Sensors'}->{Count};$ct++) { # Loop thru all sensors
$ListBox->insert('end',$HALi1->{'Sensors'}->Item($ct)->Name); # retrieve each name
} # for
$ListBox -> grid(-row=>2,-column=>1)->pack;
$frm->pack(qw/-side left -fill y/);
my $but = $box->Button(-text => 'OK',
-command => sub {Confirm("$name");
$box->destroy;
})->pack;
MainLoop;
}
1;
sub button_4 {
my ($ct, $name);
# Let's draw the window on the screen
my ($box) = MainWindow->new;
my $frm = $box -> Frame();
my $ListBox = $frm -> Scrolled('Listbox',-height=>4,-width=>0,-scrollbars=>'osoe');
$ListBox->bind('', sub{
my $index = $ListBox->curselection();
$name = $ListBox -> get($index);
$Button4 = $name;
$hal_menu->delete(4);
$hal_menu->insert(4,'command',-command => \&setButton4,
-label => $Button4, -underline => 0);
});
for ($ct = 1;$ct<=$HALi1->{'Sensors'}->{Count};$ct++) { # Loop thru all sensors
$ListBox->insert('end',$HALi1->{'Sensors'}->Item($ct)->Name); # retrieve each name
} # for
$ListBox -> grid(-row=>2,-column=>1)->pack;
$frm->pack(qw/-side left -fill y/);
my $but = $box->Button(-text => 'OK',
-command => sub {Confirm("$name");
$box->destroy;
})->pack;
MainLoop;
}
1;
sub setButton1 {
$HALi1->ExecuteAction("","","$Button1", "FLAG","","TRUE","","","",0);
}
1;
sub setButton2 {
$HALi1->ExecuteAction("","","$Button2", "FLAG","","TRUE","","","",0);
}
1;
sub setButton3 {
$HALi1->ExecuteAction("","","$Button3", "FLAG","","TRUE","","","",0);
}
1;
sub setButton4 {
$HALi1->ExecuteAction("","","$Button4", "FLAG","","TRUE","","","",0);
}
1;
sub Confirm {
my ($ji) = @_;
# Let's draw a window on the screen
my $dlg = MainWindow->new;
$dlg->Label(-text => "This menu will set HAL Flag ".uc($ji))->pack;
$dlg->configure(-takefocus => 1);
# Define the save button and what happens when it's hit.
my $but = $dlg->Button(-text => 'OK',
-command => sub {$dlg->destroy}, # Terminate Entry Dialog Box.
)->pack;
MainLoop;
}
1;
sub occultMoon {
$MoonPct=56;
# if ($MoonPct == 101) {$MoonPct = 0};
$Display->coords('earthShadow',295+$MoonPct,15,365+$MoonPct,100);
$MoonPct++;
}
1;
               (
geocities.com/wa4otj)