Magic Disk 64/Magic_Disk_64_93-02_1993_-_de_Side_A.d64/fk.usedir.src

Text File | 2023-02-26 | 13KB | 708 lines

;*****************************
         *= $0801
status   = $90
setpar   = $ffba
setnam   = $ffbd
open     = $ffc0
close    = $ffc3
chkin    = $ffc6
clrch    = $ffcc
basin    = $ffcf
bsout    = $ffd2
load     = $ffd5
save     = $ffd8
ckout    = $ffc9
intout   = $bdcd
inkey    = $ffe4
listen   = $ffb1
unlist   = $ffae
talk     = $ffb4
untalk   = $ffab
iecin    = $ffa5
iecout   = $ffa8
sectlk   = $ff96
seclst   = $ff93

filemem  = $0f00
numbuff  = $0332
need     = $0337
dskfree  = $0338
allfree  = $033a
dirfree  = $033c
dirstrt  = $033d
ftrack   = $033e
fsector  = $033f
dsindex  = $0340
combuff  = $0341

mem0     = $02
mem1     = $03
mem2     = $04
mem3     = $05
mem4     = $06
;*******************************
;         jmp main
;*******************************
         .byte $0b,$08,$0a,$00,$9e
         .text "2061"
         .byte 0,0,0
;*******************************
main     lda #11
         sta 53280
         sta 53281

         lda #<(text1)
         ldy #>(text1)
         jsr strout
         jsr getin
         cpy #1
         bne m3
         lda #"x"
         cmp name
         bne m3
         jmp 64738

m3       jsr rfile
         jsr getneed

         lda #<(text2)
         ldy #>(text2)
         jsr strout
mloop1   jsr inkey
         beq mloop1

         lda #<(text3)
         ldy #>(text3)
         jsr strout

         jsr wdummy
         jsr openio
         jsr getdskf
         jsr getdirf
         jsr closeio
         jsr statout

         lda dirfree
         bne m1
         lda #<(errtxt1)
         ldy #>(errtxt1)
         jmp errout

m1       cmp need
         bcc m2
         lda #<(errtxt2)
         ldy #>(errtxt2)
         jmp errout

m2       ldy allfree+1
         bne ok
         lda allfree+0
         cmp need
         bcs ok
         lda #<(errtxt3)
         ldy #>(errtxt3)
         jmp errout

ok       lda #19
         sec
         sbc dirfree
         tay
         lda blktab,y
         sta dirstrt
         sty dsindex

         ldx dirfree
         txa
         dex
         asl a
         eor #$ff
         clc
         adc #1
         adc #<(filemem)
         bcc m5
         inx
m5       sta $fd
         txa
         clc
         adc #>(filemem)
         sta $fe
         jsr wfile

         jsr openio
         jsr chgent
         jsr wblocks
         jsr closeio

         lda #<(text4)
         ldy #>(text4)

errout   jsr strout
eo1      jsr inkey
         beq eo1
         jmp main
;*******************************
statout  lda #<(stext1)
         ldy #>(stext1)
         jsr strout
         lda #0
         ldx need
         jsr intout

         lda #<(stext2)
         ldy #>(stext2)
         jsr strout
         lda #0
         ldx dirfree
         jsr intout

         lda #<(stext3)
         ldy #>(stext3)
         jsr strout
         lda dskfree+1
         ldx dskfree+0
         jmp intout
;*******************************
getneed  ldx #0
         stx need

         lda $f9
         ldx $fa
         sec
         sbc #<(filemem)
         bcs rf1
         dex
rf1      sta mem1
         txa
         sec
         sbc #>(filemem)
         sta mem2

         rol a
         bcc cn1
         inc need
cn1      clc
         adc mem1
         beq cn2
         bcc cn2
         inc need
cn2      inc need

         lda mem2
         clc
         adc need
cn3      sta need
         rts
;*******************************
getdskf  lda #<(com5)
         ldy #>(com5)
         jsr striec

         lda #8
         jsr talk
         lda #$6f
         jsr sectlk

         jsr iecin
         sta dskfree+0
         jsr iecin
         jsr iecin
         sta dskfree+1

         lda #8
         jmp untalk
;*******************************
getdirf  lda #<(com6)
         ldy #>(com6)
         jsr striec

         lda #<(com7)
         ldy #>(com7)
         jsr striec

         lda #8
         jsr talk
         lda #$62
         jsr sectlk

         jsr iecin
         sta dirfree

         ldx dskfree+1
         clc
         adc dskfree+0
         bcc gf1
         inx
gf1      sta allfree+0
         stx allfree+1

         lda #8
         jmp untalk
;*******************************
i2a      ldy #(48-1)
ialoop1  iny
         sec
         sbc #100
         bcs ialoop1
         adc #100
         sty numbuff+1

         ldy #(48-1)
ialoop2  iny
         sec
         sbc #10
         bcs ialoop2
         adc #10
         sty numbuff+2

         clc
         adc #48
         sta numbuff+3

         lda #32
         sta numbuff+0
         lda #0
         sta numbuff+4
         rts
;*******************************
rfile    ldx #<(filemem)
         ldy #>(filemem)
         stx $f9
         sty $fa

         lda mem0
         ldx #<(name)
         ldy #>(name)
         jsr setnam
         lda #1
         ldx #8
         ldy #0
         jsr setpar
         jsr open
         ldx #1
         jsr chkin

         ldy #0
loop1    jsr basin
         sta ($f9),y

         inc $f9
         bne l1
         inc $fa

l1       lda $90
         beq loop1

         jsr clrch
         lda #1
         jmp close
;*******************************
wfile    lda #<(text5)
         ldy #>(text5)
         jsr strout

         lda mem0
         ldx #<(name)
         ldy #>(name)
         jsr setnam
         lda #1
         ldx #8
         ldy #1
         jsr setpar
         jsr open
         ldx #1
         jsr ckout

         ldy #0
wfloop1  lda ($fd),y
         jsr bsout

x3       jsr inkey
         bne x3

         inc $fd
         bne wf1
         inc $fe

wf1      lda $fe
         cmp $fa
         bne wfloop1
         lda $fd
         cmp $f9
         bne wfloop1

         jsr clrch
         lda #1
         jmp close
;*******************************
wdummy   lda mem0
         ldx #<(name)
         ldy #>(name)
         jsr setnam
         lda #1
         ldx #8
         ldy #1
         jsr setpar
         jsr open
         ldx #1
         jsr ckout
         jsr bsout
         jsr clrch
         lda #1
         jsr close

         jsr opencom
         lda #<(name-2)
         ldy #>(name-2)
         jsr striec
         lda #1
         jmp close
;*******************************
getin    ldy #0
giloop1  jsr basin
         cmp #13
         beq giend
         sta name,y
         iny
         cpy #16
         bne giloop1
giend    sty mem0
         lda #0
         sta name,y
         rts
;*******************************
strout   sta $fb
         sty $fc
         ldy #0
soloop1  lda ($fb),y
         bne so1
         rts

so1      jsr bsout
         iny
         bne soloop1
         inc $fc
         jmp soloop1
;*******************************
striec   sta $fb
         sty $fc

         lda #8
         jsr listen
         lda #$6f
         jsr seclst

         ldy #0
siloop1  lda ($fb),y
         bne si1
         lda #8
         jmp unlist

si1      jsr iecout
         iny
         bne siloop1
         inc $fc
         jmp siloop1
;*******************************
opencom  lda #1
         ldx #<(comnam)
         ldy #>(comnam)
         jsr setnam
         lda #1
         ldx #8
         ldy #$6f
         jsr setpar
         jmp open
;*******************************
openio   jsr opencom
         lda #1
         ldx #<(bufnam)
         ldy #>(bufnam)
         jsr setnam
         lda #2
         ldx #8
         ldy #$62
         jsr setpar
         jmp open
;*******************************
closeio  lda #2
         jsr close
         lda #1
         jmp close
;*******************************
chgent   lda #<(text6)
         ldy #>(text6)
         jsr strout

         lda #1
         sta mem1

celoop1  lda #8
         jsr untalk
         ldy mem1
         lda blktab,y
         sta mem3
         ldx #<(com1)
         ldy #>(com1)
         jsr sendcom
         inc mem1
         lda #0
         sta mem2

celoop2  ldy mem2
         cpy #8
         beq celoop1
         lda enttab,y
         sta mem4
         ldx #<(com2)
         ldy #>(com2)
         jsr sendcom
         inc mem2

         lda #8
         jsr talk
         lda #$62
         jsr sectlk

         jsr iecin
         cmp #$82
         bne celoop2
         jsr iecin
         sta ftrack
         jsr iecin
         sta fsector

         ldy #$ff
celoop3  iny
         jsr iecin
         cmp name,y
         beq celoop3

         cpy #16
         beq ce1
         cmp #160
         bne celoop2
         lda name,y
         bne celoop2

ce1      lda #8
         jsr untalk

         lda mem4
         clc
         adc #1
         ldx #<(com2)
         ldy #>(com2)
         jsr sendcom

         lda #8
         jsr listen
         lda #$62
         jsr seclst

         lda #18
         jsr iecout
         lda dirstrt
         jsr iecout

         lda #8
         jsr unlist

         lda mem3
         ldx #<(com3)
         ldy #>(com3)
         jmp sendcom
;*******************************
wblocks  lda #<(text7)
         ldy #>(text7)
         jsr strout

         ldx #<(filemem)
         ldy #>(filemem)
         stx $fd
         sty $fe

wbloop1  lda #<(com4)
         ldy #>(com4)
         jsr striec

         lda #8
         jsr listen
         lda #$62
         jsr seclst

         ldy dsindex
wb4      iny
         lda blktab,y
         bpl wb1
         lda ftrack
         jsr iecout
         lda fsector
         jsr iecout
         jmp wb2

wb1      pha
         lda #18
         jsr iecout
         pla
         jsr iecout

wb2      ldy #0
wbloop2  lda ($fd),y
         jsr iecout
         iny
         cpy #$fe
         bne wbloop2

         lda #8
         jsr unlist

         lda $fd
         clc
         adc #$fe
         bcc wb3
         inc $fe
wb3      sta $fd

         ldy dsindex
         lda blktab,y
         pha
         ldx #<(com3)
         ldy #>(com3)
         jsr sendcom
         pla
         ldx #<(com8)
         ldy #>(com8)
         jsr sendcom
         inc dsindex
         dec dirfree
         bne wbloop1
         rts
;*******************************
sendcom  pha
         stx scloop1+1
         sty scloop1+2

         ldy #0
scloop1  lda $c000,y
         beq sc1
         sta combuff,y
         iny
         jmp scloop1

sc1      sty mem0
         pla
         jsr i2a
         ldy mem0

         ldx #0
scloop2  lda numbuff,x
         beq sc2
         sta combuff,y
         inx
         iny
         jmp scloop2

sc2      lda #13
         sta combuff,y
         iny
         lda #0
         sta combuff,y

         lda #<(combuff)
         ldy #>(combuff)
         jmp striec
;*******************************
com1     .text "u1 2 0 18"
         .byte 0
com2     .text "b-p 2"
         .byte 0
com3     .text "u2 2 0 18"
         .byte 0
com4     .text "b-p 2 0"
         .byte 13,0
com5     .text "m-r"
         .byte 250,2,3,13,0
com6     .text "u1 2 0 18 0"
         .byte 13,0
com7     .text "b-p 2 72"
         .byte 13,0
com8     .text "b-a 0 18"
         .byte 13,0

comnam   .text "i"
bufnam   .text "#"
;*******************************
blktab   .byte 0,1,4,7,10,13,16
         .byte 2,5,8,11,14,17
         .byte 3,6,9,12,15,18,$ff

enttab   .byte 2,34,66,98,130,162
         .byte 194,226,0

         .text "s:"
name     .byte 0,0,0,0,0,0,0,0
         .byte 0,0,0,0,0,0,0,0,0
;*******************************
text1    .text ""
         .text "             UseDir V1"
         .text ".0                "
         .text "   written anno 1992 b"
         .text "y Uli Basters     "
         .text "(Programmbeispiel zum "
         .text "Floppy-Kurs Teil8)"
         .byte 13
         .text "Dieses Programm speich"
         .text "ert ein File auf"
         .byte 13
         .text "Diskette, jedoch unter"
         .text " Mitbenutzung der"
         .byte 13
         .text "sonst unzugaenglichen "
         .text "Directoryblocks!"
         .byte 13,13
         .text "Filename: "
         .byte 0

text2    .byte 13,13
         .text "Bitte Zieldiskette e"
         .text "inlegen!"
         .byte 13,13,0
text3    .text "Untersuche Zieldiskett"
         .text "e..."
         .byte 13,13,0

text4    .text "File installiert!!"
         .byte 0

text5    .byte 13,13
         .text "File wird angelegt..."
         .byte 13,0
text6    .text "Suche und aendere Eint"
         .text "rag..."
         .byte 13,0
text7    .text "Schreibe und belege Di"
         .text "rblocks..."
         .byte 13,13,0

stext1   .text "Benoetigte Blocks: "
         .byte 0
stext2   .byte 13
         .text " Freie Dir-Blocks: "
         .byte 0
stext3   .byte 13
         .text "Freie Disk-Blocks: "
         .byte 0

errtxt1  .byte 13,13
         .text "Kein Dir-Block mehr fr"
         .text "ei!"
         .byte 0
errtxt2  .byte 13,13
         .text "File ist zu kurz!"
         .byte 0
errtxt3  .byte 13,13
         .text "File ist zu lang!"
         .byte 0
;*******************************