DIR3by Matthew J.W. Ratcliff
DIR3 is a three-across directory listing utility for all Atari-compatible disk operating systems, including SpartaDOS X-the super DOS in a cartridge from ICD.
It is frustrating to list the directory of a disk, only to have the most important files scroll off the top of the display. For this reason, by using DIR3, three filenames may be listed across the Atari 38-column display, with the standard left margin set at the second column. There isn't room, however, for the file size or for the indicator (an asterisk) for a write-protected or locked file. If a file is protected, the first character of the name will be listed in reverse video. File size will remain a mystery, however. If this data is necessary, use your DOS's standard directory listing command.
When first loaded from DOS, DIR3 will display the default directory search specifier. You will be prompted for the drive number with the current default shown in square brackets. Type the desired drive number and press Return, or type Escape twice and Return to exit the program. Press only Return to accept the current drive number. You will then be prompted for a "search specification." Enter the template specification for the files you are interested in seeing (such as " * .BAS" for all BASIC programs). Do not type a drive specifier at this prompt. The drive number has already been set and will be merged with the specification. Press only Return to keep the default, displayed at the top of the screen.
If you would like a hard copy of the directory on the printer, answer yes to the next prompt by typing an uppercase or lowercase "Y" and pressing Return. Any other input is assumed to be "no." The directory will be listed to the display and to the printer if this option is enabled.
The filenames are formatted into three fields, neatly outlined by Atari's graphic characters for the display. Printer output uses normal printable ASCII characters, since the graphic characters would garble the hard copy.
DIR3 keeps track of how many lines it has output. If any filenames are about to scroll off the top of the display, you are prompted to press Return to continue or Escape to exit. The escape key will send control back to DOS without clearing the screen. (Some DOSs always clear the screen after a machine-language program has executed, however.) The return key will allow the DIR3 list to continue until another scroll prompt is necessary or the end of the directory is reached. This prompt is displayed after the complete disk directory has been listed. At this point, pressing Return will restart DIR3 with the previous settings as defaults. Press Escape to exit to DOS. Note that the scroll prompt is not presented if the printer has been enabled.
DIR3 is especially well suited to SpartaDOS X users, since this DOS can handle up to 1,400 files in a single directory. Because DIR3 will put 66 files on the screen before scrolling, Atari DOS users may list an entire disk to a single display. Most Atari-compatible DOSs have a limitation of 64 files per disk.
Matthew J.W. Ratcliff is an electrical engineer at McDonnell Aircraft in St. Louis, Missouri. An experienced assembly language, C and Ada programmer on IBM and main frame computers, he still enjoys developing new programs and articles for the 8-bit Atari home computer. He has been an Atari enthusiast since 1982.
DIR3 is especially well
suited to
SpartaDOS X users, since this DOS
can handle up to 1,400 files in a single
directory. Because DIR3 will put 66
files on the screen before scrolling,
Atari DOS users may list an entire
disk to a single display.
SpartaDOS X users, since this DOS
can handle up to 1,400 files in a single
directory. Because DIR3 will put 66
files on the screen before scrolling,
Atari DOS users may list an entire
disk to a single display.
LISTING 1 : BASIC
HK 10 OPEN #1,8,0,"D:DIR3.OBJ"
RF 20 FOR X=1 TO 1454:READ A:PUT #1,A:NEX
T X
XW 30 CLOSE #l :END
NE 1000 DATA 255,255,0,50,28,50,32,32,32,
32,32,32,32,32,32,32
GZ 1010 DATA 68,105,114,101,99,116,111,11
4,121,58,32,68,49,58,42,46
RN 1020 DATA 42,155,27,69,50,64,51,68,114
,105,118,101,32,91,49,93
TM 1030 DATA 32,63,32,27,83,101,97,114,99
,104,115,112,101,99,32,63
EY 1040 DATA 32,27,67,97,110,110,111,116,
32,111,112,101,110,32,68,73
TU 1050 DATA 82,33,155,27,155,155,68,73,8
2,51,44,32,98,121,32,77
OU 1060 DATA 97,116,42,82,97,116,155,27,6
8,73,82,51,32,98,121,32
K5 1070 DATA 77,97,116,42,82,97,116,44,32
,40,99,41,32,65,78,65
DJ 1080 DATA 76,79,71,155,80,114,101,115,
115,32,91,69,83,67,93,32
FU 1090 DATA 116,119,105,99,101,32,38,32,
91,82,84,78,93,32,116,111
OD 1100 DATA 32,101,120,105,116,46,155,27
,43,45,45,45,45,45,45,45
FE 1110 DATA 45,45,45,45,43,45,45,45,45,4
5,45,45,45,45,45,45
BK 1120 DATA 43,45,45,45,45,45,45,45,45,4
5,45,45,43,155,27,32
ZR 1130 DATA 32,32,32,32,32,32,32,32,32,1
7,18,18,18,18,18,18
FA 1140 DATA 18,18,18,18,18,23,18,18,18,1
8,18,18,18,18,18,18
DA 1150 DATA 18,23,18,18,18,18,18,18,18,1
8,18,18,18,5,155,27
DJ 1160 DATA 26,18,18,18,18,18,18,18,18,1
8,18,18,24,18,18,18
FJ 1170 DATA 18,18,18,18,18,18,18,18,24,1
8,18,18,18,18,18,18
JE 1180 DATA 18,18,18,65,51,120,51,18,3,1
55,27,32,32,32,32,32
BQ 1190 DATA 32,32,32,32,32,32,32,32,32,3
2,32,32,32,32,32,32
AR 1200 DATA 32,32,32,32,32,32,32,32,32,3
2,32,32,32,32,32,32
HY 1210 DATA 32,32,32,32,32,32,32,32,32,3
2,32,32,32,155,27,241
TL 1220 DATA 51,236,52,0,155,27,91,82,69,
84,85,82,78,93,32,109
JK 1230 DATA 111,114,101,44,32,91,69,83,6
7,93,32,101,120,105,116,32
KY 1240 DATA 63,27,156,27,0,155,253,80,11
4,105,110,116,101,114,32,101
SW 1250 DATA 114,114,111,114,33,155,27,80
,114,105,110,116,111,117,116,32
PD 1260 DATA 100,105,114,32,63,32,40,89,4
7,78,41,32,27,169,0,141
DZ 1270 DATA 18,52,141,176,55,141,241,51,
169,0,32,85,55,169,21,162
JD 1280 DATA 50,32,129,55,169,134,162,50,
32,129,55,169,69,162,50,32
FH 1290 DATA 129,55,32,241,54,201,27,208,
3,76,37,54,201,155,240,14
BD 1300 DATA 201,49,144,224,201,57,176,22
0,141,22,50,141,76,50,169,82
BZ 1310 DATA 162,50,32,129,55,173,24,50,7
2,169,50,162,24,160,40,32
RM 1320 DATA 50,55,173,24,50,201,155,208,
7,104,141,24,50,76,159,52
BI 1330 DATA 104,162,0,189,24,50,201,155,
240,3,232,208,246,232,169,27
QQ 1340 DATA 157,24,50,169,37,162,52,32,1
29,55,32,241,54,201,89,240
OJ 1350 DATA 6,201,121,240,2,169,0,141,17
6,55,32,72,55,162,16,169
BG 1360 DATA 21,157,68,3,169,50,157,69,3,
169,0,157,72,3,157,73
GO 1370 DATA 3,157,75,3,169,6,157,74,3,16
9,3,157,66,3,32,237
LU 1380 DATA 52,232,53,86,228,152,16,17,1
69,21,162,50,32,129,55,169
TC 1390 DATA 96,162,50,32,129,55,76,82,52
,169,242,162,51,32,129,55
MT 1400 DATA 169,0,162,50,32,129,55,169,2
47,162,50,32,129,55,173,176
DJ 1410 DATA 55,240,21,169,242,162,51,32,
179,55,169,6,162,50,32,179
KL 1420 DATA 55,169,198,162,50,32,179,55,
160,0,162,0,32,76,54,173
AU 1430 DATA 241,51,240,3,76,202,53,189,6
9,51,201,42,208,8,189,70
RI 1440 DATA 51,9,128,157,70,51,169,124,1
57,69,51,138,24,105,12,170
CZ 1450 DATA 173,241,51,240,3,76,202,53,2
00,192,3,208,207,169,124,157
OY 1460 DATA 69,51,232,169,155,157,69,51,
169,27,232,157,69,51,238,18
SD 1470 DATA 52,169,69,162,51,32,129,55,1
73,176,55,240,10,169,69,162
AA 1480 DATA 51,32,179,55,76,50,53,173,18
,52,201,22,144,154,169,244
NT 1490 DATA 162,51,32,129,55,169,8,141,1
8,52,32,1,55,201,155,208
FP 1500 DATA 10,169,16,162,52,32,129,55,7
6,50,53,201,27,208,235,169
EQ 1510 DATA 16,162,52,32,129,55,169,30,1
62,51,32,129,55,76,37,54
WB 1520 DATA 138,24,105,13,170,169,155,20
0,192,3,240,11,32,48,54,200
ES 1530 DATA 192,3,240,3,32,48,54,169,155
,157,69,51,232,169,27,233
NS 1540 DATA 53,228,54,157,69,51,169,69,1
62,51,32,129,55,173,176,55
LH 1550 DATA 246,14,169,69,162,51,32,179,
55,169,198,162,50,32,179,55
LO 1560 DATA 169,30,162,51,32,129,55,32,8
,56,169,244,162,51,32,129
JE 1570 DATA 55,32,1,55,201,155,208,3,76,
59,52,201,27,208,242,32
MW 1580 DATA 8,56,169,114,162,50,32,129,5
5,96,140,74,54,160,11,169
SF 1590 DATA 32,157,69,51,232,136,208,249
,169,124,157,69,51,232,172,74
PB 1600 DATA 54,96,0,0,0,0,141,72,54,142,
73,54,140,74,54,189
HE 1610 DATA 68,51,141,75,54,162,16,169,6
8,24,109,73,54,157,68,3
DM 1620 DATA 169,51,105,0,157,69,3,169,0,
141,241,51,157,73,3,169
YJ 1630 DATA 40,157,72,3,169,5,157,66,3,3
2,86,228,152,16,3,141
RV 1640 DATA 241,51,173,72,54,174,73,54,1
72,74,54,189,68,51,201,32
PJ 1650 DATA 240,79,201,42,240,69,189,70,
51,157,72,51,189,69,51,157
NC 1660 DATA 71,51,189,68,51,157,70,51,16
9,124,157,69,51,169,32,157
AG 1670 DATA 73,51,169,70,157,74,51,169,1
14,157,75,51,169,101,157,76
CK 1680 DATA 51,157,77,51,169,32,157,78,5
1,157,79,51,157,80,51,169
YV 1690 DATA 124,157,81,51,169,1,141,241,
51,208,6,189,68,51,157,229
VC 1700 DATA 54,224,55,69,51,173,75,54,15
7,68,51,173,72,54,96,169
ST 1710 DATA 51,162,69,160,10,32,50,55,17
3,69,51,96,75,58,155,162
LM 1720 DATA 32,169,12,157,66,3,32,86,228
,169,3,157,66,3,169,254
PJ 1730 DATA 157,68,3,169,54,157,69,3,169
,4,157,74,3,32,86,228
ED 1740 DATA 169,7,157,66,3,169,0,157,72,
3,157,73,3,76,86,228
VS 1750 DATA 142,68,3,141,69,3,140,72,3,1
62,0,142,73,3,169,5
SL 1760 DATA 141,66,3,76,86,228,162,16,16
9,12,157,66,3,76,86,228
AF 1770 DATA 83,58,0,72,162,96,169,12,157
,66,3,32,86,228,162,96
ZT 1780 DATA 169,3,157,66,3,169,82,157,68
,3,169,55,157,69,3,104
RY 1790 DATA 157,75,3,41,240,73,16,9,12,1
57,74,3,76,86,228,141
OH 1800 DATA 68,3,142,69,3,133,224,134,22
5,160,0,140,73,3,177,224
WY 1810 DATA 201,27,240,10,260,208,247,23
8,73,3,230,225,208,240,140,72
DK 1820 DATA 3,169,11,141,66,3,162,0,76,8
6,228,80,58,155,0,0
JX 1830 DATA 0,142,177,55,141,178,55,162,
80,169,12,157,66,3,32,86
HK 1840 DATA 228,169,3,157,66,3,169,8,157
,74,3,169,173,157,68,3
UQ 1850 DATA 169,55,157,69,3,32,86,228,15
2,16,13,169,19,162,52,225
CL 1860 DATA 55,37,56,32,129,55,169,0,141
,176,55,96,173,177,55,157
UP 1870 DATA 69,3,173,178,55,157,68,3,169
,80,157,72,3,169,0,157
EB 1880 DATA 73,3,169,9,157,66,3,76,86,22
8,162,16,169,12,157,66
OY 1890 DATA 3,32,86,228,162,32,169,12,15
7,66,3,32,86,228,162,80
RF 1900 DATA 169,12,157,66,3,76,86,228,22
4,2,225,2,59,52
LISTING 2: ASSEMBLY
0 *SAVE#D:DIR3.M65
10 *ASM,#-,#D:DIR3.COM
20 *-----------------------------*
30 * DIR3 - 3 across directory *
40 * lister by Mat*Rat *
50 * for Analog Computing (c)1989*
60 * from: Ratware Softworks *
70 * 32 S. Hartnett Ave. *
80 * St. Louis, MO 63135 *
90 *-----------------------------*
0100 .ORG $3200
0110 .OPT OBJ
0120 * Important equates for exciting
0130 * things:
0140 ESC = 27
0150 EOL = 155
0160 *
0170 CIO = $E455 ;CALL OS HERE
0180 ICCOM = $0342 ;COMMAND TO CIO
0190 ICBADR = $0344 ;BUFFER OR FNAME
0200 ICBLEN = $0348 ;BUFFER LENGTH
0210 ICAUXI = $034A ;AUX BYTE #1
0220 ICAUX2 = $0340 ;AUX BYTE #2
0230 *
0240 COPN = 3 ;COMMAND OPEN
0250 CCLOSE = 12 ;COMMAND CLOSE
0260 CGTXR = 5 ;GET TEXT REC
0270 CPTXR = 9 ;PUT TEXT REC
0280 CGBINR = 7 ;GET BINARY REC
0290 CPBINR = 11 ;PUT BINARY REC
0300 CDRAW = 17 ;COMMAND DRAWTO
0310 CFILL = 18 ;COMMAND FILL
0320 *
0330 OPIN = 4 ;OPEN FOR INPUT
0340 OPOUT = 8 ;OPEN FOR OUTPUT
0350 OPDIR = 6 ;OPEN FOR DIR
0360 *
0370 XCORD = $55
0380 YCORD = $54
0390 *
0400 *-----------------------------*
0410 * GL - Get a line of text *
0420 * macro. Places hi byte *
0430 * of string addr in A reg, *
0440 * low byte of string addr *
0450 * in X reg, and max len *
0460 * of string in Y reg *
0470 * and then calls GETSTRING *
0480 *-----------------------------*
0490 .MACRO GL
0500 .IF X.002
0510 .ERROR 11GL error, 2 param"
0520 .ENDIF
0530 LDA # >%1
0540 LDX # <%1
0550 .IF %2<256
0560 LDY #%2
0570 .ELSE
0580 LDY Y.2
0590 .ENDIF
0600 JSR GETSTRING
0610 .ENDM
0620 *-----------------------------*
0630 * Graphics 0 Macro *
0640 * Execute the equivalent of *
0650 * an Atari BASIC GRAPHICS 0 *
0660 * command *
0670 *-----------------------------*
0680 .MACRO GR0
0690 .IF %0<>0
0700 .ERROR "No paran for GR0"
0710 .ENDIF
0720 LDA #0
0730 JSR GRAPHICS
0740 .ENDM
0750 *------------------------------
0760 * Fprint a string at the *
0770 * X,Y position specified *
0780 *------------------------------
0790 .MACRO FPXY
0800 .IF %0<>3
0810 .ERROR "FPXY-Param count"
0820 .ENDIF
0830 .IF %1<256
0846 LDA #%1
0850 .ELSE
0860 LDA %1
0870 .ENDIF
0880 STA XCORD
0890 .IF %2<256
0900 LDA #%2
0910 .ELSE
0920 LDA %2
0930 .ENDIF
0940 STA YCORD
0950 LDA # <%3
0960 LDX # >%3
0970 JSR FPRINT
0980 .ENDM
0990 *-----------------------------*
1000 * Fprint macro, no X & Y *
1010 * specified,so use the current*
1020 * X,Y coordinates *
1030 *-----------------------------*
1040 .MACRO FP
1050 .IF %0<>1
1060 .ERROR "FP-Param count"
1070 .ENDIF
1080 LDA # <%1
1090 LDX # >%1
1100 JSR FPRINT
1110 .ENDM
1120 *-----------------------------*
1130 * LP - Line print macro *
1140 * print the text record *
1150 * pointed to by A (low) *
1160 * and X (high) registers *
1170 * on the line printer *
1180 * Disable printer output *
1190 * if an error occurs *
1200 *-----------------------------*
1210 .MACRO LP
1220 .IF %0<>1
1230 .ERROR "LP-Param count"
1240 .ENDIF
1250 LDA # <%1
1260 LDX # >%1
1270 JSR LPRINT
1280 .ENDM
1290 *-----------------------------*
1300 * Data work area
1310 *-----------------------------*
1320 DIRINFO .BYTE " "
1330 .BYTE "Directory: "
1340 DIRSPEC .BYTE "D1:*.*",155,27
1350 .DS 40
1360 DRIVE .BYTE "Drive [1] ? ",27
1370 FILESPEC .BYTE "Searchspec ? "
1380 .BYTE 27
1390 CANTDO .BYTE "Cannot open DIR!"
1400 .BYTE 155,27
1410 RDIR3 .BYTE 155,155
1420 .BYTE "DIR3, by Mat*Rat"
1430 .BYTE 155,27
1440 ESCEXIT .BYTE "DIR3 by Mat*Rat,"
1450 .BYTE " (c) ANALOG",155
1460 .BYTE "Press [ESC]'
1470 .BYTE " twice & [RTN]"
1480 .BYTE " to exit.",155,27
1490 HBAR .BYTE "+-----------+"
1500 .BYTE "-----------+"
1510 .BYTE "-----------+",155,27
1520 .BYTE " "
1530 SHEAR .BYTE 17,18,18,18,18,18
1540 .BYTE 18,18,18,18,18,18,23
1550 .BYTE 18,18,18,18,18,18
1560 .BYTE 18,18,18,18,18,23
1570 .BYTE 18,18,18,18,18,18
1580 .BYTE 18,18,18,18,18,5
1590 .BYTE 155,27
1600 BHBAR .BYTE 26,18,18,18,18,18
1610 .BYTE 18,18,18,18,18,18,24
1620 .BYTE 18,18,18,18,18,18
1630 .BYTE 18,18,18,18,18,24
1640 .BYTE 18,18,18,18,18,18
1650 .BYTE 18,18,18,18,18,3
1660 .BYTE 155,27
1670 LINBUF .BYTE " "
1680 .BYTE " "
1690 .BYTE " "
1706 .BYTE " "
1710 .BYTE " ",155,27
1720 .DS 120
1730 DONEFLG .BYTE 0
1740 LF .BYTE 155,27
1750 HOLDIT .BYTE "[RETURN] more"
1760 .BYTE ", [ESC] exit ?",27
1770 RETURN .BYTE 156,27
1780 YCOUNT .BYTE 0
1790 NOPRN .BYTE 155,253,"Printer"
1800 .BYTE " error!",155,27
1810 PROUT .BYTE "Printout dir ?"
1820 .BYTE " (Y/N) ",27
1830 *-----------------------------*
1840 * Startup the program: *
1850 * Get user preferences for *
1860 * drive, searchspec, and *
1870 * printer output, then list *
1880 * the directory. *
1890 *-----------------------------*
1900 STARTUP
1910 LDA #0
1920 STA YCOUNT
1930 STA PRCTL
1940 STA DONEFLG
1950 GR0 ; Clear screen
1960 FP DIRSPEC
1970 DRVRQ
1980 FP ESCEXIT ; Get drive
1990 FP DRIVE ; preference
2000 JSR GETLKEY
2010 CMP #ESC ; ESC to exit
2020 BNE START1
2030 JMP DNEX
2040 START1
2050 CMP #EOL ; RTN is
2060 BEG DEFDRV ; default drive
2070 CMP #'1
2080 BCC DRVRQ
2090 CMP #'9
2100 BCS DRVRQ ; Get filespec
2110 STA DIRSPEC+1
2120 STA DRIVE+7 ; RTN is default
2130 DEFDRV
2140 FP FILESPEC
2150 LDA DIRSPEC+3 ; Save default
2160 PHA
2170 GL DIRSPEC+3,40
2180 LDA DIRSPEC+3 ; Return only?
2190 CMP #EOL
2200 BNE GOTFS
2210 PLA
2220 STA DIRSPEC+3 ; Keep default
2230 JMP GOTFS1
2240 GOTFS PLA
2250 GOTFS1
2260 LDX #0 ; We use ESC
2270 ADESC LDA DIRSPEC+3,X
2280 CMP #EOL ; as end of
2290 BEQ PUTESC ; line mark
2300 INX ; for FPRINT
2310 BNE ADESC ; Adjust it
2320 PUTESC INX ; for search
2330 LDA #ESC ; spec
2340 STA DIRSPEC+3,X
2350 FP PROUT ; Hard copy?
2360 JSR GETLKEY
2370 CMP #'Y ; Y or y
2380 BEQ GOTPRN ; must be
2390 CMP #'y ; input
2400 BEQ GOTPRN ; for yes
2410 LDA #0 ; all else NO
2420 GOTPRN STA PRCTL
2430 JSR CLOSE1
2440 LDX #$10
2450 LDA # <DIRSPEC ; Open up
2460 STA ICBADR,X ; the dir
2470 LDA # >DIRSPEC ; spec
2480 STA ICBADR+1,X ; on IOCB
2490 LDA #0 ; #1 for
2500 STA ICBLEN,X ; directory
2510 STA ICBLEN+1,X ; listing
2520 STA ICAUX2,X ; input
2530 LDA #OPDIR
2540 STA ICAUX1,X
2550 LDA #COPN
2560 STA ICCOM,X
2570 JSR CIO
2580 TYA
2590 BPL DODIR
2600 FP DIRSPEC
2610 FP CANTDO
2620 JMP DRVRQ
2630 DODIR
2640 FP LF
2650 FP DIRINFO ; Show dir
2660 FP SHEAR ; and
2670 LDA PRCTL ; vert bar
2680 BEQ DODIR1 ; print?
2690 LP LF
2700 LP DIRINFO ; LPRINT too
2710 LP HBAR
2720 DODIR1
2730 LDY #0 ; Files/line
2740 LDX #0
2750 DOLINE
2760 JSR GETFN ; Get a filename
2770 LDA DONEFLG
2780 BEQ CNTDIR
2790 JMP DONEDIR
2800 CNTDIR LDA LINBUF,X
2810 CMP #'* ; Locked?
2820 BNE DOL1
2830 LDA LINBUF+1,X
2840 ORA #$80 ; Inverse char
2850 STA LINBUF+1,X
2860 DOL1
2870 LDA #'l ; Make name
2880 STA LINBUF,X ; divider
2890 TXA
2960 CLC
2910 ADC #12 ; Next field
2920 TAX
2930 LDA DONEFLG ; Last one done?
2940 BEQ DOL2 ; no, more files
2950 JMP DONEDIR ; yes, wrapup
2960 DOL2
2970 INY ; next field
2980 CPY #3 ; 3rd one?
2996 BNE DOLINE ; no, more
3000 LDA #'l ; yes, fixup
3010 STA LINBUF,X ; field with
3020 INX ; next file
3030 LDA #155 ; separator
3040 STA LINBUF,X ; and print
3050 LDA #27 ; out the line
3060 INX
3070 STA LINBUF,X
3080 INC YCOUNT
3090 FP LINBUF
3100 LDA PRCTL ; Lprint it if
3110 BEQ WATST ; PRCTL flag set
3120 LP LINBUF
3130 JMP DODIR1
3140 WATST LDA YCOUNT ; Scrolling?
3150 CMP #22
3160 BCC DODIR1
3170 FP HOLDIT
3180 LDA #0
3190 STA YCOUNT
3200 NXLWAI ; Yes, pause
3210 JSR GETKEY ; for user
3220 CMP #EOL
3230 BNE NXCK
3240 FP RETURN
3250 JMP DODIR1
3260 NXCK CMP #ESC
3270 BNE NXLWAI
3280 FP RETURN
3290 FP BHBAR
3300 JMP DNEX
3310 DONEDIR
3320 TXA ; Done with
3330 CLC ; DIR, now
3340 ADC #13 ; pad remaining
3350 TAX ; fields so
3360 LDA #EOL ; display not
3370 INY ; 'ragged'
3380 CPY #3
3390 BEQ DONEDIR1
3400 JSR FILLINE
3410 INY
3420 CPY #3
3430 BEQ DONEDIR1
3440 JSR FILLINE
3450 DONEDIR1
3460 LDA #EOL
3470 STA LINBUF,X
3480 INX
3490 LDA #ESC
3500 STA LINBUF,X
3510 FP LINBUF
3520 LDA PRCTL
3530 BEQ EXITNOW
3540 LP LINBUF
3550 LP HBAR
3560 EXITNOW
3570 FP BHBAR
3580 JSR CLOSEALL
3590 FP HOLDIT
3600 MORE JSR GETKEY
3610 CMP #EOL
3620 BNE CKEXI
3630 JMP STARTUP
3640 CKEXI CMP #ESC
3650 BNE MORE
3660 DNEX
3670 JSR CLOSEALL
3680 FP RDIR3
3690 RTS
3700 *-----------------------------*
3710 * Fill the next field with. *
3726 * blanks and a vertical bar. *
3730 * This will prevent unsightly *
3740 * 'ragged edge' at bottom *
3750 * directory list *
3760 *-----------------------------*
3770 FILLINE
3780 STY SAVY
3790 LDY #11
3800 LDA #32
3810 FIL STA LINBUF,X
3820 INX
3830 DEY
3840 BNE FIL
3850 LDA #'1
3860 STA LINBUF,X
3870 INX
3880 LDY SAVY
3890 RTS
3960 *-----------------------------*
3910 SAVA .BYTE 0 ; Save registers
3920 SAVX .BYTE 0 ; for GETFN
3930 SAVY .BYTE 0 ; function
3940 LBSV .BYTE 0
3950 *-----------------------------*
3960 * Get a filename from the *
3970 * opened IOCB #1, for DIR. *
3980 * Check for end of file and *
3990 * set DONEFLG if necessary. *
4000 *-----------------------------*
4010 GETFN
4020 STA SAVA
4030 STX SAVX
4040 STY SAVY
4050 LDA LINBUF-1,X
4060 STA LBSV ; Load in front
4070 LDX #$10 ; of linbuf
4088 LDA # <LINBUF-1
4090 CLC ; we have to
4100 ADC SAVX ; chop some
4110 STA ICBADR,X
4120 LDA # >LINBUF+1
4130 ADC #0 ; chars for
4140 STA ICBADR+1,X
4150 LDA #0 ; screen format
4160 STA DONEFLG
4170 STA ICBLEN+1,X
4180 LDA #40
4190 STA ICBLEN,X
4200 LDA #CGTXR
4210 STA ICCOM,X
4220 JSR CIO
4230 TYA
4240 BPL DNGET
4250 STA DONEFLG
4260 DNGET LDA SAVA
4270 LDX SAVX
4280 LDY SAVY
4290 LDA LINBUF-1,X
4300 CMP #32 ; Space? Not EOF
4310 BEQ FNGOT
4320 CMP #'*
4330 BEQ FNFIXUP
4340 * Must be a digit, end of dir
4350 * Patch up Free sectors field
4360 * so it fits in 12 char window
4370 LDA LINBUF+1,X
4380 STA LINBUF+3,X
4390 LDA LINBUF,X
4400 STA LINBUF+2,X
4410 LDA LINBUF-1,X
4420 STA LINBUF+1,X
4430 LDA #'1
4440 STA LINBUF,X
4450 LDA #32
4460 STA LINBUF+4,X
4470 LDA #'F
4480 STA LINBUF+5,X
4490 LDA #'r
4500 STA LINBUF+6,X
4510 LDA #'e
4520 STA LINBUF+7,X
4530 STA LINBUF+8,X
4540 LDA #32
4550 STA LINBUF+9,X
4560 STA LINBUF+10,X
4570 STA LINBUF+11,X
4580 LDA #'1
4590 STA LINBUF+12,X
4600 LDA #l
4610 STA DONEFLG
4620 BNE FNGOT
4630 FNFIXUP LDA LINBUF-1,X
4640 STA LINBUF,X
4650 FNGOT
4660 LDA LBSV
4670 STA LINBUF-1,X
4680 LDA SAVA
4690 RTS
4700 GETLKEY GL LINBUF,10
4710 LDA LINBUF
4720 RTS
4730 *-----------------------------*
4740 * Get a key from the *
4750 * keyboard through *
4760 * the K: device 2 *
4770 * and return it in *
4780 * the A register *
4790 *-----------------------------*
4800 KEY .BYTE "K:",155
4810 GETKEY
4820 LDX #$20
4830 LDA #CCLOSE
4840 STA ICCOM,X
4850 JSR CIO
4860 LDA #COPN
4870 STA ICCOM,X
4880 LDA # <KEY
4890 STA ICBADR,X
4900 LDA # >KEY
4910 STA ICBADR+1,X
4920 LDA #OPIN
4930 STA ICAUX1,X
4940 JSR CIO
4950 LDA #CGBINR
4960 STA ICCOM,X
4970 LDA #0
4980 STA ICBLEN,X
4990 STA ICBLEN+1,X
5000 JMP CIO
5010 *-----------------------------*
5020 * Get a string from *
5030 * the keyboard through the *
5040 * E: device 0 and return it *
5050 * in the A register *
5060 *-----------------------------*
5070 GETSTRING
5080 STX ICBADR ; String addr
5090 STA ICBADR+1
5100 STY ICBLEN ; Max length
5110 LDX #0
5120 STH ICBLEN+1
5130 LDA #CGTXR
5140 STA ICCOM
5150 JMP CIO
5160 *-----------------------------*
5170 * Close IOCB U1, will be used *
5180 * for DIR, filenames IOCB *
5190 *-----------------------------*
5200 CLOSE1
5210 LDX #$10 ; Close IOCB #1
5220 LDA #CCLOSE
5230 STA ICCOM,X
5240 Jmp CIO
5250 *-----------------------------*
5260 * GRAPHICS g *
5270 * ENTRY: A-REG GRAPHICS MODE *
5280 * EXIT: Y-REG HAS STATUS *
5290 * *
5300 *-----------------------------*
5310 SNAME .BYTE "S:",0 ;OPEN FNAME
5320 GRAPHICS
5330 PHA ;SAVE 'G'
5340 LDX #6*$10 ;FILE 6
5350 LDA #CCLOSE
5360 STA ICCOM,X
5370 JSR CIO ;FIRST CLOSE #6
5380 * WE IGNORE ANY ERRORS
5390 LDX #6*$10 ;AGAIN, FILE 6
5400 LDA #COPN ;OPEN THIS FILE
5410 STA ICCOM,X
5420 LDA # <SNAME
5430 STA ICBADR,X ;USE FILE "S:"
5440 LDA # >SNAME
5450 STA ICBADR+1,X ;POINT AT IT
5460 * ALL IS SET UP FOR OPEN, NOW
5470 * WE TELL CIO WHAT KIND OF OPEN
5480 *
5490 PLA ;OUR SAVED MODE
5500 STA ICAUX2,X ;GIVEN TO 'S:'
5510 * (NOTE THAT S: IGNORES UPPER
5520 * BITS OF AUX2)
5530 AND #$F0 ;GET UPPER BITS
5540 EOR #$10 ;AND FLIP BIT 4
5550 * (S: EXPECTS IT TO BE INVERTED
5560 * FROM WHAT BASIC USAGE IS)
5570 ORA #$0C ;ALLOW R/W
5580 STA ICAUX1,X ;FOR CIO AND S:
5590 JMP CIO ;OPEN S:
5600 *-----------------------------*
5610 * Fprint: *
5620 * X-Reg: Hi byte adr of string*
5630 * A-Reg: Lo byte adr of string*
5640 * String is terminated with *
5650 * an escape character. Use to *
5660 * determine its length. *
5670 * The text may have embedded *
5680 * return characters, and may *
5690 * be as long as 65536 bytes *
5700 * if so desired - just so it *
5710 * doesn't have an embedded *
5720 * escape character. *
5730 *-----------------------------*
5740 SADR = $E0 ; Work str ptr
5750 *
5760 FPRINT
5770 STA ICBADR
5780 STX ICBADR+1
5790 STA SADR
5800 STX SADR+1
5810 * Find string length
5820 LDY #0
5830 STY ICBLEN+1
5840 LEN LDA (SADR),Y
5850 CMP #ESC
5860 BEQ GOTLEN
5870 INY
5880 BNE LEN
5890 INC ICBLEN+1
5900 INC SADR+1
5910 BNE LEN
5920 GOTLEN
5930 STY ICBLEN
5940 LDA #CPBINR
5950 STA ICCOM
5960 LDX #0
5970 JMP CIO
5980 *-----------------------------*
5990 * LPRINT - Print a line of *
6000 * text. Use IOCB U7, *
6010 * normally reserved for *
6020 * printer I/0 anyway *
6030 *-----------------------------*
6040 PRN .BYTE "P:",155
6050 PRCTL .BYTE 0
6060 LX .BYTE 0 ; Hi tx adr
6070 LA .BYTE 0 ; to tx adr
6080 *-----------------------------*.
6090 LPRINT
6100 STH LX
6110 STA LA
6120 LDX #$50
6130 LDA #CCLOSE
6140 STA ICCOM,X ; Close it
6150 JSR CIO
6160 LDA #COPN ; Open it
6170 STA ICCOM,X
6180 LDA #OPOUT ; for output
6190 STA ICAUX1,X
6200 LDA # <PRN
6210 STA ICBADR,X
6220 LDA # >PRN
6230 STA ICBADR+1,X
6240 JSR CIO
6250 TYA ; Print open
6260 BPL LPRINT1 ; error?
6270 FP NOPRN
6280 LDA #0 ; Disable print
6290 STA PRCTL ; on error
6300 RTS
6310 LPRINT1
6320 LDA LX ; Open, whip
6330 STA ICBADR+1,X
6340 LDA LA ; out!
6350 STA ICBADR,X
6360 LDA #80
6370 STA ICBLEN,X
6380 LDA #0
6390 STA ICBLEN+1,X
6400 LDA #CPTXR
6410 STA ICCOM,X
6420 JMP CIO
6430 *-----------------------------*
6440 * Close-all IOCBs we used, *
6450 * clean house before exit, *
6460 * since we are sloppy about *
6470 * how we use then in the prog *
6480 *-----------------------------*
6490 CLOSEALL
6500 LDX #$10
6510 LDA #CCLOSE
6520 STA ICCOM,X
6530 JSR CIO
6540 LDX #$20
6550 LDA #CCLOSE
6560 STA ICCOM,X
6570 JSR CIO
6580 LDX #$50
6590 LDA #CCLOSE
6600 STA ICCOM,X
6610 JMP CIO
6620 *-----------------------------*
6630 *= $02E0
6640 .WORD STARTUP
6650 *-----------------------------*
6660 *