home *** CD-ROM | disk | FTP | other *** search
GW-BASIC | 1985-05-09 | 2.6 KB | 115 lines |
- 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
- 15 FOR I= 1 TO 10: KEY I,"": NEXT
- 20 ON KEY(10) GOSUB 11000
- 30 ON KEY(9) GOSUB 11500
- 99 '
- 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
- 110 DATA Y,Z,Q,-,-,5,4,-,3,-,-,-,2,as,-,ar,-,-,-,-,1,6,bt,/,-
- 130 DATA -,-,-,-,7,-,-,-,8,-,9,0,-,-,-,-,-,sk,-,-,-,-,-,-,?
- 140 DATA -,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-
- 141 '
- 1000 GOSUB 14000
- 1010 GOTO 12000
- 9000 C=250
- 9997 '
- 9998 ' This is the receive routine. <B> is timer variable; <C> is dah length; <DA> is dash decode; <DO> is dot decode.
- 9999 '
- 10000 KEY(10) ON
- 10005 A=INP(&H3FE) AND 128
- 10010 IF A=0 THEN 10005
- 10020 B=0
- 10030 A=INP(&H3FE) AND 128: B=B+10
- 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
- 10050 IF B<(0.5*C) THEN 10030
- 10060 DO=2*DO:DA=2*DA:DA=DA+1
- 10070 A=INP(&H3FE) AND 128: B=B+10
- 10080 IF A THEN GOTO 10070
- 10090 C=((4*C)+B)/5
- 10100 B=0
- 10110 A=INP(&H3FE) AND 128
- 10120 B=B+10
- 10130 IF A THEN GOTO 10020
- 10140 IF B<(0.5*C) THEN GOTO 10110
- 10145 KEY(10) OFF
- 10150 GOSUB 10220
- 10155 KEY(10) ON
- 10160 A=INP(&H3FE) AND 128
- 10170 B=B+10
- 10180 IF A THEN GOTO 10020
- 10190 IF B<(2*C) THEN GOTO 10160
- 10200 PRINT " ";
- 10210 GOTO 10005
- 10219 '
- 10220 DA=DA*2
- 10230 D=DA+DO
- 10240 IF D>100 THEN D=100
- 10250 PRINT A$(D);
- 10260 DA=0:DO=0
- 10270 RETURN
- 10997 '
- 10998 ' key(10) interrupt subroutine
- 10999 '
- 11000 KEY(10) OFF: KEY(9) OFF: F9 = FALSE: RETURN 12000
- 11497 '
- 11498 ' F9 subroutine
- 11499 '
- 11500 XSCR=POS(0): YSCR=CSRLIN: LOCATE 25,1,1
- 11510 IF F9 THEN 11600
- 11515 F9=TRUE
- 11520 COLOR 0,7: PRINT " <F9> active ";: COLOR 7,0: LOCATE YSCR,XSCR
- 11530 RETURN
- 11540 '
- 11600 F9=FALSE
- 11610 COLOR 0,7: PRINT " ";:COLOR 7,0: LOCATE YSCR,XSCR
- 11620 RETURN
- 11997 '
- 11998 ' Menu routine
- 11999 '
- 12000 CLS: PRINT" *** MENU ***": PRINT: PRINT
- 12010 PRINT" <F1> -- Receive"
- 12020 PRINT" <F2> -- Reserved"
- 12030 PRINT" <F3> -- Exit to BASIC"
- 12040 PRINT" <F4> -- Exit to DOS"
- 12050 PRINT" <F5> -- Help"
- 12060 PRINT: PRINT: PRINT " Your choice ? ";: LOCATE ,,1
- 12070 CHOICE$=INKEY$
- 12080 IF LEN(CHOICE$) < 2 THEN 12070
- 12090 ROUTINE = INSTR(";<=>?",MID$(CHOICE$,2))
- 12095 PRINT ROUTINE
- 12100 ON ROUTINE GOTO 13000,12000,13100,13200,13300
- 12105 GOTO 12000
- 12110 '
- 12998 ' goto receive routine
- 12999 '
- 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
- 13099 '
- 13100 CLS: END
- 13199 '
- 13200 CLS: SYSTEM
- 13299 '
- 13300 CLS
- 13310 OPEN "cwhelp" FOR INPUT AS #1
- 13320 WHILE NOT EOF(1)
- 13330 LINE INPUT#1, HELP$
- 13340 PRINT HELP$
- 13350 WEND
- 13360 CLOSE
- 13365 PRINT: COLOR 31,0: PRINT"Any key": COLOR 7,0
- 13367 WAIT.$=INKEY$: IF WAIT.$="" THEN 13367
- 13370 GOTO 12000
- 13999 '
- 14000 PRINT: PRINT: PRINT
- 14005 COLOR 15,0
- 14010 PRINT" KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
- 14020 PRINT" OPEN CW RECEIVE PROGRAM OPEN"
- 14030 PRINT" OPEN by AA4L OPEN"
- 14040 PRINT" OPEN Bob Johnson OPEN"
- 14050 PRINT" OPEN OPEN"
- 14060 PRINT" OPEN Version 1.0 OPEN"
- 14070 PRINT" OPEN 04/09/83 OPEN"
- 14080 PRINT" OPEN Public Domain OPEN"
- 14090 PRINT" SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
- 14100 COLOR 7,0
- 14105 FOR I=1 TO 5000: NEXT
- 14110 RETURN
-