'tabs=4 '------------------------------------------------------------------------------ ' ' Script: AcquireScheduler.vbs ' Author: Robert B. Denny ' Version: ===> 8.3.1 <=== CHANGE CONSTANT BELOW! ' ' Uses: ACP Scheduler 8.2 ' ===== ACP 8.2 or later <===== N O T E ! ' MaxIm DL/CCD 5.25 or later <===== N O T E ! ' PinPoint 6.1 <===== N O T E ! ' NOVAS/COM 2.1 ' ' Objects: DC3.Scheduler.Database, ACP.Telescope, ACP.Util, ACP.FileDialog, ' ======= ACP.Camera, NOVAS.Star, NOVAS.Site, MaxIm.CCDCamera, ' PinPoint.Plate and children. ' ' Environment: This script is written to run under the ACP scripting ' =========== console. It assumes that the Telescope, Util, and ' Camera objects are "built-in" and it assumes it has ' the use of the ACP scripting console for I/O. ' ' Description: This script does automated imaging of a set of images ' =========== from specifications contained in the ACP Scheduler ' database. The scheduler will flag ONE Observation as ' the one to do, then start this script, which will locate ' te Observation to do and acquire all of its Images. ' ' ' Revision History: ' ' Date Who Description ' --------- --- -------------------------------------------------- ' 09-Mar-04 rbd Initial edit ' 24-May-04 rbd 0.1.2 - Stop tracking after run ' 04-Jun-04 rbd 0.2.1 - Add date directory level above users for image ' and log files. ' 07-Jun-04 rbd 0.2.2 - Fix named minor planets, don't back fill ' OBS.Planet for comet/MP elements! May not have MPCORB! ' 16-Jun-04 rbd 0.4.1 - Fix case for no filters ' 01-Jul-04 rbd 0.5.1 - Allow blank filter name, fix for case where no ' filters are installed, as well as where filters are ' installed. In that case, use Clear per AcquireSupport. ' 14-Jul-04 rbd 0.6.1 - Directory specs for ImageSets. Fill in ImageSet ' start and completion date/time info. ' 29-Sep-04 rbd 0.7.3 - Add definition of wasGuiding, wasOffsTrk. ' 21-Oct-04 rbd 0.8.1 - Safety folder and log filenames from junk in the ' OBS.Name, USR.Name, and PLN.Name strings. \/:*?"<>| are ' illegal in file names. ' 26-Oct-04 rbd 0.8.1 - NEO Ephemeris support, multi-entry with ' interpolation. Add error trapping for coordinate calcs ' from elements or ephemerides. ' 02-Jun-05 rbd 0.9.4 - Allow guider to fail if individual exposures are ' shorter than max unguided. GEM Auto-Flip wait with tracking ' off. Catch trap in GEM Auto-Flip if track offset not ' supported by mount. Always sum images when stacking. ' Catch stacking failures, making them non-fatal. Check ' pointing errors during repeat sequence, and recenter ' if it drifts out of tolerance. ' 09-Sep-05 rbd 0.9.5 - Interface changes in AcquireSupport 4.1.10 ' (part of ACP 4.1.1 HotFix #5), add rotator support! ' 02-Nov-05 rbd 1.0.1 - Production release. Changes for ACP HotFixes ' #6 and #7, mostly relating to auto-flip. Echo version ' of this script at startup. ' 30-Nov-05 rbd 1.0.2 - HF #$8 Oops, missed a call to SUP.HourAngle() ' for HF#7. ' 13-Jan-06 rbd 1.0.3 - Change call to SUP.TakePicture for new calling ' parameters (ACP 4.2) ' 27-Jan-06 rbd 1.0.4 - Need to do pointing update after AutoFocus even ' if AcquireStar used. We turn off AcquireStar's internal ' slew-back pointing update. ' 28-Feb-06 rbd 1.0.5 - Add guider restart during repeat sequence. ' TrackOffWaitUntil() will not toggle tracking for waits ' of less than 5 sec. Turn off orbital tracking after image ' set completes. No longer count final image plate solves ' against Max Solve Failures. If a final image fails to ' solve, don't try solving final images for the remainder ' of the repeat set. Implement TargetStart, TargetEnd, ' and ImageComplete user actions. Fix script version echo ' to log, was being sent before logging enabled. ' 18-Apr-06 rbd 2.0.1 - Custom file naming. Fix calls to custom user ' actions TargetStart() and TargetEnd(). ' 26-Apr-06 rbd 2.0.1 - Add $DATENITE token to custom file naming. Change ' default file pathing to use the same substitution engine ' but with the template coded here. Default file path ' now puts user above date, and uses nearest sunset date. ' 28-Apr-06 rbd 2.0.2 - Fix bug logging plate solutions and get base file ' name of image file for logging, etc. 2 birds, 1 stone. ' 01-May-06 rbd 2.0.3 - No longer using AcquireNow for crash detection. ' See DC3.Scheduler.ACPSequencer. Clear this flag immediately ' on starting acquisition cycle. ' 03-May-06 2.0.5 - Disconnect & release DB on a couple of rare errors. ' Get rid of duplicate fossil code that is in AcquireSupport. ' Max solve stars from 200 -> 500 for SolvePlate() calls. ' 04-May-06 rbd 2.0.5 - Add $TIMEUTC and $TIMELOC to path/name tokens. ' 06-May-06 rbd 2.0.5 - Support per-user path/name specs ' 08-May-06 rbd 2.0.6 - For 2.0.6 -- version track change only. Remove a ' large block of comments which no one reads. ' 13-May-06 rbd 2.0.7 - Fail image in database if user action ImageComplete ' returns false. ' 18-May-06 rbd 2.0.7 - Add $OBSSET for new observation repeat set number ' Add this to the default template too. ' 15-Jun-06 rbd 2.0.8 - If fail because pointing update failed, and user ' set "skip on pointing update fail" in ACP, mark images ' failed with the reason. ' 26-Jun-06 rbd 2.0.8 - Try to use new SUP.SimImageTimeCompress to turn ' off 10:1 time compression for Scheduler testing. Fail ' images if user action TargetStart() returns false. ' 07-Jul-06 rbd 2.0.9 - Oops, fix IFL.Initialize() for case where no ' ImageFileConfig.txt file exists. Roll SunEphem() ' into NearestSunset() to avoid multiple create/release ' of NOVAS object in the Do loop. ' 26-Jul-06 rbd 2.0.9 Oops, fix guider-restart pre-pointing-update Call ' to use OBS.xx instead of vars from AcquireImages. ' 28-Jul-06 rbd 2.0.9 Update sim image coords if not slewing ' 30-Aug-06 rbd 2.0.10 - Don't keep trying to guide on sum of exposure ' time in a repear loop if the initial attempt to start the ' guider fails. ' 19-Dec-06 rbd 2.0.11 - For ACP 5.0, change in SUP.TakePicture() signature. ' 19-Jan-07 rbd 2.0.12 - Change $DATENITE to switch dates at high noon ' instead of 12 hours after the sunset. NearestSunset() Is ' now called SunsetOfRun(). Remove 5 minute fudge factor In ' dawn-crossing check. ' 20-Jan-07 rbd 2.0.13 - Add $MERSIDE and $INTERVAL ' 27-Jan-07 rbd 2.0.13 - Add dithering support. Fix several calls to ' database. Fix stacking (wildcard name). ' 05-Jun-07 rbd 2.0.14 - Fix TargetStart() and TargetEnd() calls for ACP5 ' Only do post-flip pointing update if enabled. ' 15-Aug-07 rbd 2.0.15 - Fix disabling of autostack on dupe. ' 04-Oct-07 rbd 2.0.16 - New ACP 5.1 FlipConfig. ' 09-Mar-08 rbd 2.1.1 - Add back door for special observing scripts. It ' is triggered by "> xxx.xxx" in the Observation's ' Description field. This is for John Farrell. ' 10-Mar-08 rbd 2.1.1 - Fix long-standing bug in initial AutoFlipIf test. ' 21-Mar-08 rbd 2.1.2 - If Obs has a SetCount > 1 and the SetsCompleted ' is less than SetCount but > 1, then it is a repeat of a ' previous observation. Do not turn off tracking and skip ' the initial pointing update. This allows repeating Obs' ' to run at maximum efficiency. Keep recentering rolling ' through multiple filters and Obs.SetCount > 1. Skip only ' if last image repeat in last image of set in last repepated ' obs. $OBSSEQ now starts with 1 not 0. ' 24-Mar-08 rbd 2.1.3 - If external guider, guide across multiple ImageSets. ' Refactor guiding code. Add STRICT_AUTOGUIDING to control ' whether guide failure should cause Obs to fail, or To ' to continue unguided (the "passing clouds" scenario). ' 26-Mar-08 rbd 2.1.4 - Oops, fix sim image calculation on no-slew. Also, ' dark frames run with tracking off, so if an Obs contains ' any darks, it must ALWAYS slew/center even on repeats. ' 07-Feb-09 rbd 3.0.1 - Special path default for VOEvents ' 09-Feb-09 rbd 3.0.1 - New special path subst tokens $WEBROOT and ' $PRJID for VOEvent. If filter in obs request is bad, and ' it shifts gears to the "clear" filter, back-patch the ' Image record in the database with the filter actually used. ' This is required for VOEvent alerter file name sync. ' 12-Feb-09 rbd 3.0.1 - Have JPEGs saved by TakePicture for VOEvent. ' 13-Feb-09 rbd 3.0.1 - Er, have JPEG's saved only if VOEvent run. If ' VOEvent run use proj-num folder like images, then name ' the log files via date time as usual. For normal runs, ' use SunsetOfRun() date for the log file folder instead ' of the current UTC time. ' 19-Feb-09 rbd 3.0.1 - Set CLRBAND in FITS if J-C filter name ' 13-Mar-09 rbd 3.0.2 - For Scheduler 3.0.2 - No changes here. ' 21-Apr-09 rbd 3.0.4 - For Scheduler 3.0.4 - Overhaul VOEvent JPEGs. ' If internal guider, do not aggregate exposures for ' guide/no-guide test. ' 23-Apr-09 rbd 3.0.5 - Don't look up targets in MiniSAC! Leave the ' coordinates as is! ' 20-May-09 rbd 3.0.6 - (HF1) Fix InitFlipConfig(), make margin vars variable ' not Consts!! Move call to InitFlipConfig to after ' log setup and AcquireSupport.Initialize(). ' 05-Jun-09 rbd 3.0.6 - Fix Post-AF pointing update on time series after ' first pass through ImageSet. Fix broken calibration process. ' Add HotPix filtering. Remove logic for dark frames In ' ImageSets, these are no more! ' 17-Jun-09 rbd 3.0.6 - (HF1) Fix SunsetOfRun() to return sunset at +/- ' 65 degrees if site is above the (ant)arctic circle. ' 01-Oct-09 rbd 3.1.1 - Handle sub-polar (west-to-east) autoflipping (GEM:188). ' Add fixed time needed for pointing update, for flip testing. ' This is to prevent a pointing update which is followed by ' a mount flip that we didn't do (and thus no post flip ' pointing update). This is GEM:185. More on this, Need to ' convert target coordinates to Local Topo to avoid tiny ' errors leading to flip failures when margins are zero!!!! ' Add NOMINALAFTIME and NOMINALPUTIME. Prevent negative ' pre-flip margin from affecting AutoFlip for pointing upd. ' Oops, initialize auto-flip pareameters in case no FlipConfig. ' 20-Oct-09 rbd 3.1.1 - Do not segregate logs into Plan folders. Ridiculous. ' Make date folder have 4 digit year like all the others. ' GEM:236 allow ACP logs to web accessible area. ' 17-Nov-09 rbd 3.2.1 - GEM:246 Enable tracking at start of run. ' 19-Nov-09 rbd 3.2.2 - GEM:319 BestEfforts never do strict autoguiding ' GEM:246 (again!) StartSlewToTarget's return value is not ' used. Remove return and comments. Script V3.2.2. ' 21-Nov-09 rbd 3.2.2 - GEM:328 Add optional image compression ' 22-Nov-09 rbd 3.2.3 - GEM:331 Temporary, #nosolve in IMG.Description ' suppresses solving of final image. ' 12-Aug-10 rbd 3.2.4 - GEM:423 Provide path substitution token for ACP ' login username via Project Contact Name [ACP xxxxx]. ' Also put log files into web user's logs folder if the ' ACP username is in the Project Contact Name. ' 28-Nov-10 rbd 3.3.1 - GEM:452 Optimize out pointing updates on closely ' spaced Observations, if external guider or guiding off. ' GEM:518 Correct guiding decision logic and honor the ' new "disable aggregation" option in ACP 6.0. ' GEM:143 Pick up actual sum of exposures of repeated ' images (modified by ImageStart hook) for the exposure of ' the stacked image. ' 20-Dec-10 rbd 3.3.2 - GEM:535 Don't try to get filter name if no filters ' installed (setting CLRBAND for J-C). ' 15-Jan-11 rbd 3.3.3 - GEM:562 DropBox-friendly file handling ' 21-Jan-11 rbd 3.3.4 - GEM:562 Pick up RAW- file created when ACP autocal ' is on. Was being left in the temp area. GEM:574 Add logic ' to put log file and image files into new database fields. ' GEM:562 Make stacking Dropbox-friendly. GEM:563 Shorten ' and simplify default log template. ' 11-Feb-11 rbd 3.3.5 - GEM:593 Fix VOEvent portfolio thumbnails for ' DropBox friendliness. GEM:563 fix configurable log feature ' for VOEvent followup logs and 'weblog' tagged logs. ' 18-Feb-11 rbd 3.3.5 - Fix custom pathing for empty ImageFileConfig. ' [3.3 Release] ' 24-Aug-11 rbd 3.4.1 - GEM:313 For integration with the ACP web UI's ' System Status display. ' 27-Sep-11 rbd 3.4.1 - GEM:313 Oops, thumbnail and full preview were ' omitted! ' 30-Sep-11 rbd 3.4.1 - GEM:714 Populate folders for web users with ASP ' file browsing support files. No more COMPRESS_IMAGES, Now ' use info in project Contact, a # after the ACP username ' means WantsCompress. ' 21-Oct-11 rbd 3.4.1 - GEM:687 Fix error if not saving autocal raw. Fix ' CreateFolder() again dang it! ' 10-Nov-11 rbd 3.4.1 - GEM:733 Catch infinite recursion in CreateFolder() ' if drive letter is bad. ' 29-Jan-12 rbd 3.5.1 - GEM:767 Report UTC time at which a flip wait will ' end. ' 30-Jan-12 rbd 3.5.1 - GEM:766 Log Project and Plan name on the run log. ' 31-Jan-12 rbd 3.5.1 - GEM:742 Do force-flip for mounts which fail to flip ' and for which set SideOfPier is available. GEM:754 Catch ' guiding failure for external guidescope and aggregation, ' fail correctly not with script error trying to use IMG. ' 06-Feb-12 rbd 3.5.1 - GEM:791 Delete uncompressed file after compressing. ' 12-Feb-12 rbd 3.5.1 - GEM:795 Fix $PRJCONT token substitution for image ' file config. ' 18-Feb-12 rbd 3.5.1 - Missing "Set" on IMG = Nothing. ' 21-Mar-12 rbd 3.5.2 - Oops, Telescope.PierSide -> SideOfPier ' 02-May-12 rbd 3.5.2 - Oops, SCRIPTVERSION ' 14-Sep-12 rbd 3.5.3 - For ACP 7 the Autoguiding API changed, and the ' FlipConfig file is gone, replaced by API properties. ' 18-Oct-12 rbd 3.5.3 - GEM:914 Fix obscure overflow on flip tracing. ' 31-Oct-12 rbd 3.5.3 - GEM:921 For ACP 7 Honor negative pre-flip for ' post AF pointing update. ' 15-Jan-13 rbd 3.5.3 - (ACP 7) In AutoFlipIf() always wait for slew ' before checking on the scope's meridian side etc. ' 04-Feb-13 rbd 3.5.3 - (ACP 7) GEM:923 Optimization and fixes for ' flipping ' 21-Oct-13 rbd 3.5.4 - GEM:1008 Beautify the PNG previews ' 21-Oct-13 rbd 3.5.4 - GEM:1020 Fix comet elements for numbered comets ' Add support for SOFT00COMET database lookups like MPCORB. ' 22-Oct-13 rbd 3.5.4 - GEM:1018 Wow, fix slew for local topo! GEM:983 ' Fix case for local user where the login became "_". ' 04-Nov-13 rbd 3.5.4 - GEM:1036 Fix error handling of bad Planet target ' 31-Jan-14 rbd 3.6 - GEM:1092 Store last solve FWHM in global for web ' system status. ' 17-Feb-14 rbd 3.6b - GEM:1045 Fix simulation initial coordinates ' 03-Mar-14 rbd 3.6c - GEM:1018 WRONG! Original code was correct! ' 12-Jul-14 rbd 3.7 - GEM:1177 Calls to Util.IsGEMDestinationWest Now ' include Declination. ' 28-Jul-14 rbd 3.7 - GEM:906 Check for flip on pointing update ' optimization. ' 08-Aug-14 rbd 3.7 - GEM:1038 $TEMP as substitution token ' 14-Aug-14 rbd 3.7 - Change call to SolvePlate() for ACP function change. ' Add parameter that controls FWHM updating. ' 15-Nov-14 rbd 8.0 - GEM:1232 shoten potential giant error messages To ' 253 chars for database string fields (FailureReason). ' 16-Nov-14 rbd 8.0 -GEM:917 Looks like most of this got done in the past, ' and wasn't logged. Maybe while I was doing GEM:914 for ACP ' but I found one more stray CInt(). ' 16-Nov-14 rbd 8.0 - GEM:1196 $TEMP with preposterous temperature from ' SBIG camera with cooler off -> NoTemp. ' 17-Nov-14 rbd 8.0 - GEM:1249 If any of Dark, Bias, or Flat cal options ' are set, do a full calibration. Remove the old logic. ' 08-Dec-14 rbd 8.0 - GEM:138 Implement #subframe as Description text ' (temporary means). ' 09-Dec-14 rbd 8.0 - GEM:1261 Fix conversion of acpUser to "_" if no ACP ' user. Fix reporting of custom paths if ImageFileConfig ' contains nothing but comments. ' 15-Dec-14 rbd 4.0 - GEM:1222 Honor ACP's "always solve" setting ' 23-Feb-15 rbd 8.0.2 - GEM:1224 Avoid AutoFlipIf for non-GEM at one place ' 24-Feb-15 rbd 8.0.3 - GEM:1285 Implement #nopreview with substitution images. ' 26-Feb-15 rbd 8.0.4 - GEM:1307 Implement slew-ahead between Observations. ' 06-Feb-15 rbd 8.0.5 - GEM:1307 fix stupid error in the above. ' 28-Mar-15 rbd 8.0.6 - GEM:1249 Save RAW no matter how autocal was specified ' 10-Apr-15 rbd 8.0.7 - GEM:1307 PARTIAL - Comments only, see pre-slew ' detection and startSlew calculation comments (now at line 944). ' No logic changes. ' 12-Apr-15 rbd 8.0.7 - GEM:1307 Complete the changes here to avoid the ' suppression of pointing updates on pre-slew. New property ' Database.PreviousImmediate lets us get the coordinates of ' the start of the pre-slew. ' 15-Jun-15 rbd 8.0.8 - GEM:1322 Move ImageFile and LogFile config to the ' new location in Public Documents\ACP Config\Scheduler. ' 16-Jun-15 rbd 8.0.8 - GEM:1349 Avoid surprise flip on recenter slew ' 15-Sep-15 rbd 8.1.0 (8.1) - GEM:1378 Fix guider recovery when stops during ' ImageSet with Count > 1 ' 29-May-16 rbd 8.1.0 (8.1) - GEM:1360 Fail ImageSet and Observation if a ' a bad filter name is encountered. No more back-patching ' to Clear. ' 29-May-16 rbd 8.1.0 (8.1) - GEM:1047 Implement #defocus nnn in ImageSet ' description. ' 30-May-16 rbd 8.1.0 (8.1) - GEM:799 Finally(!) implement readout modes ' Also, protect IMG.FailureReason with SafeErrorMessage() ' in several places (oops). Remove dead code for old cal ' library. ' 05-Jul-16 rbd 8.1.0 (8.1) - GEM:1477 Always aggregate guiding, but make ' it optional if aggregated (individual exposures < max ' unguided). ' 10-Aug-16 rbd 8.1.0 (8.1) - GEM:1490 Leave the previews up until current ' image is finished ' 04-Oct-16 rbd 8.1.2 (8.1) - GEM:1494 (reopened) Fix storing in RAW ' subfolder. ' 18-Dec-17 rbd 8.2.0 (8.2) - GEM:1477 Do NOT aggregate guiding if the ' ACP disable aggregation option is set. Damn it. ' 26-Apr-18 rbd 8.2.1 (8.2) - GEM:1212 Fix #nopreview option so that the ' time-consuming construction of the preview image In ' AcquireSupport.TakePicture() is skipped if #nopreview ' is specified. ' 06-Jun-18 rbd 8.2.2 (8.2) - GEM:1594 Detect dupes when files are zipped ' 10-Jul-18 rbd 8.2.3 (8.2) - GEM:1604 Look for #TRACKON in OBS.Description ' and if found, and if Planet or OrbitalElements <> "" Then ' do orbital tracking. GEM:1523 Put only the solar system ' body name etc. into the FITS OBJECT field. ' 16-Jul-18 rbd 8.2.4 (8.2) - GEM:1360 (again) make check for AcquireSupport '' filter substitution caseless. ' 24-Jul-18 rbd 8.2.4 (8.2) - No GEM Fix typo in word "extand" to "extend" '`17-Sep-18 rbd 8.2.5 (8.2) - No GEM Improve handling of RAW images. Do Not ' create RAW folder unless doing RAW. ' 30-Sep-18 rbd 8.2.5 (8.2) - GEM:1637 Speed preview generation by doing ' beautification afger downsizing. ' 20-Jan-19 rbd 8.2.5 (8.2) - Notation in comments for #trackon that it Is ' now also supported in RTML23 importer. Leave the support ' there, though, for existing Observations. NO LOGIC CHANGE. ' 09-May-19 rbd 8.2.6 (8.2.1) - GEM:1692 Fix for #nopreview on systems With ' no filters. ' 12-May-19 rbd 8.2.7 (8.2.1) - GEM:1687 Add missing support for UserAction ' AcquireImage(). ' 13-May-19 rbd 8.2.7 (8.2.1) - GEM:1637 Revert this change, was adversely ' affecting preview quality. ' 30-Jul-19 rbd 8.2.8 (8.2.2) - GEM:1637 Oops, reversion was wrong on 1 line. ' Magnified thumbnail fixed with this. ' 31-Oct-19 rbd 8.3.1 (8.3) - GEM:1735 Add recognition for Interstellar "I" ' comet type (e.g., 2I/Borisov) '---------------------------------------------------------------------------- Option Explicit Const SCRIPTVERSION = "8.3.1 (Cooney Test)" ' ' GUIDE FAILURE BEHAVIOR - SET FALSE FOR NON-FATAL GUIDE FAILURES ' NOTE: BestEfforts plans never do strict autoguiding ' Const STRICT_AUTOGUIDING = True ' ' Path builder modes ' Const IMGPATH = 1 Const LOGPATH = 2 ' ' Default image/log file path/name templates - See the info in ImageFileConfig.txt/LogFileConfig.txt ' before altering this! In other words, DON'T CHANGE THIS!!! ' Const DEF_IMAGE_TMPL = "$DEFPATH\$DATENITE\$PLNNAME\$OBSNAME-S$OBSSEQ-$IMGNAME-R$IMGSEQ-$IMGFILT" Const VOE_IMAGE_TMPL = "$WEBROOT\VOEvent\images\$PRJID\$PLNNAME-$OBSNAME-$OBSSEQ-$IMGNAME-$IMGSEQ-$IMGFILT" Const DEF_LOG_TMPL = "$DEFPATH\$DATENITE\$OBSNAME-$DATEUTC@$TIMEUTC" Const VOE_LOG_TMPL = "$WEBROOT\VOEvent\logs\$PRJID\$OBSNAME-$DATEUTC@$TIMEUTC" Const WEB_LOG_TMPL = "$WEBROOT\" Const ForReading = 1, ForWriting = 2 Const DEGRAD = 0.0174532925 ' PI/180 Const MINTRACKOFFSEC = 5 ' Don't turn tracking off if waiting for less than 5 sec Const IMG_PENDING = 0 ' Database status values Const IMG_RUNNING = 1 ' (not available via COM Interop :-( ) Const IMG_COMPLETED = 2 Const IMG_FAILED = 3 Const OBS_PENDING = 0 Const OBS_RUNNING = 1 Const OBS_COMPLETED = 2 Const OBS_FAILED = 3 Const OBS_VETOED = 4 Const THUMB_FILE = "pvimage.png" ' Running plan thumbnail image for web Const NP_THUMB_FILE = "nppvimage.png" ' #nopreview thumbnail image for web Const LSTPNG_FILE = "lastimage.png" ' Post-plan "last image" PNG for web Const NP_LSTPNG_FILE = "nplastimage.png" ' #nopreview "last image" PNG for web Const LSTDIM_FILE = "lastimage.txt" ' Companion file with image dimensions Const NP_LSTDIM_FILE = "nplastimage.txt" ' Companion file with image dimensions ' ---------------- ' Global variables ' ---------------- ' Dim FSO ' File system object for general use Dim SUP ' Support library object Dim DB ' Scheduler database wrapper object Dim KT ' Kepler for Earth (used for $DATENIT file token) ' ' Control variables ' Dim OBS ' Database Observation Dim IList ' Collection of Image objects Dim IMG ' Current ImageSet we're working On Dim PLN ' Plan for our Observation Dim PRJ ' Project for our Plan Dim USR ' User for our Project Dim PREFLIPMARGIN ' Next 4 come from FlipConfig Dim POSTFLIPMARGIN ' Dim NOMINALAFTIME ' Time needed for auto-focus, for AutoFlip Dim NOMINALPUTIME ' Time needed for pointing update, for AutoFlip Dim TargetRA, TargetDec ' J2000 coordinates of target Dim TargetRARate, TargetDecRate ' Coordinate rates of target Dim wantGuiding, sumExpAGFail ' Conditional guiding (see HandleAutoguiding()) Dim obsRunDate ' "Night Folder" date for the run (sunset date) Dim acpLogin ' THe ACP login name (if for web user) or "" Dim cleanContact ' Project contact name with ACP login and compress # removed Dim wantsCompress ' True if web user and wants compression of images Dim hardwarePierSide ' True if has both SOP and DSOP Dim canExplicitlyFlip ' True if Set SOP is supported ' ------------------------------------------------------------------------------------------------------------------------------------ ' ' Globals used by ASP web pages (Util.Script.xxx). Mostly used in the ' support ASP script for the web system status display, asystemstatus.asp. ' Dim planName ' Name of currently executing Plan Dim obsName ' Name of running Observation Dim curObs ' Current Observation NUMBER Dim maxObs ' Total number of Observations for this Plan Dim lastFWHM ' FWHM from last DATA image plate solution Dim curRepeat ' Current repeat number in the current target Dim maxRepeat ' Total number of repeats for the target Dim imgSetName ' Name of current image set (hack) Dim curImgSet ' Current image set NUMBER Dim maxImgSet ' Total number of image sets for this target Dim curCount ' Current image number for this target/image set/repeat Dim maxCount ' Total nuumber of images being acquired for the above Dim isPointing ' True if a pointing update is being performed. ' ' These arrays are here as a persistent storage place for asystemstatus.asp, which ' runs every 6 seconds, for the guider error history. They are not used by ' AcquireImages.js. However, this script is live for the entire run, so the data ' stays around for the run. asystemstatus.asp comes and goes every 6 seconds. ' In order to prevent old guiding data from being on the graph, however, this ' script clears the arrays whenever it stops the guider. ' Dim guideErrHistX()'' Dim guideErrHistY()'' ' ============================= ' FILE PATH/NAME HANDLER OBJECT ' ============================= ' Class PathMaker Private c_Mode, c_DirTempl, c_FileTempl ' ' File locator and mover - Try to find it in Public Documents\ACP COnfig\Scheduler ' and if there use it. Otherwise look in the old place Program Files\ACP Scheduler. ' If there is one there, move it to the new place and use it. ' Private Function MoveAndFindFile(ScriptPath, Name) Dim NewPath, OldPath NewPath = ACPApp.ConfigPath & "\Scheduler\" & Name If FSO.FileExists(NewPath) Then MoveAndFindFile = NewPath Exit Function End If OldPath = ScriptPath & "\" & Name If FSO.FileExists(OldPath) Then If FSO.FileExists(NewPath) Then FSO.DeleteFile NewPath ' SHOULD NEVER HAPPEN HA HA End If FSO.MoveFile OldPath, NewPath MoveAndFindFile = NewPath Exit Function End If MoveAndFindFile = "" ' Nope, not found End Function ' ' Substitution engine ' Private Function Substitute(templ, I, O, P, R, U, filt, seq) Dim buf, tfilt, tseq, tdec, tmer Dim defPath If c_Mode = IMGPATH Then If filt = "" Then tfilt = "NoFilt" Else tfilt = filt End If If Not IsNull(seq) Then If seq = -1 Then ' Handle request for wildcard sequence tseq = "*" Else tseq = Util.FormatVar(seq, "000") End If Else tseq = "___" End If ' ' Create image $DEFPATH according to whether an ACP web user login name ' was found in the Project's COntact Name field. ' If acpLogin = "" Then defPath = Prefs.LocalUser.DefaultImageDir & "\Scheduler\" & U.Name ' Local use default Else defPath = Prefs.WebRoot & "\images\" & acpLogin ' Web user default End If Else ' For log files If acpLogin = "" Then defPath = Prefs.LocalUser.DefaultLogDir & "\Scheduler\" & U.Name ' Local use default Else defPath = Prefs.WebRoot & "\logs\" & acpLogin ' Web user default End If End If tdec = Util.Degrees_DMS(O.Dec, "", "", "") If Left(tdec, 1) <> "-" Then tdec = "+" & tdec ' Assure Dec has a sign If Telescope.AlignmentMode = 2 Then ' If GEM... If Telescope.SideOfPier = 0 Then ' pierEast (looking west) tmer = "W" ' Substitute W (where it is looking) Else ' pierWest (looking east) tmer = "E" ' Substitute E (where it is looking) End If Else tmer = "_" ' Should not be using this anyway! End If buf = templ buf = Replace(buf, "$DEFPATH", defPath) buf = Replace(buf, "$WEBROOT", Prefs.WebRoot) buf = Replace(buf, "$OBSNAME", SafeFileName(O.Name)) buf = Replace(buf, "$OBSRA", Util.Hours_HMS(O.RA, "", "", "")) buf = Replace(buf, "$OBSDEC", tdec) buf = Replace(buf, "$OBSPA", Util.FormatVar(O.PA, "000")) buf = Replace(buf, "$OBSSEQ", Util.FormatVar(O.SetsCompleted + 1, "000")) buf = Replace(buf, "$MERSIDE", tmer) buf = Replace(buf, "$PLNNAME", SafeFileName(P.Name)) buf = Replace(buf, "$PRJID", Util.FormatVar(R.ID, "0000000000")) buf = Replace(buf, "$PRJNAME", SafeFileName(R.Name)) buf = Replace(buf, "$PRJEXID", SafeFileName(R.ExternalID)) buf = Replace(buf, "$PRJCONT", SafeFileName(cleanContact)) buf = Replace(buf, "$USRNAME", SafeFileName(U.Name)) If acpLogin <> "" Then buf = Replace(buf, "$ACPLOGIN", SafeFileName(acpLogin)) Else buf = Replace(buf, "$ACPLOGIN", "_") End If buf = Replace(buf, "$DATEUTC", Util.FormatVar(Util.SysUTCDate, "yyyymmdd")) buf = Replace(buf, "$TIMEUTC", Util.FormatVar(Util.SysUTCDate, "HhNnSs")) buf = Replace(buf, "$DATELOC", Util.FormatVar(Now(), "yyyymmdd")) buf = Replace(buf, "$TIMELOC", Util.FormatVar(Now(), "HhNnSs")) buf = Replace(buf, "$DATEJUL", CStr(Fix(Util.SysJulianDate))) buf = Replace(buf, "$DATENITE", Util.FormatVar(obsRunDate, "yyyymmdd")) If c_Mode = IMGPATH Then buf = Replace(buf, "$IMGNAME", SafeFileName(I.Name)) buf = Replace(buf, "$INTERVAL", Util.FormatVar(CInt(I.ExposureInterval), "000")) ' Rounding here buf = Replace(buf, "$IMGFILT", SafeFileName(tfilt)) buf = Replace(buf, "$IMGBIN", I.Binning) buf = Replace(buf, "$IMGSEQ", tseq) If Camera.CanSetTemperature Then If Camera.Temperature < 40 Then buf = Replace(buf, "$TEMP", CInt(Camera.Temperature)) Else buf = Replace(buf, "$TEMP", "NoTemp") End If Else buf = Replace(buf, "$TEMP", "NoTemp") End If End If Substitute = buf End Function ' ' Initialization: If template is non-blank, we have a template ' and can make custom path/names. Supports per-user templates ' beginning with []. These must come BEFORE the ' "no-name" template that doesn't have the [...]. ' ' AS OF EXPERT 8: Look for these in Public Documents\ACP Config\Scheduler ' If not there, look in old place (ProgFiles) and move to the new place ' then use. ' Public Sub Initialize(Mode, ScriptPath, UserName, ExtID) Dim mName, cfFile, cfStream, buf, tmpl, k c_Mode = Mode If Mode = IMGPATH Then If ExtID = "VOEvent" Then ' VOEvent job overrides! tmpl = VOE_IMAGE_TMPL Console.PrintLine "Special VOEvent followup image path in use" k = InStrRev(tmpl, "\") ' Position of last '\' c_DirTempl = Left(tmpl, k - 1) ' Path part of template c_FileTempl = Mid(tmpl, k + 1) ' File part of template Exit Sub ' RETURN - FINISHED End If mName = "image" cfFile = MoveAndFindFile(ScriptPath, "ImageFileConfig.txt") ' See notes for MoveAndFindFile() above (typ.) tmpl = DEF_IMAGE_TMPL Else ' For Log file If ExtID = "VOEvent" Then ' VOEvent job overrides! tmpl = VOE_LOG_TMPL Console.PrintLine "Special VOEvent followup log path in use" k = InStrRev(tmpl, "\") ' Position of last '\' c_DirTempl = Left(tmpl, k - 1) ' Path part of template c_FileTempl = Mid(tmpl, k + 1) ' File part of template Exit Sub ' RETURN - FINISHED End If mName = "log" cfFile = MoveAndFindFile(ScriptPath, "LogFileConfig.txt") tmpl = DEF_LOG_TMPL End If buf = "" ' Assume no config file If cfFile <> "" Then ' Look and return if file exists Set cfStream = FSO.OpenTextFile(cfFile) ' Exists, open it k = Len(UserName) Do While Not cfStream.AtEndOfStream ' Read lines, skipping blank lines and comments buf = Trim(cfStream.ReadLine()) ' Get rid of leading/trailing blanks! If buf <> "" And Left(buf, 1) <> ";" Then ' If non-blank and not a comment If Left(buf, k + 2) = "[" & UserName & "]" Then ' Found a user-specific template buf = Trim(Mid(buf, k + 3)) ' Return trimmed remainder Exit Do ElseIf Left(buf, 1) <> "[" Then ' Found a no-name template Exit Do ' Stop reading file, we got it End If Else ' Otherwise... buf = "" ' Zap comment for post-loop test End If Loop cfStream.Close ' Done reading config file, close it If buf <> "" Then tmpl = buf ' We got a template Console.PrintLine "Custom image file path/names are in use" End If End If k = InStrRev(tmpl, "\") ' Position of last '\' c_DirTempl = Left(tmpl, k - 1) ' Path part of template c_FileTempl = Mid(tmpl, k + 1) ' File part of template End Sub ' ' Create a full image path/name from ImageSet, sanitized ' filter name, and repeat sequence # ' Public Function ImagePathName(I, filt, seq) Dim O, P, R, U Dim bdir, lfn, fn, z If c_Mode <> IMGPATH Then Err.Raise vbObjectError, "AcquireScheduler", "Programmer error - Wrong call to ImagePathName()" Set O = I.Observation ' Get all parents of the ImageSet Set P = O.Plan ' (reduce overhead) Set R = P.Project Set U = R.User If I.AutoStack And InStr(c_FileTempl, "$IMGSEQ") = 0 Then Console.PrintLine "**CUSTOM FILE TEMPLATE HAS NO $IMGSEQ (SEQUENCE NUMBER)" Console.PrintLine "**AUTO-STACKING CANNOT BE DONE - DISABLED" I.AutoStack = False Call I.Update(True) ' Update with event End If If I.Directory = "" Then ' If ImageSet has no specified directory bdir = Substitute(c_DirTempl, I, O, P, R, U, filt, seq) Else bdir = I.Directory ' ImageSet has override directory path End If Call CreateFolder(bdir) ' Make sure folder exists lfn = Substitute(c_FileTempl, I, O, P, R, U, filt, seq) If seq <> -1 Then lfn = SUP.MakeFileName(lfn) ' Don't filter * if asked for wildcard ' ' Combine dir and file names and munge the name to prevent ' inadvertent overwriting of old data ' z = 0 fn = bdir & "\" & lfn Do While FSO.FileExists(fn & ".fts") Or FSO.FileExists(fn & ".fts.zip") z = z + 1 fn = bdir & "\" & lfn & "_dupe-" & z Loop If z > 0 Then lfn = lfn & "_dupe-" & z Console.PrintLine "**DUPLICATE IMAGE NAME - ADDED _dupe-" & z If I.AutoStack Then Console.PrintLine "**AUTO-STACKING CANNOT BE DONE - DISABLED" I.AutoStack = False I.Update(True) ' Update with event End If End If ImagePathName = Trim(bdir & "\" & lfn) ' Return final path/name (without extension) End Function ' ' Create log file path/name ' Public Function LogPathName(O) Dim P, R, U Dim bdir, lfn If c_Mode <> LOGPATH Then Err.Raise vbObjectError, "AcquireScheduler", "Programmer error - Wrong call to LogPathName()" Set P = O.Plan ' (reduce overhead) Set R = P.Project Set U = R.User bdir = Substitute(c_DirTempl, Null, O, P, R, U, "", 0) Call CreateFolder(bdir) lfn = Substitute(c_FileTempl, Null, O, P, R, U, "", 0) LogPathName = Trim(bdir & "\" & lfn) End Function End Class ' =========== ' ALERT ENTRY ' =========== ' Sub alert() Console.PrintLine "Alerts have no effect on this script." End Sub '------------------------------------------------------------------------------ ' ' ================ ' MAIN ENTRY POINT ' ================ ' Sub Main() Dim buf, bits, x, z, i, j Dim bPtgUpdDone, bNeedPostAFPtgUpd, comb Dim tgtMinBrt, tgtSigma, tgtCatMax, clearFilter Dim plate, firstStart, MaxIm, numIMG, JScale, Doc Dim fn, fnf, bfn, tfn, tfnf, rfnf, trfnf, filtNum, filtName Dim prevSolveFails, finalImgSlvFail, IFL, LFL Dim nextDawn, SC, repeatObs, lastImgObs, imgDoneExt Dim forceCal, saveJPG, confJPG, MaxDoc, slewDist, tooFar Dim normRoMode, sumImgExposure, imgFileList Dim imgRootPath, previewImage, isAcpWeb Dim Subframe, Defocus, RoMode, RX, Mats, DidFlip Dim NOBS, POBS, slewNext, nextName, nextRA, nextDec, nextPA Randomize Set FSO = CreateObject("Scripting.FileSystemObject") ' File system methods here Set DB = CreateObject("DC3.Scheduler.Database") ' Database wrapper Set SC = CreateObject("DC3.Scheduler.SchedulerConfig") ' Scheduler config info nextDawn = NextAstronomicalDawn(SC.SunDownAlt) ' Stop observing at this time, regardless Set SC = Nothing ' Release, no longer needed ' ' Get the Observation that we're supposed to do, and all of the ' parent objects up the chain, to the User object. ' ' NOTE: The loop is needed because it takes "some time" for the ' changes to the Observation record to be written to the ' database (usually less than 2 sec.). ' i = 1 On Error Resume Next Do While True Call DB.Connect() ' Connect to the database If Err.Number <> 0 Then Console.PrintLine "**NO DATABASE???" Console.PrintLine Err.Description Set DB = Nothing ' Release Database Exit Sub End If Err.Clear Set OBS = DB.ObservationToAcquire If Err.Number = 0 Then Exit Do Else i = i + 1 Call DB.Disconnect() If i > 10 Then Console.PrintLine "Nothing to Do???" Call ReleaseAllDB() Exit Sub End If End If Err.Clear Util.WaitForMilliseconds 1000 ' Wait a sec. and try again. Loop On Error GoTo 0 ' ' Gather info about this run ' Set IList = OBS.Images Set PLN = OBS.Plan Set PRJ = PLN.Project Set USR = PRJ.User ' ' For the ACP web UI ' planName = PLN.Name maxObs = PLN.ObservationCount curObs = maxObs - PLN.RemainingObservations.Count + 1 obsName = OBS.Name curRepeat = OBS.SetsCompleted + 1 ' 1-based maxRepeat = OBS.SetCount isPointing = False ' ' If this is the second or later repeated obs, skip slewing and ' updating pointing for efficiency. Set this flag now. If OBS ' includes dark frames, tracking will be turned off, so we must ' (re)slew and do a pointing update for all repeats of the Obs. ' If OBS.SetCount > 1 And OBS.SetsCompleted > 0 Then repeatObs = True Else repeatObs = False End If ' ' If the Observation's Description field has "> xxx.yyy", it is a script ' to run in place of AcquireScheduler.vbs. This is for John Farrell. ' If Left(OBS.Description, 1) = ">" Then bits = Split(OBS.Description, " ") If UBound(bits) > 0 Then If Telescope.CanSetTracking Then Telescope.Tracking = False ' Stop tracking if possible buf = Trim(bits(1)) ' Script to run Util.ChainScript buf Call ReleaseAllDB() Set FSO = Nothing Exit Sub ' Chain to special script End If End If obsRunDate = SunsetOfRun() ' Calculate this ONCE ' ' If the Project's ContactName field is of the form "Joe User [ACP joeuser]" ' then the 'joeuser' is the ACP web login username. The web submission forms ' create contact names like this. Othedrwise, this is "" ' acpLogin = GetAcpLoginInfo(PRJ.ContactName, cleanContact, wantsCompress) ' ' Log file and logging. Cannot use SUP.MakeFileName here as ' logging must start before SUP.Initialize(). Use local ' SafeFileName() function stolen from AcquireSupport. ' [3.0] Use "night" folder for logs, special log support ' for VOEvents and WebLog. ' If PRJ.ExternalID = "VOEvent" Then Set LFL = New PathMaker LFL.Initialize LOGPATH, FSO.GetParentFolderName(Console.Script), USR.Name, PRJ.ExternalID buf = LFL.LogPathName(OBS) Set LFL = Nothing ElseIf LCase(Left(PRJ.ExternalID, 6)) = "weblog" Then ' TODO - Template this too! buf = Prefs.WebRoot & "\logs\" & Trim(Mid(PRJ.ExternalID, 7)) & "\" & _ Util.FormatVar(obsRunDate, "yyyymmdd") & "\" & _ SafeFileName(OBS.Name) & "-" & _ Util.FormatVar(Util.SysUTCDate, "dd-mmm-yyyy@HhNnSs") Else Set LFL = New PathMaker LFL.Initialize LOGPATH, FSO.GetParentFolderName(Console.Script), USR.Name, PRJ.ExternalID buf = LFL.LogPathName(OBS) Set LFL = Nothing End If Console.LogFile = buf & ".log" Console.Logging = True ' Start logging Console.PrintLine "This is AcquireScheduler V" & SCRIPTVERSION ' Echo version of this script ' ' OK, we're rolling. Shut off AcquireNow and save our log file path ' Also, this is a convenient time to detect #trackon in the Obs.Description ' and if found, set OBS.OrbitalTracking. Then do the Update(). ' WARNING! Leave the #trackon support here even though in 8.2 the RTML IMporter ' now converts it to OBS.OrbitalTracking = True. Existing Observations may ' depend on this. ' OBS.LastSequencerLog = Console.LogFile OBS.AcquireNow = False If OBS.Planet <> "" Or OBS.Elements <> "" Then ' Only if planetaries If(InStr(LCase(OBS.Description), "#trackon") > 0) Then ' Orbital tracking requested? Console.PrintLine "Solar system object and #trackon found in Description. Will track body." OBS.OrbitalTracking = True End If End If Call OBS.Update(True) ' Full update to pick up log file ' ' Initialize the image file path/name construction engine ' Set IFL = New PathMaker Call IFL.Initialize(IMGPATH, FSO.GetParentFolderName(Console.Script), USR.Name, PRJ.ExternalID) ' ' Initialize flipping related things ' hardwarePierSide = False ' Make assumptions canExplicitlyFlip = False If Telescope.AlignmentMode = 2 Then ' If GEM PREFLIPMARGIN = -Prefs.GEMTrackPastMinutes * 60 ' Old units (sec.)/sign from new ACP7 UI/Prefs POSTFLIPMARGIN = Prefs.GEMPostFlipMargin * 60 ' Old units (sec.) from new ACP7 UI/Prefs NOMINALAFTIME = 180 ' These are no longer settable NOMINALPUTIME = 60 Console.PrintLine " [PreFlip=" & PREFLIPMARGIN & " PostFlip=" & POSTFLIPMARGIN & _ " AF=" & NOMINALAFTIME & " PU=" & NOMINALPUTIME & "]" hardwarePierSide = False canExplicitlyFlip = False On Error Resume Next z = Telescope.SideOfPier z = Telescope.DestinationSideOfPier(Telescope.RightAscension, Telescope.Declination) If Err.Number = 0 Then Console.PrintLine "Hardware GEM pier side reporting is available." hardwarePierSide = True If Telescope.CanSetPierSide Then Console.PrintLine "This mount can be flipped on command." canExplicitlyFlip = True End If End If Err.Clear On Error GoTo 0 End If If Prefs.AlwaysSolveDataImages Then Console.PrintLine "Final images will always be solved" ' ' Support library ' Set SUP = CreateObject("ACP.AcquireSupport") ' Support methods here Call SUP.Initialize() ' Do initialization (may log) If SUP.HaveReadoutModes Then normRoMode = SUP.ReadoutMode ' Capture the "normal" readout mode End If ' ' Turn off 10:1 image time compression in ACP. Scheduler ' tests are invalid with this on. ' SUP.SimImageTimeCompress = False ' ' Announce start of run ' Console.PrintLine "ACPS Observation " & obsName & "(" & OBS.Sequence + 1 & " of " & PLN.ObservationCount & ")" Console.PrintLine " (belongs to Project " & PRJ.Name & ", Plan " & planName & ")" Voice.Speak "Starting observation " & OBS.Sequence + 1 & " for plan " & planName If Telescope.CanSetTracking Then If Not Telescope.Tracking Then Console.PrintLine " (turning on sidereal tracking)" Telescope.Tracking = True End If End If On Error Resume Next ' (may not be supported) Telescope.SlewSettleTime = Prefs.SlewSettleTime ' Settling time On Error Goto 0 ' ' Set up camera stuff ' Camera.BinX = 1 Camera.BinY = 1 clearFilter = Prefs.CameraPrefs.ClearFilterNumber ' ' Set up user's parameters. Use PinPoint's default values in case the ' user has not yet visited his parameters page and stored his settings. ' The parameters come from the local user's preferences. ' If Prefs.PointingUpdates.Enabled Then Console.PrintLine "Pointing updates are enabled" Else Console.PrintLine "Pointing Updates are disabled" End If If Prefs.DisableFinalSolve Then Console.PrintLine " (final image plate solving is disabled)" Else tgtMinBrt = CDbl(Profile.GetValue("minbrt", , 0)) tgtSigma = CDbl(Profile.GetValue("sigma", , 3)) tgtCatMax = CDbl(Profile.GetValue("catmax", , 18)) End If ' ' Announce start of run ' ' ' Initialize web system status preview and thumbnail stuff ' imgRootPath = Prefs.WebRoot & "\images\" ' Thumbnail and popup always go into web image root ' Call SafeDeleteFile(previewImage) ' Zap any old preview thumbnail ' Call SafeDeleteFile(imgRootPath & LSTPNG_FILE) ' Zap any old "last image JPEG" (used by single-image web) ' Call SafeDeleteFile(imgRootPath & LSTDIM_FILE) ' Zap any old last image dims file (used by single-image web) ' ' Wait for pre-slew to complete as needed ' Call SUP.WaitForSlew() ' Make sure any pre-slew has completed ' ' Don't do this if repeating and 2nd or later repeat ' NOTE: TRACKING HAS BEEN LEFT ON IF THIS IS THE 2nd OR LATER REPEAT OF ' THIS OBS OR IF COMING IN WITH PRE-SLEW FROM PREVIOUS OBS ' If Not repeatObs Then ' ' Always calculate slewDist, whether or not we got here with a completed ' pre-slew. If the scope is already pointed at this observation's ' coordinates, then we need to calculate slewDist using the previous ' immediate's coordinates (as the slew starting point). Actually, the ' very existence of a "previous immediate" is a big hint that we might ' have pre-slewed. So if we have a previous immediate, and the scope is ' currently pointed at THIS observations' coordinates, we can be sure we ' pre-slewed and calculate slewDist then skip slewing again. We waited for ' the pre-slew above, BTW. NOTE: The RA and Dec of the previous immediate ' target will already be filled in, regardless of the target type. No need ' to use StartSlewToTarget() to calculate orbitals, etc. ' ' If we decided we didn't pre-slew, then we need to start the slew to ' the target now. For the slewDist calculation, we convert this obs' ' coordinates to local topo and compare to the telescope's current ' position (done in StartSlewToTarget()). This fills in OBS.RA and ' OBS.Dec regardless of the target type. OBS.PA doesn't change ' regardless of target type. ' ' Note that calls for slew and wait are bypassed if the scope is already ' pointed "close enough". ' Set POBS = OBS.PreviousImmediate If Not POBS Is Nothing Then ' ' Regardless of the target type, the RA/Dec have already been calculated ' slewDist = SUP.EquDist(POBS.RA, POBS.Dec, OBS.RA, OBS.Dec) Call StartSlewToTarget(OBS, True, True) ' Call for a slew anyway, just in case Else slewDist = StartSlewToTarget(OBS, True, True) ' Handles various target types End If Call SUP.WaitForSlew() ' Wait for the slew to complete. If SUP.HaveRotator Then SUP.WaitForRotator ' And for rotator slew Else slewDist = StartSlewToTarget(OBS, False, True) ' Kludge for simulator and no slew (still want Rotation) End If ' ' Do the TargetStart() user action ' If Not SUP.UserActions Is Nothing Then Console.PrintLine " Calling TargetStart user action." If Not SUP.UserActions.TargetStart(PLN, OBS, null) Then For Each IMG In IList IMG.Status = IMG_FAILED IMG.FailureReason = "User action TargetStart returned False" Call IMG.Update(True) Next Call CompleteWithFailure("**Failed - User action TargetStart returned False") Exit Sub End If End If ' ' Select the filter specified in the first ImageSet object, Or ' the Clear filter. This establishes the filter group for which ' AF and Pointing updates will be done. ' If SUP.HaveFilters Then Set IMG = IList.Item(0) ' 1st ImageSet in Observation Call SUP.SelectFilter(SUP.DecodeFilter(IMG.Filter)) ' If unknown or blank, uses Clear End If ' ' If AutoFocus requested, do it now. AutoFlip before doing it ' if needed. 4.2 -- SUP.AutoFocus() -never- does a return ' slew pointing update. So we always do it. ' bNeedPostAFPtgUpd = False ' True if we do an AF here, for PtgUpd If OBS.AutoFocus Then ' If AF requested If Prefs.AutoFocus.Enabled Then ' And enabled in ACP If Telescope.AlignmentMode = 2 Then ' Only for GEM If PREFLIPMARGIN > 0 Then z = PREFLIPMARGIN Else z = 0 ' Ignore negative PREFLIPMARGIN AutoFlipIf (NOMINALAFTIME + NOMINALPUTIME + z), OBS.Name, _ OBS.RA, TargetRARate, _ OBS.Dec, TargetDecRate, OBS.PA ' Note we add PtgUpd time here to avoid flip before post-AF update End If Call SUP.AutoFocus(OBS.RA, OBS.Dec) ' Focus now (most errors non-fatal) bNeedPostAFPtgUpd = True Else Console.PrintLine "**Autofocus requested, but it is disabled in ACP, skipped" End If End If ' ' If guiding with external guider, we can optimize out pointing updates ' based on the Max Slew w/o Pointing Update setting. Still need to check for flip! ' If Not Prefs.AutoGuiding.Enabled Or Prefs.AutoGuiding.SensorType = 0 Then ' gstExternal tooFar = (slewDist > Prefs.PointingUpdates.MaximumSlew) If Not tooFar Then Console.PrintLine " (skipping pointing update, last target close enough)" If Telescope.AlignmentMode = 2 Then ' For GEM If AutoFlipIf((IList.Item(0).ExposureInterval + PREFLIPMARGIN + NOMINALPUTIME), _ OBS.Name, OBS.RA, TargetRARate, OBS.Dec, TargetDecRate, OBS.PA) Then bPtgUpdDone = True ' Auto-flip did the plate solution End If End If End If Else tooFar = True End If ' ' Don't do this if repeating and 2nd or later repeat, but do it if we ' just did an autofocus above. ' bPtgUpdDone = False ' Assume won't do a ptg update If (Not repeatObs And tooFar) Or bNeedPostAFPtgUpd Then ' ' If need to do a pointing update, get that done now too. Check to see if ' the upcoming (first) exposure would cross the flip point, and if so, ' do the auto-flip (which will do a pointing update itself). ' If Prefs.PointingUpdates.Enabled Then If Telescope.AlignmentMode = 2 Then ' For GEM If AutoFlipIf((IList.Item(0).ExposureInterval + PREFLIPMARGIN + NOMINALPUTIME), OBS.Name, _ OBS.RA, TargetRARate, OBS.Dec, TargetDecRate, OBS.PA) Then bPtgUpdDone = True ' Auto-flip did the plate solution End If End If If Not bPtgUpdDone Then ' If didn't get ptg upd from auto-flip On Error Resume Next ' May fail on slew-back below horizon isPointing = True ' For ACP web UI (typ.) bPtgUpdDone = SUP.UpdatePointing(OBS.Name, OBS.RA, OBS.Dec, OBS.PA) ' Uses Clear or filter specified for pointing updates If Err.Number <> 0 Then bPtgUpdDone = False ' Hard error, probably horizon Console.PrintLine "**Pointing update error from " & Err.Source & _ ":" & vbCrLf & " " & Err.Description ' But LOG IT! End If isPointing = False On Error Goto 0 ' Back to fatal errors End If If Not bPtgUpdDone And Prefs.PointingUpdates.SkipOnFail Then ' If user wants targets failed on pointing failures For Each IMG In IList IMG.Status = IMG_FAILED IMG.FailureReason = "Initial target pointing update failed" Call IMG.Update(True) Next Call CompleteWithFailure("Pointing update failed. See run log.") Exit Sub ' === STOP RUN HERE === End If End If End If wantGuiding = False ' Assume won't be guiding sumExpAGFail = False ' True if "sum of exposures" AG fails below ' ' If solar system body and orbital tracking, adjust tracking rates. ' If (OBS.Planet <> "" Or OBS.Elements <> "") And OBS.OrbitalTracking Then Call SUP.SetTrackOffset(TargetRARate, TargetDecRate) End If ' ------------- ' ImageSet Loop ' ------------- ' ' Separate ImageSets normally mean filter switches. In order to accommodate ' internal guiders which might sit behind the filter, we start and stop the ' guider for each ImageSet. ' numIMG = IList.Count maxImgSet = numIMG ' For ACP web UI For i = 1 To numIMG curImgSet = i ' For ACP web UI Set IMG = IList(i - 1) imgSetName = IMG.Name ' (ditto) IMG.Status = IMG_RUNNING IMG.StartTime = Util.SysUtcDate Call IMG.Update(True) If(InStr(LCase(IMG.Description), "#nopreview") = 0) Then ' Unless suppressed in the Description previewImage = imgRootPath & THUMB_FILE ' Create the preview stuff Else Console.PrintLine " (high cadence option, no web previews)" previewImage = "" End If ' ' Select the filter. This establishes the filters to be used for ' pointing updates and AutoFocus. This logic establishes the default ' if Filters are installed, and "", 0 if not. NOTE: AcquireSuppost may ' substitute the "default" filter if the name is not known. Here, we detect ' it and fail the plan. However(!!) make the comparison caseless, as the ' filter may be the right one but withy different casing. ' If SUP.HaveFilters Then filtNum = SUP.DecodeFilter(IMG.Filter) ' If unknown or "", uses Clear filtName = SUP.FilterName(filtNum) ' Get name of above result If LCase(IMG.Filter) <> LCase(filtName) Then ' If filter changed, fail (no more VOEvent Sync) buf = "Filter " + IMG.Filter + " does not exist on this system. Cannot continue." Console.PrintLine "**Image acquisition failed due to unknown filter " + IMG.Filter IMG.Status = IMG_FAILED IMG.FailureReason = SafeErrorMessage(buf) Call IMG.UpdateStatus() Call CompleteWithFailure(buf) Exit Sub ' === STOP RUN HERE === End If Call SUP.SelectFilter(filtNum) ' And select it Else filtNum = 0 ' No filters, use #0... filtName = "" ' ...And no name End If ' ' Look for the hack that allows readout mode support (and is created by ' the ACP plan importer). This detects #ReAdOutmOdE [whatever] with any ' number of spaces after the #romode and the mode name in [] and ' may contain anything before or afer this. ' If SUP.HaveReadoutModes Then RoMode = "" Set RX = New RegExp RX.Pattern = "#romode\s+\[(.+)\]" RX.IgnoreCase = True Set Mats = RX.Execute(IMG.Description) If Mats.Count = 1 Then If Mats(0).SubMatches.Count = 1 Then RoMode = Mats(0).SubMatches(0) Console.PrintLine " Use readout mode """ & RoMode & """ for this image" End If End If If RoMode <> "" Then If Not SUP.ReadoutModeExists(RoMode) Then buf = "Readout mode " + RoMode + " does not exist on this system. Cannot continue." Console.PrintLine "**Image acquisition failed due to unknown readout mode " + RoMode IMG.Status = IMG_FAILED IMG.FailureReason = SafeErrorMessage(buf) Call IMG.UpdateStatus() Call CompleteWithFailure(buf) Exit Sub ' === STOP RUN HERE === End If SUP.ReadoutMode = SUP.DecodeReadoutMode(RoMode) Else SUP.ReadoutMode = normRoMode ' Revert to default/normal RO mode End If End If ' ' Look for the hack that allows defocus support (and is created by the ' ACP plan importer). This detects #dEfOcUs [+/-]nnnnn with any number ' of spaces after the #defocus and the integer number and may contain ' anything before or afer this. ' Defocus = 0 Set RX = New RegExp RX.Pattern = "#defocus\s+([\+\-]*\d+)" RX.IgnoreCase = True Set Mats = RX.Execute(IMG.Description) If Mats.Count = 1 Then If Mats(0).SubMatches.Count = 1 Then Defocus = 0 + Mats(0).SubMatches(0) Console.PrintLine " Defocus " & Defocus & " for this image" End If End If SUP.DefocusCount = Defocus ' ' Handle autoguider startup here because each ImageSet is almost ' certainly for a different filter. If it has failed to start ' once and the individual exposures are short enough, just let it go ' on unguided and skip this. See HandleAutoguiding(). It is not ' obvious. If it returns False it is a fatal autoguiding error. ' ' If autoguiding fails but the individual exposures are shorter than ' max unguided then it returns true but sets sumExpAGFail = true, and ' we don't try to guide again in this image set. ' ' Oops (8.1) Honor the "disable aggregation" flag in ACP Guiding Preferences. ' If Not sumExpAGFail And Not OBS.OrbitalTracking Then If Prefs.Autoguiding.DisableAggregation Then x = IMG.ExposureInterval Else x = IMG.RepeatCount * IMG.ExposureInterval End If If Not HandleAutoguiding(x, False) Then Exit Sub ' END OBSERVATION! End If ' ' ----------- ' Repeat Loop ' ----------- ' ' NOTE: It is possible that (Carlo Gualdoni) uses ImageStart to alter the ' exposure interval. Thus we need to pick up the actual image exposure times ' after acquisition and sum them for the combine (if requested). ' ' NOTE: Most of the manipulation of the image file is done on a temporary ' file, which is then moved/renamed to its final place.name. This is done ' for compatibiliy with DropBox file syncing. ' finalImgSlvFail = False ' Assume final solve will succeed sumImgExposure = 0 ' Sum actual exposures for combine imgFileList = "" ' List of image file pathnames for database maxCount = IMG.RepeatCount ' For ACP web UI For j = 1 To IMG.RepeatCount curCount = j ' For ACP web UI ' ' If this is the last image of a repeated Image, the last ImageSet in the Obs ' and the last repeat in a possibly repeated Obs, then use this flag to start a ' slew to a new location if the conditions are right (see below), and to skip ' possible recentering (the latter is a nit). ' If (j = IMG.RepeatCount) And (i = numIMG) And (OBS.SetsCompleted = OBS.SetCount - 1) Then lastImgObs = True Else lastImgObs = False End If ' ' Check to see if this image would extend past dawn. ' If CDate(Now() + (IMG.ExposureInterval / 86400)) >= nextDawn Then buf = "Image in repeat set would extend past dawn" Console.PrintLine "**Scheduler failed to catch dawn-crossing Observation" Console.PrintLine "**Stopping now for astronomical dawn" IMG.Status = IMG_FAILED IMG.FailureReason = SafeErrorMessage(buf) Call IMG.UpdateStatus() Call CompleteWithFailure(buf) Exit Sub ' === STOP RUN HERE === End If ' ' Check and do AutoFlip (See AutoFlipIf() below) ' If Telescope.AlignmentMode = 2 Then ' For GEM AutoFlipIf (IMG.ExposureInterval + PREFLIPMARGIN), OBS.Name, _ OBS.RA, TargetRARate, OBS.Dec, TargetDecRate, OBS.PA End If ' ' Build the (possibly custom) image file path/name without the .fts. ' See Class PathMaker above and the initialization of same at the ' top of Main() ' fn = IFL.ImagePathName(IMG, filtName, j) ' Full path/name fnf = fn & ".fts" bfn = FSO.GetFileName(fn) ' File name only tfn = FSO.GetSpecialFolder(2).Path & "\" & FSO.GetBaseName(FSO.GetTempName()) ' 2 = temporary folder path tfnf = tfn & ".fts" ' ------------------------ ' AcquireImage User Action ' ------------------------ ' ' Return "ok" to skip to the next target, responsible for logging errors. ' Return True to continue as though nothing happened ' Return False to cause the entire script to just stop. ' imgDoneExt = False ' Will be true if AcquireIMage did it If Not SUP.UserActions Is Nothing Then Console.PrintLine " Calling AcquireImage user action." On Error Resume Next z = CStr(SUP.UserActions.AcquireImage(PLN, OBS, IMG, fnf)) If Err.Number <> 0 Then Console.PrintLine "** Run-time error in AcquireImage() User Action:" Console.PrintLine ">> " & Err.Description z = "True" ' Probably not implemented in UserAction End If On Error GoTo 0 If z = "False" Then ' False -> stop script buf = "** User action AcquireImage returned False" Console.PrintLine buf IMG.Status = IMG_FAILED IMG.FailureReason = SafeErrorMessage(buf) Call IMG.UpdateStatus() Call CompleteWithFailure(buf) Exit Sub ' === STOP RUN HERE === ElseIf LCase(z) = "ok" Then Console.PrintLine " AcquireImage successfully completed acquisition." imgDoneExt = True ' Skip all below so can loop back for next repeat End If End If If Not imgDoneExt Then ' ' Guiding restart ' If Not sumExpAGFail Then ' Could be part of below 'If' but no short-circuits If wantGuiding And Not Camera.GuiderRunning Then If Not HandleAutoguiding(0, True) Then Exit Sub ' END OBSERVATION! End If End If ' ' If any of the three cal flags are set in IMG, do a complete ' calibration in AcquireSupport as usual. ' forceCal = (IMG.Dark Or IMG.Bias Or IMG.Flat) ' ' Look for the hack that allows subframe support (and is created by the ' ACP plan importer). This is TEMPORARY (yeah, right). This detects ' #SuBfRaMe 0.nn.. with any number of spaces after the #subframe and ' the number (which has to start with "0." or "0,") and may contain ' anyting before or afer this. ' Subframe = 1.0 Set RX = New RegExp RX.Pattern = "#subframe\s+(0+[\.\,]\d+)" RX.IgnoreCase = True Set Mats = RX.Execute(Img.Description) If Mats.Count = 1 Then If Mats(0).SubMatches.Count = 1 Then Subframe = 0 + Mats(0).SubMatches(0) Console.PrintLine " Subframe " & Subframe & " for this image" End If End If ' ' If this is the last image overall in this Observation, and if we have another ' Observation coming up and if the ACP option "Disable Slew During Image Download" ' is not set, then we can start a pre-slew to this new location. NOTE, this might ' actually be the SAME location or aclose one but we use the StartSlewToTarget() ' smarts to optimize this. In any case, while we're wrapping up below we use the ' slewNext boolean to decide whether or not to stop tracking (not is we slewed). ' If lastImgObs Then Set NOBS = OBS.NextImmediate If Not NOBS Is Nothing Then Console.PrintLine " Will pre-slew for immediately upcoming Observation " & NOBS.Name slewNext = True ' We are going to pre-slew Call StartSlewToTarget(NOBS, False, False) ' Get the next Obs coordinates nextName = NOBS.Name nextRA = TargetRA nextDec = TargetDec nextPA = NOBS.PA End If Else slewNext = False nextName = "" nextRA = 0 nextDec = 0 nextPA = 0 End If ' ' TAKE THE IMAGE (can't compress in TakePicture, may be solving) ' Note that SlewNext is not passed True unless this is the last ' image of the set. Also, the return from TakePicture will be True ' only if SlewNext was true AND if the slew was actually done. ' If the #nopreview optionm is in Description, then previewImage ' will be "" from above, and none of that will be done in ' TakePicture(). ' Console.PrintLine " Imaging to " & bfn ' ' If this is a solar system body target, the Observation name will have not only ' the leacing MP or CT, but also any BS following the # delimiter. In this case ' pass only the body name, number, or designation to TakePicture so that is ' what ends up in FITS OBJECT field. ' If OBS.Planet <> "" Then buf = OBS.Planet Else buf = OBS.Name End If On Error Resume Next Call SUP.TakePicture(IMG.ExposureInterval, IMG.Binning, Subframe, IMG.Dither, _ filtNum, tfn, previewImage, False, forceCal, False, False, USR.Name, _ buf, OBS.RA, OBS.Dec, slewNext, "", nextName, nextRA, nextDec, _ slewNext, nextPA) If Err.Number <> 0 Then buf = Err.Description ' Save across On Error Goto 0 On Error Goto 0 ' Reset errors Console.PrintLine buf ' Log the Error IMG.Status = IMG_FAILED IMG.FailureReason = SafeErrorMessage(buf) Call IMG.UpdateStatus() Call CompleteWithFailure("Imaging system failure. See run log.") Exit Sub ' === STOP RUN HERE === End If On Error Goto 0 Set plate = CreateObject("PinPoint.Plate") plate.AttachNoImage tfnf ' ' Pick up the actual exposure interval and sum for combine. ' sumImgExposure = sumImgExposure + plate.ExposureInterval ' ' If filter name is J-C, set PinPoint's CLRBAND ' If SUP.HaveFilters Then Select Case UCase(SUP.FilterName(filtNum)) Case "U": z = 0 Case "B": z = 1 Case "V": z = 2 Case "R": z = 3 Case "I": z = 4 Case Else: z = -1 End Select If z <> -1 Then plate.ColorBand = z plate.UpdateFITS End If End If plate.DetachFITS Set plate = Nothing ' ' If VOEvent run, make PNG images for VOEvent web pages ' Harshly hotpixed and stretched! ' If PRJ.ExternalID = "VOEvent" Then buf = FSO.GetParentFolderName(fn) CreateFolder(buf & "\png") Set Doc = CreateObject("MaxIm.Document") Doc.OpenFile tfnf Doc.Crop (Doc.XSize / 2) - 128, (Doc.YSize / 2) - 128, 256, 256 Doc.KernelFilter 5, 0.0 ' Hotpix, 0% thresh Doc.FlattenBackground ' Auto flatten background Doc.StretchMode = 2 ' High stretch Doc.SaveFile buf & "\png\" & FSO.GetBaseName(fn) & ".png", 7, True, 0 ' 8 bit PNG Doc.Close Set Doc = Nothing End If ' ' If first or last image of a stack, grab the exposure start ' time for the stacked image start-time calculation. ' If (IMG.RepeatCount > 1) And ((j = 1) Or (j = IMG.RepeatCount)) Then Set plate = CreateObject("PinPoint.Plate") plate.AttachNoImage tfnf ' Fast attach for FITS work only If j = 1 Then firstStart = plate.ExposureStartTime plate.DetachFITS Set plate = Nothing End If If forceCal Then ' ' If we did a calibration above, then we can honor the HotPix ' flag for the ImageSet as well. ' If IMG.HotPix Then Util.Console.PrintLine " Image calibrated, HotPix requested, removing hot pixels..." Set Doc = CreateObject("MaxIm.Document") Doc.OpenFile tfnf Util.Console.PrintLine " Applying HotPix filter..." Doc.KernelFilter 5, 0.0 ' 0% threshold hotpix Doc.SaveFile tfnf, 3, False, 3, 0 ' 32-Bit IEEE float Doc.Close Set Doc = Nothing End If End If ' ' If did autocal, AcquireSupport (probably) produced a RAW-xxx file, which is named ' the same as the working tempfile xxx. We need to move this to it's final place ' and we might as well do that now while we know that ACP AutoCal is on. ' trfnf = FSO.GetParentFolderName(tfnf) & "\RAW\RAW-" & FSO.GetFileName(tfnf) If FSO.FileExists(trfnf) Then buf = FSO.GetParentFolderName(fnf) & "\RAW" rfnf = buf & "\RAW-" & bfn & ".fts" If Not FSO.FolderExists(buf) Then FSO.CreateFolder buf Else SafeDeleteFile(rfnf) End If FSO.MoveFile trfnf, rfnf End If ' ' Create the lightbox popup for web System Status unless suppressed by directive ' Do this after any calibration so see final results ' ' SafeDeleteFile imgRootPath & THUMB_FILE ' Always delete these ' SafeDeleteFile imgRootPath & LSTPNG_FILE ' Whether or no preview ' SafeDeleteFile imgRootPath & LSTDIM_FILE ' If(InStr(LCase(IMG.Description), "#nopreview") = 0) Then ' Call CreateWebPreview(tfnf, imgRootPath) ' Else ' On Error Resume Next ' Best efforts ' FSO.CopyFile imgRootPath & NP_THUMB_FILE, imgRootPath & THUMB_FILE ' FSO.CopyFile imgRootPath & NP_LSTPNG_FILE, imgRootPath & LSTPNG_FILE ' FSO.CopyFile imgRootPath & NP_LSTDIM_FILE, imgRootPath & LSTDIM_FILE ' On Error GoTo 0 ' End If ' ' Do the final plate solve unless user has disabled this. ' Update pointing corrector ONLY IF WE DIDN'T JUST DO A POINTING UPDATE ABOVE! ' ACP will replace any mapping point within 5 deg HA/Dec with the new one, and if ' this is a long sequence, the result will be a creeping mapping point that may sweep ' through and delete several existing points. Note use of bPtgUpdDone below. ' ' If a final image fails to solve, stop trying for subsequent repeats. This will save ' considerable wasted time for images that can't be solved (for whatever reason?). ' ' WARNING: Next 2 sections nearly repeated below for stacked image! ' prevSolveFails = SUP.SolveFails ' Save current solve failure counter lastFWHM = 0 ' For SYstem Status, may not solve this... If Not Prefs.DisableFinalSolve And (InStr(LCase(IMG.Description), "#nosolve") = 0) Then If Prefs.AlwaysSolveDataImages Or Not finalImgSlvFail Then ' If no final solve failures, solve (again) Console.PrintLine " Plate-solve " & bfn & " final image." If SUP.SolvePlate(tfnf, OBS.RA, OBS.Dec, OBS.PA, (SUP.PlateScaleH * Camera.BinX), _ (SUP.PlateScaleV * Camera.BinY), tgtMinBrt, tgtSigma, _ 500, tgtCatMax, 60, (Not bPtgUpdDone), True) Then bPtgUpdDone = True ' Prevent further sync/corr-upd for this target lastFWHM = SUP.lastSolveFWHM ' For web System Status display ' ' If the pointing error is above our threshold, slew to recenter. ' If SUP.LastSolvePosErr > Prefs.PointingUpdates.MaximumError Then If Not lastImgObs Then ' Skip if ultimate last img of obs ' ' If GEM (only), avoid surprise flip on recenter ' DidFlip = False If Telescope.AlignmentMode = 2 Then If AutoFlipIf(0, OBS.Name, OBS.RA, TargetRARate, OBS.Dec, TargetDecRate, OBS.PA) Then DidFlip = True End If End If If Not DidFlip Then On Error Resume Next ' May now be below horizon SUP.RecenterTarget OBS.Name, OBS.RA, OBS.Dec ' Jog scope to recenter If Err.Number <> 0 Then On Error GoTo 0 Console.PrintLine " ** Recenter failed, ending repeat sequence" SafeDeleteFile(fnf) ' Move/rename to final place (DropBox) FSO.MoveFile tfnf, fnf Exit For End If On Error GoTo 0 End If End If Else If Not lastImgObs Then _ Console.PrintLine " Within max error tolerance, no re-slew needed." End If Else finalImgSlvFail = True ' Set flag to supress further attempts in this repeat set End If Else ' Previous final solve failed, stop trying Console.PrintLine " First image plate-solve failed, skip solves until next target." End If End If ' Final image plate solving SUP.SolveFails = prevSolveFails ' Final image plate solving doesn't count failures! SafeDeleteFile(fnf) ' Move/rename to final place (DropBox) FSO.MoveFile tfnf, fnf ' ' If user actions active, do ImageComplete() Now ' WARNING: MAY CHANGE FN!! ' If Not SUP.UserActions Is Nothing Then buf = fn ' Save for name change check below Console.PrintLine " Calling ImageComplete user action" If Not SUP.UserActions.ImageComplete(fnf) Then ' Call with full name, returns full name in fn IMG.Status = IMG_FAILED IMG.FailureReason = "User action ImageComplete returned false" Call IMG.UpdateStatus() Call CompleteWithFailure("Failed - User action ImageComplete returned False") Exit Sub End If If fn <> buf And IMG.AutoStack Then ' Name was changed and auto-stack requested IMG.AutoStack = False ' Disable auto-stack (temporarily)!! Util.Console.PrintLine " ImageComplete changed file name, auto-stacking disabled" End If End If ' ' Compress the image if configured (edit at top of script). Either way, add the ' file path/name to the list in the database (used by the web interface). ' If Len(imgFileList) > 0 Then imgFileList = imgFileList & "," If wantsCompress Then Util.CompressFile fnf, fn & ".fts.zip" FSO.DeleteFile fnf ' As requested, delete original imgFileList = imgFileList & fn & ".fts.zip" Else imgFileList = imgFileList & fnf End If IMG.ImageFileList = imgFileList ' Save these now in case failure part way through Call IMG.Update(False) ' ' On all but the very last image of this Observation, allow an additional ' 5 seconds for guider settling. It was shut off during image download. ' This should be boolean reduced, but it does speak of the intent. ' If SUP.Guiding And _ Not (i = numIMG And SUP.ExternalGuider And Not Prefs.AutoGuiding.DisableAggregation) And _ Not (j = IMG.RepeatCount And Not SUP.ExternalGuider) Then Console.PrintLine " (waiting for guider to settle...)" Util.WaitForMilliseconds 5000 End If End If ' Not imgDoneExt Next ' Repeat If SUP.Guiding And Not SUP.ExternalGuider Then ' If internal guider, prepare for filter switch SUP.AutoGuide False ' Stop guider Now End If ' ' If requested, stack and optionally align the individual images ' into one stacked image. If enabled plate solve and compress the ' stacked image. DO NOT USE IMG.RepeatCount HERE! It is possible that the ' repeat loop terminated early due to below-limits or quitTime. ' In this case, the actual number of images is (j - 1). ' tfn = IFL.ImagePathName(IMG, filtName, -1) ' Get wildcard path/name (MAY INHIBIT IMG.AutoStack!) If ((j - 1) > 1) And IMG.AutoStack Then ' Stack into one image ' ' Align and sum-stack. Use auto star match and ' bicubic interpolation. ' Console.PrintLine " Combining " & (j - 1) & " images into stacked image." On Error Resume Next Util.ScriptCamera.Document.CombineFiles tfn & ".fts", 1, True, 0, False If Err.Number = 0 Then On Error GoTo 0 ' Restore Default Error trapping ' ' Make stacked image filespec and save the stacked image ' as 32-bit FP FITS (new), no compression, Dropbox friendly. ' fnf = IFL.ImagePathName(IMG, filtName, Null) & "-STACK.fts" tfnf = FSO.GetSpecialFolder(2).Path & "\" & FSO.GetBaseName(FSO.GetTempName()) & ".fts" ' 2 = temporary folder path Util.ScriptCamera.Document.SaveFile tfnf, 3, False, 3 ' ' Set exposure start time and interval for the combined image. Interval Is ' simply the sum of the individual image intervals. Start time is the ' start time of the first exposure. ' Set plate = CreateObject("PinPoint.Plate") plate.AttachNoImage tfnf ' Fast attach for FITS work only plate.ExposureInterval = sumImgExposure ' Actual (possibly modified) sum of exposures plate.ExposureStartTime = firstStart ' Start of 1st exposure plate.UpdateFITS plate.DetachFITS Set plate = Nothing ' ' Unless the user has disabled it, plate-solve the stacked image. ' Update pointing corrector ONLY IF WE DIDN'T JUST DO A POINTING UPDATE ABOVE! ' You do not want to add 2 closely spaced obseravations, especially when ' first starting from scratch! Note use of bPtgUpdDone below. ' ' WARNING: Next 2 sections nearly repeated above for each image! ' If Not Prefs.DisableFinalSolve Then Console.PrintLine " Plate-solve final image." prevSolveFails = SUP.SolveFails ' Save current solve failure counter If SUP.SolvePlate(tfnf, OBS.RA, OBS.Dec, OBS.PA, (SUP.PlateScaleH * Camera.BinX), _ (SUP.PlateScaleV * Camera.BinY), tgtMinBrt, tgtSigma, _ 500, tgtCatMax, 60, (Not bPtgUpdDone), False) Then bPtgUpdDone = True ' Prevent further sync/corr-upd for this target End If SUP.SolveFails = prevSolveFails ' Final image platesolving doesn't count failures! End If ' Final image plate solving ' ' Move/rename tempfile to final place (Dropbox) ' SafeDeleteFile(fnf) FSO.MoveFile tfnf, fnf IMG.ImageFileList = IMG.ImageFileList & "," & fnf ' Add to file list (updated right below! Else ' Stacking failed Console.PrintLine "**Stack Error: " & Err.Description SafeDeleteFile fn & ".fts" ' Delete any old stacked files w/same name SafeDeleteFile fn & ".fts.zip" SafeDeleteFile fn & ".fts.stars" On Error Goto 0 ' Restore Default Error trapping Console.PrintLine "**MaxIm stacking failed. Original images preserved." End If End If ' Stacking IMG.Status = IMG_COMPLETED IMG.FailureReason = "" IMG.CompletionTime = Util.SysUtcDate Call IMG.Update(False) Next ' IMG ImageSet ' ' Call TargetEnd() user action ' If Not SUP.UserActions Is Nothing Then Console.PrintLine " Calling TargetEnd user action" If Not SUP.UserActions.TargetEnd(PLN, OBS, null) Then Call CompleteWithFailure("**Failed - User action TargetEnd returned False") Exit Sub End If End If If SUP.Guiding Then SUP.AutoGuide False ' Stop guider Now Elseif SUP.DoingOffsetTracking Then ' Can't have AG and TrackOffset together! Call SUP.SetTrackOffset(0.0, 0.0) ' Stop offset tracking End If OBS.Status = OBS_COMPLETED OBS.FailureReason = "" Call OBS.UpdateStatus() ' ' If this is the last set for this Observation, we either have another Observation ' in this plan or a new plan. Unless we started a pre-slew above, stop tracking. ' If OBS.SetsCompleted >= OBS.SetCount - 1 And Not slewNext Then ' Dispatcher won't have updated for this run! If Telescope.CanSetTracking Then Telescope.Tracking = False ' Stop tracking if possible End If Call ReleaseAllDB() ' Disconnect from database Call SUP.Terminate() Console.PrintLine "Run complete" Console.Logging = False End Sub ' ================= ' SUPPORT FUNCTIONS ' ================= ' ' Handle autoguiding start/restart. More later... suffice it to say that ' this sets globals wantGuiding and sumExpAGFail on an initial start. ' A restart is when the guider quits during a series where the decision ' to guide has already been made. The sumExpAGFail flag tells the Main ' logic that guiding failed for aggregate exposure length guideable but ' the individual exposures are short enough to be unguided. ' ' SIDE EFFECTS: Always sets sumExpAGFail to True if guiding fails here ' Always sets wantGuiding to True if the total exposure > min unguided ' Function HandleAutoguiding(totExp, restart) Dim sumExpAG sumExpAG = (totExp > IMG.ExposureInterval) ' True if aggregated exposures sumExpAGFail = False ' GLOBAL, RESULT OF THIS FUNCTION (grrrr) If Not restart Then wantGuiding = Prefs.AutoGuiding.Enabled And Not SUP.DoingOffsetTracking And _ totExp > Prefs.AutoGuiding.MaxUnguidedExposureInterval If Not wantGuiding Then HandleAutoguiding = True ' Success (don't need guiding) Exit Function End If If sumExpAG Then Console.PrintLine " (aggregated exposure times, trying to autoguide)" Else Console.PrintLine " (long exposure, trying to autoguide)" End If Else Console.PrintLine " (guider not running, restarting...)" SUP.AutoGuide False ' We must know it is not guiding before ptg upd If Not SUP.ExternalGuider Then ' Update pointing if internal guider Console.PrintLine " (rotated guider - attempt pointing update before guider restart)" isPointing = True ' For ACP web UI (typ) SUP.UpdatePointing OBS.Name, OBS.RA, OBS.Dec, OBS.PA isPointing = False End If End If If Not SUP.AutoGuide(True) Then If IMG.ExposureInterval > Prefs.AutoGuiding.MaxUnguidedExposureInterval Then If STRICT_AUTOGUIDING And Not PLN.BestEfforts Then IMG.Status = IMG_FAILED IMG.FailureReason = "Autoguider failed to start" Call IMG.UpdateStatus() Call CompleteWithFailure("Autoguiding. See run log.") HandleAutoguiding = False ' === STOP RUN HERE === Exit Function Else If PLN.BestEfforts Then Console.PrintLine " (**AG failed, continuing unguided as Plan is Best Efforts)" Else Console.PrintLine " (**AG failed, continuing unguided for possible passing clouds)" End If End If Else sumExpAGFail = True ' Don't keep trying in repeat Loop Console.PrintLine " (**AG failed, but individual exposure(s) can be unguided)" End If End If HandleAutoguiding = True ' Some sort of success or soft failure End Function ' --------------------- ' CompleteWithFailure() ' --------------------- ' ' Called when we're exiting the script early, with a failure ' Sub CompleteWithFailure(Reason) If SUP.DoingOffsetTracking Then ' If orbital tracking Call SUP.SetTrackOffset(0.0, 0.0) ' Stop tracking Elseif SUP.Guiding Then ' Or if guiding Call SUP.AutoGuide(False) ' Shut that off End If OBS.Status = OBS_FAILED ' Set fail status and reason OBS.FailureReason = SafeErrorMessage(Reason) Call OBS.UpdateStatus() ' Update observation status only Call ReleaseAllDB() ' Disconnect from database Call SUP.Terminate() ' Call support cleanup method If Telescope.CanSetTracking Then Telescope.Tracking = False ' Stop tracking if possible Console.Logging = False End Sub ' -------------- ' ReleaseAllDB() ' -------------- ' ' Do our best to release all objects served by DC3.Scheduler.Database so the ' assembly itself can be disposed. ' Sub ReleaseAllDB() Call DB.Disconnect() ' Disconnect from database Set DB = Nothing ' Release all of these globals Set IList = Nothing Set OBS = Nothing Set IMG = Nothing Set PLN = Nothing Set PRJ = Nothing Set USR = Nothing End Sub ' ---------------- ' TargetInLimits() ' ---------------- ' ' Check if target is CURRENTLY(!) within limits. ' Function TargetInLimits(Name, RA, Dec) On Error Resume Next ' Check slew limits Call Util.EnforceSlewLimits(RA, Dec) ' J2000 OK for this rough test If Err.Number <> 0 Then ' If this is a not usable target Console.PrintLine "**ERROR: " & Name & " failed: " & Err.Description TargetInLimits = False Else TargetInLimits = True End If On Error Goto 0 ' Should not be needed... End Function ' ------------------- ' StartSlewToTarget() ' ------------------- ' ' This reads the given Observation object (which could be a pre-slew target) ' and decides what the target coordinates are. The order of precedence is: ' ' (1) Orbital elements ' (2) Planet, Minor Planet or Comet number/name/designation ' (3) Observation Name is Deep Sky catalog name ' (4) Given RA/Dec (J2000) ' ' If (1) or (2) it also calculates the coordinate rates. If (1), (2) ' or (3) it fills in the name, type and J2000 coordinates in the database ' and updates it. Finally, it puts the coordinates and rates into ' globals, then starts the slew, unless the scope is already close enough. ' ' The test for Comet vs MP elements looks for C/ or P/ somewhere ' after column 95, and NEO ephemerides are sensed by the presence ' of a "|" somewhere in the string. ' ' NOTE: No need for error checks here, as the scheduler will have tried ' to make coordinates for all of these types already, and it failed, it ' won't even try to start this observation. Nonetheless, we raise errors ' here if there are problems... ' ' Note: This is used in the pre-slew logic to calculate the next Observation's ' target RA/Dec. Yes this could be off a bit on solar system objects. But in this ' case both doSlew and doRotate are false and we're just looking for "close" ' TargetRA and TargetDec for the pre-slew. ' ' If doSlew is false, just update the simulator if needed, This is a kludge... ' ' RETURN: Slew distance, degrees ' Function StartSlewToTarget(Observation, doSlew, doRotate) Dim name, buf, tra, tdec, RX If Observation.Elements <> "" Then ' Elements given, figure out type Set RX = New RegExp RX.Pattern = "[PCDI]-?[A-Z]?/" ' Match normal and fragmentary names ' ' Historically, we allowed truncated MPC 1-line for minor planets: the data ' after column 103 could be omitted. In order to preserve backward compatibility ' the test for Comet vs MP elements looks for C/ P/ D/ I/ or C-x P-x D-x (latter are ' comet fragment names) somewhere after column 95. ' If RX.Test(Mid(Observation.Elements, 95)) Then ' C/ P/ D/ I/ Comet If Not SUP.Comet(Observation.Elements, name, TargetRA, TargetDec, _ TargetRARate, TargetDecRate) Then _ Err.Raise 32768, "AcquireScheduler", "Bad cometary orbital elements" Observation.Type = "Comet" Elseif InStr(Observation.Elements, "|") <> 0 Then ' NEO Ephemerides If Not SUP.NEOEph(Observation.Elements, TargetRA, TargetDec, _ TargetRARate, TargetDecRate) Then _ Err.Raise 32768, "AcquireScheduler", "Bad NEO ephemerides" Observation.Type = "NEO" Else If Not SUP.MinorPlanet(Observation.Elements, name, TargetRA, TargetDec, _ TargetRARate, TargetDecRate) Then _ Err.Raise 32768, "AcquireScheduler", "Bad minor planet orbital elements" Observation.Type = "Minor Planet" End If Observation.RA = TargetRA Observation.Dec = TargetDec Call Observation.Update(True) ' Update database info ElseIf Observation.Planet <> "" Then ' Planetary/cometary name/designation If SUP.MajorPlanet(Observation.Planet, TargetRA, TargetDec, _ TargetRARate, TargetDecRate) Then Observation.Type = "Major Planet" ElseIf SUP.MinorPlanet("", Observation.Planet, TargetRA, TargetDec, _ TargetRARate, TargetDecRate) Then Observation.Type = "Minor Planet" ElseIf SUP.Comet("", Observation.Planet, TargetRA, TargetDec, _ TargetRARate, TargetDecRate) Then Observation.Type = "Comet" Else buf = "Unknown major/minor planet or comet """ & Observation.Planet & """" Observation.Status = Observation_FAILED Observation.FailureReason = buf Err.Raise 32768, "AcquireScheduler", buf ' === RAISE ERROR === End If Observation.RA = TargetRA Observation.Dec = TargetDec Call Observation.Update(True) ' Update database info ' ElseIf SUP.DeepSky(Observation.Name, TargetRA, TargetDec) Then ' Plain Deep Sky, try MiniSAC ' Observation.Type = "Deep Sky" ' Observation.RA = TargetRA ' Observation.Dec = TargetDec ' TargetRARate = 0.0 ' No movement ' TargetDecRate = 0.0 ' Call Observation.Update(True) ' Update database info Else ' Use given J2000 coordinates TargetRA = Observation.RA TargetDec = Observation.Dec TargetRARate = 0.0 ' No movement TargetDecRate = 0.0 End If ' ' If needed, convert the destination coordinates to local topo, ' then compare target to scope coordinates. If close enough, ' skip the slew. ' If Prefs.DoLocalTopo Then Call SUP.J2000ToLocalTopocentric(TargetRA, TargetDec) ' Convert destination coords to Local Topo tra = SUP.LocalTopoRA tdec = SUP.LocalTopoDec Else tra = TargetRA tdec = TargetDec End If StartSlewToTarget = SUP.EquDist(tra, tdec, Telescope.RightAscension, Telescope.Declination) If StartSlewToTarget < (Prefs.PointingUpdates.MaximumError / 60.0) Then ' within user set tolerance Console.PrintLine " (" & Observation.Name & " within tolerance, no slew needed)" If Prefs.PointingUpdates.Simulate Then ' If simulating SUP.CalcSimImageCoordinates TargetRA, TargetDec ' Calculate simulator image J2000 End If ElseIf Not doSlew Then ' If not doing slew If Prefs.PointingUpdates.Simulate Then ' If simulating SUP.CalcSimImageCoordinates TargetRA, TargetDec ' Calculate simulator image J2000 End If Else SUP.StartSlewJ2000 Observation.Name, TargetRA, TargetDec ' J2000 coordinates, just do it End If If SUP.HaveRotator and doRotate Then SUP.StartRotateToPA Observation.PA, tra ' If asked, start rotator slew (RA for pier, scope) End Function ' ----------- ' WouldFlip() WARNING! REPEATED IN ACQUIREIMAGES.VBS ' ----------- ' ' ' Test if a slew will result in a flip. This handles both "normal" flips caused by ' an east-to-west flip point crossing, as well as sub-polar west-to-east flips. ' Returns false for non-GEM. ' Function WouldFlip(RA, Dec) Dim AbsHA If Telescope.AlignmentMode <> 2 Then WouldFlip = False Exit Function End If AbsHA = Abs(Util.HourAngle12(Telescope.RightAscension)) WouldFlip = ((AbsHA < 6.0 And Not Util.GemWestOfPier And Util.IsGEMDestinationWest(RA, Dec)) Or _ (AbsHA > 6.0 And Util.GemWestOfPier And Not Util.IsGEMDestinationWest(RA, Dec))) End Function ' ------------ ' AutoFlipIf() WARNING! REPEATED IN ACQUIREIMAGES.VBS ' ------------ ' ' Given a time needed before flip, and some current state variables, ' perform an auto-flip if the time needed exceeds the time remaining ' before the mount reaches the westbound flip limit. TimeNeeded Is ' given in seconds. ' ' This checks to see of this exposure could cause the westbound flip ' limit to be crossed. If so, wait for a safety time, then issue a ' slew command to force the mount to flip. The slew command must be the ' whole fish, including CA... We test if TimeNeeded would end at or past ' TimeNeeded sec short of of westbound limit, then wait the safety interval ' plus POSTFLIPMARGIN to be sure, then do a slew to force the flip. ' ' NOTE: Because the coordinates are being bounced against the LST to get ' the HA, to avoid little holes where the flip would be missed, the target ' coordinates used in the calculations must be in local topo! ' Function AutoFlipIf(TimeNeeded, curName, curRA, curRaRate, curDec, curDecRate, curPA) Dim lRA, lDec, z, et, wf, wfs, gw, dwz, wasGuiding, wasOffsTrk, beginSideOfPier SUP.WaitForSlew ' In case called after starting a slew Call SUP.J2000ToLocalTopocentric(curRA, curDec) lRA = SUP.LocalTopoRA lDec = SUP.LocalTopoDec z = Range24(lRA - (TimeNeeded / 3600.0)) ' Flip if exposure + margin crosses flip point wf = WouldFlip(z, lDec) If Util.GemWestOfPier Then gw = "T" Else gw = "F" If Util.IsGEMDestinationWest(z, lDec) Then dwz = "T" Else dwz = "F" If wf Then wfs = "YES" Else wfs = "no" Console.PrintLine " [flip check: " & _ " Tn=" & CLng(timeNeeded) & "s" & _ " HAc=" & CLng(Util.HourAngle12(Telescope.RightAscension) * 3600.0) & "s" & _ " GW=" & gw & _ " HAz=" & CLng(Util.HourAngle12(z) * 3600.0) & "s" & _ " DWz=" & dwz & _ " WF=" & wfs & "]" If Not wf Then AutoFlipIf = False Exit Function End If wasGuiding = SUP.Guiding ' Save guiding state SUP.Autoguide False ' Stop guider for the wait wasOffsTrk = SUP.DoingOffsetTracking ' Save orbital tracking state If wasOffsTrk Then SUP.SetTrackOffset 0.0, 0.0 ' Shut it off for the wait (avoid trap if offs not supported!) Console.PrintLine " (GEM must flip before next operation)" Console.PrintLine " [FPw=" & CLng(Prefs.GEMFlipWestbound * 240) & "s" & _ " FPe=" & CLng(Prefs.GEMFlipEastbound * 240.0) & "s" & _ " HAt=" & CLng(Util.HourAngle12(lRA) * 3600.0) & "s" & _ " PFM=" & CLng(POSTFLIPMARGIN) & "s" & "]" If Not Util.GemWestOfPier Then ' Normal flip z = CLng((((Prefs.GEMFlipWestbound / 15.0) - Util.HourAngle12(lRA)) * 3600.0) + POSTFLIPMARGIN) Else ' Sub-polar flip z = CLng((((Prefs.GEMFlipEastbound / 15.0) + 12.0 - Util.HourAngle12(lRA)) * 3600.0) + POSTFLIPMARGIN) End If If z > 43200 Then z = 86400 - z ' Handle wraparound If z > 0 Then Console.PrintLine " (waiting " & z & " sec to pass flip limit)" Console.PrintLine " (wait ends at " & Util.FormatVar(CDate(CDbl(Util.SysUTCDate) + (z / 86400)), "Hh:Nn:Ss") & " UTC)" TrackOffWaitFor z ' Wait with tracking off Else Console.PrintLine " (no wait needed, already past flip limit)" End If If hardwarePierSide Then beginSideOfPier = Telescope.SideOfPier ' See Gemini hack below SUP.StartSlewJ2000 curName, curRA, curDec ' Kills guiding & orbital tracking If SUP.HaveRotator Then Console.PrintLine " (rolling rotator over 180 deg...)" SUP.StartRotateToPA curPA, curRA ' Start rotator slew End If SUP.WaitForSlew ' Wait for scope slew If SUP.HaveRotator Then SUP.WaitForRotator ' And for rotator slew ' ' The following was added for the Gemini which will sometimes (?) not flip ' despite reporting pier side and destination for the target being different. ' We have already slewed to the target coordinates. ' If canExplicitlyFlip Then ' (no short-circuit booleans) If Telescope.SideOfPier = beginSideOfPier Then ' Failed to flip! Console.PrintLine " (slew failed to flip!)" Console.PrintLine " (doing explicit flip by command...)" If Dome.Available Then Dome.Slaved = False ' Let the dome sit there for the flip If Telescope.SideOfPier = 0 Then ' Flip it (either way) Telescope.SideOfPier = 1 Else Telescope.SideOfPier = 0 End If SUP.WaitForSlew Console.PrintLine " (commanded flip complete. Re-slewing to target...)" If Dome.Available Then Dome.Slaved = True ' Re-slave so upcoming slew will slew dome SUP.StartSlewJ2000 curName, curRA, curDec ' Just in case, re-slew to target after flip SUP.WaitForSlew If Telescope.SideOfPier = beginSideOfPier Then Err.Raise &H80040001, "AcquireScheduler", _ "**Mount failed commanded pier side change or flipped back on target slew. This is a mount/driver bug." End If End If End If If Util.Prefs.PointingUpdates.Enabled Then ' Only if enabled... isPointing = True ' For ACP web UI (typ.) SUP.UpdatePointing curName, curRA, curDec, curPA isPointing = False End If If wasGuiding Then SUP.AutoGuide True ' If needed re-start guider If WasOffsTrk Then SUP.SetTrackOffset curRARate, curDecRate ' Or restore orbital tracking AutoFlipIf = True End Function ' ----------------- ' TrackOffWaitFor() ' ----------------- ' ' Waits with tracking off (if >= MINTRACKOFFSEC sec). Used in multiple places. ' Sub TrackOffWaitFor(Seconds) Dim rMsg rMsg = " (wait finished" If Seconds >= MINTRACKOFFSEC And Telescope.CanSetTracking Then Console.PrintLine " (turning tracking off)" Telescope.Tracking = False rMsg = rMsg & ", resuming tracking" End If Util.WaitForMilliseconds Seconds * 1000 If Telescope.CanSetTracking Then Console.PrintLine rMsg & ")" Telescope.Tracking = True End If End Sub ' -------------- ' CreateFolder() - Create a folder with recursion ' -------------- ' ' Also populates ASP scripts for web visible folders ' Sub CreateFolder(f) Dim p, fld, fl, fn If FSO.FolderExists(f) Then Exit Sub p = FSO.GetParentFolderName(f) If p = "" Then Err.Raise vbObjectError, "AcquireScheduler", "Creating folder: Found non-existent drive letter " & f If Not FSO.FolderExists(p) Then CreateFolder p End If FSO.CreateFolder f If acpLogin <> "" Then Set fld = FSO.GetFolder(p) For Each fl In fld.Files If LCase(FSO.GetExtensionName(fl.Name)) = "asp" Then fn = fl.Name FSO.CopyFile p & "\" & fn, f & "\" & fn End If Next End If End Sub ' ' -------------- ' SafeFileName() - Remove illegal chars for Windows filenames ' -------------- ' Function SafeFileName(TargetName) Dim rx Set rx = New RegExp rx.Global = True ' Replace throughout the string SafeFileName = TargetName ' Start with target name ' ' (1) Remove < and > completely ' rx.Pattern = "[\<\>]" SafeFileName = rx.Replace(SafeFileName, "") ' ' (2) Replace other illegal charachters with "-" ' rx.Pattern = "[\\\/\:\*\?\""\|]" SafeFileName = rx.Replace(SafeFileName, "-") Set rx = Nothing ' Not really needed but.. End Function ' ' ----------------- ' GetAcpLoginInfo() - Extract ACP web user info from Project's ContactName ' ----------------- ' ' Returns the ACP login username. Also returns the cleaned up contact name ' (without the [ACP xxxx]) via the out-parameter CleanedName, and the ' web user's compression flag via the out-parameter WantsCompress. ' Function GetAcpLoginInfo(ContactName, CleanedName, WantsCompress) Dim rx, matches Set rx = New RegExp rx.Pattern = "(.*) \[ACP (\w+)\]" Set matches = rx.Execute(ContactName) If matches.Count = 0 Then CleanedName = ContactName GetAcpLoginInfo = "" WantsCompress = False Else CleanedName = Trim(matches.Item(0).SubMatches(0)) GetAcpLoginInfo = Trim(matches.Item(0).SubMatches(1)) WantsCompress = (Right(ContactName, 2) = "]#") End If End Function ' --------- ' Range24() - Force argument into range 0 <= h < 24 ' --------- ' Function Range24(h) Range24 = h While Range24 < 0.0 Range24 = Range24 + 24.0 Wend While Range24 >= 24.0 Range24 = Range24 - 24.0 Wend End Function ' -------- ' Arccos() - Calculate arc cosine of an angle, radians ' -------- ' Function Arccos(x) If x = 1. Then Arccos = 0. ElseIf x = -1. Then Arccos = 4.*Atn(1.0) Else Arccos = 2.*Atn(1.) - Atn( x/sqr(1.-x*x) ) End If End Function ' ------------- ' SunsetOfRun() ' ------------- ' ' Compute sunset time for a run - Good to 1 minute ' ' Typically, this will converge to 1 minute within 2-3 loops. ' Since the Sun ephem produces J2000 coordinates, we use local ' MEAN sidereal time instead of APPARENT for the hour angle. ' These approximations will get us typically to within ' 0.001 degree of the target sun elevation. PLENTY CLOSE! ' ' For polar regions, use the latitude of the Artic or ' Antartic circle. This is good enough for the path subst. ' #DATENITE. ' Function SunsetOfRun() Dim JD, JDPrev, SunRA, SunDec, LMST, HA0, HA Dim SunDecRad, Lat, LatRad, KT Dim tvec, KA Set KT = CreateObject("Kepler.Ephemeris") ' Re-usable Earth ephem (reverse = Sun!) KT.BodyType = 0 ' Planet KT.Number = 3 ' EARTH Set tvec = CreateObject("NOVAS.PositionVector") Lat = Telescope.SiteLatitude If Lat > 65.0 Then Lat = 65.0 If Lat < -65.0 Then Lat = -65.0 LatRad = Lat * DEGRAD ' Latiude in radians (constant) ' ' Iteration Loop ' JD = Util.SysJulianDate ' Start with current date/Time JDPrev = JD Do KA = KT.GetPositionAndVelocity(JD) ' Get earth from sun tvec.x = -KA(0) ' Reverse cartesian vector for sun from earth tvec.y = -KA(1) tvec.z = -KA(2) SunRA = tvec.RightAscension ' J2000 coordinates of sun from earth SunDec = tvec.Declination SunDecRad = SunDec * DEGRAD HA0 = Arccos((-(Sin(LatRad) * Sin(SunDecRad))) / _ (Cos(LatRad) * Cos(SunDecRad))) / DEGRAD LMST = Util.Julian_GMST(JD) + (Telescope.SiteLongitude / 15.0) ' LOCAL MEAN Sidereal Time HA = Util.HourAngle12(SunRA, LMST) ' Local hour angle of sun at JD (SIGN REVERSE, ACP BUG) JD = JD + (((HA0 / 15.0) - HA) / 24.0) If HA < 0 Then ' If after local high noon JD = JD - 1 ' Back up to prev sunset Elseif Abs(JD - JDPrev) < 0.0006944 Then Exit Do ' Convergence = 1 Minute End If JDPrev = JD Loop SunsetOfRun = Util.Julian_Date(JD) ' Local time of run's sunset End Function ' ---------------------- ' NextAstronomicalDawn() ' ---------------------- ' ' Compute the time of the next astronomical dawn ' ' Typically, this will converge to 1 minute within 2-3 loops. ' Since the Sun ephem produces J2000 coordinates, we use local ' MEAN sidereal time instead of APPARENT for the hour angle. ' These approximations will get us typically to within ' 0.001 degree of the target sun elevation. PLENTY CLOSE! ' Function NextAstronomicalDawn(SunEl) Dim JD, JDPrev, SunRA, SunDec, LMST, HA Dim SunDecRad, LatRad, H0Rad Dim tvec, KA, KT Set KT = CreateObject("Kepler.Ephemeris") ' Re-usable Earth ephem (reverse = Sun!) KT.BodyType = 0 ' Planet KT.Number = 3 ' EARTH Set tvec = CreateObject("NOVAS.PositionVector") LatRad = Telescope.SiteLatitude * DEGRAD ' Latiude in radians (constant) H0Rad = SunEl * DEGRAD ' Target altitude radians (constant) ' ' Iteration Loop ' JD = Util.SysJulianDate ' Start with current date/Time JDPrev = JD Do KA = KT.GetPositionAndVelocity(JD) ' Get earth from sun tvec.x = -KA(0) ' Reverse cartesian vector for sun from earth tvec.y = -KA(1) tvec.z = -KA(2) SunRA = tvec.RightAscension ' J2000 coordinates of sun from earth SunDec = tvec.Declination SunDecRad = SunDec * DEGRAD HA = -Arccos((Sin(H0Rad) - (Sin(LatRad) * Sin(SunDecRad))) / _ (Cos(LatRad) * Cos(SunDecRad))) / DEGRAD LMST = Util.Julian_GMST(JD) + (Telescope.SiteLongitude / 15) ' LOCAL MEAN Sidereal Time JD = JD + (((HA / 15.0) - Util.HourAngle12(SunRA, LMST)) / 24.0) If Util.SysJulianDate > JD Then JD = JD + 1 Elseif Abs(JD - JDPrev) < 0.0000115741 Then Exit Do ' Convergence = 1 Second End If JDPrev = JD Loop NextAstronomicalDawn = Util.Julian_Date(JD) ' Local time of next dawn End Function ' ------------------ ' CreateWebPreview() - Make web PNG preview ' ------------------ ' ' Scale appropriately and also create a dimensions file For ' the lightbox display in the web UI. ASSUMES OLD FILES HAVE ' ALREADY BEEN DELETED! ' Sub CreateWebPreview(ImageFile, imgRootPath) Dim Doc, PScale, xSize, ySize, dStrm ' ' First the 128x128 thumbnail ' Set Doc = CreateObject("MaxIm.Document") Doc.OpenFile ImageFile ' -- added beautify -- Doc.KernelFilter 5, 20 Doc.DDP 0, true, true, 0, 0, 100 Doc.RemoveGradient ' -------------------- ' Crosshatch avoidance - Emulate 'ciel' function (typ.) PScale = Fix(Doc.XSize / 128) + 1 If Doc.XSize >= 128 And CInt(Doc.XSize / 128) = Doc.XSize / 128 Then PScale = PScale - 1 ' Catch edge condition If PScale < 1 Then PScale = 1 Doc.Resize (Doc.XSize / PScale), (Doc.YSize / PScale) Doc.SaveFile imgRootPath + THUMB_FILE, 7, True, 0 ' Scaled, 8-bits/pix, PNG On Error Resume Next Doc.Close ' Close for MaxIm V4 only On Error Goto 0 Util.WaitForMilliseconds 500 ' [BUG/WORKAROUND] See 25-Oct-2004 edit track ' ' Now for the 1024x1024 or whatever ' Set Doc = CreateObject("MaxIm.Document") Doc.OpenFile ImageFile ' -- added beautify -- Doc.KernelFilter 5, 20 Doc.DDP 0, true, true, 0, 0, 100 Doc.RemoveGradient ' -------------------- PScale = Fix(Doc.XSize / 1024) + 1 If Doc.XSize >= 1024 And CInt(Doc.XSize / 1024) = Doc.XSize / 1024 Then PScale = PScale - 1 ' Catch edge condition If PScale < 1 Then PScale = 1 xSize = Fix(Doc.XSize / PScale) ' For the dims file ySize = Fix(Doc.YSize / PScale) Doc.Resize xSize, ySize Doc.SaveFile imgRootPath + LSTPNG_FILE, 7, True, 0 ' Scaled, 8-bits/pix, PNG On Error Resume Next Doc.Close ' Close for MaxIm V4 only On Error Goto 0 Util.WaitForMilliseconds 500 ' [BUG/WORKAROUND] See 25-Oct-2004 edit track ' ' And finally the text file with the dimensions (for lightbox) ' Set dStrm = FSO.CreateTextFile(imgRootPath + LSTDIM_FILE, True) ' Make new preview dimensions file dStrm.WriteLine xSize ' Dims one per line dStrm.WriteLine ySize dStrm.Close End Sub ' ---------------- ' SafeDeleteFile() - Delete a file whether it exists or not ' ---------------- Sub SafeDeleteFile(f) On Error Resume Next FSO.DeleteFile f End Sub ' ------------------ ' SafeErrorMessage() - Return message shortened to fit in string field of database ' ------------------ Function SafeErrorMessage(msg) SafeErrorMessage = msg If Len(SafeErrorMessage) > 254 Then SafeErrorMessage = Left(SafeErrorMessage, 250) & "..." End Function