Updated documentation theme. Fixed broken link.
[qbasicapps.git] / networking / lptmorse.bas
1 ' Svjatoslav Agejenko\r
2 ' 2003.02\r
3 \r
4 ' Program to control radio transmitter over LPT port,\r
5 ' and send data in morse like code.\r
6 \r
7 \r
8 DECLARE SUB sbit (a!)\r
9 DECLARE SUB msg (a$)\r
10 DECLARE SUB sb (a!)\r
11 DECLARE SUB quit ()\r
12 DECLARE SUB tone (c!)\r
13 DECLARE SUB wai (a!)\r
14 DECLARE SUB echo ()\r
15 DECLARE SUB lptsend ()\r
16 DIM SHARED bit(0 TO 7)\r
17 DIM SHARED prt\r
18 \r
19 CLS\r
20 prt = &H378\r
21 echo\r
22 \r
23 l = 0\r
24 1\r
25 IF lt$ <> TIME$ THEN\r
26 IF l > 60 THEN echo: l = 0\r
27 l = l + 1\r
28 lt$ = TIME$\r
29 END IF\r
30 \r
31 a$ = INKEY$\r
32 IF a$ <> "" THEN quit\r
33 GOTO 1\r
34 \r
35 SUB echo\r
36 \r
37 bit(5) = 1\r
38 lptsend\r
39 wai 5\r
40 \r
41 msg "Hello!"\r
42 'msg "Hello, world!"\r
43 \r
44 wai 1\r
45 bit(5) = 0\r
46 lptsend\r
47 \r
48 \r
49 \r
50 END SUB\r
51 \r
52 SUB lptsend\r
53 'DIM SHARED bit(0 TO 7)\r
54 \r
55 b = 0\r
56 FOR a = 0 TO 7\r
57 b = b * 2\r
58 IF bit(a) > 0 THEN b = b + 1\r
59 NEXT a\r
60 \r
61 OUT prt, b\r
62 \r
63 END SUB\r
64 \r
65 SUB msg (a$)\r
66 \r
67 FOR a = 1 TO LEN(a$)\r
68 b$ = RIGHT$(LEFT$(a$, a), 1)\r
69 sb ASC(b$)\r
70 c$ = INKEY$\r
71 IF c$ <> "" THEN quit\r
72 NEXT a\r
73 \r
74 \r
75 END SUB\r
76 \r
77 SUB quit\r
78 bit(5) = 0\r
79 lptsend\r
80 END\r
81 END SUB\r
82 \r
83 SUB sb (a)\r
84 d = a\r
85 c = 128\r
86 \r
87 FOR b = 0 TO 7\r
88 IF d >= c THEN sbit 1: d = d - c:  ELSE sbit 0\r
89 c = c / 2\r
90 NEXT b\r
91 \r
92 END SUB\r
93 \r
94 SUB sbit (a)\r
95 IF a = 1 THEN\r
96   tone 0\r
97   tone 0\r
98   tone 1\r
99 ELSE\r
100   tone 0\r
101   tone 1\r
102   tone 1\r
103 END IF\r
104 END SUB\r
105 \r
106 SUB tone (c)\r
107 'c = 1\r
108 PRINT c;\r
109 FOR a = 1 TO 40\r
110 bit(4) = c\r
111 lptsend\r
112 FOR b = 1 TO 500\r
113 NEXT b\r
114 bit(4) = 0\r
115 lptsend\r
116 FOR b = 1 TO 500\r
117 NEXT b\r
118 NEXT a\r
119 END SUB\r
120 \r
121 SUB wai (a)\r
122 FOR b = 1 TO a * 10\r
123 SOUND 0, .1\r
124 NEXT b\r
125 \r
126 END SUB\r
127 \r