home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / forth / fifth.arc / TEXT.FIV < prev    next >
Text File  |  1986-05-27  |  3KB  |  132 lines
  1. CREATE X
  2. CREATE |
  3. CREATE NAME
  4. EDIT
  5. ( EXEC -> string )
  6. : name cls 20 10 gotoxy
  7.   ." Please enter a filename: "
  8.   pad 40 expect over + 0 swap c!
  9. ;
  10. ~UP
  11. CREATE H
  12. EDIT
  13. create h 99 ,
  14. ~UP
  15. CREATE EJECT
  16. EDIT
  17. : eject
  18.  name 1+ 32 createfile if h ! else ." error" abort endif
  19.  0 <# 12 hold #> h @ write drop drop
  20.  
  21. ;
  22. ~UP
  23. CREATE P
  24. CREATE PRINT
  25. CREATE BUFFER
  26. EDIT
  27. create buffer 40 1024 * allot
  28. ~UP
  29. EDIT
  30. : PRINT
  31.         4 +
  32.         dup @ 77777777 = not abort" Invalid text word "
  33.         dup 8 + @ swap 4 + @             \ Get length, address.
  34.         over 0 do                        \ For all characters,
  35.           dup c@@ buffer i + c! 1+       \ Stack: buffer buffer length address.
  36.         loop
  37.         drop                             \ Drop the address.
  38.         buffer swap h @                  \ Buffer_addr  count  handle
  39.         write if drop
  40.         else
  41.            ." Write error... ( {PRINT} in {P} )" abort
  42.         endif
  43.         ." <"
  44. ;
  45. ~UP
  46. CREATE PRINT_ALL
  47. EDIT
  48. : print_all
  49.         ?dup if else exit endif
  50.         dup comp
  51.         dup >body   print
  52.         dup child   print_all
  53.             next    print_all
  54. ;
  55. ~UP
  56. EDIT
  57. \ ( document execution addr -> )
  58. : p
  59.         ?dup if else exit endif
  60.         dup name 32 createfile
  61.         if h ! else ." Can't open output file!" abort endif
  62.         dup >body print
  63.         child     print_all
  64.         h @ close ?dup drop drop
  65. ;
  66. ~UP
  67. EDIT
  68. : |
  69.   >in @
  70.   create
  71.   >in !
  72.   ' ,                           \ Save execution address.
  73.   77777777 ,                    \ Safety flag.
  74.   >in @ ,                       \ Save the address of text stream.
  75.  
  76.   0                             \ The initial count of the bytes.
  77.   >in @                         \ Get the pointer to the text.
  78.   begin
  79.     dup c@@                     \ Is it zero?
  80.   while                         \ While not null, increment the pointer.
  81.     1+ swap 1+ swap             \ Increment the count and address.
  82.   repeat
  83.   >in !                         \ point text pointer to null.
  84.   ,                             \ Save the byte count.
  85. does>
  86.   @ p                           \ Get execution address and print.
  87. ;
  88. ~UP
  89. CREATE DOCUMENT
  90. CREATE CHAPTER1
  91. EDIT
  92. | chapter1
  93.  
  94.             Chapter 1
  95.  
  96. In this chapter we will explain the
  97. various meanings to life, the universe,
  98. and everything.
  99. ~UP
  100. CREATE CHAPTER2
  101. EDIT
  102. | chapter2
  103.  
  104.             Chapter 2
  105.  
  106. This section is about a young boy,
  107. and his trials in becoming a man.
  108. ~UP
  109. CREATE CHAPTER3
  110. EDIT
  111. | chapter3
  112.  
  113.             Chapter 3
  114.  
  115. Here we give up any pretence of trying
  116. to make sense.
  117. ~UP
  118. EDIT
  119. | document
  120.  
  121.         An Example Document
  122.         -- ------- --------
  123. ~UP
  124. EDIT
  125. \ Executing any text module ( one defined with | ) will create a file
  126. \ and write out all text of the executed module and all modules below it.
  127. \
  128. \ For example, exeucting document gives the entire document.  Executing
  129. \ CHAPTER1 only writes out that chapter.
  130. create x
  131. ~UP
  132. ABORT