home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / atari / amodem42.bas < prev    next >
Encoding:
BASIC Source File  |  1983-09-09  |  8.7 KB  |  212 lines
  1. 10 REM AMODEM4.BAS:VER 4.2; 11-24-82
  2. 20 GOTO 10000
  3. 1000 TRAP 1000:GOSUB 13000:? :? " OPTION  = TOGGLE MEMORY SAVE"
  4. 1010 ? " SELECT  = (ABORT,B,C,D,M,P,R,S,T,U)"
  5. 1020 ? " START   = START TRANSMISSION"
  6. 1030 SETCOLOR 2,7,2:C$=CHR$(SRFLAG):IF SRFLAG=ZERO THEN C$=" ":FILE$=C$
  7. 1040 ? C$;" FILE   = ";FILE$:? 
  8. 1042 IF  NOT TRN THEN ? "*** ASCII";
  9. 1044 IF TRN THEN ? "*** ATARI";
  10. 1046 ? " TERMINAL MODE ***"
  11. 1050 ADDR=USR(ADR(IO$),ADDR,LEN(BUFF$)+ADDR-1)
  12. 1055 C=PEEK(706):IF C=8 THEN PUT #MODEM,19:? "*** BUFFER FULL ***":GOTO 1700
  13. 1200 IF C=6 THEN 5000
  14. 1210 IF C=5 THEN 6000
  15. 1220 IF C<>3 OR SRFLAG<>67 THEN GOTO TERM
  16. 1230 MSAVE=WON-MSAVE:POKE 704,MSAVE:? :? "Capture ";
  17. 1240 IF MSAVE THEN SETCOLOR 2,0,2:? "On  ";
  18. 1250 IF  NOT MSAVE THEN SETCOLOR 2,7,2:? "Off ";
  19. 1260 ? ADDR-BUFF;" BYTES"
  20. 1270 IF PEEK(CON)=3 THEN 1270
  21. 1280 GOTO TERM
  22. 1500 ? :? "*** NEW CAPTURE FILE ***"
  23. 1510 ? "*** SELECT D WILL SAVE IT!***"
  24. 1520 ADDR=BUFF:GOSUB 13000
  25. 1530 SETCOLOR 2,0,2:POKE 766,1
  26. 1540 MSAVE=1:POKE 704,MSAVE:GOTO TERM
  27. 1700 ? :CLOSE #MODEM:IF ADDR<=BUFF THEN ? "*** BUFFER IS EMPTY ***":GOTO 1760
  28. 1710 TRAP 1760:? "*** SAVING MEMORY ***"
  29. 1720 OPEN #FILE,8,ZERO,FILE$
  30. 1730 OBJ=1:IF TRN THEN OBJ=0
  31. 1740 POKE 1536,OBJ
  32. 1750 C=USR(1610,BUFF,ADDR)
  33. 1760 MSAVE=ZERO:POKE 704,MSAVE:ADDR=BUFF:L$=""
  34. 1790 SRFLAG=ZERO:GOTO MENU
  35. 2000 TRAN=32:GOSUB IO:A=NAK:POKE 766,1
  36. 2010 SETCOLOR 2,4,2:BLOCK=ZERO
  37. 2020 ? :? "*** RECEIVING ";FILE$;" ***"
  38. 2300 POKE 77,ZERO:FOR TRY=WON TO ERRTRY-WON
  39. 2310 ? :? "*** GETTING SECTOR ";BLOCK+WON;"/";TRY;" ***"
  40. 2315 IF PEEK(CON)=5 THEN A=CAN
  41. 2320 PUT #MODEM,A:A=ACK
  42. 2330 GET #MODEM,SH:SUM=SH:IF SH=EOT OR SH=CAN THEN 2380
  43. 2340 GET #MODEM,C:SUM=SUM+C:GET #MODEM,C:SUM=SUM+C
  44. 2350 ADDR=BLOCK*128+BUFF:FOR BLK=0 TO 127:GET #MODEM,C:POKE ADDR+BLK,C:? CHR$(C);:SUM=SUM+C:NEXT BLK
  45. 2360 GET #MODEM,C:SUM=ASC(CHR$(SUM)):IF C=SUM THEN 2380
  46. 2370 A=NAK:FOR C=WON TO 400:NEXT C:GOTO 2390
  47. 2380 TRY=ERRTRY
  48. 2390 NEXT TRY:BLOCK=BLOCK+1
  49. 2500 IF SH=EOT AND A=ACK THEN 2800
  50. 2510 IF SH=CAN OR A<>ACK THEN 2900
  51. 2530 GOTO 2300
  52. 2800 PUT #MODEM,ACK:? :? "*** SAVING FILE ***":TRAP 2860
  53. 2805 C=PEEK(ADDR+127)
  54. 2810 FOR A=ADDR+C TO ADDR+127:IF PEEK(A)<>C THEN C=128
  55. 2812 NEXT A:ADDR=ADDR+C:CLOSE #MODEM
  56. 2820 OBJ=ZERO:A=PEEK(BUFF):IF A>ZERO AND A<255 THEN OBJ=WON
  57. 2825 A=ZERO:IF FILE$(1,1)="C" AND OBJ=ZERO THEN A=128
  58. 2830 IF TRN THEN OBJ=ZERO
  59. 2840 POKE 1536,OBJ:POKE 195,WON:? "*** ";ADDR-BUFF;" BYTES"
  60. 2850 OPEN #FILE,8,A,FILE$:C=USR(1610,BUFF,ADDR)
  61. 2860 GOTO 2990
  62. 2900 ? :? "*** UNABLE TO RECEIVE FILE":A=NAK
  63. 2910 PUT #MODEM,CAN
  64. 2990 SRFLAG=ZERO:GOTO MENU
  65. 3000 TRAN=32:GOSUB IO:POKE 766,1
  66. 3010 SETCOLOR 2,WON,2:BLOCK=ZERO:BYTE=BYTES
  67. 3020 ? :? "*** SENDING ";FILE$;" ***"
  68. 3300 POKE 77,ZERO:FOR TRY=WON TO ERRTRY
  69. 3310 ? :? "*** SENDING SECTOR ";BLOCK+WON;"/";TRY;" ***"
  70. 3320 PUT #MODEM,SOH:SUM=ZERO
  71. 3330 PUT #MODEM,BLOCK+WON
  72. 3340 PUT #MODEM,254-BLOCK
  73. 3350 ADDR=BLOCK*128+BUFF:FOR BLK=0 TO 127:C=PEEK(ADDR+BLK):PUT #MODEM,C:? CHR$(C);:SUM=SUM+C:NEXT BLK
  74. 3360 SUM=ASC(CHR$(SUM)):PUT #MODEM,SUM
  75. 3370 GET #MODEM,A:IF A=CAN OR PEEK(CON)=5 THEN 3900
  76. 3380 IF A<>ACK THEN 3400
  77. 3390 TRY=ERRTRY
  78. 3400 NEXT TRY:BLOCK=BLOCK+1
  79. 3500 IF A<>ACK THEN 3900
  80. 3510 BYTE=BYTE-128:IF BYTE>ZERO THEN 3300
  81. 3800 PUT #MODEM,EOT:PUT #MODEM,ZERO
  82. 3810 ? :? "*** TRANSFER COMPLETE ***"
  83. 3820 GOTO 3990
  84. 3900 ? :? "*** UNABLE TO SEND FILE ***"
  85. 3910 PUT #MODEM,CAN
  86. 3990 GOTO MENU
  87. 4000 ? :CLOSE #MODEM
  88. 4010 FOR C=49 TO 52
  89. 4020 L$="D1:*.*":L$(2,2)=CHR$(C)
  90. 4030 TRAP 4060:OPEN #FILE,6,ZERO,L$:? L$:TRAP 4050
  91. 4040 INPUT #FILE;L$:? L$:GOTO 4040
  92. 4050 PRINT 
  93. 4060 TRAP 4065:CLOSE #FILE
  94. 4065 IF DR=WON THEN 4080
  95. 4070 NEXT C
  96. 4080 DR=ZERO:L$="":GOTO MENU
  97. 4500 POKE 766,WON:SETCOLOR 2,2,2:? :? "*** UPLOADING ";FILE$;" ***"
  98. 4510 FOR I=BUFF TO BUFF+BYTES-129+BYTE
  99. 4520 PUT #MODEM,PEEK(I):IF PEEK(CON)=5 THEN ? :? "*** ABORTED ***":GOTO 4550
  100. 4530 STATUS #MODEM,C:BLK=PEEK(747):IF BLK THEN FOR A=WON TO BLK:GET #MODEM,C:? CHR$(C);:NEXT A
  101. 4540 NEXT I
  102. 4550 FOR I=1 TO 100:NEXT I
  103. 4560 STATUS #MODEM,C:IF PEEK(747) THEN GET #MODEM,C:? CHR$(C);:GOTO 4560
  104. 4570 ? :? "*** UPLOAD COMPLETE ***":GOTO MENU
  105. 5000 IF SRFLAG=67 THEN 1500
  106. 5010 IF SRFLAG=82 THEN 2000
  107. 5020 IF SRFLAG=83 THEN 3000
  108. 5030 IF SRFLAG=85 THEN 4500
  109. 5040 ? :? "*** MUST SELECT FIRST! ***"
  110. 5050 IF PEEK(CON)<>7 THEN 5040
  111. 5060 GOTO TERM
  112. 6000 ? :? " Baud, Capture, Dump, Menu or 1-4,":? " duPlex, Receive, Send,":? " Translation, Upload  ?";
  113. 6010 CLOSE #MODEM:GET #KEY,C:C$=CHR$(C):? C$
  114. 6012 IF C$="B" THEN 9900
  115. 6015 IF C$="C" THEN 7000
  116. 6020 IF C$="D" THEN 1700
  117. 6025 IF C$="U" THEN 8000
  118. 6030 IF C$="M" THEN 4000
  119. 6035 IF C$="R" THEN 7000
  120. 6040 IF C$="S" THEN 8000
  121. 6045 IF C$="T" THEN TRN=32-TRN:IF SRFLAG>82 THEN SRFLAG=ZERO
  122. 6050 IF C$="P" THEN PLX=1-PLX:POKE 705,PLX
  123. 6055 DR=0:IF C>48 AND C<53 THEN DR=WON:GOTO 4020
  124. 6060 GOTO MENU
  125. 7000 SRFLAG=ZERO:MSAVE=ZERO:? :? "*** RECEIVE FILESPEC ";
  126. 7010 INPUT L$:IF L$="" THEN 7090
  127. 7015 TRAP 7000:IF L$(2,2)<>":" THEN IF L$(3,3)<>":" THEN ? "SPECIFY DEVICE!":GOTO 7000
  128. 7020 FILE$=L$:IF L$(1,1)<>"D" THEN 7080
  129. 7030 TRAP 7080:OPEN #FILE,4,ZERO,FILE$
  130. 7040 ? :? "*** HAVE FILE ";FILE$
  131. 7050 ? "*** Type (Y) to ERASE ";FILE$;" ";
  132. 7060 GET #KEY,A:? CHR$(A):IF A<>89 THEN L$="":GOTO 7090
  133. 7070 CLOSE #FILE:XIO 36,#FILE,ZERO,ZERO,FILE$:XIO 33,#FILE,ZERO,ZERO,FILE$
  134. 7080 SRFLAG=C:ADDR=BUFF
  135. 7090 TRAP 40000:GOTO MENU
  136. 8000 SRFLAG=ZERO:? :? "*** SEND FILESPEC ";:INPUT L$:IF L$="" THEN 8090
  137. 8005 TRAP 8000:IF L$(2,2)<>":" THEN IF L$(3,3)<>":" THEN ? "SPECIFY DEVICE!":GOTO 8000
  138. 8010 A=ZERO:IF L$(1,2)="C:" THEN A=128
  139. 8014 SRFLAG=C:? "*** LOADING INTO BUFFER ***":OBJ=0
  140. 8015 ADDR=BUFF:TRAP 8080:FILE$=L$:OPEN #FILE,4,A,FILE$
  141. 8020 IF TRN THEN 8050
  142. 8030 GET #FILE,A:POKE ADDR,A:ADDR=ADDR+1:IF A>ZERO AND A<255 THEN OBJ=1
  143. 8050 POKE 1536,OBJ
  144. 8060 C=USR(1537,ADDR):BYTES=C-BUFF:BYTE=((BYTES/128)-INT(BYTES/128))*128
  145. 8065 IF PEEK(195)<>136 THEN ? "*** ERROR ";PEEK(195):GOTO 8085
  146. 8070 FOR A=C TO C+127-BYTE:POKE A,BYTE:NEXT A:C=A:BYTES=C-BUFF:GOTO 8090
  147. 8080 ? CHR$(253);"*** FILE NOT FOUND ***"
  148. 8085 SRFLAG=ZERO:L$=""
  149. 8090 TRAP 40000:GOTO MENU
  150. 9000 TRM=32-TRM
  151. 9010 GOSUB IO:GOTO MENU
  152. 9900 BAUD=BAUD+1:IF BAUD>10 THEN BAUD=8
  153. 9910 IF BAUD<10 THEN ? 300*(BAUD-7);
  154. 9920 IF BAUD=10 THEN ? 1200;
  155. 9930 ? " BAUD":GOTO MENU
  156. 10000 C=FRE(0)-400:DIM BUFF$(C),IO$(170):BUFF=ADR(BUFF$):ADDR=BUFF
  157. 10005 ZERO=0:WON=1:SOH=1:EOT=4:ACK=6
  158. 10010 BEL=7:BS=8:LF=10:VT=11:CR=13
  159. 10020 NAK=21:CAN=24:EOF=26:EOL=ZERO
  160. 10030 KEY=1:FILE=2:PTR=3:MODEM=4
  161. 10040 DIM C$(1),FILE$(15),L$(130)
  162. 10050 MENU=1000:TERM=1050:PLX=0
  163. 10060 ERRTRY=10:CON=53279:IO=14000
  164. 10070 OPEN #KEY,4,ZERO,"K:"
  165. 10080 BAUD=8:GRAPHICS ZERO:? 
  166. 10120 XIO 34,#MODEM,192,ZERO,"R1:"
  167. 10130 XIO 36,#MODEM,BAUD,ZERO,"R1:"
  168. 10180 BUFF$(1)=" ":BUFF$(C)=" "
  169. 10190 BUFF$(2,LEN(BUFF$))=BUFF$
  170. 11000 ? "        ATARI MODEM VER. 4.2"
  171. 11010 ? " COPYRIGHT(C) 1982 JIM STEINBRECHER"
  172. 11020 ? "         37220 TRICIA DRIVE"
  173. 11030 ? "       STERLING HTS MI. 48077"
  174. 11040 ? :? "  BUFFER= ";C;" BYTES, ";INT(C/128);" SECTORS":? 
  175. 11050 ? "  WITH  WARD CHRISTENSEN'S  XMODEM"
  176. 11060 ? "       FILE TRANSFER PROTOCOL"
  177. 11070 ? "   FOR USE ON  ASCII CP/M SYSTEMS"
  178. 11080 ? :? "    ATARI TO ATARI FILE TRANSFER"
  179. 11090 ? "     AND SELECTED ATARI SYSTEMS"
  180. 12000 FOR C=1536 TO 1736:READ A:POKE C,A:NEXT C
  181. 12010 FOR C=1 TO 152:READ A:IO$(C)=CHR$(A):NEXT C
  182. 12020 POKE 704,MSAVE:POKE 705,PLX
  183. 12030 GOTO MENU
  184. 13000 TRAP 13000:TRAN=TRN
  185. 14000 CLOSE #MODEM:CLOSE #PTR:CLOSE #FILE
  186. 14005 XIO 36,#MODEM,BAUD,ZERO,"R1:"
  187. 14010 XIO 38,#MODEM,TRAN,ZERO,"R1:"
  188. 14020 OPEN #MODEM,13,ZERO,"R1:"
  189. 14030 XIO 40,#MODEM,ZERO,ZERO,"R1:"
  190. 14040 POKE 712,TRN*4.1:POKE 707,0:POKE 766,ZERO
  191. 14050 TRAP 40000:RETURN 
  192. 15000 DATA 1,104,104,133,213,104,133,212,162,32,169,7,157,66,3,169,0,157,72,3
  193. 15010 DATA 157,73,3,32,86,228,48,40,160,0,145,212,173,0,6,201,1,208
  194. 15020 DATA 20,177,212,201,155,208,14,169,13,145,212,230,212,208,2,230,213,169,10,145
  195. 15030 DATA 212,230,212,208,2,230,213,24,144,196,132,195,96,74,68,83
  196. 15040 DATA 104,104,133,204,104,133,203,104,133,206,104,133,205,162,32,169,11,157,66,3
  197. 15050 DATA 169,0,157,72,3,157,73,3,160,0,173,0,6,201,1,208,26,177,203,201
  198. 15060 DATA 13,208,20,160,1,177,203,201,10,208,12,160,0,230,203,208,2,230,204,169
  199. 15070 DATA 155,145,203,160,0,177,203,32,86,228,230,203,208,2,230,204,165,203,197,205
  200. 15080 DATA 208,187,165,204,197,206,208,181,96
  201. 15090 DATA 169,13,157,66,3,76,86,228,169,7,32,189,6,76,86,228
  202. 15100 DATA 168,169,11,32,189,6,152,76,86,228,157,66,3,169,0,157,72,3,157,73,3,96
  203. 16000 DATA 104,104,133,213,104,133,212,104,133,215,104,133,214
  204. 16010 DATA 162,64,32,163,6,173,235,2,201,0,240,68,162,64,32,171,6
  205. 16020 DATA 172,200,2,192,0,208,16,201,7,208,2,169,253,201,8,208,2,169,126
  206. 16030 DATA 201,32,144,20,172,192,2,240,10,162,0,129,212,230,212,208,2,230,213,162,0,32,179,6
  207. 16040 DATA 165,215,197,213,208,190,165,214,197,212,208,184,169,8,141,194,2,96
  208. 16060 DATA 240,176,173,252,2,201,255,240,41,162,16,32,171,6,172,193,2,192
  209. 16070 DATA 0,240,5,162,0,32,179,6,172,200,2,192,0,208,12,201,253,208,2
  210. 16080 DATA 169,7,201,126,208,2,169,8,162,64,32,179,6,173,31,208,201,7
  211. 16090 DATA 16,199,141,194,2,96
  212.