!*************************** AMUS Program Label ******************************
! Filename: PROLAB.BAS Date: 2/26/90
! Category: UTIL Hash Code: 651-773-641-647 Version: 1.0(101)
! Initials: GR/AM Name: James A. Jarboe IV
! Company: Educational Video Network, Inc. Telephone #: 4092955767
! Related Files: PROLAB.DOC, EDIT.SBR, DIRHSH.SBR, MACLIB.UNV (FOR EDIT.SBR)
! Min. Op. Sys.: AMOSL 1.0 Expertise Level: BEG
! Special: Uses DIRHSH.SBR to get hash/version of compiled or assembled file.
! Description: Used to create a program label for donations made to the AMUS
! Network. Creates a file called LABEL.RPT which can then be appended to
! the top of the source code program. See PROLAB.DOC for more info.
!*****************************************************************************
!*! Updated on 26-Feb-90 at 4:54 AM by James A. Jarboe IV; edit time: 2:11:32
!*************************** AMUS Program Label ******************************
! Filename: PROLAB.BAS Date: 01/19/89
! Category: UTIL Hash Code: 774-057-755-505 Version: 1.0(100)
! Initials: ARCH/US Name: STEVE ARCHULETA
! Company: ALPHA MICRO USERS SOCIETY Telephone #: 3034496917
! Related Files: PROLAB.DOC, EDIT.M68 (SBR), MACLIB.UNV-TO ASSEMBLE EDIT.M68
! Min. Op. Sys.: AMOSL 1.0 Expertise Level: BEG
! Special:
! Description: Used to create a program label for donations made to the AMUS
! Network. Creates a file called LABEL.RPT which can then be appended to
! the top of the source code program. See PROLAB.DOC for more info.
!*****************************************************************************
! -NOTE- Added help prompts, visual border as to what border PROLAB will
! output, option to load some user defaults via "PROLAB.INI",
! automatic preloading of most of the previous AMUS program label
! from the source code if it exists to cut down on data entry, and
! automatic hashing of files using DIRHSH.SBR. 26-Feb-90 [JAJ]
!
Program PROLAB,1.0(101) ! New version.
MAP1 dummy,S,1 !dummy variable
MAP1 file'type,S,1,"" !type of file by extension
MAP1 field(16) !field record
MAP2 prompt,S,17 ! field prompt
MAP2 pr'x,F ! field prompt column
MAP2 pr'y,F ! field prompt row
MAP2 y,S,3 ! field row
MAP2 x,S,3 ! field column
MAP2 type,S,2 ! field type
MAP2 minsize,S,2 ! minimum field size
MAP2 maxsize,S,2 ! maximum field size
MAP2 flags,S,3 ! field flag
MAP2 string,S,80 ! field string
MAP1 num'flds,F,,16 !number of defined fields
MAP1 key,B,2 !result code from EDIT XCALL
MAP1 fld'stats,S,16 !string descriptor for EDIT XCALL
MAP1 fld,F !field counter
MAP1 col,F !column var for PRINT'RPT
MAP1 comment'char,S,1,"*" !comment char var for PRINT'RPT
MAP1 ini'file, S, 20, "PROLAB.INI" ! INI file name.
MAP1 hash'array, S, 74 ! DIRHSH.SBR returned file data.
MAP1 hash'file, S, 30 ! Filename to DIRHSH.
MAP1 hash'flag, B, 1 ! DIRHSH error flag.
MAP1 prompt'hlp(16),S,70 ! Field prompt helps.
prompt'hlp(1 ) = "Enter name of source file."
prompt'hlp(2 ) = "Enter Current Date."
prompt'hlp(3 ) = "UTIL, SBR, GAME, TDV, MATH, TEXT, GRAP, DOC, COMM, CAL, SEC, SCI"
prompt'hlp(4 ) = "Enter hash total of assembled or compiled program."
prompt'hlp(5 ) = "Enter version number of assembled or compiled program."
prompt'hlp(6 ) = "Enter your AMUS EMAIL initials."
prompt'hlp(7 ) = "Enter Donators name."
prompt'hlp(8 ) = "Enter Donators Company Name."
prompt'hlp(9 ) = "Enter phone number you can be reached at (optional)."
prompt'hlp(10) = "Enter any files related to this program."
prompt'hlp(11) = "Enter Minimum AMUS O/S this program can run on."
prompt'hlp(12) = "(BEG)inner, (INT)ermediate, (ADV)anced."
prompt'hlp(13) = "Enter any special considerations."
prompt'hlp(14) = "Enter a general description of this program."
prompt'hlp(15) = "Enter a general description of this program."
prompt'hlp(16) = "Enter a general description of this program."
MAP1 ini'default(4), S, 7 ! INI file default names.
ini'default(1) = "INITIAL" ! AMUS network ID.
ini'default(2) = "NAME" ! Donators name.
ini'default(3) = "COMPANY" ! Donators company name.
ini'default(4) = "PHONE" ! Donators phone.
MAP1 ini'string, S, 80 ! ini default input string.
MAP1 bin'date, B, 4 ! Binary date.
MAP1 the'date,@bin'date ! date in accessable variables.
MAP2 month, B, 1 ! the month
MAP2 day, B, 1 ! the day
MAP2 year, B, 1 ! the year
MAP1 previous'flag, F, 6 ! Previous AMUS label loaded flag.
MAP1 stars,S,75 ! label border.
stars="*****"
for i = 1 to 5
stars=stars+stars
next i
!***********************************************************************
! Main program structure - follow the call routines and you've got the *
! program flow. *
!***********************************************************************
on error goto TRAP'ERROR !clear screen on error
call START'UP !start program
call LOAD'FIELDS !initialize fields
call LOAD'DEFAULTS ! Preload defaults from INI file.
call PRINT'FIELDS !print fields on terminal screen
call PROCESS'FIELDS !get field input
call PRINT'RPT !create output report
goto EXIT !finished
!***********************************************************************
! START'UP - Find out what type of source code is involved so we can *
! set the appropriate comment character (default to DOC). If a Q then *
! abandon ship. *
!***********************************************************************
START'UP:
? tab(-1,0)
? tab(16) "********* AMUS Program Label Generator *********"
?
?
?
? "File types: (M)68, (B)asic, (C), (P)ostScript, (D)oc"
?
input "Enter file type or 'Q' to quit: ", file'type
file'type = ucs(file'type[1;1])
if file'type = "Q" then goto EXIT
if file'type = "M" then comment'char = ";"
if file'type = "B" then comment'char = "!"
if file'type = "C" then comment'char = "/"
if file'type = "P" then comment'char = "%"
if file'type = "D" then comment'char = "*"
RETURN
!***********************************************************************
! LOAD'FIELDS - Read in field data from data statements. Data includes *
! prompt string, prompt display x-y coordinates, data field x-y coords,*
! field type (* - string), field minimum size, field maximum size, and *
! and field flags (U - Uppercase, R - Required field) *
!***********************************************************************
LOAD'FIELDS:
for fld = 1 to num'flds
read prompt(fld),pr'x(fld),pr'y(fld),y(fld),x(fld),type(fld),minsize(fld),maxsize(fld),flags(fld)
next fld
RETURN
!***********************************************************************
! PRINT'FIELDS - display field prompts on terminal screen *
!***********************************************************************
PRINT'FIELDS:
? tab(-1,0)
? TAB(4,1);comment'char+stars
? TAB(4,28);" AMUS Program Label "
for fld = 5 to 14
? TAB(fld,1);comment'char
next fld
? comment'char+stars
for fld = 1 to num'flds
? tab(pr'y(fld),pr'x(fld)) prompt(fld);string(fld)
next fld
? tab(17,28) "[ Press ESC to Finish ]"
fld = 1
RETURN
!***********************************************************************
! PROCESS'FIELDS - Set up program to receive input data. Keep track of *
! field location and increment appropriately - if Up-Arrow then go back*
! one field, otherwise move to next field. If at first or last fields *
! then cycle back to appropriate field. If ESC then return. *
!***********************************************************************
PROCESS'FIELDS:
call GET'INPUT
if key = 1 then return
if fld = 1 then call AUTO'HASH
if key = 2 then fld = fld - 1 &
else fld = fld + 1
if fld < 1 then fld = num'flds
if fld > num'flds then fld = 1
goto PROCESS'FIELDS
!***********************************************************************
! LOAD'STRING - Preload Strings with defaults from PROLAB.INI if it *
! it exists. PROLAB.INI is an initialization file for PROLAB.RUN. *
! Using PROLAB.INI you can set defaults which will be proloaded into *
! the Initial, Name, Company, and Phone fields so that information *
! does not have to be typed in every time. Search path is local *
! account, BAS: . If you want others add them. *
! PROLAB.INI is a VUEable file with the following format. The labels *
! must be included. *
! *
!Example INITIALS =ARCH/US *
! NAME =Steve Archuleta *
! COMPANY =Alpha Micro Users Society *
! PHONE =3034496917 *
! *
!***********************************************************************
LOAD'DEFAULTS:
bin'date= DATE
string(2)=str(month)+"/"+str(day)+"/"+str(year)
LOOKUP ini'file, answer
if answer > 0 goto LOAD'EM
ini'file = "BAS:"+ini'file
LOOKUP "BAS:PROLAB.INI", answer
if answer < 1 RETURN
!***********************************************************************
!LOAD'EM: Open the PROLAB.INI file for input. Could be the INI file in *
!this account or any set in LOAD'DEFAULTS. *
!***********************************************************************
LOAD'EM:
open #99, ini'file, input
!***********************************************************************
!GET'DEF - Get ini file input and check for "=", commented out lines, *
!and blank lines. Report errors at INI'ERROR. *
!***********************************************************************
GET'DEF:
input line #99, ini'string
if eof(99) then CLOSE #99 : RETURN
if ini'string[1;1]=";" then goto GET'DEF
if ini'string="" then goto GET'DEF
eq = instr(1,ini'string,"=")
if eq = 0 goto INI'ERROR
c = 1
!***********************************************************************
!FIND'DEF - located default definition and load default. If definition *
! does not match then report error at INI'ERROR. *
!***********************************************************************
FIND'DEF:
g = instr(1,UCS(ini'string), ini'default(c))
if g then &
ini'string = ini'string[eq+1,len(ini'string)] &
: goto BYP'BLNK
if c = 4 goto INI'ERROR
c=c+1
goto FIND'DEF
!***********************************************************************
!BYP'BLNK - Bypass white space in Default definitions, set default and *
!attempt to get next default at GET'DEF *
!***********************************************************************
BYP'BLNK:
if ini'string[1,1]=" " then &
ini'string = ini'string[2,len(ini'string)] &
: goto BYP'BLNK
string(c+5) = ini'string
goto GET'DEF
!***********************************************************************
!INI'ERROR - An error has been located in the PROLAB.INI file. Error *
! is reported and default file input is suspended *
!***********************************************************************
INI'ERROR:
? : ? "Error in ";ini'file;" -> ";ini'string
? "Press ENTER to continue "; : input "",c
CLOSE #99
RETURN
!***********************************************************************
! GET'INPUT - Use EDIT.SBR to take care of user input. Allows use of *
! various VUE control chars to edit input. See EDIT.M68 in [100,52] *
! on AMUS Network. *
!***********************************************************************
GET'INPUT:
call SHOW'HELP
fld'stats = y(fld) + x(fld) + type(fld) &
+ minsize(fld) + maxsize(fld) + flags(fld)
xcall edit,fld'stats,string(fld),key
RETURN
!***********************************************************************
! AUTO'HASH - Gets hash total from file using XCALL DIRHSH.SBR *
! for automatic input to Hash and Version *
!***********************************************************************
AUTO'HASH:
CALL LOAD'PREVIOUS
if hash'file <> "" then goto LOOK'HASH
dot = instr(1,string(1),".")
if dot then hash'file=string(1)[1,dot-1] &
else hash'file=string(1)
if file'type="M" hash'file=hash'file+".LIT"
if file'type="C" hash'file=hash'file+".LIT"
if file'type="B" hash'file=hash'file+".RUN"
if file'type="P" hash'file=hash'file+".PS "
if file'type="D" hash'file=hash'file+".DOC"
!***********************************************************************
!LOOK'HASH - Looks up the name of the file to get hash and version *
! number. If default file does not exist then user will be asked for *
! file name to do a HASH on. Complete filespec is accepted. *
!***********************************************************************
LOOK'HASH:
LOOKUP hash'file, answer
if answer <1 then goto ASK'HASH
if hash'flag <> 0 then goto ASK'HASH
string(4)= hash'array[57;15] : ? tab(y(4),x(4));string(4)
string(5)= hash'array[39;15] : ? tab(y(5),x(5));string(5)
RETURN
!***********************************************************************
!ASK'HASH - Default file was not found. User is asked to input file *
! name to HASH. An empty field will return user to prompts without *
! HASHing a file. If a file name is given then file will attempted *
! to be HASHed in LOOK'HASH. *
!***********************************************************************
ASK'HASH:
? TAB(19,25);"Cannot find ";hash'file;"."
hash'file= ""
? TAB(21,13);"Enter file name to HASH "
? TAB(24,13);"Enter nothing but a RETURN to NOT Hash a file.";
fld'stats = "21 "+"37 "+"* "+"0 "+"25"+"U R"
xcall edit,fld'stats,hash'file,key
? tab(19,1);tab(-1,10);
if hash'file="" RETURN
goto LOOK'HASH
!***********************************************************************
!SHOW'HELP - All field helps (prompt'hlp) are displayed here by *
!centering the text on line 24 of the terminal. *
!***********************************************************************
SHOW'HELP:
? TAB(24,1);tab(-1,9);
c= (40-(len(prompt'hlp(fld))/2))
? tab(24,c);prompt'hlp(fld);
return
!***********************************************************************
! LOAD'PREVIOUS- Preload applicable fields with previous label data *
! So user doesn't have to retype the obvious. *
!***********************************************************************
LOAD'PREVIOUS:
if previous'flag = 1 RETURN
previous'flag=1
LOOKUP string(1), answer
if answer<1 then RETURN
OPEN #99, string(1), input
!***********************************************************************
! LOADP'LOOP- Check input line for d/SOFT update lines, and current *
! AMUS label header. *
!***********************************************************************
LOADP'LOOP:
input line #99, ini'string
if EOF(99) then goto CLOSE'FILE
if ini'string[1,3]=comment'char+"*"+comment'char &
then goto LOADP'LOOP
c = instr(1,ini'string,"AMUS Program Label")
if c = 0 then goto CLOSE'FILE
c = 0
!***********************************************************************
! LAB'LOOP- Loop through input lines and preload strings with current *
! applicable AMUS label data. *
!***********************************************************************
LAB'LOOP:
c = c + 1
if c > 10 then goto CLOSE'FILE
input line #99, ini'string
if EOF(99) then goto CLOSE'FILE
if c = 2 then string(3) = ini'string[(x(3)+1);maxsize(3)]
if c = 5 then string(10) = ini'string[(x(10)+1);maxsize(10)]
if c = 6 then string(11) = ini'string[(x(11)+1);maxsize(11)] &
: string(12) = ini'string[(x(12)+1);maxsize(12)]
if c = 7 then string(13) = ini'string[(x(13)+1);maxsize(13)]
if c = 8 then string(14) = ini'string[(x(14)+1);maxsize(14)]
if c = 9 then string(15) = ini'string[(x(15)+1);maxsize(15)]
if c = 10 then string(16) = ini'string[(x(16)+1);maxsize(16)]
goto LAB'LOOP
!***********************************************************************
! CLOSE'FILE- Close the source file. *
!***********************************************************************
CLOSE'FILE:
? tab(y(3),x(3));string(3)
for c = 10 to 16
? tab(y(c),x(c));string(c);
next c
CLOSE #99
RETURN
!***********************************************************************
! PRINT'RPT - Finished with the input, now output data to LABEL.RPT. *
! First use appropriate comment character, then output data. *
!***********************************************************************
PRINT'RPT:
row = 0
lookup "label.rpt",exists
? tab(17,15);
if exists then &
input "LABEL.RPT already exists - continue? (Y/N) -> ", dummy
if ucs(dummy[1;1]) = "N" then goto EXIT
open #1, "label.rpt", output
if file'type = "M" then comment'char = ";"
if file'type = "B" then comment'char = "!"
if file'type = "C" then comment'char = "/"
if file'type = "P" then comment'char = "%"
if file'type = "D" then comment'char = "*"
? #1,comment'char;
? #1,"*************************** AMUS Program Label ******************************";
if file'type = "C" then comment'char = "*"
for fld = 1 to num'flds
if row # pr'y(fld) then col = 0 : row = pr'y(fld) : ? #1 : ? #1,comment'char;
temp = col
col = pr'x(fld) - col - 1
? #1, space(col); : ? #1,prompt(fld); : ? #1, string(fld);
col = temp + col + len(prompt(fld)) + len(string(fld))
next fld
? #1
? #1,comment'char;
? #1,"****************************************************************************";
if file'type = "C" then ? #1,"/" else ? #1,"*"
close #1
RETURN
!***********************************************************************
! TRAP'ERROR - Let them know what the error is. *
!***********************************************************************
TRAP'ERROR:
if ERR(0) = 1 then resume EXIT
if ERR(0) = 12 then ? tab(-1,0) :&
? "Both EDIT.SBR and DIRHSH.SBR are needed to run this program." :&
? "These files are available on the AMUS Network." : END
? tab(-1,0) : ? "Basic error"; ERR(0) : END
!***********************************************************************
! EXIT - All done, clear the screen please. *
!***********************************************************************
EXIT:
? tab(-1,0)
