diff options
Diffstat (limited to 'sys/gio/calcomp')
35 files changed, 3649 insertions, 0 deletions
diff --git a/sys/gio/calcomp/README b/sys/gio/calcomp/README new file mode 100644 index 00000000..c3dd017f --- /dev/null +++ b/sys/gio/calcomp/README @@ -0,0 +1,34 @@ +GIO Calcomp kernel + +This directory contains source for the IRAF calcomp graphics kernel. +Specifications may be found in ccpspecs.hlp. Installation involves +building the kernel task, which is accomplished using "make" (Makefile) +with argument "install" to move the executable into lib$. + +In addition to the kernel task routines, the vttest.x routine contains code +to simulate calcomp software on standard gio graphics devices. vttest.x +contains all the source for the simulation, using parameter file vttest.par. +Here, the calcomp routines "plot", "plots", "newpen", and "symbol" are +replaced with appropriate gio calls (violating interfaces) and to be used +mainly for testing text fonts, line type and width simulation. + +TODO: + +- super-bold font +- bold + italic + +- multiples of dash, dot for linetypes numbered higher than 4 + +-------------------------------------------------------------------------------- +FUTURE ENHANCEMENTS (much work): + +1) Sophisticated parallel-tracing algorithm that looks at entire array + and merges intersections so that all adjacent segments are parallel + to each other and do not cross the acute bisector. Implemented by + parallel array segments rather than drawing each parallel segment + individually, to avoid pen overtravel on short choppy lines. + +2) Panelling: when plot width exceeds available paper width, wrap graphics + to beyond maximum x so that paper can be cut and pasted. + +3) Versatec extension with area-fill. diff --git a/sys/gio/calcomp/ccp.com b/sys/gio/calcomp/ccp.com new file mode 100644 index 00000000..d9e9ac69 --- /dev/null +++ b/sys/gio/calcomp/ccp.com @@ -0,0 +1,38 @@ +# CCP common. A common is necessary since there is no graphics descriptor +# in the argument list of the kernel procedures. The kernel data structures +# are designed along the lines of FIO: a small common is used to hold the time +# critical data elements, and an auxiliary dynamically allocated descriptor is +# used for everything else. + +pointer g_cc # kernel graphics descriptor +pointer g_tty # graphcap descriptor +int g_nframes # number of frames written +int g_maxframes # max frames per device metafile +int g_ndraw # no draw instr. in current frame +int g_in # input file +real g_xres # x resolution of plotter +real g_yres # y resolution of plotter +real g_max_x # maximum x drawn, in plotter units +real g_xndcto_p # x(pltr) = GKI*g_xndcto_p; final scale +real g_yndcto_p # y(pltr) = GKI*g_yndcto_p; final scale +real g_xtask_scale # x scale determined from task params +real g_ytask_scale # y scale determined from task params +real g_xdefault_scale # x scale from graphcap or compile-time +real g_ydefault_scale # y scale from graphcap or compile-time +int g_ltype # line type +real g_dashlen # length of dash in dashed line, p_units +real g_gaplen # width of gap in dash/dot line, p_units +real g_plwsep # polyline width separation for ntracing +int g_txquality # text quality parameter +bool g_ltover # user override of line-type generator +bool g_lwover # user override of line width simulation +bool g_lcover # user override of line color generator +char g_lwtype # line width mode parameter +char g_device[SZ_GDEVICE] # force output to named device + +common /ccpcom/ g_cc, g_tty, g_nframes, g_maxframes, g_ndraw, + g_in, g_xres, g_yres, g_max_x, g_xndcto_p, g_yndcto_p, + g_xtask_scale, g_ytask_scale, + g_xdefault_scale, g_ydefault_scale, + g_ltype, g_dashlen, g_gaplen, g_plwsep, g_txquality, + g_ltover, g_lwover, g_lcover, g_lwtype, g_device diff --git a/sys/gio/calcomp/ccp.h b/sys/gio/calcomp/ccp.h new file mode 100644 index 00000000..037dbc6a --- /dev/null +++ b/sys/gio/calcomp/ccp.h @@ -0,0 +1,92 @@ +# CCP definitions. + +define MAX_CHARSIZES 10 # max discreet device char sizes +define SZ_SBUF 1024 # initial string buffer size +define SZ_GDEVICE 31 # maxsize forced device name +define CCP_LDEV 5 # device for "plots(0,0,ldev") +define CCP_UP 3 # "pen-up" code +define CCP_DOWN 2 # "pen-down" code +define PL_SINGLE 1 # rel width of single-width line +define MAXTRACES 15 # maximum adjacent bold traces +define SEGSIZE 256 # segment buffer size +define XSEG Memr[xseg + $1 - 1] # segment buffer for ccp_calcseg +define YSEG Memr[yseg + $1 - 1] # " +define DIS sqrt ((($3)-($1))**2+(($4)-($2))**2) #dis (x1,y1, x2,y2) +define XTRAN ($1) * g_xndcto_p # convert NDC to plotter coords +define YTRAN ($1) * g_yndcto_p # " +define FRAME_OFFSET 1.0 # pltr units between [new]frames +define MAX_PL_XWIDTH 0.3307 # max pltr x (m) if no graphcap +define MAX_PL_YHEIGHT 0.2540 # max pltr y (m) if no graphcap +define DEF_MPER_PUNIT 0.0254 # default meters / plotter unit +define DEF_DASHLEN 0.1000 # default dash length, pltr unit +define DEF_GAPLEN 0.0500 # default gap length, pltr units +define DEF_PLWSEP 0.0050 # default ntracing sep. in pu + +# CCP state device descriptor: + +define LEN_CCP 81 + +define CCP_SBUF Memi[$1] # string buffer +define CCP_SZSBUF Memi[$1+1] # size of string buffer +define CCP_NEXTCH Memi[$1+2] # next char pos in string buf +define CCP_NCHARSIZES Memi[$1+3] # number of character sizes +define CCP_POLYLINE Memi[$1+4] # device supports polyline +define CCP_POLYMARKER Memi[$1+5] # device supports polymarker +define CCP_FILLAREA Memi[$1+6] # device supports fillarea +define CCP_CELLARRAY Memi[$1+7] # device supports cell array +define CCP_ZRES Memi[$1+8] # device resolution in Z +define CCP_FILLSTYLE Memi[$1+9] # number of fill styles +define CCP_ROAM Memi[$1+10] # device supports roam +define CCP_ZOOM Memi[$1+11] # device supports zoom +define CCP_SELERASE Memi[$1+12] # device has selective erase +define CCP_PIXREP Memi[$1+13] # device supports pixel replic. +define CCP_STARTFRAME Memi[$1+14] # frame advance at metafile BOF +define CCP_ENDFRAME Memi[$1+15] # frame advance at metafile EOF + # extra space +define CCP_CURSOR Memi[$1+20] # last cursor accessed +define CCP_COLOR Memi[$1+21] # last color set +define CCP_TXSIZE Memi[$1+22] # last text size set +define CCP_TXFONT Memi[$1+23] # last text font set +define CCP_LTYPE Memi[$1+24] # last line type set +define CCP_WIDTH Memi[$1+25] # last line width set +define CCP_DEVNAME Memi[$1+26] # name of open device +define CCP_DEVCHAN Memi[$1+27] # channel for "plots(0,0,ldev)" + # extra space +define CCP_CHARHEIGHT Memi[$1+30+$2-1] # character height +define CCP_CHARWIDTH Memi[$1+40+$2-1] # character width +define CCP_CHARSIZE Memr[P2R($1+50+$2-1)] # text sizes permitted +define CCP_PLAP ($1+60) # polyline attributes +define CCP_PMAP ($1+64) # polymarker attributes +define CCP_FAAP ($1+68) # fill area attributes +define CCP_TXAP ($1+71) # default text attributes + +# Substructure definitions. + +define LEN_PL 4 +define PL_STATE Memi[$1] # polyline attributes +define PL_LTYPE Memi[$1+1] +define PL_WIDTH Memi[$1+2] +define PL_COLOR Memi[$1+3] + +define LEN_PM 4 +define PM_STATE Memi[$1] # polymarker attributes +define PM_LTYPE Memi[$1+1] +define PM_WIDTH Memi[$1+2] +define PM_COLOR Memi[$1+3] + +define LEN_FA 3 # fill area attributes +define FA_STATE Memi[$1] +define FA_STYLE Memi[$1+1] +define FA_COLOR Memi[$1+2] + +define LEN_TX 10 # text attributes +define TX_STATE Memi[$1] +define TX_UP Memi[$1+1] +define TX_SIZE Memi[$1+2] +define TX_PATH Memi[$1+3] +define TX_SPACING Memr[P2R($1+4)] +define TX_HJUSTIFY Memi[$1+5] +define TX_VJUSTIFY Memi[$1+6] +define TX_FONT Memi[$1+7] +define TX_QUALITY Memi[$1+8] +define TX_COLOR Memi[$1+9] diff --git a/sys/gio/calcomp/ccpclear.x b/sys/gio/calcomp/ccpclear.x new file mode 100644 index 00000000..9ff17c20 --- /dev/null +++ b/sys/gio/calcomp/ccpclear.x @@ -0,0 +1,29 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include "ccp.h" + +# CCP_CLEAR -- Advance a frame on the plotter. All attribute packets are +# initialized to their default values. Redundant calls or calls immediately +# after a workstation open (before anything has been drawn) are ignored. + +procedure ccp_clear (dummy) + +int dummy # not used at present +include "ccp.com" + +begin + # This is a no-op if nothing has been drawn. + if (g_cc == NULL || g_ndraw == 0) + return + + # Start a new frame. This is by resetting the origin to the last + # x-position drawn plus a compile-time offset. + + call plot (g_max_x + FRAME_OFFSET, 0.0, -3) + g_max_x = 0.0 + + # Init kernel data structures. + call ccp_reset() + g_ndraw = 0 +end diff --git a/sys/gio/calcomp/ccpclose.x b/sys/gio/calcomp/ccpclose.x new file mode 100644 index 00000000..3d433eb0 --- /dev/null +++ b/sys/gio/calcomp/ccpclose.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "ccp.h" + +# CCP_CLOSE -- Close the calcomp kernel. Free up storage. + +procedure ccp_close() + +include "ccp.com" + +begin + # Signal end of plot. + call plot (0, 0, 999) + # call plots (0, 0, CCP_DEVCHAN(g_cc)) #do we really want to do this? + # (calcomp may get into funny state without, but may mess up APPEND + + # Free kernel data structures. + call mfree (CCP_SBUF(g_cc), TY_CHAR) + call mfree (g_cc, TY_STRUCT) + + g_cc = NULL +end diff --git a/sys/gio/calcomp/ccpclws.x b/sys/gio/calcomp/ccpclws.x new file mode 100644 index 00000000..f536d7ab --- /dev/null +++ b/sys/gio/calcomp/ccpclws.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# include "ccp.h" + +# CCP_CLOSEWS -- Close the named workstation. +# If the plot were terminated (plot (0, 0, 999)) APPEND mode would not work. + +procedure ccp_closews (devname, n) + +short devname[ARB] # device name (not used) +int n # length of device name +# include "ccp.com" + +begin + # noop + return +end diff --git a/sys/gio/calcomp/ccpcolor.x b/sys/gio/calcomp/ccpcolor.x new file mode 100644 index 00000000..98b701d0 --- /dev/null +++ b/sys/gio/calcomp/ccpcolor.x @@ -0,0 +1,36 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "ccp.h" + +# Calcomp pen colors +define BLACK 1 +define WHITE 2 +define RED 3 +define GREEN 4 +define BLUE 5 + +# CCP_COLOR set pen color + +procedure ccp_color(index) + +int index # index for color switch statement +include "ccp.com" + +begin + if (g_lcover) # CL param lcover, line color override is on; noop + return + + switch (index) { + + case WHITE: + call newpen (WHITE) + case RED: + call newpen (RED) + case GREEN: + call newpen (GREEN) + case BLUE: + call newpen (BLUE) + default: + call newpen (BLACK) + } +end diff --git a/sys/gio/calcomp/ccpcseg.x b/sys/gio/calcomp/ccpcseg.x new file mode 100644 index 00000000..7b55adc7 --- /dev/null +++ b/sys/gio/calcomp/ccpcseg.x @@ -0,0 +1,207 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include <mach.h> +include "ccp.h" + +# CCP_CALCSEG -- Calculate a contiguous line segment; used to return individual +# line segments under the various options of line type simulation. (Width is +# not simulated here). Each segment returned is actually drawable, guaranteeing +# constant-length dashes and gaps along the exact length of the input polyline. +# Normally called by ccp_polyline. + +procedure ccp_calcseg (p, npts, ltype, curpl_pt, segsize, xseg,yseg, nsegpts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs +int ltype # line type; CCP_CLEAR <= ltype <= CCP_DASHDOT +int curpl_pt # current polyline point; input and output +int segsize # current segment memory size +pointer xseg,yseg # plotter-unit contiguous line segment, output +int nsegpts # number of points in segment, output + +int i, j +real lastp_x, lastp_y, x, y, curseglen +bool toggle + +include "ccp.com" + +begin + if (curpl_pt == 1) { # always start line w/beginning of dash, etc. + lastp_x = XTRAN(p[1]) + lastp_y = YTRAN(p[2]) + curpl_pt = curpl_pt + 1 + toggle = false + } + + XSEG(1) = lastp_x + YSEG(1) = lastp_y + nsegpts = 1 + curseglen = 0.0 + + switch (ltype) { + case GL_CLEAR: + nsegpts = 0 + + case GL_DASHED: + # Return one contiguous polyline segment worth one dash: + call ccx_dash (p, npts, curpl_pt, curseglen, nsegpts, segsize, + xseg,yseg, lastp_x,lastp_y) + + # Now increment internal counters for gap width for next call + call ccx_gap (p, npts, curpl_pt, curseglen, g_dashlen + g_gaplen, + lastp_x,lastp_y) + + case GL_DOTTED: + # Since we already built one point, we need only the following gap: + call ccx_gap (p, npts, curpl_pt, curseglen, g_gaplen, + lastp_x,lastp_y) + + case GL_DOTDASH: + # Implement as dash/gap/dot/gap/: + if (toggle) { # build dot/gap/ + x = lastp_x #XTRAN(p[i]) + y = lastp_y #YTRAN(p[i+1]) + nsegpts = 0 + call ccx_addsegpt (x,y, xseg,yseg, nsegpts, segsize) + toggle = false + call ccx_gap (p, npts, curpl_pt, curseglen, g_gaplen, + lastp_x,lastp_y) + + } else { # build dash/gap/ + call ccx_dash (p, npts, curpl_pt, curseglen, nsegpts, + segsize, xseg,yseg, lastp_x,lastp_y) + call ccx_gap (p, npts, curpl_pt, curseglen, + g_dashlen + g_gaplen, lastp_x,lastp_y) + toggle = true + } + + default: # solid line + do i = curpl_pt, npts { + j = (i-1) * 2 + 1 + x = XTRAN(p[j]) + y = YTRAN(p[j+1]) + call ccx_addsegpt (x,y, xseg,yseg, nsegpts, segsize) + } + curpl_pt = npts + } +end + + +# CCX_DASH -- Do the actual work of building a dashed line segment (no gap) + +procedure ccx_dash (p, npts, curpl_pt, curseglen, cursegpt, segsize, + xseg,yseg, lastp_x,lastp_y) + +short p[ARB] # Input: points defining line +int npts # Input: number of points, i.e., (x,y) pairs +int curpl_pt # In/Output: current polyline point +real curseglen # Output: length of current simulated ltype unit (._) +int cursegpt # Output: index of current drawable point in segment +int segsize # In/Output: current segment size +pointer xseg,yseg # Output: plotter-units, contiguous line segment +real lastp_x,lastp_y # Output: last point in segment (visible or invisible) + +int i +real temppl_dis, x, y, delx, dely +real actual_dis, rem_dashlen + +include "ccp.com" + +begin + rem_dashlen = g_dashlen + + # Build up current "dash" (may be bent any number of times). + + while (curseglen + EPSILON < g_dashlen && curpl_pt <= npts) { + i = (curpl_pt-1) * 2 + 1 + x = XTRAN(p[i]) + y = YTRAN(p[i+1]) + temppl_dis = DIS(lastp_x, lastp_y, x, y) + if (temppl_dis >= EPSILON) { + actual_dis = min (temppl_dis, rem_dashlen) + rem_dashlen = rem_dashlen - actual_dis + + delx = x - lastp_x + dely = y - lastp_y + x = lastp_x + delx * actual_dis / temppl_dis + y = lastp_y + dely * actual_dis / temppl_dis + + call ccx_addsegpt (x,y, xseg,yseg, cursegpt, segsize) + curseglen = curseglen + actual_dis + lastp_x = XSEG(cursegpt) + lastp_y = YSEG(cursegpt) + } + if (curseglen + EPSILON < g_dashlen) + curpl_pt = curpl_pt + 1 + } +end + + +# CCX_GAP -- Do the actual work of building an invisible gap along original +# polyline. + +procedure ccx_gap (p, npts, curpl_pt, curseglen, matchlen, lastp_x,lastp_y) + +short p[ARB] # Input: points defining line +int npts # Input: number of points, i.e., (x,y) pairs +int curpl_pt # In/Output: current polyline point +real curseglen # In/Output: length of current simulated ltype unit (._) +real matchlen # Output: length to build curseglen up to +real lastp_x,lastp_y # Output: last point in segment (visible, invisible) + +int i +real x, y, delx, dely +real temppl_dis, actual_dis, rem_gaplen + +include "ccp.com" + +begin + rem_gaplen = g_gaplen + + # Build up current "gap" (may be bent any number of times). + + while ((curseglen + EPSILON < (matchlen)) && (curpl_pt <= npts)) { + i = (curpl_pt-1) * 2 + 1 + x = XTRAN(p[i]) + y = YTRAN(p[i+1]) + + temppl_dis = DIS(lastp_x, lastp_y, x, y) + if (temppl_dis >= EPSILON) { + actual_dis = min (temppl_dis, rem_gaplen) + rem_gaplen = rem_gaplen - actual_dis + + delx = x - lastp_x + dely = y - lastp_y + curseglen = curseglen + actual_dis + lastp_x = lastp_x + delx * actual_dis / temppl_dis + lastp_y = lastp_y + dely * actual_dis / temppl_dis + } + if (curseglen + EPSILON < matchlen) + curpl_pt = curpl_pt + 1 + } +end + + +# CCX_ADDSEGPT -- add a point to the segment structure; handle memory needs + +procedure ccx_addsegpt (x,y, xseg,yseg, cursegpt,segsize) + +real x,y # point to be added to output segment +pointer xseg,yseg # NDC-coord contiguous line segment, output +int cursegpt # index of current drawable point in segment +int segsize # current segment size + +begin + cursegpt = cursegpt + 1 + + if (cursegpt > segsize) { + segsize = segsize + SEGSIZE + call realloc (xseg, segsize, TY_REAL) + call realloc (yseg, segsize, TY_REAL) + } + + XSEG(cursegpt) = x + YSEG(cursegpt) = y +end diff --git a/sys/gio/calcomp/ccpdrawch.x b/sys/gio/calcomp/ccpdrawch.x new file mode 100644 index 00000000..dab89158 --- /dev/null +++ b/sys/gio/calcomp/ccpdrawch.x @@ -0,0 +1,233 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include <gki.h> +include <gset.h> +include "ccp.h" +include "font.h" + +define ITALIC_TILT 0.30 # fraction of xsize to tilt italics at top +define MAX_STROKESIZE 32 # max number of vectors making up one stroke +define CALCOMP_CHSTART 16 # maximum calcomp special symbol plus 1 +define SYMBOL_ASPECT 1.17 # calcomp height = 7/6 width for normal spacing. +define LOW_REDRAWS 5 # multiple traces for low-quality bold text +define HIGH_REDRAWS 9 # multiple traces for high-quality bold text + + +# CCP_DRAWCHAR -- Draw a character of the given size and orientation at the +# given position. + +procedure ccp_drawchar (ch, x, y, xsize, ysize, orien, font, quality) + +char ch # character to be drawn +int x, y # lower left GKI coords of character +int xsize, ysize # char width and height in unscaled GKI units +int orien # orientation of character (0 degrees normal) +int font # desired character font +int quality # quality control -- low(calcomp); other(iraf) + +real px, py, coso, sino, theta, xto_nicesize, yto_nicesize +real sx[MAX_STROKESIZE], sy[MAX_STROKESIZE] +int stroke, tab1, tab2, i, j, pen +int bitupk() + +include "ccp.com" +include "font.com" + +begin + # Compute correction factor for absolute physical character size. + # This also corrects for distortion of high-qual text if xscale<>yscale. + xto_nicesize = g_xdefault_scale / g_xndcto_p + yto_nicesize = g_ydefault_scale / g_yndcto_p + + # Set the font. + call ccp_font (font) + + if (quality == GT_LOW) { + # If low text quality requested, draw with Calcomp's SYMBOL call. + # We avoid machine-dependency word-size problems by always + # calling SYMBOL only from here, one char per call. + # Calcomp's SYMBOL expects height as only size; aspect is height + # = 7/6 (width) for normal character spacing. + + call ccx_intersymbol (XTRAN(x),YTRAN(y), real(xsize) * xto_nicesize, + real(ysize) * yto_nicesize, ch, real(orien)) + + } else { + # Text quality requested is not low; draw font either with single- + # width line or bold, via ccp_drawseg. + + if (ch < CHARACTER_START || ch > CHARACTER_END) + i = '?' - CHARACTER_START + 1 + else + i = ch - CHARACTER_START + 1 + + tab1 = chridx[i] + tab2 = chridx[i+1] - 1 + + if (tab2 - tab1 + 1 > MAX_STROKESIZE) { + call eprintf ( + "CCP KERNEL WARNING: up-dimension MAX_STROKESIZE\n") + call eprintf ( + "in module ccp_drawch; new stroke size %d, char %s\n") + call pargi (tab2 - tab1 + 1) + call pargc (ch) + tab2 = tab1 + MAX_STROKESIZE - 1 + } + + theta = -DEGTORAD(orien) + coso = cos(theta) + sino = sin(theta) + + j = 0 + do i = tab1, tab2 { + stroke = chrtab[i] + px = bitupk (stroke, COORD_X_START, COORD_X_LEN) + py = bitupk (stroke, COORD_Y_START, COORD_Y_LEN) + pen = bitupk (stroke, COORD_PEN_START, COORD_PEN_LEN) + + # Scale size of character in unwarped (xscale == yscale) system. + px = px / FONT_WIDTH * xsize + py = py / FONT_HEIGHT * ysize + + # The italic font is implemented applying a tilt. + if (font == GT_ITALIC) + px = px + ((py / ysize) * xsize * ITALIC_TILT) + + if (pen == 0 && j > 0) { # new stroke segment; draw last + if (j > 1) + call ccx_interpoly (sx, sy, j, quality) + j = 0 + } + + # Rotate, shift (unwarped), then correct for xscale <> yscale. + j = j + 1 + sx[j] = XTRAN(x + ( px * coso + py * sino) * xto_nicesize) + sy[j] = YTRAN(y + (-px * sino + py * coso) * yto_nicesize) + } + + # last stroke segment: + if (j > 1) + call ccx_interpoly (sx, sy, j, quality) + } +end + + +# CCX_INTERPOLY -- intermediate routine to 1) pass simple draw instruction to +# calcomp plot routines if linewidth single or bold method = penchange, or +# 2) simulate bold text by offsetting to the four corners and four edges +# of a box surrounding the character. + +procedure ccx_interpoly (x, y, npts, quality) + +real x[ARB],y[ARB] # plotter-unit coordinates to be drawn as polyline +int npts # number points in x,y +int quality # text quality (distinguish between medium and high) + +int i, j, num_redraws, twidth +real xp, yp +real xoff[HIGH_REDRAWS],yoff[HIGH_REDRAWS] + +include "ccp.com" + +data xoff/0., 1., 0., -1., 0., 1., -1., -1., 1./ +data yoff/0., 0., 1., 0., -1., 1., 1., -1., -1./ + +begin + if (npts <= 0) + return + + # If line width override is on, or linewidth is single, do simple move + # and draws. + + num_redraws = 1 + twidth = nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc))) + if (!g_lwover) + if (g_lwtype == 'p' && twidth >= 1) + call ccp_lwidth (twidth) + else if (twidth > 1 && quality == GT_HIGH) + num_redraws = HIGH_REDRAWS + else + num_redraws = LOW_REDRAWS + + if (num_redraws == 1) { + call plot (x[1], y[1], CCP_UP) + g_max_x = max (x[1], g_max_x) + + if (npts == 1) { # single pt is special case; drop pen + call plot (x[1], y[1], CCP_DOWN) + } else { # draw normally + do i = 2, npts { + call plot (x[i], y[i], CCP_DOWN) + g_max_x = max (x[i], g_max_x) + } + } + } else { + do i = 1, num_redraws { + xp = x[1] + xoff[i] * g_plwsep + yp = y[1] + yoff[i] * g_plwsep + call plot (xp, yp, CCP_UP) + g_max_x = max (xp, g_max_x) + + if (npts == 1) { # single pt is special case; drop pen + call plot (xp, yp, CCP_DOWN) + } else { # draw normally + do j = 2, npts { + xp = x[j] + xoff[i] * g_plwsep + yp = y[j] + yoff[i] * g_plwsep + call plot (xp, yp, CCP_DOWN) + g_max_x = max (xp, g_max_x) + } + } + } + } +end + + +# CCX_INTERSYMBOL -- routine intermediate to Calcomp SYMBOL routine; handles +# bold text. + +procedure ccx_intersymbol (x,y, xsize,ysize, ch, orien) + +real x,y # plotter-unit coords of lower left of character +real xsize,ysize # char width, height in GKI units scaled to "nice" sizes +char ch # character to be drawn +real orien # degrees counterclockwise from +x axis to text path + +int i, nsym, symchar, num_redraws +real xp,yp, xoff[HIGH_REDRAWS],yoff[HIGH_REDRAWS], csize + +include "ccp.com" + +data xoff/0., 1., 0., -1., 0., 1., -1., -1., 1./ +data yoff/0., 0., 1., 0., -1., 1., 1., -1., -1./ + +begin + symchar = int (ch) + nsym = 1 + + if (ch < CALCOMP_CHSTART && ch >= 0) { + nsym = -1 + } else if (ch < ' ' || ch > '~') + ch = '~' + + # Since we are only called if text_quality == low, implement + # bold text with only the center and edge positions (LOW_REDRAWS). + num_redraws = 1 + if (!g_lwover && nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc))) > 1) + num_redraws = LOW_REDRAWS + + # Set the size as the height of the character in device units; we + # start with the width to avoid overlapping, and we use the default + # scale, which results in reasonable-sized characters; the specified + # scale would produce strange results as orien passes from 0 to 90. + + csize = min (xsize * g_xndcto_p * SYMBOL_ASPECT, ysize * g_yndcto_p) + + do i = 1, num_redraws { + xp = x + xoff[i] * g_plwsep + yp = y + yoff[i] * g_plwsep + call symbol (xp, yp, csize, symchar, orien, nsym) + g_max_x = max (xp + csize, g_max_x) + } +end diff --git a/sys/gio/calcomp/ccpdseg.x b/sys/gio/calcomp/ccpdseg.x new file mode 100644 index 00000000..2d5d1c76 --- /dev/null +++ b/sys/gio/calcomp/ccpdseg.x @@ -0,0 +1,208 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include "ccp.h" + +define DIAGSEP (g_plwsep / 0.8660254) # distance to vertex of hexagon +define PIOVER3 (PI / 3.0) +define PIOVER6 (PI / 6.0) +define SIN_MIN_HALFBISECTOR 0.1 # sine of minimum half-bisector + + +# CCP_DRAWSEG -- Draw a polyline segment, optionally simulating variable +# widths. + +procedure ccp_drawseg (xseg, yseg, nsegpts, lwidth) + +real xseg[ARB] # plotter coordinate array of contiguous points +real yseg[ARB] +int nsegpts # number of pts in array +int lwidth # line width relative to single width + +int i, j +real pleft_x[MAXTRACES], pleft_y[MAXTRACES] +real pright_x[MAXTRACES], pright_y[MAXTRACES], lastp_x,lastp_y +real ahp2p1, theta, delx,dely, dx,dy, tx,ty +real rptheta4 () +include "ccp.com" +data lastp_x/0.0/, lastp_y/0.0/ + +begin + if (nsegpts < 1) + return + if (lwidth > MAXTRACES) { + call eprintf ("WARNING: line width > MAXTRACES in ccp_drawseg\n") + call eprintf (" line width reset to %d\n") + call pargi (MAXTRACES) + lwidth = MAXTRACES + } + + if (nsegpts == 1) { # 1 pt spcl bold + + # Draw a single point as a hexagon lined up in the direction from + # the preceding point. Start bounding hexagon 60 degrees cc from + # projection of last point drawn (0,0 initially) through current pt. + # 'ahp2p1' = Angle from Horizontal at P1 to line P1 -> P2, etc. + + ahp2p1 = rptheta4 (xseg[1], yseg[1], lastp_x, lastp_y) + lastp_x = xseg[1] + lastp_y = yseg[1] + theta = ahp2p1 - PIOVER6 + + # do even a single, interior point as a hexagon, up to lwidth times + do i = 1, lwidth { + tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta) + ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta) + call plot (tx, ty, CCP_UP) + + # draw a bounding hexagon around point: + do j = 1, 6 { + theta = theta + PIOVER3 + tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta) + ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta) + call plot (tx, ty, CCP_DOWN) + + # Store maximum-x plotted for a "newframe" in ccp_clear. + g_max_x = max (tx, g_max_x) + } + + # fill in a diagonal line across hexagon: + tx = xseg[1] + (2 + i) * DIAGSEP * cos (theta + PI) + ty = yseg[1] + (2 + i) * DIAGSEP * sin (theta + PI) + call plot (tx, ty, CCP_DOWN) + theta = theta + PIOVER3 # rotate spokes + } + + } else { # nsegpts > 1 + + if (g_lwover || lwidth == PL_SINGLE) { + call plot (xseg[1], yseg[1], CCP_UP) + g_max_x = max (xseg[1], g_max_x) + + do i = 2, nsegpts { + call plot (xseg[i], yseg[i], CCP_DOWN) + g_max_x = max (xseg[i], g_max_x) + } + } else if (lwidth > PL_SINGLE) { + + # compute flanking points; by definition +-90 deg. from p1-p2, + # so first point is special case; do for all thicknesses: + + call ccx_offsets (xseg[1]-xseg[2]+xseg[1], + yseg[1]-yseg[2]+yseg[1], xseg[1],yseg[1], + xseg[2],yseg[2], delx,dely) + + do i = 1, lwidth - 1 { + pleft_x[i] = xseg[1] + i * delx + pleft_y[i] = yseg[1] + i * dely + pright_x[i] = xseg[1] - i * delx + pright_y[i] = yseg[1] - i * dely + } + + # must draw each segment individually, to make flanks meet. + do i = 1, nsegpts - 2 { + + # actual line segment in data: + call plot (xseg[i], yseg[i], CCP_UP) + call plot (xseg[i+1], yseg[i+1], CCP_DOWN) + g_max_x = max (xseg[i], g_max_x) + + call ccx_offsets (xseg[i],yseg[i], xseg[i+1],yseg[i+1], + xseg[i+2],yseg[i+2], delx,dely) + + # for each flanking line; p2 in middle, at temp origin + do j = 1, lwidth - 1 { + + # point to left of p1-p2, facing p2: + dx = j * delx + dy = j * dely + tx = xseg[i+1] + dx + ty = yseg[i+1] + dy + call plot (pleft_x[j], pleft_y[j], CCP_UP) + call plot (tx, ty, CCP_DOWN) + pleft_x[j] = tx + pleft_y[j] = ty + + # point to right of p1-p2, facing p2: + tx = xseg[i+1] - dx + ty = yseg[i+1] - dy + call plot (pright_x[j], pright_y[j], CCP_UP) + call plot (tx, ty, CCP_DOWN) + pright_x[j] = tx + pright_y[j] = ty + } + } + + # last point: + call plot (xseg[nsegpts-1], yseg[nsegpts-1], CCP_UP) + call plot (xseg[nsegpts], yseg[nsegpts], CCP_DOWN) + g_max_x = max (xseg[nsegpts-1], g_max_x) + g_max_x = max (xseg[nsegpts], g_max_x) + + # save this point for a possible following dotted line segment: + lastp_x = xseg[nsegpts] + lastp_y = yseg[nsegpts] + + # square the flanking lines: + call ccx_offsets (xseg[nsegpts-1], yseg[nsegpts-1], + xseg[nsegpts], yseg[nsegpts], + xseg[nsegpts] * 2.0 - xseg[nsegpts-1], + yseg[nsegpts] * 2.0 - yseg[nsegpts-1], + delx, dely) + + do i = 1, lwidth - 1 { + tx = xseg[nsegpts] + i * delx + ty = yseg[nsegpts] + i * dely + call plot (pleft_x[i], pleft_y[i], CCP_UP) + call plot (tx, ty, CCP_DOWN) + tx = xseg[nsegpts] - i * delx + ty = yseg[nsegpts] - i * dely + call plot (pright_x[i], pright_y[i], CCP_UP) + call plot (tx, ty, CCP_DOWN) + } + } + } +end + + +# CCX_OFFSETS -- return offsets in x, y from point 2 to one level of line width +# simulation, given points 1, 2, 3. + +procedure ccx_offsets (p1x,p1y, p2x,p2y, p3x,p3y, delx,dely) + +real p1x,p1y # input: point 1 is previous point +real p2x,p2y # input: point 2 is current point (middle of the three) +real p3x,p3y # input: point 3 is succeeding point +real delx,dely # output: offsets from point 2 to one flanking point + +real ahp2p1 # Angle from Horizontal to line p2-->p1, etc. +real ahp2p3, ap1p2p3, ahbisector, sintheta, r +real rptheta4 () +include "ccp.com" + +begin + # convention is that p2 is current point, at temporary origin; p1 + # is "behind", and p3 is "ahead" of the current point, p2. + # "ahp2p1" = angle from horizontal to segment p2->p1 + # "ap1p2p3" = angle from p1 to p2 to p3 + # "ahbisector" = angle from horizontal (+x) to bisector of p1->p2->p3 + + ahp2p1 = rptheta4 (p2x,p2y, p1x,p1y) + ahp2p3 = rptheta4 (p2x,p2y, p3x,p3y) + ap1p2p3 = ahp2p1 - ahp2p3 + ahbisector = ahp2p3 + 0.5 * ap1p2p3 + sintheta = sin (ahp2p1 - ahbisector) + + # very small angles cause extremely exaggerated vertices; truncate + # at arbitrary multiple of plwsep; 10*plwsep is eqv. to 11.5 deg. bisect + + if (abs (sintheta) < SIN_MIN_HALFBISECTOR) { + r = g_plwsep / SIN_MIN_HALFBISECTOR + if (sintheta < 0.0) + r = -r + } else + r = g_plwsep / sintheta + + delx = r * cos (ahbisector) + dely = r * sin (ahbisector) +end diff --git a/sys/gio/calcomp/ccpescape.x b/sys/gio/calcomp/ccpescape.x new file mode 100644 index 00000000..37e81972 --- /dev/null +++ b/sys/gio/calcomp/ccpescape.x @@ -0,0 +1,65 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gescape.h> +include "ccp.h" + +# CCP_ESCAPE -- Pass a device dependent instruction on to the kernel. +# used for passing exact scaling factors through gki metacode + +procedure ccp_escape (fn, instruction, nwords) + +int fn # function code +short instruction[ARB] # instruction data words +int nwords # length of instruction + +int ip +real tempr +char scale_str[SZ_LINE] +int ctod () + +include "ccp.com" + +string warnx "Warning: ccpkern unable to convert gki_escape xscale\n" +string warny "Warning: ccpkern unable to convert gki_escape yscale\n" + +begin + call achtsc (instruction, scale_str, nwords) + scale_str[nwords+1] = EOS + ip = 1 + + switch (fn) { + + case GSC_X_GKITODEV: + + # if kernel task scale params were not specified, set actual scale + # params to those passed from metacode if translatable, set to + # default scale from ccp_init/graphcap if untranslatable. If + # kernel task did specify scale, this is a no op. + + if (IS_INDEF (g_xtask_scale)) { + if (ctod (scale_str, ip, tempr) < 1) { + g_xndcto_p = g_xdefault_scale + call eprintf (warnx) + call eprintf ("scale string: %s\n") + call pargstr (scale_str) + call eprintf ("new (graphcap-default) x scale: %f\n") + call pargr (g_xndcto_p) + } else + g_xndcto_p = tempr + } + + case GSC_Y_GKITODEV: + + if (IS_INDEF (g_ytask_scale)) { + if (ctod (scale_str, ip, tempr) < 1) { + g_yndcto_p = g_ydefault_scale + call eprintf (warny) + call eprintf ("scale string: %s\n") + call pargstr (scale_str) + call eprintf ("new (graphcap-default) y scale: %f\n") + call pargr (g_yndcto_p) + } else + g_yndcto_p = tempr + } + } +end diff --git a/sys/gio/calcomp/ccpfa.x b/sys/gio/calcomp/ccpfa.x new file mode 100644 index 00000000..cf54861d --- /dev/null +++ b/sys/gio/calcomp/ccpfa.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "ccp.h" + +# CCP_FILLAREA -- Fill a closed area. + +procedure ccp_fillarea (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs +include "ccp.com" + +begin + # Not implemented yet. + call ccp_polyline (p, npts) +end diff --git a/sys/gio/calcomp/ccpfaset.x b/sys/gio/calcomp/ccpfaset.x new file mode 100644 index 00000000..228669f9 --- /dev/null +++ b/sys/gio/calcomp/ccpfaset.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "ccp.h" + +# CCP_FASET -- Set the fillarea attributes. + +procedure ccp_faset (gki) + +short gki[ARB] # attribute structure +pointer fa +include "ccp.com" + +begin + fa = CCP_FAAP(g_cc) + FA_STYLE(fa) = gki[GKI_FASET_FS] + FA_COLOR(fa) = gki[GKI_FASET_CI] +end diff --git a/sys/gio/calcomp/ccpfont.x b/sys/gio/calcomp/ccpfont.x new file mode 100644 index 00000000..0e7ad9a4 --- /dev/null +++ b/sys/gio/calcomp/ccpfont.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "ccp.h" + +# CCP_FONT -- Set the character font. The roman font is normal. Bold is +# implemented by increasing the vector line width; care must be taken to +# set CCP_WIDTH so that the other vector drawing procedures remember to +# change the width back. The italic font is implemented in the character +# generator by a geometric transformation. + +procedure ccp_font (font) + +int font # code for font to be set +int pk1, pk2, width +include "ccp.com" + +begin + pk1 = GKI_PACKREAL(1.0) + pk2 = GKI_PACKREAL(2.0) + + width = CCP_WIDTH(g_cc) + + if (font == GT_BOLD) { + if (width != pk2) + width = pk2 + } else { + if (GKI_UNPACKREAL(width) > 1.5) + width = pk1 + } + + CCP_WIDTH(g_cc) = width +end diff --git a/sys/gio/calcomp/ccpinit.x b/sys/gio/calcomp/ccpinit.x new file mode 100644 index 00000000..1ae558c7 --- /dev/null +++ b/sys/gio/calcomp/ccpinit.x @@ -0,0 +1,165 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <ctype.h> +include <gki.h> +include "ccp.h" + +# CCP_INIT -- Initialize the CCP data structures from the graphcap entry +# for the plotter. Called once, at OPENWS time, with the TTY pointer already +# set in the common. The companion routine CCP_RESET initializes the attribute +# packets. + +procedure ccp_init (tty, devname) + +pointer tty # graphcap descriptor +char devname[ARB] # device name + +pointer nextch +int maxch, i +real char_height, char_width, char_size, xres, yres, xwidth, yheight +real mper_punit +bool ttygetb() +real ttygetr() +int ttygeti(), btoi(), gstrcpy() +include "ccp.com" + +begin + # Allocate the CCP descriptor, string buffer, and x,y segment buffers. + if (g_cc == NULL) { + call calloc (g_cc, LEN_CCP, TY_STRUCT) + call malloc (CCP_SBUF(g_cc), SZ_SBUF, TY_CHAR) + } + + # Init string buffer parameters. The first char of the string buffer + # is reserved as a null string, used for graphcap control strings + # omitted from the graphcap entry for the device. + + CCP_SZSBUF(g_cc) = SZ_SBUF + CCP_NEXTCH(g_cc) = CCP_SBUF(g_cc) + 1 + Memc[CCP_SBUF(g_cc)] = EOS + + # Get the device resolution, dimensions in meters, and meter-to-pltr + # unit conversion factor from graphcap; if none are specified, use + # compile-time constants. + + xres = ttygeti (tty, "xr") + if (xres <= 0) + xres = GKI_MAXNDC + yres = ttygeti (tty, "yr") + if (yres <= 0) + yres = GKI_MAXNDC + + xwidth = ttygetr (tty, "xs") + if (xwidth <= 0.0) + xwidth = MAX_PL_XWIDTH + yheight = ttygetr (tty, "ys") + if (yheight <= 0.0) + yheight = MAX_PL_YHEIGHT + + mper_punit = ttygetr (tty, "MP") + if (mper_punit <= 0.0) + mper_punit = DEF_MPER_PUNIT + + # Set up coordinate transformation if not explicitly specified to + # kernel task at run time. Scale determined from graphcap is saved + # in case ccp_escape gets a metacode scale it cannot translate. + # Set up default scale such that a full max_gki_ndc plot will fit in y. + + g_ydefault_scale = yheight / (mper_punit * GKI_MAXNDC) + if (IS_INDEF (g_ytask_scale)) + g_yndcto_p = g_ydefault_scale + + g_xdefault_scale = xwidth / (mper_punit * GKI_MAXNDC) + if (IS_INDEF (g_xtask_scale)) + g_xndcto_p = g_xdefault_scale + + # Initialize the character scaling parameters, required for text + # generation. The heights are given in NDC units in the graphcap + # file, which we convert to GKI units. Estimated values are + # supplied if the parameters are missing in the graphcap entry. + + char_height = ttygetr (tty, "ch") + if (char_height < EPSILON) + char_height = 1.0 / 35.0 + char_height = char_height * GKI_MAXNDC + + char_width = ttygetr (tty, "cw") + if (char_width < EPSILON) + char_width = 1.0 / 80.0 + char_width = char_width * GKI_MAXNDC + + # If the plotter has a set of discrete character sizes, get the + # size of each by fetching the parameter "tN", where the N is + # a digit specifying the text size index. Compute the height and + # width of each size character from the "ch" and "cw" parameters + # and the relative scale of character size I. + + CCP_NCHARSIZES(g_cc) = min (MAX_CHARSIZES, ttygeti (tty, "th")) + nextch = CCP_NEXTCH(g_cc) + + if (CCP_NCHARSIZES(g_cc) <= 0) { + CCP_NCHARSIZES(g_cc) = 1 + CCP_CHARSIZE(g_cc,1) = 1.0 + CCP_CHARHEIGHT(g_cc,1) = char_height + CCP_CHARWIDTH(g_cc,1) = char_width + } else { + Memc[nextch+2] = EOS + for (i=1; i <= CCP_NCHARSIZES(g_cc); i=i+1) { + Memc[nextch] = 't' + Memc[nextch+1] = TO_DIGIT(i) + char_size = ttygetr (tty, Memc[nextch]) + CCP_CHARSIZE(g_cc,i) = char_size + CCP_CHARHEIGHT(g_cc,i) = char_height * char_size + CCP_CHARWIDTH(g_cc,i) = char_width * char_size + } + } + + # Get dash length, gap length, and n-tracing separation width: + if (IS_INDEF (g_dashlen)) { + g_dashlen = ttygetr (tty, "DL") + if (g_dashlen <= 0.0) + g_dashlen = DEF_DASHLEN + } + if (IS_INDEF (g_gaplen)) { + g_gaplen = ttygetr (tty, "GL") + if (g_gaplen <= 0.0) + g_gaplen = DEF_GAPLEN + } + if (IS_INDEF (g_plwsep)) { + g_plwsep = ttygetr (tty, "PW") + if (g_plwsep <= 0.0) + g_plwsep = DEF_PLWSEP + } + + # Initialize the output parameters. All boolean parameters are stored + # as integer flags. All string valued parameters are stored in the + # string buffer, saving a pointer to the string in the CCP + # descriptor. If the capability does not exist the pointer is set to + # point to the null string at the beginning of the string buffer. + + CCP_POLYLINE(g_cc) = btoi (ttygetb (tty, "pl")) + CCP_POLYMARKER(g_cc) = btoi (ttygetb (tty, "pm")) + CCP_FILLAREA(g_cc) = btoi (ttygetb (tty, "fa")) + CCP_FILLSTYLE(g_cc) = ttygeti (tty, "fs") + CCP_ROAM(g_cc) = btoi (ttygetb (tty, "ro")) + CCP_ZOOM(g_cc) = btoi (ttygetb (tty, "zo")) + CCP_ZRES(g_cc) = ttygeti (tty, "zr") + CCP_SELERASE(g_cc) = btoi (ttygetb (tty, "se")) + CCP_PIXREP(g_cc) = btoi (ttygetb (tty, "pr")) + + # Initialize the input parameters. + + CCP_CURSOR(g_cc) = 1 + + # Save the device string in the descriptor. + nextch = CCP_NEXTCH(g_cc) + CCP_DEVNAME(g_cc) = nextch + CCP_DEVCHAN(g_cc) = CCP_LDEV + maxch = CCP_SBUF(g_cc) + SZ_SBUF - nextch + 1 + nextch = nextch + gstrcpy (devname, Memc[nextch], maxch) + 1 + CCP_NEXTCH(g_cc) = nextch + + # Initialize maximum-x tracker, used for "newframe" in ccp_clear. + g_max_x = 0.0 +end diff --git a/sys/gio/calcomp/ccpltype.x b/sys/gio/calcomp/ccpltype.x new file mode 100644 index 00000000..e5325ddd --- /dev/null +++ b/sys/gio/calcomp/ccpltype.x @@ -0,0 +1,27 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include "ccp.h" + +# CCP_LINETYPE -- Set the line type option in the nspp world. + +procedure ccp_linetype (index) + +int index # index for line type switch statement + +include "ccp.com" + +begin + switch (index) { + case GL_CLEAR: + g_ltype = 0 + case GL_DASHED: + g_ltype = 2 + case GL_DOTTED: + g_ltype = 3 + case GL_DOTDASH: + g_ltype = 4 + default: + g_ltype = 1 # GL_SOLID and default + } +end diff --git a/sys/gio/calcomp/ccplwidth.x b/sys/gio/calcomp/ccplwidth.x new file mode 100644 index 00000000..bda9c33b --- /dev/null +++ b/sys/gio/calcomp/ccplwidth.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "ccp.h" + +# Calcomp pen widths +define SINGLE 1 # ***** site dependence!! [MACHDEP] +define DOUBLE 2 # + +# CCP_LWIDTH set pen width; see ccp_color, which also sets pens. +# We should only be called if task param "lwtype" was explicitly set to +# "p" for pen method; normally bold lines are handled by ntracing. + +procedure ccp_lwidth (index) + +int index # index for width switch statement +include "ccp.com" + +begin + if (g_lwover) # CL param lwover, line width override is on; noop + return + + # ***** site dependence; add other pen numbers here; if pen numbers + # for multiple widths are monotonic, make single call to newpen(index). + + switch (index) { + + case DOUBLE: + call newpen (DOUBLE) + default: + call newpen (SINGLE) + } +end diff --git a/sys/gio/calcomp/ccpopen.x b/sys/gio/calcomp/ccpopen.x new file mode 100644 index 00000000..f900b95b --- /dev/null +++ b/sys/gio/calcomp/ccpopen.x @@ -0,0 +1,77 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "ccp.h" + +# CCP_OPEN -- Install the calcomp kernel as a graphics kernel device driver. +# The device table DD consists of an array of the entry point addresses for +# the driver procedures. The table entry for non-implemented procedures is +# set to zero, causing the interpreter to ignore the instruction. + +procedure ccp_open (devname, dd) + +char devname[ARB] # ignored if only one plotter on system +int dd[ARB] # device table to be initialized + +pointer sp, devns +int len_devname +int locpr(), strlen() +extern ccp_openws(), ccp_closews(), ccp_clear() +extern ccp_polyline(), ccp_polymarker(), ccp_text() +extern ccp_plset() +extern ccp_pmset(), ccp_txset() +extern ccp_escape() +include "ccp.com" + +begin + call smark (sp) + call salloc (devns, SZ_FNAME, TY_SHORT) + + # Flag first pass. Save forced device name in common for OPENWS. + # Zero the frame and instruction counters. + + g_cc = NULL + g_ndraw = 0 #????? may not need; also used in ccp_openws,ccp_clear, + # ccp_polyline, ccp_polymarker, ccp_text; may want for + # debug etc. + call strcpy (devname, g_device, SZ_GDEVICE) + + # Install the device driver. + + dd[GKI_OPENWS] = locpr (ccp_openws) + dd[GKI_CLOSEWS] = locpr (ccp_closews) + dd[GKI_DEACTIVATEWS] = 0 + dd[GKI_REACTIVATEWS] = 0 + dd[GKI_MFTITLE] = 0 + dd[GKI_CLEAR] = locpr (ccp_clear) + dd[GKI_CANCEL] = 0 + dd[GKI_FLUSH] = 0 + dd[GKI_POLYLINE] = locpr (ccp_polyline) + dd[GKI_POLYMARKER] = locpr (ccp_polymarker) + dd[GKI_TEXT] = locpr (ccp_text) + dd[GKI_FILLAREA] = 0 + dd[GKI_PUTCELLARRAY] = 0 + dd[GKI_SETCURSOR] = 0 + dd[GKI_PLSET] = locpr (ccp_plset) + dd[GKI_PMSET] = locpr (ccp_pmset) + dd[GKI_TXSET] = locpr (ccp_txset) + dd[GKI_FASET] = 0 + dd[GKI_GETCURSOR] = 0 + dd[GKI_GETCELLARRAY] = 0 + dd[GKI_ESCAPE] = locpr (ccp_escape) + dd[GKI_SETWCS] = 0 + dd[GKI_GETWCS] = 0 + dd[GKI_UNKNOWN] = 0 + + # If a device was named open the workstation as well. This is + # necessary to permit processing of metacode files which do not + # contain the open workstation instruction. + + len_devname = strlen (devname) + if (len_devname > 0) { + call achtcs (devname, Mems[devns], len_devname) + call ccp_openws (Mems[devns], len_devname, NEW_FILE) + } + + call sfree (sp) +end diff --git a/sys/gio/calcomp/ccpopenws.x b/sys/gio/calcomp/ccpopenws.x new file mode 100644 index 00000000..aec063cf --- /dev/null +++ b/sys/gio/calcomp/ccpopenws.x @@ -0,0 +1,87 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <gki.h> +include <error.h> +include "ccp.h" + +# CCP_OPENWS -- Open the named workstation. Once a workstation has been +# opened we leave it open until some other workstation is opened or the +# kernel is closed. Opening a workstation involves initialization of the +# kernel data structures, following by initialization of the device itself. + +procedure ccp_openws (devname, n, mode) + +short devname[ARB] # device name +int n # length of device name +int mode # access mode + +pointer sp, buf +pointer ttygdes() +bool streq() +bool need_open, same_dev +include "ccp.com" + +begin + call smark (sp) + call salloc (buf, SZ_FNAME, TY_CHAR) + + # If a particular plotter was named when the kernel was opened then + # output will always go to that plotter (g_device) regardless of the + # plotter named in the OPENWS instruction. If no plotter was named + # (null string) then unpack the plotter name, passed as a short integer + # array. + + if (g_device[1] == EOS) { + call achtsc (devname, Memc[buf], n) + Memc[buf+n] = EOS + } else + call strcpy (g_device, Memc[buf], SZ_FNAME) + + # Find out if first time, and if not, if same device as before + # note that if (g_cc == NULL), then same_dev is false. + + same_dev = false + need_open = true + + if (g_cc != NULL) { # not first time + same_dev = (streq (Memc[CCP_DEVNAME(g_cc)], Memc[buf])) + if (!same_dev) { + # close previous plotter, initialize new one. + call plot (0, 0, 999) + call plots (0, 0, CCP_DEVCHAN(g_cc)) + } else + need_open = false + } + + # Initialize the kernel data structures. Open graphcap descriptor + # for the named device, allocate and initialize descriptor and common. + # graphcap entry for device must exist. + + if (need_open) { + if ((g_cc != NULL) && !same_dev) + call ttycdes (g_tty) # close prev tty + if (!same_dev) { + iferr (g_tty = ttygdes (Memc[buf])) + call erract (EA_ERROR) + g_ndraw = 0 + } + } + + # Initialize data structures if we had to open a new device. + if (!same_dev) { + call ccp_init (g_tty, Memc[buf]) + call ccp_reset() + call plots (0, 0, CCP_DEVCHAN(g_cc)) + } + + # Advance a frame if device is being opened in new_file mode. + # This is a nop if we really opened a new device, but it will advance + # the paper if this is just a reopen of the same device in new file + # mode. + + if (mode == NEW_FILE) + call ccp_clear (0) + + call sfree (sp) +end diff --git a/sys/gio/calcomp/ccppl.x b/sys/gio/calcomp/ccppl.x new file mode 100644 index 00000000..2b1712bd --- /dev/null +++ b/sys/gio/calcomp/ccppl.x @@ -0,0 +1,105 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "ccp.h" + +# CCP_POLYLINE -- Set up a polyline. The polyline is defined by the array of +# points P, consisting of successive (x,y) coordinate pairs. The first point +# is not plotted unless it is the only point, but rather defines the start of +# the polyline. The remaining points define line segments to be drawn. + +procedure ccp_polyline (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs + +pointer pl, xseg,yseg +int i, curpl_pt, nsegpts +int len_p, segsize, lsize + +include "ccp.com" + +begin + if (npts <= 0) + return + + len_p = npts * 2 + + # Keep track of number of drawing instructions since last frame clear. + g_ndraw = g_ndraw + 1 + + # Update polyline attributes if necessary. + pl = CCP_PLAP(g_cc) + + if (CCP_LTYPE(g_cc) != PL_LTYPE(pl)) { + call ccp_linetype (PL_LTYPE(pl)) # set g_ltype in ccp.com + CCP_LTYPE(g_cc) = PL_LTYPE(pl) + } + if (CCP_WIDTH(g_cc) != PL_WIDTH(pl)) { + if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5) { + CCP_WIDTH(g_cc) = GKI_PACKREAL(PL_SINGLE) + } else + CCP_WIDTH(g_cc) = PL_WIDTH(pl) + } + if (CCP_COLOR(g_cc) != PL_COLOR(pl)) { + call ccp_color (PL_COLOR(pl)) + CCP_COLOR(g_cc) = PL_COLOR(pl) + } + + # If the overrides are on, or linetype is solid and linewidth is single, + # do simple move and draws: + + if ((g_ltover && g_lwover) || (!g_lwover && g_lwtype == 'p') || + (g_ltype == GL_SOLID && CCP_WIDTH(g_cc) == GKI_PACKREAL(PL_SINGLE)) + || (g_ltover && CCP_WIDTH(g_cc) == GKI_PACKREAL(PL_SINGLE)) || + (g_ltype == GL_SOLID && g_lwover)) { + + if (g_lwtype == 'p') + call newpen (PL_WIDTH(pl)) + + call plot (XTRAN(p[1]), YTRAN(p[2]), CCP_UP) + if (npts == 1) { + call plot (XTRAN(p[1]), YTRAN(p[2]), CCP_DOWN) + } else { # draw normally + do i = 3, len_p, 2 + call plot (XTRAN(p[i]), YTRAN(p[i+1]), CCP_DOWN) + } + + # Store maximum-x point plotted for a "newframe" in ccp_clear. + do i = 1, len_p, 2 + g_max_x = max (XTRAN(p[i]), g_max_x) + + + # Otherwise, must calculate individual segments of dashes and dots, + # keeping their lengths constant along polyline (ccp_calcseg), before + # optionally simulating bold and drawing (ccp_drawseg): + + } else { # vector polyline; simulate linetype, linewidth + + segsize = SEGSIZE + call malloc (xseg, segsize, TY_REAL) + call malloc (yseg, segsize, TY_REAL) + + curpl_pt = 1 + lsize = nint(GKI_UNPACKREAL(CCP_WIDTH(g_cc))) + if (!g_ltover && (g_ltype >= GL_DASHED && g_ltype <= GL_DOTDASH)) { + + while (curpl_pt <= npts) { + call ccp_calcseg (p, npts, g_ltype, curpl_pt, segsize, + xseg,yseg, nsegpts) + call ccp_drawseg (Memr[xseg],Memr[yseg], nsegpts, lsize) + } + + } else { # either (ltype override or solid line), not single wid. + + call ccp_calcseg (p, npts, GL_SOLID, curpl_pt, segsize, xseg, + yseg, nsegpts) + call ccp_drawseg (Memr[xseg],Memr[yseg], nsegpts, lsize) + } + + call mfree (xseg, TY_REAL) + call mfree (yseg, TY_REAL) + } + +end diff --git a/sys/gio/calcomp/ccpplset.x b/sys/gio/calcomp/ccpplset.x new file mode 100644 index 00000000..c118f93e --- /dev/null +++ b/sys/gio/calcomp/ccpplset.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "ccp.h" + +# CCP_PLSET -- Set the polyline attributes. The polyline width parameter is +# passed to the encoder as a packed floating point number, i.e., int(LWx100). + +procedure ccp_plset (gki) + +short gki[ARB] # attribute structure +pointer pl +include "ccp.com" + +begin + pl = CCP_PLAP(g_cc) + PL_LTYPE(pl) = gki[GKI_PLSET_LT] + PL_WIDTH(pl) = gki[GKI_PLSET_LW] + PL_COLOR(pl) = gki[GKI_PLSET_CI] +end diff --git a/sys/gio/calcomp/ccppm.x b/sys/gio/calcomp/ccppm.x new file mode 100644 index 00000000..bb6c783f --- /dev/null +++ b/sys/gio/calcomp/ccppm.x @@ -0,0 +1,73 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <math.h> +include "ccp.h" + +define DIAGSEP (1.0 * g_plwsep / 0.7071068) # dis at 40 degrees from plwsep + +# CCP_POLYMARKER -- Draw a polymarker. The polymarker is defined by the array +# of points P, consisting of successive (x,y) coordinate pairs. + +procedure ccp_polymarker (p, npts) + +short p[ARB] # points defining line +int npts # number of points, i.e., (x,y) pairs + +pointer pm +int i, j, len_p +real theta, x, y, tx, ty +include "ccp.com" + +begin + if (npts <= 0) + return + + len_p = npts * 2 + + # Keep track of the number of drawing instructions since the last frame + # clear. + g_ndraw = g_ndraw + 1 + + # Update polymarker attributes if necessary. + + pm = CCP_PMAP(g_cc) + + if (CCP_LTYPE(g_cc) != PM_LTYPE(pm)) { + call ccp_linetype (PM_LTYPE(pm)) + CCP_LTYPE(g_cc) = PM_LTYPE(pm) + } + if (CCP_WIDTH(g_cc) != PM_WIDTH(pm)) + CCP_WIDTH(g_cc) = PM_WIDTH(pm) + + if (CCP_COLOR(g_cc) != PM_COLOR(pm)) { + call ccp_color (PM_COLOR(pm)) + CCP_COLOR(g_cc) = PM_COLOR(pm) + } + + # Draw the polymarker. + do i = 1, len_p, 2 { + # Draw the single point as a box with a diagonal + # through it. + + theta = 0.5 * HALFPI + x = XTRAN(p[i]) + y = YTRAN(p[i+1]) + tx = x + DIAGSEP * cos (theta) + ty = y + DIAGSEP * sin (theta) + call plot (tx, ty, CCP_UP) + g_max_x = max (tx, g_max_x) + + do j = 1, 4 { + theta = theta + HALFPI + tx = x + DIAGSEP * cos (theta) + ty = y + DIAGSEP * sin (theta) + call plot (tx, ty, CCP_DOWN) + } + + # Fill in diagonal. + tx = x + DIAGSEP * cos (theta + PI) + ty = y + DIAGSEP * sin (theta + PI) + call plot (tx, ty, CCP_DOWN) + } +end diff --git a/sys/gio/calcomp/ccppmset.x b/sys/gio/calcomp/ccppmset.x new file mode 100644 index 00000000..2f3f5534 --- /dev/null +++ b/sys/gio/calcomp/ccppmset.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include "ccp.h" + +# CCP_PMSET -- Set the polymarker attributes. + +procedure ccp_pmset (gki) + +short gki[ARB] # attribute structure +pointer pm +include "ccp.com" + +begin + pm = CCP_PMAP(g_cc) + PM_LTYPE(pm) = gki[GKI_PMSET_MT] + PM_WIDTH(pm) = gki[GKI_PMSET_MW] + PM_COLOR(pm) = gki[GKI_PMSET_CI] +end diff --git a/sys/gio/calcomp/ccpreset.x b/sys/gio/calcomp/ccpreset.x new file mode 100644 index 00000000..7d4514f6 --- /dev/null +++ b/sys/gio/calcomp/ccpreset.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gki.h> +include <gset.h> +include "ccp.h" + +# CCP_RESET -- Reset the state of the transform common, i.e., in response to +# a clear or a cancel. Initialize all attribute packets to their default +# values and set the current state of the device to undefined, forcing the +# device state to be reset when the next output instruction is executed. + +procedure ccp_reset() + +pointer pl, pm, fa, tx +include "ccp.com" + +begin + # Set pointers to attribute substructures. + pl = CCP_PLAP(g_cc) + pm = CCP_PMAP(g_cc) + fa = CCP_FAAP(g_cc) + tx = CCP_TXAP(g_cc) + + # Initialize the attribute packets. + PL_LTYPE(pl) = GL_SOLID + PL_WIDTH(pl) = GKI_PACKREAL(PL_SINGLE) + PL_COLOR(pl) = 1 + PM_LTYPE(pm) = GL_SOLID + PM_WIDTH(pm) = GKI_PACKREAL(PL_SINGLE) + PM_COLOR(pm) = 1 + TX_UP(tx) = 90 + TX_SIZE(tx) = GKI_PACKREAL(1.) + TX_PATH(tx) = GT_RIGHT + TX_HJUSTIFY(tx) = GT_LEFT + TX_VJUSTIFY(tx) = GT_BOTTOM + TX_FONT(tx) = GT_ROMAN + TX_COLOR(tx) = 1 + TX_SPACING(tx) = 0.0 + + # Set the device attributes to undefined, forcing them to be reset + # when the next output instruction is executed. + + CCP_LTYPE(g_cc) = -1 + CCP_WIDTH(g_cc) = -1 + CCP_COLOR(g_cc) = -1 + CCP_TXSIZE(g_cc) = -1 + CCP_TXFONT(g_cc) = -1 +end diff --git a/sys/gio/calcomp/ccptx.x b/sys/gio/calcomp/ccptx.x new file mode 100644 index 00000000..b93b5223 --- /dev/null +++ b/sys/gio/calcomp/ccptx.x @@ -0,0 +1,463 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include <gset.h> +include <gki.h> +include "ccp.h" + +define BASECS_X 12 # Base (size 1.0) char width in GKI coords. +define BASECS_Y 12 # Base (size 1.0) char height in GKI coords. + + +# CCP_TEXT -- Draw a text string. The string is drawn at the position (X,Y) +# using the text attributes set by the last GKI_TXSET instruction. The text +# string to be drawn may contain embedded set font escape sequences of the +# form \fR (roman), \fG (greek), etc. We break the input text sequence up +# into segments at font boundaries and draw these on the output device, +# setting the text size, color, font, and position at the beginning of each +# segment. + +procedure ccp_text (xc, yc, text, n) + +int xc, yc # where to draw text string +short text[ARB] # text string +int n # number of characters + +real g_dx, g_dy # scale GKI to window coords +int g_x1, g_y1 # origin of device window +int g_x2, g_y2 # upper right corner of device window +real x, y, dx, dy, tsz, xto_nicesize, yto_nicesize +int x1, x2, y1, y2, orien +int x0, y0, gki_dx, gki_dy, ch, cw +int xstart, ystart, newx, newy +int totlen, polytext, font, seglen, quality +pointer sp, seg, ip, op, tx, first, pl +int ccx_segment() +include "ccp.com" + +data g_dx /1.0/, g_dy /1.0/ +data g_x1 /0/, g_y1 /0/, g_x2 /GKI_MAXNDC/, g_y2 / GKI_MAXNDC/ + +begin + call smark (sp) + call salloc (seg, n + 2, TY_CHAR) + + # Keep track of the number of drawing instructions since the last frame + # clear. + g_ndraw = g_ndraw + 1 + + # Set pointer to the text attribute structure. + tx = CCP_TXAP(g_cc) + + # Set the text size and color if not already set. Both should be + # invalidated when the screen is cleared. Text color should be + # invalidated whenever another color is set. The text size was + # set by ccp_txset, and is just a scaling factor. + + CCP_TXSIZE(g_cc) = TX_SIZE(tx) + if (TX_COLOR(tx) != CCP_COLOR(g_cc)) { + call ccp_color (TX_COLOR(tx)) + CCP_COLOR(g_cc) = TX_COLOR(tx) + } + + # Set the character-generator quality. Only low (Calcomp "symbol") + # and other (ccp_font; see NSPP doc. on its font) are supported. + if (g_txquality == 0) { + quality = TX_QUALITY(tx) # param was specified "normal" to task + } else + quality = g_txquality # param was explicit to task + + # Set the linetype to a solid line, and invalidate last setting. + call ccp_linetype (GL_SOLID) # for use in ccp_polyline + CCP_LTYPE(g_cc) = -1 # PL_LTYPE still contains current settng + + # Set pointer to polyline attribute structure and set line width + # if necessary. + pl = CCP_PLAP(g_cc) + + if (CCP_WIDTH(g_cc) != PL_WIDTH(pl)) { + if (GKI_UNPACKREAL(PL_WIDTH(pl)) < 1.5) { + CCP_WIDTH(g_cc) = GKI_PACKREAL(PL_SINGLE) + } else + CCP_WIDTH(g_cc) = PL_WIDTH(pl) + } + # Break the text string into segments at font boundaries and count + # the total number of printable characters. + + totlen = ccx_segment (text, n, Memc[seg], TX_FONT(tx)) + + # Compute the text drawing parameters, i.e., the coordinates of the + # first character to be drawn, the step between successive characters, + # and the polytext flag (GKI coords). + + call ccx_parameters (xc,yc, totlen, x0,y0, gki_dx,gki_dy, polytext, + orien) + + # Scale the base sizes. + tsz = GKI_UNPACKREAL(TX_SIZE(tx)) # scale factor + ch = CCP_CHARHEIGHT(g_cc,1) * tsz + cw = CCP_CHARWIDTH(g_cc,1) * tsz + + # Compute correction factors for absolute physical character sizes. + # This also corrects for distortion of high-qual text if xscale<>yscale. + xto_nicesize = g_xdefault_scale / g_xndcto_p + yto_nicesize = g_ydefault_scale / g_yndcto_p + + # The first segment is drawn at (X0,Y0). The separation between + # characters is DX,DY. A segment is drawn as a block if the polytext + # flag is set, otherwise each character is drawn individually. + + x = x0 * g_dx + g_x1 + y = y0 * g_dy + g_y1 + dx = gki_dx * g_dx + dy = gki_dy * g_dy + + for (ip=seg; Memc[ip] != EOS; ip=ip+1) { + # Process the font control character heading the next segment. + font = Memc[ip] + ip = ip + 1 + + # Draw the segment. + while (Memc[ip] != EOS) { + # Clip leading out of bounds characters. + for (; Memc[ip] != EOS; ip=ip+1) { + x1 = x + x2 = x1 + cw * xto_nicesize + y1 = y + y2 = y1 + ch * yto_nicesize + + if (x1 >= g_x1 && x2 <= g_x2 && y1 >= g_y1 && y2 <= g_y2) + break + else { + x = x + dx + y = y + dy + } + + if (polytext == NO) { + ip = ip + 1 + break + } + } + + # Coords of first char to be drawn. + xstart = x + ystart = y + + # Move OP to first out of bounds char. + for (op=ip; Memc[op] != EOS; op=op+1) { + x1 = x + x2 = x1 + cw * xto_nicesize + y1 = y + y2 = y1 + ch * yto_nicesize + + if (x1 <= g_x1 || x2 >= g_x2 || y1 <= g_y1 || y2 >= g_y2) + break + else { + x = x + dx + y = y + dy + } + + if (polytext == NO) { + op = op + 1 + break + } + } + + # Count number of inbounds chars. + seglen = op - ip + + # Leave OP pointing to the end of this segment. + if (polytext == NO) + op = ip + 1 + else { + while (Memc[op] != EOS) + op = op + 1 + } + + # Compute X,Y of next segment. + newx = xstart + (dx * (op - ip)) + newy = ystart + dy + + # Quit if no inbounds chars. + if (seglen == 0) { + x = newx + y = newy + ip = op + next + } + + # Output the inbounds chars. + + first = ip + x = xstart + y = ystart + + while (seglen > 0 && (polytext == YES || ip == first)) { + call ccp_drawchar (Memc[ip], nint(x), nint(y), cw, ch, + orien, font, quality) + ip = ip + 1 + seglen = seglen - 1 + x = x + dx + y = y + dy + } + + x = newx + y = newy + ip = op + } + } + + call sfree (sp) +end + + +# CCX_SEGMENT -- Process the text string into segments, in the process +# converting from type short to char. The only text attribute that can +# change within a string is the font, so segments are broken by \fI, \fG, +# etc. font select sequences embedded in the text. The segments are encoded +# sequentially in the output string. The first character of each segment is +# the font number. A segment is delimited by EOS. A font number of EOS +# marks the end of the segment list. The output string is assumed to be +# large enough to hold the segmented text string. + +int procedure ccx_segment (text, n, out, start_font) + +short text[ARB] # input text +int n # number of characters in text +char out[ARB] # output string +int start_font # initial font code + +int ip, op +int totlen, font + +begin + out[1] = start_font + totlen = 0 + op = 2 + + for (ip=1; ip <= n; ip=ip+1) { + if (text[ip] == '\\' && text[ip+1] == 'f') { + # Select font. + out[op] = EOS + op = op + 1 + ip = ip + 2 + + switch (text[ip]) { + case 'B': + font = GT_BOLD + case 'I': + font = GT_ITALIC + case 'G': + font = GT_GREEK + default: + font = GT_ROMAN + } + + out[op] = font + op = op + 1 + + } else { + # Deposit character in segment. + out[op] = text[ip] + op = op + 1 + totlen = totlen + 1 + } + } + + # Terminate last segment and add null segment. + + out[op] = EOS + out[op+1] = EOS + + return (totlen) +end + + +# CCX_PARAMETERS -- Set the text drawing parameters, i.e., the coordinates +# of the lower left corner of the first character to be drawn, the spacing +# between characters, and the polytext flag. Input consists of the coords +# of the text string, the length of the string, and the text attributes +# defining the character size, justification in X and Y of the coordinates, +# and orientation of the string. All coordinates are in GKI units. + +procedure ccx_parameters (xc, yc, totlen, x0, y0, dx, dy, polytext, orien) + +int xc, yc # coordinates at which string is to be drawn +int totlen # number of characters to be drawn +int x0, y0 # lower left corner of first char to be drawn +int dx, dy # step in X and Y between characters +int polytext # OK to output text segment all at once +int orien # rotation angle of characters + +pointer tx +int up, path +real dir, sz, ch, cw, cosv, sinv, space, xto_nicesize, yto_nicesize +real xsize, ysize, xvlen, yvlen, xu, yu, xv, yv, p, q, xtmp, ytmp +include "ccp.com" + +begin + tx = CCP_TXAP(g_cc) + + # Compute correction factors for absolute physical character sizes. + # This also removes any warping due to different xscale, yscale. + xto_nicesize = g_xdefault_scale / g_xndcto_p + yto_nicesize = g_ydefault_scale / g_yndcto_p + + # Get character sizes in GKI(plotter) coords; scale y (ch) dimension + # to that of x for absolute scale systems that are different in x,y. + + sz = GKI_UNPACKREAL (TX_SIZE(tx)) + ch = CCP_CHARHEIGHT(g_cc,1) * sz + cw = CCP_CHARWIDTH(g_cc,1) * sz + + # Compute the character rotation angle. This is independent of the + # direction in which characters are drawn. A character up vector of + # 90 degrees (normal) corresponds to a rotation angle of zero. + + up = TX_UP(tx) + orien = up - 90 + + # Determine the direction in which characters are to be plotted. + # This depends on both the character up vector and the path, which + # is defined relative to the up vector. + + path = TX_PATH(tx) + switch (path) { + case GT_UP: + dir = up + case GT_DOWN: + dir = up - 180 + case GT_LEFT: + dir = up + 90 + default: # GT_NORMAL, GT_RIGHT + dir = up - 90 + } + + # ------- DX, DY --------- + # Convert the direction vector into the step size between characters. + # Note CW and CH are in GKI coordinates, hence DX and DY are too. + # Additional spacing of some fraction of the character size is used + # if TX_SPACING is nonzero. + + dir = -DEGTORAD(dir) + cosv = cos (dir) + sinv = sin (dir) + + # Correct for spacing (unrotated and unscaled). + space = (1.0 + TX_SPACING(tx)) + if (path == GT_UP || path == GT_DOWN) + p = ch * space + else + p = cw * space + q = 0 + + # Correct for rotation, scaling differences, and absolute size. + dx = ( p * cosv + q * sinv) * xto_nicesize + dy = (-p * sinv + q * cosv) * yto_nicesize + + # ------- XU, YU --------- + # Determine the coordinates of the center of the first character req'd + # to justify the string, assuming dimensionless characters spaced on + # centers DX,DY apart. + + xvlen = dx * (totlen - 1) + yvlen = dy * (totlen - 1) + + switch (TX_HJUSTIFY(tx)) { + case GT_CENTER: + xu = - (xvlen / 2.0) + case GT_RIGHT: + # If right justify and drawing to the left, no offset req'd. + if (xvlen < 0) + xu = 0 + else + xu = -xvlen + default: # GT_LEFT, GT_NORMAL + # If left justify and drawing to the left, full offset right req'd. + if (xvlen < 0) + xu = -xvlen + else + xu = 0 + } + + switch (TX_VJUSTIFY(tx)) { + case GT_CENTER: + yu = - (yvlen / 2.0) + case GT_TOP: + # If top justify and drawing downward, no offset req'd. + if (yvlen < 0) + yu = 0 + else + yu = -yvlen + default: # GT_BOTTOM, GT_NORMAL + # If bottom justify and drawing downward, full offset up req'd. + if (yvlen < 0) + yu = -yvlen + else + yu = 0 + } + + # ------- XV, YV --------- + # Compute the offset from the center of a single character required + # to justify that character, given a particular character up vector. + # (This could be combined with the above case but is clearer if + # treated separately.) + + p = -DEGTORAD(orien) + cosv = cos(p) + sinv = sin(p) + + # Compute the rotated character size in X and Y. + xsize = abs ( cw * cosv + ch * sinv) * xto_nicesize + ysize = abs (-cw * sinv + ch * cosv) * yto_nicesize + + switch (TX_HJUSTIFY(tx)) { + case GT_CENTER: + xv = 0 + case GT_RIGHT: + xv = - (xsize / 2.0) + default: # GT_LEFT, GT_NORMAL + xv = xsize / 2 + } + + switch (TX_VJUSTIFY(tx)) { + case GT_CENTER: + yv = 0 + case GT_TOP: + yv = - (ysize / 2.0) + default: # GT_BOTTOM, GT_NORMAL + yv = ysize / 2 + } + + # ------- X0, Y0 --------- + # The center coordinates of the first character to be drawn are given + # by the reference position plus the string justification vector plus + # the character justification vector. + + x0 = xc + xu + xv + y0 = yc + yu + yv + + # The character drawing primitive requires the coordinates of the + # lower left corner of the character (irrespective of orientation). + # Compute the vector from the center of a character to the lower left + # corner of a character, rotate to the given orientation, and correct + # the starting coordinates by addition of this vector. + + p = - (cw / 2.0) + q = - (ch / 2.0) + + xtmp = ( p * cosv + q * sinv) * xto_nicesize + ytmp = (-p * sinv + q * cosv) * yto_nicesize + + x0 = x0 + xtmp + y0 = y0 + ytmp + + # ------- POLYTEXT --------- + # Set the polytext flag. Polytext output is possible only if chars + # are to be drawn to the right with no extra spacing between chars. + + if (abs(dy) == 0 && dx == cw) + polytext = YES + else + polytext = NO +end diff --git a/sys/gio/calcomp/ccptxset.x b/sys/gio/calcomp/ccptxset.x new file mode 100644 index 00000000..f2f4f040 --- /dev/null +++ b/sys/gio/calcomp/ccptxset.x @@ -0,0 +1,29 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <gset.h> +include <gki.h> +include "ccp.h" + +# CCP_TXSET -- Set the text drawing attributes. + +procedure ccp_txset (gki) + +short gki[ARB] # attribute structure + +pointer tx +include "ccp.com" + +begin + tx = CCP_TXAP(g_cc) + + TX_UP(tx) = gki[GKI_TXSET_UP] + TX_PATH(tx) = gki[GKI_TXSET_P ] + TX_HJUSTIFY(tx) = gki[GKI_TXSET_HJ] + TX_VJUSTIFY(tx) = gki[GKI_TXSET_VJ] + TX_FONT(tx) = gki[GKI_TXSET_F ] + TX_QUALITY(tx) = gki[GKI_TXSET_Q ] + TX_COLOR(tx) = gki[GKI_TXSET_CI] + + TX_SPACING(tx) = GKI_UNPACKREAL (gki[GKI_TXSET_SP]) + TX_SIZE(tx) = gki[GKI_TXSET_SZ] +end diff --git a/sys/gio/calcomp/doc/ccpspecs.hlp b/sys/gio/calcomp/doc/ccpspecs.hlp new file mode 100644 index 00000000..fae12e4e --- /dev/null +++ b/sys/gio/calcomp/doc/ccpspecs.hlp @@ -0,0 +1,384 @@ +.help +\fBSpecifications for IRAF Calcomp kernel -- (CCP package)\fR + + +The Calcomp kernel (package prefix "ccp") will implement selected GKI +instructions, using only calls to the Calcomp routines \fBplots\fR, +\fBplot\fR, \fBnewpen\fR and \fBsymbol\fR. + + +There are two sub-components of the CCP package: 1) the kernel driver +task allowing a user to send a specified graphics metafile to the plotter, and +2) the low-level kernel routines which implement specific GKI instructions, +and which make the only calls to the Calcomp library. + + +.nh +\fBCL interface -- task CALCOMP\fR + + +The driver task, \fBcalcomp\fR, allows a user to direct an existing GKI metacode +file to a particular Calcomp plotter under control of a set of CL parameters. +The task is loaded either by being run directly from the CL as a task, or by +being invoked through inter-process control following a write-to-pseudofile +containing the GKI_OPENWS metacode instruction. The task may +optionally control certain kinds of debug output. + +.nf +CL parameters to the kernel driver task \fBcalcomp\fR: + +input,s,a,,,,"input metacode file" +device,s,h,"calcomp",,,"output device" +generic,b,h,no,,,"ignore remaining kernel dependent parameters" +debug,b,h,no,,,"print decoded graphics instructions during processing" +verbose,b,h,no,,,"print elements of polylines, etc. in debug mode" +gkiunits,b,h,no,,,"print coordinates in GKI rather than NDC units" +xscale,r,h,INDEF,0.0,,"plotter x = GKI_NDC_X * xscale" +yscale,r,h,INDEF,0.0,,"plotter y = GKI_NDC_Y * yscale" +txquality,s,h,"normal","normal|low|high",,"character quality; n=from metacode" +lwtype,s,h,"ntracing","ntracing|penchange",,"bold line/text implementation" +ltover,b,h,no,,,"override line type simulation" +lwover,b,h,no,,,"override line width simulation" +lcover,b,h,no,,,"override line color implementation by penchange" +dashlen,r,h,INDEF,0.0,,"dashed line dash length, pltr units; 0.5 reasonable" +gaplen,r,h,INDEF,0.0,,"dashed line gap length, pltr units; 0.1 reasonable" +plwsep,r,hl,INDEF,0.,,"polyline width separation for ntracing; 0.005 reasonable" + +.fi + + +.nh +\fBSuggested GRAPHCAP entry for calcomp plotter\fR + +.nf + + p5|calcomp|calcomp pen plotter:\ + :kf=xcalcomp.e:tn=calcomp:co#132:li#66:xr#32767:yr#5375:\ + :ch#.0294:cw#.0125:xs#1.664564:ys#0.27305:\ + :PU=inches:MP#.0254:DL#.50:GL#.10:PW#.005:\ + :DD=plot!calcomp,/tmp/gcaXXXXXX,\ + !{ cd /tmp; nice /local/bin/plotX -Tcalcomp -W=1 $F |\ + nice /usr/bin/plot -Tcalcomp; rm $F; }&: + + #xs 1.664564 # maximum x in meters; max at .002 inches step size + #ys .27305000 # maximum y in meters; 10.75 inch paper + #xr 32767 # max resolution in x; limited by GKI short int coords + #yr 5375 # max resolution in y; 10.75 inches at .002 inches step + #PU inches # plotter units + #MP 0.0254 # meters per plotter unit + #DL 0.5000 # dash length in plotter units + #GL 0.1000 # gap length in plotter units + #PW 0.0050 # n-tracing (bold line simul.) width sep. in pltr units + #if yscale not set by kernel, g_yndcto_p = GKI_MAXNDC/(MP*yr); 32767/10.75" + #if xscale not set by kernel, g_xndcto_p = g_yndcto_p; square aspect ratio + +.fi + + +.nh +\fBInterface between CALCOMP task and lower-level kernel routines\fR + + +Two kernel routines will normally be called from outside the GKI +instruction-stream decoding facility (as from the driver task): + +.nf + ccp_open (devname, dd) + + devname: device name of desired Calcomp plotter (must have + entry in graphcap file) + + dd: array of entry point addresses to lower-level kernel + routines + + discussion: linking to multiple Calcomp plotters is a + site-dependent function. Ordinarily devname is + ignored; if this kernel is called, output will go + to the device initialized by the Calcomp library. + See ccp_openws. + + + ccp_close () + + discussion: causes a Calcomp "newframe" -- resets origin to + right of last previously-plotted point. + + +.fi +.nh +\fBLow-level kernel routines\fR + + +All remaining kernel routines will normally be called either by ccp_open or +by gki_execute, or by each other. Following are descriptions of the +implementation of GKI instructions: +.nf + + GKI_EOF + + Not implemented; it should be trapped outside the kernel, as in + \fBgki_execute\fR. + + GKI_OPENWS + + ccp_openws (devname, len_devname, mode) + + devname; len_devname: + + name of plotter, name length, if not present in metafile + + mode: + + file access mode for gki metafile; if NEWFILE, a Calcomp + "newframe" (reorigin to right of previous plot) will + occur; if APPEND mode, no newframe. + + discussion: + + There is no output metafile; device connection and any + site-specific spooling is handled below this level. + Note that there must be a graphcap entry for devname. + + GKI_CLOSEWS + + ccp_closews () + + discussion: + + As there is no output metafile, this is a noop. + + GKI_REACTIVATEWS + + Not implemented. + + GKI_DEACTIVATEWS + + Not implemented. + + GKI_MFTITLE + + Not implemented. + + GKI_CLEARWS + + ccp_clear () + + discussion: + + Implemented only by a Calcomp "newframe"; there is no + output metacode file for spooling at this level. + + GKI_CANCEL + + Not implemented, since there is no buffered output. + + GKI_FLUSH + + Not implemented. + + GKI_POLYLINE + + ccp_polyline (p, npts) + + p: array of points (x1, y1, x2, y2, ...) + + npts: number of pairs + + discussion: + + To GKI, ccp_polyline will appear pretty normal; due to + the lack of settable parameters like dashed-line in + Calcomp, such features are implemented in further layers + between ccp_polyline and the actual Calcomp vector-draw + routine. See kernel task parameters lwtype, lwover, and + ltover for line width and type control. + + GKI_POLYMARKER + + ccp_polymarker (p, npts) + + arguments: same as above + + discussion: + + Ccp_polymarker will merely dot the location at the + coordinate passed in; more complicated marker + symbols will be assumed to have been handled above, for + purposes of clipping, and will be drawn with ccp_polyline + at this level. + + GKI_TEXT + + ccp_text (x, y, text, nchar) + + x, y: + + NDC coordinates of text stream; note that the JUSTIFY + parameters in GSET determine where these coordinates are + relative to the text characters. + + text: array of type short characters + + nchar: number of chars in text + + discussion: + + The same levels of text quality will be supported as in + the stdgraph kernel; normal is taken from the metacode + request, medium and high fonts are stroke text, while low + quality is Calcomp hardware text. Depending on the + particular plotter controller at each site, low quality + text may or may not be significantly faster than stroke + text. + + The special Calcomp symbols numbered 0 - 15 in the + Calcomp symbol library are invoked by characters with + ASCII values 0 - 15. When using hardware text generation, + the ASCII symbol requested will be mapped to the Calcomp + set if possible; otherwise, a default "indefinite" character + will appear. + + GKI_FILLAREA + + ccp_fillarea (p, npts) + + p, npts: same as above for ccp_polyline + + discussion: + + With Calcomp, fillarea could only be implemented by + simulating with hatching patterns, a time-consuming + process for a pen plotter. We may or may not choose + to do this, depending upon users' needs. For the + very similar Versaplot kernel which may follow, it + should definitely be implemented, using Versaplot's + \fBtone\fR call. Initially, it will only be implemented + here with a call to ccp_polyline for the border. + + GKI_PUTCELLARRAY + + Not implemented. + + GKI_SETCURSOR + + Not implemented. + + GKI_PLSET + + ccp_plset (gki) + + gki: attribute structure decoded by gki + + discussion: + + Line types documented in the GIO manual will be + implemented in software except for "erase", unless the + CL parameter to the CALCOMP task "ltover" is on, in + which case all lines drawn will be solid. See task + parameters dash and gap. In the future, line types + numbered higher than 4 may be implemented using various + combinations of dashes and dots as in Morse code. Line + width and color may be similarly implemented or overridden; + if not overridden, line width will be done by default using + n-tracing (n = nearest integer value of line width) or by a + penchange, under control of task parameter "lwtype". + + GKI_PMSET + + ccp_pmset (gki) + + gki, discussion: Same as for ccp_plset. + + GKI_TXSET + + ccp_txset (gki) + + gki, discussion: + + Internal flags are set from structure gki controlling + text up vector, path relative to up vector, horizontal + and vertical justification, font, quality, color, + spacing, and size. For high-quality text, all flags are + implemented (color by a pen change, with optional + override); see GKI_TEXT discussion. + + GKI_FASET + + ccp_faset (gki) + + gki, discussion: + + Internal flags are set for fill area style and color. + If we decide to implement fill area in software (the only + way for Calcomp), we will use GKS conventions wherever + possible. + + GKI_GETCURSOR + + Not implemented. The Calcomp \fBwhere\fR routine would only + duplicate GCURPOS in GIO. + + GKI_CURSORVALUE + + Not implemented; not an interactive device. + + GKI_GETCELLARRAY + + Not implemented; not a storage device. + + GKI_CELLARRAY + + Not implemented. + + GKI_ESCAPE + + ccp_escape (fn, instruction, nwords) + + fn: escape function code + + instruction, nwords: + + Nwords-long array of short integers containing the + instruction sequence. + + discussion: + + A high-level task may pass the NDC-to-plotter units + coordinate scaling factor down into the kernel to + permit exact scaling. The scale factors will be + set in common to allow fast access by the ccp_draw + routine. + + GKI_ESCAPE = BOI 25 L FN N DC + + L(i) 5 + N + FN(i) escape function code + N(i) number of escape data words + DC(i) escape data words + + 1) xndc_to_plotter: + + FN = ESC_XNDCTO_P (currently = 1 in ccp.h) + N = number of characters in the scale specification + DC = array of N short integers containing character- + packed scale (must be achtsc'd then ctod'd to + get x scale) + + 2) yndc_to_plotter: + + FN = ESC_YNDCTO_P (currently = 2 in ccp.h) + N = same as in (1) + DC = same as in (1) + + The macros ESC_*NDCTO_P, currently defined in ccp.h, should + probably be defined in a gki-public place like gki.h. + + + GKI_SETWCS + + Not implemented. + + GKI_GETWCS + + Not implemented. +.fi diff --git a/sys/gio/calcomp/font.com b/sys/gio/calcomp/font.com new file mode 100644 index 00000000..ec1b0ec9 --- /dev/null +++ b/sys/gio/calcomp/font.com @@ -0,0 +1,207 @@ +# CHRTAB -- Table of strokes for the printable ASCII characters. Each character +# is encoded as a series of strokes. Each stroke is expressed by a single +# integer containing the following bitfields: +# +# 2 1 +# 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 +# | | | | | | | +# | | | +---------+ +---------+ +# | | | | | +# | | | X Y +# | | | +# | | +-- pen up/down +# | +---- begin paint (not used at present) +# +------ end paint (not used at present) +# +#------------------------------------------------------------------------------ + +# Define the database. + +short chridx[96] # character index in chrtab +short chrtab[800] # stroke data to draw the characters + +# Index into CHRTAB of each printable character (starting with SP). + +data (chridx(i), i=01,05) / 1, 3, 12, 21, 30/ +data (chridx(i), i=06,10) / 45, 66, 79, 85, 92/ +data (chridx(i), i=11,15) / 99, 106, 111, 118, 121/ +data (chridx(i), i=16,20) / 128, 131, 141, 145, 154/ +data (chridx(i), i=21,25) / 168, 177, 187, 199, 203/ +data (chridx(i), i=26,30) / 221, 233, 246, 259, 263/ +data (chridx(i), i=31,35) / 268, 272, 287, 307, 314/ +data (chridx(i), i=36,40) / 327, 336, 344, 352, 359/ +data (chridx(i), i=41,45) / 371, 378, 385, 391, 398/ +data (chridx(i), i=46,50) / 402, 408, 413, 425, 433/ +data (chridx(i), i=51,55) / 445, 455, 468, 473, 480/ +data (chridx(i), i=56,60) / 484, 490, 495, 501, 506/ +data (chridx(i), i=61,65) / 511, 514, 519, 523, 526/ +data (chridx(i), i=66,70) / 529, 543, 554, 563, 574/ +data (chridx(i), i=71,75) / 585, 593, 607, 615, 625/ +data (chridx(i), i=76,80) / 638, 645, 650, 663, 671/ +data (chridx(i), i=81,85) / 681, 692, 703, 710, 723/ +data (chridx(i), i=86,90) / 731, 739, 743, 749, 754/ +data (chridx(i), i=91,95) / 759, 764, 776, 781, 793/ +data (chridx(i), i=96,96) / 801/ + +# Stroke data. + +data (chrtab(i), i=001,005) / 36, 1764, 675, 29328, 585/ +data (chrtab(i), i=006,010) / 21063, 21191, 21193, 21065, 29383/ +data (chrtab(i), i=011,015) / 1764, 355, 29023, 351, 29027/ +data (chrtab(i), i=016,020) / 931, 29599, 927, 29603, 1764/ +data (chrtab(i), i=021,025) / 603, 29066, 842, 29723, 1302/ +data (chrtab(i), i=026,030) / 28886, 143, 29839, 1764, 611/ +data (chrtab(i), i=031,035) / 29256, 78, 20810, 21322, 21581/ +data (chrtab(i), i=036,040) / 21586, 21334, 20822, 20569, 20573/ +data (chrtab(i), i=041,045) / 20833, 21345, 29789, 1764, 419/ +data (chrtab(i), i=046,050) / 20707, 20577, 20574, 20700, 20892/ +data (chrtab(i), i=051,055) / 21022, 21025, 20899, 1187, 28744/ +data (chrtab(i), i=056,060) / 717, 21194, 21320, 21512, 21642/ +data (chrtab(i), i=061,065) / 21645, 21519, 21327, 21197, 1764/ +data (chrtab(i), i=066,070) / 1160, 20700, 20704, 20835, 21027/ +data (chrtab(i), i=071,075) / 21152, 21149, 20561, 20556, 20744/ +data (chrtab(i), i=076,080) / 21192, 29841, 1764, 611, 21023/ +data (chrtab(i), i=081,085) / 21087, 21155, 21091, 1764, 739/ +data (chrtab(i), i=086,090) / 21087, 21018, 21009, 21068, 29384/ +data (chrtab(i), i=091,095) / 1764, 547, 21151, 21210, 21201/ +data (chrtab(i), i=096,100) / 21132, 29192, 1764, 93, 29774/ +data (chrtab(i), i=101,105) / 608, 29259, 78, 29789, 1764/ +data (chrtab(i), i=106,110) / 604, 29260, 84, 29780, 1764/ +data (chrtab(i), i=111,115) / 516, 21062, 21065, 21001, 21000/ +data (chrtab(i), i=116,120) / 21064, 1764, 84, 29780, 1764/ +data (chrtab(i), i=121,125) / 585, 21063, 21191, 21193, 21065/ +data (chrtab(i), i=126,130) / 21191, 1764, 72, 29859, 1764/ +data (chrtab(i), i=131,135) / 419, 20573, 20558, 20872, 21320/ +data (chrtab(i), i=136,140) / 21646, 21661, 21347, 20899, 1764/ +data (chrtab(i), i=141,145) / 221, 21155, 29320, 1764, 95/ +data (chrtab(i), i=146,150) / 20835, 21411, 21663, 21655, 20556/ +data (chrtab(i), i=151,155) / 20552, 29832, 1764, 95, 20899/ +data (chrtab(i), i=156,160) / 21347, 21663, 21658, 21334, 29270/ +data (chrtab(i), i=161,165) / 854, 5266, 21644, 21320, 20872/ +data (chrtab(i), i=166,170) / 28749, 1764, 904, 21411, 21283/ +data (chrtab(i), i=171,175) / 20561, 20559, 21391, 911, 13455/ +data (chrtab(i), i=176,180) / 1764, 136, 21320, 21645, 21652/ +data (chrtab(i), i=181,185) / 21337, 20889, 20565, 20579, 29859/ +data (chrtab(i), i=186,190) / 1764, 83, 20888, 21336, 21651/ +data (chrtab(i), i=191,195) / 21645, 21320, 20872, 20557, 20563/ +data (chrtab(i), i=196,200) / 20635, 29347, 1764, 99, 21667/ +data (chrtab(i), i=201,205) / 29064, 1764, 355, 20575, 20570/ +data (chrtab(i), i=206,210) / 20822, 20562, 20556, 20808, 21384/ +data (chrtab(i), i=211,215) / 21644, 21650, 21398, 20822, 918/ +data (chrtab(i), i=216,220) / 5274, 21663, 21411, 20835, 1764/ +data (chrtab(i), i=221,225) / 648, 21584, 21656, 21662, 21347/ +data (chrtab(i), i=226,230) / 20899, 20574, 20568, 20883, 21331/ +data (chrtab(i), i=231,235) / 21656, 1764, 602, 21210, 21207/ +data (chrtab(i), i=236,240) / 21079, 21082, 21207, 592, 21069/ +data (chrtab(i), i=241,245) / 21197, 21200, 21072, 21197, 1764/ +data (chrtab(i), i=246,250) / 602, 21146, 21143, 21079, 21082/ +data (chrtab(i), i=251,255) / 21143, 585, 21132, 21136, 21072/ +data (chrtab(i), i=256,260) / 21071, 21135, 1764, 988, 20628/ +data (chrtab(i), i=261,265) / 29644, 1764, 1112, 28824, 144/ +data (chrtab(i), i=266,270) / 29776, 1764, 156, 21460, 28812/ +data (chrtab(i), i=271,275) / 1764, 221, 20704, 20899, 21218/ +data (chrtab(i), i=276,280) / 21471, 21466, 21011, 21007, 521/ +data (chrtab(i), i=281,285) / 20999, 21127, 21129, 21001, 21127/ +data (chrtab(i), i=286,290) / 1764, 908, 20812, 20560, 20571/ +data (chrtab(i), i=291,295) / 20831, 21407, 21659, 21651, 21521/ +data (chrtab(i), i=296,300) / 21393, 21331, 21335, 21210, 21018/ +data (chrtab(i), i=301,305) / 20887, 20883, 21009, 21201, 21331/ +data (chrtab(i), i=306,310) / 1764, 72, 20963, 21219, 29768/ +data (chrtab(i), i=311,315) / 210, 5074, 1764, 99, 21411/ +data (chrtab(i), i=316,320) / 21663, 21658, 21398, 20566, 918/ +data (chrtab(i), i=321,325) / 5266, 21644, 21384, 20552, 20579/ +data (chrtab(i), i=326,330) / 1764, 1165, 21320, 20872, 20557/ +data (chrtab(i), i=331,335) / 20574, 20899, 21347, 29854, 1764/ +data (chrtab(i), i=336,340) / 99, 21347, 21662, 21645, 21320/ +data (chrtab(i), i=341,345) / 20552, 20579, 1764, 99, 20552/ +data (chrtab(i), i=346,350) / 29832, 86, 13078, 99, 29859/ +data (chrtab(i), i=351,355) / 1764, 99, 20552, 86, 13078/ +data (chrtab(i), i=356,360) / 99, 29859, 1764, 722, 21650/ +data (chrtab(i), i=361,365) / 29832, 1165, 4936, 20872, 20557/ +data (chrtab(i), i=366,370) / 20574, 20899, 21347, 29854, 1764/ +data (chrtab(i), i=371,375) / 99, 28744, 85, 5269, 1160/ +data (chrtab(i), i=376,380) / 29859, 1764, 291, 29603, 611/ +data (chrtab(i), i=381,385) / 4680, 328, 29576, 1764, 77/ +data (chrtab(i), i=386,390) / 20872, 21256, 21581, 29795, 1764/ +data (chrtab(i), i=391,395) / 99, 28744, 1160, 20887, 82/ +data (chrtab(i), i=396,400) / 13475, 1764, 99, 20552, 29832/ +data (chrtab(i), i=401,405) / 1764, 72, 20579, 21077, 21603/ +data (chrtab(i), i=406,410) / 29768, 1764, 72, 20579, 21640/ +data (chrtab(i), i=411,415) / 29859, 1764, 94, 20899, 21347/ +data (chrtab(i), i=416,420) / 21662, 21645, 21320, 20872, 20557/ +data (chrtab(i), i=421,425) / 20574, 862, 29859, 1764, 72/ +data (chrtab(i), i=426,430) / 20579, 21411, 21663, 21656, 21396/ +data (chrtab(i), i=431,435) / 20564, 1764, 94, 20557, 20872/ +data (chrtab(i), i=436,440) / 21320, 21645, 21662, 21347, 20899/ +data (chrtab(i), i=441,445) / 20574, 536, 29828, 1764, 72/ +data (chrtab(i), i=446,450) / 20579, 21411, 21663, 21657, 21398/ +data (chrtab(i), i=451,455) / 20566, 918, 13448, 1764, 76/ +data (chrtab(i), i=456,460) / 20808, 21384, 21644, 21649, 21397/ +data (chrtab(i), i=461,465) / 20822, 20570, 20575, 20835, 21411/ +data (chrtab(i), i=466,470) / 29855, 1764, 648, 21155, 99/ +data (chrtab(i), i=471,475) / 29923, 1764, 99, 20557, 20872/ +data (chrtab(i), i=476,480) / 21320, 21645, 29859, 1764, 99/ +data (chrtab(i), i=481,485) / 21064, 29795, 1764, 99, 20808/ +data (chrtab(i), i=486,490) / 21141, 21448, 29923, 1764, 99/ +data (chrtab(i), i=491,495) / 29832, 72, 29859, 1764, 99/ +data (chrtab(i), i=496,500) / 21079, 29256, 599, 13411, 1764/ +data (chrtab(i), i=501,505) / 99, 21667, 20552, 29832, 1764/ +data (chrtab(i), i=506,510) / 805, 20965, 20935, 29447, 1764/ +data (chrtab(i), i=511,515) / 99, 29832, 1764, 421, 21221/ +data (chrtab(i), i=516,520) / 21191, 29063, 1764, 288, 21091/ +data (chrtab(i), i=521,525) / 29600, 1764, 3, 29891, 1764/ +data (chrtab(i), i=526,530) / 547, 29341, 1764, 279, 21207/ +data (chrtab(i), i=531,535) / 21396, 21387, 21127, 20807, 20555/ +data (chrtab(i), i=536,540) / 20558, 20753, 21201, 21391, 907/ +data (chrtab(i), i=541,545) / 13447, 1764, 99, 28744, 76/ +data (chrtab(i), i=546,550) / 4424, 21256, 21516, 21523, 21271/ +data (chrtab(i), i=551,555) / 20823, 20563, 1764, 981, 21271/ +data (chrtab(i), i=556,560) / 20823, 20563, 20556, 20808, 21256/ +data (chrtab(i), i=561,565) / 29642, 1764, 1043, 4887, 20823/ +data (chrtab(i), i=566,570) / 20563, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=571,575) / 1032, 29731, 1764, 80, 5136/ +data (chrtab(i), i=576,580) / 21523, 21271, 20823, 20563, 20556/ +data (chrtab(i), i=581,585) / 20808, 21256, 29707, 1764, 215/ +data (chrtab(i), i=586,590) / 29591, 456, 20958, 21153, 21409/ +data (chrtab(i), i=591,595) / 29727, 1764, 67, 20800, 21248/ +data (chrtab(i), i=596,600) / 21508, 29719, 1043, 21271, 20823/ +data (chrtab(i), i=601,605) / 20563, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=606,610) / 1764, 99, 28744, 83, 4439/ +data (chrtab(i), i=611,615) / 21271, 21523, 29704, 1764, 541/ +data (chrtab(i), i=616,620) / 21019, 21147, 21149, 21021, 21147/ +data (chrtab(i), i=621,625) / 533, 21077, 29256, 1764, 541/ +data (chrtab(i), i=626,630) / 21019, 21147, 21149, 21021, 21147/ +data (chrtab(i), i=631,635) / 533, 21077, 21058, 20928, 20736/ +data (chrtab(i), i=636,640) / 28802, 1764, 99, 28744, 84/ +data (chrtab(i), i=641,645) / 29530, 342, 13320, 1764, 483/ +data (chrtab(i), i=646,650) / 21089, 21066, 29384, 1764, 87/ +data (chrtab(i), i=651,655) / 28744, 584, 21076, 84, 4375/ +data (chrtab(i), i=656,660) / 20951, 21076, 21207, 21399, 21588/ +data (chrtab(i), i=661,665) / 29768, 1764, 87, 28744, 83/ +data (chrtab(i), i=666,670) / 20823, 21271, 21523, 29704, 1764/ +data (chrtab(i), i=671,675) / 83, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=676,680) / 21523, 21271, 20823, 20563, 1764/ +data (chrtab(i), i=681,685) / 87, 28736, 83, 20823, 21271/ +data (chrtab(i), i=686,690) / 21523, 21516, 21256, 20808, 20556/ +data (chrtab(i), i=691,695) / 1764, 1047, 29696, 1036, 21256/ +data (chrtab(i), i=696,700) / 20808, 20556, 20563, 20823, 21271/ +data (chrtab(i), i=701,705) / 21523, 1764, 87, 28744, 83/ +data (chrtab(i), i=706,710) / 20823, 21271, 29716, 1764, 74/ +data (chrtab(i), i=711,715) / 20808, 21256, 21514, 21518, 21264/ +data (chrtab(i), i=716,720) / 20816, 20562, 20565, 20823, 21271/ +data (chrtab(i), i=721,725) / 21461, 1764, 279, 29591, 970/ +data (chrtab(i), i=726,730) / 21320, 21128, 21002, 21025, 1764/ +data (chrtab(i), i=731,735) / 87, 20556, 20808, 21256, 21516/ +data (chrtab(i), i=736,740) / 1032, 29719, 1764, 151, 21064/ +data (chrtab(i), i=741,745) / 29719, 1764, 87, 20808, 21077/ +data (chrtab(i), i=746,750) / 21320, 29783, 1764, 151, 29704/ +data (chrtab(i), i=751,755) / 136, 29719, 1764, 87, 21064/ +data (chrtab(i), i=756,760) / 320, 29783, 1764, 151, 21527/ +data (chrtab(i), i=761,765) / 20616, 29704, 1764, 805, 21157/ +data (chrtab(i), i=766,770) / 21026, 21017, 20951, 20822, 20949/ +data (chrtab(i), i=771,775) / 21011, 21001, 21127, 21255, 1764/ +data (chrtab(i), i=776,780) / 611, 29273, 594, 29256, 1764/ +data (chrtab(i), i=781,785) / 485, 21093, 21218, 21209, 21271/ +data (chrtab(i), i=786,790) / 21398, 21269, 21203, 21193, 21063/ +data (chrtab(i), i=791,795) / 29127, 1764, 83, 20758, 20950/ +data (chrtab(i), i=796,800) / 21265, 21457, 29844, 1764, 0/ diff --git a/sys/gio/calcomp/font.h b/sys/gio/calcomp/font.h new file mode 100644 index 00000000..c33dc6ee --- /dev/null +++ b/sys/gio/calcomp/font.h @@ -0,0 +1,29 @@ +# NCAR font definitions. + +define CHARACTER_START 32 +define CHARACTER_END 126 +define CHARACTER_HEIGHT 26 +define CHARACTER_WIDTH 17 + +define FONT_LEFT 0 +define FONT_CENTER 9 +define FONT_RIGHT 27 +define FONT_TOP 36 +define FONT_CAP 34 +define FONT_HALF 23 +define FONT_BASE 9 +define FONT_BOTTOM 0 +define FONT_WIDTH 27 +define FONT_HEIGHT 36 + +define COORD_X_START 7 +define COORD_Y_START 1 +define COORD_PEN_START 13 +define COORD_X_LEN 6 +define COORD_Y_LEN 6 +define COORD_PEN_LEN 1 + +define PAINT_BEGIN_START 14 +define PAINT_END_START 15 +define PAINT_BEGIN_LEN 1 +define PAINT_END_LEN 1 diff --git a/sys/gio/calcomp/mkpkg b/sys/gio/calcomp/mkpkg new file mode 100644 index 00000000..f4b7f8b9 --- /dev/null +++ b/sys/gio/calcomp/mkpkg @@ -0,0 +1,52 @@ +# Make the CALCOMP GIO graphics kernel. Requires the host system library +# LIB_CALCOMP, which must be callable from an IRAF program (which is not the +# same as a Fortran program). + +$checkout libccp.a lib$ +$update libccp.a +$checkin libccp.a lib$ +$call relink +$exit + +update: # update lib$x_calcomp.e + $call relink + $call install + ; + +relink: # make x_calcomp.e in local directory + $omake x_calcomp.x + $link x_calcomp.o -lccp $(LIB_CALCOMP) + ; + +install: # install in system library + $move x_calcomp.e bin$ + ; + +libccp.a: + ccpclear.x ccp.com ccp.h <mach.h> + ccpclose.x ccp.com ccp.h + ccpclws.x ccp.com ccp.h + ccpcolor.x ccp.com ccp.h + ccpcseg.x ccp.com ccp.h <gki.h> <gset.h> <mach.h> + ccpdrawch.x ccp.com ccp.h font.com font.h <gki.h> <gset.h>\ + <math.h> + ccpdseg.x ccp.com ccp.h <math.h> + ccpescape.x ccp.com ccp.h <gescape.h> + ccpfa.x ccp.com ccp.h + ccpfaset.x ccp.com ccp.h <gki.h> + ccpfont.x ccp.com ccp.h <gki.h> <gset.h> + ccpinit.x ccp.com ccp.h <ctype.h> <gki.h> <mach.h> + ccpltype.x ccp.com ccp.h <gset.h> + ccplwidth.x ccp.com ccp.h + ccpopen.x ccp.com ccp.h <gki.h> + ccpopenws.x ccp.com ccp.h <error.h> <gki.h> <mach.h> + ccppl.x ccp.com ccp.h <gki.h> <gset.h> + ccpplset.x ccp.com ccp.h <gki.h> + ccppm.x ccp.com ccp.h <gki.h> <math.h> + ccppmset.x ccp.com ccp.h <gki.h> + ccpreset.x ccp.com ccp.h <gset.h> <gki.h> + ccptx.x ccp.com ccp.h <gki.h> <gset.h> <math.h> + ccptxset.x ccp.com ccp.h <gki.h> <gset.h> + rptheta4.x <math.h> + t_calcomp.x <error.h> <gki.h> ccp.com ccp.h <gset.h> <mach.h> + ; diff --git a/sys/gio/calcomp/rptheta4.x b/sys/gio/calcomp/rptheta4.x new file mode 100644 index 00000000..b2ee42b7 --- /dev/null +++ b/sys/gio/calcomp/rptheta4.x @@ -0,0 +1,37 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> + +define PIOVER4 (0.25 * PI) +define THREEPIOVER4 (0.75 * TWOPI) + +# RPTHETA4 -- Polar angle, Real precision, 4 arguments; from p1(x,y) to p2(x,y): +# angle between line segment p1-p2 and horizontal +x axis centered on p1; +# returned in radians; single precision (see pdtheta4). + +real procedure rptheta4 (p1x, p1y, p2x, p2y) + +real p1x,p1y, p2x,p2y # x,y of each point +real dx, dy, ang + +begin + dx = p2x - p1x + dy = p2y - p1y + + if (dx == 0.0) { + if (dy >= 0.0) { + ang = HALFPI + } else { + ang = THREEPIOVER4 + } + } else { + ang = atan (dy / dx) + if (dx < 0.0) { # 2nd or 3rd quadrant + ang = ang + PI + } else if (dy < 0.0) { # 4th quadrant + ang = ang + TWOPI + } + } + + return (ang) +end diff --git a/sys/gio/calcomp/t_calcomp.x b/sys/gio/calcomp/t_calcomp.x new file mode 100644 index 00000000..0164d043 --- /dev/null +++ b/sys/gio/calcomp/t_calcomp.x @@ -0,0 +1,125 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <gki.h> +include <gset.h> +include <mach.h> +include "ccp.h" + +define SZ_TXQUALITY 1 + +# CALCOMP -- Graphics kernel for Calcomp pen plotter output. The whole +# package is copied as much as possible from the NSPP kernel. + +procedure t_calcomp() + +int fd, list +pointer gki, sp, fname, devname +int dev[LEN_GKIDD], deb[LEN_GKIDD] +int debug, verbose, gkiunits +char txquality[SZ_TXQUALITY] +bool clgetb() +char clgetc() +real clgetr() +int clpopni(), clgfil(), open(), btoi() +int gki_fetch_next_instruction() + +include "ccp.com" + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (devname, SZ_FNAME, TY_CHAR) + + # Open list of metafiles to be decoded. + list = clpopni ("input") + + # Get parameters. + call clgstr ("device", Memc[devname], SZ_FNAME) + + if (clgetb ("generic")) { + debug = NO + verbose = NO + gkiunits = NO + g_xtask_scale = INDEF + g_xndcto_p = INDEF + g_ytask_scale = INDEF + g_yndcto_p = INDEF + g_txquality = 0 + g_lwtype = 'n' + g_ltover = false + g_lwover = true + g_lcover = false + g_dashlen = INDEF + g_gaplen = INDEF + g_plwsep = INDEF + + } else { + debug = btoi (clgetb ("debug")) + verbose = btoi (clgetb ("verbose")) + gkiunits = btoi (clgetb ("gkiunits")) + + # scale precedence: calcomp.par->metacode->graphcap->compile_time + g_xtask_scale = clgetr ("xscale") + if (!IS_INDEF (g_xtask_scale)) + g_xndcto_p = g_xtask_scale + g_ytask_scale = clgetr ("yscale") + if (!IS_INDEF (g_ytask_scale)) + g_yndcto_p = g_ytask_scale + + # Get the quality parameter for the text generator. + call clgstr ("txquality", txquality, SZ_TXQUALITY) + switch (txquality[1]) { + case 'l': + g_txquality = GT_LOW + case 'm': + g_txquality = GT_MEDIUM + case 'h': + g_txquality = GT_HIGH + default: + g_txquality = 0 # .par default is "normal" + } + + # Method of line width implementation: + g_lwtype = clgetc ("lwtype") + + # The overrides: + g_ltover = clgetb ("ltover") + g_lwover = clgetb ("lwover") + g_lcover = clgetb ("lcover") + + # Plotter line type, width control: + g_dashlen = clgetr ("dashlen") + g_gaplen = clgetr ("gaplen") + g_plwsep = clgetr ("plwsep") + } + + # Open the graphics kernel. + call ccp_open (Memc[devname], dev) + call gkp_install (deb, STDERR, verbose, gkiunits) + + # Process a list of metacode files, writing the decoded metacode + # instructions on the standard output. + + while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) { + # Open input file. + iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) { + call erract (EA_WARN) + next + } + + # Process the metacode instruction stream. + while (gki_fetch_next_instruction (fd, gki) != EOF) { + if (debug == YES) + call gki_execute (Mems[gki], deb) + call gki_execute (Mems[gki], dev) + } + + call close (fd) + } + + call gkp_close() + call ccp_close() + call clpcls (list) + call sfree (sp) +end diff --git a/sys/gio/calcomp/vttest.par b/sys/gio/calcomp/vttest.par new file mode 100644 index 00000000..fcbcb2ad --- /dev/null +++ b/sys/gio/calcomp/vttest.par @@ -0,0 +1,10 @@ +lname,s,hl,"ltest1.dat",,,"input polyline test file name" +tname,s,hl,"ttest3.dat",,,"input text test file name" +ltype,i,hl,1,1,6,"line type" +lwidth,i,hl,1,1,15,"line width" +mtype,i,hl,0,0,1023,"polymarker type code" +dashlen,r,hl,10000.,0.,,"length of dash in plotter units" +gaplen,r,hl,5000.,0.,,"width of gap in plotter units" +plwsep,r,hl,50.,0.,,"polyline width separation for ntracing" +option,s,hl,"l",,,"test option: {l-line; t-text; m-marker}" +device,s,hl,"vt640",,,"output device for test program" diff --git a/sys/gio/calcomp/vttest.x b/sys/gio/calcomp/vttest.x new file mode 100644 index 00000000..ceff7c7a --- /dev/null +++ b/sys/gio/calcomp/vttest.x @@ -0,0 +1,608 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <gki.h> +include <gset.h> +include <gio.h> +include <ctype.h> +include <math.h> +include "ccp.h" + +define SZ_BUF 2048 +define PIOVER4 (0.25 * PI) +define THREEPIOVER4 (0.75 * TWOPI) +define MAXCH 15 + +# X_VTTEST -- testing task for simulating calcomp kernel routines on vt640 + +task vttest = t_vttest + +# T_VTTEST -- test low-level Calcomp graphics simulation routines on vt640 + +procedure t_vttest () + +char lname[SZ_FNAME], tname[SZ_FNAME], devname[SZ_FNAME] +int ltype, lwidth, npts, n, mtype, i +char testoption +pointer x, y, gp, sim_gp +short p[ARB] + +pointer sp, nambuf, pl, pm +int clgeti (), strlen () +real clgetr () +char clgetc () +pointer ttygdes (), gopen () + +include "ccp.com" +common /simulate/ sim_gp + +string fdevice "vt640" + +begin + call smark (sp) + call salloc (nambuf, SZ_FNAME, TY_CHAR) + + testoption= clgetc ("option") + if (testoption == 'l') { + call clgstr ("lname", lname, SZ_FNAME) + ltype = clgeti ("ltype") + lwidth = clgeti ("lwidth") # width in rel. units + g_dashlen = clgetr ("dashlen") + g_gaplen = clgetr ("gaplen") + g_plwsep = clgetr ("plwsep") + } else if (testoption == 't') { + call clgstr ("tname", tname, SZ_FNAME) + g_plwsep = clgetr ("plwsep") + } else if (testoption == 'm') { + mtype = clgeti ("mtype") + } + call clgstr ("device", devname, SZ_FNAME) + + n = strlen (devname) + if (g_device[1] == EOS) { + call achtsc (devname, Memc[nambuf], n) + Memc[nambuf+n] = EOS + } + iferr (g_tty = ttygdes (Memc[nambuf])) + call erract (EA_ERROR) + g_cc = NULL + call ccp_init (g_tty, Memc[nambuf]) + call ccp_reset () + + g_xndcto_p = 1.0 # for testing, raw data is NDC-space (0-32767) + g_yndcto_p = 1.0 # (that is, after passing through to_short()) + g_ltover = false + g_lwover = true + + pl = CCP_PLAP(g_cc) + pm = CCP_PMAP(g_cc) + + PL_LTYPE(pl) = ltype + PL_WIDTH(pl) = GKI_PACKREAL(lwidth) + PM_LTYPE(pm) = mtype + + gp = gopen (devname, NEW_FILE, STDGRAPH) + sim_gp = gp + call gsview (gp, 0.0, 0.63, 0.0, 1.0) # square viewport + call gswind (gp, 0.0, 32767.0, 0.0, 32767.0) + + switch (testoption) { + + case 'l': # polyline + + call rddata (lname, x, y, npts) # range 0.0-1.0 + call to_short (Memr[x], Memr[y], npts, p) # range 0-32767 + call ccp_polyline (p, npts) + + case 't': # text + + call testtext (gp, tname) # read, calc, call ccppl + + case 'm': # polymarker + + call rddata (lname, x, y, npts) # x,y array of mrkr pos. + do i = 1, npts { + call calcmarker (32767 * Memr[x+i-1], 32767 * Memr[y+i-1], + mtype, p, npts) + call ccp_polymarker (p, npts) + } + } + + call gclose (gp) + call ccp_close () # free g descriptors + call mfree (x, TY_REAL) + call mfree (y, TY_REAL) + call sfree (sp) +end + +# TO_SHORT -- convert x, y real arrays to short integers as NDC coords + +procedure to_short (x, y, npts, p) + +real x[ARB], y[ARB] +int npts +short p[ARB] + +int i, j + +begin + do i = 1, npts, 1 { + j = (i - 1) * 2 + 1 + p[j] = x[i] * 32767 + p[j+1] = y[i] * 32767 + } + return +end + +# CALCMARKER -- calculate and return a pattern of points representing a +# polymarker of the specified type, origined at x, y. + +procedure calcmarker (x, y, marktype, p, npts) + +real x,y # GKI_NDC coordinates of marker origin +int marktype # polymarker type, specified in GIO specs +short p[ARB] # output array of points defining marker, in GKI_NDC +int npts # no. of points; x,y pairs (= 1/2 elements in p) + +int i, j, m, fill +real xsize, ysize +pointer tx +int and() + +include "ccp.com" +include "/iraf/sys/gio/markers.dat" + +begin + tx = CCP_TXAP(g_cc) + xsize = CCP_CHARHEIGHT(g_cc,1) * GKI_UNPACKREAL(TX_SIZE(tx)) + ysize = xsize # for now + # The point marker type cannot be combined with the other types and + # is treated as a special case. The remaining markers are drawn + # using GUMARK, which draws marks represented as polygons + + if (marktype == GM_POINT || (xsize == 0 && ysize == 0)) { + p[1] = x + p[2] = y + npts = 1 + + } else { + + # The polylines for the standard marks are stored in MPX and MPY + # at offsets MXO and MYO. + fill = NO + npts = 0 + do i = GM_FIRSTMARK, GM_LASTMARK + if (and (marktype, 2 ** i) != 0) { + m = i - GM_FIRSTMARK + 1 + do j = 1, mnpts[m] { + npts = npts + 1 + p[npts*2-1] = x - 0.5 * xsize + xsize * mpx[moff[m]+j-1] + p[npts*2] = y - 0.5 * ysize + ysize * mpy[moff[m]+j-1] + } + } + } +end + + +procedure rddata (fname, x, y, npts) + +char fname[ARB] +pointer x, y +int npts + +int buflen, n, fd, ncols, lineno, i, status, testint +pointer sp, lbuf, ip +real xval, yval, maxy +int getline(), nscan(), open() +errchk open, sscan, getline, malloc + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + fd = open (fname, READ_ONLY, TEXT_FILE) + + buflen = SZ_BUF + iferr { + call malloc (x, buflen, TY_REAL) + call malloc (y, buflen, TY_REAL) + } then + call erract (EA_FATAL) + + n = 0 + ncols = 0 + lineno = 0 + + status = 0 + while (status != EOF) { + iferr (status = getline (fd, Memc[lbuf])) { + call eprintf ("getline error from rddata: status=%d\n") + call pargi (status) + call erract (EA_FATAL) + } + if (status == EOF) + next + # Skip comment lines and blank lines. + lineno = lineno + 1 + if (Memc[lbuf] == '#') + next + for (ip=lbuf; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '\n' || Memc[ip] == EOS) + next + + # Decode the points to be plotted. + call sscan (Memc[ip]) + call gargr (xval) + call gargr (yval) + + # The first line determines whether we have an x,y list or a + # y-list. It is an error if only one value can be decoded when + # processing a two column list. + + if (ncols == 0 && nscan() > 0) + ncols = nscan() + + switch (nscan()) { + case 0: + call eprintf ("no args; %s, line %d: %s\n") + call pargstr (fname) + call pargi (lineno) + call pargstr (Memc[lbuf]) + next + case 1: + yval = xval + default: # normally, ncols=2 + if (ncols != 2) { + call eprintf ("weird data; file %s, line %d: %s\n") + call pargstr (fname) + call pargi (lineno) + call pargstr (Memc[lbuf]) + next + } + } + + n = n + 1 + if (n > buflen) { + buflen = buflen + SZ_BUF + call realloc (x, buflen, TY_REAL) + call realloc (y, buflen, TY_REAL) + } + + Memr[x+n-1] = xval + Memr[y+n-1] = yval + testint = x+n-1 + } + + if (ncols == 1) { + maxy = 0.0 + do i = 1, n + maxy = max (Memr[y+i-1], maxy) + do i = 1, n + Memr[x+i-1] = maxy * real(i) / real(n) + } + call realloc (x, n, TY_REAL) + call realloc (y, n, TY_REAL) + + call close (fd) + call sfree (sp) + npts = n +end + + +# RPTHETA4 -- Polar angle, Real precision, 4 arguments; from p1(x,y) to p2(x,y): +# angle between line segment p1-p2 and horizontal +x axis centered on p1; +# returned in radians; single precision (see pdtheta4). + +real procedure rptheta4 (p1x, p1y, p2x, p2y) + +real p1x,p1y, p2x,p2y # x,y of each point + +real dx, dy, ang + +begin + dx = p2x - p1x + dy = p2y - p1y + if (dx == 0.0) { + if (dy >= 0.0) { + ang = HALFPI + } else { + ang = THREEPIOVER4 + } + } else { + ang = atan (dy / dx) + if (dx < 0.0) { # 2nd or 3rd quadrant + ang = ang + PI + } else if (dy < 0.0) { # 4th quadrant + ang = ang + TWOPI + } + } + return (ang) +end + +# PLOT -- simulate Calcomp's PLOT routine for testing development version of +# calcomp kernel + +procedure plot (x, y, pencode) + +real x,y # plotter coords (ndc in simulation) +int pencode + +real lastp_x, lastp_y + +pointer gp +common /simulate/ gp + +begin + if (pencode == CCP_DOWN) + call gline (gp, lastp_x, lastp_y, x, y) + if (pencode == CCP_DOWN || pencode == CCP_UP) { + lastp_x = x + lastp_y = y + } +end + +# PLOTS -- simulate calcomp plots routine for testing ccp code on vt640 + +procedure plots (dum1, dum2, ldev) + +int dum1, dum2, ldev + +begin + return +end + + +# NEWPEN -- temporary dummy routine for simulating Calcomp + +procedure newpen (whichpen) + +int whichpen + +begin + return +end + +# SYMBOL -- simulate Calcomp's SYMBOL routine for testing development version of +# calcomp kernel + +procedure symbol (xp, yp, size, ch, orien, nchar) + +real xp,yp # plotter coords (ndc in simulation) +real size # char size in plotter coords +char ch[ARB] # chars to be drawn +real orien # degrees counterclockwise from +x to rightward vector +int nchar # number of chars + +pointer gp +common /simulate/ gp + +string format "" + +begin + ch[nchar+1] = EOS + call gseti (gp, G_TXUP, 90 + int(orien)) + call gsetr (gp, G_TXSIZE, size) + call gtext (gp, xp, yp, ch, format) +end + + +# TESTTEXT -- read sequential lines from designated file and call ccp_text to +# draw text at specified coordinates in specified format. + +procedure testtext (gp, fname) + +pointer gp # graphics device +char fname[SZ_FNAME] # name of file from which to extract table + +int fd, textlen, restlen, ip, op +char lbuf[SZ_LINE], ttext[SZ_LINE], rest[SZ_LINE], tformat[SZ_LINE], quote +short sttext[SZ_LINE] +real x,y +int open (), strlen (), getline (), nscan () + +string errmsg "unable to open table file " +data quote/34/ + +begin + iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) { + call sprintf (errmsg[27], SZ_FNAME, "%s") + call pargstr (fname) + call fatal (EA_FATAL, errmsg) + } + + while (getline (fd, lbuf) != EOF) { + # Skip comment lines and blank lines. + if (lbuf[1] == '#') + next + for (ip=1; IS_WHITE(lbuf[ip]); ip=ip+1) + ; + if (lbuf[ip] == '\n' || lbuf[ip] == EOS) + next + + # Decode. + call sscan (lbuf[ip]) + call gargr (x) + call gargr (y) + call gargstr (rest, SZ_LINE) + + if (nscan() < 3) # insufficient fields; ignore line, not nice. + next + + restlen = strlen (rest) + + # Pull out text buffer: + for (ip=1; rest[ip] != quote && ip < restlen; ip=ip+1) #->1st " + ; + op = 0 + for (ip=ip+1; rest[ip] != quote && ip < restlen; ip=ip+1) { + op = op + 1 + ttext[op] = rest[ip]; + } + textlen = op + ttext[op+1] = EOS + + # Pull out format string: + for (ip=ip+1; IS_WHITE(rest[ip]); ip=ip+1) #-> past whitesp + ; + op = 0 + for (; ip <= restlen && !IS_WHITE(rest[ip]); ip=ip+1) { + op = op + 1 + tformat[op] = rest[ip]; + } + tformat[op+1] = EOS + + # set ccp descriptor text attributes if specified: + if (tformat[1] != EOS) + call testxset (tformat) + call achtcs (ttext, sttext, textlen) # ccp_text expects short text + sttext[textlen+1] = EOS + call ccp_text (nint(x), nint(y), sttext, textlen) + } + call close (fd) +end + + +# TESTXSET -- Parse a text drawing format string and set the values of the text +# attributes in the TX (g_cc) output structure. + +procedure testxset (format) + +char format[ARB] # text attribute format string + +pointer tx +char attribute[MAXCH], value[MAXCH] +real tempsize +int ip, op, tip, temp, ch +int h_v[4], v_v[4], f_v[4], q_v[4], p_v[4] +int ctoi(), ctor(), stridx() + +include "ccp.com" + +define badformat_ 91 + +string h_c "nclr" +data h_v /GT_NORMAL, GT_CENTER, GT_LEFT, GT_RIGHT/ +string v_c "nctb" +data v_v /GT_NORMAL, GT_CENTER, GT_TOP, GT_BOTTOM/ +string f_c "rgib" +data f_v /GT_ROMAN, GT_GREEK, GT_ITALIC, GT_BOLD/ +string q_c "nlmh" +data q_v /GT_NORMAL, GT_LOW, GT_MEDIUM, GT_HIGH/ +string p_c "lrud" +data p_v /GT_LEFT, GT_RIGHT, GT_UP, GT_DOWN/ + +begin + # ccp kernel text descriptor: + tx = CCP_TXAP(g_cc) + + # Parse the format string and set the text attributes. The code is + # more general than need be, i.e., the entire attribute name string + # is extracted but only the first character is used. Whitespace is + # permitted and ignored. + + for (ip=1; format[ip] != EOS; ip=ip+1) { + # Extract the next "attribute=value" construct. + while (IS_WHITE (format[ip])) + ip = ip +1 + + op = 1 + for (ch=format[ip]; ch != EOS && ch != '='; ch=format[ip]) { + if (op <= MAXCH) { + attribute[op] = format[ip] + op = op + 1 + } + ip = ip + 1 + } + attribute[op] = EOS + + if (ch == '=') + ip = ip + 1 + + op = 1 + while (IS_WHITE (format[ip])) + ip = ip +1 + ch = format[ip] + while (ch != EOS && ch != ';' && ch != ',') { + if (op <= MAXCH) { + value[op] = format[ip] + op = op + 1 + } + ip = ip + 1 + ch = format[ip] + } + value[op] = EOS + + if (attribute[1] == EOS || value[1] == EOS) + break + + # Decode the assignment and set the corresponding text attribute + # in the graphics descriptor. + + switch (attribute[1]) { + case 'u': # character up vector + tip = 1 + if (ctoi (value, tip, TX_UP(tx)) <= 0) { + TX_UP(tx) = 90 + goto badformat_ + } + + case 'p': # path + temp = stridx (value[1], p_c) + if (temp <= 0) + goto badformat_ + else + TX_PATH(tx) = p_v[temp] + + case 'c': # color + tip = 1 + if (ctoi (value, tip, TX_COLOR(tx)) <= 0) { + TX_COLOR(tx) = 1 + goto badformat_ + } + + case 's': # character size scale factor + tip = 1 + if (ctor (value, tip, tempsize) <= 0) { + TX_SIZE(tx) = GKI_PACKREAL(1.0) + goto badformat_ + } + TX_SIZE(tx) = GKI_PACKREAL(tempsize) + + case 'h': # horizontal justification + temp = stridx (value[1], h_c) + if (temp <= 0) + goto badformat_ + else + TX_HJUSTIFY(tx) = h_v[temp] + + case 'v': # vertical justification + temp = stridx (value[1], v_c) + if (temp <= 0) + goto badformat_ + else + TX_VJUSTIFY(tx) = v_v[temp] + + case 'f': # font + temp = stridx (value[1], f_c) + if (temp <= 0) + goto badformat_ + else + TX_FONT(tx) = f_v[temp] + + case 'q': # font quality + temp = stridx (value[1], q_c) + if (temp <= 0) + goto badformat_ + else + TX_QUALITY(tx) = q_v[temp] + + default: +badformat_ call eprintf ("Warning (testtxset): bad gtext format '%s'\n") + call pargstr (format) + } + + if (format[ip] == EOS) + break + } +end diff --git a/sys/gio/calcomp/x_calcomp.x b/sys/gio/calcomp/x_calcomp.x new file mode 100644 index 00000000..32c82aa2 --- /dev/null +++ b/sys/gio/calcomp/x_calcomp.x @@ -0,0 +1,3 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +task calcomp = t_calcomp |