!*! Updated on 01-Nov-91 at 12:15 PM by Michele Tonti; edit time: 0:00:25
.......|..>................................._..................... |
;^i*^i^i*^m
(%***************************************************************%
(* *
(* AMUS SOFTWARE LIBRARY INFORMATION SHEET *
(* *
(* Software name: _TYPET.BAS_ *
(* *
(* Created by: _Donn Rodekohr_ on: _May 28, 1983_ *
(* *
(* Donated to AMUS on: _May 23, 1985_ *
(* *
(* For information contact: _Donn Rodekohr_ *
(* _Nebraska Water Resources Center_ *
(* _310 Ag. Hall, East Campus_ *
(* _University of Nebraska_ *
(* _Lincoln, Ne. 68583-0710_ *
(* *
(* Status: *
(* [X] Donated (may be distributed) *
(* [ ] For demonstration (available on the Network) *
(* [ ] For AMUS staff use only *
(* *
(* Abstract: *
(* TYPET is a pre-processing program that is designed to ease *
(* the entry of complex and precise typesetting codes. *
(* There are two phases, or modes, in which the program *
(* operates. The first mode asks the user for typesetting *
(* codes which are assigned to a simple flag (e.g., ]1). *
(* When completed, a command file is created so that the *
(* typesetting codes do not need to be re-entered. The *
(* second mode processes a list file (.LST) substituting the *
(* typesetting codes for any flags that are found. The *
(* output file is called *.SAV. The program also removes *
(* any doublespaces, and sets the text to a left margin of *
(* zero (0). *
(* *
(* The function of the command file (named CODES.CMD) is to *
(* allow the operator to process several different files *
(* that have the same typesetting format without re-entering *
(* the typesetting codes. Additional codes may be entered *
(* if desired, and the command file can be re-generated. *
(* *
(%***************************************************************%
! TYPET.BAS -- a typesetting aide for standard .LST file
! Author: Donn Rodekohr, University of Nebraska
! Date Created: 4-23-83
! Date Donated: 4-23-85
! The function of this program is to ease the entry of complex typesetting
! codes by substituting a simple flag in the text file with the code.
head:
strsiz 132
map1 READY'DATA ! The name and size of the file to be typeset
map2 FIL2,s,10
map2 CNT,F,6
map1 TYPE'SET'CODES ! user set typesetting codes
map2 SPACER ! special case of leading spaces
map3 SP'FLAG(3),f,6
map3 SP'CODE(3),s,6
map2 CODE'FLAG(64),f,6
map2 CODES(64),s,24
map1 MISC'VAR
map2 CODE'CNT,f,6 ! count of all the codes set
map2 CDFLG,s,1,"]" ! flag for advising of code to follow
map2 row,f,6
map2 col,f,6
map2 EFLAG,f,6
data 49,57,65,90,97,122 ! ascii values for digits and letters
EFLAG = 1 ! what is the error flag value?
row = 2 ! where do I start printing?
q = 1 ! how many special cases are there?
screen'one:
print tab(-1,0)
print tab(1,18);"MODE I: TYPE SETTING CODE INPUT"
input'loop:
lpcnt = lpcnt + 1
read st,sp
for i = st to sp
z = z + 1
print tab(20,0),tab(-1,10)
print "Enter the typesetting code for ]"chr(i)
input line "(limit of 24 characters): ",CODES(z)
CODES(z) = ucs(CODES(z)) ! convert to upper case
if CODES(z) <> "" call show &
else i=sp : next i : goto exit'loop
call spec'case ! call sub for special cases
CODE'FLAG(z) = i
CODE'CNT = z
next i
if lpcnt < 3 then goto input'loop
exit'loop:
call print'out
print tab(-1,0)
print tab(4,18)
print "MODE II: PROCESSING TEXT"
? : ?
input "The name of the file you wanted processed -- "FIL$
FIL1$ = FIL$ + ".LST"
lookup FIL1$,W
if W = 0 then call not'here :&
on EFLAG goto exit'loop,that'is'all
if W < 0 then call random'file :&
on EFLAG goto exit'loop,that'is'all
if W > 0 then call found'it
finished:
close #1 ! input file *.lst
close #2 ! output file *.sav
open #3 "READY.DAT",output ! store the processed file name and line count
print #3 FIL2;CNT
close #3
that'is'all:
print tab(22,0)tab(-1,10)
print "Enter command"
end
! ***********************************************************
! SUBROUTINES THAT CHECK FOR FILE EXISTANCE
not'here:
print chr(7)
print tab(20,0);tab(-1,10)
print "Sorry, but "FIL1$" is not located in your directory."
print
input "Do you wish to try another file name? (Y or N) "AN$
AN$ = ucs(AN$)
IF AN$ = "N" then EFLAG = 2
return
random'file:
print chr(7)
print tab(10,0);tab(-1,10)
print "Sorry, but "FIL1$" is a random access file and is not printable."
print
input "Do you wish to try another file name? (Y or N) "AN$
AN$ = ucs(AN$)
IF AN$ = "N" then EFLAG = 2
return
! ***********************************************************
! SUBROUTINES CALLED FROM INPUT LOOP
show:
if z > 32 goto page'two
if z < 16 then col = 1
row = row + 1
if row = 17 then row = 3
if z => 16 then col = 40
print tab(row,col)"]"chr(i)" : "
print tab(row,col+6)CODES(z)
return
page'two:
if page'flg = 0 then print tab(2,72)"PAGE 2";tab(-1,10) :&
page'flg = 1
if z < 48 then col = 1
row = row + 1
if row = 17 then row = 3
if z => 48 then col = 40
print tab(row,col)"]"chr(i)" : "CODES(z)
return
print'out:
print tab(20,0);tab(-1,10)
print "Do you want to generate a command file to save these codes"
input "and also get an explanitory print out of these codes? ",AN$
AN$ = UCS(AN$)
if AN$ = "Y" then goto proceed else return
proceed:
print tab(20,0);tab(-1,10)
input "Enter the name of the printer: ",PRNTR$
open #99,"CODES.LST",output
open #98,"CODES.CMD",output
print #98":R"
print #98"RUN TYPET"
for i = 1 to CODE'CNT
out'flag = 0
print ".";
for j = 1 to 3
if CODE'FLAG(i) = SP'FLG(j) then call print'spec'case
next j
if out'flag=1 then next i
OUT$ = CODES(i)+space(36-len(CODES(i)))
OUT2$ = "; code flag ]" + chr(CODE'FLAG(i))
OUT3$ = OUT$ + OUT2$
print #99 OUT3$
print #98 CODES(i)
next i
close #99
print ".";
close #98
print ".";
xcall spool,"CODES.LST",PRNTR$,2,1,"NORMAL"
print "Done"
return
spec'case: ! a special case of inserting leading blanks
if instr(1,CODES(z),"SP(") = 0 then goto go'back
CP = instr(4,CODES(z),")") ! look for close parenthesis
BLANKS$ = mid(CODES(z),4,(CP-4))
SP'FLG(q) = i
SP'CODE(q) = CODES(z)
q = q + 1
CODES(z) = space(BLANKS$)
go'back:
return
print'spec'case: ! how do you print these buggers out?
out'flag=1
OUT$ = SP'CODE(j)+space(36-len(SP'CODE(j)))
OUT2$ = "; code flag ]"+chr(SP'FLG(j))
OUT3$ = OUT$ + OUT2$
print #99 OUT3$
print #98 SP'CODE(j)
return
!******************************************************************
! SUBROUTINES FOR PROCESSING THE TYPESETTING CODES
found'it:
open #1,FIL1$,input
FIL2 = FIL$ + ".SAV"
open #2,FIL2,output
CNT = 0 ! line counter set to zero
print tab(12,0)
print "Number of lines processed -- "
start'reading:
input line #1,TEXT$
if eof(1) = 1 then goto home'james
CNT = CNT + 1
print tab(13,30);
print using "####",CNT;
X = 1
10 move'left: ! deletes all leading blanks
J$ = mid(TEXT$,X,1)
if asc(J$)=32 then X=X+1 :&
then goto move'left
SHORT1$ = right(TEXT$,(len(TEXT$)-(X-1)))
call check'dbl
call check'codes
print #2,SHORT1$
goto start'reading
home'james:
return
! ********************************************************
! SUBROUTINES CALLED FROM start'reading
check'dbl:
DBL$ = " "
K = instr(1,SHORT1$,DBL$)
if K = 0 then return
SHORTF$ = left$(SHORT1$,K) ! front half of line
SHORTB$ = right$(SHORT1$,(len(SHORT1$)-(K+1))) ! back half
SHORT1$ = SHORTF$ + SHORTB$
goto check'dbl ! look for more
check'codes:
CD = instr(1,SHORT1$,CDFLG) ! look for the ]
if CD = 0 then return
look'for'code:
Q$ = mid(SHORT1$,(CD+1),1) ! look to the first space after the code flag
if asc(Q$) < 48 then call next'half :&
return ! check the back side of the line
CODE = asc(Q$)
for i = 1 to CODE'CNT
if CODE = CODE'FLAG(i) then call real'code
next i
goto check'codes ! look for many flags
next'half:
SHORT2$=left$(SHORT1$,CD) ! save the front half of the line
SHORT3$ = right$(SHORT1$,(len(SHORT1$)-(CD+1)))
CD = instr(1,SHORT3$,CDFLG) ! look for code in last part
if CD = 0 then goto done'with'this'half
Q$ = mid(SHORT3$,(CD+1),1)
if asc(Q$) < 48 then goto done'with'this'half
CODE = asc(Q$)
CD = CD + len(SHORT2$) + 1 ! get proper replacement spot
for i = 1 to CODE'CNT
if CODE = CODE'FLAG(i) then call real'code
next i
done'with'this'half:
return
