!----------------------------------------------------------------------------------------------------------------------------------- !<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>- !----------------------------------------------------------------------------------------------------------------------------------- subroutine nc_printhtml(win,filename) ! @(#) print ncurses(3c) window as HTML use M_ncurses implicit none !----------------------------------------------------------------------------------------------------------------------------------- type(C_PTR),intent(in) :: win ! window to print character(len=*),intent(in) :: filename ! filename to print to !----------------------------------------------------------------------------------------------------------------------------------- integer :: my,mx ! size of the specified window integer(C_LONG) :: cell ! long character in cell (attributes, color pair, and character) character(len=1) :: let ! the character in the cell character(len=128) :: lets ! the characters that need printed in HTML to represent the cell integer :: ilet ! decimal value of character in the cell integer(C_LONG) :: attr ! attributes of the cell integer :: ios ! status from open(3f) character(len=256) :: msg ! message from open(3f) integer,save :: iout=11 ! unit to open(3f) for writing integer :: i,j ! loop counters integer :: ierr integer(C_SHORT) :: pair ! color pair used by the cell integer(C_SHORT) :: rf,gf,bf ! color components of cell foreground integer(C_SHORT) :: rb,gb,bb ! color components of cell background integer(C_SHORT) :: fg,bg ! foreground and background color numbers of cell logical :: span=.false. !! started a span region or not. Might actually use it later character(len=100) :: colordef character(len=100) :: class character(len=100) :: lastclass !----------------------------------------------------------------------------------------------------------------------------------- OPEN(UNIT=iout,FILE=trim(filename),ACTION='write',ACCESS='stream',FORM='unformatted',IOSTAT=ios,IOMSG=msg,STATUS='unknown') if(ios.ne.0)then call nc_errmessage("failed to open print file "//trim(filename)//':'//trim(msg)) return endif !----------------------------------------------------------------------------------------------------------------------------------- call ln('') call ln('') call ln('') call ln('') !----------------------------------------------------------------------------------------------------------------------------------- call ln('') !----------------------------------------------------------------------------------------------------------------------------------- call ln('') call ln('') call ln('
')
!-----------------------------------------------------------------------------------------------------------------------------------
   call getmaxyx(win,my,mx)                     ! size window size as defined (all of it, even if subsection being displayed)
!-----------------------------------------------------------------------------------------------------------------------------------
   lastclass=''
   do i=0,my-1
      do j=0,mx-1
         class=''
         cell=mvwinch(win,i,j)                    ! retrieve cell value
         ilet=and(cell,A_CHARTEXT)                ! get decimal letter from cell using bit-mask
         let=char(ilet)                           ! get character from decimal
         lets=let                                 ! what to print for the character
         pair=int(PAIR_NUMBER(cell),C_INT)        ! the color pair used to draw the cell
         attr=iand(cell,A_ATTRIBUTES)             !! the attributes of the cell
         if(iand(attr,A_BLINK).eq. A_BLINK)          class=trim(class)//' BL'
         if(iand(attr,A_INVIS).eq. A_INVIS)          class=trim(class)//' IN'
         if(iand(attr,A_NORMAL).eq. A_NORMAL)        class=class !class=' '
         if(iand(attr,A_PROTECT).eq. A_PROTECT)      class=trim(class)//' '
         if(iand(attr,A_UNDERLINE).eq. A_UNDERLINE)  class=trim(class)//' U'
         if(iand(attr,A_DIM).eq.A_DIM)               class=trim(class)//' '
         if(iand(attr,A_HORIZONTAL).eq.A_HORIZONTAL) class=trim(class)//' '
         if(iand(attr,A_LEFT).eq.A_LEFT)             class=trim(class)//' '
         if(iand(attr,A_LOW).eq.A_LOW)               class=trim(class)//' '
         if(iand(attr,A_RIGHT).eq.A_RIGHT)           class=trim(class)//' '
         if(iand(attr,A_STANDOUT).eq.A_STANDOUT)     class=trim(class)//' '
         if(iand(attr,A_TOP).eq.A_TOP)               class=trim(class)//' '
         if(iand(attr,A_VERTICAL).eq.A_VERTICAL)     class=trim(class)//' '
         if(iand(attr,A_BOLD).eq.A_BOLD)             class=trim(class)//' BO'
         if(iand(attr,A_ITALIC).eq.A_ITALIC)         class=trim(class)//' I'
!-----------------------------------------------------------------------------------------------------------------------------------
         ! The Alternate Character Set ( includes lines & boxes)
         if(iand(attr,A_ALTCHARSET).eq.A_ALTCHARSET)then
            select case(let)
            case('l'); lets="┌"   ! ACS_ULCORNER upper left corner        ┌
            case('m'); lets="└"   ! ACS_LLCORNER lower left corner        └
            case('k'); lets="┐"   ! ACS_URCORNER upper right corner       ┐
            case('j'); lets="┘"   ! ACS_LRCORNER lower right corner       ┘
            case('t'); lets="├"   ! ACS_LTEE     tee pointing right       ├
            case('u'); lets="┤"   ! ACS_RTEE     tee pointing left        ┤
            case('v'); lets="┴"   ! ACS_BTEE     tee pointing up          ┴
            case('w'); lets="┬"   ! ACS_TTEE     tee pointing down        ┬
            case('q'); lets="─"   ! ACS_HLINE    horizontal line          ─
            case('x'); lets="│"   ! ACS_VLINE    vertical line            !
            case('n'); lets="┼"   ! ACS_PLUS     large plus or crossover  ┼
            case('o'); lets="⎺"   ! ACS_S1       macron, overline, scan line 1 (above) ⎺
               lets="¯"
               lets="⎺"
            case('s'); lets="⎽"   ! ACS_S9       scan line 9 (below)      ⎽
            case('`'); lets="◆"   ! ACS_DIAMOND  diamond                  ◆
               lets="◊"
               lets="♦"
            case('a'); lets="ਟ"   ! ACS_CKBOARD  checker board (stipple)  ▒
               lets="▒"
            case('f'); lets="°"     ! ACS_DEGREE   degree symbol            °
            case('g'); lets="±"  ! ACS_PLMINUS  plus/minus               ±
            case('~'); lets="•"    ! ACS_BULLET   bullet                   · •
            case(','); lets="←"    ! ACS_LARROW   arrow pointing left      ←
            case('+'); lets="→"    ! ACS_RARROW   arrow pointing right     →
            case('.'); lets="↓"    ! ACS_DARROW   arrow pointing down      ↓
            case('-'); lets="↑"    ! ACS_UARROW   arrow pointing up        ↑
            case('h'); lets="▚"   ! ACS_BOARD    board of squares         ▚
            case('i'); lets="␋"   ! ACS_LANTERN  lantern symbol           ␋
            case('0'); lets="█"   ! ACS_BLOCK    solid square block       █
            case('p'); lets="⎻"   ! ACS_S3       scan line 3(at top)      ⎻
            case('r'); lets="⎼"   ! ACS_S7       scan line 7 (at bottom)  ⎼
            case('y'); lets="≤"      ! ACS_LEQUAL   less/equal               ≤
            case('z'); lets="≥"      ! ACS_GEQUAL   greater/equal            ≥
            case('{'); lets="π"      ! ACS_PI       Pi                       π
            case('|'); lets="≠"      ! ACS_NEQUAL   not equal                ≠
            case('}'); lets="£"   ! ACS_STERLING UK pound sign            £
            end select
         else                           ! Regular Characters that are special in HTML
            select case(let)
            case('&'); lets='&'     !   &  &  {ampersand}
            case('<'); lets='<'      !   <  <  {less than}
            case('>'); lets='>'      !   >  >  {greater than}
            case('"'); lets='"'    !   "  "  {quotation mark}
            !case(' '); lets=' '   !        {Non-breaking space}
            end select
         endif
!-----------------------------------------------------------------------------------------------------------------------------------
         if(iand(attr,A_REVERSE).eq.A_REVERSE)then
            write(class,'(a," RPAIR",i0)') trim(class),pair
         else
            write(class,'(a," PAIR",i0)') trim(class),pair
         endif
!-----------------------------------------------------------------------------------------------------------------------------------
         if(iand(attr,A_STANDOUT).eq.A_STANDOUT)then
            write(class,'(a," RPAIR",i0)') trim(class),pair
         else
            write(class,'(a," PAIR",i0)') trim(class),pair
         endif
!-----------------------------------------------------------------------------------------------------------------------------------
         if(class.ne.lastclass)then
            if(span)then
               write(iout)''
               span=.false.
            endif
            if(class.eq.' ')then
               write(iout)''
            else
               write(iout)''
            endif
            span=.true.
         endif
!-----------------------------------------------------------------------------------------------------------------------------------
         write(iout)lets(:max(1,len_trim(lets)))
         lastclass=class
      enddo
      write(iout)NEW_LINE('a')
   enddo
!-----------------------------------------------------------------------------------------------------------------------------------
   if(span)call ln('')
   call ln('
') call ln('') call ln('') endfile(unit=iout,iostat=ios,iomsg=msg) ! make sure file is truncated or longer old files may leave data in file contains subroutine ln(string) implicit none character(len=*) :: string write(iout)string write(iout)new_line('a') end subroutine ln end subroutine nc_printhtml