home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / txt / unform.ba < prev    next >
Text File  |  2006-10-19  |  3KB  |  49 lines
  1. 0 ' UNFORM.100 by Don Zeikel 
  2. 1 ' Club 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  3. 20 REM Strips carriage returns from lines within paragraphs.  Leaves them at ends of paragraphs, on blank lines, and on formatted lists.
  4. 30 GOTO110
  5. 40 PB$=CHR$(27)+"p":QB$=CHR$(27)+"q":RETURN
  6. 50 A$=INKEY$:IFA$=""THEN50ELSERETURN
  7. 60 :PRINT@288,PB$" Press any key to exit "PQ$;:RETURN
  8. 70 BEEP:CLS:IFERR=52THENPRINT@85,"Not a valid file name.":PRINT@125,"Try again.":GOSUB470:GOSUB50:RUN120
  9. 80 IFERR=7THENPRINT@85,"Out of memory.":PRINT@125,"Delete some files & try again.":GOSUB60:GOSUB50:IFTR=1THENKILL"NEW##.DO":MAXFILES=1:MENUELSEMAXFILES=1:MENU
  10. 90 PRINT@85,"Please try again.":GOSUB470:GOSUB50:RUN120
  11. 110 CLS:GOSUB40:PRINT@52,PB$" UNFORM.100 "QB$:PRINT@132,"by Don Zeikel":GOSUB470:GOSUB50
  12. 120 CLS:CLEAR768:MAXFILES=2:GOSUB40
  13. 130 ONERRORGOTO70
  14. 140 FILES:PRINT@245,"Which file do you wish":PRINT@285,"to unformat?        .DO ";:PRINT@299,"";
  15. 150 GOSUB50
  16. 160 IFASC(A$)>96ANDASC(A$)<123THENA$=CHR$(ASC(A$)-32)
  17. 170 PRINTA$;:IFASC(A$)=13THEN200ELSEDO$=DO$+A$:IFLEN(DO$)=6THEN190
  18. 180 GOTO150
  19. 190 GOSUB50
  20. 200 IFLEN(DO$)<6THENDO$=DO$+SPACE$(6-LEN(DO$)):Q$=DO$
  21. 210 DO$=DO$+".DO":
  22. 220 OPENDO$FORINPUTAS1:X=0
  23. 230 CLS:PRINT@88,PB$;" Measuring "DO$" ";QB$:X$="":LINEINPUT#1,X$:IFLEN(X$)>200THEN250ELSECLOSE:OPENDO$FORINPUTAS1
  24. 240 X$="":IFEOF(1)THENBEEP:PRINT@165,"Format width of":PRINT@205,"file presently is"X:GOSUB450:GOTO310ELSELINEINPUT#1,X$
  25. 250 IFX>200THENCLS:BEEP:PRINT@85,"File is already unformatted.":PRINT@125,"There is at least one line":PRINT@165,"longer than 200 characters.":GOSUB60:GOSUB50:MAXFILES=1:MENUELSE260
  26. 260 Y=LEN(X$):IFYTHENFORI=1TOY:IFASC(MID$(X$,I,1))>27ORASC(MID$(X$,I,1))=9THENNEXTELSE480
  27. 270 IFUQTHEN290ELSEIF(Y>X)THENX=Y:Q$=X$
  28. 280 GOTO240
  29. 290 IF((Y>X)AND(Y<(3*UQ/4)))THENX=Y:Q$=X$
  30. 300 GOTO240
  31. 310 CLOSE:OPENDO$FORINPUTAS1:OPEN"NEW##"FOROUTPUTAS2:TR=1:X=INT(2*X/3)
  32. 320 LINEINPUT#1,W$:LINEINPUT#1,X$:GOTO340
  33. 330 IFEOF(1)THEN410ELSEW$=X$:LINEINPUT#1,X$
  34. 340 IFLEN(W$)=0ORLEN(X$)=0THEN400ELSEO=ASC(RIGHT$(W$,1)):P=ASC(LEFT$(X$,1))
  35. 350 IF(LEN(W$)<=X)OR(P=9)THEN400
  36. 360 IFP=32THEN400
  37. 370 IFO>32ANDP>32ANDO<>46ANDO<>33ANDO<>63ANDO<>58THENW$=W$+" ":GOTO390
  38. 380 IF(O=46ORO=33ORO=63ORO=58)ANDP<>32THENW$=W$+"  ":GOTO390
  39. 390 PRINT#2,W$;:GOTO330
  40. 400 PRINT#2,W$:GOTO330
  41. 410 PRINT#2,X$:DP$="OLD"+LEFT$(DO$,3)+".DO":NAMEDO$ASDP$:NAME"NEW##.DO"ASDO$
  42. 420 BEEP:CLS:PRINT@83,"unformatting of "PB$" "DO$" "QB$" completed":PRINT@169,"Would you like to":PRINT@207,"save old version? (Y/N)";:GOSUB50:PRINTA$
  43. 430 IFA$="Y"ORA$="y"THENCLS:PRINT@42,"Old file is now named "PB$" "DP$" "QB$:GOSUB60:GOSUB50:MAXFILES=1:MENU
  44. 440 IFA$="N"ORA$="n"THENKILLDP$:MAXFILES=1:MENUELSE420
  45. 450 GOSUB470:GOSUB50:CLS:PRINT"The following is a line from "DO$":":BEEP:PRINTPB$;Q$;QB$:PRINT"IS THIS A TYPICAL LENGTH LINE? (Y/N)";:GOSUB50
  46. 460 PRINTA$:IFA$="Y"ORA$="y"THENUQ=0:CLS:PRINT@88,PB$;" Unformatting "DO$" ";QB$:RETURNELSEUQ=X:CLOSE:GOTO220
  47. 470 PRINT@285,PB$;CHR$(154)" PRESS ANY KEY TO CONTINUE "CHR$(155);QB$;:RETURN
  48. 480 CLS:BEEP:PRINT@47,"File contains one or more":PRINT@89,"CONTROL CHARACTERS.":PRINT@167,"Delete them and try again.":GOSUB60:GOSUB50:MAXFILES=1:MENU
  49.