;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ; PRO are_you_certain,mtitle1,answer !order=1 mtext=["NO","YES"] choice1=1 REPEAT BEGIN smrtmnu,mtitle1,mtext,choice1 ENDREP UNTIL (choice1 NE -1) answer=choice1 RETURN END ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ; ;+ ;==-AFGWC/DOA MODULE DEFINITION-=============================================== ; ; NAME: n_polar_sgdb_zoom ; ; MODULE OVERVIEW: NORTHERN POLAR STEREOGRAPHIC SGDB IMAGER ; SGDB - Satellite Global Database. ; ; ;------------------------------------------------------------------------------ ; PARAMETER TABLE: ;------------------------------------------------------------------------------ ; ; I/O NAME TYPE FUNCTION ;------------------------------------------------------------------------------ ; ;_______________________________________________________________________________ ;=============================================================================== ; ; CODED BY: Bruce Thomas, Aerospace Corp. ; DATE : Feb 1995 ; ; MODIFICATIONS: LT Paul McCrone , AFGWC/DOA 17 Feb 95 ; Translation made to PV WAVE, with some ; small modifications. THIS WAS AN IDL ; program at first. ;=============================================================================== ;- PRO n_polar_sgdb_zoom, infile1 !order=1 sgdb_imager_config,data_directory,program_directory,color_table_directory itl = '-adobe-new century schoolbook-bold-i-normal--14-140-75' + $ '-75-p-88-iso8859-1' DEVICE, font=itl loadct,4 device, pseudo_color=8 num_colors=!d.n_colors !ORDER=1 infile=' ' PS=BYTARR(4096,4096) ; GSTOK=[190.5,192.4,194.3,196.1,198.0,199.9,201.8,203.7,205.6,207.5,209.4,211.3,213.1,215.0,216.9,218.8,220.7,222.6,224.5,226.4,228.3,230.2,232.0,233.9,235.8,237.7,239.6,241.5,243.4,245.3,247.2,249.1,250.9,252.8,254.7,256.6,258.5,260.4,262.3,264.2,266.1,268.0,269.9,271.7,273.6,275.5,277.4,279.3,281.2,283.1,285.0,286.9,288.7,290.6,292.5,294.4,296.3,298.2,300.1,302.0,303.9,305.7,307.6,309.5] ; r=bytarr(num_colors) g=bytarr(num_colors) b=bytarr(num_colors) r(0:63)=bindgen(64)*4 g=r b=r r(64)=253 g(64)=253 b(64)=253 r(65:70)=254 g(65:70)=254 b(65:70)=254 ; red r(num_colors-7)=255 g(num_colors-7)=0 b(num_colors-7)=0 ; blu r(num_colors-6)=0 g(num_colors-6)=0 b(num_colors-6)=255 ; yellow r(num_colors-15)=224 g(num_colors-5)=224 b(num_colors-5)=0 ; cyan r(num_colors-4)=0 g(num_colors-4)=216 b(num_colors-4)=216 ; violet r(num_colors-3)=208 g(num_colors-3)=0 b(num_colors-3)=255 ; orange r(num_colors-2)=255 g(num_colors-2)=159 b(num_colors-2)=0 ; white r(num_colors-1)=255 g(num_colors-1)=255 b(num_colors-1)=255 ; red=num_colors-7 blue=num_colors-6 yellow=num_colors-5 cyan=num_colors-4 violet=num_colors-3 orange=num_colors-2 white=num_colors-1 tvlct,r,g,b imagery_ready=0 ; STARTUP: ; CLOSE,1 infile=infile1 ; ; read SDHS SGDB header to decode the data file! ; this procedure returns a header structure..... ; sdhs_sgdb_header,infile,hdr ; openr,1,infile nhtest=strpos(infile,'NH') shtest=strpos(infile,'SH') if(nhtest ne -1) then hemi = 1 if(shtest ne -1) then hemi = 0 irtest=strpos(infile,'IR') if(irtest ne -1) then ir=1 if(irtest eq -1) then ir=0 ; ICNTR=LONG(0) IST=LONG(0) IEND=LONG(0) JST=LONG(0) JEND=LONG(0) i=long(0) j=long(0) val1=long(0) val2=long(0) iboxes=long(0) BOX=ASSOC(1,BYTARR(64,64),2560) for j=0,hdr.num_rows-1 do begin iboxes=0 for i=hdr.box_table(j*2),hdr.box_table(j*2+1) do begin val1=hdr.box_table(j*2)+iboxes IST = (val1-((val1/64)*64))*64 IEND = IST + 63 JST = j*64 JEND = j*64+63 ; print,j,i,val1 PS(IST:IEND,JST:JEND)=BOX(ICNTR) ICNTR=ICNTR+1 iboxes=iboxes+1 endfor endfor HSNAP: imagery_ready=1 A=CONGRID(PS,750,750,INTERP=0) test=where(a ne 0,count) if(count ne -1) then a(test)=63-a(test) A64=rotate(A,7) test2=where(a eq 0,count2) if(count2 ne -1) then a(test2)=blue WINDOW,XS=750,YS=750,TITLE='AFGWC Satellite Global Database, '+infile, $ get_xwin_id=xw2,xpos=165,ypos=30,/free image_winid=!d.window hemi=1 tv,A B=A ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;MAP THE IMAGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;mapflag = 1 ;mtitle1='Do you want this image mapped?' ;are_you_certain,mtitle1,mapflag ;IF mapflag EQ 1 THEN BEGIN wset,image_winid B=A restore ,program_directory+'/stmap' print,"Mapping.....",infile st=transpose(st_map) st=ROT(st,80) ; ;This section is intended to slightly compress the map image, ;so that the borders fit right. PJM 2/95 ; st=congrid(st,730,730) stt = bytarr(750,750) stt( 10:739 , 10:739 ) = st ; land B( where(stt EQ 12) )=251 ;grid B( where(stt EQ 13) )=252 tv, B ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;MAP THE BIG "PS" IMAGE ARRAY ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;print,"Mapping the big array .....for ",infile ;h1=where (stt EQ 12) ;y1_array=(h1)/750 ;x1_array=(h1) mod 750 ;x1_array=x1_array*(4096/750.0) ;y1_array=y1_array*(4096/750.0) ;h2=where (stt EQ 13) ;y2_array=(h2)/750 ;x2_array=(h2) mod 750 ;x2_array=x2_array*(4096/750.0) ;y2_array=y2_array*(4096/750.0) ;; land ;PS(x1_array,y1_array)=251 ;;grid ;PS(x2_array,y2_array)=252 ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;ROTATE IMAGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;stop_rot=1 ;degrees=0 ; ;WHILE stop_rot EQ 1 DO BEGIN ; ; messg="To rotate image, enter degrees (or CANCEL to avoid rotation)" ; ; stop_rot=requester(messg,/t_entry,entry=degrees,/qmark) ; ; IF stop_rot EQ 1 THEN BEGIN ; ; print,"ROTATING....." ; ; B=ROT(B,degrees) ; tv,B ; ; ; ENDIF ; ;ENDWHILE ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;enter date/time of satellite image ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;;Begin the selection of the date info. ;;; ; ;get_date_time_data,ident,ident1,ident2,image_type ; ; ; ; xyouts,02,72,image_type,charsize=2,charthick=3,color=0,/device ; ; xyouts,02,02,ident1,charsize=2,charthick=3,color=0,/device ; ; xyouts,02,37,ident2,charsize=2,charthick=3,color=0,/device ; ; ; ;; ;At this point, I'm reading in the currently displayed data and ;putting it back into the B array. This way, the date and everything ;is saved. ; ;;;;;;;; wait,5 B=tvrd(0,0,750,750) tv,B ; ; ;THIS IS THE INVERSION OPTION FOR A POLAR IMAGE. ; ; are_you_certain,'Invert Image?',answer ; ; IF answer EQ 1 THEN BEGIN ; ; B=TRANSPOSE(B) ; ; B=ROT(B,90) ; ; tv,B ; ; ENDIF ; ;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;SAVE THE FILE;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;messg="Enter image filename (or CANCEL to avoid saving the image)" ; ;result=requester(messg,/t_entry,entry=img_file,/qmark) ; ; ;Save in /doa_data2/sgdb/imager_files/n_hemi ; ; ; ;IF (result EQ 1) THEN BEGIN ; ; img_file=img_file+".img.nhm.sgdb" ; save,B,file=data_directory+'/imager_files/n_hemi/'+img_file ; ;ENDIF ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;ZOOM IN ON IMAGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;zoomflag = 1 ;mtitle1='Do you want to zoom in on the original image?' ;are_you_certain,mtitle1,zoomflag ;IF (zoomflag EQ 1) THEN BEGIN ; WINDOW,0,XS=750,YS=750, xpos=165,ypos=30, $ TITLE='ZOOMING THE IMAGE',get_xwin_id=xw1,/free zoom_image_winid=!d.window tv,B road_sign,"Select the center point of", $ "desired zoom area on the current satellite image.", $ 270,800, road_winid wset,zoom_image_winid wshow,zoom_image_winid cursor,x,y,1,/device wdelete, road_winid print,"Zooming...." old_y=y y=750-y IF (x LT 75) THEN x = 75 IF (y LT 75) THEN y = 75 IF (x GT 675) THEN x= 675 IF (y GT 675) THEN y= 675 B_xll=x-75 B_yll=old_y-75 B_xur=x+74 B_yur=old_y+74 ;image_winid wset,image_winid wshow,image_winid xyouts,x,old_y,"+",charsize=2,charthick=2,color=255,/device plots,[B_xll,B_xur],[B_yll,B_yll],color=255,/device plots,[B_xur,B_xur],[B_yll,B_yur],color=255,/device plots,[B_xur,B_xll],[B_yur,B_yur],color=255,/device plots,[B_xll,B_xll],[B_yur,B_yll],color=255,/device ;zoom_image_winid wset,zoom_image_winid wshow,zoom_image_winid xyouts,x,old_y,"+",charsize=2,charthick=2,color=255,/device plots,[B_xll,B_xur],[B_yll,B_yll],color=255,/device plots,[B_xur,B_xur],[B_yll,B_yur],color=255,/device plots,[B_xur,B_xll],[B_yur,B_yur],color=255,/device plots,[B_xll,B_xll],[B_yur,B_yll],color=255,/device wait,3 reference_image=intarr(150,150) wset,zoom_image_winid wshow,zoom_image_winid reference_image=tvrd(B_xll,B_yll,150,150) FACTOR=4096.0/750.0 x1=(FACTOR * x) y1=(FACTOR * y) IF (x1 LT 375) THEN x = 375 IF (y1 LT 375) THEN y = 375 IF (x1 GT 3721) THEN x= 3721 IF (y1 GT 3721) THEN y= 3721 xll=x1-375 yll=y1-375 xur=x1+374 yur=y1+374 print,"xll= ",xll," yll= ",yll," xur= ",xur," yur= ",yur A=PS(xll:xur,yll:yur) A=256-A tv,A,0,0 tv,reference_image,0,0 wset,zoom_image_winid wshow,zoom_image_winid wait,3 A=tvrd(0,0,750,750) restore , program_directory+'/superzoom_colors.dat' blue=colors_out(*,2) green=colors_out(*,1) red=colors_out(*,0) tvlct,red,green,blue ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;ROTATE ZOOMED IMAGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; stop_rot=1 degrees=0 WHILE stop_rot EQ 1 DO BEGIN messg="Rotate Zoomed Image? " are_you_certain,messg,stop_rot IF stop_rot EQ 1 THEN BEGIN mtitle1="Select Angle of Rotation" mtext=['90 Degrees','180 Degrees'] choice1=1 REPEAT BEGIN smrtmnu,mtitle1,mtext,choice1 ENDREP UNTIL (choice1 NE -1) degrees=(choice1+1)*90 print,"ROTATING....." A=ROT(A,degrees) tv,A ENDIF ENDWHILE RETURN END ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ; ;+ ;==-AFGWC/DOA MODULE DEFINITION-=============================================== ; ; NAME: s_polar_sgdb_zoom ; ; MODULE OVERVIEW: SOUTHERN POLAR STEREOGRAPHIC SGDB IMAGER ; SGDB - Satellite Global Database. ; ; ;------------------------------------------------------------------------------ ; PARAMETER TABLE: ;------------------------------------------------------------------------------ ; ; I/O NAME TYPE FUNCTION ;------------------------------------------------------------------------------ ; ;_______________________________________________________________________________ ;=============================================================================== ; ; CODED BY: Bruce Thomas, Aerospace Corp. ; DATE : Feb 1995 ; ; MODIFICATIONS: LT Paul McCrone , AFGWC/DOA 01 Mar 95 ; Translation made to PV WAVE, with some ; small modifications. THIS WAS AN IDL ; program at first. ;=============================================================================== ;- PRO s_polar_sgdb_zoom, infile1 !order=1 sgdb_imager_config,data_directory,program_directory,color_table_directory itl = '-adobe-new century schoolbook-bold-i-normal--14-140-75' + $ '-75-p-88-iso8859-1' DEVICE, font=itl loadct,4 device, pseudo_color=8 num_colors=!d.n_colors !ORDER=1 infile=' ' PS=BYTARR(4096,4096) ; GSTOK=[190.5,192.4,194.3,196.1,198.0,199.9,201.8,203.7,205.6,207.5,209.4,211.3,213.1,215.0,216.9,218.8,220.7,222.6,224.5,226.4,228.3,230.2,232.0,233.9,235.8,237.7,239.6,241.5,243.4,245.3,247.2,249.1,250.9,252.8,254.7,256.6,258.5,260.4,262.3,264.2,266.1,268.0,269.9,271.7,273.6,275.5,277.4,279.3,281.2,283.1,285.0,286.9,288.7,290.6,292.5,294.4,296.3,298.2,300.1,302.0,303.9,305.7,307.6,309.5] ; r=bytarr(num_colors) g=bytarr(num_colors) b=bytarr(num_colors) r(0:63)=bindgen(64)*4 g=r b=r r(64)=253 g(64)=253 b(64)=253 r(65:70)=254 g(65:70)=254 b(65:70)=254 ; red r(num_colors-7)=255 g(num_colors-7)=0 b(num_colors-7)=0 ; blu r(num_colors-6)=0 g(num_colors-6)=0 b(num_colors-6)=255 ; yellow r(num_colors-15)=224 g(num_colors-5)=224 b(num_colors-5)=0 ; cyan r(num_colors-4)=0 g(num_colors-4)=216 b(num_colors-4)=216 ; violet r(num_colors-3)=208 g(num_colors-3)=0 b(num_colors-3)=255 ; orange r(num_colors-2)=255 g(num_colors-2)=159 b(num_colors-2)=0 ; white r(num_colors-1)=255 g(num_colors-1)=255 b(num_colors-1)=255 ; red=num_colors-7 blue=num_colors-6 yellow=num_colors-5 cyan=num_colors-4 violet=num_colors-3 orange=num_colors-2 white=num_colors-1 tvlct,r,g,b imagery_ready=0 ; STARTUP: ; CLOSE,1 infile=infile1 ; ; read SDHS SGDB header to decode the data file! ; this procedure returns a header structure..... ; sdhs_sgdb_header,infile,hdr ; openr,1,infile nhtest=strpos(infile,'NH') shtest=strpos(infile,'SH') if(nhtest ne -1) then hemi = 1 if(shtest ne -1) then hemi = 0 irtest=strpos(infile,'IR') if(irtest ne -1) then ir=1 if(irtest eq -1) then ir=0 ; ICNTR=LONG(0) IST=LONG(0) IEND=LONG(0) JST=LONG(0) JEND=LONG(0) i=long(0) j=long(0) val1=long(0) val2=long(0) iboxes=long(0) BOX=ASSOC(1,BYTARR(64,64),2560) for j=0,hdr.num_rows-1 do begin iboxes=0 for i=hdr.box_table(j*2),hdr.box_table(j*2+1) do begin val1=hdr.box_table(j*2)+iboxes IST = (val1-((val1/64)*64))*64 IEND = IST + 63 JST = j*64 JEND = j*64+63 ; print,j,i,val1 PS(IST:IEND,JST:JEND)=BOX(ICNTR) ICNTR=ICNTR+1 iboxes=iboxes+1 endfor endfor HSNAP: imagery_ready=1 A=CONGRID(PS,750,750,INTERP=0) test=where(a ne 0,count) if(count ne -1) then a(test)=63-a(test) A64=rotate(A,7) test2=where(a eq 0,count2) if(count2 ne -1) then a(test2)=blue window,XS=750,YS=750,TITLE='AFGWC Satellite Global Database, '+infile, $ get_xwin_id=xw2,xpos=165,ypos=30,/free image_winid=!d.window hemi=1 tv,A B=A ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;MAP THE IMAGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;mapflag = 1 ;mtitle1='Do you want this image mapped?' ;are_you_certain,mtitle1,mapflag ;IF mapflag EQ 1 THEN BEGIN wset,image_winid B=A restore ,'southern_map' print,"Mapping.....",infile ;tv,southern_map st=southern_map st=transpose(southern_map) st=ROT(st,90) ; ;This section is intended to slightly compress the map image, ;so that the borders fit right. ; st=congrid(st,730,730) stt = bytarr(750,750) stt( 10:739 , 10:739 ) = st ; land B( where(stt EQ 12) )=251 ;grid B( where(stt EQ 13) )=252 tv, B ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;MAP THE BIG "PS" IMAGE ARRAY ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;print,"Mapping the big array .....for ",infile ;h1=where (stt EQ 12) ;y1_array=(h1)/750 ;x1_array=(h1) mod 750 ;x1_array=x1_array*(4096/750.0) ;y1_array=y1_array*(4096/750.0) ;h2=where (stt EQ 13) ;y2_array=(h2)/750 ;x2_array=(h2) mod 750 ;x2_array=x2_array*(4096/750.0) ;y2_array=y2_array*(4096/750.0) ;; land ;PS(x1_array,y1_array)=251 ;;grid ;PS(x2_array,y2_array)=252 ; ;ENDIF ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;ROTATE IMAGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;stop_rot=1; ;degrees=0; ; ;WHILE stop_rot EQ 1 DO BEGIN; ; ; messg="To rotate image, enter degrees (or CANCEL to avoid rotation)"; ; ; stop_rot=requester(messg,/t_entry,entry=degrees,/qmark); ; ; IF stop_rot EQ 1 THEN BEGIN; ; ; print,"ROTATING....."; ; ; B=ROT(B,degrees); ; tv,B; ; ; ; ENDIF; ; ; ;ENDWHILE; ; ; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;enter date/time of satellite image ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;get_date_time_data,ident,ident1,ident2 ; ; ; xyouts,02,72,imgtype(choicetype),charsize=2,charthick=3,color=0,/device ; ; xyouts,02,02,ident1,charsize=2,charthick=3,color=0,/device ; ; xyouts,02,37,ident2,charsize=2,charthick=3,color=0,/device ; ; print,ident ; ; ;At this point, I'm reading in the currently displayed data and ;putting it back into the B array. This way, the date and everything ;is saved. ; ;;;;;;;; wait,5 B=tvrd(0,0,750,750) tv,B ; ; ;THIS IS THE INVERSION OPTION FOR A POLAR IMAGE. ; ; are_you_certain,'Invert Image?',answer ; ; IF answer EQ 1 THEN BEGIN ; ; B=TRANSPOSE(B) ; ; B=ROT(B,90) ; ; tv,B ; ; ; ENDIF ; ;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;SAVE THE FILE;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;messg="Enter image filename (or CANCEL)" ; ;result=requester(messg,/t_entry,entry=img_file,/qmark) ; ;; ;;Save in /doa_data2/sgdb/imager_files/s_hemi ;;; ; ; ;IF (result EQ 1) THEN BEGIN ; ; img_file=img_file+".img.shm.sgdb" ; save,B,file=data_directory+'/imager_files/s_hemi/'+img_file ; ;ENDIF ; ; ;;;ready_to_move_on ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;ZOOM IN ON IMAGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;zoomflag = 1 ;mtitle1='Do you want to zoom in on the original image?' ;are_you_certain,mtitle1,zoomflag ;IF (zoomflag EQ 1) THEN BEGIN ; WINDOW,0,XS=750,YS=750, xpos=165,ypos=30, $ TITLE='ZOOMING THE IMAGE',get_xwin_id=xw1,/free zoom_image_winid=!d.window tv,B road_sign,"Select the center point of", $ "desired zoom area on the current satellite image.", $ 270,800, road_winid wset,zoom_image_winid wshow,zoom_image_winid cursor,x,y,1,/device wdelete, road_winid print,"Zooming...." old_y=y y=750-y IF (x LT 75) THEN x = 75 IF (y LT 75) THEN y = 75 IF (x GT 675) THEN x= 675 IF (y GT 675) THEN y= 675 B_xll=x-75 B_yll=old_y-75 B_xur=x+74 B_yur=old_y+74 ;image_winid wset,image_winid wshow,image_winid xyouts,x,old_y,"+",charsize=2,charthick=2,color=255,/device plots,[B_xll,B_xur],[B_yll,B_yll],color=255,/device plots,[B_xur,B_xur],[B_yll,B_yur],color=255,/device plots,[B_xur,B_xll],[B_yur,B_yur],color=255,/device plots,[B_xll,B_xll],[B_yur,B_yll],color=255,/device ;zoom_image_winid wset,zoom_image_winid wshow,zoom_image_winid xyouts,x,old_y,"+",charsize=2,charthick=2,color=255,/device plots,[B_xll,B_xur],[B_yll,B_yll],color=255,/device plots,[B_xur,B_xur],[B_yll,B_yur],color=255,/device plots,[B_xur,B_xll],[B_yur,B_yur],color=255,/device plots,[B_xll,B_xll],[B_yur,B_yll],color=255,/device wait,3 reference_image=intarr(150,150) wset,zoom_image_winid wshow,zoom_image_winid reference_image=tvrd(B_xll,B_yll,150,150) FACTOR=4096.0/750.0 x1=(FACTOR * x) y1=(FACTOR * y) IF (x1 LT 375) THEN x = 375 IF (y1 LT 375) THEN y = 375 IF (x1 GT 3721) THEN x= 3721 IF (y1 GT 3721) THEN y= 3721 xll=x1-375 yll=y1-375 xur=x1+374 yur=y1+374 print,"xll= ",xll," yll= ",yll," xur= ",xur," yur= ",yur A=PS(xll:xur,yll:yur) A=256-A tv,A,0,0 tv,reference_image,0,0 wset,zoom_image_winid wshow,zoom_image_winid wait,3 A=tvrd(0,0,750,750) restore , program_directory+'/superzoom_colors.dat' blue=colors_out(*,2) green=colors_out(*,1) red=colors_out(*,0) tvlct,red,green,blue ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;ROTATE ZOOMED IMAGE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; stop_rot=1 degrees=0 WHILE stop_rot EQ 1 DO BEGIN messg="Rotate Zoomed Image? " are_you_certain,messg,stop_rot IF stop_rot EQ 1 THEN BEGIN mtitle1="Select Angle of Rotation" mtext=['90 Degrees','180 Degrees'] choice1=1 REPEAT BEGIN smrtmnu,mtitle1,mtext,choice1 ENDREP UNTIL (choice1 NE -1) degrees=(choice1+1)*90 print,"ROTATING....." A=ROT(A,degrees) tv,A ENDIF ENDWHILE RETURN END ;+ ;==-AFGWC/DOA MODULE DEFINITION-=============================================== ; ; NAME: display merc zoom ; ; MODULE OVERVIEW: Mercator SGDB IMAGER ; SGDB - Satellite Global Database. ; ; ;------------------------------------------------------------------------------ ; PARAMETER TABLE: ;------------------------------------------------------------------------------ ; ; I/O NAME TYPE FUNCTION ;------------------------------------------------------------------------------ ; ; I image String FILENAME OF DATA ; ; O winidi BYTE WINDOW ID # ; ;_______________________________________________________________________________ ;=============================================================================== ; ; CODED BY: Kim Runk (primary), and Paul McCrone. AFGWC/DOA ; DATE : ?? Feb 1995 ; ; MODIFICATIONS: 01 Mar 95: LT Paul McCrone , AFGWC/DOA ; Translation made to PV-WAVE, with some ; small modifications. THIS WAS AN IDL ; program at first. ; ; 18 Apr 95: LT Paul McCrone, AFGWC/DOA ; Added South America Special Area. ;=============================================================================== ;- PRO display_merc_zoom,image,winidi !order=1 sgdb_imager_config,data_directory,program_directory,color_table_directory f17=1 f17f = '-adobe-times-medium-r-normal--18-180-75-75-p-94-iso8859-1' f12 = '-adobe-new century schoolbook-medium-r-normal--12-120-75'+ $ '-75-p-70-iso8859-1' itl = '-adobe-new century schoolbook-bold-i-normal--14-140-75' + $ '-75-p-88-iso8859-1' DEVICE, font=itl B=bytarr(1140,680) !order=1 openr,imgunit,image,/get_lun box=assoc(imgunit,bytarr(64,64),2560) red=bindgen(256) ;open array for color stretch r=bindgen(64)*4 ; stretch color array red(0:63)=r ; stuff color into first 64 bytes grn=red blu=red red(65)=180 ; red map color grn(65)=155 ; grn map color blu(65)=100 ; blu map color red(64)=105 ; red grid color grn(64)=175 ; grn grid color blu(64)=135 ; blu grid color tvlct,red,grn,blu ; load custom color table istart=long(0) iend=long(0) jstart=long(0) jend=long(0) icntr=long(0) merc=bytarr(6208,1792) for j=0,27 do begin for i=0,96 do begin istart=(i*64) iend=((i+1)*64-1) jstart=(j*64) jend=((j+1)*64-1) merc(istart:iend,jstart:jend)=box(icntr) icntr=icntr+1 endfor endfor ; ; Resize image ; img=congrid(merc,2280,680) mercer=63-[img(1140:2279,*),img(0:1139,*)] ; ;END OF RESIZE ; window,xsize=1140,ysize=680,title='TROPICAL MERCATOR MOSAIC IMAGE ' $ + '(' + string(image) + ')',/FREE,xpos=1,ypos=220,get_xwin_id=xw1 free_lun,imgunit winidi=!d.window restore,program_directory+'/mercgrid_map.dat' map=rotate(map,7) map=congrid(map,2280,680) mercer(where(map EQ !map_border))=65 mercer(where(map EQ !map_grid))=64 ; ;choice=long(0) ;choice_strings=['Select region for display','ATLANTIC/EPAC', $ ; 'WESTPAC/IO','Entire World','Quit'] ;choice=wmenu(choice_strings,init=1,title=0) ; ; ;IF (choice eq 4) then BEGIN ; ; wdelete,winidi ; RETURN ; ;ENDIF ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;enter date/time of satellite image ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;;Begin the selection of the date info. ;;; ;get_date_time_data,ident,ident1,ident2 ; ; ; xyouts,02,72,imgtype(choicetype),charsize=2,charthick=3,color=0,/device ; ; xyouts,02,02,ident1,charsize=2,charthick=3,color=0,/device ; ; xyouts,02,37,ident2,charsize=2,charthick=3,color=0,/device ; ; print,ident ; ; ;Image Processing ; BB=congrid(mercer,1140,340) tv,BB ; ; xyouts,100,05,ident,charsize=3,charthick=3,color=255,/device, $ ; font=f17 ; road_sign,"Select the center point of", $ "desired zoom area on the current satellite image.", $ 300,60, road_winid wset,winidi wshow,winidi cursor,x,y,1,/device wdelete, road_winid IF y GT 340 THEN y=340 IF x GT 1140 THEN x=1140 IF (x LT 75) THEN x = 75 IF (y LT 75) THEN y = 75 IF (x GT 1060) THEN x= 1060 IF (y GT 675) THEN y= 675 B_xll=x-75 B_yll=y-75 IF (B_xll LT 1) THEN B_xll = 1 IF (B_yll LT 1) THEN B_yll = 1 IF (B_xll GT 985) THEN B_xll= 985 IF (B_yll GT 185) THEN B_yll= 185 ;B_xur=x+74 ;B_yur=y+74 B_xur=B_xll+150 B_yur=B_yll+150 ; ;IF (B_xll LT 1) THEN B_xll = 1 ;IF (B_yll LT 1) THEN B_yll = 1 ; ;IF (B_xll GT 985) THEN B_xll= 985 ;IF (B_yll GT 185) THEN B_yll= 185 ; wset,winidi wshow,winidi xyouts,x,y,"+",charsize=2,charthick=2,color=255,/device plots,[B_xll,B_xur],[B_yll,B_yll],color=255,/device plots,[B_xur,B_xur],[B_yll,B_yur],color=255,/device plots,[B_xur,B_xll],[B_yur,B_yur],color=255,/device plots,[B_xll,B_xll],[B_yur,B_yll],color=255,/device reference_image=tvrd(B_xll,B_yll,151,151) print,"x= ",x," y= ",y oldy=y oldx=x y=340-y ;IF (x GT 570) THEN BEGIN ; x=x-570 ;ENDIF IF (x LT 570) THEN BEGIN x=x+570 ENDIF ELSE BEGIN x=x-570 ENDELSE ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; print,"x= ",x," y= ",y," This is after data treament." print,"Zooming...." IF (x LT 70) THEN x = 70 IF (y LT 72) THEN y = 72 IF (x GT 1070) THEN x=1070 IF (y GT 268) THEN y=268 xFACTOR=6208.0/1140.0 yFACTOR=1792.0/340.0 x1=(xFACTOR * x) y1=(yFACTOR * y) IF (x1 LT 375) THEN x1 = 375 IF (y1 LT 375) THEN y1 = 375 IF (x1 GT 5830) THEN x1= 5830 IF (y1 GT 1415) THEN y1= 1415 print,"x1= ",x1," y1= ",y1 xll=x1-375 yll=y1-375 xur=x1+374 yur=y1+374 print,"xll= ",xll," yll= ",yll print,"xur= ",xur," yur= ",yur ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;At this point, we will calculate the lat/lon ;; ; ;of the center point and the lower-left/upper right ;; ; ;hand corners. This is mapping the image array (1140 X 340);; ; ;to the -180 to 180 longs and -45 (s) to 40 (n) lats. ;; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; lon_FACTOR=(360.0/1140.0) lat_FACTOR=(85.0/340.0) lon_b=-180.0 lat_b=-45.0 ; ;IN GENERAL, LONG=lon_FACTOR (image x position) + lon_b ; LAT =lat_FACTOR (image y position) + lat_b ; center_LONG=(lon_FACTOR*oldx)+lon_b center_LAT =((oldy-180.0)/4.0) ;lat= sin(!dtor* ((oldy-180.0)/4.0) )????????? print,"Center-point LONGITUDE= ",center_LONG, $ " Center-point LATITUDE= ",center_LAT image_y_ll=oldy-(375/yFACTOR) image_y_ur=oldy+(374/yFACTOR) image_x_ll=oldx-(375/xFACTOR) image_x_ur=oldx+(374/xFACTOR) lat_ll =((image_y_ll-180.0)/4.0) lat_ur =((image_y_ur-180.0)/4.0) ; lat_ll=(lat_FACTOR*(image_y_ll))+lat_b ; lat_ur=(lat_FACTOR*(image_y_ur))+lat_b lon_ll=(lon_FACTOR*(image_x_ll))+lon_b lon_ur=(lon_FACTOR*(image_x_ur))+lon_b print,"Lower-Left LONGITUDE= ",lon_ll, $ " Lower-Left LATITUDE= ",lat_ll print,"Upper-right LONGITUDE= ",lon_ur, $ " Upper-right LATITUDE= ",lat_ur ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; A=merc(xll:xur,yll:yur) A=63-A WINDOW,0,XS=755,YS=755, xpos=160,ypos=30, $ TITLE='ZOOMING THE IMAGE '+image, $ get_xwin_id=xw1,/free zoom_image_winid=!d.window tv,A,0,0 tv,reference_image,0,0 ; ; xyouts,100,05,ident,charsize=3,charthick=3,color=255,/device, $ ; font=f17 ;Save the image ; messg="To save, Enter file name, else CANCEL" result=requester(messg,/t_entry,entry=img_file,/qmark) ; ;Save in /doa_data2/sgdb/imager_files/mercator ; IF (result EQ 1) THEN BEGIN ;;;;;;;; ; ;At this point, I'm reading in the currently displayed ;data and ;putting it back into the B array. This way, the date ;and everything ;is saved. ; ;;;;;;;; wait,5 A=tvrd(0,0,750,750) tv,A,0,0 img_file=img_file+".img.merc.zoom.sgdb" OLDB=B B=A save,B,file=data_directory+'/zoom_images/mercator/'+img_file B=OLDB ENDIF RETURN END ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ; ;+ ;==-AFGWC/DOA MODULE DEFINITION-=============================================== ; ; NAME: road sign ; ; MODULE OVERVIEW: Takes a string and displays it in nice text. ; ;------------------------------------------------------------------------------ ; PARAMETER TABLE: ;------------------------------------------------------------------------------ ; ; I/O NAME TYPE FUNCTION ;------------------------------------------------------------------------------ ; ;_______________________________________________________________________________ ;=============================================================================== ; ; CODED BY: Paul McCrone ; DATE : 7 Mar 1995 ; ; MODIFICATIONS: NONE ;=============================================================================== ;- PRO road_sign,road_string,road_string2,xxp,yyp,road_winid !order=1 sgdb_imager_config,data_directory,program_directory,color_table_directory f17 = '-adobe-times-medium-r-normal--18-180-75-75-p-94-iso8859-1' f12 = '-adobe-new century schoolbook-medium-r-normal--12-120-75'+ $ '-75-p-70-iso8859-1' itl = '-adobe-new century schoolbook-bold-i-normal--14-140-75' + $ '-75-p-88-iso8859-1' DEVICE, font=itl window,/free,title=road_string,xpos=xxp,ypos=yyp,xsize=550,ysize=100, $ colors=256,get_xwin_id=xw1 road_winid=!d.window !p.color=0 !p.background=250 erase NULL=add_widg(stackler,/text,label=road_string, $ 275,70,align=.5,font=f17) NULL=add_widg(stackler,/text,label=road_string2, $ 275,30,align=.5,font=f17) draw_widg,stackler RETURN END ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ;*******************************&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& ; ;+ ;==-AFGWC/DOA MODULE DEFINITION-=============================================== ; ; NAME: super zoom for SGDB_IMAGER ; ; MODULE OVERVIEW: THIS PORTION CONTROLS THE DISPLAY OF EITHER POLAR ; STEREOGRAPHIC SATELLITE GLOBAL DATABASE IMAGERY OR MERCATOR ; [TROPICAL] IMAGERY. ; ; ; IMPORTANT PROCEDURES: auto_process_merc_data8,image,winidi ; ; ; ; ;------------------------------------------------------------------------------ ; PARAMETER TABLE: ;------------------------------------------------------------------------------ ; ; I/O NAME TYPE FUNCTION ;------------------------------------------------------------------------------ ; ;_______________________________________________________________________________ ;=============================================================================== ; ; CODED BY: Paul McCrone ; DATE : 20 July 1995 ; ; MODIFICATIONS: None ; ;=============================================================================== ;- PRO superzoom sgdb_imager_config,data_directory,program_directory,color_table_directory window,/free,title="Super Zoom for SGDB IMAGER",xpos=300,ypos=250, $ xsize=550,ysize=500,colors=256,get_xwin_id=xw1 superzoom_winid=!d.window !p.color=0 !p.background=250 erase ; ;Lists of image data files ; merc_files=findfile(data_directory+'/data/mercator/*') n_hemi_files=findfile(data_directory+'/data/n_hemi/*') s_hemi_files=findfile(data_directory+'/data/s_hemi/*') ; ;Fonts for gui's ; f17 = '-adobe-times-medium-r-normal--18-180-75-75-p-94-iso8859-1' f12 = '-adobe-new century schoolbook-medium-r-normal--12-120-75'+ $ '-75-p-70-iso8859-1' itl = '-adobe-new century schoolbook-bold-i-normal--14-140-75' + $ '-75-p-88-iso8859-1' DEVICE, font=itl ; ;Build Widgets ; cncl1=add_widg(stacksz,150,200,80,label="Exit",xpos=470,ypos=470,font=f17) slct_merc=add_widg(stacksz,label='Select storm',xpos=70,ypos=300, $ /slide_box,l_list=merc_files,colors=slider_backg, $ xsize=390, ysize=120) slct_n_hemi=add_widg(stacksz,label='Select storm',xpos=70,ypos=150, $ /slide_box,l_list=n_hemi_files,colors=slider_backg, $ xsize=390, ysize=100) slct_s_hemi=add_widg(stacksz,label='Select storm',xpos=70,ypos=10, $ /slide_box,l_list=s_hemi_files,colors=slider_backg, $ xsize=390, ysize=100) NULL=add_widg(stacksz,/text,label='SGDB Imager',285,480,align=.5, $ font=f17) NULL=add_widg(stacksz,/text,label='Select Image File', $ 285,455,align=.5,font=f17) NULL=add_widg(stacksz,/text,label='Tropical Mercator Projection', $ 285,430,align=.5,font=f17) NULL=add_widg(stacksz,/text,label='Northern Hemisphere Polar Projection', $ 285,255,align=.5,font=f17) NULL=add_widg(stacksz,/text,label='Southern Hemisphere Polar Projection', $ 285,115,align=.5,font=f17) road_string='Select the raw data file' road_string2='that you want to expand.' road_sign,road_string,road_string2,300,120,road_winid wset,superzoom_winid wshow,superzoom_winid choice=manage_widg(stacksz,[slct_merc,slct_n_hemi,slct_s_hemi,cncl1]) wdelete,road_winid wset,superzoom_winid wshow,superzoom_winid IF choice EQ cncl1 THEN BEGIN wdelete,superzoom_winid cd,program_directory RETURN ENDIF IF choice EQ slct_merc THEN BEGIN file_num=get_widg_value(stacksz,slct_merc) file=merc_files(file_num) IF (file NE '') THEN BEGIN wdelete,superzoom_winid display_merc_zoom,file,winidi merc_winid=!d.window ENDIF ENDIF ;Select Merc IF choice EQ slct_n_hemi THEN BEGIN file_num=get_widg_value(stacksz,slct_n_hemi) file=n_hemi_files(file_num) IF (file NE '') THEN BEGIN wdelete,superzoom_winid n_polar_sgdb_zoom,file n_polar_winid=!d.window ENDIF ;END OF THE NE TEST ENDIF ;Select NH IF choice EQ slct_s_hemi THEN BEGIN file_num=get_widg_value(stacksz,slct_s_hemi) file=s_hemi_files(file_num) IF (file NE '') THEN BEGIN wdelete,superzoom_winid s_polar_sgdb_zoom,file s_polar_winid=!d.window ENDIF ENDIF ; Select SH ;cncl1 cd,program_directory RETURN END ;WAVE> save,colors_out,file='superzoom_colors.dat'