Category : Word Processors
Archive   : VENTEX10.ZIP
Filename : VENTEX10.BAS

 
Output of file : VENTEX10.BAS contained in archive : VENTEX10.ZIP

'
' ***********************************************
' * *
' * V E N T E X *
' * *
' * VENTURA PLAINTEXT FILTER & FORMAT UTILITY *
' * Version 1.0: 01/31/88 *
' * *
' ***********************************************
'
' Copyright (C) 1988, by NightOwl Software, Inc.
' All Rights Reserved Worldwide.
'
' Structured BASIC
' sourcecode
' From
' NightOwl Software [ Creators of the Modem Executive communications ]
' Route 1 Box 7 [ package. Written completely in ultra-fast as- ]
' Fort Atkinson, WI [ sembly language, the Modem Executive is one of ]
' 53538 [ the fastest communications packages available, ]
' [ supporting most popular protocols, autodialing, ]
' Written by Ron Fowler [ and a full-featured script programming language,]
' Last revised: 01-31-88 [ and can be menu OR command driven. For a free ]
' [ brochure, write to the address shown, or call ]
' [ tollfree 1-800-NITEOWL; (Wisconsin:414-563-4013 ]
'
' Compiled with QuickBasic v4.0.
'
'----------------------------------------------------------------------------
'
' This program reads an input file of plain ASCII text and produces an output
' file with all multiple spaces reduced, and with opening and closing double
' quotes differentiated and converted to Ventura format codes. Left and
' right angle brackets are doubled (to prevent their interpretation by Ventura
' as format markers). This conversion also handles open quotes using paired
' single quotes (for example, ``This text is quoted''). Also, all imbedded
' control characters (except CR, LF and tab) are removed.
'
' We needed LETTRIX conversion as well; if you don't (and you probably won't
' if your text files weren't formatted for LETTRIX) strip the LETTRIX case
' clause from the FILTER$ function (it's clearly marked in comments within
' the FILTER$ code). You may want to modify the LETTRIX clause for use with
' other "backslash" formatters, such as FANCY FONT (tm) and ImagePrint (tm).
'
' Usage (from DOS command prompt):
'
' A>VENTEX []
'
' If the output filename is omitted, VENTEX will write the output file to the
' same name as the input file (the original is renamed with filetype .BAK).
' A temporary file is used during processing, so the output file won't be
' changed until all processing is complete.
'
'
'----------------------------------------------------------------------------
'
'
' Function declaration
'
declare function filter$ (ln$)
declare function strip$ (ln$, sep$)
declare function lftrim$ (ln$, sep$)
declare function rttrim$ (ln$, sep$)
declare function arg$ (ln$, argnum!, sep$)
'
' Sign On
'
print "VENTEX Plaintext Converer, Version 1.0"
'
' We start by reading the command tail, and stripping blanks
'
a$=command$
a$=strip$(a$," ")
'
' An empty command line is a request for help
'
if a$="" then
Print "Usage (from DOS command prompt):
Print
Print " A>VENTEX []"
Print
Print " is optional, and if omitted, writes"
Print "the output to the input filename, renaming the orig-"
Print "to filetype BAK."
end
end if
'
' separate command tail into one or two pairs of
'
inpnam$=arg$(arg$(a$,1," "),1,".")
inptyp$=arg$(arg$(a$,1," "),2,".")
outnam$=arg$(arg$(a$,2," "),1,".")
outtyp$=arg$(arg$(a$,2," "),2,".")
'
if outnam$+outtyp$="" then 'if no output name specified
outnam$=inpnam$ ' use .$$$
outtyp$="$$$"
end if
'
on error goto ErrorHandler 'open the file, trapping an open error
open inpnam$+"."+inptyp$ for input as #1
on error goto 0 'file is open, trap no more
'
open outnam$+"."+outtyp$ for output as #2 'open the output file
'
' Mainline: read, filter and write lines
'
while not eof(1) 'read file until end
line input #1, a$
a$=filter$(a$) 'filter each line
print a$
print #2,a$ 'send each to the output file
wend

'
' Wrap it up: close and maybe rename the files
'
close #1 'all done reading and writing
close #2
'
if outnam$+outtyp$=inpnam$+"$$$" then 'if a temporary file was made
on error goto nameok1 'Rename, leaving the backup file
kill inpnam$+"."+"BAK"
nameok1:
on error goto nameok2
name inpnam$+"."+inptyp$ as inpnam$+"."+"BAK"
name outnam$+"."+"$$$" as inpnam$+"."+inptyp$
nameok2:
endif
'
end
'
ErrorHandler:
print inpnam$+inptyp$+" not found"
end
'
'*************************
'
' FUNCTIONS
'
'*************************
'
' This is the FILTER function. It does almost all the work.
'
Function filter$ (ln$)
'
ln$=strip$(ln$," ")
if left$(ln$, 1) <> "." then
ln2$ = ""
i = 1
do while i <= len(ln$)
ch$=mid$(ln$,i,1)
select case ch$
'
case "'","`" 'open, closing format quotes
if i<=len(ln$) then 'if another character exists
if mid$(ln$,i+1,1)=ch$ then 'is it double?
i=i+2 'if so, delete both

if ch$="`" then 'open
ln2$=ln2$+"<169>"
else 'close
ln2$=ln2$+"<170>"
end if
else 'not double
ln2$=ln2$+ch$ 'just copy
i=i+1
end if
else
ln2$=ln2$+ch$ 'single at end of line, copy it
i=i+1
end if
'
case " " 'Compress multiple blanks
ch$=mid$(ln$,i+1,1) 'get char after blank
if ch$<>" " then
ln2$=ln2$ + " " 'copy the blank
if ch$=chr$(34) then 'a double quote here is an openquote
ln2$=ln2$+"<169>" 'plug in the format code
i=i+1 'ditch the double quote
end if
end if
i=i+1
'
case chr$(34) 'double quotes
if i>1 then '... past first char of line
ln2$=ln2$+"<170>" '... have to be closing quotes
else
ln2$=ln2$+"<169>" '... first char of line is open quote
end if
i=i+1
'
case "<" 'fix Ventura format identifier
ln2$ = ln2$ + "<<"
i=i+1
'
case ">"
ln2$ = ln2$ + ">>"
i=i+1
'
case "\" 'LETTRIX conversion
i=i+1 'If you don't want LETTRIX conversion
if i <= len(ln$) then '... then strip out this entire CASE
select case mid$(ln$,i,1) '... clause (the end of which is con-
case "\" '... veniently marked below
ln2$=ln2$+"\" '... at END LETTRIX
i=i+1 '
case "B" 'LETTRIX: start-bold
ln2$=ln2$+"" '
i=i+1 '
case "I" 'LETTRIX: start-italic
ln2$=ln2$+"" '
i=i+1 '
case "i","b" 'LETTRIX: end-bold, end-italic
ln2$=ln2$+"" '
i=i+1 '
case "#",chr$(34),"!","M","{","T","%","&","#" 'LETTRIX: w/args
i=i+1 'strip out the LETTRIX args
do while i<=len(ln$) and mid$(ln$,i,1)>="0" and mid$(ln$,i,1)<="9"
i=i+1 '
loop '
case else 'suppress all other \x
i=i+1 '
end select '
end if 'END LETTRIX
'
case chr$(13),chr$(10),chr$(9) 'cr, lf tab ok
ln2$=ln2$+ch$
i=i+1
'
case is < " " 'all other ctrl chars suppressed
i=i+1
'
case else 'all non-filtered chars here
ln2$=ln2$+chr$(asc(ch$) and 127)'strip hi bit
i=i+1
end select
loop
else
ln2$ = ""
end if
filter$ = ln2$
'
End Function
'
' This function strips leading and trailing delimiter
' characters (SEP$) from the argument string (LN$)
'
Function strip$(ln$,sep$)
ln$=lftrim$(ln$,sep$)
strip$=rttrim$(ln$,sep$)
End function
'
' This function strips leading delimiters (SEP$) from
' the argument string (LN$). It's a bit better than
' BASIC's LTRIM, since characters other than blanks
' can be stripped.
'
Function lftrim$(ln$,sep$)
do while left$(ln$, 1) = sep$
ln$ = mid$(ln$, 2, len(ln$) - 1)
loop
lftrim$=ln$
End Function
'
' This function strips trailing delimiters (SEP$) from
' the argument string (LN$). It's a bit better than
' BASIC's RTRIM, since characters other than blanks
' can be stripped.
'
Function rttrim$(ln$,sep$)
do while right$(ln$, 1) = sep$
ln$ = mid$(ln$, 1, len(ln$) - 1)
loop
rttrim$=ln$
End Function
'
' This function is used for parsing; it cuts the passed LN$ into
' arguments delimited by SEP$, and returns the ARGNUMth piece.
' This function calls itself recursively. Note that if the delimiter
' is a space, then multiple consecutive spaces are treated as a
' single space. Delimiters other than space will return a null
' argument between two consecutive delimiters.
'
Function arg$(ln$,argnum,sep$)
mark=instr(ln$,sep$)
if mark=0 then
if argnum=1 then
arg$=ln$
else
arg$=""
end if
else
if argnum>1 then
if sep$=" " then 'if space-delimited, multiple-delimiters=1 delimiter
arg$=arg$(lftrim$(mid$(ln$,mark+1,len(ln$)-mark),sep$),argnum-1,sep$)
else 'all other delimiters: 2 delimiters enclose null args
arg$=arg$(mid$(ln$,mark+1,len(ln$)-mark),argnum-1,sep$)
end if
else
arg$=mid$(ln$,1,mark-1)
end if
end if
End Function
'
' End Program
'