home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / jx4nt125 / utils / ub2t.utf (.txt) < prev    next >
Encoding:
Null Bytes Alternating  |  1995-05-19  |  5.0 KB  |  80 lines
  1. \ ub2t.f .. convert Unicode BLOCK files to Unicode TEXT files
  2. \ Copyright (c)1994 Jack J. Woehr
  3. \ P.O. Box 51, Golden, Colorado 80402-0051
  4. \ jax@well.sf.ca.us 72203.1320@compuserve.com
  5. \ SYSOP RCFB (303) 278-0364 2400/9600/14400
  6. \ All Rights Reserved
  7. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  8. \ This is free software and can be modified and redistributed under
  9. \ certain conditions described in the file COPYING.TXT. The
  10. \ Disclaimer of Warranty and License for this free software are also
  11. \ contained in the file COPYING.TXT.
  12. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  13.  
  14. \
  15. \ $Revision: 1.2 $
  16. \
  17.  
  18. MARKER ub2t.f
  19.  
  20. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  21. \ Convert an entire Unicode BLOCK file to Unicode text file
  22. \ by reading a line at a time and copying it appending CRLFs.
  23. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  24.  
  25. BASE @ HEX
  26.  
  27. \ Describe how many lines we'll have to convert.
  28. 400 CONSTANT CHARS/BLOCK
  29. 10 CONSTANT LINES/BLOCK
  30.  
  31. \ Some string buffers
  32. CREATE (CRLF) 0D C, 0A C,
  33. CREATE NAMEBUFF 400 CHARS ALLOT
  34.  
  35. BASE !
  36.  
  37. \ Generic err handler
  38. : FILE-IO-ERR? ( flag --)
  39.     IF -37 THROW THEN
  40. ;
  41.  
  42. \ Do a line from one file to the other, adding CRLF
  43. : UB2T-LINE ( in-fid out-fid -- u)
  44.     >R                          \ save out-fid
  45.     PAD 64 ROT READ-FILE        \ -- u ior  R: -- out-fid
  46.     FILE-IO-ERR?                \ -- u      R: -- out-fid
  47.     DUP                         \ -- u u    R: -- out-fid
  48.     IF                          \ -- u      R: -- out-fid
  49.         DUP                     \ -- u u    R: -- out-fid
  50.         PAD SWAP R@ WRITE-FILE  \ -- u ior  R: -- out-fid
  51.         FILE-IO-ERR?            \ -- u      R: -- out-fid
  52.         (CRLF) 2 R> WRITE-FILE  \ -- u ior  R: --
  53.         FILE-IO-ERR?            \ -- u
  54.     ELSE                        \ -- 0      R: -- out-fid
  55.         R> DROP                 \ -- 0      R: --
  56.     THEN                        \ -- u|0
  57.         
  58. ;
  59.  
  60.  
  61. \ Usage: UB2T file1 file2
  62. : UB2T ( "ccc" "ccc" --)
  63.     BL WORD COUNT
  64.     R/O OPEN-FILE FILE-IO-ERR?          \ -- fid1
  65.     BL WORD COUNT
  66.     R/W BIN CREATE-FILE FILE-IO-ERR?    \ -- fid1 fid2
  67.     OVER FILE-SIZE FILE-IO-ERR?         \ -- fid1 fid2 ud
  68.     CHARS/BLOCK UM/MOD NIP              \ -- fid1 fid2 n
  69.     LINES/BLOCK UM* DROP  0             \ -- fid1 fid2 n' 0
  70.     DO
  71.         2DUP UB2T-LINE
  72.         0= FILE-IO-ERR?
  73.     LOOP
  74.     CLOSE-FILE DROP CLOSE-FILE DROP
  75. ;
  76.  
  77. \ ~~~~~~~~~~~~~
  78. \ End of ub2t.f
  79. \ ~~~~~~~~~~~~~
  80.