PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #50)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “ROFF”
This version of ROFF, based on the formatter in Kernighan and
Plauger's book SOFTWARE TOOLS, is written in BDS C, and employs
the directed i/o functions that go along with that package.
Using ROFF, you can make nice printouts of a file, with as little
or as much help from the program as you want. There are default
values for all parameters, so if you don't put any commands in at
all, your file will come out with filled, right-justified lines.
The default line-length is 80 characters; the default page-length
is 66 lines per page. "Filled lines" means that as many input
words as possible are packed onto a line before it is printed;
"non-filled" lines go through the formatter w/o rearrangement.
"Right-justified" simply means that spaces are added between
words to make all the right margins line up nicely.
Filling out the disk are a group of solid utilities like SDIR and
REBOOT and some useful BASIC programs.
How to Start: Consult ROFF.DOC for directions and
documentation. Type ROFF <ENTER> to run. For the BASIC programs,
consult the directions in Getting Started for your configuration.
File Descriptions:
COLOR COM Allows switch to and from mono screen
MUSICBOX BAS A few tunes to while away the moment
MONO COM Allows switch to and from mono screen
FILEIO C File redirection utility
DEPREC BAS Simple depreciation
REBOOT ASM Assembly code for REBOOT
ROFF EXE ROFF text formatter
ROFF HE ROFF subprogram ROFF1
ROFF H ROFF subprogram
SDIR ASM Assembly code
SDIR COM Compiled version of directory shell
REBOOT COM Utility for special warm boots
ROFF DOC Directions on using ROFF
REBOOT EXE Executable version of REBOOT
TABLET BAS One for Moses, one for you
TICCLOCK BAS Time keeper for your PC
ROFF? C Uncompiled version of ROFF.EXE to modify.
ADDCRS BAS Adds carriage returns to downloaded files
ASCFILTR BAS Filter non-ASCII characters from files
ADDCRS.BAS
2 INPUT"INPUT THE FILENAME THAT WAS DOWNLOADED WITHOUT CR (d:filename) ",A$
4 INPUT"INPUT THE NEW NAME FOR THE DOWNLOADED FILE (d:filename) ",B$
5 ' CHANGE THE INPUT AND OUTPUT NAMES TO THE NAMES OF THE FILES YOU WANT AS
6 ' INPUT AND OUTPUT PRIMARILY USED TO COPY FILES WITH NO CARRIAGE RETURNS
7 ' IN THEM SO THAT YOU CAN EDLIN THEM CONTRIBUTED BY DON WITHROW
10 OPEN A$ FOR INPUT AS #1
20 OPEN B$ FOR OUTPUT AS #2
30 IF EOF(1) THEN 100 ELSE LINE INPUT #1, THELIN$
40 PRINT #2, THELIN$
50 GOTO 30
100 CLOSE:END
120 'This program will add Carriage Returns to a downloaded file that does
130 'not appear to have them when you try to list it using the DOS TYPE
140 'command. The file has to be a basic program, patch or subroutine.
150 'After adding CRs to the file you can then use EDLIN to remove direct
160 'statements from the file.
ASCFILTR.BAS
10 ' FILTERS NON-ASCII CHARACTERS FROM A FILE
20 ' USEFUL FOR CLEANING UP NULLS AND CONTROL CHARACTERS FROM A
30 ' TRANSMITTED FILE.
40 ' RICHARD STECK 820511
50 '
60 '
70 CLOSE
80 DEFINT A-Z
90 ON ERR GOTO 470
100 KEY OFF
110 CLS:WIDTH 80: LOCATE 12,,1
120 INPUT " ENTER NAME OF FILE TO BE FILTERED "; F1$
130 PRINT
140 INPUT " ENTER DESTINATION FILE NAME "; F2$
150 IF F1$ = F2$ THEN GOTO 110
160 PRINT: PRINT
170 PRINT TAB(10), "Source file name is: "; TAB(33); F1$
180 PRINT
190 PRINT TAB(10), "Destination file name is: ";TAB(33); F2$
200 PRINT
210 INPUT " Is that correct(Y/N/Q)? "; ANS$
220 IF (LEFT$(ANS$,1) = "Q") OR (LEFT$(ANS$,1) = "q" ) THEN STOP
230 IF NOT ((LEFT$(ANS$,1) = "Y") OR (LEFT$(ANS$,1) = "y") ) THEN GOTO 160
240 OPEN F1$ FOR INPUT AS #1
250 OPEN F2$ FOR OUTPUT AS #2
260 '
270 WHILE NOT EOF(1)
280 LINE INPUT #1,A$
290 '
300 PRINT A$ : ' DISPLAY STRING
310 GOSUB 370
320 PRINT #2,A$
330 WEND
340 CLOSE 1,2
350 STOP
360 '
370 ' FILTER OUT NULLS FROM A$
380 AA$= STRING$(255," ")
390 J = 1
400 FOR I = 1 TO LEN(A$)
410 TEST = ASC(MID$(A$,I,1))
420 IF TEST < 32 AND (TEST < 7 OR TEST > 13) THEN GOTO 430 ELSE MID$(AA$,J,1) = MID$(A$,I,1) : J = J + 1
430 NEXT I
440 A$ = LEFT$(AA$,J-1)
450 RETURN
460 '
470 PRINT : PRINT "ERROR CONDITION "; ERR; " IN LINE NO. "; ERL: PRINT : STOP
CRC.TXT
PC-SIG Disk No. #50, version v1
The following is a list of the file checksums which should be produced by
the CRCK4 program on disk #9 (and others). If the CRC numbers do not match
you may have a bad file. To use type: CRCK4 <filespec>
CRCK4 output for this disk:
CRCK ver 4.2B (MS DOS VERSION )
CTL-S pauses, CTL-C aborts
--> FILE: ROFF .EXE CRC = 72 EB
--> FILE: ROFF .DOC CRC = F4 E8
--> FILE: ROFF .H CRC = C1 12
--> FILE: ROFF .HE CRC = EF 38
--> FILE: ROFF1 .C CRC = E4 0C
--> FILE: ROFF2 .C CRC = BA 80
--> FILE: ROFF3 .C CRC = 02 BC
--> FILE: FILEIO .C CRC = 24 39
--> FILE: REBOOT .ASM CRC = 27 DE
--> FILE: REBOOT .EXE CRC = 8C F1
--> FILE: REBOOT .COM CRC = 00 00
--> FILE: SDIR .ASM CRC = DB D8
--> FILE: SDIR .COM CRC = FC 14
--> FILE: MUSICBOX.BAS CRC = 75 20
--> FILE: DEPREC .BAS CRC = 18 47
--> FILE: TABLET .BAS CRC = 8C 37
--> FILE: TICCLOCK.BAS CRC = 89 0C
--> FILE: ADDCRS .BAS CRC = 96 B2
--> FILE: ASCFILTR.BAS CRC = B9 5B
--> FILE: COLOR .COM CRC = 8C 78
--> FILE: MONO .COM CRC = A5 59
---------------------> SUM OF CRCS = 8E E1
DONE
These and other Public Domain and user-supported programs from:
PC Software Interest Group
1125 Stewart Ct Suite G
Sunnyvale, CA 94086
(408) 730-9291
DEPREC.BAS
10 REM ******************** DEPRECIATION PROGRAM ******************************
20 REM ************ REVISED FOR ECONOMIC RECOVERY ACT OF 1981 *****************
30 REM **** BY A.P GITT; POPULAR COMPUTING ,DEC. 1982, PAGE 59 **************
40 REM **** REVISED: 01/09/82 ********
50 REM **** DISK FILE NAME: DEPREC.BAS ********
60 REM **** FURTHER REVISED BY C.F. MITASIK ON 11-16-82 TO INCLUDE ********
70 REM **** 10 YEAR ACRS AND THE 15 YEAR, 175% DEPRECIATION OPTION ********
80 REM **** FOR REAL PROPERTY ********
90 REM ************************************************************************
100 REM *** NOTE: HOME COMPUTERS WOULD USUALLY BE WRITTEN OFF USING ********
110 REM *** 5 YEAR ACRS; UNLESS IT IS BEING USED FOR RESEARCH ********
120 REM *** AND DEVELOPMENT WORK IN WHICH CASE THE 3 YEAR ACRS ********
130 REM *** METHOD MAY BE USED. ********
140 REM ***********************************************************************
150 REM *** WARNING: NO GUARENTEES ARE GIVEN OR IMPLIED REGARDING ********
160 REM *** YOUR USE OF THIS PROGRAM. I ALSO TAKE NO RESPONSIBILITY ********
170 REM *** FOR THE DEPRECIATION METHOD(S) YOU CHOOSE TO USE OR FOR ********
180 REM *** WHETHER OR NOT YOUR PROPERTY IS IN FACT DEPRECIABLE. ********
190 REM *** PLEASE CONSULT A KNOWLEDGEABLE TAX SPECIALIAST FOR ********
200 REM *** ASSISTANCE ALONG THESE LINES. ********
210 REM ***********************************************************************
220 REM
230 CLEAR 2000:KEY OFF
240 DIM D(40)
250 COLOR 2,0,0:CLS:LOCATE 10,32:PRINT "TAX DEPRECIATION"
260 FOR I = 1 TO 1500:NEXT I:CLS
270 REM ****************** INPUT DATA *****************************************
280 LOCATE 2,1:INPUT "NAME OF ITEM";I$
290 A = 0:B = 0:F = 0:F1 = 0:D(1) = 0:A9$ = ""
300 DP$ = DATE$
310 PRINT "TODAYS DATE = ";DP$
320 INPUT "PURCHASE DATE (MM/DD/YY)";D$
330 INPUT "COST OF ITEM";C
340 PRINT "DO YOU WISH TO USE THE ACCELERATED COST"
350 INPUT "RECOVERY SYSTEM (ACRS)? (Y)ES OR (N)O";A9$
360 GOTO 530
370 IF YY < 81 THEN A = 1
380 INPUT "USEFUL LIFE";L
390 INPUT "DEPRECIATION RATE (NEW = 200% : USED = 150%)";R
400 R$ = STR$(R)+"%"
410 REM ******************* CALCULATE YEARLY RATE ****************************
420 YR = R/(100*L)
430 REM ****************** CALCULATE EXTRA 1ST YEAR DEPRECIATION *************
440 IF L > 6 AND YY < 81 THEN ED = 0.2*C ELSE ED = 0
450 CV = C - ED
460 REM ****************** CALCULATE INVESTMENT CREDIT ************************
470 IF L < 3 THEN IC = 0
480 IF L >= 3 THEN IC = C/30
490 IF L >= 5 THEN IC = C/15
500 IF L >= 7 THEN IC = C/10
510 GOTO 610
520 REM ***************** DETERMINE YEAR/DAY/MONTH ****************************
530 MM = VAL (LEFT$(D$,2))
540 DD = VAL (MID$(D$,4,2))
550 YY = VAL (RIGHT$(D$,2))
560 IF DD >< 15 THEN FY = 13 - MM ELSE FY = 12 - MM
570 LY = 12 - FY
580 IF YY < 81 AND A9$ = "Y" OR A9$ = "YES" THEN PRINT:PRINT "ACRS ONLY VALID "; "FOR PROPRETY PURCHASED AFTER 1980. PLEASE START AGAIN.":GOTO 280
590 IF YY < 81 OR A9$ = "N" THEN 370 ELSE 1570
600 REM ******************* FIRST YEAR DEPRECIATION **************************
610 CY = 1
620 D(CY) = CV*YR*(FY/12)
630 CV = CV - D(CY)
640 REM ******************* MIDDLE YEARS DEPRECIATION *************************
650 FOR CY = 2 TO L
660 D(CY) = YR*CV
670 CV = CV - D(CY)
680 NEXT
690 REM ******************* LAST YEAR DEPRECIATION ****************************
700 IF CY = 0 THEN 730 ELSE CY = L + 1
710 D(CY) = YR*CV*(LY/12)
720 CV = CV - D(CY)
730 REM ******************* OUTPUT TO VIDIO ***********************************
740 CLS
750 LOCATE 3,15:PRINT "DEPRECIATION ANALYSIS FOR ";I$
760 LOCATE 4,15:PRINT "DATE PREPARED: ";DP$
770 REM
780 LOCATE 6,1:PRINT "ITEM NAME: ";TAB(31);I$
790 PRINT "DATE OF PURCHASE: ";TAB(31);D$
800 PRINT "COST: ";TAB(30);C
810 PRINT "USEFULL LIFE: ";TAB(30);L
820 PRINT "DEPRECIATION RATE: ";TAB(30);R$
830 PRINT
840 CY = 1
850 Y = 1899 + YY
860 INPUT "PRESS ENTER TO CONTINUE",Z$:CLS
870 PRINT
880 IF B = 1 THEN 940
890 PRINT :PRINT " YEAR";TAB(10);"INVESTMENT CREDIT";
900 IF A = 1 AND ED >< 0 THEN PRINT TAB(35);"EXTRA FIRST YEAR DEPRECIATION"
910 IF A = 0 THEN PRINT
920 PRINT TAB(2);TY+CY;TAB(12);IC;
930 IF A = 1 AND ED >< 0 THEN PRINT TAB(39);ED ELSE PRINT CHR$(10)
940 PRINT:PRINT " YEAR";TAB(10)"DEPRECIATION":PRINT
950 IF R1 = 1 THEN 1060
960 IF F1 = 1 THEN 1000
970 IF F = 1 THEN 990
980 IF A = 1 THEN 990 ELSE 1000
990 IF LY = 0 THEN 1000 ELSE 1010
1000 LOOP = L:GOTO 1020
1010 LOOP = L + 1
1020 FOR CY = 1 TO LOOP
1030 PRINT TAB(2);TY+CY;TAB(11);:PRINT USING "######.##";D(CY)
1040 IF CY = 10 OR CY = 20 OR CY = 30 THEN PRINT:PRINT "PLEASE PRESS ENTER TO"; " CONTINUE";:INPUT " ",Z$ ELSE 1070
1050 CLS:R1 = 1:PRINT :GOTO 940
1060 R1 = 0
1070 NEXT
1080 IF CV <= 0 THEN 1120
1090 PRINT
1100 IF A = 1 THEN 1110 ELSE 1120
1110 PRINT "SALVAGE VALUE AT END OF";CY +Y-1;" IS ";CV
1120 REM ******************* PRINTOUT ROUTINE **********************************
1130 PRINT:PRINT:INPUT "DO YOU WANT A PRINTOUT";Z$
1140 IF LEFT$(Z$,1) = "Y" THEN 1150 ELSE 10
1150 POKE 16424,65:POKE 16425,0:LPRINT :LPRINT :LPRINT
1160 T = 40 - (12+((LEN(I$))/2))
1170 LPRINT TAB(T);"DEPRECIATION ANALYSIS FOR ";I$
1180 LPRINT :LPRINT TAB(32);"DATE PREPARED: ";DP$
1190 LPRINT :LPRINT TAB(6);"INPUT DATA"
1200 LPRINT TAB(6);"----------"
1210 LPRINT :LPRINT TAB(6);"DATE OF PURCHASE: ";TAB(32);D$
1220 LPRINT TAB(6);"COST OF ITEM: ";TAB(32);"$";C
1230 LPRINT TAB(6);"USEFULL LIFE: ";TAB(32);L;"YEARS"
1240 LPRINT TAB(6);"DEPRECIATION RATE: ";TAB(31);R$
1250 LPRINT
1260 LPRINT TAB(6);"DEPRECIATION CALCULATIONS"
1270 LPRINT TAB(6);"-------------------------"
1280 LPRINT
1290 Y = 1899+YY
1300 IF B = 1 THEN 1410
1310 IF A = 1 THEN LPRINT TAB(6);" YEAR";TAB(16);"INVESTMENT CREDIT";
1320 IF A = 1 AND ED >< 0 THEN LPRINT TAB(37);"EXTRA FIRST YEAR DEPRECIATION"
1330 IF F = 1 THEN LPRINT TAB(6);" YEAR";TAB(16);"INVESTMENT CREDIT"
1340 IF A = 1 THEN LPRINT TAB(6);" ----";TAB(16);"-----------------";
1350 IF A = 1 AND ED >< 0 THEN LPRINT TAB(37);"-----------------------------"
1360 IF F = 1 THEN LPRINT TAB(6);" ----";TAB(16);"-----------------"
1370 CY = 1
1380 IF A = 1 THEN LPRINT TAB(6);Y+CY;:LPRINT TAB(16)USING"$$######.##";IC;
1390 IF A = 1 AND ED >< 0 THEN LPRINT TAB(37)USING "$$######.##";ED
1400 IF F = 1 THEN LPRINT TAB(6);Y+CY;:LPRINT TAB(16)USING "$$######.##";IC
1410 LPRINT:LPRINT TAB(6);" YEAR";TAB(16);"DEPRECIATION"
1420 LPRINT TAB(6);" ----";TAB(16);"------------"
1430 IF F = 1 THEN 1470
1440 IF F = 1 THEN 1480
1450 IF A = 1 THEN 1460 ELSE 1470
1460 IF LY = 0 THEN 1470 ELSE 1480
1470 LOOP = L:GOTO 1490
1480 LOOP = L+1
1490 FOR CY = 1 TO LOOP
1500 LPRINT TAB(6);Y+CY;:LPRINT TAB(16)USING "$$######.##";D(CY)
1510 NEXT CY
1520 IF CV <= 0 THEN 1540
1530 LPRINT :LPRINT TAB(6);"SALVAGE VALUE AT END OF";CY+Y-1; " IS ";:LPRINT USING"$$######.##";CV
1540 POKE 14312,12
1550 INPUT "DO YOU WANT ANOTHER PRINTOUT ";Z$
1560 IF Z$ = "Y" THEN 1120 ELSE 10
1570 REM ****************** DETERMINE YEAR/TYPE DEPRECIATION ******************
1580 CLS:PRINT:PRINT "PLEASE SELECT TYPE OF DEDUCTION/DEPRECIATION THAT YOU "; "WANT":PRINT:PRINT
1590 PRINT TAB(10);"1 MAXIMUM SHORT TERM DEDUCTIONS/DEPRECIATION"
1600 PRINT
1610 PRINT TAB(10);"2 LONG TERM DEPRECIATION"
1620 PRINT:PRINT
1630 INPUT "PLEASE ENTER THE NUMBER OF YOUR SELECTION: ",Z7
1640 IF YY = 81 THEN 1690
1650 IF YY = 82 OR YY = 83 THEN 1720
1660 IF YY = 84 OR YY = 85 THEN 1820
1670 IF YY > 85 THEN 1930
1680 REM ********************* 1981 DEPRECIATION ******************************
1690 ED = 0:C1 = C
1700 IF Z7 = 1 THEN 2170 ELSE 2580
1710 ************************* 1982/83#EPRECIATION ***************************
1720 ED = 0:C1 = 0
1730 IF Z7 = 1 THEN 1740 ELSE 2580
1740 IF C > 5000 THEN D(1) = 5000 ELSE 1780
1750 IF C > 5000 THEN C1 = C
1760 IF C > 5000 THEN C = C - 5000
1770 GOTO 2170
1780 R$ = " 100% WRITE OFF"
1790 IF C < 5001 THEN D(1) = C
1800 B = 1
1810 GOTO 730
1820 REM ********************* 1984/85 DEPRECIATION ***************************
1830 ED = 0:C1 = C
1840 IF Z7 = 1 THEN 1850 ELSE 2580
1850 IF C > 7500 THEN D(1) = 7500 ELSE 1890
1860 IF C > 7500 THEN C1 = C
1870 IF C > 7500 THEN C = C - 7500
1880 B = 1:GOTO 2170
1890 IF C < 7501 THEN D(1) = C ELSE 2170
1900 R$ = " 100$ WRITE OFF"
1910 B = 1
1920 GOTO 730
1930 REM ********************** 1986 AND BEYOND DEPRECIATION ******************
1940 ED = 0:C1 = C
1950 IF Z7 = 1 THEN 1960 ELSE 2580
1960 IF C > 10000 THEN D(1) = 10000 ELSE 2000
1970 IF C > 10000 THEN C1 = C
1980 IF C > 10000 THEN C = C - 10000
1990 B = 1:GOTO 2170
2000 IF C < 10001 THEN D1 = C ELSE 2170
2010 R$ = " 100% WRITE OFF"
2020 B = 1
2030 GOTO 730
2040 REM ********************** 5 YEAR ASSET COST RECOVERY SYSTEM *************
2050 CY = 1:F1 = 1
2060 D(CY) = D(1) + C*0.15
2070 CY = 2
2080 D(CY) = 0.22*C
2090 FOR CY = 3 TO 5
2100 D(CY) = 0.21*C
2110 NEXT CY
2120 CV = 0
2130 IC = 0.1*C
2140 F = 1:C = C1
2150 R$ = " ASSET RECOVERY SYSTEM"
2160 GOTO 730
2170 REM ******************** ACCELERATED USEFULL LIFE SELECTION **************
2180 CLS:PRINT :PRINT "PLEASE SELECT TYPE OF LIFE/USE FROM THE FOLLOWING LIST"
2190 PRINT :PRINT
2200 PRINT TAB(10);"1) 3 YEAR CLASS PROPERTY (AUTO'S,LIGHT TRUCKS,MACHINERY,"; "R&D EQUIPMENT)"
2210 PRINT
2220 PRINT TAB(10);"2) 5 YEAR CLASS PROPERTY (COMPUTERS, MOST OFFICE FURNITURE," ;" HEAVY DUTY",TAB(19);"TRUCKS & MACHINERY,AGRICULTURAL STRUCTURES)"
2230 PRINT
2240 PRINT TAB(10);"3) 10 YEAR CLASS PROPERTY (PUBLIC UTILITY & RAILROAD "; "PROPERTY",TAB(19);"AND SOME REAL PROPERTY)"
2250 PRINT
2260 PRINT TAB(10);"4) 15 YEAR CLASS PROPERTY (MOSTLY PUBLIC UTILITIES)"
2270 PRINT
2280 PRINT TAB(10);"5) 15 YEAR, 175% DEP. RATE FOR REAL PROPERTY"
2290 PRINT :PRINT
2300 INPUT "PLEASE ENTER THE NUMBER OF YOUR SELECTION: ",Z
2310 IF Z = 1 THEN L = 3:GOTO 2490
2320 IF Z = 2 THEN L = 5:GOTO 2040
2330 IF Z = 3 THEN L = 10:GOTO 2690
2340 IF Z = 4 THEN L = 15:GOTO 3130
2350 IF Z = 5 THEN L = 15:GOTO 2870
2360 IF Z > 5 THEN 2170
2370 REM ******************* STRAIGHT LINE DEPRECIATION ***********************
2380 IC = 0.1*C:ED = 0
2390 F = 1
2400 CY = 1
2410 D(CY) = C/L*(FY/12)
2420 FOR CY = 2 TO L
2430 D(CY) = C/L
2440 NEXT CY
2450 CY = L+1
2460 D(CY) = C/L*(LY/12)
2470 R$ = " STRAIGHT LINE"
2480 GOTO 730
2490 REM ****************** 3 YEAR ACRS ***************************************
2500 F1 = 1
2510 D(1) = D(1) + 0.25*C
2520 D(2) = 0.38*C
2530 D(3) = 0.37*C
2540 CV = 0:IC = 0.06*C:F = 1:R$ = " ASSET COST RECOVERY SYSTEM"
2550 C = C1
2560 GOTO 730
2570 END
2580 REM ************ LONG TERM USEFUL LIFE SELECTION *************************
2590 CLS:PRINT:PRINT "PLEASE SELECT TYPE OF USEFULL LIFE FROM THE FOLLOWING "; "LIST"
2600 PRINT TAB(10);"1 LONG TERM - 12 YEARS"
2610 PRINT TAB(10);"2 LONG TERM - 25 YEARS"
2620 PRINT "PLEASE ENTER NUMBER OF YOUR SELECTION"
2630 INPUT Z
2640 IF Z = 1 THEN L = 12:GOTO 2370
2650 IF Z = 2 THEN L = 25:GOTO 2370
2660 IF Z > 2 THEN 2580
2670 GOTO 2580
2680 REM ****************** 10 YEAR ACRS **************************************
2690 F1 = 1:CY = 1
2700 D(CY) = D(1) + 0.08*C
2710 CY = 2
2720 D(CY) = 0.14*C
2730 CY = 3
2740 D(CY) = 0.12*C
2750 FOR CY = 4 TO 6
2760 D(CY) = 0.09999999*C
2770 NEXT
2780 FOR CY = 7 TO 10
2790 D(CY) = 0.09*C
2800 NEXT
2810 CV = C
2820 IC = C/10
2830 F = 1:C = C1
2840 R$ = "ASSET RECOVERY SYSYEM"
2850 GOTO 730
2860 REM ********************* 15 YEAR, 175% REAL PROPERTY *******************
2870 FY = 13 - MM
2880 LY = 12 - FY
2890 R$ = " 175% ACRS FOR REAL PROPERTY"
2900 A = 1:ED = 0
2910 CV = 0
2920 C = C1:IC = 0
2930 RESTORE
2940 FOR J = 1 TO MM
2950 FOR I = 1 TO 16:READ D(I):NEXT I
2960 NEXT J
2970 FOR I = 1 TO 16
2980 D(I) = C*D(I)/100
2990 NEXT I
3000 GOTO 700
3010 DATA 12,10,9,8,7,6,6,6,6,5,5,5,5,5,5,0
3020 DATA 11,10,9,8,7,6,6,6,6,6,5,5,5,5,5,0
3030 DATA 10,11,9,8,7,6,6,6,6,5,5,5,5,5,5,1
3040 DATA 9,11,9,8,7,6,6,6,6,6,5,5,5,5,5,1
3050 DATA 8,11,10,8,7,7,6,6,5,5,5,5,5,5,5,2
3060 DATA 7,11,10,8,7,7,6,6,6,5,5,5,5,5,5,2
3070 DATA 6,11,10,9,8,7,6,5,5,5,5,5,5,5,5,3
3080 DATA 5,11,10,9,8,7,6,6,5,5,5,5,5,5,5,3
3090 DATA 4,11,10,9,8,7,6,6,5,5,5,5,5,5,5,4
3100 DATA 3,11,10,9,8,7,6,6,6,5,5,5,5,5,5,4
3110 DATA 2,11,10,9,8,7,6,6,6,6,5,5,5,5,5,4
3120 DATA 1,12,10,9,8,7,6,6,6,5,5,5,5,5,5,5
3130 REM *********************** 15 YEAR ACRS *********************************
3140 CY = 1
3150 F1 = 1
3160 D(CY) = D(1) + 0.05*C
3170 CY = 2
3180 D(CY) = 0.09999999*C
3190 CY = 3
3200 D(CY) = 0.09*C
3210 CY = 4
3220 D(CY) = 0.08*C
3230 FOR CY = 5 TO 6
3240 D(CY) = 0.07*C
3250 NEXT
3260 FOR CY = 7 TO 15
3270 D(CY) = 0.06*C
3280 NEXT
3290 CV = 0
3300 IC = 0.1*C
3310 F = 1:C = C1
3320 R$ = "ASSET RECOVERY SYSTEM"
3330 GOTO 730
MUSICBOX.BAS
100 REM ----- BLUES -----
101 ' TYPED IN WITH MODIFICATIONS BY D.G. PATTERSON
102 ' SEE SOFTSIDE MAGAZINE FOR INSTRUCTIONS
106 ' PROGRAM TO WRITE MUSIC.---TAKEN FROM SOFTSIDE #34 NOV 1982
107 ' SOME FUNCTIONS NOT ACTIVATED - THEY WILL BE ADDED IN FUTURE
108 ' ISSUES OF SOFTSIDE AND POSTED TO PCanada....
116 CLS:KEY OFF:DEFINT A-Z:MAX=2000:DIM NCURS(38),SHARP(38),FLAT(38),STAFF(1884),NOTE1(38),NOTE2(38),NOTE4(38),NOTE8(38),NOTE16(38),NOTE32(38),NOTE64(38),BLOCK(99,2),M$(2000),PCL(154),PCC(154),PCR(154)
118 DIM FU$(10)
120 DIM REST1(38),REST2(38),REST4(38),REST8(38),REST16(38),REST32(38),REST64(38),PIANOL(104),PIANOR(104),PIANOC(104),DOT(38),NDY(35),BK(5):DEF FNU$(A$)=CHR$(ASC(LEFT$(A$,1))+32*(LEFT$(A$,1)>"Z"))
124 DEF FNL2!(X)=LOG(X)/LOG(2):DEF FNS$(N$)=RIGHT$(N$,LEN(N$)-1):TRUE=-1:FALSE=0:FLAT=FALSE:SHARP=FALSE:OC=3:CN$="C":SCALE$="CDEFGAB":NN=7*OC-6
128 STAFFX=5:STAFFY=55:PTN$="":X$="C C#D E-E F F#G A-A B-B ":FOR X=1 TO 5:PTN$=PTN$+X$:NEXT:PSCALE$="C.D.EF.G.A.B":PTNPTR=(12*(OC-1)+INSTR(PSCALE$,CN$)-SHARP+FLAT)*2-1
132 KBX=123:KBY=6:NX=6:NY=160:RX=6:RY=180:MIDC=30:NDX=STAFFX+49:RDX=NDX-2:RDY=STAFFY
135 NCOUNT=0:TEMPO=100:BCOUNT=0:DOTTED=FALSE:NOTE=TRUE:PREVNOTE=NOTE:TIME=4:PREVTIME=TIME:PREVDOT=DOTTED:PREVPTR=PTNPTR:BCOUNT=0:BPOS=0:NCOUNT=1:NPOS=1:INSERTING=FALSE:GOSUB 13000:CLS:X$="Just a moment...":LOCATE 12,20-LEN(X$)/2:PRINT X$
140 GOSUB 16170:GOSUB 2000:GOSUB 15000:GOSUB 14000
141 '
142 ' ***** MAIN INPUT LOOP:ACCEPT VALID CHARACTERS;REJECT *****
143 ' ***** INVALID ONES;BRANCH TO APPROPRIATE SUBROUTINES. *****
144 '
1000 IN$=INKEY$:IF IN$="" THEN 1000
1010 IF FNU$(IN$)="S" THEN GOSUB 18000:GOTO 1150
1020 IF FNU$(IN$)="L" THEN GOSUB 17000:GOTO 1150
1030 IF FNU$(IN$)="P" THEN GOSUB 19000:GOTO 1150
1040 IF FNU$(IN$)="T" THEN GOSUB 20000:GOTO 1150
1045 IF FNU$(IN$)=" " THEN GOSUB 11000:NOTE=NOT NOTE:GOTO 1150
1050 IF FNU$(IN$)="N" THEN GOSUB 21000:GOTO 1150
1055 IF FNU$(IN$)="C" THEN GOSUB 22000:GOTO 1150
1060 IF FNU$(IN$)=CHR$(13) THEN GOSUB 16000:GOTO 1150
1065 IF FNU$(IN$)=CHR$(3) THEN GOSUB 23000:GOTO 1150
1067 IF FNU$(IN$)="M" THEN RUN "MENU"
1070 IF ASC(LEFT$(IN$,1))<>0 THEN 1000 ELSE IN=ASC(RIGHT$(IN$,1))
1080 IF IN<59 OR (IN>68 AND IN<72) OR IN=73 OR IN=79 OR IN>80 THEN 1000
1090 IF IN=72 THEN GOSUB 3000:GOTO 1150
1100 IF IN=75 THEN GOSUB 6000:GOTO 1150
1110 IF IN=77 THEN GOSUB 5000:GOTO 1150
1120 IF IN=80 THEN GOSUB 4000:GOTO 1150
1140 ON IN-58 GOSUB 8000,7000,50000,50000,50000,50000,50000,50000,9000,10000
1150 GOSUB 2000
1160 GOSUB 12000:GOTO 1000
1989 END
1990 '
1992 ' ***** CALCULATIONS OF NEW VALUES FOR OC *****
1993 ' ***** SHARP,FLAT,NN,N$, AND AC$. THE *****
1994 ' ***** VALUE OF PTNPTR IS THE SOLE PARAMETER *****
1995 ' ***** OF THIS ROUTINE. *****
1998 '
2000 N$=MID$(PTN$,PTNPTR,2):CN$=LEFT$(N$,1):AC$=RIGHT$(N$,1):IF AC$=" " THEN SHARP=FALSE:FLAT=FALSE
2030 IF AC$="#" THEN SHARP=TRUE:FLAT=FALSE
2040 IF AC$="-" THEN SHARP=FALSE:FLAT=TRUE
2060 OC=((PTNPTR-1)/2-INSTR(PSCALE$,CN$))/12+1:NN=7*OC+INSTR(SCALE$,CN$)-7:RETURN
2990 '
2992 ' ***** INCREMENT PITCH OF NOTE ONE HALF-STEP *****
2998 '
3000 GOSUB 11000:PTNPTR=PTNPTR+2:IF PTNPTR>119 THEN PTNPTR=1
3010 RETURN
3990 '
3992 ' ***** DECREMENT PITCH ONE HALF-STEP. *****
3998 '
4000 GOSUB 11000:PTNPTR=PTNPTR-2:IF PTNPTR<1 THEN PTNPTR=119
4010 RETURN
4990 '
4992 ' ***** MOVE TIME INDICATOR TO THE RIGHT. THIS *****
4994 ' ***** SHORTENS THE LENGTH OF THE NOTE OR REST. *****
5000 GOSUB 11000:IF NOTE THEN 5050
5020 IF TIME=64 THEN TIME=1 ELSE TIME=TIME*2
5030 RETURN
5050 IF DOTTED THEN DOTTED=FALSE:RETURN
5060 DOTTED=TRUE:IF TIME=64 THEN TIME=1 ELSE TIME=TIME*2
5070 RETURN
5990 '
5992 ' ***** MOVE TIME INDICATOR TO THE LEFT. *****
5998 '
6000 GOSUB 11000:IF NOTE THEN 6040
6010 IF TIME=1 THEN TIME=64 ELSE TIME=TIME/2
6020 RETURN
6040 IF NOT DOTTED THEN DOTTED=TRUE:RETURN
6050 DOTTED=FALSE:IF TIME=1 THEN TIME=64 ELSE TIME=TIME/2
6060 RETURN
6990 '
6992 ' ***** MOVE UP AN OCTAVE *****
6998 '
7000 GOSUB 11000:PTNPTR=PTNPTR+24:IF PTNPTR>119 THEN PTNPTR=PTNPTR-120
7010 RETURN
7990 '
7992 ' ***** MOVE DOWN AN OCTAVE. *****
7998 '
8000 GOSUB 11000:PTNPTR=PTNPTR-24:IF PTNPTR<1 THEN PTNPTR=PTNPTR+120
8010 RETURN:GOSUB 11000 :IF NPOS=1 THEN RETURN
8990 '
8992 ' ***** MOVE TO THE PREVIOUS NOTE IN THE BUFFER *****
8998 '
9000 GOSUB 11000:IF NPOS=1 THEN RETURN
9010 NPOS=NPOS-1:IF BPOS>1 THEN IF NPOS=BLOCK(BPOS-1,2) THEN BPOS=BPOS-1
9020 C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):TEMPO=VAL(MID$(M$(NPOS),2,3)):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
9060 SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
9990 '
9992 ' ***** MOVE TO THE NEXT NOTE IN THE BUFFER. *****
9998 '
10000 GOSUB 11000:IF NPOS>=NCOUNT-1 THEN NPOS=NCOUNT:PTNPTR=49:TIME=4:DOTTED=FALSE:NOTE=TRUE:RETURN
10010 NPOS=NPOS+1:IF NPOS=BLOCK(BPOS+1,1) THEN BPOS=BPOS+1
10020 C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):TEMPO=VAL(MID$(M$(NPOS),2,3)):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
10060 SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
10090 '
10092 ' ***** SAVE THE PREVIOUS STATE OF THE SCREEN FOR *****
10094 ' ***** PROPER ERASURE OF SYMBOLS. *****
11000 PREVTIME=TIME:PREVDOT=DOTTED:PREVNOTE=NOTE:PREVPTR=PTNPTR:RETURN
11990 '
11992 ' ***** DISPLAY ROUTINE.RE-CREATE THE DATA OF *****
11993 ' ***** THE PREVIOUS NOTE,USING THE INFORMATION *****
11994 ' ***** PRESERVED IN LINE 11000. *****
11995 '
12000 PREVN$=MID$(PTN$,PREVPTR,2):PREVAC$=RIGHT$(PREVN$,1):PREVOC=((PREVPTR-1)/2-INSTR(PSCALE$,LEFT$(PREVN$,1)))/12+1:PREVNN=7*PREVOC+INSTR(SCALE$,LEFT$(PREVN$,1))-7:N2$=N$:IF AC$="-" THEN MID$(N2$,2,1)="b"
12040 '
12042 ' ***** UPDATE THE INFORMATION SQUARE. *****
12048 '
12050 LOCATE 3,31:IF DOTTED THEN PRINT USING "Tone \ \";N2$+"." ELSE PRINT USING "Tone \\";N2$
12060 LOCATE 2,31:PRINT USING "Octave #";OC:LOCATE 6,31:PRINT USING "Note ####";NPOS:LOCATE 5,31:PRINT USING "Tempo ###";TEMPO:LOCATE 7,31:PRINT USING "Blocks ##";BCOUNT:LOCATE 4,31:PRINT USING "Length ##";TIME
12090 '
12092 ' ***** UPDATE THE TIME INDICATOR. *****
12098 '
12100 OLDTX=FNL2!(PREVTIME)*15+RX:IF PREVNOTE AND PREVDOT THEN PUT (OLDTX,NY),DOT
12110 PUT (OLDTX,RY+20*PREVNOTE),NCURS:TX=RX+15*FNL2!(TIME):PUT (TX,RY+20*NOTE),NCURS:IF NOTE AND DOTTED THEN PUT (TX,RY+20*NOTE),DOT
12150 '
12152 ' ***** UPDATE THE PIANO KEYS *****
12158 '
12160 X=INSTR(SCALE$,LEFT$(PREVN$,1)):XQ=INT(X-X/3+.5):IF PREVAC$<>" " THEN PAINT (KBX+BK(XQ),KBY+5),0,2 ELSE IF X=2 OR X=5 OR X=6 THEN PUT (KBX+15*(X-1),KBY),PCC ELSE IF X=1 OR X=4 THEN PUT (KBX+15*(X-1),KBY),PCL ELSE PUT (KBX+15*(X-1),KBY),PCR
12180 X=INSTR(SCALE$,LEFT$(N$,1)):XQ=INT(X-X/3+.5):IF AC$<>" " THEN PAINT (KBX+BK(XQ),KBY+5),1,2 ELSE IF X=2 OR X=5 OR X=6 THEN PUT (KBX+15*(X-1),KBY),PCC ELSE IF X=1 OR X=4 THEN PUT (KBX+15*(X-1),KBY),PCL ELSE PUT (KBX+15*(X-1),KBY),PCR
12190 LINE (0,0)-(319,199),3,B
12200 '
12202 ' ***** UPDATE THE STAFF *****
12208 '
12210 IF NOT PREVNOTE THEN 12440
12220 ON FNL2!(PREVTIME)+1 GOTO 12230,12240,12250,12260,12270,12280,12290
12230 PUT (NDX,NDY(PREVNN)),NOTE1:GOTO 12300
12240 PUT (NDX,NDY(PREVNN)),NOTE2:GOTO 12300
12250 PUT (NDX,NDY(PREVNN)),NOTE4:GOTO 12300
12260 PUT (NDX,NDY(PREVNN)),NOTE8:GOTO 12300
12270 PUT (NDX,NDY(PREVNN)),NOTE16:GOTO 12300
12280 PUT (NDX,NDY(PREVNN)),NOTE32:GOTO 12300
12290 PUT (NDX,NDY(PREVNN)),NOTE64
12300 IF PREVDOT THEN PUT (NDX,NDY(PREVNN)),DOT
12310 IF PREVAC$="-" THEN PUT (NDX-2,NDY(PREVNN)),FLAT ELSE IF PREVAC$="#" THEN PUT (NDX-2,NDY(PREVNN)),SHARP
12320 IF NOT NOTE THEN 12520 ELSE ON FNL2!(TIME)+1 GOTO 12330,12340,12350,12360,12370,12380,12390
12330 PUT (NDX,NDY(NN)),NOTE1:GOTO 12400
12340 PUT (NDX,NDY(NN)),NOTE2:GOTO 12400
12350 PUT (NDX,NDY(NN)),NOTE4:GOTO 12400
12360 PUT (NDX,NDY(NN)),NOTE8:GOTO 12400
12370 PUT (NDX,NDY(NN)),NOTE16:GOTO 12400
12380 PUT (NDX,NDY(NN)),NOTE32:GOTO 12400
12390 PUT (NDX,NDY(NN)),NOTE64
12400 IF DOTTED THEN PUT (NDX,NDY(NN)),DOT
12410 IF AC$="-" THEN PUT (NDX-2,NDY(NN)),FLAT ELSE IF AC$="#" THEN PUT (NDX-2,NDY(NN)),SHARP
12420 RETURN
12440 IF PREVNOTE THEN 12320 ELSE ON FNL2!(PREVTIME)+1 GOTO 12450,12460,12470,12480,12490,12500,12510
12450 PUT (RDX,RDY),REST1:GOTO 12320
12460 PUT (RDX,RDY),REST2:GOTO 12320
12470 PUT (RDX,RDY),REST4:GOTO 12320
12480 PUT (RDX,RDY),REST8:GOTO 12320
12490 PUT (RDX,RDY),REST16:GOTO 12320
12500 PUT (RDX,RDY),REST32:GOTO 12320
12510 PUT (RDX,RDY),REST64:GOTO 12320
12520 ON FNL2!(TIME)+1 GOTO 12530,12540,12550,12560,12570,12580,12590
12530 PUT (RDX,RDY),REST1:RETURN
12540 PUT (RDX,RDY),REST2:RETURN
12550 PUT (RDX,RDY),REST4:RETURN
12560 PUT (RDX,RDY),REST8:RETURN
12570 PUT (RDX,RDY),REST16:RETURN
12580 PUT (RDX,RDY),REST32:RETURN
12590 PUT (RDX,RDY),REST64:RETURN
12997 '
12998 ' ***** SET UP THE SHAPE TABLES *****
12999 '
13000 SCREEN 1:CLS:COLOR 0,1:STAFF$="S10 A000 BM000,000 C1 D8 R1 U8 L1 R1 BR40 D8 R1 U8 L1 L40 D2 R40 D2 L40 D2 R40 D2 L40":STAFF$=STAFF$+" L1 D16 R1 U8 L1 R1 BR40 D8 R1 U8 L1 L40 D2 R40 D2 L40 D2 R40 D2 L40":DRAW STAFF$:STAFF$=""
13030 GET (0,0)-(104,70),STAFF:CLS
13050 CIRCLE (4,13),3,2,,,.55:GET (0,0)-(13,17),NOTE1:LINE (7,13)-(7,1),2:GET (0,0)-(13,17),NOTE2:PAINT (4,13),2,2:GET (0,0)-(13,17),NOTE4:LINE (7,1)-(12,3),2:GET (0,0)-(13,17),NOTE8:LINE (7,3)-(12,5),2:GET (0,0)-(13,17),NOTE16
13060 LINE (7,5)-(12,7),2:GET (0,0)-(13,17),NOTE32:LINE (7,7)-(12,9),2:GET (0,0)-(13,17),NOTE64:CLS
13080 LINE(2,0)-(2,6),2:LINE (4,0)-(4,6),2:LINE (1,2)-(5,2),2:LINE (1,4)-(5,4),2:GET (0,0)-(13,17),SHARP:CLS:LINE (2,0)-(2,6),2:LINE (2,6)-(6,4),2:LINE (6,4)-(2,2),2:GET (0,0)-(13,17),FLAT
13100 CLS:LINE (3,11)-(9,13),2,BF:GET (0,0)-(13,17),REST1:CLS:LINE (3,9)-(9,7),2,BF:GET (0,0)-(13,17),REST2:CLS:LINE (6,3)-(8,5),2:LINE (8,5)-(6,8),2:LINE (6,8)-(8,10),2:LINE (8,10)-(5,13),2:LINE (5,13)-(6,15),2:GET (0,0)-(13,17),REST4
13110 CLS:LINE (6,14)-(9,3),2:LINE (9,4)-(3,6),2:GET (0,0)-(13,17),REST8:LINE (9,6)-(3,8),2:GET (0,0)-(13,17),REST16:LINE (7,8)-(3,10),2:GET (0,0)-(8,16),REST32:LINE (7,10)-(3,12),2:GET (0,0)-(13,17),REST64
13130 CLS:LINE (0,0)-(9,30),3,BF:LINE (0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOL
13131 PAINT (5,5),2,0:GET (0,0)-(12,50),PCL
13132 CLS:LINE (4,0)-(9,30),3,BF:LINE(0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOC
13133 PAINT (5,5),2,0:GET (0,0)-(12,50),PCC
13134 CLS:LINE (4,0)-(12,30),3,BF:LINE (0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOR
13135 PAINT (5,5),2,0:GET (0,0)-(12,50),PCR
13140 CLS:LINE (0,0)-(13,17),2,BF:GET (0,0)-(13,17),NCURS:CLS:PSET (10,14),2:PSET (10,15),2:PSET (11,14),2:PSET (11,15),2:GET (0,0)-(13,17),DOT:RETURN
13990 '
13992 ' ***** DRAW THE INITIAL SCREEN *****
14000 CLS:LINE (0,0)-(319,199),3,B:LINE (115,0)-(115,199),3:LINE (115,63)-(319,199),3,B:LINE (234,0)-(234,63),3
14030 PUT (KBX,KBY),PIANOL:PUT (KBX+15,KBY),PIANOC:PUT (KBX+30,KBY),PIANOR:PUT (KBX+45,KBY),PIANOL:PUT (KBX+60,KBY),PIANOC:PUT (KBX+75,KBY),PIANOC:PUT (KBX+90,KBY),PIANOR:LINE (KBX-3,KBY-2)-(KBX+105,KBY+52),3,B:PAINT (KBX+11,KBY+1),2,3
14050 FOR X=KBX+10 TO KBX+25 STEP 15:LINE (X+1,KBY)-(X+7,KBY+28),0,BF:NEXT X:FOR X=KBX+55 TO KBX+55+30 STEP 15:LINE (X+1,KBY)-(X+7,KBY+28),0,BF:NEXT X
14060 PUT (KBX,KBY),PCL
14070 LINE (0,NY-2)-(115,NY-2),3:PUT (NX,NY),NOTE1:PUT (NX+15,NY),NOTE2:PUT (NX+30,NY),NOTE4:PUT (NX+45,NY),NOTE8:PUT (NX+60,NY),NOTE16:PUT (NX+75,NY),NOTE32:PUT (NX+90,NY),NOTE64:TX=RX+15*FNL2!(TIME):PUT (TX,NY),NCURS
14090 LINE (0,RY-2)-(115,RY-2),3:PUT (RX,RY),REST1:PUT (RX+15,RY),REST2:PUT (RX+30,RY),REST4:PUT (RX+45,RY),REST8:PUT (RX+60,RY),REST16:PUT (RX+75,RY),REST32:PUT (RX+90,RY),REST64:PUT (STAFFX,STAFFY),STAFF
14120 FOR X=1 TO 5:LINE (STAFFX+46,STAFFY-X*5)-(STAFFX+60,STAFFY-X*5),1:LINE (STAFFX+46,STAFFY+X*5+45)-(STAFFX+60,STAFFY+X*5+45),1:NEXT X:LINE (STAFFX+46,STAFFY+MIDC)-(STAFFX+60,STAFFY+MIDC),1:PUT (NDX,NDY(NN)),NOTE4
14160 GOSUB 12000:LOCATE 12,22:DEF SEG:POKE 78,1:PRINT"PC Blues Box":LOCATE 14,21:DEF SEG:POKE 78,2:PRINT "A Music Editor":LOCATE 15,21:PRINT "For The IBM PC"
14165 X$="CDEFGAB":FOR X=0 TO 6:PLAY "MB O="+VARPTR$(X)+"T100 L32 X" +VARPTR$(X$)+"X"+VARPTR$(X$):NEXT :FOR X=18 TO 12 STEP -1:LOCATE X,16:PRINT STRING$(24,32):NEXT
14170 LOCATE 10,16:PRINT "F1 DOWN Octave UP F2"
14190 LOCATE 11,16:PRINT "F3 START Block END F4"
14200 LOCATE 12,16:PRINT "F5 INSRT Block DEL F6"
14210 LOCATE 13,16:PRINT "F7 PREV. Block NEXT F8"
14220 LOCATE 14,16:PRINT "F9 PREV. Note NEXT F0"
14230 LOCATE 15,16:PRINT "S SAVE File LOAD L"
14240 LOCATE 16,16:PRINT "C CLEAR Music PLAY P"
14250 LOCATE 17,16:PRINT "N NOTE Edit TEMPO T"
14260 LOCATE 18,16:PRINT "[Esc] Stop Play [Esc]"
14265 LOCATE 19,16:PRINT "Ctrl-C Quit Menu M"
14270 RETURN
14990 '
14992 ' ***** SET UP Y COORDINATES FOR DRAWING *****
14993 ' ***** NOTES AND THE X COORDINATES FOR DRAWING *****
14994 ' ***** PIANO KEYS. *****
15000 RESTORE:FOR X=1 TO 35:READ NDY(X):NDY(X)=NDY(X)+STAFFY:NEXT:FOR X=1 TO 5:READ BK(X):NEXT:RETURN
15010 DATA 57,55,52,50,47,45,42,40,37,35,32,30,27,25,17,10,7,5,2,0,-3,-5,-8,-10,-13,-15,-18,-20,-23,-25,-28,-30,-33,-35,-38,15,30,60,75,90
15990 '
15992 ' ***** ACCEPT A NOTE INTO THE BUFFER. *****
15998 '
16000 GOSUB 11000:M$="T000O0L00Na ":LZ=-((TEMPO<10)+(TEMPO<100)):MID$(M$,2+LZ)=FNS$(STR$(TEMPO)):MID$(M$,6)=FNS$(STR$(OC)):LZ=-(TIME<10):MID$(M$,8+LZ)=FNS$(STR$(TIME))
16060 IF NOT NOTE THEN MID$(M$,10)="P"+FNS$(STR$(TIME)) ELSE MID$(M$,10)=N$:IF DOTTED THEN MID$(M$,12)="."
16070 M$(NPOS)=M$:IF NOTE THEN PLAY M$
16090 NPOS=NPOS+1:IF NPOS>NCOUNT THEN NCOUNT=NCOUNT+1
16110 IF NPOS=NCOUNT THEN RETURN
16120 C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
16160 SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
16167 '
16168 ' ***** UN-DEFINE THE FUNCTION KEYS *****
16169 '
16170 FOR X=1 TO 10:KEY X, "":NEXT X
16171 RETURN
16990 '
16992 ' ***** FILE OPERATIONS(LOAD AND SAVE). *****
16998 '
17000 ON ERROR GOTO 17500
17010 GOSUB 11000:LOCATE 22,16:LINE INPUT "File >";F$:LOCATE 22,16:PRINT STRING$(24,32):OPEN F$ FOR INPUT AS #1:INPUT #1,BCOUNT:INPUT #1,NCOUNT:IF BCOUNT<>0 THEN FOR X=1 TO BCOUNT:INPUT #1,BLOCK(X,1):INPUT #1,BLOCK(X,2):NEXT X
17060 BPOS=BCOUNT:FOR X=1 TO NCOUNT-1:INPUT #1,M$(X):NEXT X:CLOSE #1:NPOS=NCOUNT:TIME=4:DOTTED=FALSE:NOTE=TRUE:PTNPTR=49:TEMPO=VAL(MID$(M$(1),2,3))
17065 RETURN
17070 ON ERROR GOTO 0
17490 '
17492 ' ***** RETURN IF NO DATA FILE *****
17498 '
17500 IF ERR=53 THEN LOCATE 22,16:PRINT STRING$(24,32):LOCATE 22,16:PRINT "NO FILE CALLED ";F$:FOR X=1 TO 5000:NEXT X:LOCATE 22,16:PRINT STRING$(24,32):GOSUB 22030:RESUME 17065
17520 END
18000 GOSUB 11000:LOCATE 22,16:LINE INPUT "FILE >";F$:LOCATE 22,16:PRINT STRING$(24,32):OPEN F$ FOR OUTPUT AS #1:PRINT #1,BCOUNT:PRINT #1,NCOUNT:IF BCOUNT<>0 THEN FOR X=1 TO BCOUNT:PRINT #1,BLOCK(X,1):PRINT #1,BLOCK(X,2):NEXT X
18060 BPOS=BCOUNT:FOR X=1 TO NCOUNT-1:PRINT #1,M$(X):NEXT X:CLOSE #1:NPOS=NCOUNT:TIME=4:DOTTED=FALSE:NOTE=TRUE:PTNPTR=49:RETURN
18990 '
18992 ' ***** PLAY THE MUSIC *****
18998 '
19000 GOSUB 11000:PLAY "MB":FOR X=1 TO NCOUNT-1:IF INKEY$=CHR$(27) THEN RETURN ELSE PLAY M$(X)
19020 NEXT :RETURN
19990 '
19992 ' ***** SET TEMPO *****
19998 '
20000 GOSUB 11000:LOCATE 22,16:LINE INPUT "Tempo (32-255) >";X$:TEMPO=VAL(X$):IF TEMPO<32 OR TEMPO>255 THEN TEMPO=100
20010 LOCATE 22,16:PRINT STRING$(24,32):RETURN
20990 '
20992 ' ***** MOVE NOTE TO EDIT *****
20998 '
21000 GOSUB 11000:LOCATE 22,16:LINE INPUT "Edit Which Note # >";X$:LOCATE 22,16:PRINT STRING$(24,32):IF VAL(X$)<1 OR VAL(X$)>=NCOUNT THEN RETURN
21010 NPOS=VAL(X$):C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
21020 TEMPO=VAL(MID$(M$(NPOS),2,3))
21060 SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
21990 '
21992 ' ***** CLEAR THE MUSIC BUFFER *****
21998 '
22000 GOSUB 11000:LOCATE 22,16:LINE INPUT "Are You Sure >";X$:LOCATE 22,16:PRINT STRING$(24,32)
22010 IF X$="" THEN RETURN
22020 IF FNU$(X$)<>"Y" THEN RETURN
22030 BCOUNT=0:NCOUNT=1:NPOS=1:TIME=4:NOTE=TRUE:DOTTED=FAFSE:PTNPTR=49:TIME=4:TEMPO=100:RETURN
22990 '
22992 ' ***** QUIT *****
22998 '
23000 GOTO 51000
49990 '
49992 ' ***** TEMPORARY LINE TO HANDLE UNIMPLEMENTED COMMANDS *****
49998 '
50000 GOSUB 11000:LOCATE 22,16:PRINT "Not yet implemented.":FOR X=1 TO 1000:NEXT X:LOCATE 22,16:PRINT STRING$(24,32):RETURN
51000 CLS:FU$(1)=CHR$(12)+"LIST "
51010 FU$(2)="RUN"+CHR$(13)
51020 FU$(3)="LOAD"+CHR$(34)
51030 FU$(4)="SAVE"+CHR$(34)
51040 FU$(5)="RUN"+CHR$(34)+"MENU"+CHR$(13)
51050 FU$(6)=","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13)
51060 FU$(7)="TRON"+CHR$(13)
51070 FU$(8)="WIDTH 80"+CHR$(13)+"CLS"+CHR$(13)
51080 FU$(9)="COLOR 2,0,0"+CHR$(13)
51090 FU$(10)="SCREEN 0,0,0"+CHR$(13)
51110 FOR X=1 TO 10:KEY X,FU$(X):NEXT X
51120 SCREEN 0,0,0:CLS:COLOR 2,0,0:WIDTH 80
REBOOT.ASM
TITLE REBOOT DOS
;
DSEG SEGMENT AT 0
ORG 01EH*4
DISK_POINTER LABEL DWORD
FIRST DW ?
SECOND DW ?
DSEG ENDS
;
CSEG SEGMENT
ASSUME CS:CSEG,DS:DSEG
ORG 100H
START: MOV AX,DSEG
MOV DS,AX
MOV SECOND,0F000H
MOV FIRST,0EFC7H
INT 19H
CSEG ENDS
END START
ROFF.DOC
August 28, 1982 /* Modified for IBM PC by MSZachmann */
May 7, 1981
ROFF
This version of ROFF, based on the formatter in Kernighan
and Plauger's book SOFTWARE TOOLS, is written in BDS C, and employs
the directed i/o functions that go along with that package. Well,
half of the directed I/O anyway - it doesn't use redirected input
because I wanted to be able to format more than one file at a run.
Please ignore any "odd" comments to myself in ROFF1.C and ROFF2.C;
I tried to find them all but there may be a few extra silly remarks
around.
For more details on the directed I/O (NDIO in our version)
see NDIO.C
Sample calls:
A> roff filename
This will send the formatted output to the Console (display)
A> roff >filename2 filename
This will send the formatted output to filename2
A> roff >PRN: filename
This will send the formatted output to the printer.
Using ROFF, you can make nice printouts of a file, with as
little or as much help from the program as you want, depending on the
commands. There are default values for all parameters, so if you
don't put any commands in at all, your file will come out with filled,
right-justified lines. The default line-length is 80 characters;
the default page-length is 66 lines per page. "Filled lines" means
that as many input words as possible are packed onto a line before it
is printed; "non-filled" lines go through the formatter w/o
rearrangement. "Right-justified" simply means that spaces are added
between words to make all the right margins line up nicely.
To set a parameter, use the appropriate commands below. All
commands have the form of a period followed by two letters. A command
line should have nothing on it but the command and its arguments (if
any); any text would be lost.
A command argument can be either ABSOLUTE or RELATIVE :
.in 5 sets the indent value to 5 spaces
.in +5 sets the indent value to the CURRENT value plus 5
.ls -1 sets the line spacing value to the current value
minus one
Also, all commands have a minimum and maximum value that will
weed out any odd command settings (like setting the line spacing to
zero, for example. It won't let you do that, but it could be changed
if you REALLY have a burning desire to do so).
Some commands cause a "break", which is noted in the table
below. Before such a command goes into effect, the current line of
text is put out, whether it is completely filled or not. (this is
what happens at the end of a paragraph, for example.) A line
beginning with spaces or a tab will cause a break, and will be
indented by that many spaces (or tabs) regardless of the indent value
at that time (this is a "temporary indent", which can also be set
explicitly). An all blank line also causes a break. If you find that
seem to have some lines that are indented strangely, and it's not
obvious WHY, look at which commands are causing a break, and which
aren't. For instance:
.fi
.ti 0
this is a line of text
.in 8
<- blank line
more text for the machine to play with
At first glance it seems obvious that the line "this is a line of text"
will be indented zero spaces, but it won't - it will be indented 8.
The indent command does NOT cause a break (although the .ti does)
so it will not cause the line to be put out before setting the indent
value to 8. Then, when the blank line is encountered, it will cause
a break - and "this is a line of text" will be indented incorrectly.
*********************** Table of Commands *****************************
Command Break? Default Function
------- ------ ------- ---------
.bp n yes n = +1 begin page numbered n
.br yes cause a break
.ce n yes n = 1 center next n lines
.fi yes start filling lines
.fo string no empty sets footer to string
.he string no empty sets header to string
.in n no n = 0 sets indent value to n
.ls n no n = 1 sets line spacing to n
.m1 no n = 2 sets topmost margin to n
.m2 no n = 2 sets 2nd top margin to n lines
.m3 no n = 2 1st bottom margin to n lines
.m4 no n = 2 bottom-most margin to n lines
.nf yes stop filling lines
.pl n no n = 66 sets page length to n
.rm n no n = 80 sets right margin to n
.sp n yes n = 1 space down n lines
.ti n yes n = 0 sets temporary indent of n
.ul n no n = 1 underline next n lines
----------------------------------------------------------------------
Here's what the page parameters look like:
_ _________________________________________________
| | top margin - (includes header) |
| |-----------------------------------------------|
| | top margin 2 |
| |-----------------------------------------------|
P | : : |
A | :<-indent : |
G | : : |
E | :lots and lots of silly text and: |
L | :other garbage. Get the picture?: |
E | :This is a temp. indentation: |
N | : : |
G | : right margin -> : |
T | : : |
H | : : |
| |-----------------------------------------------|
| | margin 3 |
| |-----------------------------------------------|
| | margin 4 - (includes footer) |
- -------------------------------------------------
To change the default for any parameter, simply alter ROFFGLOB
recompile ROFF1.c and ROFF2.c, and re-clink them with NDIO.CRL
(you can use DIO.CRL, but it doesn't have all the features of
NDIO )
************************************************************
A Few Extra Comments on Some of the Commands:
************************************************************
If you want to center lots of lines, but don't
want to count them, do something like this:
.ce 1000
lots and
lots of words to
be centered
.ce 0
--------------------------------------
To underline a few words on a line:
.fi
.ul
Some
of the words in
.ul
this
sentence are
.ul
underlined
.nf
WOULD PRODUCE:
Some of the words in this sentence are underlined.
---- ---- -----------
(obviously you don't have to turn the fill on and off if it's
already on )
------------------------------------
A new paragrah may be caused by using the temporary indent
command, like
.ti +5
or by simply beginning the paragraph with a tab, as you would if
you were just typing.
------------------------------------
Headers and Footers.
A page number can be incorporated into any header or
footer by putting a "#" in the title where you want the number
to go:
.he This is a witty header title for page #
Each time this is printed at the top of a page, the current
page number will be substituted for the "#".
------------------------------------
If you want to send the output to a file, and don't want the page
breaks in there ( that's what I did for this ) set margins 1-4 to
zero.
SDIR.ASM
TITLE SDIR - SORTED DIRECTORY COMMAND, Version 2.1
PAGE 64,101 ; JAN 1983
COMMENT |
SDIR [d:][filename[.ext]] [options]
[filespec] same as for DIR command
[options] * /A - List hidden files.
* /E - Without screen erase.
* /P - Pause when screen full.
/X - Sort by extension.
/S - Sort by size.
/D - Sort by date/time.
/N - Do not sort, original order.
Default = *.* sorted by name.ext with screen erase.
* - Option may be combined with other options.
This source file was created from an object file obtained
from Gene Plantz's BBS in Chicago. The original file name
was SD.HEX. I then used DEBUG and CAPTURE to get the first
dis-assembly which was then edited with WORDSTAR to create
a source that when assembled using MASM would duplicate the
original object file.
Comments have been added and I do hope they are helpful.
I have made several modifications to the first version and
am continuing to add comments. This source file is an
excellent example for anyone wishing to learn 8086/8088
assembly language. Use at your own risk and feel free to
share this file with your friends.
I certainly wish that John Chapman would publish his
source file. His comments are sure to be more meaningful
than mine could ever be. Some of the conversion routines
are very elegant, but difficult to understand. As far as
I'm concerned, PRINTDD is magic.
Several modifications have been made. They are:
1. Filespecs are processed like DIR does.
2. No sort option was added. /N
3. Pause when screen full option added. /P
4. Number of files found is printed.
Ted Reuss
Houston, TX
|
SUBTTL EQUATES & STRUCTURES
PAGE
IF1
DOSCALL MACRO FUNC,PARM1
.xcref
F_C = FUNC
IFNB <PARM1>
IF F_C EQ 2 OR (F_C GE 4 AND F_C LE 6) OR F_C EQ 14 OR F_C EQ 46
MOV DL,PARM1
ELSE
MOV DX,OFFSET PARM1
ENDIF
ENDIF
MOV AH,FUNC
INT 21H
.cref
ENDM
ENDIF
.SALL ;supress all macro expansions
; PC-DOS INTERRUPT 21H FUNCTION CODES
;
@CHROUT EQU 2 ;display char in DL
@KEYIN EQU 8 ;kybd input w/o echo
@STROUT EQU 9 ;print string terminated with $
@CKEYIN EQU 12 ;clr kybd bufr & do inp.func in AL
@SRCH1 EQU 17 ;search for first dir entry
@SRCH2 EQU 18 ;search for next dir entry
@GETDSK EQU 25 ;get default disk drive
@SETDTA EQU 26 ;set disk transfer addr
@FATAD2 EQU 28 ;get FAT of drive # in DL
@PARSEF EQU 41 ;parse filename
@GETDTE EQU 42 ;get system date
@GETTME EQU 44 ;get system time
CR EQU 0DH ;carriage return
LF EQU 0AH ;line feed
FCB_1 EQU 5CH ;fcb for parameter 1
PARAM_L EQU 80H ;# characters in PARAM_B
PARAM_B EQU 81H ;DOS cmd parameter buffer.
; PC-DOS packed date <yyyyyyym mmmddddd>
P_DTE RECORD P_YR:7,P_MO:4,P_DY:5
; PC-DOS packed time <hhhhhmmm mmmsssss>
P_TME RECORD P_HR:5,P_MI:6,P_2S:5
DIRNTRY STRUC ;directory entry structure
LNK DW 0 ;ptr to next entry
NAM DB 8 DUP(0),'.' ;filename
EXT DB 3 DUP(0) ;extension
TME DW 0 ;time
DTE DW 0 ;date
SZL DW 0 ;low word of size
SZH DW 0 ;high word of size
DIRNTRY ENDS
SUBTTL DATA AREA & INITIALIZATION
PAGE
SDIR SEGMENT PUBLIC 'CODE'
ASSUME CS:SDIR,DS:SDIR,ES:SDIR
ORG 100H
MAIN PROC FAR
JMP STARTS
DIRLNK DW DIRBUF ;ptr to next opening in DIRBUF
C1LNK DW 0 ;ptr to row 1, column 1
C2LNK DW 0 ;ptr to row 1, column 2
NBRFILS DW 0 ;# of files or detail lines
SRTFLG DB 0 ;if = 0 then sort else no sort
CLSFLG DB 0 ;if = 0 then clear screen
EXTFLG DB 0 ;if <> 0 then sort by ext
SIZFLG DB 0 ;if <> 0 then sort by size
DTEFLG DB 0 ;if <> 0 then sort by date/time
PSEFLG DB 0 ;if <> 0 then pause if screen full
LPERSCR EQU 25 ;Lines per screen
LINCNT DB LPERSCR-4 ;Number of lines left
PSEMSG DB 'Strike a key when ready . . . $'
HDNG1 DB 'Sorted Disk Directory Version 2.02 '
DB 'DRIVE '
HDRVE DB '@: Date '
D_MM DW '00' ;Month
DB '/'
D_DD DW '00' ;Day
DB '/'
D_YY DW '00' ;Year
DB ' Time '
T_HH DW '00' ;Hours
DB ':'
T_MM DW '00' ;Minutes
DB CR,LF
CRLF DB CR,LF,'$'
HDNG2 DB '--FILENAME-- -SIZE- --LAST CHANGE--$'
DB 8 DUP(' ')
SPACES DB '$'
HDNG3 DB ' File(s)',CR,LF,'$'
SUBTTL DISK TRANSFER AREA & FREE SPACE ENTRY DEFS
PAGE
XFCB DB -1,7 DUP(0),11 DUP('?'),25 DUP(0)
ATTRIB EQU XFCB+6 ;file attribute
DRVNBR EQU ATTRIB+1 ;drive # (1=A, 2=B, etc.)
DTA DB 40 DUP(0) ;Disk Transfer Area used
FILNAME EQU DTA+8 ;by SRCHDIR for the
FILTIME EQU DTA+30 ;directory search.
FILSIZE EQU DTA+36
FREESPC DW 0 ;Free space entry.
DB '*FREE SPACE*',4 DUP(0)
LOSIZE DW 0 ;of free space
HISIZE DW 0 ;of free space
SUBTTL MAIN PROGRAM SECTION
PAGE
STARTS:
PUSH DS ;Set up the
XOR AX,AX ; stack for a
PUSH AX ; return to DOS.
CALL GETARGS ;Process arguments
CALL SRCHDIR ;Search directory
CMP SRTFLG,0 ;Check if any sort
JZ A1 ; option selected.
CALL LNKDIRB ;Leave in original
JMP SHORT A2 ; directory order.
A1: CALL SRTDIRB ;Sort by major key
A2: CALL GETFREE ;Get free space
CALL SPLTLST ;Set up for 2 columns
CALL PRTHDNG ;Print headings
CALL PRTDRVR ;Print detail lines
CALL PRTNFLS ;Print # of files
RET ;Return to DOS
MAIN ENDP
SUBTTL GETARGS - PROCESS ARGUMENTS
PAGE
GETARGS PROC NEAR
MOV SI,PARAM_B ;point to cmd buffer
MOV DI,OFFSET DRVNBR ;point to FCB
MOV AL, 1111B ;Select parse options
DOSCALL @PARSEF ;Parse filename
CMP BYTE PTR [DI],0 ;If <> 0 then
JNZ B1 ; not default drive
DOSCALL @GETDSK ;AL <- default disk
INC AL ;Increment drive #
STOSB ;Save drive #
B1: MOV SI,PARAM_L ;SI <- ptr cmd length
MOV CH,0
MOV CL,[SI] ;CL <- # chars in cmd
JCXZ B10
B2: INC SI ;Point to next char
CMP BYTE PTR [SI],'/'
JNZ B8 ;If not a slash
MOV AL,[SI+1] ;AL <- option letter
AND AL,0DFH ;Force to upper-case
CMP AL,'A' ;Hidden & system files?
JNZ B3 ;Nope, try next one.
MOV BYTE PTR ATTRIB,2+4 ;Hidden & system
B3: CMP AL,'E' ;Without screen erase?
JNZ B4 ;Nope, try next one.
MOV CLSFLG,AL
B4: CMP AL,'S' ;Sort by size?
JNZ B5 ;Nope, try next one.
MOV SIZFLG,AL
B5: CMP AL,'D' ;Sort by date/time?
JNZ B6 ;Nope, try next one.
MOV DTEFLG,AL
B6: CMP AL,'X' ;Sort by extension?
JNZ B7 ;Nope, try next one.
MOV EXTFLG,AL
B7: CMP AL,'N' ;Original order?
JNZ B8 ;Nope, try next one.
MOV SRTFLG,AL
B8: CMP AL,'P' ;Pause when screen full?
JNZ B9 ;Nope, try next one.
MOV PSEFLG,AL
B9: LOOP B2 ;Test for another param.
B10: RET
GETARGS ENDP
SUBTTL SRCHDIR - SEARCH DIRECTORY
PAGE
SRCHDIR PROC NEAR
DOSCALL @SETDTA,DTA ;Set DTA for dir. search
DOSCALL @SRCH1,XFCB ;First call to search dir.
C1: OR AL,AL
JNZ C2 ;Not found, quit looking.
MOV BX,DIRLNK ;BX <- base of DIRBUF
LEA DI,[BX].NAM
MOV SI,OFFSET FILNAME
MOV CX,SIZE NAM
CLD
REPZ MOVSB ;Move filename to DIRBUF
MOV BYTE PTR [DI],'.' ; Store a period
INC DI
MOV CX,SIZE EXT
REPZ MOVSB ;Move ext to DIRBUF
MOV SI,OFFSET FILTIME
MOVSW ;Move time to DIRBUF
MOVSW ;Move date to DIRBUF
MOV SI,OFFSET FILSIZE
MOVSW ;Move size to DIRBUF
MOVSW
ADD BX,SIZE DIRNTRY ;Point to next entry
MOV DIRLNK,BX ;Save ptr
INC NBRFILS ;Increment file count
DOSCALL @SRCH2,XFCB ;Search for next file
JMP C1 ;Loop for next one
C2: RET
SRCHDIR ENDP
SUBTTL SRTDIRB - SORTS ENTRIES IN DIRBUF
PAGE
SRTDIRB PROC NEAR ;Sorts directory entries in DIRBUF
MOV DI,OFFSET DIRBUF ;Point to DIRBUF
D1: CMP DI,DIRLNK ;Are there anymore?
JNC D8 ;NO, exit
MOV SI,OFFSET C1LNK ;Start with column 1 ptr
D2: MOV BX,SI
MOV SI,[BX] ;SI<-ptr to next entry
OR SI,SI
JZ D7 ;if link=0
MOV AX,SI
MOV DX,DI
XOR CL,CL ;CL <- 0
CMP CL,SIZFLG
JNZ D5 ;If sort by size
CMP CL,DTEFLG
JNZ D4 ;If sort by date/time
CMP CL,EXTFLG
JNZ D3 ;If sort by ext
LEA SI,[SI].NAM
LEA DI,[DI].NAM
MOV CX,1+SIZE NAM+SIZE EXT ;# of bytes
JMP SHORT D6
D3: LEA SI,[SI].EXT ;Sort by extension
LEA DI,[DI].EXT
MOV CX,SIZE EXT ;# of bytes
JMP SHORT D6
D4: LEA SI,[SI].DTE ;Sort by date/time
LEA DI,[DI].DTE
MOV CX,2 ;# of words
STD
REPZ CMPSW
MOV DI,DX
MOV SI,AX
JBE D2
JMP SHORT D7
D5: LEA SI,[SI].SZH ;Sort by size
LEA DI,[DI].SZH
MOV CX,2 ;# of words
STD
REPZ CMPSW
MOV DI,DX
MOV SI,AX
JBE D2
JMP SHORT D7
D6: CLD ;Sort by name.ext
REPZ CMPSB
MOV DI,DX
MOV SI,AX
JBE D2
D7: MOV [DI],SI
MOV [BX],DI
ADD DI,SIZE DIRNTRY ;Point to next entry
JMP D1
D8: RET
SRTDIRB ENDP
SUBTTL
PAGE
; LNKDIRB - LINKS ENTRIES IN DIRBUF
LNKDIRB PROC NEAR ;LINK ENTRIES IN DIRBUF
MOV DI,OFFSET DIRBUF
MOV C1LNK,DI ;Point to 1st entry
MOV CX,NBRFILS ;Set loop counter
DEC CX
LNK1: MOV BX,DI
ADD DI,SIZE DIRNTRY ;Offset to next entry
MOV [BX],DI ;Store ptr
LOOP LNK1 ;Link next entry
MOV [DI],CX ;Last ptr <- null
RET
LNKDIRB ENDP
; SPLTLST - SPLITS LINKED LIST IN HALF
SPLTLST PROC NEAR
MOV CX,NBRFILS ;Get # of entries
SAR CX,1 ; and divide by 2
JZ F2 ;if NBRFILS < 2
ADC CL,0 ;Account for odd #
MOV BX,OFFSET C1LNK
F1: MOV BX,[BX] ;Chain thru list to
LOOP F1 ; last row of column 1.
MOV AX,[BX] ;Get ptr to 1st row of col 2
MOV C2LNK,AX ; C2LNK <- R1,C2 ptr
MOV [BX],CX ;Last row of col 1 <- null
F2: RET
SPLTLST ENDP
SUBTTL GETFREE - GET DISK FREE SPACE
PAGE
GETFREE PROC NEAR ;cluster = allocation unit
MOV DL,DRVNBR ;Get drive #
PUSH DS ;Save DS
DOSCALL @FATAD2 ;Get FAT info from DOS
MOV AH,0 ;AL = sector size
XCHG CX,DX ;Sector size times the
MUL DX ; # sectors/cluster
PUSH AX ;Save cluster size
XOR AX,AX ;Unused clusters = 0
MOV SI,2 ;Skip first 3 clusters
E1: MOV DI,SI ;DI <- cluster #
SHR DI,1 ;Divide cluster number
ADD DI,SI ; by 1.5
MOV DI,[BX+DI] ;Fetch from FAT
TEST SI,1 ;Test if even or odd
JZ E2 ;If even then skip
SHR DI,1 ; else if odd
SHR DI,1 ; right justify the
SHR DI,1 ; cluster number.
SHR DI,1
E2: AND DI,0FFFH ;Mask the low 12 bits
JNZ E3 ;If not 0 then skip, else
INC AX ; increment counter.
E3: INC SI ;Point to next cluster
LOOP E1 ; and go check it.
POP CX ;Get cluster size, times
MUL CX ; # of free clusters
POP DS ;Restore DS
MOV LOSIZE,AX ;Save the 32 bit
MOV HISIZE,DX ; binary free space
MOV BX,C1LNK ;Insert FREESPC in
MOV DI,OFFSET FREESPC ;first position
MOV [DI],BX ; of linked list of
MOV C1LNK,DI ; directory entries.
INC NBRFILS ;Bump # of entries
RET
GETFREE ENDP
SUBTTL PRTHDNG - PRINT HEADINGS
PAGE
PRTHDNG PROC NEAR
MOV AL,CLSFLG
OR AL,AL
JNZ G1 ;If not erase screen
SUB CX,CX
MOV DX,24*256+79 ;row=24 col=79
MOV BH,7 ;Video mode
MOV AX,0600H
INT 10H ;BIOS video call
SUB DX,DX
MOV AH,2 ;Clear screen
MOV BH,0
INT 10H ;BIOS video call
G1: MOV AL,DRVNBR ;Get drive #
ADD HDRVE,AL ;Convert to ascii
DOSCALL @GETDTE ; CX<-year, DH<-month, DL<-day
MOV AL,DH
AAM
XCHG AL,AH
OR D_MM,AX ;Fold into month
MOV AL,DL
AAM
XCHG AL,AH
OR D_DD,AX ;Fold into day
MOV AX,CX
SUB AX,1900
AAM
XCHG AL,AH
OR D_YY,AX ;Fold into year
DOSCALL @GETTME ; CH<-hours, CL<-minutes
MOV AL,CH ;AL<-binary hours
AAM ;Convert AL to two
XCHG AL,AH ; BCD digits in AX.
OR T_HH,AX ;Fold into hours
MOV AL,CL ;AL<-binary minutes
AAM ;Convert AL to two
XCHG AL,AH ; BCD digits in AX.
OR T_MM,AX ;Fold into minutes
DOSCALL @STROUT,HDNG1 ;Print main heading
DOSCALL @STROUT,HDNG2 ;Print column 1 heading
CMP WORD PTR C2LNK,0
JZ G2 ;If not 2 columns
DOSCALL @STROUT,SPACES-5 ;Print 5 spaces
DOSCALL @STROUT,HDNG2 ;Print column 2 heading
G2: DOSCALL @STROUT,CRLF ;Start a new line
RET
PRTHDNG ENDP
SUBTTL PRINT DETAIL LINES
PAGE
PRTDRVR PROC NEAR ;Driver routine
MOV BX,C1LNK
OR BX,BX ;more to print?
JZ H2 ; no, return
MOV AX,[BX]
MOV C1LNK,AX
CALL PRTDTL ;print column one
MOV BX,C2LNK
OR BX,BX
JZ H1 ;If no column 2 entry
DOSCALL @STROUT,SPACES-5 ;print 5 spaces
MOV AX,[BX]
MOV C2LNK,AX
CALL PRTDTL ;print column two
H1: DOSCALL @STROUT,CRLF
CMP PSEFLG,0 ;Check for pause option
JZ PRTDRVR ;Nope, continue
DEC LINCNT ;Decrement line counter
JNZ PRTDRVR ;If page not full?
MOV LINCNT,LPERSCR-2 ;Reset to # lines/screen
DOSCALL @STROUT,PSEMSG ;Display pause message.
MOV AL,@KEYIN ;Specify input function
DOSCALL @CKEYIN ;Wait for key press
DOSCALL @STROUT,CRLF ;Set to new line
JMP PRTDRVR ;Go do the next line
H2: RET
PRTDRVR ENDP
PRTDTL PROC NEAR ;Prints file.ext, size, date & time
MOV CX,1+SIZE NAM+SIZE EXT
SUB DI,DI ;DI <- 0
I1: DOSCALL @CHROUT,[BX+DI].NAM
INC DI ;point to next char.
LOOP I1 ;go do next char.
PUSH BX ;save entry base
MOV SI,[BX].SZL ;SI <- low size
MOV DI,[BX].SZH ;DI <- high size
CALL PRINTDD ;Print size
POP BX ;restore entry base
DOSCALL @STROUT,SPACES-2 ;print 2 spaces
MOV AX,[BX].DTE ;AX <- packed date
CALL PRTDTE
DOSCALL @STROUT,SPACES-2 ;print 2 spaces
MOV AX,[BX].TME ;AX <- packed time
CALL PRTTME
RET
PRTDTL ENDP
SUBTTL PRINTDD - PRINT A DOUBLE WORD IN DI:SI
PAGE
PRINTDD PROC NEAR ;Prints a 32 bit integer in DI:SI
XOR AX,AX ;Zero out the
MOV BX,AX ; working
MOV BP,AX ; registers.
MOV CX,32 ;# bits of precision
J1: SHL SI,1
RCL DI,1
XCHG BP,AX
CALL J6
XCHG BP,AX
XCHG BX,AX
CALL J6
XCHG BX,AX
ADC AL,0
LOOP J1
MOV CX,1710H ;5904 ?
MOV AX,BX
CALL J2
MOV AX,BP
J2: PUSH AX
MOV DL,AH
CALL J3
POP DX
J3: MOV DH,DL
SHR DL,1 ;Move high
SHR DL,1 ; nibble to
SHR DL,1 ; the low
SHR DL,1 ; position.
CALL J4
MOV DL,DH
J4: AND DL,0FH ;Mask low nibble
JZ J5 ;If not zero
MOV CL,0
J5: DEC CH
AND CL,CH
OR DL,'0' ;Fold in ASCII zero
SUB DL,CL
DOSCALL @CHROUT ;Print next digit
RET ;Exit to caller
PRINTDD ENDP
J6 PROC NEAR
ADC AL,AL
DAA
XCHG AL,AH
ADC AL,AL
DAA
XCHG AL,AH
RET
J6 ENDP
SUBTTL PRINT DATE, TIME & # FILES ROUTINES
PAGE
PRTDTE PROC NEAR ;Print packed date in AX as MM/DD/YY
OR AX,AX
JNZ K1 ;If date <> 0
DOSCALL @STROUT,SPACES-8 ;Print 8 spaces
RET
K1: PUSH AX
AND AX,MASK P_MO ;Mask the month,
MOV CL,P_MO ; set shift count,
SHR AX,CL ; right justify, &
CALL PRTBCD ; print it.
DOSCALL @CHROUT,'/'
POP AX
PUSH AX
AND AX,MASK P_DY ;Mask the day &
CALL PRTBCD ; print it.
DOSCALL @CHROUT,'/'
POP AX
AND AX,MASK P_YR ;Mask the year,
MOV CL,P_YR ; set shift count,
SHR AX,CL ; right justify,
ADD AX,80 ; add in year bias, &
; print it.
PRTBCD: AAM ;Convert AL to BCD
OR AX,'00' ;Convert to ASCII
PUSH AX
DOSCALL @CHROUT,AH ;High order digit
POP AX
DOSCALL @CHROUT,AL ;Low order digit
RET
PRTDTE ENDP
PRTTME PROC NEAR ;Print packed time in AX as HH:MM
OR AX,AX
JNZ L1
DOSCALL @STROUT,SPACES-5 ;Print 5 spaces
RET
L1: PUSH AX
AND AX,MASK P_HR ;Mask the hours,
MOV CL,P_HR ; set shift count,
SHR AX,CL ; right justify, &
CALL PRTBCD ; print it.
DOSCALL @CHROUT,':'
POP AX
AND AX,MASK P_MI ;Mask the minutes,
MOV CL,P_MI ; set shift count,
SHR AX,CL ; right justify, &
CALL PRTBCD ; print it.
RET
PRTTME ENDP
PRTNFLS PROC NEAR ;print number of files
MOV SI,NBRFILS ;get # of files
DEC SI ;-1 for free space
XOR DI,DI ;zero high order
CALL PRINTDD ;Print # of files
DOSCALL @STROUT,HDNG3
RET
PRTNFLS ENDP
EVEN
DIRBUF DIRNTRY <> ;Buffer for directory entr
;
;
;SOMETHING IS MISSING AFTER THIS!!
; I'VE FILLED IN THE TWO STATEMENTS BELOW.
;THERE MAY STILL BE BUGS.
;
;
SDIR ENDS
END MAIN
TABLET.BAS
1 ' This program was uploaded to the Capital PC Users Group Software Exchange
2 ' Host system by Alex Hobbs of Raleigh NC on 11-12-82 at 17:20
50 KEY OFF
1000 GOTO 5000
1010 C$=INKEY$:IF C$="" THEN GOTO 1010
1020 C=ASC(RIGHT$(C$,1)):IF LEN(C$)=1 AND (C<48 OR C>57) AND C <> 32 AND C <> 13 THEN GOTO 1010
1030 RETURN
1040 GET (CX-10,CY-8)-(CX+10,CY+8),UCUR:PUT(CX-10,CY-8),CUR,>=:RETURN
1050 PUT (CX-10,CY-8),UCUR,PSET:ECOL=POINT(CX,CY):RETURN
1060 GOSUB 1050:T=C-71
1070 CX=CX+RX*DX(T)
1080 IF CX<10 THEN CX=10:BEEP ELSE IF CX>299 THEN CX=299:BEEP
1090 CY=CY+RY*DY(T)
1100 IF CY<8 THEN CY=8:BEEP ELSE IF CY>183 THEN CY=183:BEEP
1110 ON SKETCH GOTO 1345, 1390,1355, 1365, 1415, 1375, 1040, 1040, 1480, 1040
1120 T=C-48:IF T=0 THEN RX=PIC(0)/2:RY=PIC(1):RETURN
1130 RX=(8*(T)-4)/3:RY=2*(T)-1:RETURN
1140 COLOR BACK:GOSUB 1010:IF C<>32 THEN RETURN 5020
1150 BACK=BACK+1:IF BACK>15 THEN BACK=0
1160 GOTO 1140
1170 GET (124,90)-(195,107),HOLD
1180 COLOR,PAL
1190 LINE (124,90)-(147,107),1,BF:LINE(148,90)-(171,107),2,BF:LINE(172,90)-(195,107),3,BF
1200 GOSUB 1010:IF C<>32 THEN PUT (124,90),HOLD,PSET:RETURN 5020
1210 PAL=1-PAL:GOTO 1180
1220 GET (124,90)-(195,107),HOLD
1230 LINE (124,90)-(195,107),COL,BF
1240 GOSUB 1010:IF C<>32 THEN PUT (124,90),HOLD,PSET:RETURN 5020
1250 COL=COL+1:IF COL>3 THEN COL=0
1260 GOTO 1230
1270 GET (124,90)-(195,107),PIC
1280 LINE(124,90)-(195,107),BND,BF
1290 GOSUB 1010:IF C<>32 THEN PUT (124,90),PIC,PSET:RETURN 5020
1300 BND=BND+1:IF BND>3 THEN BND=0
1310 GOTO 1280
1320 COL=BND:RETURN
1330 ON C-58 GOTO 1340, 1380,1350,1362,1410,1370,1220,1270,1470,1560
1340 GOSUB 1050
1345 LX=CX:LY=CY:PSET(CX,CY),BND:GOSUB 1040:RETURN
1350 GOSUB 1050
1355 LINE (LX,LY)-(CX,CY),BND:GOSUB 1040
1360 OX=LX:OY=LY:LX=CX:LY=CY:RETURN
1362 GOSUB 1050
1365 LINE (LX,LY)-(CX,CY),BND:GOTO 1040
1370 GOSUB 1050
1375 LINE (LX,LY)-(CX,CY),BND,B:GOSUB 1040:RETURN
1380 GOSUB 1050
1390 TX=ABS(CX-LX):TY=6*ABS(CY-LY)/5:CIRCLE(LX,LY),SQR(TX*TX+TY*TY),BND:GOTO 1040
1410 GOSUB 1050
1415 PAINT (CX,CY),COL,BND:GOSUB 1040:RETURN
1430 ON C-103 GOTO 1670,1630,8000,1820,1440,1440,1140,1170,1570,1850
1440 BEEP:RETURN
1470 GOSUB 1050
1480 IF CX+PIC(0)/2>320 THEN BEEP:GOTO 1040
1490 TY=PIC(1):IF CY+PIC(1)>200 THEN PIC(1)=200-CY
1500 ON PMODE GOSUB 1520,1530,1540,1550
1510 PIC(1)=TY:GOTO 1040
1520 PUT(CX,CY),PIC,PSET:RETURN
1530 PUT(CX,CY),PIC,>=:RETURN
1540 PUT(CX,CY),PIC,OR:RETURN
1550 PUT(CX,CY),PIC,AND:RETURN
1560 GOSUB 1050:GET(LX,LY)-(CX,CY),PIC:GOSUB 1040:RETURN
1570 GET(124,90)-(195,107),HOLD
1580 T$="PSETXOR OR AND "
1590 LOCATE 13,19:PRINT " ";MID$(T$,4*PMODE-3,4);" ";
1600 GOSUB 1010:IF C<>32 THEN PUT (124,90),HOLD,PSET:RETURN 5020
1610 PMODE=PMODE+1:IF PMODE>4 THEN PMODE=1
1620 GOTO 1590
1621 SKETCH=C-83:RETURN
1630 TYPE$="loaded":GOSUB 1710
1640 IF NAMEF$="" THEN RETURN
1650 DEF SEG=&HB800:BLOAD DRIVE$+":"+NAMEF$+".PIC",0
1660 GOTO 1040
1670 TYPE$="saved":GOSUB 1710
1680 IF NAMEF$="" THEN RETURN ELSE ON ERROR GOTO 1700
1690 GOSUB 1050:DEF SEG=&HB800:BSAVE DRIVE$+":"+NAMEF$+".PIC",0,&H4000:GOTO 1040
1700 LOCATE 1,1:PRINT "Unable to save picture ";:GOSUB 1010:PUT(0,0),HOLD,PSET:GOSUB 1040:RETURN 5020
1710 GET (0,0)-(319,7),HOLD
1720 LOCATE 1,1:PRINT SPACE$(39);:LOCATE 1,1
1730 PRINT"name of picture to be ";TYPE$;
1740 LINE INPUT": ";NAMEF$
1750 IF NAMEF$="" GOTO 1810
1760 NAMEF$=LEFT$(NAMEF$,8)
1770 LOCATE 1,1:PRINT SPACE$(39);:LOCATE 1,1
1780 LINE INPUT;" Drive picture is on (default=A): ";DRIVE$
1790 IF DRIVE$="" THEN DRIVE$="A"
1800 IF DRIVE$="a" OR DRIVE$="A" OR DRIVE$="B" OR DRIVE$="b" OR DRIVE$="D" OR DRIVE$= "d" GOTO 1810 ELSE GOTO 1770
1810 PUT (0,0),HOLD,PSET:RETURN
1820 GET (0,0)-(319,31),HOLD:GOSUB 1770
1825 ON ERROR GOTO 1835
1830 LOCATE 1,1:FILES DRIVE$+":*.PIC":GOTO 1840
1835 LOCATE 1,1:PRINT "Picture not found ";
1840 GOSUB 1010:PUT(0,0),HOLD,PSET:RETURN 5020
1850 GOSUB 1050:LOCATE (CY+4)/8,(CX+4)/8:LINE INPUT "";T$:GOTO 1040
2000 ON C-93 GOTO 2100,2200,2300,2400,1440,2500,1440,2600,1440,2700
2100 T=BND:BND=ECOL:GOSUB 1340:BND=T:RETURN
2200 T=BND:BND=ECOL:GOSUB 1380:BND=T:RETURN
2300 T=BND:BND=ECOL:LX=OX:LY=OY:GOSUB 1362:BND=T:RETURN
2400 T=BND:BND=ECOL:GOSUB 1362:BND=T:RETURN
2500 T=BND:BND=ECOL:GOSUB 1370:BND=T:RETURN
2600 GOSUB 1050:LINE (LX,LY)-(CX,CY),COL,BF:GOSUB 1040:RETURN
2700 CLS:GOSUB 1040:RETURN
5000 GOSUB 5070
5010 GOSUB 1010
5020 IF C>=48 AND C<=57 THEN GOSUB 1120
5030 IF C>=59 AND C<=68 THEN GOSUB 1330
5040 IF C>=71 AND C<=81 THEN GOSUB 1060
5045 IF C>=84 AND C<=93 THEN GOSUB 1621
5047 IF C>=94 AND C<=103 THEN GOSUB 2000
5050 IF C>=104 AND C<=113 THEN GOSUB 1430
5060 GOTO 5010
5070 DEFINT A-Z
5080 DIM HLPD(8001),PIC(8001),CUR(52),UCUR(52),DX(10),DY(10),HOLD(1281)
5100 BACK=0:PAL=1:COL=3:BND=3:PMODE=2:SKETCH=10
5105 GOSUB 6000
5110 KEY OFF:SCREEN 1,0:COLOR BACK,PAL
5130 CLS:GET (0,0)-(0,0),PIC
5140 LINE (0,8)-(6,8):LINE(14,8)-(20,8)
5150 LINE(10,0)-(10,4):LINE(10,12)-(10,16)
5160 GET (0,0)-(20,16),CUR
5180 CLS:CX=159:CY=99:GOSUB 1040:GOSUB 1340:C=57:GOSUB 1120
5190 DATA -1,-1,0,-1,1,-1,0,0,-1,0,0,0,1,0,0,0,-1,1,0,1,1,1
5200 FOR I=0 TO 10:READ DX(I),DY(I):NEXT
5210 FOR I=1 TO 10:KEY I,"":NEXT
5220 RETURN
6000 CLS:PRINT " TABLET"
6001 PRINT
6002 PRINT
6003 PRINT "This program can be used with the IBM Color Graphics Adapter"
6004 PRINT "and Advanced Basic, to produce picture (.PIC) files, in color"
6005 PRINT
6006 PRINT "To get instructions, press ALT-F3 any time"
6007 LOCATE 25,1:PRINT "(Press any key) to start the program";
6008 GOTO 1010
7000 CLS:WIDTH 80:PRINT " TABLET: INSTRUCTIONS:":PRINT:PRINT"- Use numeric keypad to move graphics cursor."
7001 PRINT :PRINT"- Press number to set distance of cursor move."
7002 PRINT :PRINT "- Use 'F' Keys to perform graphics functions."
7003 PRINT
7004 PRINT:PRINT " F KEYS MAY BE USED IN 4 MODES:":PRINT
7005 PRINT " - Alone: perform basic graphics functions."
7006 PRINT " - Shift: causes basic function to perform each"
7007 PRINT " time cursor is moved."
7008 PRINT " - Ctrl : same as basic function, but erase."
7009 PRINT " - Alt : perform over-all screen and system"
7010 PRINT " functions."
7020 LOCATE 25,1:PRINT "press any key to see next page.";
7021 C$=INKEY$:IF C$="" THEN 7021
7030 CLS:PRINT " TABLET: ";
7031 PRINT " BASIC GRAPHICS FUNCTIONS: (F key functions)"
7033 PRINT:PRINT " 1 POINT - etches a point and sets the reference point"
7034 PRINT " 2 CIRCLE - draws a circle around the reference point"
7035 PRINT " 3 CONNECT - draws a line to reference point,"
7036 PRINT " and resets the reference point."
7037 PRINT " 4 LINE - draws a line to reference point."
7038 PRINT " 5 PAINT - paints the area at cursor with color"
7039 PRINT " defined in F7. Boundaries of paint "
7040 PRINT " are defined by the color from F8."
7041 PRINT " 6 BOX - draws a box from reference point corner"
7042 PRINT " to cursor point corner."
7043 PRINT " 7 PCOLOR - color to use for paint in F5."
7044 PRINT " 8 LCOLOR - color of lines and points drawn."
7045 PRINT " Also, color of boundary for F5."
7046 PRINT " 9 FIGURE - Place copy from F10 in space whose"
7047 PRINT " upper left corner is cursor position."
7048 PRINT " 10 COPY - Take a copy of screen portion whose "
7049 PRINT " upper left corner is reference point"
7050 PRINT " and lower left corner is cursor point."
7051 PRINT " This copy may be placed anywhere on "
7052 PRINT " screen with F9."
7053 LOCATE 25,1:PRINT "press any key to see next page...";
7054 C$=INKEY$:IF C$="" THEN 7054
7060 CLS:PRINT " TABLET: SCREEN AND SYSTEM FUNCTIONS: (ALT Fkeys)"
7061 PRINT:PRINT " 1 SAVE - saves the screen on disk (.PIC file)"
7062 PRINT:PRINT " 2 LOAD - loads a .PIC file from disk to screen."
7063 PRINT:PRINT " 3 HELP - displays this explanation"
7064 PRINT:PRINT " 4 FILES- displays all .PIC file names on a given disk."
7065 PRINT:PRINT " 7 BACKGRND- select screen background color"
7066 PRINT:PRINT " 8 PALETTE - select color choice."
7067 PRINT:PRINT " 9 PMODE - select action to use with 'PUT' for F9"
7068 PRINT " (see page 4-200 of BASIC manual)."
7069 PRINT:PRINT " 10 TEXT - print text on screen in color from F8"
7070 PRINT:PRINT:PRINT"(For 7,8, and 9 - present setting is displayed"
7071 PRINT " on screen. Roll past choices by pressing "
7072 PRINT " space bar, then ENTER to set new choice.)"
7079 LOCATE 25,1:PRINT "press any key to go back to graphics...";
7080 C$=INKEY$:IF C$="" THEN 7080
7090 CLS:SCREEN 1,0:COLOR BACK,PAL
7100 PUT (0,0),HLPD:RETURN
8000 GET (0,0)-(319,199),HLPD
8001 GOTO 7000
TICCLOCK.BAS
0 '************************************************************
1 '* *
2 '* Author: Mike J. Sullivan , Houston, Tx. *
3 '* 12402 Campos Dr. ,Houston, Tx. 77065 *
4 '* Date: 09/05/82 *
5 '* Purpose: Display your Basic Programs *
6 '* Title: Digital Clock *
7 '* Comment(s): enjoy *
8 '* *
9 '************************************************************
10 KEY OFF
11 ODD = 0
12 Q15$ = "MbMLP14O4EO4CDO3G"
13 Q30$ = "MbMLP14O3GO4DEC"
15 CHIME = 0
20 LOCATE ,,0
21 '
22 ' Day of week / Date rollover for Mike Sullivan's digital clock
23 ' This code was merged into the original program already..
24 ' Day of week will be displayed;
25 ' day and date will change following 23:59:59.
26 ' You can also use the perpetual calendar routine in other programs.
27 ' Clayton Gaskill, Charlotte, NC
28 ' BASICA required!!!!!!!!!!
30 CLS
31 ' Tick and Tock for Mike Sullivan's Digital Clock. This merge was placed
32 ' into his clock to add tick,tock and Big Ben's chimes
33 ' Willis Frick, 8359 Amber Rose Lane, Rosemead, Ca. 91770,213 572 2738
35 ' The tick, tock and chimes will work with/without Clayton Gaskill
36 ' I have added all the enhancements to sullivans clock from these sources
37 ' Rich Schinnell Capital PC Software Exchange, 1982 November 21
40 LOCATE 2,19:PRINT "M I K E S U L L I V A N ' S --- I B M ---"
50 LOCATE 4,19:PRINT " DIGITAL CLOCK 1 . 1 0 "
60 GOSUB 4060
240 DIM ONE$(7),TWO$(7),THR$(7),FOU$(7),FIV$(7)
250 DIM SIX$(7),SEV$(7),EIG$(7),NIN$(7),ZER$(7),TEMP$(7)
260 XH1=0.1:XH2=0.1:XM1=0.1:XM2=0.2:XS1=0.1:XS2=0.1
270 COL$(1)=" "
280 COL$(2)=" "
290 COL$(3)=STRING$(2,CHR$(219))
300 COL$(4)=" "
310 COL$(5)=STRING$(2,CHR$(219))
320 COL$(6)=" "
330 COL$(7)=" "
340 ONE$(1)=" "+STRING$(3,CHR$(219))+" "
350 ONE$(2)=" "+CHR$(219)+CHR$(219)+" "
360 ONE$(3)=" "+CHR$(219)+CHR$(219)+" "
370 ONE$(4)=" "+CHR$(219)+CHR$(219)+" "
380 ONE$(5)=" "+CHR$(219)+CHR$(219)+" "
390 ONE$(6)=" "+CHR$(219)+CHR$(219)+" "
400 ONE$(7)=" "+STRING$(6,CHR$(219))+" "
410 TWO$(1)=STRING$(8,CHR$(219))
420 TWO$(2)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
430 TWO$(3)=" "+CHR$(219)+CHR$(219)
440 TWO$(4)=STRING$(8,CHR$(219))
450 TWO$(6)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
460 TWO$(5)=CHR$(219)+CHR$(219)+" "
470 TWO$(7)=STRING$(8,CHR$(219))
480 THR$(1)=STRING$(8,CHR$(219))
490 THR$(2)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
500 THR$(3)=" "+CHR$(219)+CHR$(219)
510 THR$(4)=STRING$(8,CHR$(219))
520 THR$(5)=" "+CHR$(219)+CHR$(219)
530 THR$(6)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
540 THR$(7)=STRING$(8,CHR$(219))
550 FOU$(1)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
560 FOU$(2)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
570 FOU$(3)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
580 FOU$(4)=STRING$(8,CHR$(219))
590 FOU$(6)=" "+CHR$(219)+CHR$(219)
600 FOU$(5)=" "+CHR$(219)+CHR$(219)
610 FOU$(7)=" "+CHR$(219)+CHR$(219)
620 FIV$(1)=STRING$(8,CHR$(219))
630 FIV$(2)=CHR$(219)+CHR$(219)+" "
640 FIV$(3)=CHR$(219)+CHR$(219)+" "
650 FIV$(4)=STRING$(8,CHR$(219))
660 FIV$(6)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
670 FIV$(5)=" "+CHR$(219)+CHR$(219)
680 FIV$(7)=STRING$(8,CHR$(219))
690 SIX$(1)=STRING$(8,CHR$(219))
700 SIX$(2)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
710 SIX$(3)=CHR$(219)+CHR$(219)+" "
720 SIX$(4)=STRING$(8,CHR$(219))
730 SIX$(6)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
740 SIX$(5)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
750 SIX$(7)=STRING$(8,CHR$(219))
760 SEV$(1)=STRING$(8,CHR$(219))
770 SEV$(2)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
780 SEV$(3)=" "+CHR$(219)+CHR$(219)
790 SEV$(4)=" "+CHR$(219)+CHR$(219)
800 SEV$(5)=" "+CHR$(219)+CHR$(219)
810 SEV$(6)=" "+CHR$(219)+CHR$(219)
820 SEV$(7)=" "+CHR$(219)+CHR$(219)
830 EIG$(1)=STRING$(8,CHR$(219))
840 EIG$(2)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
850 EIG$(3)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
860 EIG$(4)=STRING$(8,CHR$(219))
870 EIG$(5)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
880 EIG$(6)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
890 EIG$(7)=STRING$(8,CHR$(219))
900 NIN$(1)=STRING$(8,CHR$(219))
910 NIN$(2)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
920 NIN$(3)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
930 NIN$(4)=CHR$(219)+STRING$(7,CHR$(219))
940 NIN$(6)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
950 NIN$(5)=" "+CHR$(219)+CHR$(219)
960 NIN$(7)=STRING$(8,CHR$(219))
970 ZER$(1)=STRING$(8,CHR$(219))
980 ZER$(2)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
990 ZER$(3)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
1000 ZER$(4)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
1010 ZER$(5)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
1020 ZER$(6)=CHR$(219)+CHR$(219)+" "+CHR$(219)+CHR$(219)
1030 ZER$(7)=CHR$(219)+STRING$(7,CHR$(219))
1040 H1=VAL(MID$(TIME$,1,1))
1050 H2=VAL(MID$(TIME$,2,1))
1060 M1=VAL(MID$(TIME$,4,1))
1070 M2=VAL(MID$(TIME$,5,1))
1080 S1=VAL(MID$(TIME$,7,1))
1090 S2=VAL(MID$(TIME$,8,1))
1095 XDA$=MID$(DATE$,4,2)
1100 Z$=INKEY$:IF Z$="" THEN 1101 ELSE END
1101 MIN = VAL(MID$(TIME$,4,2))
1102 HOUR = VAL(MID$(TIME$,1,2))
1103 IF HOUR = 0 THEN HOUR = 12
1104 IF CHIME = 1 AND MIN = 0 THEN GOSUB 10090
1105 IF CHIME = 1 AND MIN = 15 THEN GOSUB 10090
1106 IF CHIME = 1 AND MIN = 30 THEN GOSUB 10090
1107 IF CHIME = 1 AND MIN = 45 THEN GOSUB 10090
1108 IF (MIN = 14) OR (MIN = 29) OR (MIN = 44) OR (MIN = 59) OR (MIN = 16) OR (MIN = 31) OR (MIN = 46) OR (MIN = 1) THEN CHIME = 1
1110 IF S2=XS2 THEN 1040
1111 GOSUB 10000
1115 IF DA$<>XDA$ THEN GOSUB 4060
1120 IF H1=0 THEN 1130 ELSE 1170
1130 IF H1=XH1 THEN 1450 ELSE XH1=H1
1140 FOR I=1 TO 7
1150 TEMP$(I)=ZER$(I):NEXT I
1160 GOSUB 3100:GOTO 1450
1170 IF H1=XH1 THEN 1450 ELSE XH1=H1
1180 ON H1 GOTO 1190,1220,1250,1280,1310,1340,1370,1400,1430
1190 FOR I=1 TO 7
1200 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3100
1210 GOTO 1450
1220 FOR I=1 TO 7
1230 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3100
1240 GOTO 1450
1250 FOR I=1 TO 7
1260 TEMP$(I)=THR$(I):NEXT I:GOSUB 3100
1270 GOTO 1450
1280 FOR I=1 TO 7
1290 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3100
1300 GOTO 1450
1310 FOR I=1 TO 7
1320 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3100
1330 GOTO 1450
1340 FOR I=1 TO 7
1350 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3100
1360 GOTO 1450
1370 FOR I=1 TO 7
1380 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3100
1390 GOTO 1450
1400 FOR I=1 TO 7
1410 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3100
1420 GOTO 1450
1430 FOR I=1 TO 7
1440 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3100
1450 IF H2=0 THEN 1460 ELSE 1500
1460 IF H2=XH2 THEN 1790 ELSE XH2=H2
1470 FOR I=1 TO 7
1480 TEMP$(I)=ZER$(I):NEXT I
1490 GOSUB 3140:GOTO 1790
1500 IF H2=XH2 THEN 1790 ELSE XH2=H2
1510 ON H2 GOTO 1520,1550,1580,1610,1640,1670,1700,1730,1760
1520 FOR I=1 TO 7
1530 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3140
1540 GOTO 1790
1550 FOR I=1 TO 7
1560 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3140
1570 GOTO 1790
1580 FOR I=1 TO 7
1590 TEMP$(I)=THR$(I):NEXT I:GOSUB 3140
1600 GOTO 1790
1610 FOR I=1 TO 7
1620 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3140
1630 GOTO 1790
1640 FOR I=1 TO 7
1650 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3140
1660 GOTO 1790
1670 FOR I=1 TO 7
1680 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3140
1690 GOTO 1790
1700 FOR I=1 TO 7
1710 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3140
1720 GOTO 1790
1730 FOR I=1 TO 7
1740 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3140
1750 GOTO 1790
1760 FOR I=1 TO 7
1770 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3140
1780 GOTO 3090
1790 IF M1=0 THEN 1800 ELSE 1840
1800 IF M1=XM1 THEN 2120 ELSE XM1=M1
1810 FOR I=1 TO 7
1820 TEMP$(I)=ZER$(I):NEXT I
1830 GOSUB 3210:GOTO 2120
1840 IF M1=XM1 THEN 2120 ELSE XM1=M1
1850 ON M1 GOTO 1860,1890,1920,1950,1980,2010,2040,2070,2100
1860 FOR I=1 TO 7
1870 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3210
1880 GOTO 2120
1890 FOR I=1 TO 7
1900 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3210
1910 GOTO 2120
1920 FOR I=1 TO 7
1930 TEMP$(I)=THR$(I):NEXT I:GOSUB 3210
1940 GOTO 2120
1950 FOR I=1 TO 7
1960 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3210
1970 GOTO 2120
1980 FOR I=1 TO 7
1990 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3210
2000 GOTO 2120
2010 FOR I=1 TO 7
2020 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3210
2030 GOTO 2120
2040 FOR I=1 TO 7
2050 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3210
2060 GOTO 2120
2070 FOR I=1 TO 7
2080 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3210
2090 GOTO 2120
2100 FOR I=1 TO 7
2110 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3210
2120 IF M2=0 THEN 2130 ELSE 2170
2130 IF M2=XM2 THEN 2450 ELSE XM2=M2
2140 FOR I=1 TO 7
2150 TEMP$(I)=ZER$(I):NEXT I
2160 GOSUB 3250:GOTO 2450
2170 IF M2=XM2 THEN 2450 ELSE XM2=M2
2180 ON M2 GOTO 2190,2220,2250,2280,2310,2340,2370,2400,2430
2190 FOR I=1 TO 7
2200 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3250
2210 GOTO 2450
2220 FOR I=1 TO 7
2230 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3250
2240 GOTO 2450
2250 FOR I=1 TO 7
2260 TEMP$(I)=THR$(I):NEXT I:GOSUB 3250
2270 GOTO 2450
2280 FOR I=1 TO 7
2290 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3250
2300 GOTO 2450
2310 FOR I=1 TO 7
2320 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3250
2330 GOTO 2450
2340 FOR I=1 TO 7
2350 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3250
2360 GOTO 2450
2370 FOR I=1 TO 7
2380 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3250
2390 GOTO 2450
2400 FOR I=1 TO 7
2410 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3250
2420 GOTO 2450
2430 FOR I=1 TO 7
2440 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3250
2450 IF S1=0 THEN 2460 ELSE 2500
2460 IF S1=XS1 THEN 2780 ELSE XS1=S1
2470 FOR I=1 TO 7
2480 TEMP$(I)=ZER$(I):NEXT I
2490 GOSUB 3320:GOTO 2780
2500 IF S1=XS1 THEN 2780 ELSE XS1=S1
2510 ON S1 GOTO 2520,2550,2580,2610,2640,2670,2700,2730,2760
2520 FOR I=1 TO 7
2530 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3320
2540 GOTO 2780
2550 FOR I=1 TO 7
2560 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3320
2570 GOTO 2780
2580 FOR I=1 TO 7
2590 TEMP$(I)=THR$(I):NEXT I:GOSUB 3320
2600 GOTO 2780
2610 FOR I=1 TO 7
2620 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3320
2630 GOTO 2780
2640 FOR I=1 TO 7
2650 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3320
2660 GOTO 2780
2670 FOR I=1 TO 7
2680 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3320
2690 GOTO 2780
2700 FOR I=1 TO 7
2710 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3320
2720 GOTO 2780
2730 FOR I=1 TO 7
2740 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3320
2750 GOTO 2780
2760 FOR I=1 TO 7
2770 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3320
2780 IF S2=0 THEN 2790 ELSE 2820
2790 FOR I=1 TO 7
2800 TEMP$(I)=ZER$(I):NEXT I
2810 GOSUB 3360:GOTO 3090
2820 XS2=S2:ON S2 GOTO 2830,2860,2890,2920,2950,2980,3010,3040,3070
2830 FOR I=1 TO 7
2840 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3360
2850 GOTO 3090
2860 FOR I=1 TO 7
2870 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3360
2880 GOTO 3090
2890 FOR I=1 TO 7
2900 TEMP$(I)=THR$(I):NEXT I:GOSUB 3360
2910 GOTO 3090
2920 FOR I=1 TO 7
2930 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3360
2940 GOTO 3090
2950 FOR I=1 TO 7
2960 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3360
2970 GOTO 3090
2980 FOR I=1 TO 7
2990 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3360
3000 GOTO 3090
3010 FOR I=1 TO 7
3020 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3360
3030 GOTO 3090
3040 FOR I=1 TO 7
3050 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3360
3060 GOTO 3090
3070 FOR I=1 TO 7
3080 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3360
3090 XS2=S2:GOTO 1040
3100 FOR I=1 TO 7
3110 LOCATE 9+I,5:PRINT TEMP$(I)
3120 NEXT I
3130 RETURN
3140 FOR I=1 TO 7
3150 LOCATE 9+I,14:PRINT TEMP$(I)
3160 NEXT I
3170 FOR I=1 TO 7
3180 LOCATE 9+I,26:PRINT COL$(I)
3190 NEXT I
3200 RETURN
3210 FOR I=1 TO 7
3220 LOCATE 9+I,32:PRINT TEMP$(I)
3230 NEXT I
3240 RETURN
3250 FOR I=1 TO 7
3260 LOCATE 9+I,42:PRINT TEMP$(I)
3270 NEXT I
3280 FOR I=1 TO 7
3290 LOCATE 9+I,54:PRINT COL$(I)
3300 NEXT I
3310 RETURN
3320 FOR I=1 TO 7
3330 LOCATE 9+I,60:PRINT TEMP$(I)
3340 NEXT I
3350 RETURN
3360 FOR I=1 TO 7
3370 LOCATE 9+I,70:PRINT TEMP$(I)
3380 NEXT I
3390 RETURN
4060 MO$=MID$(DATE$,1,2)
4070 DA$=MID$(DATE$,4,2)
4080 YR$=MID$(DATE$,9,2)
4081 YR4$=MID$(DATE$,7,4)
4090 MO=VAL(MO$)
4091 YR=VAL(YR$)
4092 YR4=VAL(YR4$)
4100 ON MO GOTO 4110,4120,4130,4140,4150,4160,4170,4180,4190,4200,4210,4220
4110 MO$="JANUARY":GOTO 4230
4120 MO$="FEBRUARY":GOTO 4230
4130 MO$="MARCH":GOTO 4230
4140 MO$="APRIL":GOTO 4230
4150 MO$="MAY":GOTO 4230
4160 MO$="JUNE":GOTO 4230
4170 MO$="JULY":GOTO 4230
4180 MO$="AUGUST":GOTO 4230
4190 MO$="SEPTEMBER":GOTO 4230
4200 MO$="OCTOBER":GOTO 4230
4210 MO$="NOVEMBER":GOTO 4230
4220 MO$="DECEMBER":GOTO 4230
4230 YEAR%=YR4
4233 MONTH%=MO
4235 DAY%=VAL(DA$)
4240 IF MONTH%=1 OR MONTH%=2 THEN 4250 ELSE 4270
4250 YEAR%=YEAR%-1
4260 MONTH%=MONTH%+12
4270 DOW.K%=DAY%+YEAR%+MONTH%*2+YEAR%\4+YEAR%\400+(MONTH%+1)*3\5+2-YEAR%\100
4330 DOW%=DOW.K% MOD 7
4360 IF DOW%=0 OR DOW%=1 THEN DOW%=DOW%+7
4370 DOW%=DOW%-1
4500 ON DOW% GOTO 4510,4520,4530,4540,4550,4560,4570
4510 DOW$="MONDAY":GOTO 4580
4520 DOW$="TUESDAY":GOTO 4580
4530 DOW$="WEDNESDAY":GOTO 4580
4540 DOW$="THURSDAY":GOTO 4580
4550 DOW$="FRIDAY":GOTO 4580
4560 DOW$="SATURDAY":GOTO 4580
4570 DOW$="SUNDAY":GOTO 4580
4580 LOCATE 22,29:PRINT DOW$;", ";MO$;" ";DA$;", ";YR4$;" "
4590 RETURN
10000 IF TICKOFF < 0 THEN TICKOFF = TICKOFF + 1:RETURN
10003 IF ODD = 1 THEN SOUND 2000,1:ODD = 0:RETURN
10010 SOUND 5000,1:ODD = 1:RETURN
10090 CHIME = 0
10095 ODD = 0
10100 IF MIN = 15 THEN PLAY Q15$:TICKOFF = -2:RETURN
10110 IF MIN = 30 THEN PLAY Q15$+Q30$:TICKOFF = -5:RETURN
10120 IF MIN = 45 THEN PLAY Q15$+Q30$+Q15$:TICKOFF = -7:RETURN
10130 IF MIN = 0 THEN PLAY Q15$+Q30$+Q15$+Q30$:TICKOFF = -9 + -1*HOUR
10135 PLAY "mbP2"
10140 FOR II = 1 TO HOUR
10150 PLAY"MBO3CN0"
10160 NEXT II
10170 RETURN
Directory of PC-SIG Library Disk #0050
Volume in drive A has no label
Directory of A:\
ADDCRS BAS 858 8-24-82 9:37a
ASCFILTR BAS 1430 8-24-82 9:38a
COLOR COM 128 7-07-83 10:52a
CRC TXT 1545 11-09-84 10:46a
CRCK4 COM 1536 10-21-82 7:54p
DEPREC BAS 11264 11-30-82 10:26p
FILEIO C 235 9-01-82 6:06p
MONO COM 128 7-07-83 10:52a
MUSICBOX BAS 17920 2-01-83 7:26p
REBOOT ASM 384 2-08-83 12:25a
REBOOT COM 19 2-08-83 12:26a
REBOOT EXE 640 8-29-82 1:05a
ROFF DOC 7176 9-01-82 6:02p
ROFF EXE 18688 9-01-82 6:14p
ROFF H 3134 9-01-82 6:10p
ROFF HE 3456 9-01-82 5:05p
ROFF1 C 11192 9-01-82 6:13p
ROFF2 C 9422 9-01-82 5:21p
ROFF3 C 302 9-01-82 5:22p
SDIR ASM 15872 2-14-83 7:41a
SDIR COM 1292 2-14-83 7:38a
TABLET BAS 7424 11-24-82 8:52p
TICCLOCK BAS 11008 11-28-82 9:48a
23 file(s) 125053 bytes
29696 bytes free