aboutsummaryrefslogtreecommitdiff
path: root/pkg/images/immatch/src/linmatch/rgliscale.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/images/immatch/src/linmatch/rgliscale.x')
-rw-r--r--pkg/images/immatch/src/linmatch/rgliscale.x593
1 files changed, 593 insertions, 0 deletions
diff --git a/pkg/images/immatch/src/linmatch/rgliscale.x b/pkg/images/immatch/src/linmatch/rgliscale.x
new file mode 100644
index 00000000..e760c7f8
--- /dev/null
+++ b/pkg/images/immatch/src/linmatch/rgliscale.x
@@ -0,0 +1,593 @@
+include <gset.h>
+include <imhdr.h>
+include <ctype.h>
+include "linmatch.h"
+
+# Define the help files.
+define HELPFILE "immatch$src/linmatch/linmatch.key"
+
+# RG_LISCALE -- Scale the output image interactively.
+
+int procedure rg_liscale (imr, im1, im2, db, dformat, reglist, rpfd, ipfd, sfd,
+ ls, gd, id)
+
+pointer imr #I/O pointer to the reference image
+pointer im1 #I/O pointer to the input image
+pointer im2 #I/O pointer to the output image
+pointer db #I/O pointer to the database file
+int dformat #I is the scale file in database format
+pointer reglist #I/O the regions list descriptor
+int rpfd #I/O the reference photometry file descriptor
+int ipfd #I/O the input photometry file descriptor
+int sfd #I/O the shifts file descriptor
+pointer ls #I pointer to the linmatch structure
+pointer gd #I the graphics stream pointer
+pointer id #I display stream pointer
+
+int i, newref, newimage, newfit, newavg, newplot, plottype, wcs, key, reg
+int hplot, lplot, lplot_type
+pointer sp, cmd, udelete, stat
+real bscale, bzero, bserr, bzerr, wx, wy
+int rg_lstati(), rg_lplot(), clgcur(), rg_lgqverify(), rg_lgtverify()
+int rg_ldelete(), rg_lfind(), rg_mmhplot(), rg_rifplot(), rg_rirplot()
+int rg_lregions()
+pointer rg_lstatp()
+
+begin
+ call gdeactivate (gd, 0)
+
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+ call salloc (udelete, rg_lstati(ls, MAXNREGIONS), TY_INT)
+
+ # Initialize the fitting.
+ newref = YES
+ newimage = YES
+ newfit = YES
+ newavg = YES
+
+ # Initialize the plotting.
+ switch (rg_lstati(ls, BZALGORITHM)) {
+ case LS_MEAN, LS_MEDIAN, LS_MODE:
+ if (rg_lstati (ls, NREGIONS) > 1)
+ plottype = LS_MMFIT
+ else
+ plottype = LS_MMHIST
+ case LS_FIT:
+ if (rg_lstati (ls, NREGIONS) > 1)
+ plottype = LS_BSZFIT
+ else
+ plottype = LS_RIFIT
+ case LS_PHOTOMETRY:
+ plottype = LS_BSZFIT
+ default:
+ }
+ switch (rg_lstati(ls, BSALGORITHM)) {
+ case LS_MEAN, LS_MEDIAN, LS_MODE:
+ if (rg_lstati (ls, NREGIONS) > 1)
+ plottype = LS_MMFIT
+ else
+ plottype = LS_MMHIST
+ case LS_FIT:
+ if (rg_lstati (ls, NREGIONS) > 1)
+ plottype = LS_BSZFIT
+ else
+ plottype = LS_RIFIT
+ case LS_PHOTOMETRY:
+ plottype = LS_BSZFIT
+ default:
+ }
+
+ # Do the initial fit.
+ if (rg_lstati (ls, NREGIONS) <= 0) {
+ call gclear (gd)
+ call gflush (gd)
+ bscale = 1.0; bzero = 0.0
+ bserr = INDEFR; bzerr = INDEFR
+ call printf ("The regions/photometry list is empty\n")
+ } else {
+ call amovki (LS_NO, Memi[rg_lstatp(ls,RDELETE)], rg_lstati(ls,
+ NREGIONS))
+ call rg_scale (imr, im1, ls, bscale, bzero, bserr, bzerr, YES)
+ call amovki (NO, Memi[udelete], rg_lstati(ls,NREGIONS))
+ if (rg_lplot (gd, imr, im1, ls, Memi[udelete], 1, bscale, bzero,
+ plottype) == OK) {
+ newref = NO
+ newimage = NO
+ newfit = NO
+ newavg = NO
+ call rg_lpwrec (ls, 0)
+ } else {
+ call gclear (gd)
+ call gflush (gd)
+ call rg_lstats (ls, IMAGE, Memc[cmd], SZ_FNAME)
+ call printf ("Error computing scale factors for image %s\n")
+ call pargstr (Memc[cmd])
+ }
+ }
+ newplot = NO
+
+ # Loop over the cursor commands.
+ while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE) !=
+ EOF) {
+
+ switch (key) {
+
+ # Print the help page.
+ case '?':
+ call gpagefile (gd, HELPFILE, "")
+
+ # Quit the task gracefully.
+ case 'q':
+ if (rg_lgqverify ("linmatch", db, dformat, ls,
+ key) == YES) {
+ call sfree (sp)
+ return (rg_lgtverify (key))
+ }
+
+ # Refit the data.
+ case 'f':
+ if (newref == YES || newimage == YES || newfit == YES ||
+ newavg == YES) {
+ if (rg_lstati(ls, BSALGORITHM) != LS_PHOTOMETRY &&
+ rg_lstati(ls, BZALGORITHM) != LS_PHOTOMETRY) {
+ if (newref == YES) {
+ if (rg_lregions (reglist, imr, ls, 1, YES) > 0)
+ ;
+ } else if (newimage == YES) {
+ call rg_lindefr (ls)
+ }
+ }
+ if (newfit == YES)
+ call amovki (LS_NO, Memi[rg_lstatp(ls,RDELETE)],
+ rg_lstati(ls,NREGIONS))
+ else if (newavg == YES) {
+ do i = 1, rg_lstati(ls,NREGIONS) {
+ if (Memi[rg_lstatp(ls,RDELETE)+i-1] ==
+ LS_DELETED || Memi[rg_lstatp(ls,
+ RDELETE)+i-1] == LS_BADSIGMA)
+ Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_NO
+ }
+
+ }
+ do i = 1, rg_lstati(ls,NREGIONS) {
+ if (Memi[udelete+i-1] == YES)
+ Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_DELETED
+ }
+ if (newfit == YES)
+ call rg_scale (imr, im1, ls, bscale, bzero, bserr,
+ bzerr, YES)
+ else if (newavg == YES)
+ call rg_scale (imr, im1, ls, bscale, bzero, bserr,
+ bzerr, NO)
+ newref = NO
+ newimage = NO
+ newfit = NO
+ newavg = NO
+ newplot = YES
+ }
+
+ # Plot the default graph.
+ case 'g':
+ switch (rg_lstati(ls, BZALGORITHM)) {
+ case LS_MEAN, LS_MEDIAN, LS_MODE:
+ if (rg_lstati (ls, NREGIONS) > 1) {
+ if (plottype != LS_MMFIT)
+ newplot = YES
+ plottype = LS_MMFIT
+ } else {
+ if (plottype != LS_MMHIST)
+ newplot = YES
+ plottype = LS_MMHIST
+ }
+ case LS_FIT:
+ if (rg_lstati (ls, NREGIONS) > 1) {
+ if (plottype != LS_BSZFIT)
+ newplot = YES
+ plottype = LS_BSZFIT
+ } else {
+ if (plottype != LS_RIFIT)
+ newplot = YES
+ plottype = LS_RIFIT
+ }
+ case LS_PHOTOMETRY:
+ if (plottype != LS_BSZFIT)
+ newplot = YES
+ plottype = LS_BSZFIT
+ default:
+ }
+ switch (rg_lstati(ls, BSALGORITHM)) {
+ case LS_MEAN, LS_MEDIAN, LS_MODE:
+ if (rg_lstati (ls, NREGIONS) > 1) {
+ if (plottype != LS_MMFIT)
+ newplot = YES
+ plottype = LS_MMFIT
+ } else {
+ if (plottype != LS_MMHIST)
+ newplot = YES
+ plottype = LS_MMHIST
+ }
+ case LS_FIT:
+ if (rg_lstati (ls, NREGIONS) > 1) {
+ if (plottype != LS_BSZFIT)
+ plottype = LS_BSZFIT
+ } else {
+ if (plottype != LS_RIFIT)
+ plottype = LS_RIFIT
+ }
+ case LS_PHOTOMETRY:
+ if (plottype != LS_BSZFIT)
+ newplot = YES
+ plottype = LS_BSZFIT
+ default:
+ }
+
+ # Graph the residuals from the current fit.
+ case 'i':
+ switch (rg_lstati(ls, BZALGORITHM)) {
+ case LS_MEAN, LS_MEDIAN, LS_MODE:
+ if (rg_lstati (ls, NREGIONS) > 1) {
+ if (plottype != LS_MMRESID)
+ newplot = YES
+ plottype = LS_MMRESID
+ } else {
+ call printf (
+ "There are too few regions for a residuals plot\n")
+ }
+ case LS_FIT:
+ if (rg_lstati (ls, NREGIONS) > 1) {
+ if (plottype != LS_BSZRESID)
+ newplot = YES
+ plottype = LS_BSZRESID
+ } else {
+ if (plottype != LS_RIRESID)
+ newplot = YES
+ plottype = LS_RIRESID
+ }
+ case LS_PHOTOMETRY:
+ if (plottype == LS_BSZFIT) {
+ newplot = YES
+ plottype = LS_BSZRESID
+ } else if (plottype == LS_MAGSKYFIT) {
+ newplot = YES
+ plottype = LS_MAGSKYRESID
+ }
+ default:
+ }
+ switch (rg_lstati(ls, BSALGORITHM)) {
+ case LS_MEAN, LS_MEDIAN, LS_MODE:
+ if (rg_lstati (ls, NREGIONS) > 1) {
+ if (plottype != LS_MMRESID)
+ newplot = YES
+ plottype = LS_MMRESID
+ } else {
+ call printf (
+ "There are too few regions for a residuals plot\n")
+ }
+ case LS_FIT:
+ if (rg_lstati (ls, NREGIONS) > 1) {
+ if (plottype != LS_BSZRESID)
+ newplot = YES
+ plottype = LS_BSZRESID
+ } else {
+ if (plottype != LS_RIRESID)
+ newplot = YES
+ plottype = LS_RIRESID
+ }
+ case LS_PHOTOMETRY:
+ if (plottype == LS_BSZFIT) {
+ newplot = YES
+ plottype = LS_BSZRESID
+ } else if (plottype == LS_MAGSKYFIT) {
+ newplot = YES
+ plottype = LS_MAGSKYRESID
+ }
+ default:
+ }
+
+ # Plot the histogram and show the statistics of a given region.
+ # selected from a plot.
+ case 's':
+ if (imr != NULL && im1 != NULL) {
+ reg = rg_lfind (gd, ls, wcs, wx, wy, bscale, bzero,
+ plottype)
+ if (reg > 0) {
+ if (rg_mmhplot (gd, imr, im1, ls, Memi[udelete],
+ reg) == OK) {
+ call rg_lpwrec (ls, reg)
+ } else {
+ call printf (
+ "Unable to plot statistics for region %d\n")
+ call pargi (reg)
+ }
+ } else
+ call printf ("Unable to plot region statistics\n")
+ } else
+ call printf (
+ "The reference or input image is undefined\n")
+
+ # Trace the fit of a given region selected from a plot.
+ case 't':
+ if (imr != NULL && im1 != NULL && (rg_lstati(ls,
+ BSALGORITHM) == LS_FIT || rg_lstati(ls,BZALGORITHM) ==
+ LS_FIT)) {
+ reg = rg_lfind (gd, ls, wcs, wx, wy, bscale, bzero,
+ plottype)
+ if (reg > 0) {
+ if (plottype == LS_BSZFIT)
+ stat = rg_rifplot (gd, imr, im1, ls,
+ Memi[udelete], reg)
+ else if (plottype == LS_BSZRESID)
+ stat = rg_rirplot (gd, imr, im1, ls,
+ Memi[udelete], reg)
+ else
+ stat = ERR
+ if (stat == OK)
+ call rg_lpwrec (ls, reg)
+ else {
+ call printf (
+ "Unable to plot statistics for region %d\n")
+ call pargi (reg)
+ }
+ } else
+ call printf (
+ "Unable to plot region statistics\n")
+ } else
+ call printf (
+ "The least squares fit is undefined\n")
+
+ # Plot the statistics and show the histograms for each
+ # region in turn.
+ case 'h':
+ if (imr != NULL && im1 != NULL) {
+ reg = 1
+ if (rg_mmhplot (gd, imr, im1, ls, Memi[udelete],
+ reg) == ERR) {
+ call printf (
+ "Unable to plot statistics for region 1\n")
+ next
+ }
+ hplot = NO
+ call printf (
+ "Hit [spbar=next,-=prev,s=stats,?=help,q=quit]:")
+ while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd],
+ SZ_LINE) != EOF) {
+ switch (key) {
+ case '?':
+ call printf (
+ "Hit [spbar=next,-=prev,s=stats,?=help,q=quit]:")
+ case 'q':
+ call printf ("\n")
+ break
+ case ' ':
+ if (reg < rg_lstati (ls, NREGIONS)) {
+ reg = reg + 1
+ hplot = YES
+ }
+ case '-':
+ if (reg > 1) {
+ reg = reg - 1
+ hplot = YES
+ }
+ case 's':
+ call rg_lpwrec (ls, reg)
+ }
+ if (hplot == YES) {
+ if (rg_mmhplot (gd, imr, im1, ls,
+ Memi[udelete], reg) == ERR)
+ ;
+ call printf (
+ "Hit [spbar=next,-=prev,s=stats,?=help,q=quit]:")
+ hplot = NO
+ }
+ }
+ newplot = YES
+ } else
+ call printf (
+ "The reference or input image is undefined\n")
+
+ # Step through the least sqares fits one at a time.
+ case 'l':
+ if (imr != NULL && im1 != NULL && (rg_lstati(ls,
+ BSALGORITHM) == LS_FIT || rg_lstati(ls,BZALGORITHM) ==
+ LS_FIT)) {
+ reg = 1
+ lplot = NO
+ if (plottype == LS_BSZFIT || plottype == LS_RIFIT)
+ lplot_type = LS_RIFIT
+ else if (plottype == LS_BSZRESID || plottype ==
+ LS_RIRESID)
+ lplot_type = LS_RIRESID
+ if (lplot_type == LS_RIFIT)
+ stat = rg_rifplot (gd, imr, im1, ls, Memi[udelete],
+ reg)
+ else if (lplot_type == LS_RIRESID)
+ stat = rg_rirplot (gd, imr, im1, ls, Memi[udelete],
+ reg)
+ else
+ stat = ERR
+ if (stat == ERR) {
+ call printf ("Unable to plot fits for region 1\n")
+ next
+ }
+ call printf (
+ "Hit [spbar=next,-=prev,l=fit,i=resid,s=stats,?=help,q=quit]:")
+ while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd],
+ SZ_LINE) != EOF) {
+ switch (key) {
+ case '?':
+ call printf (
+ "Hit [spbar=next,-=prev,l=fit,i=resid,s=stats,?=help,q=quit]:")
+ case 'q':
+ call printf ("\n")
+ break
+ case ' ':
+ if (reg < rg_lstati (ls, NREGIONS)) {
+ reg = reg + 1
+ lplot = YES
+ }
+ case '-':
+ if (reg > 1) {
+ reg = reg - 1
+ lplot = YES
+ }
+ case 'l':
+ if (lplot_type == LS_RIRESID)
+ lplot = YES
+ lplot_type = LS_RIFIT
+ case 'i':
+ if (lplot_type == LS_RIFIT)
+ lplot = YES
+ lplot_type = LS_RIRESID
+ case 's':
+ call rg_lpwrec (ls, reg)
+ }
+ if (lplot == YES) {
+ if (lplot_type == LS_RIFIT)
+ stat = rg_rifplot (gd, imr, im1, ls,
+ Memi[udelete], reg)
+ else if (lplot_type == LS_RIRESID)
+ stat = rg_rirplot (gd, imr, im1, ls,
+ Memi[udelete], reg)
+ call printf (
+ "Hit [spbar=next,-=prev,l=fit,i=resid,s=stats,?=help,q=quit]:")
+ lplot = NO
+ }
+ }
+ newplot = YES
+ } else
+ call printf (
+ "The least squares fit is undefined\n")
+
+ # Plot the photometry
+ case 'p':
+ if (rg_lstati(ls,BSALGORITHM) == LS_PHOTOMETRY ||
+ rg_lstati(ls,BZALGORITHM) == LS_PHOTOMETRY) {
+ plottype = LS_MAGSKYFIT
+ newplot = YES
+ } else
+ call printf ("The input photometry is undefined\n")
+
+ # Replot the current graph.
+ case 'r':
+ newplot = YES
+
+ # Delete or undelete a region.
+ case 'd', 'u':
+ if (key == 'd')
+ reg = rg_ldelete (gd, ls, Memi[udelete], wcs, wx, wy,
+ bscale, bzero, plottype, YES)
+ else
+ reg = rg_ldelete (gd, ls, Memi[udelete], wcs, wx, wy,
+ bscale, bzero, plottype, NO)
+ if (reg > 0)
+ newavg = YES
+
+
+ # Process colon commands.
+ case ':':
+ call rg_lcolon (gd, ls, imr, im1, im2, db, dformat,
+ reglist, rpfd, ipfd, sfd, Memc[cmd], newref,
+ newimage, newfit, newavg)
+
+ # Write the parameters to the parameter file.
+ case 'w':
+ call rg_plpars (ls)
+
+ # Do nothing gracefully.
+ default:
+ }
+
+ if (newplot == YES) {
+ if (rg_lstati(ls,NREGIONS) <= 0) {
+ call gclear (gd)
+ call gflush (gd)
+ bscale = 1.0; bzero = 0.0
+ bserr = INDEFR; bzerr = INDEFR
+ call printf ("The regions/photometry list is empty\n")
+ } else if (newref == YES || newimage == YES) {
+ call printf ("Bscale and bzero must be recomputed\n")
+ } else if (rg_lplot (gd, imr, im1, ls, Memi[udelete], 1,
+ bscale, bzero, plottype) == OK) {
+ if (newfit == YES || newavg == YES)
+ call printf ("Bscale and bzero should be recomputed\n")
+ else
+ call rg_lpwrec (ls, 0)
+ newplot = NO
+ } else
+ call printf ("Unable to plot image data for region 1\n")
+ }
+
+ }
+
+ call sfree (sp)
+end
+
+define QUERY "Hit [return=continue, n=next image, q=quit, w=quit and update parameters]: "
+
+# RG_LGQVERIFY -- Print a message on the status line asking the user if they
+# really want to quit, returning YES if they really want to quit, NO otherwise.
+
+int procedure rg_lgqverify (task, db, dformat, rg, ch)
+
+char task[ARB] #I the calling task name
+pointer db #I pointer to the shifts database file
+int dformat #I is the shifts file in database format
+pointer rg #I pointer to the task structure
+int ch #I the input keystroke command
+
+int wcs, stat
+pointer sp, cmd
+real wx, wy
+bool streq()
+int clgcur()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Print the status line query in reverse video and get the keystroke.
+ call printf (QUERY)
+ #call flush (STDOUT)
+ if (clgcur ("gcommands", wx, wy, wcs, ch, Memc[cmd], SZ_LINE) == EOF)
+ ;
+
+ # Process the command.
+ if (ch == 'q') {
+ call rg_lwrec (db, dformat, rg)
+ stat = YES
+ } else if (ch == 'w') {
+ call rg_lwrec (db, dformat, rg)
+ if (streq ("linmatch", task))
+ call rg_plpars (rg)
+ stat = YES
+ } else if (ch == 'n') {
+ call rg_lwrec (db, dformat, rg)
+ stat = YES
+ } else {
+ stat = NO
+ }
+
+ call sfree (sp)
+ return (stat)
+end
+
+
+# RG_LGTVERIFY -- Verify whether or not the user truly wishes to quit the
+# task.
+
+int procedure rg_lgtverify (ch)
+
+int ch #I the input keystroke command
+
+begin
+ if (ch == 'q') {
+ return (YES)
+ } else if (ch == 'w') {
+ return (YES)
+ } else if (ch == 'n') {
+ return (NO)
+ } else {
+ return (NO)
+ }
+end
generated by cgit (git 2.34.1) at 2025-09-20 09:25:22 -0400