implicitnone int eger*4ios, buff p ar ameter (i os =10 0 00, $bu ff=1000) r eal*4 x(b u ff) , n_j oin(buff) r eal*4n ote _o ff_ ju st,i fail,page_le ngth,g a p,ind_b ar rea l *4draw_line s,i_tablt re a l*4note,y_ union _stop real*4 i_buffer,c,un ion,y _dum real*4del r eal* 4i_str ing,iv ar ,f ac _ 10, outpu t_file real*4 bottom_marg i n,i c har_1,buf fer,x _unio n_ sto p r eal*4 end _tablt,i1 real*4p ag e re al*4fo u n d,date,ratio, title _o ff i nt eger*4ich ar_2( buff) int eger *4start_union integer*4i n d_ note ,y_tail_ off i ntege r* 4versio n ,n_tail i nteger*4l en,fac_2 integer*4i_fre t_2 ,v ar ,fac_ 11 inte ger* 4y _bar,x _note inte ger*4 n_tai l_ p rev,single inte ger* 4 le ft_m argi n int eger* 4page_widt h,sta ve _off int eger*4st op_leng th,f a c_12 i n t eg er*4fa c _ 1,n ote_off inte ge r *4 draw_colon i nteger *4r rea dfil 2,itot ,err or_handle r,draw_ t _s,f ilter in te ge r* 4bet ween_ba rs,iend ,level,bar_time integer*4i_ slash,x_off,y_lin e in te ger*4 f ac_ 9 lo g ic a l a read fil 2,join,i nd_un io n,i _title lo gical f a c_8,i_point_2,n_fret,y_note,stop_union,i_string_rest, $i _len logic aly_unio n_s t a rt,dr aw _note, input_file logicaldx logica lerror_poi nt chara ct er *(i os)fa c_3 c har act er*120draw_char ,t _ s _num char acter *120 y charac t er *5 n char ch ar act e r * 8quotes d atai1/0.8/ da tan_ fret/.true./ datafound/0.3 / datada te /-2 .3/ da tarati o/ 1./ datatitle _off/1.3/ da ta n char/'1.0 '/ dataq uot es/'21/03/97'/ write(6, 14 )nchar, quot es 14 f ormat(/' ShowTab Version ',a 5,' Creation date: ',a 8/ ) o pen (un it=9,fi le= '.filter',status='old', $iost at=versi o n) dx=( versi on.eq.0) if(.no t .d x)write(6, 19) 19 for mat( ' Input name of parameter file:'/) read(5,1 ,iostat= v ersion)dra w _ ch a r 1 format(a1 20) calli_fre t_1(v e rsi o n,001 ) open(unit= 7,fi le= dr aw_char,status='old' , $i o sta t =v e rsion ) calli_f ret_ 1( version,0 0 2) ca llfirst (7 ,'OUTPUT_FILE',11,t_s_ num, n_t a il) c alli_ fret _1(n _tai l,003) open(un it=8,file=t_s _num,status='unknown' , $i ostat=version ) ca lli _fr et_1(v ersion,0 04) c allind_l en gth( 7, 'N_STRING' , 8,start _union,n_ tail) calli_fre t_ 1( n _ tai l ,005) callf ac_ 6(7 ,'LINE_OFF',8,n ote_off_ just, n_tail) c a l li_f ret_1 (n _tail,0 06) ca llfac_ 6(7,'STAVE_OFF',9 , ifail,n_tail) cal li_fret_1 (n_tai l,007) c allfac_6 (7,'NOTE_OFF' ,8, page_le ngth,n_ tail) c al l i_fret_ 1(n_ tail,008 ) call fa c _ 6 (7,'BAR_OFF',7,gap,n_ta il) calli_fret _1(n_ ta il,009) callfac_6(7, 'TITLE_OFF' ,9 ,ind _bar, n_tail) calli_f ret_1(n_tail, 010) callfac_6(7,'PAGE_WIDTH',10 ,n ote ,n_tail) calli_fre t_1 (n_ta il,011) cal lfac _6(7,'PAGE_LENGTH',11, y_un i on_s to p,n_ ta il) calli_ fret _1(n _tail,012) callfac_6(7, 'LEFT_MARGIN',11,i_buf fer ,n_ tail) c alli_fre t _1( n_tail,013) callfac_ 6( 7,'RIGHT_MARGIN', 12,c,n_t a il) call i_fret_ 1( n _ta il,01 4) ca llf ac_6(7,'TOP_MARGIN' ,10 ,u nion,n_tai l) calli_fret_1 ( n _tail,01 5) callfac_6 ( 7 ,'BOTTOM_MARGIN',13 ,y _ d um,n _t ail) cal li_f ret_1( n _tail,016) writ e ( 8,3)nchar,quot es 3 fo rmat('%!PS-Adobe-3.0'// $'%',a 5/ / $'%' ,a8// $'%'// $'%'// $'%'// $'/text_centre'/ $'{dup stringwidth pop -0.5 mul 0 rmoveto show}' $' def'// $'%'// $'/text_left'/ $'{show} def'// $'%'// $'/text_left_sub' / $'{/Helvetica fontsize 0.6 mul Font'/ $'0 fontsize -0.3 mul rmoveto show'/ $'0 fontsize 0.3 mul rmoveto '/ $'/Helvetica fontsize 0.6 div Font} def' // $'%'// $'/text_left_super'/ $'{/Helvetica fontsize 0.6 mul Font'/ $'0 fontsize 0.7 mul rmoveto show'/ $'0 fontsize -0.7 mul rmoveto '/ $'/Helvetica fontsize 0.6 div Font} def'// $'%'// $'/Font {'/ $'/fontsize exch def findfont fontsize scalefont setfont'/ $'} def'// $'%'// $'/TexTablogo'/ $'{ gsave' / $'3 1 roll translate' / $'5.75 div'/ $'dup scale'/ $'0.75 0.75 translate'/ $'0.05 setlinewidth'/ $'-0.5 -0.75 moveto' / $'5.0 -0.75 5.0 3.25 0.25 arcto' / $'4 {pop} repeat'/ $'5.0 3.25 -0.75 3.25 0.25 arcto'/ $'4 {pop} repeat'/ $'-0.75 3.25 -0.75 -0.75 0.25 arcto'/ $'4 {pop} repeat'/ $'-0.75 -0.75 5.0 -0.75 0.25 arcto'/ $'stroke'/ $'0.02 setlinewidth'/ $'2.0 2.5 moveto 4.25 2.5 lineto'/ $'0.0 2.0 moveto 1.5 2.0 lineto'/ $'3.5 2.0 moveto 4.25 2.0 lineto'/ $'0.0 1.5 moveto 4.25 1.5 lineto stroke'/ $'0.10 setlinewidth'/ $'0.0 2.5 moveto 2.0 2.5 lineto'/ $'1.5 2.0 moveto 3.5 2.0 lineto'/ $'1.0 2.5 moveto 1.0 0.5 lineto'/ $'2.5 2.0 moveto 2.5 0.0 lineto stroke' / $'0.07 setlinewidth'/ $'newpath 1.25 2.25 0.25 0 360 arc stroke' / $'newpath 2.75 1.75 0.25 0 360 arc stroke'/ $'/Helvetica 1.0 Font'/ $'1.12 0.5 moveto (E) show'/ $'1.75 0.5 moveto (X) show'/ $'2.65 0.0 moveto (A) show'/ $'3.25 0.0 moveto (B) show'/ $'grestore } def'// $'%'// $'72 2.54 div dup scale'// $'%'// $'0.02 setlinewidth'// $'%', $'----------------------------------------') write( 8,16 )n o te +da te,ratio, titl e_off 16 form at(/'%'// $3f 7. 3 ,' TexTablogo' /) i_stri ng=i_buffer ivar =y _union _stop -union cal lind_ leng t h(7 ,'N_TITLE',7 , in d_ n ot e,n _ tail ) call i_fret_ 1 (n_t ail,017) if(ind_n o te.ne.0)i var=ivar + ind_b ar doy_tail_off=1, ind_note read(7,1,iostat =versio n )y c alli_f re t_1(ve rsion ,0 18) i_fr e t_2=inde x(y,'"' ) var=index (y(i_fre t_2+1:120),'"')+i_ fret _2 re ad( y(var + 1:120 ) ,*,iostat=v er si o n)del calli_fret_1 (version,019) ivar=ivar-in d_bar if(y_ tail_o f f.eq .1)ivar=iv ar - de l write (8,4) y_tail_o f f,del 4 forma t(/'%' ,i2, $' :'//'/Helvetica ',f5.2,' Font') write (8 ,5)i_st r ing,ivar,y( i_fret_ 2 +1 : v a r- 1 ) 5 for mat(2f7 .3 ,' moveto (',a, ') text_left'/) end do ca llfirst(7,'TIME_SIGNATURE',14,y, n_ta i l) calli_fr et_1(n_tail ,020 ) i_fret_2=ind ex( y , '/') y(i_fret_2 :i_fret_2) =' ' read(y, *,iosta t= ver sion)y_bar,x_not e calli_fret_ 1(v er si on,0 21) ivar=ivar- i nd _ bar*2.-no te_off_ju st*f loat(start_unio n-1) call f irst(7 , 'TABLATURE', 9 ,y ,n_tail) calli_fret_ 1(n_ tail,022) version=0 n_ tail_ pr e v=0 a r e a dfil2=.false. ind_ union =.false . do while(ve rsion.eq.0) re ad(7,2,io s ta t=ve r sion)y 2 f or mat(a120) if(version .gt.0)ca ll i_fret_1 (ve rs ion,023 ) if ( ve rs ion. e q. 0)th en jo i n=are adfil 2 left_ m a r g in=0 dowhil e((j oin.or. $in d_union.or. $y( left_ mar gin+1:lef t_marg in+1).n e.'!'). and. $left_m a rg in.lt .120) if(y(left_margin+1: l eft _ma r g in+ 1).eq.'"') join=.n ot .j oin if (y(l eft_margi n+1:le ft_ margi n+1).eq.'_' .o r . $y(l e ft_mar g i n +1:left _ma rg i n+ 1). e q . '^')then i nd _u nion=.true. else in d_uni o n=.fal s e . en dif left_marg in=lef t_m argin+1 e ndd o len=fac_2(y(1:l eft_m argin)) dosing le=1,l e n if( y( sin g le:si n gle) . eq. '"') the n area dfil 2=.not.ar e a dfil2 endif if((y( si ngle :singl e). n e.' '.or . $(y(single : s i ngle ) . eq.' ' .a nd.areadfil2)). and. $( fac_ 3(n _ta il _ pr ev:n _tail_p re v).n e.'|'.or. $y(sin gle:si ngle) .ne.'|')) t h en n_ t ail_ p r e v=n _ta il_pr ev+ 1 if(n_t ail_prev. g t .ios) $cal li _fr e t _1( 1,02 4 ) fac _ 3(n_tai l_prev:n_tai l_p rev) =y( sin gl e:si ngl e) e ndif en ddo endif e ndd o fac_ 11 =n_ tail _pre v if(fac_3(1: 5).e q.'blank')th e n dowhile (ivar . g t.y_d um) c allanot( i_s tri ng ,i var , note_o ff_j ust,start_union,n_tail) ca lli_fret_ 1( n_ tail,02 5) call f ac_7(i_ s tr ing,ivar, $note- i_buffer-c, $note_off_jus t,st art_union , n_tail) calli_ fret _1 (n_t ail,0 26) c al l ano t(note -c, iv ar,not e_off_jus t,s t ar t_union, $n_tail) calli _fret_1(n_t ail, 02 7) ivar=iv ar-ifail end do write (8 ,18) s top endif pag e_wid th= 1 sta ve_off=1 x(1)=0 . dow hil e(s tav e _off.l e . fac_11) if(fac _3 ( stave _off:s ta ve _off). eq.'|'.or. $fac_3(st a v e_off:stav e_ of f).eq.'$')then if(page_width .n e . 1 )the n i f( fac_3( sta ve_of f-1 :stave _off -1 ).ne.'|'.and. $fac_3(st ave_o f f -1:s tav e_o ff- 1).n e.'$') $x( page_widt h) $= x(pa ge_width)+ page_ len gt h end if if (fac_3(sta v e_off :stave _o ff ).e q.'|') then n _ j oin(page _w idth) =x(pa ge_width ) els e n_ join ( pa ge_width )=x(pa ge_ wi d t h)+g ap end if ichar_2(page_ width)=st ave_of f p age_width=page_ widt h+ 1 x (p age_width)=n_join( p a ge _wi dth-1) els eif( fac_3(stav e_of f:stave_o ff ).eq.'&')the n x(pag e_widt h)= x (page_wid th)+page_le n gt h el se if (fa c_ 3 (stav e _of f:stave _of f).eq .':') then x (page_widt h)=x (page_width)+gap *2 elseif(fac_ 3(sta ve_ o ff:st a ve_off ). eq.'#')then x(pag e_wi dth)=x (pag e _wid th) +page_l en g th endif stav e _of f=st ave_off+1 e nddo page_width =page_ w idt h-1 stop_length=1 fac_1 2=2 st a ve_ off=ic har_ 2(fac _1 2) i_ title=.fal se. fac_9=1 d o w hile (fac_1 2 .l e . page_ w idth.a nd..not. i_tit le) dowhile(( n_join(fac_12)-x(sto p _length)) $. le.(no te-i_buff e r-c) $. and . $.not. ((fa c_3 (stav e_off-1 :s t ave_o ff- 1 ) .eq.'|'.and. $fac_3( stave_off:s t ave _of f) .e q .'$' ). or. $(f a c_3(sta ve_ off- 1:stave_of f -1).eq .'$' .a nd. $fac_3(stave _off:s tave_ off).e q.'|'). or. $(fa c_ 3(stave _off -1 :s tave_off-1).eq.'$'. and . $fa c _3(stave_ off : sta ve_ o ff) .eq.'$')).and. $fac_12.le.page_width) fa c_12 = fa c _12+1 if (f ac_12.gt.b uff )calli _fret_ 1( 1, 0 28) i f (fac _12. le .p age _wi dth ) the n stave_off =ichar_2(fac_ 12) else i_ti tle = .tru e. en di f en ddo fac_12=f a c_12 -1 end_t ablt= (n_join (fac_12)- x(st o p_len gt h)) $/(note-i_bu ffe r-c) i f(end_ta blt.lt.i1)end _tablt = 1. draw_l ines=page_len gt h/ end _t a blt i_ta b lt=g ap/en d_tabl t w rite( 6,7)fac_3(ichar_2 (s top_length ):ichar_2(fa c _12) ) 7 f orm at( /' Processing output line: ',a/ ) wr i te( 8,8 )f a c_3 (ichar _2(stop_ length) :ich ar _2(f ac_12)) 8 format( /'%',a) c a ll fa c_ 7(i_ s t ring,ivar, $(n_join(fa c_1 2) $- x (stop_length) )/end_t a blt, $note_ of f_jus t,s ta r t_union,n _t a il) cal li_ fret_ 1(n_tai l,029 ) y_union_s ta rt=.false. d ra w_n ote=.fal se. input_file=.fa lse . i_po i nt _2=.true. fac_8 =.false. y_note =.fal se. stop_u nio n=.f al se. dr aw_ colon=0 pa ge =0. i_string _r est= .f a ls e. i_ le n =.true. stav e _ off =ic har_2 (st op_length) do wh ile (stave _o ff. le.ic har_2(f ac_12) ) if(f a c_3( stave_off:stave_off).eq.'|' )th en if( stop_union)then i_st r ing=i_str i ng+dr aw_lin es/2. s top_un ion= .fa lse. endif call anot( i _ s tr ing,iva r ,not e _off_just,start_union,n_tail) calli _ fr et _1 (n_tail ,03 0 ) draw_col on=0 i_len =.true. elsei f(fac_3(stave _of f : stave_off ).eq . '$')then if(sto p_union) the n i_ s tring= i_s t ring+ draw _l in es/2. stop_un ion=. false. end if ca llanot(i_s tr ing,ivar,n ote_off_jus t ,sta rt_unio n, n_t ail) ca lli_fret_1( n_t ail,031) i_st r i ng=i _ string+ i_ tablt callanot(i_string, ivar,not e_ off_just,st art_union,n _ta i l) c alli_f r et_1(n_tail,032 ) dr aw_c olon=0 i_len=.tr ue. elseif(fac_ 3(stav e_off:stav e _ off).eq.'&')then if (st o p_u nion)t hen i_string=i_str ing+dr a w_lines/ 2 . stop_union=.false. endif draw_colon=0 elseif( fac_ 3( sta ve_of f :stave_off ) .eq.':')then if(stop_u n ion)t hen i_string=i_s tring +dr aw_l i n es/2. stop_union=.false. endif i_str ing =i_strin g+i_ tablt calli _ point_1 (i _ strin g ,ivar,note_of f_ju st ,start_u nio n, $n _tail) calli _fret_1(n_ta i l, 033) i _stri ng=i_stri ng+i_tablt dra w_ c olon=0 i_len=.tr ue. els eif(fac _ 3(st ave_ o ff:stave_off ).e q.'#')th en if(stop _un ion) then i _s t ring=i_ st ring+draw _lines/2. sto p _un io n =. false . endif i_ string= i _ string+draw_line s/2. callmax_bar(i_ s t r i ng,iva r,no te_ off_just,start_union,y_bar, $x_note, $n_t ail ) calli_fret _1( n_tail,034) i_ string =i _string+d ra w_line s/2 . dra w_colon=0 i_l e n=.true. elseif(f ac_3(s tave_ of f:s tave_ off). eq.'(')then f ac_ 1 =stave_ off+1 dowh ile (fac_3(f ac_ 1 :fac _1).ne.'&'.and . $f ac _3(fa c_ 1:fac_1 ).n e.'|'.an d. $f ac_3( fac_1 :fac_1).ne.'$'. and. $fac_3 (f ac_1:fac _1 ).ne.':'.and. $fa c_1.lt.ichar _ 2 (fac_1 2)) fac_1 =fac_1+1 endd o no te _off =s tave_off+1 dowh ile(fa c_3(n ote _off:note_off). n e . ')'.a nd. $not e_off.le .f a c_1 1) not e_o f f=note_ o ff+1 enddo if( not e_off.gt. f a c_11) $c all i_fre t _ 1( 1 ,035 ) if(fac_1.lt.note_off)the n draw_note= . true . els e i_poi nt_2=. f al se. y_note=.true. en di f elsei f (fac_3(stave_o ff :stav e _off).eq .')')th en inpu t_fi l e= .true. dr aw _col on =0 elseif (f ac_ 3(stave _ off :st ave_off ).eq.'[') t hen fac_8=.true. filter=0 level=0 bar_tim e=0 elseif(f ac_3(s tav e _off :stave_off).eq.']' )th en fac_8 =.f alse . dra w_ colon=0 call fac_4( i_s t ring,iv ar,no te _ off_just, $le vel,bar_tim e, $n_tai l) c alli_fret_1( n_ tail , 036) el s eif (d ra w_colon .eq.0.and . $ichar(fa c_3( stav e_off:sta ve_ off)). ge . 48.and . $ic har( fac_3( stave_o f f:s tave_ of f )). le.57)the n y_n ote= .tr u e. els eif( fac _3(stave _off: s t a ve_off).eq.'_')then if (dra w_ colon .gt .0)dr aw_colon =0 dr a w_colo n=d raw_c olon-1 elseif( fac_ 3(st ave_off:s ta ve_ off).e q.'^' )then if (draw_col o n.lt.0 ) d raw _colon=0 d raw_c olon=draw_c ol on +1 endif if(y _note)then i f(.n ot.i _p oin t_2)sta ve_of f=sta ve_off+1 y_ l ine =index(fac_3(stave _ o ff:ichar_ 2(fac_12)),'/') r ead(fac_3(sta ve_off+ y_line: st ave_off+y _line+ 1),9,i ostat= $vers io n)draw_t_s 9 forma t( i2 ) ca l li_f ret_1(ve rsi on, 037 ) i_slash=stave_off x_off=stave _ off+2 i_s trin g=i _st rin g+dr aw _lin es/2. stop_ un ion=.true. error_point =. t r u e. dow hile (fac_3(i_ slas h:i _sla sh).ne.'/') i f(i_poi nt _ 2)then dow hi le(f ac_ 3(i_slash:i_ sl a sh ) . ne.'('.and. $fac_ 3(i_slash:i_s lash).ne. '/') read( f a c_3(i_slash: x_off ),10 , io stat =ve r s ion)r readfil2 $, itot 10 format(i1 ,i2 ) calli_ fr et_1(ve rsion,03 8) call lencha r(i_str ing, ivar,note_o f f_just,d raw_lines, $rre adfil2,st art _uni on, itot, $err o r _ha ndler, $draw_t _s,fi lter, $f ac_1 0 ,o utput_fi le, $bet ween_ba rs,ien d,l eve l, bar_time, $fac _ 8 ,i_point_2 ,n_fret,error_p oint, $n _tail) c al li_f re t_1( n_ tail,0 39) i_ sl as h= i_slas h+3 x_off= x _off+3 i f(dr aw_ no te)then bottom _ margin= f ac_10 + draw_lines *fo und ichar_1=outpu t_file y_un ion_st a rt=.tru e. draw_note=.fa lse. endif if (f ac_3(i_s l a sh:i_sla sh). eq.'(')then draw_n o te=. tru e. i_ slash= i _slash+1 x _off= x_off+1 elsei f(fa c_ 3(i_slas h : i_slas h).eq. ')')t hen bu ff er =f a c _10-dr aw_ lines *f ound x_union_stop =output_file if (ic har_1.n e.x_union_ stop)the n w ri t e(6, 12) ichar_1 = x_uni on_sto p en dif write(8,13) bottom_margin,i c har_1 , $b uffer, x_u ni o n _s top y_union_start=.false. i _s lash= i_s lash+1 x_off=x _ off+1 endif e ndd o e ls e re a d(f ac_ 3 (i_sl ash: x _off),10, iosta t=vers ion) rreadfil2, $itot ca lli_fret _1( versio n, 04 0) i_s las h=i_ sla sh+3 x_off = x _off+3 r ead( fac_3( i _slash:x _off),10,i ostat=vers ion )rrea dfil2, $error_handl e r c al li_ fret_1(ve rsion,041) call lenc har( i _s tri n g,iva r, no te _ off_just,draw_lines, $rrea d fil2,start_union,itot,error_han dler, $draw_t_s,filter, $fac_10,output_fi le , $be t ween_bars,ie nd,le vel,bar_t im e, $fac _8,i_point_2, n_fr et,e rror_point , $n_tail) c all i_f ret_1( n_t ai l,042) if(fa c_3 (x_o ff +1:x_ off+1). ne. ')') $cal li_fr e t_1(1, 043) i_point _2 =.tr ue . i_slash= i_s lash +4 x_o ff=x_ o f f+4 en dif end do filter=draw_t_s level=betwee n_ bars bar_time=ie nd y_note=.false. page =page+1./float(dr aw _t _s) i_ string _rest=.tru e. i_len = .false. s tave _of f= stave_off+y_line + 2 elseif(input_fi le)then buffer=f ac_10- draw_line s*f ou nd x _union_sto p= output_file if( ichar_ 1 .ne.x_u nion _s top ) then write(6,12) 12 f or mat(' Different strings at each end of union', $' - continuing using final string' ) i char_1 =x_u nion_stop en d i f write(8, 1 3)bot tom_marg in ,ich ar_1, $buffer,x_uni on_stop 13 format(2f7.3 ,' moveto ',2f 7.3,' lineto stroke') y_uni on_ s tart=.fals e . inp ut_fil e=.false. stave_of f=st av e_ off+1 else if(draw_col on.ne.0) then if (f ac_3(st av e_ off+1:stave _off+1).eq. '_'. o r. $fac_ 3 (stave_off+ 1: stave _o ff + 1 ).eq.'^' )t hen st ave_off=st ave_off+1 elseif(fac_3(s t av e _off +1:stave_ o ff +1).n e. '"')t he n c a l ll ine_o ff(i_ st ri ng,i va r,n o te_of f_just,start_union, $fa c_ 3(stave_off+1 :stave_off+1),1 , draw_ colon $, $n_t ail) cal li_ fre t _1( n_ta il,044 ) stave_off= stave _off+2 else i _slash =stav e_off+2 x_ off=i_ slash dow hil e(f a c_3 (x_off:x _ o ff).ne . '"') x_off= x_of f+1 if(x_ off.gt.ichar_2(fac_12)) $ca lli_ fr et_1(1 ,045) en dd o x_off =x_ o f f- 1 cal llin e_off(i_strin g,iva r ,note_off_j u st,star t_un ion, $f ac_3(i_s l ash:x_ of f ),x _off-i_slash+1 , $draw_col on, $n_ta il) cal l i_f r e t_1(n_ tail,046) stave_o ff=x_of f+2 endif else sta ve _off=stave_ off+ 1 endif i f (i_le n . and.i_string_ r est)then wr ite(6,11)pa ge*floa t(x _no te)*100/float(y_ bar) 11 f ormat(' Percentage of bar filled: ' ,f5 .1 ) page=0 . i_str in g_ r e s t=.false . endif enddo if( y_unio n_start)then write(8,1 3)bo ttom _ margin,ichar_1, $i_stri ng,ichar_1 bo tto m _ ma r gin =i_buffer ichar _1= ichar_1-ifa i l endif if (fac_12.lt.pa ge _wid t h)then stav e_of f= icha r_2 (fac_12) if (fac_3(stave_off:sta ve_o f f).e q.'$' .or. $fac_3 (stave_off+1 :stave_of f + 1).eq.'$')t he n st op_length =fac_1 2+1 else sto p_l eng th=fac_1 2 en dif fac_12= s to p_ l e ngth+1 e ndif i_ st ring=i_buf f er ivar=ivar-ifail if (st ave_o ff.l e .ic har _2(fac_1 2) . and. $ivar.lt .y_dum )then write(8 ,17)(no te+i_buffer-c)/ 2., $y_dum/2 . , $fac_9 17 fo rmat (/'%'//2f 7. 3, $' moveto (', i2 , ') text_centre') wr ite(8,6 ) 6 fo rmat(/'copypage erasepage') f ac _9=fa c_9+ 1 ivar=y_ u nion_stop-union $-ind_bar *2.- n ot e_o ff_ju st*fl oat(s t a rt_union - 1) write (8 ,16)no te+d ate,r at i o,title_ off endi f enddo write( 6, 15) 15 format(/' ShowTab terminated successfully'/) if (f ac_9. ne.1) then write (8,17)( note+i_buf f e r-c)/2., $y_ dum / 2., $fac _9 e n dif write(8,18 ) 18 fo r mat(/'showpage') stop end s u b rou tinefac_7 (i_st ring, ivar,n_join_prev ,note_o f f_just, $st art _ u nion, $n_tail ) implic itnon e r e al*4i_str i ng,iv ar,n_j oin _prev, note_of f_just integer*4st art _ uni on ,n_t ail real*4i,tabl t integ er*4i n d i =i_s t ring+ n_joi n _p rev w rite (8,1) 1 fo rmat ( /'%' / ) doind= 0,start_un ion-1 tabl t=ivar+fl oat( in d) * n o te_off_just wri te(8,2 )i_st ring,ta blt,i,tablt 2 fo rmat (2f7 .3,' moveto ',2f7.3, ' lineto stroke') endd o n_ t ail=0 return end subr outine anot(i_ stri ng,i var,note _o ff_ju s t,s tart_un ion, $n _ ta i l) i mplic it none r ea l*4i_s tring,ivar, no te_ off_jus t integ er*4start_u nion,n_ta il real* 4fac_5 real*4fo und,da te datafoun d/0.02/ datad ate/0 .0 4/ write(8,1) 1 fo r mat( /'%'/) wri te( 8,2)date 2 forma t (f 5 .2,' setlinewidth' ) fa c_5=ivar+ float(s t art_un ion- 1)* note _ of f_just wr ite( 8,3)i_string, ivar- foun d/2. ,i_s tring,fac_5+foun d/2 . 3 form at(2 f7 . 3,' moveto ' ,2 f7.3, ' lineto stroke') wri te(8 ,2) fo und n_t ail= 0 return e nd s ubr outinei_ po i nt_ 1(i_string,ivar,note_off_just,start_union, $n _ tail) implicitnone real*4i _ st ri ng,iv ar, note_o f f_ jus t inte ge r *4 start_unio n,n_tail real*4fo und d a taf ou nd/0.1/ wr ite (8 ,1) 1 f o rmat (/'%'/ ) write(8 ,2)i_ stri ng, ivar+note_of f_just*1.5,note_off_just*found wr i te ( 8 ,2)i_string,ivar+note_off_just*2.5,note_off_just*found 2 format('newpath ',3f7.3, ' 0 360 arc fill') n_t ail=0 return end subr outi nemax_bar(i_string,ivar,note_off_just,start_union,y_bar, $x_n ote , $n_tail) i mplici tnon e real*4 i_string, ivar , n ote_off_j ust in tege r*4s tar t_ uni o n,y _bar,x_ note,n_t a il re a l*4foun d ,date dataf ound/2.2/ d ata date/0.2 / wri t e(8,1) 1 form a t(/'%'/ ) wri te(8,2 ) not e_ off_just*foun d 2 fo rmat('/Helvetica ',f5.2 ,' Font') write( 8,3)i_st r ing, ivar+not e_off _just*(2 .+da te), y _ba r write(8,3)i_ st ring,ivar+note_off_ju st*date,x_no te 3 format(2f7. 3, ' moveto (',i1 ,') text_centre') n _tai l=0 re tur n e nd su br outinel enchar(i _stri n g,iv a r,note_off_just,page_length, $rrea dfil 2 ,s tart_union,ito t,er ro r_handl er, $draw_t_s , fi l ter, $fac_10 ,output_f ile, $b etween_bars ,ien d,leve l, b ar _time, $f ac_8,i_point _2,n_ fret,error_point, $n_tail) i mplicitnone real*4i_str i ng,i var,no te_o ff_jus t ,p a ge_length real *4fac_10 ,output_ file in teger*4rreadfil2,start_union,itot,error_handler,draw_t_s,filter i nteger*4between_ bars, i end,lev el, bar_time inte ge r* 4n _ tail logi calf ac _8 ,i_poi n t_2,n_ fret,error_p oint real* 4ireadfil2,t_ s _d en,b ar_off,av a r re al*4f ound,date, ratio,t itle_o ff, bar_off_ just,right_margin, $n_s tring,end_join r ea l*4 note_centre,t op_ margi n,t i tle_size,nin integer *4script(2) i nt e ge r*4 x_un i on_s ta rt,in d integer *4start_ le n g t h datafo u nd/1 .1/ d at adat e/0.4/ d atarat i o/0.8/ datati tle _off/0. 4/ databar_ off_just/ 0 .4 / d ataright_margin/0.3/ datan _s tring/2. 0/ dataend_join/0 .5/ datanote_ cen t re/1.0/ dat a t op_ma rgin/ 6 0./ d atati tle_size/0. 02/ da tanin/0. 04 / datas tart_le n gth/3/ if(r readfi l2.l t .0.or. rreadfil2. g t. s tart_union.or. $ito t .lt.0.or. i tot.gt.99.o r. $e r r or_ hand ler.lt .0 .o r.error_han dler.gt .99. or. $.n ot.( draw_t_s.eq.1.or.dra w_t_ s.eq.2.or. $dra w_t_s.e q.4. or . draw _t_ s. e q.8.or. $draw_t_s.eq. 16.or.draw_ t_s.eq.32 ) .o r. $.no t.(filter.e q.0.or. $filte r.eq .1.or . filt e r.eq. 2. or. $f ilter.eq .4 .or. fi lter.eq. 8.o r. $f ilter.e q.1 6. or.filt e r.e q.32 )) th en n_ta il=1 return e nd if if(r readfil 2.eq. 0)then o u tput _ file=ivar +(5 .0- float(start_length))*note_off_ jus t else output_ fil e=ivar+(5.0-f l oat(rr eadfi l2)) *note_o ff_just end if if(n_fret )output_file =out pu t_file+0.5*n ote_of f _just if(i_ point_2.or.rrea d fil2 .eq . 0)then if( r readfil2 .eq.0)t hen writ e(8, 1 )r re adfil2, d raw_ t_s,filter 1 for m at(/'%', $3 i3, '):'/) el se writ e(8,2)rread fil2,itot,dr aw_t_s ,filte r 2 format( /'%' , $'(i_string,i_fret_1,i_len,i_len_prev) = (', $4i3, '):'/) en dif fac _10 = i _s tri ng x_union _ star t = 1 s cr ipt(1)=itot els e write(8,3)r read f il 2,it ot, er ror_hand ler,draw_t_s,filt e r 3 format (/'%', $'(i_string,i_fret_1,i_fret_2,i_len,i_len_prev) = (', $5 i3,'):'/ ) fac_1 0= i_string-note_of f_ j u st*ratio x_union_sta r t= 2 scri pt(1)=ito t script( 2)= error_h andle r endif doin d= 1 ,x_union_start if(rrea d f il2.eq.0) the n ireadfi l2 =not e _off_ju st* bar_o f f_ ju st write (8 , 4 )fac_10+i readf il 2,outpu t_f il e-ireadfil2,fac_10- $ireadfi l2 ,out put_file+ireadfi l2 w r ite(8 ,4 )fac_1 0-irea d fil2, o u tput_file-ireadfil2,fac_10+ $irea dfi l2,output_f ile+ir e adf il2 4 form a t ( 2f7.3, ' moveto ', 2f 7.3 , ' lineto stroke') elseif(script(ind) .e q. 0 )t h e n write( 8 ,5)fac_10,outp ut_file,note_ o ff_ju st /2. 5 format('newpath ',3f7.3 , ' 0 360 arc stroke') el se write( 8 , 6)no te_ off_j ust*found 6 fo rmat('/Helvetica ',f5. 2,' Font') if(s c r i pt(in d).le.9)t hen write( 8, 7)f ac_10 ,ou t put_file-note_o ff_just*date,script(ind) 7 fo rmat(2 f7. 3 ,' moveto (',i1,') text_centre') else w rite( 8,8)fa c_ 10,output_ file -note_ off_just*date,script(ind) 8 format(2f7 .3,' moveto (',i2,') text_centre' ) end if end if if(ind.eq.1 .an d..not .i_poin t_2)th en f a c_10=i _st r ing+no te_o ff _ju st*ratio write( 8,4)i _ string-note_ o ff_just *title_o ff,output_file, $i_string+n ote_off_jus t*title_ off,outp u t_ file endif e nddo if(i_point _2.an d. i tot . eq. 0)t hen t_s _den=0. else t_ s_de n=-note_off _ju st*right_margi n endi f i f( d raw_t_s.ne.1 )then bar _ o ff= i_ string-note_off _just/ 2. write(8,4)b a r_o ff,outpu t _file + t_s_den, $b a r_of f, ivar-no te _ off_ju st* n_ str ing if(err or_ point)then e rror_ point=.fals e. i f(fac _8) then if(d raw_t_s.eq.8)then bet ween_bar s= 1 e l seif(draw_t_s.eq.16)then bet ween_b ars=2 e lsei f(draw_ t_s .eq.32) then betw e en_bars=3 else b etween _bars=0 endif if(filter.e q. 0)t he n iend=0 else ien d= min 0(between_ bars,l eve l) if(iend.ne.0) th en write (8, 9) nin 9 format( f5.2, ' setlinewidth' ) doind=1 ,iend bar _off =i _st ring-n ote_ off_ju s t/2 . avar= ivar- note_off_jus t*n_str ing+fl o at(in d-1)* $note_off_j us t*end_j oin $+nin/ 2 . write(8,4 ) bar _off-page _leng t h,avar, $bar _ o ff,avar endd o w ri te( 8,9)title_s ize en dif if(leve l .gt.bar_ tim e .and. $leve l . g t.iend )the n if(bar_ time.lt.iend ) t hen ir ead fil2= n ote_ o ff_just *.75 e lse iread f il2= -n ote_o ff_jus t*. 75 en dif do ind =max0(ba r_t ime,ien d),level ba r_ o ff= i_strin g - page_ len gt h-no te_ of f _just/2. a va r=ivar-note _ of f_ju st*n_s t ring+f lo at(in d-1 )* $note_of f_ just*end_join $+ ni n/2. write(8 ,4) ba r _o ff,a var, $bar_off+irea dfil2, avar en ddo endif endif els e i f (dr aw _ t_s.eq.2)th en avar= ivar - n ote _o ff_just*n_ s tring w r it e(8,4)i_st r i ng-note _ off_j u st/2.,av ar, $i _s tr ing-n ote_off_just* 2.,ava r els e if( dra w_t_ s .eq. 8 ) then betwee n_ba rs=1 el seif(draw _t_s.eq.16 ) then between_ b ars= 2 elseif (draw_t_s.e q.32 )t hen between_ bars=3 else be t ween_bar s=0 en dif if(be t ween_b a rs.ne .0) th en ba r_off=not e_centre* (2 .*c os(top_margin *0.01745 3292)- 1 .) avar=2.* n ote_ce ntre*sin( top_marg in*0.01 7453292) doind=1,betwe en_ba r s write( 8 , 10) i_str ing +note_ off_j ust*( n ote_cent re-0.5), $iva r- note_o ff_just*n_stri ng $+float(ind -1)*n o te_off_j us t* end_j oin, $no te_ off_ just* no te_cen tr e, $180.-top_m argin ,180 . w rite(8,1 0)i_string- note _ of f _ju st *( bar_o ff+0.5), $iv a r+n ote_off_j ust*( ava r - n_s tri ng) $+float(ind-1 ) *note_off_just *end_joi n , $note_ off_ju s t*note_centre, $-top _m ar gin,top_m a rg in /2. enddo 10 format('newpath ',3f7.3,2f6.0,' arc stroke') end if end if endif endif endi f n _tai l=0 return end subr outinefac _4(i_st ri ng,i var, note_of f_just, $l evel,bar _time, $n_t ail) i mpli c itnon e r eal*4i_s trin g, i var,note_off_just integer*4level,bar_time integer*4n _ t a i l re al*4ire ad fil2, bar_off, a var re al*4n_st ri n g,end_j oin,ni n integ er*4ind da ta n_st ring/2.0/ datae n d_ joi n/0.5/ dat a nin/0 .04/ if(level .gt.bar_time )then i r eadfil 2=-no t e_of f_ju s t*.75 doi nd=bar_ time,le vel bar_of f=i_ s tring- not e_o ff _jus t / 2. avar=iva r-n ote_off_just *n_stri ng+fl o at(ind-1)*note_off_just* $e n d_join $+ni n/2. write(8,1)bar_off,a var, $bar_off+ ireadf il2,a v a r 1 format(2f7.3, ' moveto ' ,2 f 7.3,' lineto stroke') enddo endif n_ta il=0 ret urn end s ubr outineline_off(i_string,ivar,note_off_just,start_union,char, $fac_11,dr aw_ co lon, $n_tail) i m plicitnone re al*4i_str ing,ivar,note_off_just integer* 4s tar t_un i on,fac_1 1,d raw_co lon, n_ta il ch aract er*( *)char real*4 foun d,d ate,rat io,title_off,bar_off_j ust,i_le n_ p rev integer*4i_slash,x _off d ataf ound/1 .2/ da ta d ate/0.8/ dataratio/2.3/ datatitle_off/1.5/ databar_ off_j ust /1.5/ write(8,1) 1 format(/ '%'/) write(8, 2)no te_ off_just*f ound 2 form at ('/Helvetica ',f5.2 ,' Font') if(fac_ 11.eq.1)t hen i_ len_pre v =0. els e i _len_prev=-note _off_just *found* dat e /2. e ndif if(draw_col o n.lt.0)then write (8, 3 )i_string+i_len_prev,ivar+note_off_just*(-ratio+float( $d raw _co lo n )*bar_off_j us t) 3 fo rmat(2f7.3,' moveto') els eif (dr aw _colon.gt.0)then wri te( 8,3)i_s tri ng+i _ len_prev,i va r+no te_off_ju st*(float( $start _u nion-1 ) $+ title_off+float(d ra w _col on-1)* $bar_ off _j ust) endif if(fac _11.eq.1)the n write( 8,4 )char(1 : 1) 4 fo rm at( '(',a,') text_centre') else i_s lash=1 x_o f f=1 dowhil e(x_off.le.fac _11 ) dow hile(cha r (x _ off: x_off). ne.'_' .and .ch ar(x_off:x _off $).n e.'^' . and. $x_off.le.fac_ 11) x_ o ff=x_off+1 endd o if(x_o ff.ne.fac _11)x_off=x_of f-1 i f( i_s lash .le . x _o ff ) wri te(8 , 5 )char (i_s la sh:x_off) 5 format('(' ,a,') text_left') if(x_off.ne.f ac_11 ) th en x_o ff= x_off+2 if ( x_o ff.gt.fac_1 1 )t he n n_ta il= 1 retur n endif if(ch ar (x _off-1:x_of f-1 ).eq.'_')t hen write (8 , 6) char( x _o ff:x _o ff) 6 fo rmat('(',a, ') text_left_sub') e ls e write(8 ,7)ch ar(x_ off: x_off) 7 format('(',a,') text_left_super') endif endif i_sla sh = x_o ff+1 x_ of f = i_slash e nd do endif n _tail=0 r et urn end subr outin efirst(x_stop,i _f ret,fac_1 1,n_title ,n _tail) impli citno ne integer* 4x_s t op,fac_1 1,n_tai l char acter*( *)i_ fret cha ract er* 120n_title integ er*4versio n logica l ratio_limit chara cter*160ma x_ch ar rewi nd(x_ s top ) versi on= 0 rati o_l imit=.fa lse. do whil e(ve r sion . eq .0.and. .not .ra tio_limi t ) re ad (x_ stop,1, iostat = version)m a x_c har 1 f o rma t(a160) if(ma x_char(1 :fac_1 1 ) . eq.i_ fret.and. $ma x_char( fac _ 1 1+1:fac_11+1).e q. ' ' ) t hen n _t i t le(1:120 ) =max_char(fac _ 11+2 : f ac _11+121) rat io_l imit =.t rue. endif en ddo if (ver sio n .eq . 0) the n n_tail=0 else n_ t ail=1 endif end s u brout inei _fre t_1(n_tail, quotes_d um ) implicitnone int ege r *4 n_t ai l,quo t es_d um i f(n_tail.ne.0)t hen writ e(6,1)n_ta il, quo tes_d um 1 format(/' ifail returned as ',i5, ' at error point ' ,i5, $' ..... program terminated'/ ) st op e n dif return en d subrouti neind_l eng t h (x _stop ,i_f ret,fac_11,draw_bar,n_tail) im plicit no ne integ er*4x_s top,fac_11,draw_bar,n_tail ch aract er *(*)i_fr et in tege r*4version logic a lratio _limit ch aracter* 8 0max_char rewind( x_stop) version =0 ratio_ l imi t=.false. dow hile (v ersi on.eq.0 .and. .not.rati o_lim it) r ea d(x_s top , 1, iost at=ver sion)ma x_c har 1 f orm at (a 80) if(max _ cha r( 1:fac_11).eq.i_ f ret . and. $m ax_ch ar( f ac_1 1+1:fac_11+1). e q.' ')then re ad (m a x_c har( fa c_11 + 2: 80), *,iostat=ve rsio n )draw_bar rati o _limit= .tr u e . e n d if enddo if(version.eq.0)then n_t ai l= 0 else n_tail=1 endif e n d i nte g erf un ct io nfa c_2( i2) implici t no ne character *(* ) i2 i n teg er*4timin g,ind t iming =len(i2) doind=timing,1,- 1 if(i2(i nd:ind). ne.' ' ) go to1 endd o fa c_2=0 return 1 fac_ 2 = ind ret urn end subr ou t inefac_ 6(x_stop, i_fret,fac_ 11 ,x_d um, n_ tail) impli citnone real *4x_ d um i nteger*4x_stop, fac_11,n_ tai l charact er*(*)i _f re t integer*4 versi on log icalr ati o_lim it ch arac ter *8 0max_char rewind (x_stop) v ersion=0 ratio_limit=.false. dowhile(ve rsion.eq.0.and. . not.r at io_lim it) r ead (x_st op,1 ,ios ta t=ve r sion)ma x _ch ar 1 f or m at(a80 ) i f( ma x_char (1 :fac_1 1).eq.i_fret.and . $max_c har(f ac_1 1 +1:fac_11+1).eq.' ')then read ( ma x_c h ar(fac_ 1 1+2 :80), * ,iostat=v e rs io n)x_dum ratio_limit=.true. endi f endd o if(ve rsio n.eq.0)th en n _tail =0 el se n_t ai l=1 e ndif en d