diff options
Diffstat (limited to 'pkg/utilities/nttools/gtedit')
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gtdelete.x | 360 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gtdodel.x | 41 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gtedit.key | 25 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gthinfo.x | 69 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gtplot.x | 501 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gtrdxycol.x | 50 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gtupdate.x | 36 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gtwrdata.x | 90 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/gtwrhead.x | 47 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/mkpkg | 19 | ||||
| -rw-r--r-- | pkg/utilities/nttools/gtedit/t_gtedit.x | 184 |
11 files changed, 1422 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/gtedit/gtdelete.x b/pkg/utilities/nttools/gtedit/gtdelete.x new file mode 100644 index 00000000..c09f6a96 --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gtdelete.x @@ -0,0 +1,360 @@ +include <mach.h> +include <gset.h> +include <gio.h> + +define MSIZE 2.0 + +# GT_DELPT -- Mark a point as deleted + +procedure gt_delpt (gd, wx, wy, x, y, npix, deleted, undelete) + +pointer gd # Graphics descriptor +real wx # Cursor position +real wy # "" +real x[ARB] # Plotted data +real y[ARB] # Plotted data +int npix # # of pixels +int deleted[ARB] # Array of delete indicators +int undelete # Undelete flag + +int row, i +real r2min, r2, x0, y0 + +begin + # Search for the nearest point which has not been deleted + + row = 0 + r2min = MAX_REAL + + # Transform world cursor coordintes to NDC + call gctran (gd, wx, wy, wx, wy, 1, 0) + do i = 1 , npix { + if ((deleted[i] == YES && undelete == NO) || + (deleted[i] == NO && undelete == YES)) + next + + call gctran (gd, x[i], y[i], x0, y0, 1, 0) + if (x[i] < INDEFR && y[i] < INDEFR) + r2 = (wx - x0) ** 2 + (wy - y0) ** 2 + else + r2 = MAX_REAL + + if (r2 < r2min) { + r2min = r2 + row = i + } + } + + if (row != 0) { + # Mark row as being deleted + if (undelete == NO) { + # Plot X over point + call gscur (gd, x[row], y[row]) + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[row], y[row], GM_CROSS, MSIZE, MSIZE) + deleted[row] = YES + } else { + deleted[row] = NO + call gscur (gd, x[row], y[row]) + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, x[row], y[row], GM_CROSS, MSIZE, MSIZE) + } + + } + +end + +# GT_DYGT -- Delete all point > input Y + +procedure gt_dygt (gd, wy, x, y, npix, deleted, undelete) + +pointer gd # Graphics descriptor +real wy # Cursor position +real x[ARB] # Plotted data +real y[ARB] # Plotted data +int npix # # of pixels +int deleted[ARB] # Array of delete indicators +int undelete + +int i + +begin + # Search for points with Y values > than the critical value + + do i = 1 , npix { + if ((deleted[i] == YES && undelete == NO) || + (deleted[i] == NO && undelete == YES)) + next + + if (y[i] > wy) { + if (undelete == NO) { + # Plot X over point + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + deleted[i] = YES + } else { + deleted[i] = NO + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } + } + } +end + +# GT_DYLT -- Delete all point < input Y + +procedure gt_dylt (gd, wy, x, y, npix, deleted, undelete) + +pointer gd # Graphics descriptor +real wy # Cursor position +real x[ARB] # Plotted data +real y[ARB] # Plotted data +int npix # # of pixels +int deleted[ARB] # Array of delete indicators +int undelete + +int i + +begin + # Search for points with Y values > than the critical value + + do i = 1 , npix { + if ((deleted[i] == YES && undelete == NO) || + (deleted[i] == NO && undelete == YES)) + next + + if (y[i] < wy) { + if (undelete == NO) { + deleted[i] = YES + # Plot X over point + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } else { + deleted[i] = NO + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } + } + } +end + +# GT_DXGT -- Delete all point > input X + +procedure gt_dxgt (gd, wx, x, y, npix, deleted, undelete) + +pointer gd # Graphics descriptor +real wx # Cursor position +real x[ARB] # Plotted data +real y[ARB] # Plotted data +int npix # # of pixels +int deleted[ARB] # Array of delete indicators +int undelete + +int i + +begin + # Search for points with X values > than the critical value + + do i = 1 , npix { + if ((deleted[i] == YES && undelete == NO) || + (deleted[i] == NO && undelete == YES)) + next + + if (x[i] > wx) { + if (undelete == NO) { + deleted[i] = YES + # Plot X over point + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } else { + deleted[i] = NO + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } + } + } +end + +# GT_DXLT -- Delete all point > input Y + +procedure gt_dxlt (gd, wx, x, y, npix, deleted, undelete) + +pointer gd # Graphics descriptor +real wx # Cursor position +real x[ARB] # Plotted data +real y[ARB] # Plotted data +int npix # # of pixels +int deleted[ARB] # Array of delete indicators +int undelete + +int i + +begin + # Search for points with X values < than the critical value + + do i = 1 , npix { + if ((deleted[i] == YES && undelete == NO) || + (deleted[i] == NO && undelete == YES)) + next + + if (x[i] < wx) { + if (undelete == NO) { + deleted[i] = YES + # Plot X over point + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } else { + deleted[i] = NO + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } + } + } +end + +# GT_DBOX -- Delete all point in a box + +procedure gt_dbox (gd, npix, deleted, undelete, x, y, x1, y1, x2, y2) + +pointer gd # Graphics descriptor +int npix # # of pixels +int deleted[ARB] # Array of delete indicators +int undelete +real x[ARB] # Plotted data +real y[ARB] # Plotted data +real x1, y1, x2, y2 # Corners of the box + +int i +real temp + +begin + # Make sure the points are in the correct order + if (y2 < y1) { + temp = y1 + y1 = y2 + y2 = temp + } + if (x2 < x1) { + temp = x1 + x1 = x2 + x2 = temp + } + # Search for points within the box + do i = 1 , npix { + if ((deleted[i] == YES && undelete == NO) || + (deleted[i] == NO && undelete == YES)) + next + + if (x[i] <= x2 && x[i] >= x1) { + if (y[i] <= y2 && y[i] >= y1) { + if (undelete == NO) { + deleted[i] = YES + # Plot X over point + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } else { + deleted[i] = NO + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } + } + } + } +end + +# GT_DSEG -- Delete all point on one side of a line segment + +procedure gt_dseg (gd, npix, deleted, undelete, x, y, x1, y1, x2, y2, x0, y0) + +pointer gd # Graphics descriptor +int npix # # of pixels +int deleted[ARB] # Array of delete indicators +int undelete +real x[ARB] # Plotted data +real y[ARB] # Plotted data +real x1, y1, x2, y2 # Corners of the box +real x0, y0, slope, inter, temp + +int i, lessthan + +begin + # Make sure the points are in the correct order + if (y2 < y1) { + temp = y1 + y1 = y2 + y2 = temp + } + if (x2 < x1) { + temp = x1 + x1 = x2 + x2 = temp + } + + # Calculate slope and intercept + slope = (y2 - y1) / (x2 - x1) + inter = (x2 * y1 - x1 * y2) / (x2 - x1) + + # Which side should we delete the lines from? + temp = x0 * slope + inter + if (temp <= y0) + lessthan = NO + else + lessthan = YES + + # Search for points with X values between x1 and x2 + do i = 1 , npix { + if ((deleted[i] == YES && undelete == NO) || + (deleted[i] == NO && undelete == YES)) + next + + if (x[i] <= x2 && x[i] >= x1) { + # Now which side of the line does this point fall on + temp = x[i] * slope + inter + if (y[i] < temp && lessthan == YES) { + if (undelete == NO) { + deleted[i] = YES + # Plot X over point + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } else { + deleted[i] = NO + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } + } else if (y[i] > temp && lessthan == NO) { + if (undelete == NO) { + deleted[i] = YES + # Plot X over point + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } else { + deleted[i] = NO + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } + } + } + } +end + +# GT_PDEL -- Overplot crosses on those points which have been marked for zap. + +procedure gt_pdel (gd, x, y, deleted, npix) + +pointer gd +real x[ARB] +real y[ARB] +int deleted[ARB] +int npix + +int i + +begin + do i = 1, npix { + if (deleted[i] == YES) { + # Plot X over point + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, x[i], y[i], GM_CROSS, MSIZE, MSIZE) + } + } +end diff --git a/pkg/utilities/nttools/gtedit/gtdodel.x b/pkg/utilities/nttools/gtedit/gtdodel.x new file mode 100644 index 00000000..7292048c --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gtdodel.x @@ -0,0 +1,41 @@ +include <tbset.h> + +# GT_DODEL -- Actually delete the rows marked for deletion + +procedure gt_dodel (tp, tpr, deleted, npix) + +pointer tp +pointer tpr +int deleted[ARB] # io: Array of deleted flags +int npix # io: # of rows in table + +int i, j, k + +int tbpsta() + +begin + if (tpr != NULL) { + # Append to whatever is already in the table + k = tbpsta (tpr, TBL_NROWS) + do i = 1, npix { + if (deleted[i] == YES) { + k = k + 1 + call tbrcpy (tp, tpr, i, k) + } + } + } + + for (j = npix; j> 0; j = j - 1) { + if (deleted[j] == YES) { + i = j + while (deleted[i] == YES) { + i = i - 1 + if (i < 1) + break + } + i = i + 1 + call tbrdel (tp, i, j) + j = i - 1 + } + } +end diff --git a/pkg/utilities/nttools/gtedit/gtedit.key b/pkg/utilities/nttools/gtedit/gtedit.key new file mode 100644 index 00000000..2a51e584 --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gtedit.key @@ -0,0 +1,25 @@ + GTEDIT Interactive Cursor Commands + +? Print options +: Colon commands +a print out the complete row for the data point nearest the cursor +b delete all points with Y values less than the cursor Y position +c mark the corner of a box +d delete the point nearest the cursor +e exit and save changes in the output table +f make all the marked deletions and replot remaining data +h print out the column names of the input table +l delete all points with X values less than the cursor Y position +p replot the graph possibly using new data columns +q quit and do not save changes made since the last 'f' +r delete all points with X values greater than the cursor Y position +s mark one end of a line segment +t delete all points with Y values greater than the cursor Y position +u toggle between delete and undelete mode +v change from gtedit to tedit mode +z display current status (delete or undelete) + +:x(-) xcolumn set the table column for the X axis and possibly replot +:y(-) ycolumn set the table column for the Y axis and possibly replot + +- do not automatically replot after reading in new column diff --git a/pkg/utilities/nttools/gtedit/gthinfo.x b/pkg/utilities/nttools/gtedit/gthinfo.x new file mode 100644 index 00000000..dbc3d345 --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gthinfo.x @@ -0,0 +1,69 @@ +include <error.h> +include <ctype.h> +include <fset.h> # FIO +include <tbset.h> # TBtables + +# GT_HINFO -- Get the title and axes labels for the plot + +procedure gt_hinfo (tp, xlabel, ylabel, xcolumn, ycolumn, maxch) + +pointer tp # Table pointer +char xlabel[SZ_LINE] # Axis label strings (output) +char ylabel[SZ_LINE] # Axis label strings (output) +char xcolumn[SZ_COLNAME] # X column +char ycolumn[SZ_COLNAME] # Y column +int maxch + +char colunit[SZ_COLUNITS] +char errmsg[SZ_LINE] # Error message +pointer xcd, ycd + +int strlen() +bool streq() + +begin + # Single table; X and Y column + + if (!streq (xcolumn, NULL)) { + call tbcfnd (tp, xcolumn, xcd, 1) + if (xcd <= 0) { + call sprintf (errmsg, SZ_LINE, "Cannot find column %s") + call pargstr (xcolumn) + call error (0, errmsg) + } + # X axis label comes from column name + call sprintf (xlabel, maxch, "%s") + call pargstr (xcolumn) + } else { + call sprintf (xlabel, maxch, "%s") + call pargstr ("Number") + } + + # Find the column units + call tbcigt (xcd, TBL_COL_UNITS, colunit, SZ_COLUNITS) + if (colunit[1] != EOS) { + # Column units exist; append to X label + call sprintf (xlabel[strlen (xlabel)+1], maxch, " [%s]") + call pargstr (colunit) + } + + call tbcfnd (tp, ycolumn, ycd, 1) + if (ycd <= 0) { + call sprintf (errmsg, SZ_LINE, "Cannot find column %s") + call pargstr (ycolumn) + call error (0, errmsg) + } + + # Y label comes from column name + call sprintf (ylabel, maxch, "%s") + call pargstr (ycolumn) + + # Find the column units + call tbcigt (ycd, TBL_COL_UNITS, colunit, SZ_COLUNITS) + if (colunit[1] != EOS) { + # Column units exist; append to Y label + call sprintf (ylabel[strlen (ylabel)+1], maxch, " [%s]") + call pargstr (colunit) + } + +end diff --git a/pkg/utilities/nttools/gtedit/gtplot.x b/pkg/utilities/nttools/gtedit/gtplot.x new file mode 100644 index 00000000..160ed978 --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gtplot.x @@ -0,0 +1,501 @@ +include <xwhen.h> +include <config.h> +include <mach.h> +include <error.h> +include <ctype.h> +include <fset.h> # FIO +include <gset.h> # GIO +include <tbset.h> # TBtables + +define HELPFILE "tables$pkg/ttools/gtedit/gtedit.key" # (BPS 05.31.94) +define GT_QUIT 0 +define GT_EXIT 1 + +procedure gteplot (device, input, tp, tpr, deleted, xcolumn, ycolumn, x, y, + size, null, npix, table_name, status) + +char device[SZ_FNAME] # Graphics device +char input[SZ_FNAME] # Input table name +pointer tp # Table descriptor +pointer tpr # Reject Table descriptor +pointer deleted # Pointer for array of delete flags +char xcolumn[SZ_COLNAME] # X column in table +char ycolumn[SZ_COLNAME] # Y column in table +pointer x +pointer y +pointer size # Size of markers to plot +pointer null # +int npix # Number of points per curve +char table_name[SZ_FNAME] # Table name +int status # return status + +pointer gd +int mode, npix_save +char col_save[SZ_COLNAME] +char xlabel[SZ_LINE], ylabel[SZ_LINE] +char plotitle[2*SZ_LINE] +char marker[SZ_FNAME] +char cmd[SZ_LINE] +char bad_column[SZ_COLNAME] +bool xautoscale, yautoscale, mark_del +bool drawbox, rdmarks +bool silent, readonly, inplace, auto_replot +int xtran, ytran, ticklabels, marker_type, j, drawgrid +int wcs, key, ip +int undelete +real px, py +real wx1, wx2, wy1, wy2, szmarker, vx1, vx2, vy1, vy2 +real wb, wt, wl, wr +real tol, xx, yy, sz +real x1, y1, x2, y2 +pointer sp, system_id, errmsg + +string bell "\007" +define replot_ 91 +define next_ 92 + +pointer gopen() +bool clgetb() +int strncmp() +int clgeti(), gstati() +int clgcur() +real clgetr() +pointer tbtopn() +errchk clgetb, clgeti, clgstr, clgetr, glabax, gpmark +errchk gswind, gseti, gascale, grscale + +begin + call smark (sp) + call salloc (system_id, SZ_LINE, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + mode = NEW_FILE + mark_del = false + undelete = NO + + # Get the marker character to be drawn at + # each point. The size of the character is given by szmarker. If + # zero and the input operadd is a list, marker sizes are taken + # individually from the third column of each list element. If + # negative, all markers are of size |szmarker| in NDC. If + # positive and the input operand is a list, the size of a marker + # is the third column of each list element times szmarker. + + szmarker = 0.0 + rdmarks = false + + # Draw markers only + call clgstr ("marker", marker, SZ_FNAME) + call init_mark2 (marker, marker_type) + if (marker_type != GM_POINT) { + szmarker = clgetr ("szmarker") + rdmarks = (szmarker <= 0) + } + + gd = gopen (device, mode, STDGRAPH) + + call gsetr (gd, G_PLWIDTH, 2.0) + + tol = 10.0 * EPSILONR + xautoscale = false + yautoscale = false + + # Set window and viewport. If user window has not been set, enable + # autoscaling. If device viewport has not been set, let glabax + # handle the viewport internally. + + call gclear (gd) + wx1 = clgetr ("wx1") + wx2 = clgetr ("wx2") + wy1 = clgetr ("wy1") + wy2 = clgetr ("wy2") + + if (abs (wx2 - wx1) < tol) + xautoscale = true + if (abs (wy2 - wy1) < tol) + yautoscale = true + + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + + if ((abs (vx2 - vx1) > tol) && (abs (vy2 - vy1) > tol)) + call gsview (gd, vx1, vx2, vy1, vy2) + + if (!clgetb ("fill")) + call gseti (gd, G_ASPECT, 1) + + if (clgetb ("round")) + call gseti (gd, G_ROUND, YES) + +replot_ + # Draw box around plot? + drawbox = false + if (mode != APPEND) + if (clgetb ("box")) + drawbox = true + + if (drawbox) { + # Get number of major and minor tick marks. + call gseti (gd, G_XNMAJOR, clgeti ("majrx")) + call gseti (gd, G_XNMINOR, clgeti ("minrx")) + call gseti (gd, G_YNMAJOR, clgeti ("majry")) + call gseti (gd, G_YNMINOR, clgeti ("minry")) + + # Fetch labels and plot title string. + + call clgstr ("xlabel", xlabel, SZ_LINE) + call clgstr ("ylabel", ylabel, SZ_LINE) + + call gt_hinfo (tp, xlabel, ylabel, xcolumn, ycolumn, SZ_LINE) + + # Label tick marks on axes? + ticklabels = NO + if (clgetb ("ticklabels")) + ticklabels = YES + + # Draw grid ? + drawgrid = NO + if (clgetb ("grid")) + drawgrid = YES + + call gseti (gd, G_DRAWGRID, drawgrid) + } + + # Log scale? Call gswind to set log scaling regardless of whether + # the user window is known; if the user window was not input, + # autoscaling will reset it later. + + if (mode == APPEND) { + xtran = gstati (gd, G_XTRAN) + ytran = gstati (gd, G_YTRAN) + call ggwind (gd, wx1, wx2, wy1, wy2) + } else { + xtran = GW_LINEAR + if (clgetb ("logx")) + xtran = GW_LOG + ytran = GW_LINEAR + if (clgetb ("logy")) + ytran = GW_LOG + call gswind (gd, wx1, wx2, wy1, wy2) + call gseti (gd, G_XTRAN, xtran) + call gseti (gd, G_YTRAN, ytran) + } + + # Autoscale if enabled. + if (xautoscale) { + call gascale (gd, Memr[x], npix, 1) + } + call ggwind (gd, wl, wr, wb, wt) + + if (yautoscale) { + # Overplot multiple curves on the same viewport + call gascale (gd, Memr[y], npix, 2) + } + + if (drawbox) { + # Draw box around plot + call gseti (gd, G_LABELTICKS, ticklabels) + # Overplot multiple curves on the same viewport + call strcpy ("", plotitle, SZ_FNAME) + call glabax (gd, plotitle, xlabel, ylabel) + } + + # Markers at each point with no connection + if (rdmarks) { + # Variable marker sizes + if (szmarker < 0) + # World coordinate marker sizes + call amulkr (Memr[size], -szmarker, Memr[size], + npix) + do j = 1, npix { # For each point in the curve + xx = Memr[x+j-1] + yy = Memr[y+j-1] + sz = Memr[size+j-1] + call gmark (gd, xx, yy, marker_type, sz, sz) + } + } else { + call gpmark (gd, Memr[x], Memr[y],npix, marker_type, + szmarker, szmarker) + } + + # We have plotted things so now is the time to let the user + # do his thing. + + # Over plot crosses for those points which have been deleted + if (mark_del) { + call gt_pdel (gd, Memr[x], Memr[y], Memr[deleted], npix) + mark_del = false + } + +next_ + while (clgcur ("commands", px, py, wcs, key, cmd, SZ_LINE) + != EOF) { + + switch (key) { + + # Quit and do not make changes + case 'q': + status = GT_QUIT + break + + # Exit and do the changes + case 'e': + status = GT_EXIT + break + + # Help page + case '?': + if (gd == NULL) + call pagefile (HELPFILE, "") + else + call gpagefile (gd, HELPFILE, "") + + # Simply replot (may have new columns) + case 'p': + call gclear (gd) + mark_del = true + goto replot_ + + # Mark the corners of a box and delete the points within + case 'c': + x1 = px; y1 = py + call gmark (gd, x1, y1, GM_DIAMOND, 1., 1.) + call printf ("again:") + if (clgcur ("commands", px, py, wcs, key, cmd, SZ_LINE) == EOF) + goto next_ + + call gt_dbox (gd, npix, Memi[deleted], undelete, Memr[x], + Memr[y], x1, y1, px, py) + + # Mark the end points of a line segment and delete points on + # one side of this segment (indicated by user) for points with + # X values between x1 and x2 + case 's': + x1 = px; y1 = py + call gmark (gd, x1, y1, GM_DIAMOND, 1., 1.) + call printf ("again:") + if (clgcur ("commands", px, py, wcs, key, cmd, SZ_LINE) == EOF) + goto next_ + x2 = px + y2 = py + call gmark (gd, x1, y1, GM_DIAMOND, 1., 1.) + call gline (gd, x1, y1, x2, y2) + call printf ("Move cursor to one side of line and hit any key") + if (clgcur ("commands", px, py, wcs, key, cmd, SZ_LINE) == EOF) + goto next_ + + call gt_dseg (gd, npix, Memi[deleted], undelete, Memr[x], + Memr[y], x1, y1, x2, y2, px, py) + + # Update graph (delete points and replot) + case 'f': + call gt_update (tp, tpr, Memr[x], Memr[y], Memi[deleted], npix) + call gclear (gd) + goto replot_ + + # Print out the complete record for this point + case 'a': + call gt_wrdata (gd, tp, px, py, Memr[x], Memr[y], npix) + + # Print out the column names + case 'h': + call gt_wrhead (gd, tp) + + # Delete a point + case 'd': + call gt_delpt (gd,px, py, Memr[x], Memr[y], npix, + Memi[deleted], undelete) + + # Undelete a point + case 'u': + if (undelete == YES) { + undelete = NO + call printf ("Now deleting points\n") + } else { + undelete = YES + call printf ("Now undeleting points\n") + } + + # Revert to normal table editor + case 'v': + silent = false + readonly = false + inplace = false + + # First update the table + call gt_update (tp, tpr, Memr[x], Memr[y], Memi[deleted], npix) + call tbtclo (tp) + call gdeactivate (gd, 0) + call edit (table_name, " ", silent, readonly, inplace) + + # Now read in the data (which may have been edited + npix_save = npix + tp = tbtopn (table_name, READ_WRITE, NULL) + call gt_rdxycol (tp, xcolumn, ycolumn, x, y, size, null, npix, + bad_column) + if (npix < 0) { + npix = npix_save + call printf ("Cannot find column %s") + call pargstr (bad_column) + } + call greactivate (gd, AW_PAUSE) + call gclear (gd) + goto replot_ + + # Undelete status + case 'z': + if (undelete == NO) { + call printf ("Currently deleting points\n") + } else { + call printf ("Currently undeleting points\n") + } + + # Delete points > Y + case 't': + call gt_dygt (gd, py, Memr[x], Memr[y], npix, + Memi[deleted], undelete) + + # Delete points < Y + case 'b': + call gt_dylt (gd, py, Memr[x], Memr[y], npix, + Memi[deleted], undelete) + + # Delete points > X + case 'r': + call gt_dxgt (gd, px, Memr[x], Memr[y], npix, + Memi[deleted], undelete) + + # Delete points < X + case 'l': + call gt_dxlt (gd, px, Memr[x], Memr[y], npix, + Memi[deleted], undelete) + + # Colon commands: + case ':': + # Command mode + for (ip=1; IS_WHITE (cmd[ip]); ip = ip + 1) + ; + + switch (cmd[ip]) { + case 'x': + # Read in a new X column + ip = ip + 1 + auto_replot = true + if (strncmp (cmd[ip], "-", 1) == 0) { + ip = ip + 1 + auto_replot = false + } + call amovc (xcolumn, col_save, SZ_COLNAME) + call ctowrd (cmd, ip, xcolumn, SZ_FNAME) + npix_save = npix + call gt_rdxycol (tp, xcolumn, ycolumn, x, y, size, null, + npix, bad_column) + if (npix < 0) { + npix = npix_save + call gdeactivate (gd, 0) + call printf ("Cannot find column %s") + call pargstr (bad_column) + call greactivate (gd, 0) + call amovc (col_save, xcolumn, SZ_COLNAME) + } + if (auto_replot) { + call gclear (gd) + mark_del = true + goto replot_ + } + + case 'y': + # Read in a new Y column + ip = ip + 1 + auto_replot = true + if (strncmp (cmd[ip], "-", 1) == 0) { + ip = ip + 1 + auto_replot = false + } + call amovc (ycolumn, col_save, SZ_COLNAME) + call ctowrd (cmd, ip, ycolumn, SZ_FNAME) + npix_save = npix + call gt_rdxycol (tp, xcolumn, ycolumn, x, y, + size, null, npix, bad_column) + if (npix < 0) { + call gdeactivate (gd, 0) + npix = npix_save + call printf ("Cannot find column %s") + call pargstr (bad_column) + call greactivate (gd, 0) + call amovc (col_save, ycolumn, SZ_COLNAME) + } + if (auto_replot) { + call gclear (gd) + mark_del = true + goto replot_ + } + + default: + call printf (bell) + + } + + default: + call printf (bell) + + } + } + call sfree (sp) + call gclose (gd) +end + +# TGR_ONINT2 -- Interrupt handler for the task graph. Branches back to ZSVJMP +# in the main routine to permit shutdown without an error message. + +procedure tgr_onint2 (vex, next_handler) + +int vex # Virtual exception +int next_handler # not used + +int tgrjmp[LEN_JUMPBUF] +common /tgrcom/ tgrjmp + +begin + call xer_reset() + call zdojmp (tgrjmp, vex) +end + + +# INIT_MARK2 -- Returns integers code for marker type string. + +procedure init_mark2 (marker, imark) + +char marker[SZ_FNAME] # Marker type as a string +int imark # Integer code for marker - returned + +bool streq() + +begin + if (streq (marker, "point")) + imark = GM_POINT + else if (streq (marker, "box")) + imark = GM_BOX + else if (streq (marker, "plus")) + imark = GM_PLUS + else if (streq (marker, "cross")) + imark = GM_CROSS + else if (streq (marker, "circle")) + imark = GM_CIRCLE + else if (streq (marker, "hebar")) + imark = GM_HEBAR + else if (streq (marker, "vebar")) + imark = GM_VEBAR + else if (streq (marker, "hline")) + imark = GM_HLINE + else if (streq (marker, "vline")) + imark = GM_VLINE + else if (streq (marker, "diamond")) + imark = GM_DIAMOND + else { + call eprintf ("Unrecognized marker type, using 'box'\n") + imark = GM_BOX + } +end diff --git a/pkg/utilities/nttools/gtedit/gtrdxycol.x b/pkg/utilities/nttools/gtedit/gtrdxycol.x new file mode 100644 index 00000000..8bf47f98 --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gtrdxycol.x @@ -0,0 +1,50 @@ +include <error.h> +include <tbset.h> + +# GT_RDXYCOL -- read X and Y plot data from two column of the same table + +procedure gt_rdxycol (tp, xcolumn, ycolumn, x, y, size, null, numrows, bad_column) + +pointer tp # Table descriptor +char xcolumn[SZ_COLNAME], ycolumn[SZ_COLNAME] # Column names +pointer x, y, size # Pointers to x, y and size vectors +int numrows # number of pixels or rows in the table +char bad_column[SZ_COLNAME] # Return bad column name + +pointer xcdp, ycdp # Pointers to column descriptors +pointer null # Pointer to null +int numcols +int i + +int tbpsta() +bool streq() + +begin + numcols = 1 + numrows = tbpsta (tp, TBL_NROWS) + call aclrc (bad_column, SZ_COLNAME) + + if (streq (xcolumn, NULL)) { + do i = 1, numrows + Memr[x + i - 1] = float(i) + } else { + call tbcfnd (tp, xcolumn, xcdp, numcols) + if (xcdp <= 0) { + numrows = -1 + call amovc (xcolumn, bad_column, SZ_COLNAME) + return + } + call tbcgtr (tp, xcdp, Memr[x], Memb[null], 1, numrows) + } + + call tbcfnd (tp, ycolumn, ycdp, numcols) + if (ycdp <= 0) { + numrows = -1 + call amovc (ycolumn, bad_column, SZ_COLNAME) + return + } + + call tbcgtr (tp, ycdp, Memr[y], Memb[null], 1, numrows) + + return +end diff --git a/pkg/utilities/nttools/gtedit/gtupdate.x b/pkg/utilities/nttools/gtedit/gtupdate.x new file mode 100644 index 00000000..7308c38f --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gtupdate.x @@ -0,0 +1,36 @@ +# GT_UPDATE -- Delete points currently marked for deletion and update data + +procedure gt_update (tp, tpr, x, y, deleted, npix) + +pointer tp, tpr +real x[ARB] +real y[ARB] +int npix +int deleted[ARB] + +int i, j, ndelete + +begin + # Delete the points + call gt_dodel (tp, tpr, deleted, npix) + + # Update data arrays j = 0 + ndelete = 0 + for (i = 1; i <= npix; i = i + 1) { + j = j + 1 + if (deleted[i] == YES) { + ndelete = ndelete + 1 + i = i + 1 + while (deleted[i] == YES) { + ndelete = ndelete + 1 + i = i + 1 + } + } + x[j] = x[i] + y[j] = y[i] + } + + call aclri (deleted, npix) + npix = npix - ndelete +end + diff --git a/pkg/utilities/nttools/gtedit/gtwrdata.x b/pkg/utilities/nttools/gtedit/gtwrdata.x new file mode 100644 index 00000000..bc0022e2 --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gtwrdata.x @@ -0,0 +1,90 @@ +include <mach.h> +include <gset.h> +include <tbset.h> + +# GT_WRDATA -- Write out the complete table record for this point + +procedure gt_wrdata (gd, tp, wx, wy, x, y, npix) + +pointer gd # Graphics descriptor +pointer tp # Table descriptor +real wx # Cursor position +real wy # "" +real x[ARB] # Plotted data +real y[ARB] # Plotted data +int npix # # of pixels + +pointer sp +pointer cname, cunits, cfmt # pointers to scratch space for column info +pointer ctext, cp +int row, i, colnum, datatype, lendata, lenfmt, ncols +int ip +real r2min, r2, x0, y0 + +pointer tbpsta(), tbcnum() + +begin + # Allocate some space + call smark (sp) + call salloc (cname, SZ_LINE, TY_CHAR) + call salloc (cunits, SZ_LINE, TY_CHAR) + call salloc (cfmt, SZ_COLFMT, TY_CHAR) + call salloc (ctext, SZ_LINE, TY_CHAR) + + # Search for the nearest point + row = 0 + r2min = MAX_REAL + + # Transform world cursor coordintes to NDC + call gctran (gd, wx, wy, wx, wy, 1, 0) + do i = 1 , npix { + call gctran (gd, x[i], y[i], x0, y0, 1, 0) + if (x[i] < INDEFR && y[i] < INDEFR) + r2 = (wx - x0) ** 2 + (wy - y0) ** 2 + else + r2 = MAX_REAL + + if (r2 < r2min) { + r2min = r2 + row = i + } + } + + if (row != 0) { + # Deactivate the workstation + call gdeactivate (gd, 0) + # Now get the info on the columns + ncols = tbpsta (tp, TBL_NCOLS) + + call printf ("\n") + do i = 1, ncols { + cp = tbcnum (tp, i) + call tbcinf (cp, + colnum, Memc[cname], Memc[cunits], Memc[cfmt], + datatype, lendata, lenfmt) + + # Print column units (ignore trailing blanks) + # (calling sequence of inquotes modified by PEH on 13 Jan 1995) + call inquotes (Memc[cunits], Memc[cunits], SZ_LINE, NO) + call printf (" %-14s ") + call pargstr (Memc[cunits]) + + # Print column name (and include trailing blanks) + call inquotes (Memc[cname], Memc[cname], SZ_LINE, YES) + call printf ("%-16s ") + call pargstr (Memc[cname]) + + #Print column value + # Modified by by PEH, 9 Sept 1994: + # remove case statement, and skip leading blanks. + call tbegtt (tp, cp, row, Memc[ctext], SZ_LINE) + ip = 0 + while (Memc[ctext+ip] == ' ') + ip = ip + 1 + call printf ("%s\n") + call pargstr (Memc[ctext+ip]) + } + } + call greactivate (gd, AW_PAUSE) + call sfree (sp) +end diff --git a/pkg/utilities/nttools/gtedit/gtwrhead.x b/pkg/utilities/nttools/gtedit/gtwrhead.x new file mode 100644 index 00000000..2b941be4 --- /dev/null +++ b/pkg/utilities/nttools/gtedit/gtwrhead.x @@ -0,0 +1,47 @@ +include <gset.h> +include <tbset.h> + +# GT_WRHEAD -- Write out the column names of the table + +procedure gt_wrhead (gd, tp) + +pointer gd # Graphics descriptor +pointer tp # Table descriptor + +pointer sp +pointer cname, cunits, cfmt # pointers to scratch space for column info +pointer ctext, cp +int i, colnum, datatype, lendata, lenfmt, ncols + +pointer tbpsta(), tbcnum() + +begin + # Allocate some space + call smark (sp) + call salloc (cname, SZ_LINE, TY_CHAR) + call salloc (cunits, SZ_LINE, TY_CHAR) + call salloc (cfmt, SZ_COLFMT, TY_CHAR) + call salloc (ctext, SZ_LINE, TY_CHAR) + + # Deactivate the workstation + call gdeactivate (gd, 0) + # Now get the info on the columns + ncols = tbpsta (tp, TBL_NCOLS) + + call printf ("Column names:\n\n") + do i = 1, ncols { + cp = tbcnum (tp, i) + call tbcinf (cp, + colnum, Memc[cname], Memc[cunits], Memc[cfmt], + datatype, lendata, lenfmt) + + # Print column name (and include trailing blanks) + # (calling sequence of inquotes modified by PEH on 13 Jan 1995) + call inquotes (Memc[cname], Memc[cname], SZ_LINE, YES) + call printf ("%-16s \n") + call pargstr (Memc[cname]) + + } + call greactivate (gd, AW_PAUSE) + call sfree (sp) +end diff --git a/pkg/utilities/nttools/gtedit/mkpkg b/pkg/utilities/nttools/gtedit/mkpkg new file mode 100644 index 00000000..6c58f092 --- /dev/null +++ b/pkg/utilities/nttools/gtedit/mkpkg @@ -0,0 +1,19 @@ +# GTEDIT task +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + gtdelete.x <gio.h> + gtdodel.x <tbset.h> + gthinfo.x <tbset.h> + gtplot.x <config.h> <ctype.h> <error.h> <fset.h> <gset.h> \ + <imhdr.h> <mach.h> <xwhen.h> <tbset.h> + gtrdxycol.x <error.h> <tbset.h> + gtupdate.x + gtwrdata.x <gset.h> <tbset.h> + gtwrhead.x <gset.h> <tbset.h> + t_gtedit.x <config.h> <ctype.h> <error.h> \ + <imhdr.h> <mach.h> <xwhen.h> <tbset.h> + ; diff --git a/pkg/utilities/nttools/gtedit/t_gtedit.x b/pkg/utilities/nttools/gtedit/t_gtedit.x new file mode 100644 index 00000000..dc1b105d --- /dev/null +++ b/pkg/utilities/nttools/gtedit/t_gtedit.x @@ -0,0 +1,184 @@ +include <xwhen.h> +include <config.h> +include <imhdr.h> +include <mach.h> +include <error.h> +include <ctype.h> +include <fio.h> +include <fset.h> +include <tbset.h> # TBtables + +define GT_QUIT 0 +define GT_EXIT 1 + +# GTEDIT -- Interactive STSDAS Table editor. + +procedure t_gtedit() + +pointer input # Name of input table +pointer device +pointer xcolumn # Name of column for X +pointer ycolumn # Name of column for Y +pointer output +pointer reject +pointer scrname +bool inplace + +pointer x, y, null, size, sp, tp, deleted, tpr +pointer errmsg, bad_column +int npix +int window # note: this is apparently not used +int phu_copied # set by tbfpri and ignored +int tgrjmp[LEN_JUMPBUF], epa, old_onint, status +bool do_delete, do_quit + +bool clgetb() +int fstati(), scan(), strncmp(), tbpsta() +pointer tbtopn() +extern tgr_onint2() +data window /0/ +common /tgrcom/ tgrjmp + +begin + if (fstati (STDOUT, F_REDIR) == NO) + call fseti (STDOUT, F_FLUSHNL, YES) + + # Initialize curve pointers to NULL, in case ggplot aborts without + # allocating any buffers. + x = NULL + y = NULL + size = NULL + npix = NULL + + # Get some Memory + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (xcolumn, SZ_FNAME, TY_CHAR) + call salloc (ycolumn, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (reject, SZ_FNAME, TY_CHAR) + call salloc (scrname, SZ_FNAME, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + call salloc (bad_column, SZ_COLNAME, TY_CHAR) + call aclrc (Memc[reject], SZ_FNAME) + call aclrc (Memc[output], SZ_FNAME) + + call clgstr ("input", Memc[input], SZ_FNAME) + + # Fetch plotting parameters. + call clgstr ("device", Memc[device], SZ_FNAME) + + # Get column names etc. + call clgstr ("xcolumn", Memc[xcolumn], SZ_FNAME) + call clgstr ("ycolumn", Memc[ycolumn], SZ_FNAME) + inplace = clgetb ("inplace") # modified by PEH 13-Jul-92 + + # Do we need to get the output file name + if (!inplace) { + call clgstr ("output", Memc[output], SZ_FNAME) + if (strncmp (Memc[output], "", 1) == 0) { + call clpstr ("gtedit.output.p_mode", "q") + call clgstr ("output", Memc[output], SZ_FNAME) + call clpstr ("gtedit.output.p_mode", "h") + } + } + call clgstr ("reject", Memc[reject], SZ_FNAME) + + if (inplace) { + # Copy the name of the table to scrname and open it by that name + call strcpy (Memc[input], Memc[scrname], SZ_FNAME) + tp = tbtopn (Memc[scrname], READ_WRITE, 0) + } else { + # Copy the table to the output and work on the output. + # The call to fcopy was replaced by tbtcpy by PEH on 8-Nov-1993. + # The call to tbfpri was added by PEH on 8-Apr-1999. + call tbfpri (Memc[input], Memc[output], phu_copied) + call tbtcpy (Memc[input], Memc[output]) + tp = tbtopn (Memc[output], READ_WRITE, 0) + } + + # Number of rows + npix = tbpsta (tp, TBL_NROWS) + iferr { + call malloc (x, npix, TY_REAL) + call malloc (y, npix, TY_REAL) + call malloc (size, npix, TY_REAL) + call malloc (null, npix, TY_REAL) + } then + call erract (EA_FATAL) + + + # Open reject table if required + tpr = NULL + if (Memc[reject] != EOS) { + tpr = tbtopn (Memc[reject], NEW_COPY, tp) + call tbtcre (tpr) + call tbhcal (tp, tpr) + } + + # Install interrupt exception handler. + call zlocpr (tgr_onint2, epa) + call xwhen (X_INT, epa, old_onint) + + call zsvjmp (tgrjmp, status) + if (status == OK) { + # Fetch remaining params and draw the plot. + call gt_rdxycol (tp, Memc[xcolumn], Memc[ycolumn], x, y, size, + null, npix, Memc[bad_column]) + + # Exit if no column + if (npix < 0) { + call sprintf (Memc[errmsg], SZ_LINE, "Cannot find column %s") + call pargstr (Memc[bad_column]) + call error (0, Memc[errmsg]) + } + # Now allocate space for the deleted array + call salloc (deleted, npix, TY_INT) + call aclri (Memi[deleted], npix) + + call gteplot (Memc[device], Memc[input], tp, tpr, deleted, + Memc[xcolumn], Memc[ycolumn], x, y, size, null, npix, + Memc[input], status) + } + + if (status == GT_EXIT) { + + # Actually delete the rows and save rejects (if requested) + call printf ("Please confirm update of output table [y/n]: ") + call flush (STDOUT) + if (scan() == EOF) + call gt_dodel (tp, tpr, Memi[deleted], npix) + else { + call gargb (do_delete) + if (do_delete) + call gt_dodel (tp, tpr, Memi[deleted], npix) + } + } else if (status == GT_QUIT) { + + call printf ( + "Please confirm quit with NO update of output table [y/n]: ") + call flush (STDOUT) + do_quit = false # bug fix from Doug Tody, 22-Jan-1993 + if (scan() != EOF) + call gargb (do_quit) + if (!do_quit) + call gt_dodel (tp, tpr, Memi[deleted], npix) + } else if (status == ERR) + call fseti (STDOUT, F_CANCEL, OK) + + # Close table + call tbtclo (tp) + if (tpr != NULL) + call tbtclo (tpr) + + # Return buffer space whether or not an error occurs while plotting. + + call mfree (x, TY_REAL) + call mfree (y, TY_REAL) + call mfree (size, TY_REAL) + call mfree (null, TY_REAL) + + call sfree (sp) + +end |