# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. include include include include # WL_IMD_VIEWPORT -- Map the viewport and window of the image display. procedure wl_imd_viewport (frame, im, c1, c2, l1, l2, vl, vr, vb, vt) int frame # I: display frame to be overlayed pointer im # I: pointer to the input image real c1, c2, l1, l2 # I/O: input/output window real vl, vr, vb, vt # I/O: input/output viewport int wcs_status, dim1, dim2, step1, step2 pointer sp, frimage, frim, iw real x1, x2, y1, y2, fx1, fx2, fy1, fy2, junkx, junky real vx1, vx2, vy1, vy2, nx1, nx2, ny1, ny2 pointer imd_mapframe(), iw_open() begin # If all of the viewport parameters were defined by the user # use the default viewport and window. if (! IS_INDEFR(vl) && ! IS_INDEFR(vr) && ! IS_INDEFR(vb) && ! IS_INDEFR(vt)) return # Allocate some memory. call smark (sp) call salloc (frimage, SZ_FNAME, TY_CHAR) # Open the requested display frame and get the loaded image name. # If this name is blank, use the default viewport and window. frim = imd_mapframe (frame, READ_ONLY, YES) iw = iw_open (frim, frame, Memc[frimage], SZ_FNAME, wcs_status) if (Memc[frimage] == EOS || wcs_status == ERR) { call iw_close (iw) call imunmap (frim) call sfree (sp) return } # Find the beginning and end points of the requested image section. # We already know at this point that the input logical image is # 2-dimensional. However this 2-dimensional section may be part of # n-dimensional image. # X dimension. dim1 = IM_VMAP(im,1) step1 = IM_VSTEP(im,1) if (step1 >= 0) { x1 = IM_VOFF(im,dim1) + 1 x2 = x1 + IM_LEN(im,1) - 1 } else { x1 = IM_VOFF(im,dim1) - 1 x2 = x1 - IM_LEN(im,1) + 1 } # Y dimension. dim2 = IM_VMAP(im,2) step2 = IM_VSTEP(im,2) if (step2 >= 0) { y1 = IM_VOFF(im,dim2) + 1 y2 = y1 + IM_LEN(im,2) - 1 } else { y1 = IM_VOFF(im,dim2) - 1 y2 = y1 - IM_LEN(im,2) + 1 } # Get the frame buffer coordinates corresponding to the lower left # and upper right corners of the image section. call iw_im2fb (iw, x1, y1, fx1, fy1) call iw_im2fb (iw, x2, y2, fx2, fy2) if (fx1 > fx2) { junkx = fx1 fx1 = fx2 fx2 = junkx } if (fy1 > fy2) { junky = fy1 fy1 = fy2 fy2 = junky } # Check that some portion of the input image is in the display. # If not select the default viewport and window coordinates. if (fx1 > IM_LEN(frim,1) || fx2 < 1.0 || fy1 > IM_LEN(frim,2) || fy2 < 1.0) { call iw_close (iw) call imunmap (frim) call sfree (sp) return } # Compute a new viewport and window for X. if (fx1 >= 1.0) { vx1 = max (0.0, min (1.0, (fx1 - 0.5) / IM_LEN(frim,1))) nx1 = 1.0 } else { vx1 = 0.0 call iw_fb2im (iw, 1.0, 1.0, junkx, junky) if (step1 >= 0) nx1 = max (1.0, junkx - x1 + 1.0) else nx2 = max (1.0, junkx - x2 + 1.0) } if (fx2 <= IM_LEN(frim,1)) { vx2 = max (0.0, min (1.0, (fx2 + 0.5) / IM_LEN(frim,1))) nx2 = IM_LEN(im,1) } else { vx2 = 1.0 call iw_fb2im (iw, real(IM_LEN(frim,1)), real (IM_LEN(frim,2)), junkx, junky) if (step1 >= 0) nx2 = min (real (IM_LEN(im,1)), junkx - x1 + 1.0) else nx1 = min (real (IM_LEN(im,1)), junkx - x2 + 1.0) } # Compute a new viewport and window for Y. if (fy1 >= 1.0) { vy1 = max (0.0, min (1.0, (fy1 - 0.5) / IM_LEN(frim,2))) ny1 = 1.0 } else { vy1 = 0.0 call iw_fb2im (iw, 1.0, 1.0, junkx, junky) if (step2 >= 0) ny1 = max (1.0, junky - y1 + 1) else ny2 = max (1.0, junky - y2 + 1) } if (fy2 <= IM_LEN(frim,2)) { vy2 = max (0.0, min (1.0, (fy2 + 0.5) / IM_LEN(frim,2))) ny2 = IM_LEN(im,2) } else { vy2 = 1.0 call iw_fb2im (iw, real (IM_LEN(frim,1)), real (IM_LEN(frim,2)), junkx, junky) if (step2 >= 0) ny2 = min (real (IM_LEN(im,2)), junky - y1 + 1.0) else ny1 = min (real (IM_LEN(im,2)), junky - y2 + 1.0) } # Define a the new viewport and window. if (IS_INDEFR(vl)) { vl = vx1 c1 = nx1 } if (IS_INDEFR(vr)) { vr = vx2 c2 = nx2 } if (IS_INDEFR(vb)) { vb = vy1 l1 = ny1 } if (IS_INDEFR(vt)) { vt = vy2 l2 = ny2 } # Clean up. call iw_close (iw) call imunmap (frim) call sfree (sp) end define EDGE1 0.1 define EDGE2 0.9 define EDGE3 0.12 define EDGE4 0.92 # WL_MAP_VIEWPORT -- Set device viewport wcslab plots. If not specified by # user, a default viewport centered on the device is used. procedure wl_map_viewport (gp, c1, c2, l1, l2, ux1, ux2, uy1, uy2, fill) pointer gp # I: pointer to graphics descriptor real c1, c2, l1, l2 # I: the column and line limits real ux1, ux2, uy1, uy2 # I/O: NDC coordinates of requested viewort bool fill # I: fill viewport (vs preserve aspect ratio) int ncols, nlines real xcen, ycen, ncolsr, nlinesr, ratio, aspect_ratio real x1, x2, y1, y2, ext, xdis, ydis bool fp_equalr() real ggetr() data ext /0.0625/ begin ncols = nint (c2 - c1) + 1 ncolsr = real (ncols) nlines = nint (l2 - l1) + 1 nlinesr = real (nlines) # Determine the standard window sizes. if (fill) { x1 = 0.0; x2 = 1.0 y1 = 0.0; y2 = 1.0 } else { x1 = EDGE1; x2 = EDGE2 y1 = EDGE3; y2 = EDGE4 } # If any values were specified, then replace them here. if (! IS_INDEFR(ux1)) x1 = ux1 if (! IS_INDEFR(ux2)) x2 = ux2 if (! IS_INDEFR(uy1)) y1 = uy1 if (! IS_INDEFR(uy2)) y2 = uy2 # Calculate optimum viewport, as in NCAR's conrec, hafton. if (! fill) { ratio = min (ncolsr, nlinesr) / max (ncolsr, nlinesr) if (ratio >= ext) { if (ncols > nlines) y2 = (y2 - y1) * nlinesr / ncolsr + y1 else x2 = (x2 - x1) * ncolsr / nlinesr + x1 } } xdis = x2 - x1 ydis = y2 - y1 xcen = (x2 + x1) / 2. ycen = (y2 + y1) / 2. # So far, the viewport has been calculated so that equal numbers of # image pixels map to equal distances in NDC space, regardless of # the aspect ratio of the device. If the parameter "fill" has been # set to no, the user wants to compensate for a non-unity aspect # ratio and make equal numbers of image pixels map to into the same # physical distance on the device, not the same NDC distance. if (! fill) { aspect_ratio = ggetr (gp, "ar") if (fp_equalr (aspect_ratio, 0.0)) aspect_ratio = 1.0 if (aspect_ratio < 1.0) # Landscape xdis = xdis * aspect_ratio else if (aspect_ratio > 1.0) # Portrait ydis = ydis / aspect_ratio } ux1 = xcen - (xdis / 2.0) ux2 = xcen + (xdis / 2.0) uy1 = ycen - (ydis / 2.0) uy2 = ycen + (ydis / 2.0) call gsview (gp, ux1, ux2, uy1, uy2) call gswind (gp, c1, c2, l1, l2) end # WL_W2LD -- Transform world coordinates to logical coordinates. procedure wl_w2ld (wlct, flip, wx, wy, lx, ly, npts) pointer wlct # I: the MWCS coordinate transformation descriptor int flip # I: true if the axes are transposed double wx[npts], wy[npts] # I: the world coordinates double lx[npts], ly[npts] # O: the logical coordinates int npts # I: the number of points to translate begin if (flip == YES) call mw_v2trand (wlct, wx, wy, ly, lx, npts) else call mw_v2trand (wlct, wx, wy, lx, ly, npts) end # WL_L2WD -- Transform logical coordinates to world coordinates. procedure wl_l2wd (lwct, flip, lx, ly, wx, wy, npts) pointer lwct # I: the MWCS coordinate transformation descriptor int flip # I: true if the axes are transposed double lx[npts], ly[npts] # I: the logical coordinates double wx[npts], wy[npts] # O: the world coordinates int npts # I: the number of points to translate begin if (flip == YES) call mw_v2trand (lwct, ly, lx, wx, wy, npts) else call mw_v2trand (lwct, lx, ly, wx, wy, npts) end # WL_MAX_ELEMENT_ARRAY -- Return the index of the maximum array element. # # Description # This function returns the index of the maximum value of the input array. int procedure wl_max_element_array (array, npts) double array[ARB] # I: the array to look through for the maximum int npts # I: the number of points in the array int i, maximum begin maximum = 1 for (i = 2; i <= npts; i = i + 1) if (array[i] > array[maximum]) maximum = i return (maximum) end # WL_DISTANCED - Determine the distance between two points. double procedure wl_distanced (x1, y1, x2, y2) double x1, y1 # I: coordinates of point 1 double x2, y2 # I: coordinates of point 2 double a, b begin a = x1 - x2 b = y1 - y2 return (sqrt ((a * a) + (b * b))) end # WL_DISTANCER -- Determine the distance between two points. real procedure wl_distancer (x1, y1, x2, y2) real x1, y1 # I: coordinates of point 1 real x2, y2 # I: coordinates of point 2 real a, b begin a = x1 - x2 b = y1 - y2 return (sqrt ((a * a) + (b * b))) end # The dimensionality. define N_DIM 2 # Define some memory management. define ONER Memr[$1+$2-1] # WL_ROTATE -- Rotate a vector. procedure wl_rotate (x, y, npts, angle, nx, ny) real x[npts], y[npts] # I: the vectors to rotate int npts # I: the number of points in the vectors real angle # I: the angle to rotate (radians) real nx[npts], ny[npts] # O: the transformed vectors pointer sp, center, mw pointer mw_open(), mw_sctran() begin # Get some memory. call smark (sp) call salloc (center, N_DIM, TY_REAL) mw = mw_open (NULL, N_DIM) ONER(center,1) = 0. ONER(center,2) = 0. call mw_rotate (mw, -DEGTORAD( angle ), ONER(center,1), 3b) call mw_v2tranr (mw_sctran (mw, "physical", "logical", 3b), x, y, nx, ny, npts) call mw_close (mw) call sfree (sp) end