home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / wp / wastrip.zip / WASTRIP.BAS
BASIC Source File  |  1986-06-27  |  3KB  |  59 lines
  1. 10 GOTO 70
  2. 20 'WASTRIP.BAS -- a program to convert IBM Writing Assistant text files
  3. 30 '               into ASCII text files, while displaying results on a color
  4. 40 '               monitor, with emphasized characters displayed as emphasized.
  5. 50 '               Written by Stewart A. Pollock on November 8, 1985
  6. 60 '               Placed in the Public Domain.
  7. 70 DEFINT A-Z:COLOR 7,1,1:CLS:SO$=CHR$(14)
  8. 80 CR$=CHR$(13):LF$=CHR$(10):SUB$=CHR$(26):SP$=CHR$(32):NUL$=CHR$(0)
  9. 90 INPUT "What is the name of the file to strip?",F$
  10. 100 IF F$="h" OR F$="H" THEN FILES:GOTO 90  'HELP? -- show the directory
  11. 110 INPUT "What is the name of the resulting file?",G$
  12. 120 IF G$="h" OR F$="H" THEN  FILES:GOTO 110
  13. 130 OPEN F$ AS #1 LEN=1:OPEN G$ AS #2 LEN=1
  14. 140 FIELD #1, 1 AS A$:FIELD #2, 1 AS B$
  15. 150 GET #1, 1024 'jump straight to the text, past W.A. information
  16. 200 GET #1 'read a character
  17. 210 AC = ASC(A$)
  18. 220 IF AC < 32 GOTO 300 'watch for control characters
  19. 230 IF AC > 127 THEN GOSUB 510: GOTO 200 'handle emphasized characters
  20. 240 LSET B$=A$:PUT #2:PRINT A$; 'write to new text-file and display
  21. 250 GOTO 200
  22. 300 IF A$=CR$ THEN GOSUB 420:GOTO 200 'check for carriage return
  23. 310 IF A$=SO$ THEN LSET B$=SUB$:PUT #2:GOTO 340 'check for end of W. A. text
  24. 320 IF A$=NUL$ AND LOC(1)>LOF(1) THEN LSET B$=SUB$:PUT #2:GOTO 340 'check for nulls just in case you missed the end of W. A. file
  25. 330 GOTO 200 'ignore all other control characters
  26. 340 CLOSE
  27. 350 END
  28. 400 '**** SUBROUTINES
  29. 410 'Routine to insert Carriage Return - Line Feed sequence at end of line
  30. 420 LSET B$=CR$:PUT #2:LSET B$=LF$:PUT #2:PRINT :RETURN
  31. 430 'routine to handle emphasized strings
  32. 440 '    Each emphasized character is followed by a character which defines
  33. 450 '    the emphasis for that particular character. There are two sets of
  34. 460 '    these "defining" characters:  one for letters and one for numerals and
  35. 470 '    punctuation.  This routine reads the next character, determines
  36. 480 '    whether the emphasized character is alpha or numeric, decodes the
  37. 490 '    character and then uses ON . . . GOTO to determine and display the
  38. 500 '    particular emphasis.
  39. 510 GET #1:BV=ASC(A$):IF BV<209 THEN DIF=192:BS=192:ELSE DIF=128:BS=208
  40. 520 BS=BV-BS:LSET B$=CHR$(AC-DIF):PUT #2
  41. 530 ON BS GOTO 540,550,560,570,580,590,600,610,620,630,640,650,660,670,680
  42. 540 COLOR 1,7:PRINT B$;:GOTO 700
  43. 550 COLOR 23,1:PRINT B$;:GOTO 700
  44. 560 COLOR 17,7:PRINT B$;:GOTO 700
  45. 570 COLOR 4,1:PRINT B$;:GOTO 700
  46. 580 COLOR 1,4:PRINT B$;:GOTO 700
  47. 590 COLOR 20,1:PRINT B$;:GOTO 700
  48. 600 COLOR 17,4:PRINT B$;:GOTO 700
  49. 610 COLOR 2,1:PRINT B$;:GOTO 700
  50. 620 COLOR 1,2:PRINT B$;:GOTO 700
  51. 630 COLOR 18,1:PRINT B$;:GOTO 700
  52. 640 COLOR 17,2:PRINT B$;:GOTO 700
  53. 650 COLOR 3,1:PRINT B$;:GOTO 700
  54. 660 COLOR 1,3:PRINT B$;:GOTO 700
  55. 670 COLOR 19,1:PRINT B$;:GOTO 700
  56. 680 COLOR 17,3:PRINT B$;:GOTO 700
  57. 690 COLOR 5,2,1:PRINT B$;:LSET B$=CHR$(ASC(A$)-128):PUT #2:PRINT B$;
  58. 700 COLOR 7,1,1:RETURN
  59.