home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
MBUG
/
MBUG011.ARC
/
TIMER.BAS
< prev
next >
Wrap
BASIC Source File
|
1979-12-31
|
6KB
|
177 lines
1 REM BASICODE 2 ROUTINES BY HENK WEVERS. FURTHER INFORMATION ABOUT BASICODE
3 REM NOS, HOBBYSCOOP HILVERSUM. TRANSLATED FROM DUTCH BY:
5 REM Joe Schramp,
6 REM for use by UBUG Australia.
9 PRINT CHR$(26);:WIDTH(255)
10 GOTO 1000
20 GOTO 1010
100 PRINT CHR$(26);:RETURN
110 REM
111 IF HO>51 THEN HO=51
112 IF VE>23 THEN VE=23
113 PRINT CHR$(27);"=";CHR$(VE+32);CHR$(HO+32);
115 RETURN
120 HO=PEEK(&HEF5A):VE=PEEK(&HEF5B)-&HF0
121 VE=VE*2
122 IF HO>127 THEN HO=HO-128:VE=VE+1
123 VE=VE-PEEK(&HEF62):IF VE<0 THEN VE=32+VE
124 RETURN
200 IN$=INKEY$:RETURN
210 GOSUB 200:IF IN$="" THEN 210
211 RETURN
250 PRINT CHR$(7);:RETURN
260 RV=RND(1):RETURN
270 FR=FRE(2):RETURN
300 SR$=STR$(SR)
301 Q7=LEN(SR$):IF Q7=0 THEN RETURN
302 IF RIGHT$(SR$,1)<>" " THEN 304
303 SR$=LEFT$(SR$,Q7-1):GOTO 301
304 IF LEFT$(SR$,1)<>" " THEN RETURN
305 SR$=RIGHT$(SR$,Q7-1):GOTO 301
310 Q4=SR:IF CN<>0 THEN 316
312 SR=INT(SR+.5):GOSUB 300:GOTO 330
316 Q5=SGN(SR):SR=ABS(SR):Q8=INT(SR):Q9=SR-Q8
318 FOR Q6=1 TO CN:Q9=Q9*10:NEXT Q6
320 Q9=INT(Q9+.5):SR=Q9:GOSUB 300
322 Q9$=RIGHT$("00000000000000000000"+SR$,CN)
324 IF Q8=0 AND Q9=0 THEN Q5=1
326 SR=Q8:GOSUB 300:IF Q5=-1 THEN SR$="-"+SR$
328 SR$=SR$+"."+Q9$
330 IF LEN(SR$)<=CT THEN 334
332 SR$=LEFT$("********************",CT):GOTO 340
334 SR$=RIGHT$(" "+SR$,CT)
340 SR=Q4:RETURN
350 L PRINT SR$;:RETURN
360 L PRINT:RETURN
1000 A=500:GOTO 20
1010 GOTO 6000
1020 GOSUB 100:GOSUB 5000
1030 PRINT " Astable multivibrator":PRINT
1040 GOSUB 3000:PRINT:PRINT:GOSUB 4000
1170 GOSUB 100:GOSUB 5000
1180 PRINT " Give the required duty-cycle from the"
1190 PRINT " Output at point 3. this"
1200 PRINT " must be between 50% en 100%."
1210 HO=3:VE=9:GOSUB 110
1220 PRINT "Duty-cycle in % ";
1240 INPUT D
1250 IF D>0 THEN 1280
1260 PRINT "* Duty-cycle is not allowed to be negative! *";
1270 GOTO 1210
1280 IF D>50 THEN 1310
1290 PRINT "* pick a duty-cycle larger than 50% ! * ";
1300 GOTO 1210
1310 IF D<100 THEN 1340
1320 PRINT "* Make duty-cycle smaller than 100% ! * "
1330 GOTO 1210
1340 D=D/100
1350 HO=1:VE=10:GOSUB 110
1360 FOR I=0 TO 1
1370 PRINT " "
1380 NEXT
1390 PRINT " Give now the required output- "
1400 PRINT " frequency. This has to be between"
1410 PRINT " 0.1 Hz en 100 kHz."
1420 HO=3:VE=16:GOSUB 110
1430 PRINT "Output Frequency in Hz ";
1450 INPUT F
1460 IF F>.1 THEN 1520
1470 PRINT "* pick frequency higher than 0.1 Hz * "
1480 GOTO 1420
1490 PRINT "* pick frequency lower than 100 Khz *"
1500 GOTO 1420
1510 GOTO 1350
1520 IF F<10 THEN C=.00001:GOTO 1560
1530 IF F<1000 THEN C=.000001:GOTO 1560
1540 IF F<100000! THEN C=1E-08:GOTO 1560
1550 GOTO 1490:REM frequency TO HIGH
1560 PRINT " "
1570 FOR I=0 TO 8:PRINT " Ok";:NEXT
1580 K1=LOG(2):K2=1/(K1*F*C)
1590 RB=K2*(1-D)
1600 RA=K2-2*RB
1610 R=RB:GOSUB 2000:RB=R1
1620 R=RA:GOSUB 2000:RA=R1
1630 GOSUB 100:GOSUB 5000:GOSUB 3000
1640 K$=""
1650 IF RA>10000 THEN R1=RA/1000:K$="kilo-"
1660 PRINT "R1=";R1;K$;"ohm"
1670 K$="":R2=RB
1680 IF RB>10000 THEN R2=RB/1000:K$="kilo-"
1690 PRINT "R2=";R2;K$;"ohm"
1700 PRINT " C=";C*1E+06;"microfarad"
1710 PRINT "frequency=";1/(K1*(RA+2*RB)*C);"Hz"
1720 PRINT "Duty cycle=";100*(RA+RB)/(RA+2*RB);"%";
1730 GOSUB 4000
1740 GOSUB 100:GOSUB 5000
1750 PRINT "This was an P2000 BASICODE program,"
1755 PRINT "Translated from Dutch by Joe Schramp,"
1756 PRINT "For MBUG AUSTRALIA INC."
1760 END
1770 :
2000 F=0:REM NOT OUTSIDE REACH
2010 K=0:REM EXPONENT COUNTER
2020 IF R<.1 THEN F=1:REM TO SMALL
2030 IF R>1E+07 THEN F=1:REM TO BIG
2040 R1=R
2050 REM LOOK FOR VALUE IN TABLE
2060 IF R1<=1 THEN 2100
2070 R1=R1/10:REM SHIFT COMMA
2080 K=K+1:REM COUNT DISPLACEMENT
2090 GOTO 2060:REM STILL WITHIN REACH ?
2100 B=1:REM POINTER TO ARRAY-START
2110 E=25:REM POINTER TO ARRAY-END
2120 M=INT((B+E)/2):REM POINTER IN THE MIDDLE OF THE USEFULL AREA
2130 IF M=B THEN 2170
2140 IF R1=A(M) THEN 2200
2150 IF R1<A(M) THEN E=M:GOTO 2120
2160 IF R1>A(M) THEN B=M:GOTO 2120
2170 IF (R1-A(B))<(A(E)-R1) THEN R1=A(B):GOTO 2190
2180 R1=A(E)
2190 REM TAKE CLOSE BY
2200 R1=R1*10^K
2210 IF R1>10 THEN R1=INT(R1+.5)
2220 RETURN
2230 :
3000 PRINT " +-----------------+"
3010 PRINT " ! !"
3020 PRINT " +5V-+-----8 3---OUTPUT"
3030 PRINT " ! ! 555 !"
3040 PRINT " +-----4 1---+--GND"
3050 PRINT " ! ! ! !"
3060 PRINT " ! +--7--------6--2--+ !"
3070 PRINT " ! ! ! ! !"
3080 PRINT " ! +----+ ! +----+ ! ! !!C !"
3090 PRINT " +-! R1 !-+-! R2 !-+--+--!!--+"
3100 PRINT " +----+ +----+ !!"
3110 RETURN
3120 :
4000 HO=15:VE=23:GOSUB 110:PRINT "\ENTER\...";:GOSUB 210
4010 RETURN
4020 :
5000 PRINT:PRINT:PRINT:PRINT:RETURN
6000 DIM A(25)
6010 FOR I=1 TO 25
6020 READ A(I)
6030 NEXT I
6040 GOSUB 100:GOSUB 5000
6050 PRINT " - - - DE ELECTRONICA DESIGNER - - -"
6060 PRINT
6070 PRINT " **** *** *** *** ***"
6080 PRINT " * * * * * * * * * *"
6090 PRINT " * * * * * * * * *"
6100 PRINT " **** * * * * * * *"
6110 PRINT " * * * * * * * *"
6120 PRINT " * * * * * * * *"
6130 PRINT " * ***** *** *** ***"
6140 PRINT
6150 PRINT "Astable multivibrator with the NE-555."
6160 PRINT:PRINT "This program calculates the resistances"
6170 PRINT:PRINT "and the capacitor values in the following scheme"
6180 GOSUB 4000:GOTO 1020
6190 :
30000 REM STANDARD VALUES
30010 DATA .1,.11,.12,.13,.15,.16,.18,.2
30020 DATA .22,.24,.27,.3,.33,.36,.39,.43
30030 DATA .47,.51,.56,.62,.68,.75,.82,.91,1
3120 :