home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol149 / toxmod.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  2.5 KB  |  117 lines
  1.     program toxmodem
  2. c  convert VAX text file to
  3. c  file of XMODEM 128 byte records with embedded <CR><LF>
  4.  
  5.     character*254 line,input,output
  6.     character*1 CR,LF,c
  7.     integer blank
  8.     logical eof,eol
  9.     data eof,eol/.false.,.false./
  10.  
  11.     CR=char(13)
  12.     LF=char(10)
  13.     call lib$get_foreign(line,'$_From  To: ',)
  14.  
  15.     blank=index(line,' ')
  16.     input=line( 1:blank )
  17.     output=line( blank:)
  18.  
  19.     open(6,file=input,status='OLD')
  20.     open(7,file=output,status='NEW',carriagecontrol='LIST',
  21.     1                  recl=128,recordtype='FIXED')
  22.  
  23. c  getchar (read new line if no input characters left)
  24. c  putchar ( output record if full, close if EOF )
  25. c  if EOL on input, putchar CR putchar LF (output record if full)
  26. c  loop
  27.  
  28.   100    call getchar(c,eof,eol)
  29.     if(.not.eol) then
  30.         call putchar(c,eof)
  31.     else
  32. c  end of line
  33.         call putchar(CR,eof)
  34.         call putchar(LF,eof)
  35.         eol=.false.
  36.     endif
  37.     go to 100
  38.  
  39.       end
  40. c-------------------------------------------
  41.     subroutine getchar(inchar,eof,eol)
  42.     character*1 inchar
  43.     logical eof,eol
  44. c  get character from input line (read line if necessary)
  45. c  returns character and eol=.true. if no more char on line
  46. c  returns eof if end of file (no character)
  47.     character*255 line
  48.     integer len, pos
  49.     logical firsttime
  50.     common/lincom/pos,len
  51.     common/lin2com/line
  52.     data pos/0/
  53.  
  54.     if(pos.eq.0) then
  55.         read(6,1000,end=100)len,line(1:len)
  56.  1000        format(q,a)
  57. c        print*,' line=',line
  58.     endif
  59.     pos=pos+1
  60.     if(pos.gt.len) then
  61.         eol=.true.
  62.         pos=0
  63.         return
  64.     endif
  65. c    print*,' pos=',pos,' line(1:pos)=',line(1:pos)
  66. c    print*,' line(pos:pos)=',line(pos:pos)
  67.     inchar=line(pos:pos)
  68. c    print*,' pos,char',pos,inchar
  69.     return
  70.  
  71. c  EOF
  72.   100    continue
  73.     eof=.true.
  74.     return
  75.     end
  76. c------------------------------------------
  77.     subroutine putchar(c,eof)
  78.     character*1 c
  79.     logical eof
  80. c  put character into record (write record if necessary)
  81. c  if eof, fills out rest of record with CTRL-Z's and exits
  82.     character*1 CTRLZ
  83.     character*128 record
  84.     integer point
  85.     common /reccom/point
  86.     common /rec2com/record
  87.     data point/0/
  88.  
  89.     if(eof) goto 200
  90.     point=point+1
  91. c  strip parity in case VAX file had it
  92.     record(point:point)=char(iand(ichar(c),127))
  93. c    print*,' record(point:point)=',record(point:point)
  94. c    print*,' point=',point
  95.    50    if(point.ge.128) then
  96. c        print*,' record=',record
  97.   100        write(7,1000) record
  98.  1000        format(a)
  99.         point=0
  100.     endif
  101.     return        
  102.  
  103. c  EOF fill record with 26's (CTRL-Z, CP/M end of file mark for ASCII)
  104. c  output last record and exit
  105.   200    continue
  106. c    print*,' in putchar EOF section'
  107.     CTRLZ=char(26)
  108.     do i=point+1,128
  109.         record(i:i)=CTRLZ
  110.     enddo
  111. c    print*,' record=',record
  112.     write(7,1000) record
  113.     close(6)
  114.     close(7)
  115.     call exit
  116.     end
  117.