10 REM AMODEM4.BAS:VER 4.2; 11-24-82 20 GOTO 10000 1000 TRAP 1000:GOSUB 13000:? :? " OPTION = TOGGLE MEMORY SAVE" 1010 ? " SELECT = (ABORT,B,C,D,M,P,R,S,T,U)" 1020 ? " START = START TRANSMISSION" 1030 SETCOLOR 2,7,2:C$=CHR$(SRFLAG):IF SRFLAG=ZERO THEN C$=" ":FILE$=C$ 1040 ? C$;" FILE = ";FILE$:? 1042 IF NOT TRN THEN ? "*** ASCII"; 1044 IF TRN THEN ? "*** ATARI"; 1046 ? " TERMINAL MODE ***" 1050 ADDR=USR(ADR(IO$),ADDR,LEN(BUFF$)+ADDR-1) 1055 C=PEEK(706):IF C=8 THEN PUT #MODEM,19:? "*** BUFFER FULL ***":GOTO 1700 1200 IF C=6 THEN 5000 1210 IF C=5 THEN 6000 1220 IF C<>3 OR SRFLAG<>67 THEN GOTO TERM 1230 MSAVE=WON-MSAVE:POKE 704,MSAVE:? :? "Capture "; 1240 IF MSAVE THEN SETCOLOR 2,0,2:? "On "; 1250 IF NOT MSAVE THEN SETCOLOR 2,7,2:? "Off "; 1260 ? ADDR-BUFF;" BYTES" 1270 IF PEEK(CON)=3 THEN 1270 1280 GOTO TERM 1500 ? :? "*** NEW CAPTURE FILE ***" 1510 ? "*** SELECT D WILL SAVE IT!***" 1520 ADDR=BUFF:GOSUB 13000 1530 SETCOLOR 2,0,2:POKE 766,1 1540 MSAVE=1:POKE 704,MSAVE:GOTO TERM 1700 ? :CLOSE #MODEM:IF ADDR<=BUFF THEN ? "*** BUFFER IS EMPTY ***":GOTO 1760 1710 TRAP 1760:? "*** SAVING MEMORY ***" 1720 OPEN #FILE,8,ZERO,FILE$ 1730 OBJ=1:IF TRN THEN OBJ=0 1740 POKE 1536,OBJ 1750 C=USR(1610,BUFF,ADDR) 1760 MSAVE=ZERO:POKE 704,MSAVE:ADDR=BUFF:L$="" 1790 SRFLAG=ZERO:GOTO MENU 2000 TRAN=32:GOSUB IO:A=NAK:POKE 766,1 2010 SETCOLOR 2,4,2:BLOCK=ZERO 2020 ? :? "*** RECEIVING ";FILE$;" ***" 2300 POKE 77,ZERO:FOR TRY=WON TO ERRTRY-WON 2310 ? :? "*** GETTING SECTOR ";BLOCK+WON;"/";TRY;" ***" 2315 IF PEEK(CON)=5 THEN A=CAN 2320 PUT #MODEM,A:A=ACK 2330 GET #MODEM,SH:SUM=SH:IF SH=EOT OR SH=CAN THEN 2380 2340 GET #MODEM,C:SUM=SUM+C:GET #MODEM,C:SUM=SUM+C 2350 ADDR=BLOCK*128+BUFF:FOR BLK=0 TO 127:GET #MODEM,C:POKE ADDR+BLK,C:? CHR$(C);:SUM=SUM+C:NEXT BLK 2360 GET #MODEM,C:SUM=ASC(CHR$(SUM)):IF C=SUM THEN 2380 2370 A=NAK:FOR C=WON TO 400:NEXT C:GOTO 2390 2380 TRY=ERRTRY 2390 NEXT TRY:BLOCK=BLOCK+1 2500 IF SH=EOT AND A=ACK THEN 2800 2510 IF SH=CAN OR A<>ACK THEN 2900 2530 GOTO 2300 2800 PUT #MODEM,ACK:? :? "*** SAVING FILE ***":TRAP 2860 2805 C=PEEK(ADDR+127) 2810 FOR A=ADDR+C TO ADDR+127:IF PEEK(A)<>C THEN C=128 2812 NEXT A:ADDR=ADDR+C:CLOSE #MODEM 2820 OBJ=ZERO:A=PEEK(BUFF):IF A>ZERO AND A<255 THEN OBJ=WON 2825 A=ZERO:IF FILE$(1,1)="C" AND OBJ=ZERO THEN A=128 2830 IF TRN THEN OBJ=ZERO 2840 POKE 1536,OBJ:POKE 195,WON:? "*** ";ADDR-BUFF;" BYTES" 2850 OPEN #FILE,8,A,FILE$:C=USR(1610,BUFF,ADDR) 2860 GOTO 2990 2900 ? :? "*** UNABLE TO RECEIVE FILE":A=NAK 2910 PUT #MODEM,CAN 2990 SRFLAG=ZERO:GOTO MENU 3000 TRAN=32:GOSUB IO:POKE 766,1 3010 SETCOLOR 2,WON,2:BLOCK=ZERO:BYTE=BYTES 3020 ? :? "*** SENDING ";FILE$;" ***" 3300 POKE 77,ZERO:FOR TRY=WON TO ERRTRY 3310 ? :? "*** SENDING SECTOR ";BLOCK+WON;"/";TRY;" ***" 3320 PUT #MODEM,SOH:SUM=ZERO 3330 PUT #MODEM,BLOCK+WON 3340 PUT #MODEM,254-BLOCK 3350 ADDR=BLOCK*128+BUFF:FOR BLK=0 TO 127:C=PEEK(ADDR+BLK):PUT #MODEM,C:? CHR$(C);:SUM=SUM+C:NEXT BLK 3360 SUM=ASC(CHR$(SUM)):PUT #MODEM,SUM 3370 GET #MODEM,A:IF A=CAN OR PEEK(CON)=5 THEN 3900 3380 IF A<>ACK THEN 3400 3390 TRY=ERRTRY 3400 NEXT TRY:BLOCK=BLOCK+1 3500 IF A<>ACK THEN 3900 3510 BYTE=BYTE-128:IF BYTE>ZERO THEN 3300 3800 PUT #MODEM,EOT:PUT #MODEM,ZERO 3810 ? :? "*** TRANSFER COMPLETE ***" 3820 GOTO 3990 3900 ? :? "*** UNABLE TO SEND FILE ***" 3910 PUT #MODEM,CAN 3990 GOTO MENU 4000 ? :CLOSE #MODEM 4010 FOR C=49 TO 52 4020 L$="D1:*.*":L$(2,2)=CHR$(C) 4030 TRAP 4060:OPEN #FILE,6,ZERO,L$:? L$:TRAP 4050 4040 INPUT #FILE;L$:? L$:GOTO 4040 4050 PRINT 4060 TRAP 4065:CLOSE #FILE 4065 IF DR=WON THEN 4080 4070 NEXT C 4080 DR=ZERO:L$="":GOTO MENU 4500 POKE 766,WON:SETCOLOR 2,2,2:? :? "*** UPLOADING ";FILE$;" ***" 4510 FOR I=BUFF TO BUFF+BYTES-129+BYTE 4520 PUT #MODEM,PEEK(I):IF PEEK(CON)=5 THEN ? :? "*** ABORTED ***":GOTO 4550 4530 STATUS #MODEM,C:BLK=PEEK(747):IF BLK THEN FOR A=WON TO BLK:GET #MODEM,C:? CHR$(C);:NEXT A 4540 NEXT I 4550 FOR I=1 TO 100:NEXT I 4560 STATUS #MODEM,C:IF PEEK(747) THEN GET #MODEM,C:? CHR$(C);:GOTO 4560 4570 ? :? "*** UPLOAD COMPLETE ***":GOTO MENU 5000 IF SRFLAG=67 THEN 1500 5010 IF SRFLAG=82 THEN 2000 5020 IF SRFLAG=83 THEN 3000 5030 IF SRFLAG=85 THEN 4500 5040 ? :? "*** MUST SELECT FIRST! ***" 5050 IF PEEK(CON)<>7 THEN 5040 5060 GOTO TERM 6000 ? :? " Baud, Capture, Dump, Menu or 1-4,":? " duPlex, Receive, Send,":? " Translation, Upload ?"; 6010 CLOSE #MODEM:GET #KEY,C:C$=CHR$(C):? C$ 6012 IF C$="B" THEN 9900 6015 IF C$="C" THEN 7000 6020 IF C$="D" THEN 1700 6025 IF C$="U" THEN 8000 6030 IF C$="M" THEN 4000 6035 IF C$="R" THEN 7000 6040 IF C$="S" THEN 8000 6045 IF C$="T" THEN TRN=32-TRN:IF SRFLAG>82 THEN SRFLAG=ZERO 6050 IF C$="P" THEN PLX=1-PLX:POKE 705,PLX 6055 DR=0:IF C>48 AND C<53 THEN DR=WON:GOTO 4020 6060 GOTO MENU 7000 SRFLAG=ZERO:MSAVE=ZERO:? :? "*** RECEIVE FILESPEC "; 7010 INPUT L$:IF L$="" THEN 7090 7015 TRAP 7000:IF L$(2,2)<>":" THEN IF L$(3,3)<>":" THEN ? "SPECIFY DEVICE!":GOTO 7000 7020 FILE$=L$:IF L$(1,1)<>"D" THEN 7080 7030 TRAP 7080:OPEN #FILE,4,ZERO,FILE$ 7040 ? :? "*** HAVE FILE ";FILE$ 7050 ? "*** Type (Y) to ERASE ";FILE$;" "; 7060 GET #KEY,A:? CHR$(A):IF A<>89 THEN L$="":GOTO 7090 7070 CLOSE #FILE:XIO 36,#FILE,ZERO,ZERO,FILE$:XIO 33,#FILE,ZERO,ZERO,FILE$ 7080 SRFLAG=C:ADDR=BUFF 7090 TRAP 40000:GOTO MENU 8000 SRFLAG=ZERO:? :? "*** SEND FILESPEC ";:INPUT L$:IF L$="" THEN 8090 8005 TRAP 8000:IF L$(2,2)<>":" THEN IF L$(3,3)<>":" THEN ? "SPECIFY DEVICE!":GOTO 8000 8010 A=ZERO:IF L$(1,2)="C:" THEN A=128 8014 SRFLAG=C:? "*** LOADING INTO BUFFER ***":OBJ=0 8015 ADDR=BUFF:TRAP 8080:FILE$=L$:OPEN #FILE,4,A,FILE$ 8020 IF TRN THEN 8050 8030 GET #FILE,A:POKE ADDR,A:ADDR=ADDR+1:IF A>ZERO AND A<255 THEN OBJ=1 8050 POKE 1536,OBJ 8060 C=USR(1537,ADDR):BYTES=C-BUFF:BYTE=((BYTES/128)-INT(BYTES/128))*128 8065 IF PEEK(195)<>136 THEN ? "*** ERROR ";PEEK(195):GOTO 8085 8070 FOR A=C TO C+127-BYTE:POKE A,BYTE:NEXT A:C=A:BYTES=C-BUFF:GOTO 8090 8080 ? CHR$(253);"*** FILE NOT FOUND ***" 8085 SRFLAG=ZERO:L$="" 8090 TRAP 40000:GOTO MENU 9000 TRM=32-TRM 9010 GOSUB IO:GOTO MENU 9900 BAUD=BAUD+1:IF BAUD>10 THEN BAUD=8 9910 IF BAUD<10 THEN ? 300*(BAUD-7); 9920 IF BAUD=10 THEN ? 1200; 9930 ? " BAUD":GOTO MENU 10000 C=FRE(0)-400:DIM BUFF$(C),IO$(170):BUFF=ADR(BUFF$):ADDR=BUFF 10005 ZERO=0:WON=1:SOH=1:EOT=4:ACK=6 10010 BEL=7:BS=8:LF=10:VT=11:CR=13 10020 NAK=21:CAN=24:EOF=26:EOL=ZERO 10030 KEY=1:FILE=2:PTR=3:MODEM=4 10040 DIM C$(1),FILE$(15),L$(130) 10050 MENU=1000:TERM=1050:PLX=0 10060 ERRTRY=10:CON=53279:IO=14000 10070 OPEN #KEY,4,ZERO,"K:" 10080 BAUD=8:GRAPHICS ZERO:? 10120 XIO 34,#MODEM,192,ZERO,"R1:" 10130 XIO 36,#MODEM,BAUD,ZERO,"R1:" 10180 BUFF$(1)=" ":BUFF$(C)=" " 10190 BUFF$(2,LEN(BUFF$))=BUFF$ 11000 ? " ATARI MODEM VER. 4.2" 11010 ? " COPYRIGHT(C) 1982 JIM STEINBRECHER" 11020 ? " 37220 TRICIA DRIVE" 11030 ? " STERLING HTS MI. 48077" 11040 ? :? " BUFFER= ";C;" BYTES, ";INT(C/128);" SECTORS":? 11050 ? " WITH WARD CHRISTENSEN'S XMODEM" 11060 ? " FILE TRANSFER PROTOCOL" 11070 ? " FOR USE ON ASCII CP/M SYSTEMS" 11080 ? :? " ATARI TO ATARI FILE TRANSFER" 11090 ? " AND SELECTED ATARI SYSTEMS" 12000 FOR C=1536 TO 1736:READ A:POKE C,A:NEXT C 12010 FOR C=1 TO 152:READ A:IO$(C)=CHR$(A):NEXT C 12020 POKE 704,MSAVE:POKE 705,PLX 12030 GOTO MENU 13000 TRAP 13000:TRAN=TRN 14000 CLOSE #MODEM:CLOSE #PTR:CLOSE #FILE 14005 XIO 36,#MODEM,BAUD,ZERO,"R1:" 14010 XIO 38,#MODEM,TRAN,ZERO,"R1:" 14020 OPEN #MODEM,13,ZERO,"R1:" 14030 XIO 40,#MODEM,ZERO,ZERO,"R1:" 14040 POKE 712,TRN*4.1:POKE 707,0:POKE 766,ZERO 14050 TRAP 40000:RETURN 15000 DATA 1,104,104,133,213,104,133,212,162,32,169,7,157,66,3,169,0,157,72,3 15010 DATA 157,73,3,32,86,228,48,40,160,0,145,212,173,0,6,201,1,208 15020 DATA 20,177,212,201,155,208,14,169,13,145,212,230,212,208,2,230,213,169,10,145 15030 DATA 212,230,212,208,2,230,213,24,144,196,132,195,96,74,68,83 15040 DATA 104,104,133,204,104,133,203,104,133,206,104,133,205,162,32,169,11,157,66,3 15050 DATA 169,0,157,72,3,157,73,3,160,0,173,0,6,201,1,208,26,177,203,201 15060 DATA 13,208,20,160,1,177,203,201,10,208,12,160,0,230,203,208,2,230,204,169 15070 DATA 155,145,203,160,0,177,203,32,86,228,230,203,208,2,230,204,165,203,197,205 15080 DATA 208,187,165,204,197,206,208,181,96 15090 DATA 169,13,157,66,3,76,86,228,169,7,32,189,6,76,86,228 15100 DATA 168,169,11,32,189,6,152,76,86,228,157,66,3,169,0,157,72,3,157,73,3,96 16000 DATA 104,104,133,213,104,133,212,104,133,215,104,133,214 16010 DATA 162,64,32,163,6,173,235,2,201,0,240,68,162,64,32,171,6 16020 DATA 172,200,2,192,0,208,16,201,7,208,2,169,253,201,8,208,2,169,126 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 16040 DATA 165,215,197,213,208,190,165,214,197,212,208,184,169,8,141,194,2,96 16060 DATA 240,176,173,252,2,201,255,240,41,162,16,32,171,6,172,193,2,192 16070 DATA 0,240,5,162,0,32,179,6,172,200,2,192,0,208,12,201,253,208,2 16080 DATA 169,7,201,126,208,2,169,8,162,64,32,179,6,173,31,208,201,7 16090 DATA 16,199,141,194,2,96