!*! 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 real'code: SHORT1$ = left$(SHORT1$,CD-1) + CODES(i) & + (right$(SHORT1$,(len(SHORT1$)-(CD+1)))) i = CODE'CNT return