module Generate_Text_m

  ! Generate an ALD page as text using DEC (or IBM/Microsoft 437)
  ! line-drawing characters.

  use Declaration_Types ! Field names F_*
  use Error_Handler, only: Error_Intro, Warning
  use Output_m, only: Blanks, Output
  use Parser_Tables, only: N_Asterisk, N_Dot, N_Minus, N_Plus, N_Tilde
  use String_Table, only: Get_String, String_Length
  use Tables_m, only: Block_t, Blocks, Comment_t, Comments, Dot_t, Dots, &
    & EC_t, ECs, Edge_t, Edges, Ends, Input_t, Inputs, Line_t, Lines, &
    & Multi_t, Multis, Output_t, Outputs, Page_t, Pages
  use Toggles, only: T_Gen=>Gen, Levels, Toggle
  use Trace, only: Trace_Begin, Trace_End
  use Tree, only: Decoration, Node_Id, Node_Kind, NSons, Pseudo, Source_Ref, &
    & Subtree, Sub_Rosa

  implicit NONE
  private

  public :: Generate_Text

  ! Grapin_hics characters are represented by special characters and
  ! lower-case letters, which are easier to grok for debugging, or by
  ! DECTECH encoding of box-drawing characters:

  !    DECTECH encoding                   HTML       Postscript
  character, parameter :: &     
    Horz  = 'q', &  ! horizontal          &#x2500;   SF100000
  & Vert  = 'x', &  ! vertical            &#x2502;   SF110000
  & UL    = 'l', &  ! upper left corner   &#x250C;   SF010000
  & LL    = 'm', &  ! lower left corner   &#x2514;   SF020000
  & UR    = 'k', &  ! top right corner    &#x2510;   SF030000
  & LR    = 'j', &  ! bottom right corner &#x2518;   SF040000
  & Cross = 'n', &  ! crossing            &#x253C;   SF050000
  & Dot   = 'O', &  ! dot                 &#x25CB;   O or circle
  & Right = 't', &  ! abut from right     &#x251C;   SF080000
  & Left  = 'u', &  ! abut from left      &#x2524;   SF090000
  & Above = 'v', &  ! abut from above     &#x2534;   SF070000
  & Below = 'w', &  ! abut from below     &#x252C;   SF060000
  & Loz   = 'g'     ! lozenge             &#x25A1;   filledbox or whitesquare

  character(4), parameter :: Corners(4) =  [ & ! Prev x Curr directions
  & ' ' // lr // ll // ' ',        & ! D to D, L, R, U
  & ul  //   '  '   // ll,         & ! L to D, L, R, U
  & ur  //   '  '   // lr,         & ! R to D, L, R, U
  & ' ' // ur // ul // ' ' ]         ! U to D, L, R, U

  character :: Gen(120,198)       ! Columns, lines

!---------------------------- RCS Module Info ------------------------------
  character (len=*), private, parameter :: ModuleName= &
       "$RCSfile: parser.f90,v $"
  private :: not_used_here 
!---------------------------------------------------------------------------

contains

  subroutine Generate_Text ( Root, Modular, Page_Num, U, PostScript, Warn )

    integer, intent(in) :: Root       ! of the abstract syntax tree
    integer , intent(in) :: Modular   ! 1 or 2
    integer, intent(in) :: Page_Num   ! to draw
    integer, intent(in) :: U          ! Output unit
    logical, intent(in) :: PostScript ! "Generate postscript output"
    logical, intent(inout) :: Warn

    integer :: I, J

    if ( toggle(t_gen) ) call trace_begin ( 'Generate_Text', text=' for ', node=root )

    gen = ''

    call draw_page ( pages(page_num) )

    do i = ends(page_num-1)%last_block+1, ends(page_num)%last_block
      call draw_block ( blocks(i), modular )
    end do

    call draw_comment_and_EC ( comments(ends(page_num-1)%last_comment+1: &
                                       &ends(page_num)%last_comment), &
                             & ECs(ends(page_num-1)%last_EC+1:&
                                  &ends(page_num)%last_EC) )

    do i = ends(page_num-1)%last_dot+1, ends(page_num)%last_dot
      call draw_dot ( dots(i) )
    end do

    call draw_edge ( edges(ends(page_num-1)%last_edge+1: &
                          &ends(page_num)%last_edge) )

    do i = ends(page_num-1)%last_input+1, ends(page_num)%last_input
      call draw_input ( inputs(i) )
    end do

    do i = ends(page_num-1)%last_line+1, ends(page_num)%last_line
      call draw_line ( lines(i), Warn )
    end do

    do i = ends(page_num-1)%last_multi+1, ends(page_num)%last_multi
      call draw_multi ( multis(i) )
    end do

    do i = ends(page_num-1)%last_output+1, ends(page_num)%last_output
      call draw_output ( outputs(i) )
    end do

    if ( toggle(t_gen) ) call trace_end ( 'Generate_Text', text=' for ', node=root )

    if ( postScript ) then
      call Write_Postscript ( page_num, u )
    else
      do j = 1, size(gen,2)
        do i = size(gen,1), 1, -1
          if ( gen(i,j) /= ' ' ) exit
        end do    
        write ( u, '(120a)' ) gen(1:i,j)
      end do
    end if

  end subroutine Generate_Text

  subroutine Copy_Text ( From, To, Adj, Fill )
    character(*), intent(inout) :: From
    character, intent(inout) :: To(:)
    character, intent(in), optional :: Adj  ! Center, Left, Right, default L
    character, intent(in), optional :: Fill ! To replace blanks
    integer :: I, L, N
    character :: MyAdj
    myAdj = 'L'
    if ( present(adj) ) myAdj = adj
    select case ( myAdj )
    case ( 'C' ) ! Center
      from = adjustl(from)
      l = len_trim(from)
      n = size(to)
      from = repeat(' ',(n-l+1)/2) // from(1:l)
    case ( 'L' ) ! Adjustl
      from = adjustl(from)
    case ( 'R' ) ! Adjustr
      from = adjustr(from)
    end select

    do i = 1, len(from)
      to(i) = from(i:i)
      if ( present(fill) ) then
        if ( to(i) == ' ' ) to(i) = fill
      end if
    end do
  end subroutine Copy_Text

  subroutine Draw_Block ( The_Block, Modular )
    type(block_t), intent(in) :: The_Block
    integer, intent(in) :: Modular  ! 1 or 2
    integer :: GSon ! Son of son
    integer :: H, I, J, V, V2
    integer :: S    ! Sub_Rosa(son)
    integer :: Son  ! Of The_block%Tree spec node
    character(10) :: Text
    if ( toggle(t_gen) ) call trace_begin ( 'Draw_Block', text=' for ', node=the_block%tree )
    h = iachar(the_block%label(1:1)) - iachar('0')
    v = min(iachar(the_block%label(2:2)) - iachar('A') + 1,9)
    h = mod(the_block%page_pos,1000)
    v = the_block%page_pos/1000
    ! Draw the box
    associate ( g => gen(h+2:h+7,v:v+11) )
      g(1,4)    = ul
      g(2:5,4)  = horz
      g(6,4)    = ur
      g(1,5:10) = vert
      g(6,5:10) = vert
      g(1,11)  = ll
      g(2,11)  = horz
      g(5,11)  = horz
      g(6,11)  = lr
      text = the_block%label
      call copy_text ( text(1:2), g(3:4,12) ) ! Block coordinates
      do i = 2, nsons(the_block%tree)   ! Spec node's sons
        son = subtree(i,the_block%tree) ! Field node
        gson = subtree(2,son)           ! First value of the field
        if ( node_kind(gson) == pseudo  ) then
          s = sub_rosa(gson)
          call get_str ( s, text )
        end if
        select case ( decoration(son) ) ! Field node
        case ( f_block ) ! ...............................  Block  .....
          call copy_text ( text(1:2), g(3:4,11), 'R', fill='0' )
        case ( f_cap ) ! ...................................  Cap  .....
          call copy_text ( text(1:2), g(4:5,10), 'R', fill='-' )
        case ( f_card ) ! .................................  Card  .....
          call copy_text ( text(1:2), g(2:3,10), 'R', fill='-' )
        case ( f_chassis ) ! ...........................  Chassis  .....
          call copy_text ( text(1:1), g(2:2,9), 'R', fill='-' )
        case ( f_column ) ! .............................  Column  .....
          if ( modular == 1 ) then
            call get_str ( s, g(3,9) )
          else
            call copy_text ( text(1:2), g(4:5,9) )
          end if
        case ( f_ec ) ! .....................................  EC  .....
          call get_str ( s, g(5,8) )
        case ( f_frame ) ! ...............................  Frame  .....
          call copy_text ( text(1:2), g(2:3,8), 'R', fill='0' )
        case ( f_func ) ! .................................  Func  .....
          if ( text == '' ) text=' .. '
          call copy_text ( text(1:4), g(2:5,6) )
        case ( f_gate ) ! .................................  Gate  .....
          if ( modular == 1 ) then
            call get_str ( s, g(2,9) )
          else
            call get_str ( s, g(4,8) )
          end if
        case ( f_mode ) ! .................................  Mode  .....
          if ( node_id(gson) == n_dot ) then
            call get_str ( sub_rosa(subtree(1,gson)), text )
            call copy_text ( text(1:2), g(2:3,7) )
            call get_str ( sub_rosa(subtree(2,gson)), text )
            call copy_text ( text(1:2), g(4:5,7), 'R' )
          else
            call get_str ( sub_rosa(subtree(1,gson)), text )
            call copy_text ( text(1:2), g(2:5,7) )
          end if
        case ( f_module ) ! .............................  Module  .....
          call get_str ( s, g(4,8) )
        case ( f_row ) ! ...................................  Row  .....
          if ( modular == 1 ) then
            call copy_text ( text(1:2), g(4:5,9), 'R' , fill='0')
          else
            call get_str ( s, g(3,9) )
          end if
        case ( f_show ) ! .................................  Show  .....
          ! field values are dot expressions
          do j = 2, nsons(son)
            gson = subtree(j,son) ! Known to be N_Dot
            call get_str ( sub_rosa(subtree(2,gson)), text ) ! Row number 1-16
            read ( text, * ) v2
            call get_str ( sub_rosa(subtree(1,gson)), text ) ! Pin(s)
            if ( v2 < 9 ) then
              if ( text(2:2) == ' ' ) text(2:2) = horz
              call copy_text ( text(1:2), gen(h:h+1,merge(v+v2+2,v+v2-6,v2<9)) )
            else
              text(2:2) = adjustr(text(2:2))
              if ( text(1:1) == ' ' ) text(2:2) = horz
              call copy_text ( text(1:2), gen(h+8:h+9,merge(v+v2+2,v+v2-6,v2<9)) )
            end if
          end do
        case ( f_symbol )  ! ............................  Symbol  .....
          if ( node_id(gson) == n_minus ) then
            text(1:1) = '-'
            call get_str ( sub_rosa(subtree(1,gson)), text(2:) )
          else if ( node_id(gson) == n_plus ) then
            text(1:1) = '+'
            call get_str ( sub_rosa(subtree(1,gson)), text(2:) )
          end if
          call copy_text ( text(1:4), g(2:5,5), 'C' )
        case ( f_title ) ! ...............................  Title  .....
          call copy_text ( text(1:10), gen(h:h+9,v+2), 'C' )
        end select
      end do
    end associate
    if ( toggle(t_gen) ) call trace_end ( 'Draw_Block', text=' for ', node=the_block%tree )
  end subroutine Draw_Block

  subroutine Draw_Comment_and_EC ( Comment, EC )
    ! Draw Comments and Engineering Change numbers together because the total
    ! number of lines occupied depends upon the maximum numbers of both.
    type(comment_t), intent(in) :: Comment(:)
    type(ec_t), intent(in) :: EC(:)
    integer :: H, I, J, V
    integer :: NLines  ! occupied by comments and engineering change numbers
    integer :: Son     ! index of text=... field node
    character(39) :: Text

    ! Draw the border lines for the engineering change number fields
    v = min(4,size(ec))
    text = 'COMMENTS'
    call copy_text ( text(1:len('COMMENTS')), gen(17:24,184) )
    do j = 1, v
      h = 40 + 20*(j-1)
      text='TAG  DATE   E.C.NO.'
      call copy_text ( text(1:len('TAG  DATE   E.C.NO.')), gen(h+1:h+20,184) )
    end do
    nLines = max ( sum(comment(:)%n_Text), (size(ec)-1)/4 + 1 )
    do i = 1, nLines
      do j = 41, 41+20*(v-1), 20
       gen(j,184+i) = vert
      end do
    end do

    ! Set the comments
    v = 184 ! Line of Gen
    do i = 1, min(size(comment),14)
      if ( toggle(t_gen) ) call trace_begin ( 'Draw_Comment', text=' for ', &
        & node=comment(i)%tree )
      son = subtree(2,comment(i)%tree)
      do j = 2, nsons(son)
        v = v + 1
        call get_str ( sub_rosa(subtree(j,son)), text )
        call copy_text ( text, gen(1:39,v) )
      end do ! j
      if ( toggle(t_gen) ) call trace_end ( 'Draw_EC', text=' for ', &
        & node=comment(i)%tree )
    end do

    ! Set the engineering changes
    v = 184
    j = 4    ! Number of ECs on the line so far
    do i = 1, size(ec)
      j = j + 1
      if ( j > 4 ) then
        j = 1
        v = v + 1
      end if
      h = 40 + 20*(j-1)
      gen(h+2:h+2,v) = ec(i)%tag
      text = ec(i)%date
      call copy_text ( text(1:len(ec(i)%date)), gen(h+4:h+11,v) )
      text = ec(i)%number
      call copy_text ( text(1:len(ec(i)%number)), gen(h+13:h+19,v) )
    end do
  end subroutine Draw_Comment_and_EC

  subroutine Draw_Dot ( The_Dot )
    type(dot_t), intent(in) :: The_Dot
    integer :: H, V
    if ( toggle(t_gen) ) call trace_begin ( 'Draw_Dot', text=' for ', node=the_dot%tree )
    h = mod(the_dot%page_pos,1000)
    v = the_dot%page_pos/1000
    gen(h,v) = dot
    if ( toggle(t_gen) ) call trace_end ( 'Draw_Dot', text=' for ', node=the_dot%tree )
  end subroutine Draw_Dot

  subroutine Draw_Edge ( Edge )
    type(Edge_t), intent(in) :: Edge(:)
    ! Edge connectors defined on Input or Output are included in Edge(:)
    integer :: H, I, J, Tree, V
    character(8) :: Text
    v = 165
    j = 6
    do i = 1, size(edge)
      tree = edge(i)%tree
      if ( edge(i)%i_o_tree /= 0 ) tree = edge(i)%i_o_tree
      if ( toggle(t_gen) ) call trace_begin ( 'Draw_Edge', text=' for ', &
        & node=tree )
      j = j + 1
      if ( j > 6 ) then
        j = 1
        v = v + 1
      end if
      h = 1 + 19*(j-1)
      gen(h:h+5,v) = horz
      if ( edge(i)%tag /= ' ' ) then
        gen(h:h+1,v) = ' '
        gen(h+2,v) = '*'
        gen(h+3,v) = edge(i)%tag
      end if
      text = edge(i)%text
      call copy_text ( text, gen(h+6:h+13,v) )
      if ( toggle(t_gen) ) call trace_end ( 'Draw_Edge', text=' for ', &
        & node=tree )
    end do
  end subroutine Draw_Edge

  subroutine Draw_Input ( Input )
    type(input_t), intent(inout) :: Input ! %Text might be rearranged
    logical :: Fail ! Needed by Draw_Horz, but not otherwise used.
    integer :: GSon ! Son of son
    integer :: I, V
    integer :: R    ! Right end of a line + 1
    integer :: Son  ! Of Input%Tree spec node
    if ( toggle(t_gen) ) call trace_begin ( 'Draw_Input', text=' for ', node=input%tree )
    v = input%page_pos/1000
    gen(11:14,v+2) = '    '
    r = 15
    do i = 2, nsons(input%tree)   ! Spec node's sons, i.e., field nodes
      son = subtree(i,input%tree) ! Field node
      gson = subtree(2,son)       ! First value of the field
      select case ( decoration(son) ) ! Field node
      case ( f_edge ) ! node_id(gson) == n_dot
        gen(13,v+2) = '*'
        call get_str ( sub_rosa(subtree(2,gson)),gen(14,v+2) )
        r = 13
      case ( f_level ) ! Already done in Tables_m
      case ( f_logic )
        call set_logic ( gson, 1, v+2 )
      case ( f_text )
        if ( input%nText == 1 ) then
          call copy_text ( input%sign, gen(1:1,v+1) )
          call copy_text ( input%signal, gen(2:3,v+1) )
          call copy_text ( input%text(1)(1:12), gen(4:15,v+1) )
        else
          call copy_text ( input%sign, gen(1:1,v) )
          call copy_text ( input%signal, gen(2:3,v) )
          call copy_text ( input%text(1)(1:12), gen(4:15,v) )
          call copy_text ( input%text(2)(1:15), gen(1:15,v+1) )
        end if
      end select
    end do
    call draw_horz ( 10, r, v+2, input%tree, fail )
    if ( toggle(t_gen) ) call trace_end ( 'Draw_Input', text=' for ', node=input%tree )
  end subroutine Draw_Input

  subroutine Draw_Line ( Line, Warn )
    type(line_t), intent(in) :: Line
    logical, intent(inout) :: Warn
    logical :: Asterisk     ! From field value begins with asterisk or tilde
    character :: D, DP      ! Direction to move, a letter in the route field
    logical :: Fail         ! Unable to draw the line, stuff in the way
    integer :: H0, H1, H2, H3   ! Page coordinates
    integer :: I, J
    logical :: Input        ! From is an input label
    integer :: L            ! string_length(r)
    character(2) :: Label   ! of logic block pin
    integer :: N            ! Distance to move, a number in the route field
    integer :: Pin_H, Pin_V ! End coordinates of previous line
    character(99) :: Route  ! Text of route
    integer :: R            ! Sub_Rosa of route R in B.#.R or L.R
    integer :: Son          ! Son of From or To vertex
    integer :: V0, V1, V2, V3   ! Page coordinates
    integer :: XC, XP       ! Current, previous directions DLRU => 1..4
    if ( toggle(t_gen) ) call trace_begin ( 'Draw_Line', text=' for ', node=line%tree )
    son = subtree(2,line%from)
    asterisk = any(node_id( son ) == [ n_asterisk, n_tilde ])
    if ( asterisk ) son = subtree(1,son)
    call get_h_v ( son, h0, v0, label, pin_h )
    Input = node_id(son) /= n_dot ! Block, for now
    if ( .not. input ) then ! From a block
      if ( asterisk ) gen(h0-1,v0) = loz
      call copy_text ( label, gen(h0:h0+1,v0) )
      h0 = h0 + 1
    else ! Label of dot or input
      input = decoration(decoration(son)) == s_input
    end if
    do i = 2, nsons(line%to)
      h1 = h0
      v1 = v0
      son = subtree(i,line%to)
      asterisk = any(node_id(son) == [ n_asterisk, n_tilde ])
      if ( asterisk ) son = subtree(1,son)
      r = 0
      call get_h_v ( son, h2, v2, label, pin_h )
      if ( node_id(son) == n_dot ) then ! Block.pin.label.R or Label.R
        if ( nsons(son) >= 3 ) then
          if ( asterisk ) then
            gen(merge(h2-1,h2+2,pin_h<9),v2) = loz
          else if ( pin_h < 9 ) then
            gen(h2+2,v2) = left ! Original ALD didn't have this
          end if
          call copy_text ( label, gen(h2:h2+1,v2) )
          if ( nsons(son) == 4 ) r = sub_rosa(subtree(4,son))
        else
          r = sub_rosa(subtree(2,son))
        end if
      end if
      if ( r == 0 ) then
        ! Try just straight unblocked vertical and horizontal lines
        if ( h1 == h2 ) then
          call draw_vert ( h1, v1, v2, son, fail )
        else if ( v1 == v2 ) then
          call draw_horz ( h1, h2, v1, son, fail )
        else
          fail = .true.
        end if
      else
        call get_str ( r, route ) ! upper case, sans quotes
        l = string_length(r)
        j = 0 ! Route character position. Route is alternating letters and numbers
        dp = ' '
        if ( input .and. route(1:1) /= 'R' ) then ! Need a corner
          dp = 'R'
          xp = 3 ! R
          pin_h = 14
          pin_v = v1
        end if
        do
          j = j + 1
          d = route(j:j)
          call get_dist ( route, l, j, n )
          if ( levels(t_gen) > 1 ) then
            call output ( 'Drawing line segment ' )
            call output ( d )
            call output ( n, advance='yes' )
          end if
          select case ( d )
          case ( 'D' ) ! Down
            xc = 1
            v3 = v2
            if ( n /= 0 ) v3 = v1 + n
            if ( dp /= ' ' ) gen(pin_h,pin_v) = corners(xp)(xc:xc)
            call draw_vert ( h1, v1, v3, son, fail )
            v1 = v3
            if ( fail ) exit
          case ( 'L' ) ! Left
            xc = 2
            h3 = h2
            if ( n /= 0 ) h3 = h1 - n
            if ( dp /= ' ' ) gen(pin_h,pin_v) = corners(xp)(xc:xc)
            call draw_horz ( h1, h3, v1, son, fail )
            h1 = h3
            if ( fail ) exit
          case ( 'R' ) ! Right
            xc = 3
            h3 = h2
            if ( n /= 0 ) h3 = h1 + n
            if ( dp /= ' ' ) gen(pin_h,pin_v) = corners(xp)(xc:xc)
            call draw_horz ( h1, h3, v1, son, fail )
            h1 = h3
            if ( fail ) exit
          case ( 'U' ) ! Up
            xc = 4
            v3 = v2
            if ( n /= 0 ) v3 = v1 - n
            if ( dp /= ' ' ) gen(pin_h,pin_v) = corners(xp)(xc:xc)
            call draw_vert ( h1, v1, v3, son, fail )
            v1 = v3
            if ( fail ) exit
          end select
          dp = d
          pin_h = h1 ; pin_v = v1
          xp = xc
          if ( j >= l ) exit
        end do
        if ( h1 == h2 ) then ! Last leg, previous was Horz
          xc = merge(1,4,v1<v2)
          if ( dp == 'L' ) then
            gen(pin_h,pin_v) = corners(xp)(xc:xc)
          else if ( dp == 'R' ) then
            gen(pin_h,pin_v) = corners(xp)(xc:xc)
          end if
          call draw_vert ( h1, v1, v2, son, fail )
        else if ( v1 == v2 ) then ! Last leg, previous was Vert
          xc = merge(2,3,h1>h2)
          if ( dp == 'D' ) then
            gen(pin_h,pin_v) = corners(xp)(xc:xc)
          else if ( dp == 'U' ) then
            gen(pin_h,pin_v) = corners(xp)(xc:xc)
          end if
          call draw_horz ( h1, h2, v1, son, fail )
        else
          call error_intro ( warning, source_ref(son) )
          call output ( 'Routing information is not sufficient.', advance='yes' )
          warn = .true.
        end if
      end if
      if ( fail ) then
        call error_intro ( warning, source_ref(son) )
        call output ( "Need routing information, or it's incorrect.", advance='yes' )
        warn = .true.
      end if
    end do
    if ( toggle(t_gen) ) call trace_end ( 'Draw_Line', text=' for ', node=line%tree )

  contains

    subroutine Get_Dist ( Route, L, J, N )
      character(*), intent(in) :: Route
      integer, intent(in) :: L     ! Last character of route to use
      integer, intent(inout) :: J  ! Position in route
      integer, intent(out) :: N    ! Number starting at J, or zero if none
      n = 0
      do
        j = j + 1
        if ( j > l ) exit
        if ( iachar(route(j:j)) < iachar('0') .or. &
           & iachar(route(j:j)) > iachar('9') ) exit
        n = n * 10 + iachar(route(j:j)) - iachar('0')
      end do
      j = j - 1
    end subroutine Get_Dist

    subroutine Get_H_V ( Son, H, V, Label, Pin )
      integer, intent(in) :: Son    ! Son vertex index, N_Dot or N_Identifier
      integer, intent(out) :: H, V  ! Page coordinates
      character(2), intent(out) :: Label ! If Son is N_dot for a block vertex
      integer, intent(out) :: Pin   ! of logic block
      integer :: Decor    ! Decoration of something
      integer :: Ix       ! Index in Blocks, Dots, Line
      label = ' '
      pin = 0 ! In case it's not a logic block
      if ( node_id(son) == n_dot .and. nsons(son) >= 3 ) then ! Block.pin.label
        call get_str ( sub_rosa(subtree(2,son)), label ) ! Actually the pin index
        read ( label, * ) pin
        decor = decoration(subtree(1,son)) ! Block spec vertex index
        ix = decoration(subtree(1,decor))
        h = mod(blocks(ix)%page_pos, 1000)
        if ( pin > 8 ) h = h + 8
        v = blocks(ix)%page_pos / 1000 + mod(pin-1,8) + 3
        call get_str ( sub_rosa(subtree(3,son)), label )
        if ( label(2:2) == ' ' ) label(2:2) = horz
      else ! Label of dot or input or output
        if ( node_id(son) == n_dot ) then ! Dot.Route or Output.Route
          decor = decoration(subtree(1,son))
        else ! Dot or Output
          decor = decoration(son) ! dot or Input or output Spec vertex index
        end if
        ix = decoration(subtree(1,decor))    ! Index in dots or Inputs or outputs
        select case ( decoration(decor) )
        case ( s_dot )
          h = mod(dots(ix)%page_pos, 1000)
          v = dots(ix)%page_pos / 1000
        case ( s_input )
          h = 14
          v = inputs(ix)%page_pos / 1000 + 2
        case ( s_output )
          h = mod(outputs(ix)%page_pos, 1000)
          v = outputs(ix)%page_pos / 1000 + 2
        end select
      end if
    end subroutine Get_H_V
  end subroutine Draw_Line

  subroutine Draw_Multi ( Multi )
    type(multi_t), intent(in) :: Multi
    integer, allocatable :: Coords(:) ! Blocks' page positions
    logical :: Fail ! Not used, but Draw_Vert needs it
    integer :: GSon ! Son of son
    integer :: H, I, J, V
    integer :: Son  ! Of Multi%Tree spec node
    integer :: T
    if ( toggle(t_gen) ) call trace_begin ( 'Draw_Multi', text=' for ', node=multi%tree )
    son = subtree(2,multi%tree) ! Field node
    allocate ( coords(nsons(son)-1) )
    do j = 2, nsons(son)
      gson = decoration(subtree(j,son)) ! Tree index of block node
      coords(j-1) = blocks(decoration(subtree(1,gson)))%page_pos
    end do
    ! Sort the coordinates of the blocks. The Type Checker verified
    ! they're in the same column.
    do i = 1, size(coords)-1
      do j = 2, i+1
        if ( coords(i) > coords(j) ) then
          t = coords(i)
          coords(i) = coords(j)
          coords(j) = t
        end if
      end do
    end do
    h = mod(coords(1),1000) + 3
    do i = 1, size(coords)-1
      v = coords(i)/1000 + 10
      gen(h,v) = below; gen(h,v+11) = above ! Original ALD didn't have these
      call draw_vert ( h, v, v+11, son, fail )
      call draw_vert ( h+3, v, v+11, son, fail )
      gen(h+3,v) = below; gen(h+3,v+11) = above ! Original ALD didn't have these
    end do
    if ( toggle(t_gen) ) call trace_end ( 'Draw_Multi', text=' for ', node=multi%tree )
  end subroutine Draw_Multi

  subroutine Draw_Output ( Output )
    type(output_t), intent(inout) :: Output ! %Text might be rearranged
    logical :: Fail ! Needed for Draw_Horz, but not otherwise used
    integer :: GSon ! Son of son
    integer, parameter :: H = 106
    integer :: I, V
    integer :: L    ! Left end of a line
    integer :: Son  ! Of Output%Tree spec node
    if ( toggle(t_gen) ) call trace_begin ( 'Draw_Output', text=' for ', node=output%tree )
    v = output%page_pos/1000
    gen(h:h+3,v+2) = '    '
    l = h - 1
    do i = 2, nsons(output%tree)   ! Spec node's sons, i.e., field nodes
      son = subtree(i,output%tree) ! Field node
      gson = subtree(2,son)        ! First value of the field
      select case ( decoration(son) ) ! Field node
      case ( f_edge ) ! node_id(gson) == n_dot
        gen(h,v+2) = '*'
        call get_str ( sub_rosa(subtree(2,gson)),gen(h+1,v+2) )
        l = h + 1
      case ( f_level ) ! Already done in Tables_m
      case ( f_logic )
        call set_logic ( gson, 110, v+2 )
      case ( f_text )
        if ( output%nText == 1 ) then
          call copy_text ( output%sign, gen(h:h,v+1) )
          call copy_text ( output%signal, gen(h+1:h+2,v+1) )
          call copy_text ( output%text(1)(1:11), gen(h+3:h+14,v+1) )
        else
          call copy_text ( output%sign, gen(h:h,v) )
          call copy_text ( output%signal, gen(h+1:h+2,v) )
          call copy_text ( output%text(1)(1:11), gen(h+3:h+14,v) )
          call copy_text ( output%text(2)(1:14), gen(h:h+14,v+1) )
        end if
      end select
    end do
    call draw_horz ( l, h+4, v+2, output%tree, fail )
    if ( toggle(t_gen) ) call trace_end ( 'Draw_Output', text=' for ', node=output%tree )
  end subroutine Draw_Output

  subroutine Draw_Page ( Page )
    type(page_t), intent(in) :: Page
    integer :: GSon
    integer :: I
    integer :: S    ! Sub_Rosa(son)
    integer :: Son
    character(86) :: Text ! Wide enough for the title field
    if ( toggle(t_gen) ) call trace_begin ( 'Draw_Page', text=' for ', node=page%tree )
    do i = 2, nsons(page%tree)
      son = subtree(i,page%tree) ! Field node
      gson = subtree(2,son)      ! First value of the field
      if ( node_kind(gson) == pseudo  ) then
        s = sub_rosa(gson)
        call get_str ( s, text )
      end if
      select case ( decoration(son) ) ! Field node
      case ( f_logic )
        ! GSon is required to be a Dot node with 4 sons
        call set_logic ( gson, 108, 1 )
      case ( f_machine )
        call copy_text ( text(1:4), gen(95:98,1), 'R' )
      case ( f_number )
        call copy_text ( text(1:7), gen(1:7,1), 'R', fill='0' )
      case ( f_title )
        call copy_text ( text, gen(8:94,1), 'C' )
      end select
    end do
    if ( toggle(t_gen) ) call trace_end ( 'Draw_Page', text=' for ', node=page%tree )
  end subroutine Draw_Page

  subroutine Check_Horz ( H1, H2, V, Son, Fail )
    integer, intent(in) :: H1, H2, V, Son
    logical, intent(out) :: Fail
    integer :: I
    if ( levels(t_gen) > 0 ) then
      call output ( h1, before='Checking Horizontal line from (' )
      call output ( v, before=',' )
      call output ( h2, before=') to (' )
      call output ( v, before=',' )
      call output ( ').', advance='yes' )
    end if
    fail = .false. ! Assume no problems
    do i = min(h1,h2)+1, max(h1,h2)-1
      ! This is a kludge. The right coordinate of a box pin might be wrong.
      ! But only if it's To, not From:
      if ( gen(i,v) /= ' ' .and. gen(i,v) /= vert .and. &
                                 gen(i,v) /= horz ) then
        call error_intro ( warning, source_ref(son) )
        call output ( h1, before='Horizontal line from (' )
        call output ( v, before=',' )
        call output ( h2, before=') to (' )
        call output ( v, before=',' )
        call output ( ')', advance='yes' )
        call blanks ( len('*** Warning ***') )
        call output ( i, before=' failed because gen(' )
        call output ( v, before=',' )
        call output ( ') contains ' )
        call output ( gen(i,v), advance='yes' )
        fail = .true.
        return
      end if
    end do
  end subroutine Check_Horz

  subroutine Check_Vert ( H, V1, V2, Son, Fail )
    integer, intent(in) :: H, V1, V2, Son
    logical, intent(out) :: Fail
    integer :: J
    if ( levels(t_gen) > 0 ) then
      call output ( h, before='Checking Vertical line from (' )
      call output ( v1, before=',' )
      call output ( h, before=') to (' )
      call output ( v2, before=',' )
      call output ( ').', advance='yes' )
    end if
    fail = .false. ! Assume no problems
    do j = min(v1,v2)+1, max(v1,v2)-1
      if ( gen(h,j) /= ' ' .and. gen(h,j) /= horz) then
        fail = .true.
        call error_intro ( warning, source_ref(son) )
        call output ( h, before='Vertical line from (' )
        call output ( v1, before=',' )
        call output ( h, before=') to (' )
        call output ( v2, before=',' )
        call output ( ')', advance='yes' )
        call blanks ( len('*** Warning ***') )
        call output ( h, before=' failed because gen(' )
        call output ( j, before=',' )
        call output ( ') contains ' )
        call output ( gen(h,j), advance='yes' )
        return
      end if
    end do
  end subroutine Check_Vert

  subroutine Draw_Horz ( H1, H2, V, Son, Fail )
    integer, intent(in) :: H1, H2, V, Son
    logical, intent(out) :: Fail
    integer :: I
    fail = .false. ! Assume no problems
    call check_horz ( h1, h2, v, son, fail )
    if ( fail ) return
    do i = min(h1,h2)+1, max(h1,h2)-1
      if ( gen(i,v) == ' ' ) then
        gen(i,v) = horz
      ! This is a kludge. The right coordinate of a box pin might be wrong.
      ! But only if it's To, not From:
      else if ( gen(i,v) /= horz ) then
        gen(i,v) = cross
      end if
    end do
  end subroutine Draw_Horz

  subroutine Draw_Vert ( H, V1, V2, Son, Fail )
    integer, intent(in) :: H, V1, V2, Son
    logical, intent(out) :: Fail
    integer :: J
    call check_vert ( h, v1, v2, son, fail )
    if ( fail ) return
    do j = min(v1,v2)+1, max(v1,v2)-1
      if ( gen(h,j) == ' ' ) then
        gen(h,j) = vert
      else
        gen(h,j) = cross
      end if
    end do
  end subroutine Draw_Vert

  subroutine Get_Str ( String, Text )
    ! Wrapper for Get_String, to set Strip and Cap always .true.
    integer, intent(in) :: String
    character(*), intent(inout) :: Text
    call get_string ( string, text, cap=.true., strip=.true. )
  end subroutine Get_Str

  subroutine Set_Logic ( Logic, H, V )
    integer, intent(in) :: Logic ! Index of Dot tree node
    integer, intent(in) :: H, V  ! Coordinates in Gen
    integer :: J, K
    character(2) :: Text
    do j = 1, 4
      k = 3 * ( j - 1 )
      call get_str ( sub_rosa(subtree(j,logic)), text )
      if ( j /= 4 ) then
        call copy_text ( text(1:2), gen(h+k:h+k+1,v), 'R', fill='0' )
        gen(h+k+2,v) = '.'
      else
        call copy_text ( text(1:1), gen(h+9:h+9,v) )
      end if
    end do
  end subroutine Set_Logic

  subroutine Write_Postscript ( Page_Num, Out )
    integer, intent(in) :: Page_Num
    integer, intent(in) :: Out ! Drawing file

    integer, parameter :: H = 1224 ! Page height in points

    ! Column ranges where dots might occur
    integer, parameter :: Cols(2,6) = reshape ( [ &
      & 16, 21, 31, 38, 48, 55, 65, 72, 82, 89, 99, 105 ], [ 2, 6 ] )

    ! To count intersections at a dot, sum them to make W:
    integer, parameter :: R=1, U=2, L=4, D=8

    integer :: I, J, K, N
    character(size(gen,1)) :: More
    integer :: V    ! Vertical coordinate of a line
    integer :: W    ! What to superimpose, sum of R, U, L, D
    character, parameter :: &
      & NewDot = 'o' ! HTML: &#x25CB;   PostScript: o or circle

    character, parameter :: Over(0:15) = [ & ! Indexed by W
    & ' ',    & ! 0  No intersections 
    & ' ',    & ! 1  Right            
    & ' ',    & ! 2  Up               
    & ' ',    & ! 3  Right and up     
    & ' ',    & ! 4  Left             
    & horz,   & ! 5  Right and left
    & ' ',    & ! 6  Up and left
    & above,  & ! 7  Right, up, and left
    & ' ',    & ! 8  Down
    & ' ',    & ! 9  Right and down
    & vert,   & ! 10 Up and down
    & right,  & ! 11 Right, up, and down
    & ' ',    & ! 12 Left and down
    & below,  & ! 13 Right, left, and down
    & left,   & ! 14 Up, left, and down
    & cross  ]  ! 15 Right, up, left, and down

  1 format ( *(a,i0) )
    write ( out, 1 ) '%%Page: (', page_num, ') ', page_num
    write ( out, 1 ) '_S'
    write ( out, 1 ) '18 36 translate'
    write ( out, 1 ) '/pagenum ', page_num, ' def'
    v = h - 72/4 ! Skip 1/4 inch at top of page
    do j = 1, size(gen,2)
      do n = size(gen,1), 1, -1
        if ( gen(n,j) /= '' ) exit
      end do
      if ( j >= 3 .and. j <= 164 ) then
        do k = 1, 6
          do i = cols(1,k),cols(2,k)
            if ( gen(i,j) == dot ) gen(i,j) = newDot
          end do
        end do
      end if
      if ( n /= 0 ) then
        write ( out, 1 ) '5 ', v, ' M'
      2 format ( *(a) )
        write ( out, 2 ) '(', gen(1:n,j), ') s'
        more = ''
        if ( j >= 3 .and. j <= 164 ) then
          do k = 1, 6
            do i = cols(1,k),cols(2,k)
              call overlay
            end do
          end do
        end if
      end if
      v = v - 6
    end do

    write ( out, 1 ) '_R'
    write ( out, 1 ) 'S'

  contains
    subroutine Overlay
      if ( gen(i,j) == newDot ) then
        w = 0
        if ( scan(gen(i+1,j), ' ' // vert // right // ul // ll) == 0 ) w = w + r
        if ( scan(gen(i,j-1), ' ' // horz // above // lr // ll) == 0 ) w = w + u
        if ( scan(gen(i-1,j), ' ' // vert // left  // ur // lr) == 0 ) w = w + l
        if ( scan(gen(i,j+1), ' ' // horz // above // ur // ul) == 0 ) w = w + d
        more(i:i) = over(w)
      else if ( gen(i,j) == loz ) then
        more(i:i) = vert
      end if
      if ( more /= '' ) then
      1 format ( *(a,i0) )
        write ( out, 1 ) '5 ', v, ' M'
        write ( out, '(3a)' ) '(', trim(more), ') s'
      end if
    end subroutine Overlay
  end subroutine Write_Postscript

!--------------------------- end bloc --------------------------------------
  logical function not_used_here()
  character (len=*), parameter :: IdParm = &
       "$Id: parser.f90,v 1.4 2022/02/10 18:57:13 vsnyder Exp $"
  character (len=len(idParm)) :: Id = idParm
    not_used_here = (id(1:1) == ModuleName(1:1))
    print *, Id ! .mod files sometimes change if PRINT is added
  end function not_used_here
!---------------------------------------------------------------------------

! $Log: parser.f90,v $

end module Generate_Text_m
