The CDPD Public Domain Collection for CDTV 2/CDPD_II_2352.bin/scope/051-075/scopedisk62/quicklib/quicklib.bas

BASIC Source File | 1992-10-27 | 5KB | 227 lines

'* * * * * * * * * * * * * *
'*                         *
'*    QUICK_LIB            *
'*                         *
'*                         *
'*  Source code            *
'*      by                 *
'*  Robert D'Asto          *
'*                         *
'* * * * * * * * * * * * * *

'************************************
'*
'* copyright 1988 PiM Publications
'*
'* this program appeared in the March '89
'* issue of Amazing Computing [PO Box 869,
'* Fall River, MA 02722,  508-678-4200]
'*   reproduced and distributed with
'*      permission
'*
'*  Typed in and somewhat tweaked up by
'*      Bernie Cosell ([e-mail])
'*  The version in AC worked fine, so if this
'*  one doesn't, I screwed up either in my typing
'*  or in my "improvements"
'*
'***************************************


ON BREAK GOSUB endit
BREAK ON

MENU 1,0,1," Quick Lib "
MENU 1,1,1," Load bmap "
MENU 1,2,1," Quit      "

MENU 2,0,0,"           "
MENU 3,0,0,"           "
MENU 4,0,0,"           "

ON MENU GOSUB MenuSort
MENU ON

WHILE -1
  SLEEP
WEND

MenuSort:
  IF MENU(1) = 1 THEN GOSUB Loadbmap
  IF MENU(1) = 2 THEN GOSUB endit
RETURN

Loadbmap:
  bmap.name$ = ""
  lib.name$ = ""
  subname$ = ""
  Q$ = CHR$(34)
  CLS
startload:
  PRINT
  INPUT "Name of library to load "; b$
  IF RIGHT$(b$, 5) <> ".bmap" THEN
    IF RIGHT$(b$, 8) = ".library" THEN
      b$ = LEFT$(b$, LEN(b$) - 8) + ".bmap"
    ELSE
      PRINT
      PRINT "Spelling is incorrect or file"
      PRINT "is misnamed.  A bmap file name"
      PRINT "must end with " + Q$ + ".bmap" + Q$ + "."
      GOTO startload
    END IF
  END IF

  ON ERROR GOTO CatchError
  GotError = 0

  OPEN b$ FOR INPUT AS 1
  IF GotError THEN
    GotError = 0
    OPEN ":" + b$ FOR INPUT AS 1
    IF GotError THEN
      GotError = 0
      OPEN "libs:" + b$ FOR INPUT AS 1
      IF GotError THEN
        ON ERROR GOTO 0
        PRINT
        PRINT "Can't find bmap for library " + Q$ + b$ + Q$
        GOTO startload
      END IF
    END IF
  END IF
  ON ERROR GOTO 0

  bmap$ = INPUT$ (LOF(1), 1)
  CLOSE 1

'extract name of library from
'full pathname entered above
  startpoint% = LEN(b$) - 5
  namelen% = 1
  control% = 100

  WHILE startpoint% > 0 AND 96 < control%  AND control% < 123
    control% = ASC(MID$(b$, startpoint%, 1))
    startpoint% = startpoint% - 1
    namelen% = namelen% + 1
  WEND

  IF control% <= 96 OR 123 <= control% THEN
    n$ = MID$(b$, startpoint%+2, namelen%-2)
  ELSE
    n$ = MID$(b$, startpoint%+1, namelen%-1)
  END IF

'use name extracted above to
'create appropriate names for
'library, bmap and subprogram
  bmap.name$ = n$ + ".bmap"
  lib.name$ = n$ + ".library"
  subname$ = "Init." + n$ + ".lib"

'call the GetRoutine sub, passing the
'complete bmap and above names to it
  GetRoutine bmap$, lib.name$, bmap.name$, subname$
  NewCycle
RETURN

endit:
  MENU RESET
  END
RETURN


' Little bit of machinery to allow errors to be caught easily
CatchError:
  GotError = -1
RESUME NEXT


SUB GetRoutine (bmap$, lib$, bn$, s$) STATIC
  CLS
Start:
  routine$ = ""
  fd$ = ""
  Q$ = CHR$(34)

  PRINT
  PRINT "Name of first " + lib$ + " routine"
  INPUT "you wish to use "; routine$
  IF routine$ = "" THEN Start

Again:

'find routine within the bmap
  offset% = INSTR(bmap$, routine$ + CHR$(0))

  IF offset% = 0 THEN
    PRINT "I can't find " + Q$ + routine$ + Q$ + " in this library."
    PRINT "Check spelling."
    PRINT
    GOTO ReType
  END IF

  fd$ = fd$ + "  fd$ = fd$ + " + Q$ + routine$ + Q$
  fd$ = fd$ + " + chr$(0)" + CHR$(10) + "  "
  length% = LEN(routine$)+1
  count% = offset% + length%
  fd$ = fd$ + "fd$=fd$+"

'extract offset and parameter data
'for this routine from the bmap
  char$ = ""
  WHILE char$ <> CHR$(0)
    char$ = MID$(bmap$, count%, 1)
    fd$ = fd$ + "CHR$(" + MID$(STR$(ASC(char$)),2) + ")" + "+"
    count% = count% + 1
  WEND

  newlength% = LEN(fd$) - 1
  fd$ = LEFT$(fd$, newlength%)
  fd$ = fd$ + CHR$(10)

  PRINT
  PRINT "Thank you.  ";
ReType:
  PRINT "Next routine "
  INPUT "(if none press RETURN) ", routine$
  IF routine$ = "" THEN
    GOTO GoOn
  ELSEIF routine$ = CHR$(127) THEN
    GOTO Start
  ELSE
    GOTO Again
  END IF

GoOn:
  final.length% = LEN(fd$) - 1
  fd$ = LEFT$(fd$, final.length%)
  PRINT
  INPUT "name of destination file "; destfile$
  IF destfile$ = "" THEN GoOn
  F$ = " for output as 1"
  OPEN destfile$ FOR OUTPUT AS 1
  PRINT #1, ""
  PRINT #1, "SUB " + s$ + " STATIC"
  PRINT #1, fd$
  PRINT #1, "  OPEN " + Q$ + "RAM:" + bn$ + Q$ + F$
  PRINT #1, "  PRINT #1, fd$;"
  PRINT #1, "  CLOSE 1"
  PRINT #1, "  LIBRARY " + Q$ + "RAM:" + lib$ + Q$
  PRINT #1, "END SUB"
  CLOSE 1
  EXIT SUB
END SUB

SUB NewCycle STATIC
  CLS
  Q$ = CHR$(34)
  PRINT "If you wish to use routines"
  PRINT "from another library select"
  PRINT Q$ + "Load bmap" + Q$ + "from menu."
  EXIT SUB
END SUB