! VCRDOC.BAS - VCR directory reformatting program
! Version 1.0
! Author: John R. Plumlee, Sterling Quality Software, Inc.
!
! (C) 1985 Sterling Quality Software, Inc. All rights reserved.
!
! Permission is granted to any individual or institution to copy or use this
! software and the routines described in it, except for explicitly commercial
! purposes. This software must not be sold to any person or institution.
!
!*************************** D I S C L A I M E R ****************************
!* No warranty of the software or of the accuracy of the documentation **
!* surrounding it is expressed or implied, and neither the authors, **
!* Sterling Quality Software, Inc. nor AMUS acknowledge any liability **
!* resulting from program or documentation errors. **
!****************************************************************************
!
! usage format:
! VCRDOC [<optional-output-file-name>] [<optional-work-file-name>]
!
STRSIZ 80
MAP1 INPUT'LINE,S,74
MAP1 INPUT'WORK'AREA,@INPUT'LINE
MAP2 FILE'NUMBER,S,7
MAP2 FILE'DISK,S,6
MAP2 FILE'NAME,S,7
MAP2 FILE'EXT,S,4
MAP2 FILE'PPN,S,8
MAP2 FILE'SIZE,S,6
MAP2 FILE'TYPE,S,2
MAP2 FILE'DATE,S,10
MAP2 FILE'TIME,S,8
MAP2 FILE'FILLER,S,20
MAP1 HEADER'TABLE
MAP2 HEADER'LINE(6)
MAP3 HEADER'FILLER'1,S,15
MAP3 HEADER'TITLE,S,50
MAP3 HEADER'FILLER'2,S,11
MAP3 HEADER'PAGE,S,4
MAP1 PPN'HEADER
MAP2 PPN'DISK,S,6," "
MAP2 PPN'B'1,S,1,"["
MAP2 PPN'PPN,S,8," "
MAP2 PPN'B'2,S,1,"]"
MAP2 PPN'SPACE,S,4," "
MAP2 PPN'CONTINUE,S,11," "
MAP1 PPN'HEADER'WORK,S,31
MAP1 DETAIL'TABLE
MAP2 MAPLINE(51)
MAP3 OUT'COLUMN(4)
MAP4 OUT'NAME,S,7
MAP4 OUT'EXT,S,4
MAP4 OUT'SIZE,S,6
MAP4 OUT'TYPE,S,2
MAP4 OUT'FILLER,S,1
MAP1 REMAP'DETAIL'TABLE,@DETAIL'TABLE
MAP2 OUTLINE(51),S,80
MAP1 NUMBER'OF'HEADERS,B,2,6
MAP1 PAGE'NUMBER,B,2
MAP1 LINE'NUMBER,B,2,9999
MAP1 LINES'PER'PAGE,B,2,56
MAP1 PPN'FILES,F,6,0
MAP1 PPN'BLOCKS,F,6,0
MAP1 DISK'FILES,F,6,0
MAP1 DISK'BLOCKS,F,6,0
MAP1 TOTAL'FILES,F,6,0
MAP1 TOTAL'BLOCKS,F,6,0
MAP1 SOURCE'FILE'NAME,S,10
MAP1 OUTPUT'FILE'NAME,S,10
FOR X = 1 TO NUMBER'OF'HEADERS
HEADER'LINE(X) = SPACE(80)
NEXT X
MAPLINE(51) = SPACE(80)
FOR X = 1 TO 4
OUT'NAME(51,X) = ""
NEXT X
FOR X = 1 TO 50
MAPLINE(X) = MAPLINE(51)
NEXT X
PRINT TAB(-1,0)
PRINT "THE DATA MANAGER Tape Directory Reformatter Version 1.0"
PRINT "Copyright 1985 by Sterling Quality Software, Inc."
PRINT " "
INPUT "Source file name = ",SOURCE'FILE'NAME
SOURCE'FILE'NAME= UCS(SOURCE'FILE'NAME)
INPUT "Output file name = ",OUTPUT'FILE'NAME
OUTPUT'FILE'NAME= UCS(OUTPUT'FILE'NAME)
I = INSTR(1,SOURCE'FILE'NAME,".")
IF I = 0 THEN &
SOURCE'FILE'NAME= SOURCE'FILE'NAME + ".LST"
I = INSTR(1,SOURCE'FILE'NAME,".")
IF OUTPUT'FILE'NAME = "*" THEN &
OUTPUT'FILE'NAME= SOURCE'FILE'NAME[1,I] + "PRT"
I = INSTR(1,OUTPUT'FILE'NAME,".")
IF I = 0 THEN &
OUTPUT'FILE'NAME= OUTPUT'FILE'NAME + ".PRT"
OPEN #1,SOURCE'FILE'NAME,INPUT
OPEN #2,OUTPUT'FILE'NAME,OUTPUT
GOSUB READ'INPUT'FILE
GOSUB READ'INPUT'FILE
GOSUB READ'INPUT'FILE
HEADER'TITLE(1) = " Reformated Tape Directory "
HEADER'TITLE(2) = " For "
010 GET'TITLES:
FOR X = 3 TO 5
GOSUB READ'INPUT'FILE
HEADER'TITLE(X) = INPUT'LINE + SPACE(50)
NEXT X
HEADER'FILLER'2(5) = " Page "
ROW = 0
COL = 1
020 PROCESS'INPUT'FILE:
GOSUB READ'INPUT'FILE
IF EOF(1) THEN &
GOTO WRAP'UP'PROGRAM
IF VAL(FILE'NUMBER) = 0 THEN &
GOTO PROCESS'INPUT'FILE
IF (FILE'DISK <> PPN'DISK OR &
FILE'PPN <> PPN'PPN) AND &
PPN'DISK <> " " AND &
PPN'PPN <> " " THEN &
GOSUB HEADERS : &
GOSUB PRINT'PAGE : &
GOSUB CONTROL'BREAK : &
PPN'DISK = FILE'DISK : &
PPN'PPN = FILE'PPN : &
PPN'CONTINUE = " " : &
ROW = 0 : &
COL = 1
ROW = ROW + 1
IF ROW > 50 THEN &
COL = COL + 1 : &
ROW = 1
IF COL > 4 THEN &
GOSUB HEADERS : &
GOSUB PRINT'PAGE : &
PPN'CONTINUE = "(continued)" : &
ROW = 1 : &
COL = 1
PPN'DISK = FILE'DISK
PPN'PPN = FILE'PPN
OUT'NAME(ROW,COL) = FILE'NAME
OUT'EXT(ROW,COL) = FILE'EXT
OUT'SIZE(ROW,COL) = FILE'SIZE
OUT'TYPE(ROW,COL) = FILE'TYPE
PPN'FILES = PPN'FILES + 1
PPN'BLOCKS = PPN'BLOCKS + VAL(FILE'SIZE)
DISK'FILES = DISK'FILES + 1
DISK'BLOCKS = DISK'BLOCKS + VAL(FILE'SIZE)
TOTAL'FILES = TOTAL'FILES + 1
TOTAL'BLOCKS = TOTAL'BLOCKS + VAL(FILE'SIZE)
GOTO PROCESS'INPUT'FILE
030 HEADERS:
PAGE'NUMBER = PAGE'NUMBER + 1
HEADER'PAGE(NUMBER'OF'HEADERS - 1) &
= PAGE'NUMBER USING "####"
PRINT #2,CHR(12);
FOR X = 1 TO NUMBER'OF'HEADERS
PRINT #2,HEADER'LINE(X)
NEXT X
RETURN
040 PRINT'PAGE:
PPN'HEADER'WORK = PPN'HEADER
X = 2
045 PRINT'PAGE'PPN'SQUEEZE:
IF PPN'HEADER'WORK[X,X] = " " THEN &
PPN'HEADER'WORK = PPN'HEADER'WORK[ 1,X-1] + &
PPN'HEADER'WORK[X+1, 20] + &
" " + &
PPN'HEADER'WORK[ 21, 31] : &
GOTO PRINT'PAGE'PPN'SQUEEZE
IF PPN'HEADER'WORK[X,X] <> "]" AND &
X < 20 THEN &
X = X + 1 : &
GOTO PRINT'PAGE'PPN'SQUEEZE
PRINT #2," ";PPN'HEADER'WORK
PRINT #2,""
FOR X = 1 TO 50
PRINT #2," ";OUTLINE(X)[1,-3]
NEXT X
PRINT #2,""
FOR X = 1 TO 50
MAPLINE(X) = MAPLINE(51)
NEXT X
RETURN
050 CONTROL'BREAK:
PPN'HEADER'WORK = "[" + PPN'PPN + "]"
X = 2
055 CONTROL'BREAK'SQUEEZE:
IF PPN'HEADER'WORK[X,X] = " " THEN &
PPN'HEADER'WORK = PPN'HEADER'WORK[ 1,X-1] + &
PPN'HEADER'WORK[X+1, -1] : &
GOTO CONTROL'BREAK'SQUEEZE
IF PPN'HEADER'WORK[X,X] <> "]" AND &
X < 20 THEN &
X = X + 1 : &
GOTO CONTROL'BREAK'SQUEEZE
FOR X = 2 TO 9
IF PPN'HEADER'WORK[X,X] = " " THEN &
PPN'HEADER'WORK = PPN'HEADER'WORK[ 1,X-1] + &
PPN'HEADER'WORK[X+1, 20]
NEXT X
IF FILE'DISK <> PPN'DISK OR &
FILE'PPN <> PPN'PPN THEN &
PRINT #2," ";PPN'FILES;" files in "; &
PPN'BLOCKS;" blocks for ";PPN'HEADER'WORK : &
PRINT #2,"" : &
PPN'FILES = 0 : &
PPN'BLOCKS = 0
IF FILE'DISK <> PPN'DISK THEN &
PRINT #2," ";DISK'FILES;" files in "; &
DISK'BLOCKS;" blocks for ";PPN'DISK : &
PRINT #2,"" : &
DISK'FILES = 0 : &
DISK'BLOCKS = 0
RETURN
060 WRAP'UP'PROGRAM:
FILE'DISK = SPACE(10)
FILE'PPN = SPACE(10)
GOSUB HEADERS
GOSUB PRINT'PAGE
GOSUB CONTROL'BREAK
PRINT #2," Total of ";TOTAL'FILES;" files in ";TOTAL'BLOCKS;" blocks"
PRINT #2,CHR(12);
CLOSE #1
CLOSE #2
END
070 READ'INPUT'FILE:
IF EOF(1) THEN &
RETURN
INPUT LINE #1,INPUT'LINE
RETURN
