home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / yappprot / cwrcv.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-04-09  |  2.6 KB  |  115 lines
  1. 10  CLEAR: CLS: KEY OFF: DIM A$(100): DEFINT D,I,A: FOR I=1 TO 100: READ A$(I):     NEXT: FALSE=0: TRUE=NOT FALSE
  2. 15  FOR I= 1 TO 10: KEY I,"": NEXT
  3. 20  ON KEY(10) GOSUB 11000
  4. 30  ON KEY(9) GOSUB 11500
  5. 99  '
  6. 100  DATA E,T,I,A,N,M,S,U,R,W,D,K,G,O,H,V,F,-,L,aa,P,J,B,X,C
  7. 110  DATA Y,Z,Q,-,-,5,4,-,3,-,-,-,2,as,-,ar,-,-,-,-,1,6,bt,/,-
  8. 130  DATA -,-,-,-,7,-,-,-,8,-,9,0,-,-,-,-,-,sk,-,-,-,-,-,-,?
  9. 140  DATA -,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-
  10. 141  '
  11. 1000  GOSUB 14000
  12. 1010  GOTO 12000
  13. 9000  C=250
  14. 9997  '
  15. 9998  ' This is the receive routine. <B> is timer variable; <C> is dah length;          <DA> is dash decode; <DO> is dot decode.
  16. 9999  '
  17. 10000  KEY(10) ON
  18. 10005  A=INP(&H3FE) AND 128
  19. 10010  IF A=0 THEN 10005
  20. 10020  B=0
  21. 10030  A=INP(&H3FE) AND 128: B=B+10
  22. 10040  IF A=0 THEN DO=2*DO:DA=2*DA:DO=DO+1:IF F9 THEN 10100 ELSE C=((5*C)+(3*B))/6: GOTO 10100
  23. 10050  IF B<(0.5*C) THEN 10030
  24. 10060  DO=2*DO:DA=2*DA:DA=DA+1
  25. 10070  A=INP(&H3FE) AND 128: B=B+10
  26. 10080  IF A THEN GOTO 10070
  27. 10090  C=((4*C)+B)/5
  28. 10100  B=0
  29. 10110  A=INP(&H3FE) AND 128
  30. 10120  B=B+10
  31. 10130  IF A THEN GOTO 10020
  32. 10140  IF B<(0.5*C) THEN GOTO 10110
  33. 10145  KEY(10) OFF
  34. 10150  GOSUB 10220
  35. 10155  KEY(10) ON
  36. 10160  A=INP(&H3FE) AND 128
  37. 10170  B=B+10
  38. 10180  IF A THEN GOTO 10020
  39. 10190  IF B<(2*C) THEN GOTO 10160
  40. 10200  PRINT " ";
  41. 10210  GOTO 10005
  42. 10219  '
  43. 10220  DA=DA*2
  44. 10230  D=DA+DO
  45. 10240  IF D>100 THEN D=100
  46. 10250  PRINT A$(D);
  47. 10260  DA=0:DO=0
  48. 10270  RETURN
  49. 10997  '
  50. 10998  ' key(10) interrupt subroutine
  51. 10999  '
  52. 11000  KEY(10) OFF: KEY(9) OFF: F9 = FALSE: RETURN 12000
  53. 11497  '
  54. 11498  ' F9 subroutine
  55. 11499  '
  56. 11500  XSCR=POS(0): YSCR=CSRLIN: LOCATE 25,1,1
  57. 11510  IF F9 THEN 11600
  58. 11515  F9=TRUE
  59. 11520  COLOR 0,7: PRINT "    <F9> active    ";: COLOR 7,0: LOCATE YSCR,XSCR
  60. 11530  RETURN
  61. 11540  '
  62. 11600  F9=FALSE
  63. 11610  COLOR 0,7: PRINT "                  ";:COLOR 7,0: LOCATE YSCR,XSCR
  64. 11620  RETURN
  65. 11997  '
  66. 11998  ' Menu routine
  67. 11999  '
  68. 12000  CLS: PRINT"    *** MENU ***": PRINT: PRINT
  69. 12010  PRINT" <F1> -- Receive"
  70. 12020  PRINT" <F2> -- Reserved"
  71. 12030  PRINT" <F3> -- Exit to BASIC"
  72. 12040  PRINT" <F4> -- Exit to DOS"
  73. 12050  PRINT" <F5> -- Help"
  74. 12060  PRINT: PRINT: PRINT " Your choice ? ";: LOCATE ,,1
  75. 12070  CHOICE$=INKEY$
  76. 12080  IF LEN(CHOICE$) < 2 THEN 12070
  77. 12090  ROUTINE = INSTR(";<=>?",MID$(CHOICE$,2))
  78. 12095  PRINT ROUTINE
  79. 12100  ON ROUTINE GOTO 13000,12000,13100,13200,13300
  80. 12105  GOTO 12000
  81. 12110  '
  82. 12998  ' goto receive routine
  83. 12999  '
  84. 13000  CLS: LOCATE 25,1: COLOR 0,7: PRINT SPACE$(25);"**** RECEIVING ****";SPACE$(79-POS(0));: LOCATE ,60: PRINT" <F10> for Menu ";: COLOR 7,0: LOCATE 1,1: KEY(9) ON : GOTO 10000
  85. 13099  '
  86. 13100  CLS: END
  87. 13199  '
  88. 13200  CLS: SYSTEM
  89. 13299  '
  90. 13300  CLS
  91. 13310  OPEN "cwhelp" FOR INPUT AS #1
  92. 13320  WHILE NOT EOF(1)
  93. 13330  LINE INPUT#1, HELP$
  94. 13340  PRINT HELP$
  95. 13350  WEND
  96. 13360  CLOSE
  97. 13365  PRINT: COLOR 31,0: PRINT"Any key": COLOR 7,0
  98. 13367  WAIT.$=INKEY$: IF WAIT.$="" THEN 13367
  99. 13370  GOTO 12000
  100. 13999  '
  101. 14000  PRINT: PRINT: PRINT
  102. 14005  COLOR 15,0
  103. 14010  PRINT" KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  104. 14020  PRINT" OPEN  CW RECEIVE PROGRAM   OPEN"
  105. 14030  PRINT" OPEN        by AA4L        OPEN"
  106. 14040  PRINT" OPEN     Bob Johnson       OPEN"
  107. 14050  PRINT" OPEN                       OPEN"
  108. 14060  PRINT" OPEN     Version 1.0       OPEN"
  109. 14070  PRINT" OPEN       04/09/83        OPEN"
  110. 14080  PRINT" OPEN     Public Domain     OPEN"
  111. 14090  PRINT" SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
  112. 14100  COLOR 7,0
  113. 14105  FOR I=1 TO 5000: NEXT
  114. 14110  RETURN
  115.