CP/M/CPM_CDROM.iso/lambda/soundpot/p/sbasics.lbr/DRIVER.BZS/DRIVER.BAS

BASIC Source File | 1993-10-25 | 11.4 KB | 427 lines

comment
    Program:    DRIVER
    Version:    1.0
        Date:        30 May 83
    Purpose:    Display a menu of COM files and execute selected
            program.
    Writer:         Bryan Ashby
            850 Pine Avenue, Pacific Grove, CA 93950.
    Copyright:    None.  This program is deposited in the public domain
            in the hope that it may be improved.

    Program Structure:
                DRIVER
                                   |
          _________________________|________________
          |        |                 |               |
      SET_DISK   MENU          SELECT         RUN
                   |             |    |           | |
             |   POINTER_BACK   |  PARAMETERS |
             |              |            ADD_CHAR
             |          POINTER_FORWARD
             |
     ______________|__________________________________
     |           |       |         |                  |
READ_SECTOR    MATCH   SKEW   DISPLAY_LABEL   DIRECTORY_ENTRY

end
$page
rem ---------------------------------------
rem Set addresses of BIOS entry points.
rem See CP/M Alteration Guide, Section 6.
rem ---------------------------------------
var    SELDSK      ; Select disk
    SETTRK        ; Set track
    SETSEC        ; Set sector
    SETDMA        ; Set Disk Memory Access buffer
    B_READ        ; Read sector
    SECTRAN        ; Logical-to-physical sector translate
        = integer
based    WBOOT     = integer
base      WBOOT at 1
SELDSK    = WBOOT + 24
SETTRK    = WBOOT + 27
SETSEC    = WBOOT + 30
SETDMA    = WBOOT + 33
B_READ    = WBOOT + 36
SECTRAN    = WBOOT + 36

rem -------------
rem CPU registers
rem -------------
var    HL,DE,BC,A_PSW    = integer
based     BIOS_RETURN    = byte
location var HL = A_PSW
base BIOS_RETURN at HL + 1

rem ----------------------------------------------
rem Disk Memory Access (DMA) buffer for sector I/O
rem ----------------------------------------------
dim byte    SECTOR(128)
var         LOC_SECTOR = integer
location array    LOC_SECTOR = SECTOR

dim byte COMMANDS(20,10)
$constant     TOPLINE = 5
$constant     BOTTOMLINE = 19
$constant     COL1    = 18
$constant     COL2    = 52
$constant    ETERNITY = 0
$page
var     BYTE    = byte    ; Input character
var    I,J,K        ; Work variables
    FCB_LOC        ; Location of File Control Block
    DIR_SECTORS    ; Number of sectors occupied by directory
       COUNT            ; Number of COM files
    LEFTCOUNT    ; Number of files in left column
    X,Y         ; Location of cursor
        = integer
based    FIRST_DIR_TRACK    ;
    SKEW_TABLE_ADDRESS ;
    SECTORS_PER_TRACK  = integer
dim base byte FILENAME(8)

$constant TBUFF = 80H
based BUFFLEN   = byte
base  BUFFLEN   at TBUFF
dim base char COMBUFF(30)
locate COMBUFF at TBUFF + 1
dim base byte COMARRAY(30)
var     COMMAND = string:14
$page

Procedure SET_DISK ( DISK = char )
rem ==========================================================
rem Select the disk in the DISK drive and set the DMA.
rem ==========================================================
var    DISKNUM        ;
    DPH_ADDRESS    = integer    ; Address of Disk Parameter Header
based    DPB              = integer    ; Disk Parameter Block
based   DIR_BLOCKS    = integer

DISKNUM = DISK - 'A'

call (SELDSK, DPH_ADDRESS, DE, DISKNUM, A_PSW)

   base SKEW_TABLE_ADDRESS at DPH_ADDRESS
   base DPB           at DPH_ADDRESS + 10
   base SECTORS_PER_TRACK  at DPB
   base DIR_BLOCKS       at DPB + 7
   base FIRST_DIR_TRACK       at DPB + 13
   DIR_SECTORS    = (DIR_BLOCKS+1) / 4
   BC = LOC_SECTOR + 1

call (SETDMA, HL, DE, BC, A_PSW)

end
$page

Function SKEW (SECTR = integer) = integer
rem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rem Return the physical sector number coresponding to the logical sector SECTR
rem Uses the BIOS routine SECTRAN and the translate table address which was set
rem in SET_DISK.
rem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if SKEW_TABLE_ADDRESS <> 0 \
    then begin
        BC = SECTR - 1
        call (SECTRAN, HL, SKEW_TABLE_ADDRESS, BC, A_PSW)
         end
    else HL = SECTR - 1
end = HL

Procedure READ_SECTOR (TRACK, SEC = integer)
rem =================================================
rem Read sector SEC of track TRACK into SECTOR array.
rem =================================================
for K = 1 to 128
    SECTOR[K] = 0
next K
call (SETTRK, HL, DE, TRACK, A_PSW)
call (SETSEC, HL, DE, SEC,   A_PSW)
call (B_READ, HL, DE, BC,    A_PSW)
SECTOR[0] = BIOS_RETURN
end

Procedure GOTOXY (XX,YY = integer)
rem ================================
rem Move cursor to column XX, line YY.
rem 1,1 is top left.
rem ================================
print chr(27); '='; chr(YY+31); chr(XX+31);
end

Procedure DISPLAY (XX,YY = integer; IT = string)
rem ==================
rem Display IT at XX,YY.
rem ==================
GOTOXY XX,YY
print IT;
end
$page
Procedure DISPLAY_LABEL (DISK=byte)
rem ==========================================
rem Display the disk 'label'.
rem The label is a filename starting with '-'.
rem ==========================================
var L = integer
dim base byte TYPE(3)
DISPLAY X-6, 3, "Disk ";
print DISK; " is:             ";
GOTOXY X+5, 3
for L = 1 to 8
    if FILENAME[L] = ' ' \
    then L = 8
    else print FILENAME[L];
next L
print '.';
locate TYPE at FCB_LOC + 9
for L = 1 to 3
    print TYPE[L];
next L
end

Function MATCH (ADDRESS=integer; TARGET=string:8) = byte
rem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rem See whether the characters starting at ADDRESS match the TARGET string.
rem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dim base byte ARRAY(8)
var RESULT = byte
var INDEX  = integer
locate ARRAY at ADDRESS
RESULT = 't'
INDEX = 0
repeat
    begin
    INDEX = INDEX + 1
    if ARRAY[INDEX] <> mid(TARGET,INDEX,1) then RESULT = 'f'
    end
until RESULT = 'f' or INDEX = len(TARGET)
end = RESULT
$page
Procedure DIRECTORY_ENTRY (DISK = byte)
rem =============================================================
rem Read an entry from the directory on DISK.
rem If its a COM file, display it and save it in the COMMANDS table.
rem =============================================================
based    EXTENT  = byte
base    EXTENT  at FCB_LOC + 13
if EXTENT = 0 \
    then begin
        if FILENAME[1] = '-' then DISPLAY_LABEL DISK
            if MATCH(FCB_LOC+9,"COM") \
        then if MATCH(FCB_LOC+1,"DRIVER") = 'f' \
            then begin
                GOTOXY X, Y
                print DISK; ": ";
                COUNT = COUNT + 1
                COMMANDS[COUNT,1] = DISK
                COMMANDS[COUNT,2] = ':'
                for K = 1 to 8
                    print FILENAME[K];
                    COMMANDS[COUNT,K+2] = FILENAME[K]
                next K
                Y = Y + 1
                if Y > BOTTOMLINE \
                    then begin
                        Y = TOPLINE
                        X  = COL2
                     end
                 end
     end
end
$page
Procedure MENU ( DISK = byte )
rem =============================================================
rem Read the directory of the DISK, and construct the menu.
rem Display each COM file name and save it in the COMMANDS table.
rem The first byte is ASCII 229 (E5H) if entry is unused.
rem =============================================================
var    TRACK    ;
    SEC    ;
    COUNTX    = integer
based   USED    = byte
COUNTX  = COUNT
TRACK    = FIRST_DIR_TRACK
SEC    = 0
for I = 1 to DIR_SECTORS
    SEC = SEC + 1
    if SEC > SECTORS_PER_TRACK \
    then begin
        TRACK = TRACK + 1
        SEC   = 1
         end
    READ_SECTOR TRACK, SKEW(SEC)
    for FCB_LOC = LOC_SECTOR to LOC_SECTOR+96 step 32
    base USED at FCB_LOC
    locate FILENAME at FCB_LOC + 1
    if USED = chr(229) \
        then if FILENAME[1] = chr(229) \
            then I = DIR_SECTORS    rem: No more dirctory entries.
            else I = I            rem: Dummy statement
        else DIRECTORY_ENTRY DISK
    next FCB_LOC
next I
if COUNT = COUNTX \
    then begin
        if DISK = 'A' then X = COL1
              else X = COL2
        DISPLAY X,TOPLINE, "(No COM files) "
     end
end
$page
procedure POINTER_BACK
rem ======================================================================
rem Move the pointer back;  if at the top, move to the bottom.
rem Called from SELECT in response to an up-arrow, left-arrow, "<" or ",".
rem ======================================================================
if I = 1 \
    then begin
        I = COUNT
        if LEFTCOUNT = COUNT \
        then Y = TOPLINE + COUNT - 1
        else begin
            Y = TOPLINE + COUNT - LEFTCOUNT - 1
            X  = COL2 - 5
             end
     end
    else begin
        I = I - 1
        if Y = TOPLINE \
        then begin
            Y = TOPLINE + LEFTCOUNT - 1
            X  = COL1 - 5
             end
        else Y = Y - 1
    end
end

procedure POINTER_FORWARD
rem ======================================================================
rem Move the pointer forward;  if at the bottom, move to the top.
rem ======================================================================
if I = COUNT \
    then begin
        I    = 1
        Y = TOPLINE
        X  = COL1 - 5
     end
    else begin
        I = I + 1
        if I = LEFTCOUNT + 1 \
            then begin
                Y = TOPLINE
                X  = COL2 - 5
             end
        else Y = Y + 1
     end
end
$page
procedure PROMPT (MESSAGE=string)
rem ==================================================================
rem Display a message on the prompt line.  Clear the rest of the line.
rem ==================================================================
var COL,LINE = integer
COL = len(MESSAGE) + 1
LINE = BOTTOMLINE + 2
DISPLAY   1, LINE, MESSAGE
DISPLAY COL, LINE, space$(80-COL)
GOTOXY  COL+1, LINE
end


procedure SELECT
rem =========================================
rem Select a program from the table.
rem I is sequence number of selected program.
rem =========================================
PROMPT "X selects program;  any other key moves pointer."
Y = TOPLINE
X = COL1 - 5
I = 1
repeat
   begin
    DISPLAY X, Y, "X-->"
    GOTOXY  X, Y
    input3 BYTE
    if BYTE <> 'X' and BYTE <> 'x' \
        then begin
             DISPLAY X, Y, "    "
            if BYTE = 8 or BYTE = 11 or BYTE = ',' or BYTE = '<' \
            then POINTER_BACK
            else POINTER_FORWARD
         end
   end
until BYTE = 'X' or BYTE = 'x'
end
$page
procedure RUN
rem ----------------------------------------------------------------------
rem Display the selected program name and execute it.
rem ----------------------------------------------------------------------
var NOMORE = byte
X = 1
Y = BOTTOMLINE + 3
GOTOXY  X, Y
COMMAND = space$(14)
NOMORE = 'f'
repeat
    begin
    if X > 2 then mid(COMMAND,X-2,1) = COMMANDS[I,X]
    if X = 2 then print '>';
         else print COMMANDS[I,X];
    X = X + 1
    if X = 11 \
        then NOMORE = 't'
        else if COMMANDS[I,X] = ' ' then NOMORE = 't'
    end
until NOMORE
print ' ';
if X = 11 \
    then mid(COMMAND,X-1,4) = ".COM"
    else mid(COMMAND,X-2,4) = ".COM"

SET_DISK COMMANDS[I,1]        rem: Select drive A or B

execute COMMAND            rem: Exit DRIVER.  It is assumed that DRIVER
                rem: has been linked into CP/M by the Auto-load
                rem: feature, so it will be reinvoked on the
                rem: next warm boot.
end
$page
print chr(26);
DISPLAY 29,1, "~~~  D R I V E R  ~~~"

Y    = TOPLINE
X    = COL1
COUNT     = 0
SET_DISK 'A'

MENU 'A'

if X = COL1 then LEFTCOUNT = COUNT
        else LEFTCOUNT = BOTTOMLINE - TOPLINE + 1
PROMPT "Drive B too ?  (y/n)  "
input3 BYTE
if BYTE = 'Y' or BYTE = 'y' \
    then begin
        SET_DISK 'B'
        if X = COL1 then Y = TOPLINE
        X = COL2
        MENU 'B'
     end

if COUNT > 0 \
    then repeat
         begin
        SELECT
        RUN
         end
     until ETERNITY
    else begin
         PROMPT "Please put another disk in A or B, then press any key."
         input3 BYTE
     end

end