;+ ;============================================================================ ; ; file CPSUNCEN.PRO - includes CPTVCOPY, CPCURSOR, CPGET_R_T, ; CPSUNCEN_EV, CPSUNCEN ;============================================================================ ; ; ; NAME: ; CPTVCOPY ; ; PURPOSE: ; Output current window to selected printer ; ; CATEGORY: ; CP display ; ; CALLING SEQUENCE: ; CPTVCOPY, COLO=COLO, NORM_DIFF=NORM_DIFF ; ; CALLED BY: ; CPONE ; ; CALLS TO: ; PSPLOT ; ; INPUTS: ; COLO : -1 means no hard copy allowed ; 0 means hard copy device is B/W ; 1 means hard copy device is color ; NORM_DIFF : 0 means do a normal image ; 1 means do a difference image ; ; OPTIONAL INPUTS: ; none ; ; OUTPUTS: ; none ; ; OPTIONAL OUTPUTS: ; none ; ; COMMON BLOCKS: ; CPWIDGBASES for the widget IDs of the informational windows. ; ; SIDE EFFECTS: ; Prints a file. ; ; RESTRICTIONS: ; none ; ; PROCEDURE: ; Read (TVRD) a window into an array and print it to the selected device. ; ; MODIFICATION HISTORY: ; 1991 - Elaine Einfalt (HSTX) ; ;- pro cptvcopy, colo=colo, norm_diff=norm_diff @cpwidgbases.common widget_control, comment, set_value='Copying IDL window...', /append snap = byte(tvrd(0,0,!d.x_size,!d.y_size)) oxsiz=21. & oysiz = oxsiz * (!d.y_size/float(!d.x_size)) yoff=24.5 & if norm_diff eq 0 then xoff=3. else xoff=4.5 set_plot,'ps',/copy device, /landscape, bits_per_pixel=8, xsize=oxsiz, ysize=oysiz, $ xoffset=xoff, yoffset=yoff, color=colo, filename='CP.PS' tv,snap device,/close & set_plot,'x' widget_control, comment, set_value='Printing output', /append ; if colo eq 0 then spawn,'print/setup=psi/delete/notify idl.ps' $ ; else spawn,'print/que=color$script/notify/delete idl.ps' psplot, filename='CP.PS', color=colo, /delete widget_control, onebase, sensitive=1 end ;============================================================================ ;+ ; ; NAME: ; CPCURSOR ; ; PURPOSE: ; Draw users requested R and theta ; ; CATEGORY: ; CPDISPLAY ; ; CALLING SEQUENCE: ; CPCURSOR, XCUR=XCUR, YCUR=YCUR, SC_SIZ=SC_SIZ, SIN_MOV=SIN_MOV, $ ; RULECONDITION=RULECONDITION, RULETIMES=RULETIMES, $ ; RADIUS=RADIUS, THETA=THETA, RD=R, $ ; RADIALMAX=RADIALMAX, COLO=COLO, ROLL=ROLL, $ ; xcenter=xcenter, ycenter=ycenter, housekp=housekp ; ; CALLED BY: ; CPSUNCEN ; ; CALLS TO: ; CPGET_R_T, CPSCANS ; ; INPUTS: ; DATA : the image array ; SC_SIZ : radius of area to be marked as suncenter (pixels) ; an arbitrary number large enough for cursor click termination ; SIN_MOV : 0 means current display mode is for single images ; 1 means current display mode is for movies ; RULECONDITION : 0 means draw ruler s/c thru R/theta ; 1 means mark R/theta click w/ circle ; 2 means don't draw ruler or mark ; 3 means plot radial scan ; 4 means plot azmuthal scan ; RULETIMES : 0 will never be set if this routine is called ; 1 means pick 1 R/theta ; 2 means pick multiple R/theta ; 3 means enter R/theta ; 4 means use r/theta already in memory ; ; RADIUS : radius array for solar disk ; THETA : array of all degree in a circle (360) convert to radians ; R : the sun's radius in pixel, (and a terrible variable name) ; RADIALMAX : the largest radial extent for this image ; COLO : -1 means no hard copy allowed ; 0 means hard copy device is B/W ; 1 means hard copy device is color ; ROLL : the angle of solar north in radians, from "+x" axis ; XCENTER : the x-axis coordinate of sun center (in pixels) ; YCENTER : the y-axis coordinate of sun center (in pixels) ; ; OPTIONAL INPUTS: ; none ; ; OUTPUTS: ; none ; ; OPTIONAL OUTPUTS: ; none ; ; COMMON BLOCKS: ; CPLASTPASS to initial array for radial or azmuthal scans ; CPUSERINP for user selected values of r and theta ; CPWIDGBASES for the widget IDs of the informational windows ; ; SIDE EFFECTS: ; Common block values in CPLASTPASS are modified. ; ; RESTRICTIONS: ; none ; ; PROCEDURE: ; Gets user input cursor click and turns it into R and theta. ; Draw over top of the already displayed image R/Theta using option ; requested by the user. ; ; MODIFICATION HISTORY: ; 1991 - Elaine Einfalt (HSTX) ; Mar 93 - moved initial request for R and theta (xcur and ycur) to ; this routine from CPSUNCEN. Also moved XCUR and YCUR ; to common block CPUSERINP ; remove the now obsolete common block CPRULE.COMMON ; added call to CPSCANS, to get radial or azmuthal scans values ;- pro cpcursor, data=data, sc_siz=sc_siz, sin_mov=sin_mov, $ rulecondition=rulecondition, ruletimes=ruletimes, $ radius=radius, theta=theta, rd=r, $ radialmax=radialmax, colo=colo, roll=roll, $ xcenter=xcenter, ycenter=ycenter @cplastpass.common @cpuserinp.common @cpwidgbases.common multi_plot = -1 ; initial scan plots finis = 0 ; user is not finished linecol = !p.color-1 ; red for normal/white for diff if ruletimes ne 4 then begin ; ; Initialize the arrays because not using them from memory ; cpintensity = bytarr(800, 5) - 1 ; data intensities of scans cpabscissa = fltarr(800, 5) - 1 ; theta or Rsun of scans cptheta = -1 ; position angle (deg) vector cprsun = -1 ; Rsun vector cpnum_vals_n_scans = intarr(5)-1 ; in each of up to 5 repeats endif ; ; Get the first R and theta from the user or from memory ; if ruletimes lt 4 then begin ; ; Ask the user for a R and thetas. ; if (ruletimes lt 3) and (colo eq -1) then begin ; ; Using cursor to get R/Theta but can't do that unless we have ; an image on the screen. ; explain = 'CLICK CURSOR ON DESIRED POSITION OR SUN CENTER TO QUIT.' if sin_mov eq 0 $ then widget_control, comment, set_value=explain,/append $ else widget_control, news, set_value=explain, /append cursor, xcur, ycur, /down ; in polar coordinates in pixels, ; with sun center at (0,0) if ((abs(xcur) le sc_siz) and (abs(ycur) le sc_siz)) then finis=1 endif else begin ; ; User wants to manually input R/theta, or they are making ; a print requiring manual input. ; savdev = !d.name savclip = !p.clip ; switching devices does a reset set_plot,'X' ; so widget can ask for R and theta cpget_r_t, sin_mov=sin_mov ; prompt user using a widget set_plot, savdev !p.clip = savclip ; get back into plot coordinates if (xcur eq 0) and (ycur eq 0) then finis=1 endelse ; ; Since the user is done, add the terminator to the R/theta vectors ; if finis then begin cprsun = [cprsun, 0] cptheta = [cptheta, 0] endif endif else begin ; ; Use next value from memory ; xcur = cprsun(1) ; 1st index is bogus ycur = cptheta(1) ; 1st index is bogus if (xcur eq 0) and (ycur eq 0) then finis=1 endelse ; ; Does the user want to quit already? ; if finis then begin explain = 'No R and theta requested, continue processing.' if sin_mov eq 0 $ then widget_control, comment, set_value=explain, /append $ else widget_control, news, set_value=explain, /append return endif repeat begin ; Keep doing R and theta until it is time to stop multi_plot = multi_plot + 1 if ruletimes lt 3 and colo eq -1 then begin ; ; The user clicked mouse on the image, this means the input was ; in a polar coordinate system with sun center at (0,0). ; But also need them as degrees and Rsun. ; rcur = xcur^2 + ycur^2 & rcur = sqrt(rcur) ; radius of cursor click ; in polar pixels rsun = rcur / r ; in solar radii Tclick = atan(ycur,xcur) ; theta (radians) of click pos = Tclick / !dtor ; convert theta to degrees ; c.c.w. from "+X axis" if pos lt 0 then pos = 360 + pos ; adjust to subscript values realdegrees = pos - roll ; true roll, negating polar ; coord. (-90 deg.) ; and CP (-43 degree) if realdegrees lt 0 then realdegrees = realdegrees + 360 ; if neg. endif else begin ; user input R and theta ; ; The user manually enter solar radii and position angle (degrees) ; or used values from memory, so already have as degrees and Rsun. ; But also need them as polar coordinate system with sun center=(0,0). ; rsun = xcur ; user enters solar radii rcur = xcur * r ; user's Rsun times # pixels in 1 Rsun ; for radius in pixels realdegrees = ycur ; user enters degrees pos = (roll + ycur) mod 360 ; to get theta in degrees ; c.c.w. from the "+X" axis, we add ; ROLL. ROLL is a polar coord ; adjustment (+90) and the ; CP weirdness adjustment (+43) and ; spacecraft roll. tclick = pos * !dtor ; convert angle to radians endelse ; ; if radius is too small make it larger ; if rsun lt 0.10 then begin rsun = 0.10 rcur = 0.10 * r endif explain = 'Radius (solar radii) : '+ strtrim(rsun) if sin_mov eq 0 then widget_control, comment, set_value=explain,/append $ else widget_control, news, set_value=explain, /append explain = 'Position angle (degrees) : ' + strtrim(realdegrees) if sin_mov eq 0 then widget_control, comment, set_value=explain,/append $ else widget_control, news, set_value=explain, /append if ruletimes ne 4 then begin ; ; Now have a new radius in solar radii and a theta in degrees, ; so save for possible use later. ; cprsun = [cprsun, rsun] cptheta = [cptheta, realdegrees] endif ; ; User has elected to "Mark R and theta click". ; All this does is to put a PSYM mark at the selected location. ; if rulecondition eq 1 then $ ; mark cursor click oplot, [rcur], [Tclick], psym=4, /polar, color=linecol ; ; User has elected to "Draw R and theta ruler". ; This draws a line from sun center outward thru click and beyond. ; if rulecondition eq 0 then begin ; ; Draw the line ; oplot,[0,radialmax],[Tclick,Tclick], /polar, color=linecol ; ; Draw the ruler's tick marks ; pos = fix(pos+.5) ; round pos to nearest integer thru_R = 5. ; ticks out to thru_R + 1 radii tick = 5 ; degree length of long tick by = 1. ; ticks every "by" of a solar radius for long_short = 0, 1 do begin ; long ticks then short ticks if (pos ge tick) and (pos le 360-tick) then $ ; plot long ruler ticks at 1 thru 5 solar radii for i=0.,thru_R,by do $ oplot,radius(pos-tick:pos+tick)+(r*i),theta(pos-tick:pos+tick), $ /polar, color=linecol $ else begin ; just in case the ticks cross the "+X axis" ; how much above "+X" axis if pos ge 0 and pos lt tick*2 then above = tick + pos $ else above = tick - (360-pos) below = 360 - ((tick*2)-above) ; how much below "+X" axis for i=0.,thru_R,by do begin ; from +X axis upward oplot,radius(0:above)+(r*i),theta(0:above),/polar,color=linecol ; from +X axis down oplot,radius(below:360)+(r*i),theta(below:360),/polar,color=linecol endfor endelse tick = 2 ; degree length of short tick by = .1 ; ticks every "by" of a solar radius endfor endif if rulecondition ge 3 then begin ; ; RULECONDITION 3 : Plot radial scan from 1 solar radii out to cursor. ; RULECONDITION 4 : Plot azmuthal scan at radius of cursor click. ; ; Will not output these scans until later, back in CPTV. ; ; if rcur ge r then begin ; must be at least 1 Rsun ; ; Collect the scan array values. ; cpscans, rulecondition=rulecondition, onersun=r, rcur=rcur, $ tclick=tclick, xcenter=xcenter, ycenter=ycenter, $ roll=roll, multi_plot=multi_plot, sin_mov=sin_mov, $ radialmax=radialmax, linecol=linecol if multi_plot ge 4 then begin savdev = !d.name ; save original device set_plot,'X' ; need to output to text widget explain='Only 5 repeats allowed with scans. Formatting scan plots.' if sin_mov eq 0 $ then widget_control, comment, set_value=explain,/append $ else widget_control, news, set_value=explain, /append set_plot, savdev ; back to original device return endif ; endif else begin ; ignore anything less then 1 Rsun ; ; ; ; ; Undo what this pass has already saved, these values don't count. ; ; ; ; multi_plot = multi_plot - 1 ; ; last_element = n_elements(cprsun) - 1 ; cprsun = cprsun(0:last_element) ; cptheta = cptheta(0:last_element) ; ; savdev = !d.name ; savclip = !p.clip ; switching devices does a reset, ; ; since the user may still enter ; ; values, !p.clip is still needed ; set_plot,'X' ; need to output to text widget ; ; explain='Radius for scans must be larger than one solar radii.' ; if sin_mov eq 0 $ ; then widget_control, comment, set_value=explain,/append $ ; else widget_control, news, set_value=explain, /append ; ; set_plot, savdev ; back to original device ; !p.clip = savclip ; back into plot coordinates ; ; endelse endif ; end of rule condition 3 and 4 ; ; Time to get more R and thetas. ; if ruletimes lt 4 then begin ; ; Ask user for more R and thetas. ; if (ruletimes ne 1) then begin ; ; Not the pick only one R and theta option. ; if (ruletimes eq 2) and (colo eq -1) then begin ; ; Using cursor to get R/Theta but can't do that unless we have ; an image on the screen. ; explain = 'CLICK CURSOR ON DESIRED POSITION OR SUN CENTER TO QUIT.' if sin_mov eq 0 $ then widget_control, comment, set_value=explain,/append $ else widget_control, news, set_value=explain, /append cursor, xcur, ycur, /down ; in polar coordinates in pixels ; with sun center at (0,0) if ((abs(xcur) le sc_siz) and (abs(ycur) le sc_siz)) then finis=1 endif else begin ; ; User wants to manually input R/theta, or they are making ; a print requiring manual input. ; savdev = !d.name savclip = !p.clip ; switching devices does a reset set_plot,'X' ; so widget can ask for R and theta cpget_r_t, sin_mov=sin_mov ; prompt user using a widget set_plot, savdev !p.clip = savclip ; back into plot coordinates if (xcur eq 0) and (ycur eq 0) then finis=1 endelse ; ; Since the user is done, add the terminator to the R/theta vectors ; if finis then begin cprsun = [cprsun, 0] cptheta = [cptheta, 0] endif endif else finis=1 ; user only wanted one R/theta endif else begin ; ; Use next value from memory ; xcur = cprsun(multi_plot+2) ; skip the bogus "-1" and 1st value ycur = cptheta(multi_plot+2) if (xcur eq 0) and (ycur eq 0) then finis=1 endelse endrep until (finis) ;4/93 ((abs(xcur) le sc_siz) and (abs(ycur) le sc_siz)) or $ ;4/93 (ruletimes eq 1) if ruletimes ne 4 then begin cprsun = [cprsun, 0] ; save a terminator cptheta = [cptheta, 0] ; save a terminator endif if rulecondition le 2 then explain = 'R and theta done, continue processing.' $ else explain = 'R and theta done, formatting scan plots.' if sin_mov eq 0 then widget_control, comment, set_value=explain, /append $ else widget_control, news, set_value=explain, /append return end ;======================================================================== ;+ ; ; NAME: ; CPGET_R_T ; ; PURPOSE: ; Make widget that will allow use input of R and Theta. ; ; CATEGORY: ; CP display ; ; CALLING SEQUENCE: ; CPGET_R_T, SIN_MOV=SIN_MOV ; ; CALLED BY: ; CPSUNCEN ; ; CALLS TO: ; CPSUNCEN_EV (via XMANAGER) ; ; INPUTS: ; SIN_MOV : 0 when doing a single image ; 1 when doing a movie ; ; OPTIONAL INPUTS: ; none ; ; OUTPUTS: ; none explicit, only through commons ; ; OPTIONAL OUTPUTS: ; none ; ; COMMON BLOCKS: ; CPGET_R_T widget IDs for R and Theta manual input and input status ; ; SIDE EFFECTS: ; none ; ; RESTRICTIONS: ; none ; ; PROCEDURE: ; Create the widget which will prompt user to input R and Theta values ; ; MODIFICATION HISTORY : ; 1991 - Elaine Einfalt (HSTX) ; Mar 93 - added widget labels values CURRENT_R and CURRENT_T ; ;- pro cpget_r_t, sin_mov=sin_mov @cpget_r_t.common r_ok=0 & t_ok=0 ; initialize sinmov_state = sin_mov inpget = widget_base(title='Enter Radius and Theta', /column, $ space=20, xpad=20, ypad=20) lab = widget_label(inpget, value='Enter desired radius and position angle') lab = widget_label(inpget, value='Enter 0 and 0 to terminate') get_r_t = widget_base(inpget, /column, space=20) get_r = widget_base(get_r_t, /column, space=10) junkr = widget_label(get_r, $ value='Enter Radius (solar radii) and hit RETURN') current_r = widget_label(get_r, $ value='Last entered radius : none') r_it = widget_text(get_r, /editable, uvalue='RADII') get_t = widget_base(get_r_t, /column, space=10) junkt = widget_label(get_t, $ value='Enter position angle (degrees) and hit RETURN') current_t = widget_label(get_t, $ value='Last entered theta : none') t_it = widget_text(get_t, /editable, uvalue='THETA') doingit = widget_button(inpget, value='Ready', uvalue='READY') canit = widget_button(inpget, value='Cancel', uvalue='CAN_R_T') wait,1 ; let xmanger catch up widget_control, inpget, /realize widget_control, doingit, sensitive=0 xmanager, 'cpsuncen', inpget, event_handler='cpsuncen_ev', /modal end ;============================================================================ ;+ ; ; NAME: ; CPSUNCEN_EV ; ; PURPOSE : ; The event handler for manual R and Theta input widget ; ; CATEGORY: ; CP display ; ; CALLING SEQUENCE: ; CPSUNCEN_EV, EV ; ; CALLED BY: ; CPGET_R_T (via XMANAGER) ; ; CALLS TO: ; none ; ; INPUTS: ; EV: the event structure, variable depending on type of item selected ; also, values in commons ; ; OPTIONAL INPUTS: ; none ; ; OUTPUTS: ; none explicit, only through commons ; ; OPTIONAL OUTPUTS: ; none ; ; COMMON BLOCKS: ; CPUSERINP for passing xcur and ycur ; CPGET_R_T widget IDs for R/Theta manual input and input status ; CPWIDGBASES for the widget IDs of informational widgets ; ; SIDE EFFECTS: ; none ; ; RESTRICTIONS: ; none ; ; PROCEDURE: ; Process events representing user input of R and Theta until the ; buttons "Ready" or "Cancel" are clicked. At that point control is ; passed to CPCURSOR or back to calling routine. ; ; MODIFICATION HISTORY: ; 1991 - Elaine Einfalt (HSTX) ; Mar 93 - removed call to CPCURSOR ; added output of users last enter R and theta to widget ; ;- pro cpsuncen_ev, ev @cpget_r_t.common @cpuserinp.common @cpwidgbases.common ; 3/93 @cpdispfiles.common ; 3/93 @cprule.common widget_control, ev.id, get_uvalue=input ; which widget was clicked if n_elements(input) eq 0 then input = '' type = strmid(tag_names(ev, /structure_name),7,1000) ; get widget type case type of 'BUTTON' : case input of 'READY': begin widget_control, ev.top, /destroy ; kill top widgets return end 'CAN_R_T': begin widget_control, ev.top, /destroy ; kill top widgets xcur = 0 & ycur = 0 return end else : print, 'Invalid BUTTON value in CPSUNCEN: ' + input endcase ; of input 'TEXT' : begin widget_control, ev.id, get_value=value, set_value='' case input of 'RADII' : begin ; get and test input radius on_ioerror, error_jump explain ='Entered radius of '+ value(0) +' solar radii' if sinmov_state eq 0 $ then widget_control, comment,set_value=explain, /append $ else widget_control, news, set_value=explain, /append xcur = float(value(0)) on_ioerror, null ; radius shouldn't be too larger xcur = xcur < 10.0 widget_control, current_r, set_value='Last entered radius : ' + $ strtrim(xcur,2) r_ok = 1 if r_ok and t_ok then widget_control, doingit, sensitive=1 end 'THETA' : begin ; get and test input theta on_ioerror, error_jump explain ='Entered postion angle of ' + value(0) + ' degrees' if sinmov_state eq 0 $ then widget_control,comment,set_value=explain, /append $ else widget_control, news, set_value=explain, /append ycur = float(value(0)) mod 360 on_ioerror, null if ycur lt 0 then ycur = ycur + 360 widget_control, current_t, set_value='Last entered theta : ' + $ strtrim(ycur,2) t_ok=1 if r_ok and t_ok then widget_control, doingit, sensitive=1 end else : print, 'Invalid TEXT value in CPSUNCEN: ' + input endcase ; of input end ; of text else : print, 'Invalid widget type in CPSUNCEN: ' + type endcase ; of type error_jump: end ;============================================================================ ;+ ; ; NAME: ; CPSUNCEN ; ; PURPOSE: ; Draw solar disk, solar north, and radial grid, as requested by user. ; ; CATEGORY: ; CP display ; ; CALLING SEQUENCE: ; CPSUNCEN, IMSIZ=IMSIZ, HK=HK, DONORTH=DONORTH, DODISK=DODISK, $ ; DORADII=DORADII, DORADIAL=DORADIAL, COLO=COLO, $ ; RULETIMES=RULETIMES, RULECONDITION=RULECONDITION, $ ; SIN_MOV=SIN_MOV, NORM_DIFF=NORM_DIFF, $ ; XPOS=XPOS, YPOS=YPOS, X_SIZ=X_SIZ, Y_SIZ=Y_SIZ, HOUSEKP=HOUSEKP ; ; CALLED BY: ; CPDISPLAY, CPMOVIE ; ; CALLS TO: ; CPCURSOR, CPGET_R_T ; ; INPUTS: ; DATA : the image array ; IMSIZ : the size of the CP image in pixels ; HK : Array of size (224 x N) where N is 1 for single images ; and 2 for difference images. Contains the housekeeping ; information for the current image(s) ; DONORTH : 0 means don't draw solar north ; 1 means do draw solar north on image ; DODISK : 0 means don't draw solar disk ; 1 means do draw solar disk ; DORADII : 0 means don't draw radius lines ; 1 means do draw radius lines ; DORADIAL : 0 means don't draw radial lines ; 1 means do draw radial lines ; COLO : -1 means no hard copy allowed ; 0 means hard copy device is B/W ; 1 means hard copy device is color ; RULETIMES : 0 means don't do pick any R/theta ; 1 means pick 1 R/theta ; 2 means pick multiple R/theta ; 3 means enter R/theta ; 4 means use r/theta already in memory ; RULECONDITION : 0 means draw ruler s/c thru R/theta ; 1 means mark R/theta click w/ circle ; 2 means don't draw ruler or mark ; 3 means plot radial scan ; 4 means plot azmuthal scan ; SIN_MOV : 0 means current display mode is for single images ; 1 means current display mode is for movies ; NORM_DIFF : 0 means do a normal image ; 1 means do a difference image ; XPOS : X direction screen coordinate (device pixels), to place window ; YPOS : Y direction screen coordinate (device pixels), to place window ; X_SIZ : Image X size ; Y_SIZ : Image Y size ; HOUSEKP : X direction size reserved for house keeping info. ; ; OPTIONAL INPUTS: ; none ; ; OUTPUTS: ; none explicit, only through commons ; ; OPTIONAL OUTPUTS: ; none ; ; COMMON BLOCKS: ; none ; ; SIDE EFFECTS: ; none ; ; RESTRICTIONS: ; none ; ; PROCEDURE: ; Convert solar and CP parameters for display over an already existing ; CP image. And solar disk, solar north, and radial grid, as ; requested by user. ; ; MODIFICATION HISTORY: ; 1991 - Elaine Einfalt (HSTX) ; Mar 93 - removed initial request for user to input R and theta, ; first requests are now in CPSUNCEN.PRO. Removed the now ; unneeded common blocks CPWIDGBASES.COMMON and CPUSERINP.COMMON ; and the now obsolete CPRULE.COMMON. ; Apr 93 - modified uses of colors. Remove passing of savpcolor ; ;- pro cpsuncen, data=data, imsiz=imsiz, hk=hk, donorth=donorth, dodisk=dodisk, $ doradii=doradii, doradial=doradial, colo=colo, $ ruletimes=ruletimes, rulecondition=rulecondition, $ sin_mov=sin_mov, norm_diff=norm_diff, $ xpos=xpos, ypos=ypos, x_siz=x_siz, y_siz=y_siz, housekp=housekp if ishft(hk(15) and '20'x,-5) eq 1 then return ; calibration image ignored ;hghlit_1 = !p.color ; white for normal / white for diff. ;hghlit_2 = !p.color - 1 ; red for normal / white for diff. ;hghlit_3 = !p.color - 2 ; cyan normal / white for diff. hghlit_1 = !D.N_COLORS - 1 ; white for normal / white for diff. hghlit_2 = !D.N_COLORS - 2 ; red for normal / white for diff. hghlit_3 = !D.N_COLORS - 3 ; cyan normal / white for diff. factor = 896. / imsiz r = 161.9754 / factor ; suns radius in pixels radius = fltarr(361) + r ; radius array theta = findgen(361) * !dtor ; all theta, converted to radians range = findgen(imsiz) ; the X and Y scale in pixels (square) radialmax = sqrt(imsiz^2. + imsiz^2.) ; max possible radial length ; the coordinates for sun center of each sector mirror (high res values) ; SW S SE E NE N NW W composite xcen = [ 36.3, 213.1, 539.9, 820.0, 892.4, 718.6, 386.7, 104.3, 447.0] ycen = [499.8, 193.6, 3.3, 87.0, 361.5, 679.3, 856.4, 792.1, 447.0] ycen = 896-ycen ; put Y coordinate 0 at bottom (CP 0,0 is top left) xcen=xcen/factor & ycen=ycen/factor ; set up an invisible coordinate system with (0,0) at sun center ter = ishft(hk(14) and '3c'x,-3) ; image sector mirror xcenter = xcen(ter) & ycenter = ycen(ter) ; pixel coord of s/c fov_x = range-xcenter & fov_y = range-ycenter ; coordinate system fov_pos_x0 = housekp & fov_pos_y0 = 0 ; plotting start pos. fov_pos_x1 = housekp+x_siz & fov_pos_y1 = y_siz ; plotting end pos. plot, fov_x, fov_y, /nodata, xstyle=5, ystyle=5, /noerase, $ position=[fov_pos_x0,fov_pos_y0,fov_pos_x1,fov_pos_y1] ; axis,xax=0,0,0 ,xstyle=1 & axis,yax=0,0,0 ,ystyle=1 ; for debugging if dodisk then $ ; draw solar disk oplot, radius, theta, /polar, linestyle=1, color=hghlit_1 if doradii then begin ; draw solar radius lines for i=2.,7. do oplot,radius*i,theta,/polar,color=hghlit_3 ; solar radii for i=2.5,6.5 do oplot,radius*i,theta,/polar, $ ; half solar radii linesty=2,color=hghlit_3 endif percent = .10 ; % of solar radius to mark with S/C circle sc_siz = r*percent ; radius of area marked as suncenter (float) ; get value of north for this image roll = 256*hk(88) + hk(89) ; CP roll values range 1 to 360 roll = abs(roll-360) ; adjust to positive angles CCW roll = (roll + 90 + 43) mod 360 ; adjust for polar and cp weirdness north = roll * !dtor if donorth then begin ; draw line indicating north ; draw circle about S/C center = radius*percent ; radius of area marked as suncenter (fltarr) oplot,center,theta,/polar,color=hghlit_1 ; small circle about S/C ; draw line pointing north oplot,/polar,[sc_siz,r],[north,north],thick=2,color=hghlit_1 endif ; cross hairs @ s/c are always drawn (a must if using multiple R/theta) oplot,[-(sc_siz),sc_siz],[0,0],color=hghlit_1 oplot,[0,0],[-(sc_siz),sc_siz],color=hghlit_1 if doradial then begin ; draw radial grid on image every 15 degrees deg_sep = 15. ; every 15 degrees three60 = 360*!dtor & space = deg_sep*!dtor for i = north, north+three60, space do $ oplot, /polar, [0,radialmax], [i,i], color=hghlit_3 ; radial line endif if ruletimes ne 0 then begin ; some sort of R and theta is wanted cpcursor, data=data, sc_siz=sc_siz, sin_mov=sin_mov, $ rulecondition=rulecondition, ruletimes=ruletimes, $ radius=radius, theta=theta, rd=r, $ radialmax=radialmax, colo=colo, roll=roll, $ xcenter=xcenter, ycenter=ycenter endif return end