!  Amiga high-level DOS routines
!
!  a True BASIC, Inc. product
!
!  Copyright (c) 1986 by True BASIC, Inc.
!  All rights reserved.
!

EXTERNAL

SUB Askdir(name$)

    DECLARE DEF CurrentDir, DupLock, Addr, Examine
    DECLARE DEF UnNullt$, ParentDir, UnLock

    CALL ZeroString(fileinfoblock$,260)
    LET fi = Addr(fileinfoblock$)
    LET name$ = ""

    LET lock = CurrentDir(0)
    LET xxx = CurrentDir(lock)
    LET lock = DupLock(lock)

    DO
       LET ok = Examine(lock,fi)
       IF ok = 0 then EXIT DO
       LET filename$ = UnNullt$(fileinfoblock$[9:117])
       LET name$ = filename$ & "/" & name$
       LET nlock = ParentDir(lock)
       IF nlock = 0 then EXIT DO
       LET xxx = UnLock(lock)
       LET lock = nlock
    LOOP

    LET xxx = UnLock(lock)
    IF ok = 0 then CAUSE EXCEPTION 9002

    LET xxx = len(filename$)+1
    LET name$[xxx:xxx] = ":"

END SUB

SUB Chdir(name$)

    DECLARE DEF Lock, Addr, Examine, UnLock, CurrentDir, Nullt$

    LET xname$ = Nullt$(name$)
    LET mylock = Lock(Addr(xname$),-2)      ! shared lock
    IF mylock = 0 then CAUSE EXCEPTION 9003

    CALL ZeroString(infoblock$,260)
    LET result = Examine(mylock,Addr(infoblock$))
    IF result = 0 then
       LET result = UnLock(mylock)
       CAUSE EXCEPTION 9002
    END IF

    IF unpackb(infoblock$,33,-32) < 0 then
       LET result = UnLock(mylock)
       CAUSE EXCEPTION 953,"""" &  name$ & """ is a file, not a directory."
    END IF

    LET result = UnLock(CurrentDir(mylock))

END SUB

SUB Mkdir(name$)

    DECLARE DEF CreateDir, Addr, UnLock, IoErr, Nullt$

    LET xname$ = Nullt$(name$)
    LET lock = CreateDir(Addr(xname$))
    IF lock = 0 then
       SELECT CASE IoErr
       CASE 204, 205, 206, 210
            CAUSE EXCEPTION 9003
       CASE 214,222,223,224
            CAUSE EXCEPTION 9001
       CASE else
            CAUSE EXCEPTION 950,"Access denied."
       END SELECT
    ELSE
       LET xxx = UnLock(lock)
    END IF

END SUB

SUB Rename_file(old$,new$)

    DECLARE DEF Nullt$, Addr, Rename, IoErr

    LET xold$ = Nullt$(old$)
    LET xnew$ = Nullt$(new$)

    LET result = Rename(Addr(xold$),Addr(xnew$))
    IF result = 0 then
       SELECT CASE IoErr
       CASE 204,205,206,210
            CAUSE EXCEPTION 9003
       CASE 214,222,223,224
            CAUSE EXCEPTION 9001
       CASE 215
            CAUSE EXCEPTION 952,"Not same device."
       CASE else
            CAUSE EXCEPTION 9002
       END SELECT
    END IF

END SUB

SUB read_dir(name$(),size(),dlm$(),tlm$(),prot())

    DECLARE DEF Addr, UnNullt$, Examine, ExNext, CurrentDir, IoErr

    LET topsize = 40
    MAT name$ = Nul$(topsize)
    MAT size = Zer(topsize)
    MAT dlm$ = Nul$(topsize)
    MAT tlm$ = Nul$(topsize)
    MAT prot = Zer(topsize)

    LET mylock = CurrentDir(0)
    LET xxx = CurrentDir(mylock)
    CALL ZeroString(fileinfoblock$,260)
    LET fi = Addr(fileinfoblock$)

    LET ok = Examine(mylock,fi)
    IF ok<>0 then LET ok = ExNext(mylock,fi)

    DO while ok<>0
       LET index = index + 1
       IF index > topsize then
          LET topsize = topsize + 40
          CALL sresize(name$,topsize)
          CALL nresize(size,topsize)
          CALL sresize(dlm$,topsize)
          CALL sresize(tlm$,topsize)
          CALL nresize(prot,topsize)
       END IF
       LET name$(index) = UnNullt$(fileinfoblock$[9:117])
       IF unpackb(fileinfoblock$,4*8+1,-32) > 0 then
          LET name$(index) = name$(index) & "/"
       END IF
       LET size(index) = unpackb(fileinfoblock$,124*8+1,-32)
       LET prot(index) = unpackb(fileinfoblock$,116*8+1,-32)
       LET days =        unpackb(fileinfoblock$,132*8+1,-32)
       LET minutes =     unpackb(fileinfoblock$,136*8+1,-32)
       LET ticks =       unpackb(fileinfoblock$,140*8+1,-32)
       CALL store_date
       LET ok = ExNext(mylock,fi)
    LOOP

    IF IoErr <> 232 then CAUSE EXCEPTION 9002

    IF topsize <> index then
       CALL sresize(name$,index)
       CALL nresize(size,index)
       CALL sresize(dlm$,index)
       CALL sresize(tlm$,index)
       CALL nresize(prot,index)
    END IF

    SUB store_date
        CALL divide(days,365,years,days)
        CALL divide(years+1,4,leaps,mod)
        LET days = days-leaps+1
        IF days <= 0 then
           LET years = years-1
           LET days = days+365
           LET mod = mod + 3
           IF mod = 3 then LET days = days+1
        END IF
        LET years = years+1978
        LET months = 1
        LET dd$ = "310031303130313130313031"
        IF mod = 3 then LET dd$[3:4] = "29" else LET dd$[3:4] = "28"
        DO
           LET daysinmonth = val(dd$[months:months+1])
           IF days <= daysinmonth then EXIT DO
           LET months = months+2
           LET days = days-daysinmonth
        LOOP
        LET months = (months-1)/2 + 1
        LET dlm$(index) = using$("%%%%",years) & using$("%%",months,days)
        CALL divide(minutes,60,hours,minutes)
        CALL divide(ticks,50,seconds,ticks)
        LET tlm$(index) = using$("%%:%%:%%",hours,minutes,seconds)
    END SUB

    SUB sresize(s$(),n)
        DIM a$(1)
        MAT a$ = Nul$(n)
        FOR i = 1 to min(n,ubound(s$))
            LET a$(i) = s$(i)
        NEXT i
        MAT s$ = a$
    END SUB

    SUB nresize(s(),n)
        DIM a(1)
        MAT a = Zer(n)
        FOR i = 1 to min(n,ubound(s))
            LET a(i) = s(i)
        NEXT i
        MAT s = a
    END SUB

END SUB