home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / rtty / rtty12 / ru.bas < prev    next >
BASIC Source File  |  1985-06-27  |  5KB  |  126 lines
  1. 10 REM $LINESIZE:132
  2. 20 '********************************************************************
  3. 30 '
  4. 40 ' RTTY UTILITY PROGRAM FOR THE IBM PERSONAL COMPUTER
  5. 50 '
  6. 60 ' BY   GLENN E. WELMAN  -  KF4NB   (FORMERLY WB0OWT)
  7. 70 '      3301 PASTERN CT.
  8. 80 '      LEXINGTON, KY 40513
  9. 90 '
  10. 100 '  (C) COPYRIGHT WELMAN SOFTWARE 1983, 1984
  11. 110 '********************************************************************
  12. 120 '
  13. 130 '  FEEL FREE TO GIVE COPIES OF THIS PROGRAM TO YOUR FRIENDS.
  14. 140 '
  15. 150 '  PLEASE, DON'T SELL OR BARTER THE PROGRAM TO OTHERS.
  16. 160 '
  17. 170 '  IF YOU FIND BUGS IN THE PROGRAM, FEEL FREE TO
  18. 180 '  CORRESPOND DIRECTLY WITH ME. (SASE REQUESTED)
  19. 190 '
  20. 200 '  WHEN YOU PASS ALONG THE PROGRAM, INCLUDE ONLY THE
  21. 210 '  ORIGINAL UNMODIFIED VERSION.
  22. 220 '
  23. 230 '  DO NOT REMOVE THESE GUIDELINES FROM THE PROGRAM
  24. 240 '  OR DOCUMENT.
  25. 250 '
  26. 260 '  IF YOU FIND THE PROGRAM OF VALUE, A SMALL CONTRIBUTION
  27. 270 '  FOR MY EFFORT WILL BE APPRECIATED ($25 SUGGESTED).
  28. 280 '
  29. 290 '                       73's
  30. 300 '                       Glenn - KF4NB
  31. 310 'Modification 3/30/85 W9HLQ
  32. 320 '********************************************************************
  33. 330 CPRGHT$="(C) COPYRIGHT WELMAN SOFTWARE 1983, 1984"
  34. 340 DEFINT A-Z
  35. 350 'DETERMINE SCREEN SIZE AND SET THE SCROLL PARAMETERS
  36. 360 A=CSRLIN:PRINT STRING$(60," ");:IF A=CSRLIN THEN CMAX=80 ELSE CMAX=40
  37. 370 CLS
  38. 380 'READ THE INITIALIZATION PARAMETERS
  39. 390 QBEL=0:RCNT=1:LPTR$="LPT1:"
  40. 400 ON ERROR GOTO 510
  41. 410 OPEN "PARMS.RTY" FOR INPUT AS #1
  42. 420 WHILE NOT EOF(1)
  43. 430 INPUT#1,P$:P$=LEFT$(P$,4)
  44. 440 FOR PL=1 TO LEN(P$)
  45. 450 P=ASC(MID$(P$,PL,1)):IF (P>&H60) AND (P<&H7B) THEN MID$(P$,PL,1)=CHR$(P-&H20)
  46. 460 NEXT PL
  47. 470 IF P$="LPT2" THEN LPTR$="LPT2:":GOTO 500
  48. 480 IF P$="LPT3" THEN LPTR$="LPT3:":GOTO 500
  49. 490 IF P$="QB" THEN QBEL=-1
  50. 500 WEND
  51. 510 CLOSE #1
  52. 520 REM $PAGE
  53. 530 'INITIALIZE PROGRAM VARIABLES
  54. 540 ON ERROR GOTO 0
  55. 550 LOCATE 2,1:PRINT "************************************************************3/30/85**********"
  56. 555 LOCATE 3,22:COLOR 1,7:PRINT "YE OLDE RTTY ART PRINT PROGRAM":COLOR 7,1
  57. 560 LOCATE 6,10:INPUT "ENTER DRIVE (Default B:)";D$
  58. 570 IF D$="" THEN D$="B:"
  59. 580 LOCATE 8,10:INPUT "ENTER NAME OF FILE TO PROCESS";PF$
  60. 590 IF PF$="" THEN 580
  61. 600 OPEN D$+PF$ FOR INPUT AS #2
  62. 610 LOCATE 10,10:INPUT "WOULD YOU LIKE TO SAVE THE RESULTS";P$
  63. 620 P$=LEFT$(P$,1):IF P$="Y" OR P$="y" THEN GOSUB 920
  64. 630 LOCATE 14,10:INPUT "DO YOU WANT TO PRINT THE FILE";P$
  65. 640 P$=LEFT$(P$,1):IF P$="Y" OR P$="y" THEN PRNTR=-1 ELSE PRNTR=0
  66. 650 GOSUB 1190
  67. 660 CLS
  68. 670 WIDTH LPTR$,255
  69. 680 OPEN LPTR$ AS #1
  70. 690 IF SIZE=1 THEN PRINT #1,CHR$(18)+CHR$(27)+CHR$(50) ELSE PRINT #1,CHR$(15)+CHR$(27)+CHR$(49)
  71. 700 'THIS IS THE MAIN PROGRAM LOOP
  72. 710 IF UNCOMP THEN GOSUB 1060:GOTO 740
  73. 720 IF EOF(2) THEN 750
  74. 730 TCH$=INPUT$(1,#2):GOSUB 1060
  75. 740 GOTO 710
  76. 750 CLOSE:END
  77. 760 'GET THE NEXT RECEIVED CHARACTER AND DISPLAY IT
  78. 770 B$=CHR$(BAU):IF BAU > 31 OR BAU=7 OR BAU=10 OR BAU=13 THEN 790 ELSE 900
  79. 780 'B$ CONTAINS THE ASCII CHARACTER
  80. 790 IF PRNTR THEN IF BAU<>7 THEN PRINT#1,B$;
  81. 800 CURIN=ASC(B$)
  82. 810 IF NOT COMP THEN 850
  83. 820 IF BFILE THEN IF CURIN=LASTIN THEN RCNT=RCNT+1:GOTO 850 ELSE IF LASTIN<>10 AND LASTIN<>13 THEN IF RCNT=1 THEN PRINT#3,CMP$;:GOTO 840 ELSE IF RCNT=2 THEN PRINT#3,CMP$;CMP$;:GOTO 840
  84. 830 IF BFILE THEN IF LASTIN<>10 AND LASTIN<>13 THEN IF RCNT=26 THEN PRINT#3,CMP$;CHR$(255);CHR$(25);CMP$; ELSE PRINT#3,CHR$(255);CHR$(RCNT);CMP$;
  85. 840 IF BFILE THEN CMP$=B$:RCNT=1
  86. 850 IF BFILE THEN IF CURIN=13 AND (LASTIN=10 OR LASTIN=13) THEN PRINT#3,
  87. 860 IF BFILE THEN IF CURIN=10 OR CURIN=13 THEN PRINT#3,CHR$(CURIN+10); ELSE IF LASTIN=10 OR LASTIN=13 THEN PRINT#3,
  88. 870 IF BFILE AND NOT COMP AND CURIN<>10 AND CURIN<>13 THEN PRINT#3,B$;
  89. 880 LASTIN = CURIN
  90. 890 GOSUB 1000:'PUT CHARACTER ON SCREEN
  91. 900 RETURN
  92. 910 'SEND RECEIVED CHARACTERS TO SPECIFIED FILE
  93. 920 BFILE=0
  94. 930 LOCATE 11,10:INPUT "ENTER NAME OF NEW FILE";BF$
  95. 940 IF BF$="" THEN 980
  96. 950 OPEN BF$ FOR APPEND AS #3
  97. 960 BFILE=-1:LOCATE 12,10:INPUT "DO YOU WANT COMPRESSION (Y/N) ";P$
  98. 970 P$=LEFT$(P$,1):IF P$="Y" OR P$="y" THEN COMP=-1 ELSE COMP=0
  99. 980 RETURN
  100. 990 'PUT RECEIVED CHARACTER ON SCREEN
  101. 1000 RCH=ASC(B$):IF RCH=13 THEN LOCATE CSRLIN,1,0:RETURN
  102. 1010 IF RCH=7 THEN RETURN  'DONT SEND BEEP CHAR TO SCREEN
  103. 1020 PRINT B$;
  104. 1030 RETURN
  105. 1040 REM $PAGE
  106. 1050 'PUT CHAR TO SEND ON SCREEN
  107. 1060 TCH=ASC(TCH$):IF UNCOMP THEN TCNT=TCNT-1:TCH=UTCH:TCH$=UTCH$:IF TCNT=0 THEN UNCOMP=0:GOTO 1120 ELSE GOTO 1120
  108. 1070 IF UCNT THEN UCNT=0:UNCOMP=-1:UTCH=TCH:IF TCH=13 THEN UTCH$=CHR$(23):RETURN ELSE UTCH$=TCH$:RETURN
  109. 1080 IF USTRT THEN USTRT=0:UCNT=-1:TCNT=TCH:RETURN
  110. 1090 IF CRLF THEN CRLF=0:IF TCH=10 THEN LTCH=10:RETURN
  111. 1100 IF QBL THEN QBL=0:IF TCH=7 THEN LTCH=7:RETURN
  112. 1110 IF TCH=255 THEN USTRT=-1:RETURN
  113. 1120 IF TCH=13 OR TCH=10 THEN IF LTCH=20 OR LTCH=23 THEN RETURN ELSE TCH$=CHR$(TCH+10)
  114. 1130 IF TCH=20 OR TCH=23 THEN BAU=TCH-10 ELSE BAU=TCH
  115. 1140 GOSUB 770
  116. 1150 LTCH=TCH
  117. 1160 IF TCH=13 THEN TCH=10:CRLF=-1:GOTO 1130
  118. 1170 IF QBEL AND TCH=39 THEN TCH=7:QBL=-1:GOTO 1130
  119. 1180 RETURN
  120. 1190 REM **********************************
  121. 1200 LOCATE 16,10:INPUT "CHANGE PIX SIZE (DEFAULT=S) Small/Full";SZ$
  122. 1210 IF SZ$="F" OR SZ$="f" THEN SIZE=1:RETURN
  123. 1220 IF SZ$="S" OR SZ$="s" THEN SIZE=0:RETURN
  124. 1230 IF SZ$="" THEN SIZE=0:RETURN
  125. 1240 GOTO 1200
  126.