!*************************** 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

	XCALL DIRHSH,hash'file,hash'file,hash'array,hash'flag

	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)

END

!***********************************************************************
! DATA information for various fields                                  *
!          prompt          px  py  row   col   type   min   max   flags*
!***********************************************************************
data "Filename: "       ,  2,  5, "5  ", "12 ", "* ", "0 ", "10 ", "U R"
data "Date: "           , 60,  5, "5  ", "66 ", "* ", "0 ", " 8 ", "U R"
data "Category: "       ,  2,  6, "6  ", "12 ", "* ", "0 ", " 4 ", "U R"
data "Hash Code: "      , 25,  6, "6  ", "36 ", "* ", "0 ", "15 ", "U R"
data "Version: "        , 57,  6, "6  ", "66 ", "* ", "0 ", " 9 ", "U  "
data "Initials: "       ,  2,  7, "7  ", "12 ", "* ", "0 ", " 7 ", "U R"
data "Name: "           , 25,  7, "7  ", "31 ", "* ", "0 ", "30 ", "U  "
data "Company: "        ,  2,  8, "8  ", "11 ", "* ", "0 ", "37 ", "U  "
data "Telephone #: "    , 51,  8, "8  ", "64 ", "* ", "0 ", "10 ", "U  "
data "Related Files: "  ,  2,  9, "9  ", "17 ", "* ", "0 ", "60 ", "U  "
data "Min. Op. Sys.: "  ,  2, 10, "10 ", "17 ", "* ", "0 ", "11 ", "U  "
data "Expertise Level: ", 47, 10, "10 ", "64 ", "* ", "0 ", " 3 ", "U  "
data "Special: "        ,  2, 11, "11 ", "11 ", "* ", "0 ", "67 ", ""
data "Description: "    ,  2, 12, "12 ", "15 ", "* ", "0 ", "63 ", ""
data ""                 ,  2, 13, "13 ", " 2 ", "* ", "0 ", "76 ", ""
data ""                 ,  2, 14, "14 ", " 2 ", "* ", "0 ", "76 ", ""