home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: Graphics
/
Graphics.zip
/
gif_text.zip
/
mkgiftxt.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1999-05-05
|
21KB
|
696 lines
/* 05 May 1999:
A front end to the GIF_TEXT addon -- this will take a request generated
by MKGIFTXT.HTM, and return a link to GIF_TEXT.
Note that this will work either as a cgi-bin script (for a generic, os/2
cgi-bin-compatabile server,or as an addon for the SRE-http
web server (http://www.srehttp.org). It will detect how it's being called,
and respond accordingly.
Note that when used as cgi-bin, many servers have "request options"
limit of 256 characters (that is, it will only recognize the first 256
characters after the ?). Since MKGIFTXT uses an IMG= link to display results,
which is always interpreted as a GET request, this limitation is likely to
arise when you've selected a lot of options in mkgiftxt.htm. This is a problem,
but there is no obvious work-around other then NOT specifying unneeded
options (which means mkgiftxt.htm should be edited, with unnecessary
options removed).
There are a few user changable parameters: see below for descriptions.
*/
/* ---------------- Begin User Changeable Parameters ------------*/
/* "Styles" directory. Should be a fully qualified directory (typically, you
should use the GIF_DIR_ROOT directory you specified in GIF_TEXT.CMD
Set to '' if you don't want to support these styles */
STYLES_DIR='\goserve\alphabyt'
/* The "base directory" of the alphabytes.
This is only needed if you use the SAVEIT option (to enable
downloads); and if you want to use the "list fonts, backgrounds,
and color slides" option */
GIF_DIR_ROOT='\goserve\alphabyt'
/* The "ttf fonts" root directory. Used if you want to use the
"list ttf fonts" option */
TTF_DIR_ROOT='\ttf'
/* Maximum number of "temporary" files (to allow downloading)
These will have names of MKGIF???.GIF, in the GIF_DIR_ROOT
directory. Only used if SAVEIT option specified.
If 0, then no "saving of temporary files" is permitted */
max_tempfiles=50
/* ---------------- End User Changable Parameters ------------*/
parse arg ddir, tempfile, reqstrg,list,verb ,uri,user, ,
basedir ,workdir,privset,enmadd,transaction,verbose, ,
servername,host_nickname,homedir
signal on syntax name err1
signal on error name err1
verboseout=1 /* verbose response */
styles_dir=strip(styles_dir,'t','\')
gif_dir_root=strip(gif_dir_root,'t','\')
ttf_dir_root=strip(ttf_dir_root,'t','\')
/* check for CGI-BIN call */
is_cgi=0
if verb="" then do /* is it cgi-bin? */
verb = value("REQUEST_METHOD",,'os2environment')
if verb="" then do
say " Sorry, this is a web server utility. "
exit
end /* do */
is_cgi=1
if verb="GET" then do
list=value("QUERY_STRING",,'os2environment')
end
else do
len=value('CONTENT_LENGTH',,'os2environment')
list=charin(,,len)
end
ref='mkgiftxt.htm'
end
else do
if verb='GET' then parse var uri . '?' list
ref=reqfield('referer')
end
/* look for list= option */
if abbrev(translate(strip(list)),'LIST=')=1 then do /* list some files, etc */
call makelist
if result=2 then return '200 ok' /* a gif file was displayed? */
signal alldone /* alldone will appropriately write the foo1 variable */
end
/* look for "style" option, and use/save the appropriate "style" (if available) */
l0=list
lnew=''
newtext=''; styfile='' ;is_style=0
saveit=0
do until l0=''
parse var l0 a1 '&' l0
parse var a1 a1a '=' a1b ; a1a=translate(a1a)
select
when a1a="MESSAGE" | a1a="TEXT" then do
newtext=a1b
end
when a1a='STYLE' then do
if styles_dir='' | styles_dir=0 then iterate /* suppress styles */
if a1b<>'' & a1b<>0 then do
styfile=a1b
if pos('.',a1b)=0 & a1b<>'' & a1b<>0 then styfile=styfile'.STY'
styfile=strip(translate(styfile,'\','/'),'l','\')
is_style=1
end
end /* do */
when a1a='SAVE_STYLE' | a1a='STYLE_SAVE' then do /* otherwise, interpret as "use style" */
if styles_dir='' | styles_dir=0 then iterate /* suppress styles */
if a1b=1 then is_style=2
end /* do */
when a1a='SAVEIT' & MAX_TEMPFILES>0 then do
if a1b=1 then saveit=1
end /* do */
when abbrev(a1a,'VERBOSE')=1 then verboseout=a1b
otherwise do
if lnew='' then
lnew=a1
else
lnew=lnew||'&'||a1
end
end
end /* do */
/* Read results from style file? */
if is_style>0 then do
if styfile='' | styfile=0 then styfile='DEFAULT.STY'
oof=styles_dir'\'styfile
if is_style=2 then do /* save list, minus text, in a style file */
foo=stream(oof,'c','open write')
if abbrev(translate(foo),'READY')=1 then do /* writeable ... */
l2=charout(oof,lnew,1)
foo=stream(oof,'c','close')
end
else do
styfile='Unable to write to 'styfile
end /* do */
end /* do */
else do /* read from style file */
goo=stream(oof,'c','query exists')
if goo<>'' then do
foo=stream(oof,'c','open read')
l2=charin(oof,1,chars(oof))
foo=stream(oof,'c','close')
list='TEXT='||newtext||'&'l2
end
else
styfile='Unable to read from ' styfile
end
end /* do */
/* save results to file (for downloading?). If so. specify
a CACHE=GTMP???.gif option, but first SEE if > max_tempfiles
(if so, delete oldest ones). */
if saveit=1 then do
fdo=sysfiletree(gif_dir_root'\GTMP*.GIF',foos,'FT')
if foos.0>max_tempfiles then do /* delete several of them */
garg=min(5,1+(max_tempfiles/3))
do io=1 to garg
call deleteold
end /* do */
call pmprintf(' MK_GifTxt: Deleted 'garg 'old temporary files ')
end
tt=gif_dir_root'\GTMP???.GIF'
foo=rxfuncquery('rexxlibregister')
if foo<>0 then /* rexx lib is not loaded */
newf=systempfilename(tt)
else
newf=dostempname(tt)
cname=filespec('n',newf)
list=list'&CACHE2='cname
end
list=list||'&MESSAGE.GIF'
crlf='0d0a'x
errm1=""
uj=length(list)
if is_cgi=0 then do
img0='<IMG src="/GIF_TEXT?'||list||'">'
end
else do
if uj > 245 then do /* long request; drop null = options */
olist=""
do until list=""
parse var list av '&' list
parse var av v1 '=' v2
if v2<>'' then olist=olist||av||'&'
end
olist=strip(olist,'t','&')
if verboseout=1 then
errm1="<p><B>Caution:</b> A long request was shortened by removing empty-valued options. In some cases this will effect the final results.<p>"
list=olist
end /* do */
if length(list)>245 then do
errm1="<p><B>Warning:</b> This server may not be able to handle this long ("||length(list)" characters) CGI-BIN IMG request </b><p> "
end
img0='<IMG src="/cgi-bin/GIF_TEXT?'||list||'">'
end /* is cgi */
iv=translate(img0)
/*parse var iv . 'SLIDE=' goon '&' . */
goon=pos('SLIDE=',iv)+pos('SLIDE_',iv)
if goon>0 & verboseout=1 then
extramess='<b>Note...</b> creating images that use <em>color slides</eM> may require a few minutes '
else
extramess=""
img=img0
fimg2="" ; tmp=""
do until img=""
parse var img a1 '&' img
if tmp="" then
tmp=a1
else
tmp=tmp'&'a1
if length(tmp)>80 then do
if img<>"" then tmp=tmp'&'
fimg2=fimg2'<br>'||fixit(tmp)
tmp=""
end
end /* do */
if tmp<>"" then fimg2=fimg2'<br>'||fixit(tmp)
fimg=fimg2
retmess=' Return to <a href="'ref'">GIF_Text input form </a> <p>'
foo1='<HTML><head><TITLE>Generating A Graphical Message</title></head>'crlf
foo1=foo1||'<body>'
if verboseout=1 then do
foo1=foo1||'<h2>Generating a graphical message </h2> ' crlf||extramess||'<p>'
foo1=foo1||' This image is generated from:<br><code>'||fimg||'<p>'crlf
end
foo1=foo1||'<br><center>'||img0||'</center>'||errm1'</center><br><hr>'
foo1=foo1'<ul><li>'retmess||crlf
if is_style=1 & verboseout=1 then do
foo1=foo1||'<li> Note: <b>using</b> specifications stored in style file: 'styfile
end /* do */
if is_style=2 & verboseout=1 then do
foo1=foo1||'<li> Note: <b>storing</b> specifications in style file: 'styfile
end /* do */
/* add a "gif_text cache" element */
if saveit=1 then do
foo1=foo1||crlf||'<br><br><li><p><em>To download a file containing this image ... </em><ol>'crlf
foo1=foo1||' <li>Wait till the image is <b>completely</b> drawn 'crlf
if is_cgi=0 then
foo1=foo1||'<li> <a href="/gif_text?cache2='cname'"> download the image file </a> ('cname') 'crlf
else
foo1=foo1||'<li> <a href="/cgi-bin/gif_text?cache2='cname'"> download the .GIF file </a> 'crlf
foo1=foo1||'</ol>'crlf
end /* do */
alldone: nop
foo1=foo1||'</ul><hr></body></html>'
if is_cgi=1 then do
Say "Content-type: text/html"
Say
call charout,foo1
return
end
foo=value('SREF_PREFIX',,'os2environment')
if foo='' then do
exp=value(enmadd||'FIX_EXPIRE',,'os2environment')
if exp>0 then a=sref_expire_response(0.1,length(foo1),'text/html')
'var type text/html name foo1 '
return '200 ok'
end
else do
foo=sref_gos('VAR type text/html name foo1',foo1)
return foo
end /* do */
/* ------------------------------*/
fixit:procedure
parse arg adesc
adesc=a_replacestrg(adesc,'&','&','ALL')
adesc=a_replacestrg(adesc,'<','<','ALL')
adesc=a_replacestrg(adesc,'>','>','ALL')
adesc=a_replacestrg(adesc,'"','"','ALL')
return adesc
/* ------------------------------*/
a_replacestrg:
exactmatch=0
backward=0 ; doall=0
parse arg astring , target , putme , type , exactmatch
type = translate(type)
if type="BACKWARD" then backward="YES"
if type="ALL" then doall="YES"
iat=1
joelen=length(target)
joelen2=length(putme)
doagain: /* here if doall=yes */
if exactmatch="YES" then do
if backward="YES" then
joe= lastpos(target,astring)
else
joe= pos(target,astring,iat)
end
else do
if backward="YES" then
joe= lastpos(translate(target),translate(astring))
else
joe= pos(translate(target),translate(astring),iat)
end
if joe=0 then
return astring
astring=delstr(astring,joe,joelen)
if putme<>' ' then
astring=insert(putme,astring,joe-1)
if doall="YES" then do
iat=joe+joelen2
signal doagain
end
/* else, all done */
return astring
/* ------------------- */
deleteold: /* real primitive search */
oldest='999999999999999' ; oldid=0
do ijo=1 to foos.0
parse var foos.ijo adate .
if adate<oldest then do
oldest=adate ; oldid=ijo
end /* do */
end /* io loop */
parse var foos.oldid . . . afile
idid=sysfiledelete(strip(afile))
foos.oldid='99999999999999999999'
return 0
/************************/
/* make a listing */
makelist:
crlf='0d0a'x
parse upper var list . '=' todo ';' filename
select
when todo='FONTS' then do
foo1='<HTML><head><TITLE>GIF_text: available fonts</title></head>'crlf
foo1=foo1||'<body>'
foo1=foo1||'<h2>Alphabyte & complete fonts available to GIF_text</h2>'crlf
aa=gif_dir_root'\*.IND'
foo=sysfiletree(aa,'gots','FOS')
foo1=foo1||'# of alphabyte and complete fonts available: 'gots.0||crlf
foo1=foo1||'<table cellpadding=2><tr>'
i1=0
LG=length(gif_dir_root)+2
do mm=1 to gots.0
aa=gots.mm
aasay=substr(aa,LG)
iaa=lastpos('\',aasay)
aasay=substr(aasay,iaa+1)
parse var aasay aasay '.' . /* the font name */
/* choose a sample of this font */
parse var aa aa2 '.' .
aa2=aa||'.gif' /* first, check for complete font */
aagif=''
if stream(aa2,'c','query exists')<>'' then aagif=aa2
if aagif='' then do /* no complete, look for A.GIF */
iaa=lastpos('\',aa)
aa2=left(aa,iaa)||'A.GIF'
if stream(aa2,'c','query exists')<>'' then aagif=aa2
end /* do */
if aagif='' then do /* no A.GIF, look for name-a.gif */
aa2=left(aa,iaa)||aasay||'-A.GIF'
if stream(aa2,'c','query exists')<>'' then aagif=aa2
end /* do */
if aagif='' then do /* find any gif in this directorty */
aagif=left(aa,iaa)'*.gif'
oof=sysfiletree(aagif,'aagifs','FO')
if aagifs.0>0 then do
if aagifs.0>3 then
aagif=aagifs.3
else
aagif=aagifs.1
end
end
if aagif<>'' then do /* write a "link" to table */
aagif2=substr(aagif,lg)
aasay='<a href="/MKGIFTXT?LIST=DISP_FONT;'aagif2'">'aasay'</a>'
end
i1=i1+1
foo1=foo1||'<td><code>'||aasay||'</code></td>'||crlf
if i1=6 then do
i1=0
foo1=foo1||'</tr><tr>'||crlf
end /* do */
end
foo1=foo1||'</table></body></html>'
return 1
end
when todo='TTFFONTS' | todo='TTFFONTS_ALL' then do
foo1='<HTML><head><TITLE>GIF_text: available TTF fonts</title></head>'crlf
foo1=foo1||'<body>'
foo1=foo1||'<h2>TTF fonts available to GIF_text</h2>'crlf
aa=ttf_dir_root'\*.TTF'
foo=sysfiletree(aa,'gots','FOS')
foo1=foo1||'# of TTF fonts available: 'gots.0||crlf
foo1=foo1||'<table cellpadding=2><tr>'
i1=0
LG=length(ttf_dir_root)+2
allem='<a href="/mkgiftxt?LIST=DISP_TTFFONT'
allem2='">Sample of all the above</a>'
do mm=1 to gots.0
aa=gots.mm
aa=substr(aa,LG)
parse var aa aa '.' .
allem=allem||';'||aa
aa='<a href="/mkgiftxt?LIST=DISP_TTFFONT;'aa'">'aa'</a>'
foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
i1=i1+1
if i1=6 then do
i1=0
foo1=foo1||'</tr><tr>'||crlf
end
end /* do */
if todo='TTFFONTS_ALL' then do
foo1=foo1||'<tr><td colspan=2>'||allem||allem2'</td>'
end
if filename<>'' then do
foo1=foo1||'<tr><td colspan=2><a href="'filename'">View samples</a></td>'
end /* do */
foo1=foo1||'</table></body></html>'
return 1
end
when todo='SLIDES' then do
foo1='<HTML><head><TITLE>GIF_text: available color slides</title></head>'crlf
foo1=foo1||'<body>'
foo1=foo1||'<h2>Color slides available to GIF_text</h2>'crlf
aa=gif_dir_root'\slides\*.gif'
foo=sysfiletree(aa,'gots','FOS')
foo1=foo1||'# of color slides: 'gots.0||crlf
foo1=foo1||'<TABLE CELLPADDING=2>'
LG=LENGTH(GIF_DIR_ROOT)+1
I1=0
do mm=1 to gots.0
aa=gots.mm
aa=substr(aa,lG)
parse var aa aa '.' .
aa='<a href="/mkgiftxt?list=DISP_SLIDE;'aa'">'aa'</a>'
i1=i1+1
foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
if i1=3 then do
i1=0
foo1=foo1||'</tr><tr>'||crlf
end
end
foo1=foo1||'</TABLE></body></html>'
return 1
end
when todo='BACKGROUNDS' then do
foo1='<HTML><head><TITLE>GIF_text: available backgrounds</title></head>'crlf
foo1=foo1||'<body>'
foo1=foo1||'<h2>Backgrounds available to GIF_text</h2>'crlf
aa=gif_dir_root'\backs\*.gif'
foo=sysfiletree(aa,'gots','FOS')
foo1=foo1||'# of backgrounds: 'gots.0||crlf
foo1=foo1||'<table cellpadding=2><tr>'
i1=0
LG=LENGTH(GIF_DIR_ROOT)+1
do mm=1 to gots.0
aa=gots.mm
aa=substr(aa,lG)
parse var aa aa '.' .
aa='<a href="/mkgiftxt?list=DISP_BACKGROUND;'aa'">'aa'</a>'
i1=i1+1
foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
if i1=3 then do
i1=0
foo1=foo1||'</tr><tr>'||crlf
end
end /* do */
foo1=foo1||'</TABLE></body></html>'
return 1
end
when todo='DISP_BACKGROUND' then do
if is_cgi=1 then do
foo1='<html><head><title>Sorry </title></head><body>DISP_BACKGROUND not suported under CGI </body></html>'
return 1
end /* do */
filename=strip(filename)
aa=TRANSLATE(gif_dir_root||filename||'.gif','\','/')
foo=sref_gos('FILE type image/gif name 'aa)
return 2
end
when todo='DISP_SLIDE' then do
if is_cgi=1 then do
foo1='<html><head><title>Sorry </title></head><body>DISP_SLIDE not suported under CGI </body></html>'
return 1
end /* do */
filename=strip(filename)
aa=TRANSLATE(gif_dir_root||filename||'.gif','\','/')
foo=sref_gos('FILE type image/gif name 'aa)
return 2
end
when todo='DISP_FONT' then do
if is_cgi=1 then do
foo1='<html><head><title>Sorry </title></head><body>DISP_FONT not suported under CGI </body></html>'
return 1
end /* do */
filename=strip(filename)
aa=TRANSLATE(gif_dir_root||'\'filename,'\','/')
foo=sref_gos('FILE type image/gif name 'aa)
return 2
end
when todo='DISP_TTFFONT' then do
if is_cgi=1 then do
foo1='<html><head><title>Sorry </title></head><body>DISP_TTFONT not suported under CGI </body></html>'
return 1
end /* do */
foo=rxfuncquery('rxttf_image')
if foo=1 then
call RxFuncAdd 'rxttf_image', 'RXTTF', 'rxttf_image'
foo=rxfuncquery('rxttf_image')
if foo=1 then DO
sTRING "Warning: RXTTF_IMAGE not available "
EXIT
END
aa='' ;nfs=0
do until filename=''
parse var filename aname ';' filename
aname=strip(aname)
aa=aa||TRANSLATE(ttf_dir_root||'\'aname,'\','/')||'.ttf'||' '
nfs=nfs+1
end
ttsize=16
if nfs=1 then ttsize=28
AA=CREATE_TTF_GIF(' AaBbCdDdEe1234!?$',aa,ttsize,tempfile)
foo=sref_gos('FILE erase type image/gif name 'aa)
return 2
end
otherwise do /* should not happen */
'string Bad option to MKGIFTXT: 'list
exit
end
end /* select */
return
create_ttf_gif:procedure expose red_text green_text blue_text ,
red_back green_back blue_back
parse arg message,ttffonts,psize,OUTFILE
foo=rxfuncquery('rxgdloadfuncs')
if foo=1 then do
Call RxFuncAdd 'RxgdLoadFuncs', 'RXGDUTIL', 'RxgdLoadFuncs'
Call RxgdLoadFuncs
end
foo=rxfuncquery('rxgdloadfuncs')
if foo=1 then do
if verb="" then do
STRING "Sorry: RXGDUTIL.DLL is not available! Did you copy it to your LIBPATH? "
return ' '
end /* do */
say 'Sorry: RXGDUTIL.DLL is not available! Did you copy it to your LIBPATH? '
exit
end /* do */
/* compute size of image */
totrows=0 ; totcols=0
do mm=1 to words(ttffonts)
ttffont=strip(word(ttffonts,mm))
ttfname=filespec('n',ttffont)
parse var ttfname ttfname '.' .
rc = rxttf_image(ttfname': 'message,ttffont,psize, data)
if rc<>0 then do
say "Error in rxttf_image ("ttffont"): "rc
exit
end
totROWS=data.!rows+totrows
totcols=max(totcols,data.!cols)
end
totrows=totrows+(2*words(ttffonts))
totcols=totcols+1
im=rxgdimagecreate(totCOLS,totROWS) /* initialize image */
ir0=1
do mm=1 to words(ttffonts)
ttffont=strip(word(ttffonts,mm))
ttfname=filespec('n',ttffont)
parse var ttfname ttfname '.' .
rc = rxttf_image(ttfname': 'message,ttffont,psize, data)
/* Check for an error */
if rc<>0 then do
say "Error in rxttf_image ("ttffont"): "rc
exit
end /* do */
/* create the gif */
MCOLS=data.!cols ; MROWS=data.!rows
transparent=0
call rxgdimagecolortransparent im,transparent
oy=rxgdimagecolorallocate(im,red_back,green_back,blue_back)
text_color=rxgdimagecolorallocate(im,red_text,green_text,blue_text)
do ir=0 to data.!rows-1
aline=translate(data.ir,'01','0001'x)
do ic=1 to MCOLS
pxels.ic=substr(aline,ic,1)
end /* do */
styled = RxgdImageSetStyle(im, pxels, data.!cols) /* write transformed row back to */
ir0=ir0+1
rc = RxgdImageLine(im, 0,ir0,MCOLS-1,ir0,styled) /* the message image */
end /* do */
ir0=ir0+2
end
/* save image to file */
foo=rxgdimagegif(im,outfile)
Call RxgdImageDestroy im
RETURN OUTFILE
/*********************/
/* here on error */
err1:
say " error in mkgiftxt at " sigl '( ' rc