cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cc  27 Jan 13  v 1.1a WJS                                 cc
cc      Must external SCALE since it is "now" a FORTRAN   cc
cc      intrinsic function                                cc
cc                     Version 1.1                        cc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


      program ctext

      character*80 s,s1
      integer angle
      real hgt
      include '../lib/penplot.com'


      external scale

cprocedure show
cbegin
cif transform1(xc,yc)then
cbegin
cpenup
cdevlin(xn-dx2,yn-dy2)
cdevlin(xn+dx2,yn-dy2)
cdevlin(xn+dx2,yn+dy2)
cdevlin(xn-dx2,yn+dy2)
cdevlin(xn-dx2,yn-dy2)
cend
cend

cprocedure lprschgt(hgt:integer)
cbegin
cwith regs do
c  begin
c  ax:.eq.$0a00
c  ds:.eq.dseg
c  si:.eq.ofs(s)+1
c  dx:.eq.angle
c  di:.eq.hgt
c  end
cintr(200,regs)
cdx2:.eq.regs.bx div 2dy2:.eq.regs.cx div 2
c{writeln('**',chrdely,' ',chrdelx)}
cend

      call scale
      if (iargc().lt.6)then
         ax=(xv1-xv0)/100.0
         bx=xv0
         ay=(yv1-yv0)/100.0
         by=yv0
         xc=50.0
         yc=50.0
         dx=0.5
         dy=0.5
      else
         xc=(x0+x1)/2.0
         yc=(y0+y1)/2.0
         dx=(x1-x0)/200.0
         dy=(y1-y0)/200.0
         endif
         call getarg(2,s)
c {writeln(s)}
         angle=0
         if (s.eq.'y') then 
            angle=90 
         else if (s.eq.'-y') then 
            angle=270 
         else if (s.eq.'-x') then 
            angle=180
            endif
         call getarg(1,s)
         call fixstr(s)
cd	write(*,*)s
         hgt=2
         if (iargc().ge.3)then
            call getarg(3,s1)
            read(s1,*)hgt
            endif
c lprschgt(hgt)

            if (iargc().lt.4) then
c  begin
c regs.ax=$0701intr(200,regs)
c
cshow
cc='a'
cwhile c<>^M do
c  begin
c  regs.ax=$8000intr(200,regs)c=chr(regs.bx)
c  if c<>^M then
c    begin
c    show
c    case c of
c      #147:xc=xc-dx/5.0
c      ^S:xc=xc-dx
c      ^A:xc=xc-5.0*dx
c      #132:xc=xc+dx/5.0
c      ^D:xc=xc+dx
c      ^F:xc=xc+5.0*dx
c      #152:yc=yc-dy/5.0
c      ^X:yc=yc-dy
c      ^C:yc=yc-5.0*dy
c      #133:yc=yc+dy/5.0
c      ^E:yc=yc+dy
c      ^R:yc=yc+5.0*dy
c      '+':begin
c          hgt=hgt+1
c          lprschgt(hgt)
c          end
c      '-':begin
c          hgt=hgt-1if hgt<0 then hgt=0
c          lprschgt(hgt)
c          end
c
c      end
c    show
c    end
c  end
cshow
cregs.ax=$0700intr(200,regs)
ctext(s,xc,yc,0,0,angle,hgt)
cendplt
ccase angle of
c 0:writeln('ct ',s,' x ',hgt,' ',xc:5:2,' ',yc:5:2)
c 90:writeln('ct ',s,' y ',hgt,' ',xc:5:2,' ',yc:5:2)
c 180:writeln('ct ',s,' -x ',hgt,' ',xc:5:2,' ',yc:5:2)
c 270:writeln('ct ',s,' -y ',hgt,' ',xc:5:2,' ',yc:5:2)
c end
cend
c
            else
               call getarg(4,s1)
               read(s1,*)xc
               call getarg(5,s1)
               read(s1,*)yc
               call text(s,xc,yc,0.0,0.0,angle,hgt,1)
           endif
            call endplt

            end

          subroutine fixstr(str)
      character*(*) str
c      write(*,*)'fixstr',str,in_lnblnk(str),len(str)
      str(in_lnblnk(str)+1:in_lnblnk(str)+1)=char(0)
      return
      end