!=====================================================================
! Program to demonstrate, by playing GIFs, LLU and NCL example plots
!=====================================================================
PROGRAM Gallery_GIF
USE CNCARG
IMPLICIT NONE
INTEGER, PARAMETER :: nmax = 100
CHARACTER(256) :: Listing(nmax)
INTEGER :: ig, n, i, ier
LOGICAL :: ex
CHARACTER :: Gallery*3, ListingFile*256, GifFilePath*256
!-----------------
DO
WRITE(*,'(/1X,A)',ADVANCE='NO') 'Play LLU (ig=1) or NCL (ig=2) GIFs: ig (0 to exit) = '
READ(*,*,IOSTAT=ier) ig
IF( ier /= 0 ) CYCLE
SELECT CASE( ig )
CASE( 0 )
EXIT
CASE( 1 )
Gallery = 'LLU'
CASE( 2 )
Gallery = 'NCL'
CASE DEFAULT
CYCLE
END SELECT
CALL Category_Listing( Gallery, Listing, n )
DO i = 1, n
INQUIRE( FILE='GIF-'//Gallery//'/list-'//TRIM(Listing(i)), EXIST=ex )
IF( .NOT. ex ) Listing(i) = ' '
END DO
!-------
! Open graphics window
CALL NG_OPNWIN()
DO
! Use mouse to picking a category
CALL Gallery_Menu( Gallery, Listing(1:n), i )
IF( i == 0 ) EXIT
ListingFile = 'GIF-'//Gallery//'/list-'//TRIM(Listing(i))
GifFilePath = 'GIF-'//Gallery
! Playing GIF files
CALL NG_WINGIF( ListingFile=ListingFile,&
GifFilePath=GifFilePath,&
Express=.TRUE.) ! means do not open/close graphics window
! No wait to clear current screen
CALL NG_FRAME( WAIT=-1, ADVANCE=.TRUE. )
END DO
! Close graphics window
CALL NG_CLSWIN()
END DO
CONTAINS !------------------------------
SUBROUTINE Category_Listing( Gallery, Listing, n )
IMPLICIT NONE
CHARACTER(*), INTENT(IN ) :: Gallery
CHARACTER(*), INTENT( OUT) :: Listing(:)
INTEGER, INTENT( OUT) :: n
!-----------------
SELECT CASE( Gallery )
CASE( 'LLU', 'llu' )
n = 47
IF( n > SIZE(Listing) ) STOP '[LLU_Category_Listing]Error: n > SIZE(Listing)'
Listing(1:n) = (/'NGSP ',&
'NGPC ',&
'NGPC-Font ',&
'NGDP ',&
'NGGA ',&
'NGPP ',&
'NGSF ',&
'NGLB ',&
'NGAR ',&
'NGER ',&
'NGHG ',&
'NGAG ',&
'NG3D ',&
' ',&
'NGTD ',&
'NGTD-Ex8 ',&
'NGCP-1 ',&
'NGCP-2 ',&
'NGCP-3 ',&
'NGMP ',&
'NGMP-Demo ',&
'NGCT ',&
'NGVV ',&
'NGST ',&
'NGVT ',&
'NGWM ',&
'NGMA ',&
' ',&
'ColorMap-A',&
'ColorMap-B',&
'ColorMap-C',&
'ColorMap-D',&
'ColorMap-E',&
'ColorMap-F',&
'ColorMap-G',&
'ColorMap-H',&
'ColorMap-I',&
'ColorMap-J',&
'ColorMap-K',&
'ColorMap-L',&
'ColorMap-M',&
' ',&
'ColorMap-N',&
'ColorMap-O',&
'ColorMap-P',&
'ColorMap-Q',&
'ColorMap-R'/)
CASE( 'NCL', 'ncl' )
n = 54
IF( n > SIZE(Listing) ) STOP '[NCL_Category_Listing]Error: n > SIZE(Listing)'
Listing(1:n) = (/ &
'_ALL ',&
' ',&
'_Plot_Types-Generic',&
'_Plot_Types ',&
'_Plot_Techniques ',&
'_Map_Projections ',&
'_Random_Data ',&
'_Special_Plots ',&
'_Datasets ',&
'_Data_Analysis ',&
'_Models ',&
' ',&
'_DKRZ ',&
' ',&
!----------------------
'_Animation_1 ',&
'_Animation_2 ',&
' ',&
'data_on_map ',&
'data_on_nomap ',&
' ',&
'xyplot_curve ',&
'xyplot_bar_histo ',&
' ',&
'stream_vector ',&
' ',&
'map_native ',&
'2dcoords ',&
' ',&
!----------------------
'techniques_basic ',&
'techniques_contour ',&
'techniques_map ',&
' ',&
'map_shapefiles ',&
' ',&
'trimesh ',&
'1d_random_data ',&
' ',&
'3dplots ',&
' ',&
'weather ',&
' ',&
' ',&
!----------------------
'axes ',&
' ',&
'overlay ',&
'mask ',&
'areas ',&
' ',&
'panel ',&
' ',&
'legend_annotation ',&
' ',&
'text_poly_marker ',&
' ',&
' ',&
' '/)
CASE DEFAULT
WRITE(*,*) 'Gallery = "', Gallery, '"'
STOP '[Category_Listing] Unknown "Gallery" Name'
END SELECT
END SUBROUTINE Category_Listing
!-------------------------------------
SUBROUTINE Gallery_Menu( ctit, cmap, imap )
USE CNCARG
IMPLICIT NONE
CHARACTER(*), INTENT(IN ) :: ctit
CHARACTER(*), INTENT(IN ) :: cmap(:)
INTEGER, INTENT( OUT) :: imap
INTEGER :: nmap, ib, i, j, k, saved_k
REAL :: x, y, xx, yy, dx, dy
LOGICAL :: inside, saved_inside
CHARACTER :: cc*256
REAL, ALLOCATABLE :: xb(:,:), yb(:,:)
LOGICAL, SAVE :: first_entry=.TRUE.
INTEGER, SAVE :: nx, ny
REAL, SAVE :: xl, yl, ht, vp(4)
REAL, ALLOCATABLE, SAVE :: x0(:), y0(:)
!---------------
nmap = SIZE(cmap)
! Set parameters
IF( first_entry ) THEN
first_entry = .FALSE.
! viewport of NG-frame
xl = 1.0
yl = 1.0
vp = (/0.0, xl, 0.0, yl/)
!-----
! by trial and error
!-----
! Number of columns (nx) and rows (ny)
nx = 4
ny = 14
IF( nx*ny < nmap ) STOP '[Gallery_Menu]Error: nx*ny < nmap'
ALLOCATE( x0(nx), y0(ny) )
! Charcater height
ht = 0.0145
dx = 0.98*xl/REAL(nx)
dy = 0.85*yl/REAL(ny)
! Position of first item
x0(1) = 0.15*dx
y0(1) = yl - 2.00*dy
!-----
! 'CenterLeft' position of each items
DO i = 2, nx
x0(i) = x0(1) + REAL(i-1)*dx
END DO
DO j = 2, ny
y0(j) = y0(1) - REAL(j-1)*dy
END DO
! Set plotchar parameters
CALL NG_PCSETI( 'FN - Font Number' , 21 ) ! HELVETICA (filled font)
CALL NG_PCSETI( 'BF - The Box Flag' , 2 ) ! 0=none, 1=line, 2=fill, "3"="1"+"2"
CALL NG_PCSETR( 'BM - Box Margen Width', 0.5 ) ! Default is 0.15
END IF
!---------------
! Reset color table
CALL NG_GSCRST()
! Define colors used for Gallery_Menu
CALL NG_GSCR( 0, 'white' )
CALL NG_GSCR( 1, 'black' )
CALL NG_GSCR( 2, 'yellow' )
CALL NG_GSCR( 3, 'red' )
! Load color table into system
CALL NG_GSCRND()
!-------
! Set coordinates transformation
CALL NG_SET( 0.0, xl, 0.0, yl, 0.0, xl, 0.0, yl, 1 )
! Set NG-frame
cc = '['//TRIM(ctit)//' Gallery]: Mouse (MB1/2) to picking, or, Keyboard (ESC) to Escape'
CALL NG_FRSET( NGVP=vp, TITLE=TRIM(cc), PERIM=.FALSE. )
CALL NG_FRAME( WAIT=1, ADVANCE=.FALSE. ) ! to draw NG-frame title
! Fill NG-frame background color
CALL NG_FRBGC( 0 )
! Write all menu items
ALLOCATE( xb(5,nmap), yb(5,nmap) )
CALL NG_PCSETI( 'BC(2) - Box Fill Color', 0 )
CALL NG_PCSETI( 'CC - Text Color' , 1 )
DO k = 1, nmap
IF( cmap(k) == ' ' ) CYCLE
i = 1 + (k-1)/ny
j = k - (i-1)*ny
CALL NG_PLCHHI( x0(i), y0(j), TRIM(cmap(k)), ht, 0.0, 'CenterLeft',&
xb=xb(1,k), yb=yb(1,k) ) ! get bounding box of string
! transform coordinates from user to fractional
xb(:,k) = NG_CUFX(xb(:,k))
yb(:,k) = NG_CUFY(yb(:,k))
END DO
!-------
saved_inside = .FALSE.
saved_k = 0
DO
! get mouse/keyboard action
CALL NG_WINCSR( x, y, ib ) ! (x,y) are fractional coordinates
! Esc pressed
IF( ib == 27 ) THEN
imap = 0
EXIT
END IF
IF( x<0.0 .OR. x>xl .OR. y<0.0 .OR. y>yl ) CYCLE
! picking a item
inside = .FALSE.
DO k = 1, nmap
IF( cmap(k) == ' ' ) CYCLE
i = 1 + (k-1)/ny
j = k - (i-1)*ny
inside = ( x>=MINVAL(xb(:,k)) .AND. x<=MAXVAL(xb(:,k)) .AND.&
y>=MINVAL(yb(:,k)) .AND. y<=MAXVAL(yb(:,k)) )
IF( inside ) EXIT
END DO
! restore the old
IF( saved_inside .AND. ((.NOT.inside) .OR. (k/=saved_k)) ) THEN
CALL NG_PCSETI( 'BC(2) - Box Fill Color', 0 )
CALL NG_PCSETI( 'CC - Text Color' , 1 )
CALL NG_PLCHHI( xx, yy, TRIM(cc), ht, 0.0, 'CenterLeft' )
END IF
! the inking new
IF( inside .AND. ((.NOT.saved_inside) .OR. (k/=saved_k)) ) THEN
cc = cmap(k)
xx = x0(i)
yy = y0(j)
CALL NG_PCSETI( 'BC(2) - Box Fill Color', 2 )
CALL NG_PCSETI( 'CC - Texr Color' , 3 )
CALL NG_PLCHHI( xx, yy, TRIM(cc), ht, 0.0, 'CenterLeft' )
END IF
! MB1/MB2 pressed
IF( inside .AND. ((ib==5).OR.(ib==6)) ) THEN
imap = k
EXIT
END IF
! save current
saved_k = k
saved_inside = inside
END DO
!-------
! Erase current frame
CALL NG_FRAME( WAIT=-1, ADVANCE=.TRUE. )
DEALLOCATE( xb, yb )
END SUBROUTINE Gallery_Menu
END PROGRAM Gallery_GIF