home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB101 / dtcat.for < prev    next >
Text File  |  1995-05-19  |  1KB  |  43 lines
  1. $STORAGE: 2
  2. $NOFLOATCALLS
  3.     subroutine dtcat(ic,irXX)
  4.     integer iwid
  5.     common/scrn/iwid
  6.     character esc
  7.     CHARACTER*2 IRH,ICH
  8.     character*3 ichw
  9.     character ichwa(4)
  10.     equivalence(ichw,ichwa(1))
  11.     equivalence(ichwa(1),ich)
  12.     CHARACTER IRA(2),ICA(2)
  13.     EQUIVALENCE(IRA(1),IRH),(ICA(1),ICH)
  14.     IR=IRXX+1
  15.     esc = 27
  16.     iterm = 0
  17. C WRITE CURSOR POSITIONING ESCAPE SEQUENCES FOR ANSI TERMINAL SYSTEMS X3.64
  18. c    WRITE(ITERM,1)
  19. c1    FORMAT(1h+)
  20. C    write(iterm,1) esc,'<'
  21. C1    format(x,2a1,$)
  22. c adapt to different width displays
  23.     if(iwid.lt.80)iwid=80
  24.     if(ic.gt.iwid)ic=iwid
  25.     if(ir.gt.25)ir=25
  26.     WRITE(IRH,22)IR
  27.     if(iwid.lt.99)WRITE(ICH,22)IC
  28. 22    FORMAT(I2)
  29.     if(iwid.ge.99)write(ichw,122)ic
  30. 122    format(i3)
  31.     if(ichwa(2).eq.' ')ichwa(2)='0'
  32. c force fillin of leading zeroes
  33.     if(IRA(1).EQ.' ')IRA(1)='0'
  34.     IF(ICA(1).EQ.' ')ICA(1)='0'
  35.     if(iwid.lt.99)write(iterm,2) esc,'[',ira,';',ica,'H'
  36.     if(iwid.ge.99)write(iterm,12) esc,'[',ira,';',ichw,'H'
  37. 2    format(1x,1a1,1a1,2a1,a1,2a1,a1,\)
  38. 12    format(1x,1a1,1a1,2a1,a1,1a3,a1,\)
  39.     return
  40.     end
  41.  
  42.  
  43.