REM > ExtCat/src 1.20
REM Microdrive Extended CATalogue   28 February 1984
REM Published in the Hisoft's GEN assembler manual
REM
REM Copyright Hisoft 1984
REM With many thanks to Andrew Pennell for his
REM Microdrive 'bible'and the Stream 14 routine
:
REM Only lists visible files
REM v1.00 28-Feb-1984 Original Hisoft version
REM v1.10 17-Jul-1985 Filetypes in words, displays start,length
REM                   entry point for *command
REM v1.11 15-Feb-2003 Retyped by JGH
REM v1.20 02-Jan-2004 Errors trapped around OPEN_M
:
ver$="1.20":vdate$="02-Jan-2004"
:
A%=0:X%=1:os%=(USR&FFF4 AND &FF00)DIV256:IFos%=6 AND PAGE>&8000:SYS "OS_GetEnv" TO A$:OSCLI"TextToBas "+MID$(A$,INSTR(A$," ",1+INSTR(A$," ")))+" *Z80":END
quit%=?&80<>0:?&80=0:ON ERROR REPORT:PRINT" at line ";ERL:IFNOTquit%:END ELSE *Quit
:
DIM mcode% &1000:load%=64000
:
REM Some equates:
CR=13:PRFILE=2:RECFLG=67
:
REM System variables:
WAIT_K=&15D4:MAKE_SPACE=&1655:ERR_SP=&5C3D
STRMS =&5C16:ERR_NR=&5C3A:CHANS =&5C4F:PROG  =&5C53
D_STR1=&5CD6:S_STR1=&5CD8:N_STR1=&5CDA:T_STR1=&5CDC
HD_00 =&5CE6:HD_0B =&5CE7:HD_0D =&5CE9:HD_0F =&5CEB
HD_11 =&5CED
:
REM Hook codes:
OPEN_M= &22:CLOSE_M= &23:NEWVARS= &31:SHADOW= &32
:
FOR P=0 TO 1:P%=load%:O%=mcode%
[OPT P*3+4
.go%                ; Enter here to cat drive 1
LD HL,&0001         ; Assume drive 1
JR NC,UseDrive      ; Not run via *command
LD A,(DE):CP ASC"0" ; Is there a drive number?
JR C,UseDrive       ; No, do drive 1
SUB ASC"0":LD L,A   ; Use specified drive
.UseDrive           ; Enter here to cat drive in HL
LD (DRIVE),HL

LD   HL,SPACE
LD   (pointer),HL
LD   IY,&5C3A

;LD   HL,SIGNON
;LD   B,SIGNEND-SIGNON
;CALL WRstring

;Set up new channel and attach to Stream 14

LD   HL,(PROG)
DEC  HL
PUSH HL
LD   BC,11
CALL MAKE_SPACE
LD   HL,CH14out
POP  DE
PUSH DE
EX   DE,HL
LD   (HL),E
INC  HL
LD   (HL),D
INC  HL
EX   DE,HL
LD   HL,C14INFO
LD   BC,11-2
LDIR
POP  HL
INC  HL
LD   BC,(CHANS)
OR   A
SBC  HL,BC
LD   (STRMS+28),HL

;Now read in bare catalogue

EXX:PUSH HL:EXX     ; HL' corrupted by PRINT_A

RST  8
DEFB NEWVARS        ; Ensure Interface 1 presence
                    ; Should really change (CAT) to match correct ROM
LD   A,14
LD   (S_STR1),A     ; Output to stream 14
LD   HL,(DRIVE)
LD   (D_STR1),HL    ; Set specificied drive
LD   HL,(CAT)
LD   (HD_11),HL     ; Call CAT with Shadow paged in
EI
RST  8:DEFB SHADOW

;Now process bare catalogue

LD   HL,SPACE
LD   B,11
CALL WRstring       ; print title
.CatL1
LD   B,15           ; 15 entries at a time
.CatLoop
PUSH BC
INC  HL
LD   A,(HL)
CP   CR             ; finished?
JP   Z,CatEnd
DEC  HL
LD   B,11
PUSH HL
CALL WRstring       ; Print <cr>,filename
CALL Space          ; Print space
EX   (SP),HL
INC  HL
EX   DE,HL
LD   HL,T_STR1
LD   (HL),E
INC  HL
LD   (HL),D
LD   HL,(DRIVE)
LD   (D_STR1),HL
LD   HL,10
LD   (N_STR1),HL
EI

LD   HL,(ERR_SP)
PUSH HL             ; Save current ERR_SP
LD   HL,OpenError
PUSH HL
LD   (ERR_SP),SP    ; Point to new error handler
SET  2,(IY+124)     ; Shadow ROM to vector via ERR_SP for errors
RST  8:DEFB OPEN_M  ; Try to fetch first sector
POP  HL:POP HL
LD   (ERR_SP),HL    ; Restore error handler
;
BIT  PRFILE,(IX+RECFLG)
JR   NZ,NotPrint    ; Data file
LD   A,4            ; Type 4="Print"
JR   PrintType
;
.OpenError
POP HL
LD (ERR_SP),HL      ; Restore error handler
LD  A,5             ; 5="?????"
.PrintType
CALL PRTYPE         ; Print file type string
JR  CatBack         ; Step to next entry
;
.NotPrint           ; data file
PUSH IX
POP  DE
LD   HL,82
ADD  HL,DE
EX   DE,HL
LD   A,(DE)         ; Get file type
INC  DE
PUSH AF
CALL PRTYPE         ; Print file type
EX   DE,HL
POP  AF
OR   A
JR   NZ,NotProg
INC  HL:INC  HL     ; BASIC program
INC  HL:INC  HL     ; point to length
INC  HL:INC  HL     ; point to start
LD   E,(HL)
INC  HL
LD   D,(HL)
CALL DEOUTS         ; print start
DEC HL:DEC HL
LD   D,(HL)
DEC  HL
LD   E,(HL)
CALL DEOUTS         ; print length
JR   CatBack
.NotProg
CP   3
JR   NZ,CatBack
INC HL:INC HL
LD   E,(HL)
INC  HL
LD   D,(HL)
CALL DEOUTS         ; print load address
DEC HL:DEC HL
LD   D,(HL)
DEC  HL
LD   E,(HL)
CALL DEOUTS         ; print length
.CatBack
RST  8
DEFB CLOSE_M        ; Close channel
.CatBack2
POP  HL
POP  BC
DEC  B
JP   NZ,CatLoop
JP   CatL1
;
.CatEnd
POP  BC
DEC  HL
LD   B,5
CALL WRstring
EXX:POP HL:EXX
LD   BC,0
RET

.PRTYPE             ; Output file type string
LD   HL,TYPETAB
LD   C,A
ADD  A,A            ; multiply by 2
ADD  A,A            ; multiply by 4
ADD  A,C            ; multiply by 5
LD   C,A
LD   B,0
ADD  HL,BC
LD   B,5            ; five characters
.TypeLoop
LD   A,(HL)
CALL CONOUT
INC  HL
DJNZ TypeLoop
JP   Space

;
; Output DE in decimal

.DEOUTS
PUSH HL
PUSH IX
EX   DE,HL
LD   B,5
LD   IX,TENTAB
.DEloop
LD   E,(IX)
LD   D,(IX+1)
LD   A,-1
.TenLoop
INC  A
OR   A
SBC  HL,DE
JR   NC,TenLoop
ADD  HL,DE
OR   &30
CALL CONOUT
INC  IX
INC  IX
DJNZ DEloop
CALL Space
POP  IX
POP  HL
RET

;
; Output for Stream14

.CH14out
LD   HL,(pointer)
LD   (HL),A
INC  HL
LD   (pointer),HL
RET

;
; Write a string of length B from (HL)

.WRstring
LD   A,(HL)
CALL CONOUT
INC  HL
DJNZ WRstring
RET

;
; Open a stream

.ChOpen
PUSH HL
PUSH DE
PUSH BC
CALL &1601
POP  BC
POP  DE
POP  HL
RET

;
; Output a space to stream 2

.Space
LD   A,ASC" "       ; continue into CONOUT

;
; Output to stream 2

.CONOUT
PUSH AF
LD   A,2
CALL ChOpen
POP  AF
RST  &10
RET

;
; Data

.TENTAB
DEFW 10000:DEFW 1000:DEFW 100:DEFW 10:DEFW 1

.TYPETAB
DEFM "Basic"
DEFM "Numbr"
DEFM "Strng"
DEFM "Bytes"
DEFM "Print"
DEFM "?????"
:
.C14INFO
DEFW &15C4
DEFB ASC"Z"
DEFW &28
DEFW &28
DEFW 11

;
; CAT routine in the Shadow ROM

.CAT
DEFW &1C52          ; Issue 2

;
; CAT routine values for various shadow ROMs

.CAT1:DEFW &1C58    ; Issue 1
.CAT2:DEFW &1C52    ; Issue 2
.CAT3:DEFW &1C54    ; Issue 3

;
; Storage

.DRIVE
DEFW 1

.SIGNON
;DEFB CR
;DEFM "Hisoft Extended CAT Listing"
;DEFB CR
;DEFM "Copyright Hisoft 1984"
;DEFB CR
;DEFB CR
.SIGNEND

.pointer
DEFM STRING$(2," ")
.SPACE
DEFM STRING$(128," ")
DEFM STRING$(128," ")
DEFM STRING$(128," ")
DEFM STRING$(128," ")

]:NEXT
:
OS."Save EXTCAT "+STR$~mcode%+" "+STR$~O%+" "+STR$~(go%OR&30000)+" "+STR$~(load%OR&30000)
IFquit%:*Quit