home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / gif_text.zip / gif_text.cmd < prev    next >
OS/2 REXX Batch file  |  1999-07-15  |  101KB  |  3,126 lines
  1. /* 23 June 1999.   SRE-http utility and generic CGI-BIN script:
  2. GIF_TEXT 1.3b: create a gif file containing a message, using an
  3.           "alphabyte" collection of character files, a "complete"
  4.           font in single image file, or a ttf font.
  5.  
  6. This program will work as a:
  7.  1)"native" SRE-http add-on,
  8.  2) as a generic CGI-BIN script
  9.  3) a stand/alone program
  10. ...it will automatically detect how it's being called.
  11.  
  12. NOTE: You MUST set the GIF_DIR_ROOT parameter below (other parameters are
  13.       optional).
  14.  
  15. ************************************************************************/
  16.  
  17. signal on error name wow1 ; signal on syntax name wow1 ;
  18.  
  19.  
  20. /******************************************************
  21.   ***********BEGIN USER CHANGABLE PARAMETERS ******************************
  22.   ***********BEGIN USER CHANGABLE PARAMETERS ******************************
  23.   ***********BEGIN USER CHANGABLE PARAMETERS ******************************/
  24.  
  25. /*-                   --------------------
  26.                     User changeable parameters
  27.  
  28. The user changeable parameters are:
  29.  
  30. GIF_DIR_ROOT : The "root" directory of the "alphabytes".
  31.  
  32.          !!!!  YOU MUST SET GIF_DIR_ROOT WHEN YOU INSTALL GIF_TEXT  !!!!!
  33.                 All the other parameters can be left unchanged with
  34.                 minimal deteriment, but GIF_TEXT will not work
  35.                 if GIF_DIR_ROOT is not properly set.
  36.  
  37. SEND_PIECES: Try to send early versions of the image, as they become available
  38. DEFAULT_FONT : The default "alphabyte font" (actually, it's directory)
  39. FIGDIST_TYPE : Method for computing "distances"
  40. FONT_NAME : Name (prefix) used to match characters to .GIF files
  41. FONT_INDEX : Index file with "alphabyte specific" configuration information
  42. CACHE_SIZE : The maximum number of images to "cache"
  43. CACHE_DURATION : Maximum duration of cached images
  44. HEIGHT : Default height of the created image
  45. WIDTH : Default width of the created image
  46. LINE_SEP: Seperation between lines of multi-line message (in pixels)
  47. X_FRAME: Width of frame, in pixels (left and right)
  48. X_OFFSET : "shadow" offset in x direction 
  49. Y_FRAME: Height of frame, in pixels (top and bottom)
  50. y_offset : "shadow" offset in y direction
  51. TIME_FMT : Default format to use when display current time
  52. DATE_FMT : Default format to use when displaying current date
  53. DEF_BACKCOLOR= Default backcolor
  54. DEF_TEXTCOLOR= Default textcolor (used when no character .GIF file is available)
  55. DEF_TRANSPARENT = Default transparent color index
  56. DEF_TEXTSIZE = Default size of default text characters
  57.  
  58. *  You MUST set the GIF_DIR_ROOT parameter
  59. *  The SEND_PIECES parameter is useful if you are using SRE-http, and 
  60.     large/complicated images are likely
  61.     to be created (which may require the client to wait a minute or more). 
  62. *  You should, but do not need to, set the TIME_FMT, DATE_FMT, and FONT_DIR
  63.    parameters.
  64. *  You should probably set HEIGHT=0 and WIDTH=0.
  65. *  You should probably set FONT_NAME=' ' and FONT_INDEX=' '
  66. *  The DEF_BACKCOLOR, and DEF_TEXTCOLOR are usually
  67.    overridden by "alphabyte" specific values,so you probably
  68.    don't need to worry about them.
  69. *  The DEF_TEXTSIZE is  rarely used (only if there are NO matching characters)!
  70. *  The DEF_TRANSPARENT should almost always equal 0
  71.  
  72. *  CACHE_SIZE=100 and CACHE_DURATION=1 are reasonable values; but if you
  73.    want to avoid clutter, set CACHE_SIZE=0 (in which case, the 
  74.    CACHE option is ignored)
  75.                                -----------------
  76. */
  77.  
  78. /*  !!!! You MUST set the GIF_DIR_ROOT parameter !!!! */
  79. /* The "base directory" of the alphabytes (the collection of character gifs) */
  80. /* if no drive is specified, the default drive (i.e.; the goserve working
  81. directory) will be used */
  82.  
  83. GIF_DIR_ROOT='\goserve\alphabyt'
  84.  
  85. /* The root directory for TTF fonts */
  86.  
  87. TTF_DIR_ROOT='\ttf'
  88.  
  89.  
  90. /* Attempt to send "pieces" (actually, less detailed versions) of the image as it becomes
  91.    available (only works with browsers that recognize connection:keep-alive). 
  92.    1=yes, 0=no
  93.    Send_pieces will ONLY work if GIF_TEXT is called as an SRE-http addon*/
  94. send_pieces=0
  95.  
  96.  
  97. /* Default font directory (relative to gif_dir_root) */
  98. DEFAULT_FONT='enviro'
  99.  
  100. /* default font name.If ' ', use "font_dir own name". This should NOT
  101.    include directory information */
  102. font_name=' '
  103.  
  104. /* default "index file" (in font_dir) -- contains alphabyte specific
  105.    configuration information. If ' ', usein font_name.ind.
  106.    This should NOT contain subdirectory information. */
  107. font_index=' '
  108.  
  109. img_prog='NETSCAPE -l en '  /* program string for displaying images */
  110.  
  111.  
  112. /* the maximum number of images to cache. 0 means "disable caching of images"*/
  113. cache_size=100
  114.  
  115. /* the maximum lifespan of an image cache file. 0 means "disable caching".
  116.    (measured in days, no fractions allowed). */
  117. cache_duration=1
  118.  
  119. /* default height in pixels (0= as big as needed) */
  120. height=0
  121. /* default width in pixels (0=as big as needed) */
  122. width=0
  123.  
  124. /* default line seperation, in pixels (for multi line messages */
  125. line_sep=2 
  126.  
  127. /* default size of frame, left and right */
  128. x_frame=0 ; X_OFFSET=0
  129.  
  130. /* default size of frame, top and bottom */
  131. y_frame=0 ; y_offset=0
  132.  
  133. /* time format (using REXX TIME('x') syntax); eg; N= 15:32:01*/
  134. time_fmt='N'
  135. /*date format (using REXX DATE('x') syntax ); eg; N=16 Jun 1997 */
  136. date_fmt='N'
  137.  
  138. /* Set the default RGB intensities for the background (color table #0)
  139.    Use a 6-hex-character (00 to ff); with 000000=black and ffffff=white.
  140.    This may be overridden by the font-index file, or by an option  */
  141. def_backcolor=b0b0b0
  142.  
  143.  
  144. /* set values to use for characters when a .gif file can not be found 
  145.    This may be overridden by the font-index file, or by an option */
  146. def_textcolor=333333
  147.  
  148. /* size of text, in pixel, if NO gifs found */
  149. def_text_size =15
  150.  
  151. /* set the "transparent color index" -- use a value between 0 and 255.
  152.   If you do NOT want a transparent color index, use -1. */
  153. def_transparent=0
  154.  
  155. /* verbose level (only used if called as cgi-bin script:
  156.   0=none, 1=minimal, 2=more
  157.  If called as SRE-http addon, then SRE-http's VERBOSE variable is used */
  158. def_verbose=2
  159.  
  160.  
  161. /* method for computing "distances"
  162.    1=euclidean, 2=grid steps, 3=modified grid steps, 4=longest axis */
  163. figdist_type=3
  164.  
  165. /* background scaling: 1 for yes, 0 for use tiles */
  166. back_scale=0
  167.  
  168. /* mask file scaling : 1 for yes, 0 for use tiles */
  169. mask_scale=0 
  170.  
  171.  
  172. /* reverse mask: 0=no (0 pixel are invisible), 1=yes (>0 pixels are invisible) */
  173. mask_reverse=0
  174.  
  175. /* maximum size of "URLS" to get as backgrounds (in bytes) */
  176. max_urlsize=100000
  177.  
  178. /********** END of USER CHANGABLE PARAMETERS *********/
  179. /********** END of USER CHANGABLE PARAMETERS *********/
  180. /********** END of USER CHANGABLE PARAMETERS *********/
  181.  
  182.  
  183. foo=rxfuncquery('rxgdloadfuncs')
  184. if foo=1 then do
  185.   Call RxFuncAdd 'RxgdLoadFuncs', 'RXGDUTIL', 'RxgdLoadFuncs'
  186.   Call RxgdLoadFuncs
  187. end
  188. foo=rxfuncquery('rxgdloadfuncs')
  189. if foo=1 then do
  190.    if verb="" then do
  191.         STRING "Sorry: RXGDUTIL.DLL is not available! Did you copy it to your LIBPATH? "
  192.         return ' '
  193.    end /* do */
  194.    say 'Sorry: RXGDUTIL.DLL is not available! Did you copy it to your LIBPATH? '
  195.    exit
  196. end /* do */
  197.  
  198. /* Load up advanced REXX functions */
  199. foo=rxfuncquery('sysloadfuncs')
  200. if foo=1 then do
  201.   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  202.   call SysLoadFuncs
  203. end
  204.  
  205. /* load rexx_ttf */
  206. foo=rxfuncquery('rxttf_image')
  207. if foo=1 then 
  208.   call RxFuncAdd 'rxttf_image', 'RXTTF', 'rxttf_image'
  209. foo=rxfuncquery('rxttf_image')
  210. if foo=1 then say "Warning: RXTTF_IMAGE not available "
  211.  
  212. if datatype(CACHE_SIZE)<>'NUM'  then cache_size=0
  213. if datatype(CACHE_DURATION)<>'NUM'  then cache_size=0
  214. if datatype(DEF_VERBOSE)<>'NUM'  then def_verbose=1
  215. if datatype(back_scale)<>'NUM'  then back_scale=0
  216.  
  217. if cache_size<1  then cache_size=0
  218. if cache_duration<1 then cache_size=0
  219.  
  220. sqs.!got=rxfuncquery('SQRT')  /* is there a sqrt function available */
  221.  
  222. send_delay=12           /* time to wait before SENDing a piece */
  223.  
  224. if filespec('D',gif_dir_root)=' ' then do
  225.      oof=directory()
  226.      arf=filespec('d',oof)
  227.      gif_dir_root=arf||gif_dir_root
  228. end  /* Do */
  229. if gif_dir_root=' ' then
  230.     gif_dir_root=strip(basedir,'t','\')||'\alphabyt'
  231.  
  232. gif_dir_root=strip(gif_dir_root,'t','\')||'\'
  233.  
  234.  
  235. ttf_dir_root=strip(ttf_dir_root,'t','\')||'\'
  236.  
  237. parse arg  ddir, tempfile, reqstrg,list,verb ,uri,user, ,
  238.           basedir ,workdir,privset,enmadd,transaction,verbose, ,
  239.          servername,host_nickname,homedir
  240.  
  241.  
  242. a_box=d2c(3)
  243. cprotocol='1.0'
  244. if verbose="" then verbose=def_verbose
  245.  
  246. nttfs=0
  247.  
  248. /* check for CGI-BIN call */
  249. is_cgi=0
  250. fake_cgi=0
  251. outputfile=""
  252. if verb="" then do    /* is it cgi-bin? */
  253.    method = value("REQUEST_METHOD",,'os2environment')  
  254.    if method="" then do
  255.        parse arg list
  256.        if list="" then do
  257.           list=ask_values()
  258.           is_cgi=2         /* signals "stand alone */
  259.           verbose=2
  260.        end
  261.        else do
  262.           list=translate(list,"&"," ")
  263.           is_cgi=1 ; fake_cgi=1
  264.           parse value list with "&as="outputfile 
  265.           parse var outputfile outputfile '&' .
  266.           foo=stream(outputfile,'c','query exists')
  267.           if foo<>'' then do
  268.               say "ERROR: "foo "exists (overwrite not permitted)."
  269.               exit
  270.           end /* do */
  271.        end;
  272.        if list="" then exit
  273.    end /* do */
  274.    else do
  275.       is_cgi=1
  276.       if method='GET' then do
  277.           list=value("QUERY_STRING",,'os2environment')
  278.       end
  279.       else do
  280.          tlen = value("CONTENT_LENGTH",,'os2environment')
  281.          list=charin(,,tlen)
  282.       end /* do */
  283.       verbose=def_verbose
  284.    end
  285. end
  286.  
  287. if is_cgi=0 then do             /* called as sre addon */
  288.   if  verb="GET" then do
  289.       parse var uri . '?' list   /* if srefilter addon, get purer version of request string */
  290.   end    
  291.   cp=extract('clientprotocol')
  292.   parse var cp . '/' cprotocol
  293. end
  294.  
  295. aa=sysfiletree(gif_dir_root||'*.*','arf','b')
  296. if arf.0=0 then do
  297.    call gpmprintf(" GIF_TEXT: GIF_DIR_ROOT is empty or missing: "gif_dir_root)
  298.    if is_cgi=1 then
  299.         return
  300.    return 0
  301. end /* do */
  302.  
  303.  
  304. /*  request options understood:
  305.    FONT_DIR, SEND, FONT_NAME, FONT_INDEX, TIME_FMT, DATE_FMT, BACKCOLOR,
  306.    TEXTCOLOR, TRANSPARENT, WIDTH, HEIGHT, LITERAL,X_FRAME,y_FRAME 
  307.    X_OFFSET, y_offset, X_SCALES Y_SCALES V_ALIGN LINE_JA
  308.     SLIDE2 SLIDE SLIDE_VERT SLIDE_HORIZ SLIDE_THRESH SLIDE_PROB
  309.     SLIDE_COORD SLIDE_SIZE SLIDE_RED SLIDE_GREEN SLIDE_BLUE SPECIAL
  310.     FIGDIST_TYPE  TTF_FONT TTF_FONT_SIZE LINE_SEP
  311.  */
  312.  
  313. /* set to blank means "use font_index value if none specified in request */
  314. send_bim=0
  315. back_file=' ' ; text=' ' ; back2_file=''; mask_file=''
  316. amessage=' ' ; cache_file=' ';  do_cache=0
  317. backcolor=' ' ; textcolor=' ' ; transparent=""
  318. fontdir=default_font; fontname=font_name ; fontindex=font_index ;fontdir2=''
  319. many_type=0 ; many_type_max=0
  320. ttf_font='' ;ttf_font_size=0 ;ttffile=''
  321. x_scales="" ;y_scales="" ; y_valign="" ; slide2=' ';slide="" ;  slide_vert="" ; 
  322. slide_thresh='P1' ; slide_horiz=''
  323. slide_red="" ; slide_green="" ;slide_blue=""
  324. slide_size=""
  325. slide_coord=""
  326. slide_xcoord="" ; slide_ycoord="" ; slide_prob=''
  327. special=''
  328. maskfile='' ; mask_threshold=0
  329. linealign='L'
  330.  
  331. /* pull options from request */
  332. literal=0 ;
  333.  do until list=""                /* get user input */
  334.    parse var list a1 '&' list
  335.    parse var a1 a1a '=' a1b0
  336.    a1a=translate(strip(a1a))
  337.    a1b1=packur2(a1b0)
  338.    a1b=strip(translate(a1b1))
  339.    select
  340.       when a1a="FONT_DIR" | a1a="FONT" then do
  341.           if a1b<>' ' then fontdir=a1b
  342.       end  /* Do */
  343.       when a1a="FONT_DIR2" | a1a="FONT2" then do
  344.           if a1b<>' ' then fontdir2=a1b
  345.       end  /* Do */
  346.  
  347.       when a1a="FONT_NAME" | a1a="NAME" then do
  348.            if a1b<>' ' then fontname=a1b
  349.       end
  350.  
  351.  
  352.       when a1a="TTF_FONT" then do
  353.            if a1b<>' ' then ttf_font=strip(a1b1)
  354.       end /* do */
  355.       when a1a="TTF_FONT_SIZE" then do
  356.            if datatype(a1b)='NUM' then ttf_font_size=a1b
  357.       end /* do */
  358.  
  359.       when a1a="FONT_INDEX" | a1a="INDEX" then do
  360.             if a1b<>' ' then fontindex=a1b
  361.       end  /* Do */
  362.       when abbrev(a1a,'TIME')=1 then time_fmt=a1b
  363.       when abbrev(a1a,'CACHE')=1 then do
  364.                 cache_file=strip(a1b)
  365.                 do_cache=1
  366.                 if a1a='CACHE2' then do_cache=2
  367.       end  /* Do */
  368.       when abbrev(a1a,'DATE')=1 then date_fmt=a1b
  369.       when abbrev(a1a,"TEXTC")=1 then textcolor=a1b
  370.       when abbrev(a1a,"BACKG")+abbrev(a1a,"BACKC")>0 then backcolor=a1b
  371.       when abbrev(a1a,"TRANS")=1 then do
  372.          if datatype(a1b)='NUM' then transparent=a1b
  373.       end
  374.       when a1a="WIDTH" | a1a="W" then width=a1b
  375.       when abbrev(a1a,'SPECIAL')=1 then special=special' 'a1b
  376.       when a1a="SEND" then send_pieces=a1b
  377.       when abbrev(a1a,'FIGDIST')=1 then do
  378.           if wordpos(a1b,'1 2 3')>0 then  figdist_type=a1b
  379.       end /* do */
  380.       when abbrev(a1a,'MANY_')=1 then do
  381.           if datatype(a1b)='NUM' then
  382.                many_type_max=a1b
  383.           else
  384.                many_type=wordpos(translate(a1b),'CYCLE FIT END RANDOM')
  385.       end /* do */
  386.       when abbrev(a1a,"X_F")=1 then do
  387.            if datatype(a1b)='NUM' then x_frame=a1b
  388.       end
  389.       when abbrev(a1a,"Y_F")=1 then do
  390.           if datatype(a1b)='NUM' then y_Frame=a1b
  391.       end
  392.       when abbrev(a1a,"X_OF")=1 then do
  393.            if datatype(a1b)='NUM' then X_OFFSET=a1b
  394.       end
  395.       when abbrev(a1a,"Y_OF")=1 then do
  396.           if datatype(a1b)='NUM' then y_offset=a1b
  397.       end
  398.  
  399.  
  400.       when a1a="HEIGHT" | a1a="H" then height=a1b
  401.       when a1a='LINE_SEP' then line_sep=a1b
  402.       when abbrev(a1a,"LIT")=1 then literal=a1b
  403.       when a1a="BACK" | a1a="BACK_FILE" then back_file=a1b
  404.       when a1a="BACK2" | a1a="BACK2_FILE" then back2_file=a1b
  405.       when a1a="BACK_SCALE" | a1a="BKSC" then back_scale=wordpos(translate(a1b),'Y YES 1')
  406.       when a1a="MASK" | a1a="MASK_FILE" then mask_file=a1b
  407.       when a1a="MASK_SCALE" | a1a="MASKSC" then mask_scale=wordpos(translate(a1b),'Y YES 1')
  408.       when a1a='MASK_REVERSE' | a1a='MASK_R' then mask_reverse=wordpos(translate(a1b),'Y YES 1')
  409.       when a1a="MASK_THRESHOLD" | a1a="MASK_T" then  mask_threshold=strip(a1b)
  410.       when abbrev(a1a,'X_SC')+abbrev(a1a,'XSCA')>0 then x_scales=a1b
  411.       when abbrev(a1a,'Y_SC')+abbrev(a1a,'YSCA')>0 then y_scales=a1b
  412.       when abbrev(a1a,'VALI')+abbrev(a1a,'V_ALI') + abbrev(a1a,'Y_VAL')+ abbrev(a1a,'YVAL')>0 then y_valign=a1b
  413.       when abbrev(a1a,'SLIDE_H')=1  then slide_horiz=a1b
  414.       when abbrev(a1a,'SLIDE_T')=1  then slide_thresh=a1b
  415.       when abbrev(a1a,'SLIDE_V')=1  then slide_vert=a1b
  416.       when abbrev(a1a,'SLIDE_F')=1 | a1a='SLIDE'  then  do
  417.           ee=translate(a1b,'\','/')
  418.           ee=strip(a1b,'l','\')
  419.           slide=gif_dir_root||ee
  420.       end
  421.       when abbrev(a1a,'SLIDE2_F')=1 | a1a='SLIDE2'  then  do
  422.           slide2=a1b
  423.       end
  424.       when abbrev(a1a,'SLIDE_S')=1  then do
  425.           if datatype(a1b)='NUM'  then slide_size=a1b
  426.       end  /* Do */
  427.       when abbrev(a1a,'SLIDE_C')=1  then slide_coord=a1b
  428.       when abbrev(a1a,'JUST')=1 | abbrev(a1a,'LINE_J')=1 then line_just=translate(left(a1b,1))
  429.       when abbrev(a1a,'SLIDE_R')=1  then slide_red=a1b
  430.       when abbrev(a1a,'SLIDE_G')=1  then slide_green=a1b
  431.       when abbrev(a1a,'SLIDE_B')=1  then slide_blue=a1b
  432.       when abbrev(a1a,'SLIDE_P')=1  then slide_prob=a1b
  433.  
  434.       when a1a="MESSAGE" | a1a="TEXT" then do
  435.          a1b0=strip(a1b0,,'"')
  436.          amessage=packur2(a1b0)
  437.       end
  438.       otherwise nop
  439.    end  /* select */
  440. end /* do */
  441. if amessage="" then amessage=' '
  442.  
  443. if verbose>1 then call gpmprintf(' GIF_TEXT font= ' fontdir ', message: 'amessage)
  444.  
  445. /* if send_pieces, then see if the browser supports multi part documents (connection:keep-alive) */
  446. if is_cgi=0 & wordPos(translate(send_pieces),'Y YES 1')>0 then do
  447.     a=translate(strip(reqfield('Connection')))
  448.     a2=translate(strip(reqfield('PROXY-Connection')))
  449.     if a<>'KEEP-ALIVE' & a<>'MAINTAIN' , 
  450.        & a2<>'KEEP-ALIVE' & a2<>'MAINTAIN' & cprotocol<'1.1' then do
  451.          send_pieces=0            /* browser does NOT support connection:keep-alive */
  452.     end                
  453.     else do
  454.         send_pieces=1   /*  it does */
  455.     end /* do */
  456. end
  457. else  do
  458.    send_pieces=0      /* send_Pieces ONLY works as SRE-http addon */
  459. end  /* Do */
  460.  
  461. call fix_defaults               /* set some default parameters */
  462.  
  463. if result=2 then signal shipit
  464.  
  465. call fix_options                /* using font_index and request stuff, set options */
  466. call fix_message                /* fix up message (special code replacmenet */
  467. call check_ndims
  468.  
  469. ttf_font0=ttf_font
  470. ttf_font_size0=ttf_font_size
  471. ttffile0=ttffile
  472. was_ttffile=0
  473.  
  474. /* DONE WITH INITIALIZATIONS  ----------------------- */
  475.  
  476. /* for each charater in message, get it's gif file (if avaiable), it's
  477.    size, and it's scale factors */
  478. len0 = Length(amessage)          /* amessage is message, after $t, etc modifications */
  479. xmess=0; ymess=0 ; cfound=0
  480. ysize_tot=0 ; xsize_tot=0
  481. l=0; l0=0; newls=''
  482. do until l0 >=len0
  483.    l0=l0+1
  484.  
  485.    achar = substr(amessage,l0,1)
  486.    ichar=c2d(achar)
  487.    if ichar=10 then do          /* newline */
  488.        newls=newls' 'l   /* record position, and drop character */
  489.        iterate
  490.    end /* do */
  491.  
  492.    if ichar=6 then do           /* font switch -- use carefully */
  493.        parse var user_fonts fontname user_fonts
  494.        switchl.l=fontname
  495.        ttf_font_size=0 ;ttffile=''
  496.        if abbrev(fontname,'!')=1 then do        /* ttf? */
  497.           parse var fontname '!' ttf_font_size '_' ttf_font
  498.        end /* do */
  499.        fontindex='';fontdir=fontname 
  500.        call fix_defaults 1              /* set some default parameters */
  501.        call fix_options
  502.        call check_ndims
  503.  
  504.        iterate
  505.    end /* do */
  506.  
  507.    l=l+1
  508.    switchl.l=''
  509.  
  510.    cls.l=' '              /* the l'th characters GIF file. ''=n.a. */
  511.    cls.!xscale.l=get_user_scale(l,len0,x_scales) /* char specific width scale factor */
  512.    cls.!yscale.l=get_user_scale(l,len0,y_scales) /* char specific height scale factor */
  513.    cls.!xsize.l=0                       /* char width (0=n.a. */
  514.    cls.!ysize.l=0                       /* char height (0=n.a. */
  515.    cls.!char.l=achar
  516.    cls.!isttf.l=0
  517.  
  518. /* note: xscale and yscale are image independent (uses character position in
  519.   the message, and the user_scale parameter) */
  520.    select
  521.  
  522. /* ttf font is special */
  523.       when ttf_font_size>0 then do
  524. /* skip through message till next ichar<6 */
  525.         do l00=l0 to len0
  526.           achar2 = substr(amessage,l00,1)
  527.           ichar2=c2d(achar2)
  528.           if ichar2<15 then leave
  529.           isat=l00
  530.         end
  531.         cls.l=substr(amessage,l0,1+isat-l0)
  532.         l0=isat
  533.         utt=strip(translate(ttffile))
  534.         t_file=ttffile
  535.         if abbrev(utt,'HTTP://')=1 then do      /* try to get from www ? */
  536.             if ttffile=was_ttffile then do
  537.                  t_file=gif_dir_root||t_file0
  538.             end /* do */
  539.             else do
  540.                t_file=get_remote_file(ttffile,max_urlsize,verbose,'.FMP',0)
  541.                was_ttffile=ttffile
  542.                t_file0=t_file
  543.                t_file=gif_dir_root||t_file
  544.                nttfs=nttfs+1
  545.             end
  546.         end /* do */
  547.         if t_file<>'' then do 
  548.            fop=stream(t_file,'c','open read')
  549.            rc = rxttf_image(cls.l,t_file,ttf_font_size,ttfdata)
  550.            fop=stream(t_file,'c','close')
  551.            if rc=0  | cls.l='' then do
  552.               cls.!ysize.l=ttfdata.!rows 
  553.               cls.!xsize.l=ttfdata.!cols
  554.               xsize_tot=xsize_tot+cls.!xsize.l
  555.               ysize_tot=ysize_tot+cls.!ysize.l
  556.               cls.!isttf.l=1       
  557.               cfound=cfound+length(cls.l) 
  558.            end
  559.         end
  560.         iterate
  561.       end                               /* ttf */
  562.       when ichar=1 | ichar=2 then do    /* am or pm character */
  563.           achar='PM' ; if ichar=1 then achar='AM'
  564.           cl=get_gifname(achar,gif_dir,fontname)  /* may use UC for LC, etc. */
  565.           if cl=' ' then iterate
  566.       end  /* Do */
  567.       when ichar=3 then do            /* filled box characher */
  568.           cls.l=achar 
  569.           iterate
  570.       end /* do */
  571.       when ichar=4 then do            /* special $x character */
  572.          icss=speclist.!current+1
  573.          speclist.!current=icss
  574.          if icss>speclist.0 then do
  575.             call gpmprintf('GIF_Text warning: special list overrun')
  576.             cls.l=' '
  577.             iterate
  578.          end /* do */
  579.          ichar0=speclist.icss
  580.          if symbol('FONT_IND.!chars.'||ichar0)<>'VAR' then iterate /* no such $nn entry; skip*/
  581.          cl=gif_dir||font_ind.!chars.ichar0
  582.          if stream(cl,'c','query exists')=' ' then iterate  /* no such file */
  583.       end  /* Do */
  584.       otherwise do             /* normal character -- check for file */
  585.          if achar=' ' then iterate
  586.          cl=get_gifname(achar,gif_dir,fontname)
  587.          if cl=' ' then iterate
  588.       end
  589.    end
  590. /* double check -- is it a gif file? */
  591.    im = RxgdImageCreateFromGIF(cl)
  592.    IF (im = 1 | im=0) THEN do
  593.         IF VERBOSE>0 then call gpmprintf("GIF_TEXT bad GIF file: " cl', 'im)
  594.         iterate
  595.    end
  596.  
  597.    cls.l=cl             /* use the CL gif file for this l'th character 
  598.                          Note: if "complete" or "ttf", should NOT get here */
  599.  
  600.    cfound=cfound+1
  601.  
  602.    cls.!xsize.l=RxgdImageSX(im)
  603.    cls.!ysize.l=RxgdImageSY(im)
  604.  
  605.    xsize_tot=xsize_tot+cls.!xsize.l
  606.    ysize_tot=ysize_tot+cls.!ysize.l
  607.    Call RxgdImageDestroy im
  608. end
  609.  
  610. len=l   
  611.  
  612. /* reset original ttf stuff */
  613. ttf_font=ttf_font0
  614. ttf_font_size=ttf_font_size0
  615. ttffile=ttffile0
  616.  
  617. /* Now, use CLS. and newls to determine HEIGHT AND WIDTH OF MESSAGE */
  618. xmess=(X_FRAME*2) ; ymess=(Y_FRAME*2) ; 
  619. yf2=ymess  /* frames are absolute sizes */
  620.  
  621.  
  622. do mm=1 to len          /* note: n.a. characters do not contribute to these calcluations */
  623.     xmess=xmess+trunc(cls.!xsize.mm*cls.!xscale.mm)
  624.     if trunc(yf2+(cls.!yscale.mm*cls.!ysize.mm))>ymess then 
  625.           ymess=yf2+trunc(cls.!yscale.mm*cls.!ysize.mm)
  626. end /* do */
  627.  
  628. /* adjust for spaces and missing chars (assuming 1 line of text)*/
  629. select
  630.   when cfound=0 then do                 /* no characters found */
  631.         ysize0=def_text_size ; xsize0=def_text_size
  632.         IF FONT_IND.!ndims>0 then DO          /* not generic default, use complete font info */
  633.            xSIZE0=FONT_ind.!WCHAR-(font_ind.!leftoffset+font_ind.!rightoffset)  /*correct for discarded offsets */
  634.            Ysize0=FONT_IND.!HCHAR-(font_ind.!topoffset+font_ind.!bottomoffset)
  635.         END
  636.         do mmm=1 to len            /* fill in CLS. (sort of a stupid approach) */
  637.            cls.!xsize.mmm=xsize0
  638.            cls.!ysize.mmm=ysize0
  639.            xmess=xmess+(xsize0*cls.!xscale.mmm)
  640.            ymess=max(ymess,yf2+trunc(ysize0*cls.!yscale.mmm))
  641.         END
  642.   end  /* Do */
  643.  
  644.   when len=found then nop               /* all characters found */
  645.  
  646.   otherwise do                          /* some characters found */
  647.      xavgsize=trunc(xsize_tot/cfound)    /* average size of found characters */
  648.      yavgsize=trunc(ysize_tot/cfound)
  649.      do mmm=1 to len              /* set values for n.a. characters */
  650.         if (cls.mmm<>'' & cls.mmm<>a_box)  then iterate   /* got values, so skip */
  651.         xmess=xmess+(xavgsize*cls.!xscale.mmm)
  652.         cls.!xsize.mmm=xavgsize
  653.         cls.!ysize.mmm=yavgsize
  654.      end /* do */
  655.   end   /* otherwise */
  656.  
  657. end  /* adjusting size for spaces etc. */
  658.  
  659.  
  660. numlines=1 
  661. /* if multiple lines, refigure xmess and ymess; using cls. info */
  662. if newls<>'' then do
  663.    j1=1 ; ymess=0 ; xmess=0 ; numlines=words(newls)+1
  664.    ymess.0=0
  665.    do mm1=1 to numlines         /*recomputing mess width and height */
  666.       xmess.mm1=0 ;ymess.mm1=0
  667.       if mm1=numlines then
  668.          j2=len
  669.       else
  670.          j2=strip(word(newls,mm1))
  671.       do wr=j1 to j2
  672.          xmess.mm1=xmess.mm1+trunc(cls.!xsize.wr*cls.!xscale.wr)
  673.          if trunc(cls.!yscale.wr*cls.!ysize.wr)>ymess.mm1 then 
  674.              ymess.mm1=trunc(cls.!yscale.wr*cls.!ysize.wr)
  675.       end
  676.       xmess=max(xmess,xmess.mm1)
  677.       ymess=ymess+ymess.mm1+line_sep  /* line_sep pixel high line sepeartor */
  678.  
  679.       j1=j2+1
  680.    end
  681.  
  682.    ymess.0=ymess
  683.    ymess=ymess+yf2+((numlines-1)*line_sep)            /* character heights + frame */
  684.    xmess.0=xmess
  685.    xmess=xmess+((2*x_Frame))
  686. end /* do */
  687.  
  688. /* we now know the total image size (xmess and ymess), and the
  689. size/scale/file for each character in the message (cls.) */
  690.  
  691. /* determine whole  image scale factors, if any */
  692. width_fact=1
  693. height_fact=1
  694. if datatype(width)='NUM' then do   
  695.   if width>0 then do 
  696.       corx=X_OFFSET+(2*x_frame)
  697.       width_fact=(width-corx)/(xmess-corx)   /* will force xmess into frame corrected width */
  698.       xmess=width
  699.   end  /* Do */
  700. end  /* Do */
  701. if datatype(height)='NUM' then do
  702.   if height>0 then do 
  703.      height_fact=(height-yf2)/(ymess-yf2)
  704.      ymess=height
  705.   end  /* Do */
  706. end 
  707.  
  708. y_useable=ymess-((2*y_frame))  /* height that can be written to */
  709.  
  710. /* xmess and ymess are the width/height of message (either determined
  711. from message+FRAME, or preset. Width_fact and height_fact will force actual
  712. characters to fit into this rectangle */
  713.  
  714. /* create a message buffer of required, or desired, size */
  715.  
  716.    messim=rxgdimagecreate(xmess,ymess)
  717.    if messim=1 | messim=0 then do
  718.       if verbose>0 then  call gpmprintf(" could not create new message buffer ")
  719.       if is_cgi=0 then do
  720.          'NODATA'
  721.          return '400 0'
  722.       end
  723.       else do
  724.            return 
  725.       end /* do */
  726.    end  /* Do */
  727.  
  728.    if slide<>' ' | slide_size>0 then do                /* if color slide, use seperate back file */
  729.          messim_b=rxgdimagecreate(xmess,ymess)
  730.          if messim_b=1 | messim_b=0 then slide=' '
  731.    end
  732.  
  733. /* set background color, default text color, and transparent colors */
  734.    oy=rxgdimagecolorallocate(messim,red_back,green_back,blue_back)
  735.    if slide<>' ' | slide_size>0 then  oy=rxgdimagecolorallocate(messim_b,red_back,green_back,blue_back)
  736.  
  737.    if transparent >-1  then do
  738.        call rxgdimagecolortransparent messim,transparent
  739.        if slide_size>0 | slide<>' ' then call rxgdimagecolortransparent messim_b,transparent
  740.    end
  741.  
  742. /* =-------- fill in the background and the mask? */
  743.  
  744. call get_background             /* uses globals */
  745.  
  746. /* background is done; should it be sent as a preliminary version? */
  747. if send_pieces=1 then do
  748.    oof=img_to_var(mmb,tempfile,1)   /* copy image handle to var; signal errdone if problem */
  749.    foo=sref_multi_send(oof,'image/gif','S',,verbose)
  750.    if foo<0  then signal errdone
  751.    send_bim=rxgdimagecreatefromgif(tempfile)
  752.    foo=sysfiledelete(tempfile)
  753.    nsent=1
  754.   if verbose>1 then call gpmprintf(' GIF_TEXT: SENDing background ')
  755. end /* do */
  756.  
  757. /* create MASK */
  758. call get_mask             /* uses globals */
  759. if send_Pieces=1 & mask_file<>'' then do
  760.    oof=img_to_var(mASKIm,tempfile,1)   /* copy image handle to var; signal errdone if problem */
  761.    foo=sref_multi_send(oof,'image/gif','S',,verbose)
  762.    foo=sysfiledelete(tempfile)
  763.    nsent=1+nsent
  764. end
  765.  
  766.  
  767. /* ------ Now copy the appropriate alphabet gifs to the message buffer 
  768.           (or extract from complete font or from ttf font ) */
  769.  
  770. nowx=x_frame+X_OFFSET ; online=1
  771. nowy=0
  772. if numlines>1 then do
  773.  if line_just='C' | line_just='R' then do       /* center align */
  774.     f1=(xmess.0-xmess.online)/xmess.0 /* diff twixt max width as fraction */  
  775.     gg=1   
  776.     if line_just='C' then gg=2
  777.     f2=f1*xmess/gg                /* scaled back to actual width */
  778.     nowx=nowx+trunc(f2)
  779.  end /* do */
  780. end                     /* 1st of numlines x correction */
  781.  
  782. do l=1 to len                   /* for each character in "corrected" message */
  783.   if numlines>1 then do
  784.     isl=l-1
  785.     army=wordpos(isl,newls) 
  786.     if army>0 then do           /* new lines, set x and y "line start */
  787.        online=online+1
  788.        nowx=x_frame+X_OFFSET
  789.        if line_just='C' | line_just='R' then do       /* center align */
  790.           f1=(xmess.0-xmess.online)/xmess.0 /* diff twixt max width as fraction */  
  791.           gg=1   
  792.           if line_just='C' then gg=2
  793.           f2=f1*xmess/gg                /* scaled back to actual width */
  794.           nowx=nowx+trunc(f2)
  795.        end /* do */
  796.        ol1=online-1
  797.        nowy=nowy+trunc(((line_sep+ymess.ol1)/ymess.0)*y_useable)
  798.     end /* do */
  799.   end
  800.   if cls.!isttf.l=1 then do
  801.      achar=cls.l
  802.   end /* do */
  803.   else do
  804.      achar=cls.!char.l ; fromdef=0  /* fromdef: 0=own.gif, 1=complete font, 2= generic, 3=ttf */
  805.   end
  806.   uul=l-1
  807.   if switchl.uul<>' ' & uul>0 then do  
  808.        fontname=switchl.uul
  809.        ttf_font_size=0 ;ttffile=''
  810.        if abbrev(fontname,'!')=1 then do        /* ttf? */
  811.           parse var fontname '!' ttf_font_size '_' ttf_font
  812.        end /* do */
  813.        fontindex='';fontdir=fontname 
  814.        call fix_defaults 1              /* set some default parameters */
  815.        call fix_options
  816.        call check_ndims
  817.    end
  818.  
  819.   if achar=' '  then do          /* a space: skip pixels in image  */
  820.       nowx=nowx+trunc(width_fact*cls.!xscale.l*cls.!xsize.l)
  821.       iterate
  822.   end
  823.  
  824.   if achar=a_box then do                        /* filled box,  treat as a special "default" character */
  825.       im=rxgdimagecreate(16,16)
  826.       oy=rxgdimagecolorallocate(im,red_back,green_back,blue_back)
  827.       text_color=rxgdimagecolorallocate(im,red_text,green_text,blue_text)
  828.       foo=rxgdimagefilledrectangle(im,0,0,15,15,1)
  829.       xsize=16 ; ysize=16
  830.       fromdef=2
  831.       xsc1=cls.!xsize.l/xsize
  832.       ysc1=cls.!ysize.l/ysize
  833.       cls.!xscale.l=cls.!xscale.l*xsc1
  834.       cls.!yscale.l=cls.!yscale.l*ysc1
  835.       cls.!xsize.l=xsize
  836.       cls.!ysize.l=ysize
  837.   end
  838.  
  839.   else do                       /* a character */
  840.      cl=cls.l
  841.      if cl=' ' | cls.!isttf.l=1 then     /* n.a. character */
  842.          im=1               /* signal "n.a." .gif file */
  843.      else
  844.         im = RxgdImageCreateFromGIF(cl)
  845.   end
  846.  
  847.   ichar=32
  848.   if cls.!isttf.l=0 then ichar=c2d(achar)       /* might be speial character */
  849.  
  850. /*  if no such file, use generic or complete font */
  851.   select
  852.  
  853.      when (im<=1) & (ichar<10) & (ichar<>3) then do   /* missing special charcter == use space character */
  854.         nowx=trunc(width_fact*cls.!xscale.l*cls.!xsize.l)+nowx
  855.         iterate
  856.      end  /* Do */
  857.  
  858.      when cls.!isttf.l=1 then do   /* use a ttf font */
  859.         utt=strip(translate(ttffile))
  860.         t_file=ttffile
  861.         if abbrev(utt,'HTTP://')=1 then do      /* try to get from www ? */
  862.            if nttfs>1 then do
  863.               t_file=get_remote_file(ttffile,max_urlsize,verbose,'.FMP',0)
  864.               t_file=gif_dir_root||t_file
  865.            end          /* else, we already read it above */
  866.            else do
  867.               t_File=gif_dir_root||t_file0
  868.            end /* do */
  869.         end /* do */
  870.         if t_File='' then do
  871.              fromdef=3
  872.              iterate
  873.         end /* do */
  874.         im=create_ttf_gif(achar,t_file,ttf_font_size)  /* t_file set when "sizing */
  875.         fop=stream(t_file,'c','close')
  876.  
  877.          xsize=RxgdImageSX(im)      /* complete font (useable) size */
  878.          ysize=RxgdImageSY(im)  
  879.          fromdef=3
  880.      end /* do */
  881.      
  882.  
  883.      when im <= 1  THEN   do       /* missing, use generic or DEFAULT font */
  884.         uul=l-1
  885.    
  886.         im=get_default_char(achar,l,len,many_type_max)   /* alphabyte specific default? */
  887.  
  888.         if im<>1 then do    /* got an image containing the font */
  889.           if  verbose>1 then call gpmprintf(' GIF_TEXT: using alphabyte specific default for character ' achar)
  890.           xsize=RxgdImageSX(im)      /* complete font (useable) size */
  891.           ysize=RxgdImageSY(im)  
  892.           fromdef=1
  893.         end
  894.  
  895.         else do         /* no complete font -- use generic default */
  896.           if  verbose>1 then call gpmprintf(' GIF_TEXT: using default for character ' achar)
  897.           im=rxgdimagecreate(16,16)
  898.           oy=rxgdimagecolorallocate(im,red_back,green_back,blue_back)
  899.           text_color=rxgdimagecolorallocate(im,red_text,green_text,blue_text)
  900.           foo=rxgdimagestring(im,'G',0,0,achar,text_color)
  901.           xsize=16 ; ysize=16
  902.           fromdef=2
  903.         end
  904.  
  905. /* scale must scale xsize,ysize to presumed size (cls.!xsize,!ysize);
  906.   and still include character specific scale */
  907.         xsc1=cls.!xsize.l/xsize
  908.         ysc1=cls.!ysize.l/ysize
  909.         cls.!xscale.l=cls.!xscale.l*xsc1
  910.         cls.!yscale.l=cls.!yscale.l*ysc1
  911.         cls.!xsize.l=xsize
  912.         cls.!ysize.l=ysize
  913.      end
  914.  
  915.      otherwise  do               /* use matching .gif file */
  916.         xsize=cls.!xsize.l
  917.         ysize=cls.!ysize.l
  918.         fromdef=0
  919.      end
  920.  
  921.   end           /* select */
  922.  
  923. /* copy to message buffer. Rxgd will take care of color table matching, etc */
  924.  
  925. /* fix background & transparency */
  926.   foo=0
  927.   if back_File<>' '& fromdef>0  & transparent>-1 then do
  928.     tt=transparent
  929.     if font_ind.!isbw=0 then do
  930.        tt=rxgdimagecolorclosest(im,dim_r,dim_g,dim_b)
  931.     end
  932.     call rxgdimagecolortransparent im,tt
  933.     foo=tt
  934.   end
  935.   else do
  936.    if back_file<>' ' then foo=rxgdimagegettransparent(im)
  937.   end
  938.   if foo=-1 & back_file<>" " & fromdef=0 then do   /* try to fix transparency */
  939.      call rxgdimagecolortransparent im,font_ind.!transparent
  940.   end
  941.  
  942.  
  943. /* now, write possibly scaled image to messim.  There are two scales:
  944.   character specific scale: a combo of the "generic/default to average"
  945.                             and the "user-specified character specific scale"
  946.   whole message scale: fit message to specified message width/height
  947.   and ... adjust vert and horiz for line and line alignment 
  948. */
  949.  
  950.   wfact=width_fact*cls.!xscale.l
  951.   hfact=height_fact*cls.!yscale.l
  952.   xsize=cls.!xsize.l ; ysize=cls.!ysize.l
  953.   yff=y_frame+y_offset
  954.   ish=y_useable
  955.   if numlines>1 then ish=trunc(((line_sep+ymess.online)/ymess.0)*y_useable)
  956.  
  957.   if wfact=1 &hfact=1 then do
  958.       select
  959.          when y_valign='B' then do
  960.               yff=yff+(ish-ysize)
  961.          end  /* Do */
  962.          when y_valign='M' then do
  963.               yff=(y_offset+y_frame)+((ish-ysize)/2)
  964.          end  /* Do */
  965.          otherwise nop
  966.       end  /* select */
  967.  
  968.       foo=rxgdimagecopy(messim,im,nowx,nowy+yff,0,0,xsize,ysize)
  969.       nowx=nowx+xsize
  970.   end
  971.   else do   /* scale it */
  972.       dxsize=trunc(xsize*wfact)
  973.       dysize=trunc(ysize*hfact)
  974.       ish=y_useable
  975.       if numlines>1 then ish=trunc(((line_sep+ymess.online)/ymess.0)*y_useable)
  976.       select
  977.          when   y_valign='T' then yff=y_frame+y_offset
  978.          when y_valign='B' then do
  979.               yff=y_offset+y_frame+(ish-dysize)
  980.          end  /* Do */
  981.          when y_valign='M' then do
  982.               yff=y_offset+y_frame+((ish-dysize)/2)
  983.          end  /* Do */
  984.          otherwise yff=y_offset+y_frame
  985.       end  /* select */
  986.       foo=rxgdimagecopyresized(messim,im,nowx,nowy+yff,0,0, ,
  987.                                dxsize,dysize,xsize,ysize)
  988.       nowx=nowx+dxsize
  989.   end  /* Do */
  990.  
  991.   Call RxgdImageDestroy im
  992.  
  993. end             /* l'th character of message */
  994.  
  995. /* if slide used, slideify messim, and then copyit to messim_b */
  996.  
  997. /* message is done; should it be sent as a secondary version? */
  998. if send_pieces=1 & (slide<>"" | slide_size>0 | mask_file<>'') then do
  999.    foo=rxgdimagecopy(send_bim,messim,0,0,0,0,xmess,ymess) 
  1000.    oof=img_to_var(send_bim,tempfile)
  1001.    foo=sref_multi_send(oof,'image/gif','M')
  1002.    if foo<0 then signal errdone
  1003.    nsent=2
  1004.    if verbose>1 then call gpmprintf(' GIF_TEXT: SENDing message text ')
  1005. end /* do */
  1006.  
  1007. /* get first row of slide, and fix up color table */
  1008. if slide<>' ' then do              /* read slide from file */
  1009.    if is_cgi=0 & abbrev(strip(translate(slide)),'HTTP://')=1 then do /* remote slide */
  1010.       slim=0
  1011.       bslide=get_remote_file(slide,max_urlsize,verbose,'.SMP')
  1012.       if bslide<>'' then do
  1013.           slim=rxgdimagecreatefromgif(gif_dir_root||bslide)
  1014.           fo=sysfiledelete(gif_dir_root||bslide)
  1015.       end /* do */
  1016.    end /* do */
  1017.    else do
  1018.       slim=rxgdimagecreatefromgif(slide)
  1019.    end
  1020.    if (slim=0 | slim=1 )  then do
  1021.           slide=''              /* no slide avaialble */
  1022.           if verbose>1 then 
  1023.              call gpmprintf(' No Slide file available ')
  1024.    end  /* Do */
  1025. end  /* Do */
  1026.  
  1027. if slide="" & slide_size>0 then do   /* make your own slide */
  1028.    slidect.0=slide_size ; slide.0=slide_size
  1029.    do mm=1 to slide_size
  1030.       mm0=mm-1
  1031.       slidect.!r.mm0=map255(get_user_scale(mm,slide_size,slide_red))
  1032.       slidect.!g.mm0=map255(get_user_scale(mm,slide_size,slide_green))
  1033.       slidect.!b.mm0=map255(get_user_scale(mm,slide_size,slide_blue))
  1034.       slide.mm=mm-1
  1035.    end /* do */
  1036.    slide_vert='N'       /* force it to be "one row" color slide */
  1037.    foo=grab_slide(0,slide_horiz,xmess,1,ymess,,slide_xcoord,slide_ycoord)
  1038. end
  1039.  
  1040. /* valid color slide .gif file, so get the slide */
  1041. if slide<>' ' | slide_size>0 then do
  1042.  
  1043.    if slide<>' ' then do   /* get slide just once */
  1044.        foo=grab_slide(slim,slide_horiz,xmess,0,ymess,,slide_xcoord,slide_ycoord)
  1045.        foo=rxgdimagecolorstotal(slim)
  1046.  
  1047. /* read the color slide's color table,*/
  1048.        foo=rxgdimagegetcolortable(slim,'tt')
  1049.        r='R'; g='G'; b='B'
  1050.        slidect.0=tt.0
  1051.        do il=0 to slidect.0-1
  1052.           slidect.!r.il=tt.r.il
  1053.           slidect.!g.il=tt.g.il
  1054.           slidect.!b.il=tt.b.il
  1055.        end
  1056.     end
  1057.  
  1058. /* if slide_size>0, then we use slidect that was created above */
  1059.  
  1060. /* get color table of messim (if slide_thresh_type<>'P') */
  1061.    if slide_thresh_type<>'P' then do
  1062.       foo=rxgdimagegetcolortable(messim,'tt')
  1063.       r='R'; g='G'; b='B'
  1064.       messct.0=tt.0
  1065.       do il=0 to messct.0-1
  1066.         messct.!r.il=tt.r.il
  1067.         messct.!g.il=tt.g.il
  1068.         messct.!b.il=tt.b.il
  1069.       end
  1070.    end /* do */
  1071.  
  1072.    foo=add_slide_ct(messim)             /* add/remapslide colors to message image */
  1073.    if slide_xcoord<>'' & slide_Ycoord<>'' then do
  1074.        ixcoord=slide_xcoord*xmess ; iycoord=slide_ycoord*ymess
  1075.    end
  1076.    nchanges=0
  1077.    if slide_prob="" then do
  1078.        ixcoord=0 ; iycoord=ny
  1079.    end /* do */
  1080.  
  1081. /* Get each row of message image, check and (possibly) convert each pixel to slide colors */
  1082.    hey=time('r')                /* timer used for SEND */
  1083.  
  1084.    nofinal=0            /* a special effect -- causes a left side shadow */
  1085.    if send_pieces=1 & wordpos('NOFINAL',translate(special))>0 then nofinal=1
  1086.    do ny=0 to ymess-1           /* =========== for each row of message image */
  1087.      if slide_coord="" then do
  1088.          ixcoord=0 ; iycoord=ny
  1089.      end /* do */
  1090.      if verbose>1 & ny//25=1 &send_pieces<>1 then call gpmprintf(" GIF_TEXT: Transforming message row " ny ' of ' ymess)
  1091.      if slide_vert<>'N' then do
  1092.         foo=grab_slide(slim,slide_horiz,xmess,ny,ymess,slide_vert)      /* get slide for this rowl */
  1093.      end  /* Do */
  1094.      foo=rxgdimagegetrowpixels(messim,ny,pxels)
  1095.  
  1096. /* save some processing by not messing with masked pixels */
  1097.       if mask_file<>' ' then do          /* mask this */
  1098.            foo=rxgdimagegetrowpixels(maskim,ny,maskpxels)
  1099.        end /* do */
  1100.  
  1101. /* ========= now scan "message" image, and modify pixels using color slide */
  1102.      do nx=1 to xmess
  1103.        apix=pxels.nx
  1104.  
  1105. /* masked, then skip */
  1106.        if mask_file<>'' then do /* check the mask */
  1107.           if maskpxels.nx=0 then iterate
  1108.        end
  1109.  
  1110.        if slide_thresh="P1" & apix=0 then iterate  /* the most common case */
  1111.        doit=do_change(apix,slide_thresh_type,slide_thresh_val,nx,xmess)
  1112.        if doit=1 then do
  1113.            if (slide_xcoord="" | slide_ycoord="") & slide_prob="" then do
  1114.                itmp=slide.nx
  1115.            end
  1116.            else do
  1117.                nnx=max(1,trunc(figdist(nx,ny,ixcoord,iycoord)))
  1118.                doit=do_change(1,'P',1,nnx,slide.0,slide_prob,1)  /* check probability */
  1119.                if doit=0 then iterate 
  1120.                itmp=slide.nnx
  1121.            end /* do */
  1122.            apix=slidect.!alt.itmp ; nchanges=nchanges+1
  1123.         end  /* Do */
  1124.         pxels.nx=apix
  1125.      end
  1126.      drop pxels.0
  1127.  
  1128.       styled  = RxgdImageSetStyle(messim, pxels, xmess)         /* write transformed row back to */
  1129.       rc = RxgdImageLine(messim, 0,ny,xmess-1,ny,styled)        /*  the message image */
  1130.  
  1131.      if send_pieces=1 then do            /* SEND what ya got? */
  1132.            hey2=time('e')
  1133.            if hey2>send_delay | (nofinal=1 & ny=ymess-1) then do
  1134.                 foo=rxgdimagecopy(send_bim,messim,0,0,0,0,xmess,ymess) 
  1135.                 oof=img_to_var(send_bim,tempfile)
  1136.                 foo=sref_multi_send(oof,'image/gif','M')
  1137.                 if foo<0 then signal errdone
  1138.                 nsent=nsent+1
  1139.                 if verbose>1 then call gpmprintf(' GIF_TEXT: SENDing transformed message text ' ny ' of 'ymess)
  1140.                 hey=time('r')
  1141.            end /* do */
  1142.      end /* do */
  1143.  
  1144.    end              /* transforming row ny */
  1145.    if  nofinal=1 then
  1146.       foo=rxgdimagecopy(messim_b,send_bim,0,0,0,0,xmess,ymess)  /* final copy */
  1147.    else
  1148.       foo=rxgdimagecopy(messim_b,messim,0,0,0,0,xmess,ymess)  /* final copy */
  1149.    mmb=messim_b
  1150.  
  1151. end  /* Do */
  1152.  
  1153. else do                 /* no color slide */
  1154.     mmb=messim
  1155. end
  1156.  
  1157.  
  1158. /* and finally, apply  mask */
  1159. if mask_file<>' ' then do          /* mask this */
  1160.    do ny=0 to ymess-1           /* for each row of message image */
  1161.     foo=rxgdimagegetrowpixels(mmb,ny,pxels)
  1162.     foo=rxgdimagegetrowpixels(maskim,ny,maskpxels)
  1163.     do nx=1 to xmess
  1164.        apix=pxels.nx*maskpxels.nx
  1165.        PXELS.NX=APIX
  1166.     end
  1167.     drop pxels.0
  1168.     styled  = RxgdImageSetStyle(mmb, pxels, xmess)         /* write transformed row back to */
  1169.     rc = RxgdImageLine(mmb, 0,ny,xmess-1,ny,styled)        /*  the message image */
  1170.   END
  1171.   foo= RxgdImageDestroy(maskim)
  1172. end
  1173.  
  1174. /* copy buffer to a file, and clean up */
  1175. if do_cache=0 then do
  1176.   gif_file=gif_dir_root||"MES?????.GIF"
  1177.   gfile=systempfilename(gif_file)
  1178. end
  1179. else do
  1180.    gfile=gif_dir_root||cache_file
  1181. end
  1182.  
  1183.  
  1184. foo=rxgdimagegif(mmb,gfile)
  1185.  
  1186. foo= RxgdImageDestroy(messim)
  1187. if slide<>' ' then foo= RxgdImageDestroy(messim_b)
  1188. do mm1=1 to font_ind.!ndims
  1189.   jdim=dim.mm1
  1190.   foo= RxgdImageDestroy(jdim)
  1191. end /* do */
  1192.  
  1193. if send_bim<>0 then foo=rxgdimagedestroy(send_bim)
  1194. if slide<>' ' then foo=rxgdimagedestroy(slim)
  1195. IF VERBOSE>1 then CALL GPMPRINTF(' GIF_TEXT: completed image of size ' xmess ' x ' ymess )
  1196.  
  1197. shipit: nop             /* jump here if cache entry found */
  1198.  
  1199. if is_cgi=0 then do             /* srefilte addon */
  1200.   signal on failure name nocon
  1201.   if send_pieces=1 then do            /* final send? */
  1202.       oof=charin(gfile,1,chars(gfile))
  1203.       foof=stream(gfile,'c','close')
  1204.       foo=sref_multi_send(oof,'image/gif','E')
  1205.       ieek=stream(gfile,'c','query size')
  1206.       if do_cache=0 then   foo=sysfiledelete(gfile)
  1207.       if foo<0  then signal errdone
  1208.       nsent=3
  1209.       return 200' 'ieek
  1210.   end /* do */
  1211. /* else, use 'FILE  */
  1212.   if do_cache=0 then do
  1213.      return 'FILE ERASE TYPE image/gif name ' gfile     /* let sre deal with reply */
  1214.    end
  1215.    else do
  1216.      return 'FILE  TYPE image/gif NOCACHE name ' gfile
  1217.    end
  1218.    oof=stream(gfile,'c','query size')
  1219.    return '200 '||oof
  1220. end
  1221. if is_cgi=1 then do             /* cgi-bin */
  1222.   ki=chars(gfile); foo=stream(gfile,'c','close')
  1223.   foo=charin(gfile,1,ki) 
  1224.   foo2=stream(gfile,'c','close')
  1225.   if fake_cgi=0 then do
  1226.      Say "Content-type: image/gif"
  1227.      Say
  1228.   end
  1229.   else do
  1230.      say "Writing "||length(foo)||" bytes to GIF file: " outputfile
  1231.   end
  1232.   if fake_cgi=1 then            /* command line invocation with parameters on command line */
  1233.      call charout outputfile,foo
  1234.   else
  1235.      call charout,foo
  1236.   if result<>0 then 
  1237.      call gpmprintf(" GIF_TEXT CGI-BIN error: not all of file written: "||foo3)
  1238.   if do_cache=0 then  foo=sysfiledelete(gfile)
  1239.   return 
  1240. end /* do */
  1241.  
  1242. if is_cgi=2  then do            /* stand alone */
  1243.   foo2=stream(gfile2,'c','close')
  1244.   ki=stream(gfile,'c','query size')
  1245.   foo=charin(gfile,1,ki) 
  1246.   aa=charout(gfile2,foo,1)
  1247.   IF AA>0 then 
  1248.       SAY " Problem writing to outfile: " gfile2
  1249.   else
  1250.      say gfile2 " created (length = " ||stream(gfile2,'c','query size')
  1251.   foo=stream(gfile2,'c','close')
  1252.   foo=stream(gfile,'c','close')
  1253.  
  1254.    IF YESNO(' Display this image using '||img_prog) =1 then do
  1255.        oo=stream(gfile2,'c','query exists')
  1256.        ar1=translate(oo,':','|')
  1257.        ar1=translate(ar1,'/','\')
  1258.        foo=img_prog' file:///'||ar1
  1259.        '@start /f 'foo
  1260.        say cy_ye " >>> starting "img_prog ||normal" (it might take a few seconds...)"
  1261.    end                  /* display with "img_prog" */
  1262.  
  1263.   foo=sysfiledelete(gfile)
  1264.  
  1265.    exit
  1266. end  /* Do */
  1267.  
  1268.  
  1269. errdone:
  1270. if is_cgi=1 then do
  1271.   Say "Content-type: text/plain"
  1272.   Say
  1273.   say "GIF_TEXT error at line  " sigl " (RC=" rc
  1274.   return 
  1275. end /* do */
  1276.  
  1277. say "GIF_TEXT error at line  " sigl " (RC=" rc
  1278. if is_cgi=0 then do
  1279.    'NODATA'
  1280.    return  '400 0'
  1281. end
  1282. exit
  1283.  
  1284. /***************/
  1285. /* get the background file */
  1286. get_background:
  1287.  
  1288.  
  1289. mmb=messim 
  1290. if back_file=0 then back_file=' '
  1291. if back_file='' then return 0
  1292. kill_backfile=0
  1293.  
  1294. if is_cgi=0 & abbrev(translate(back_file),'HTTP://')=1 then do /* try to get url? */
  1295.   back_file=get_remote_file(back_file,max_urlsize,verbose,'.GMP')
  1296.   if back_file='' then return 0
  1297. end
  1298.  
  1299. back_file=strip(translate(back_file,'\','/'),,'\')
  1300. bf2=back_file
  1301. back_file=stream(gif_dir_root||back_file,'c','query exists')
  1302. if back_file=""  & pos(".gif",bf2)=0 then
  1303.    back_file=stream(gif_dir_root||bF2||'.gif','c','query exists')
  1304.  
  1305.  
  1306. if back_file='' then return 0
  1307.  
  1308. if slide_size>0 | slide<>' ' then mmb=messim_b   /* where to write background */
  1309.  
  1310. /* now we write a background image */
  1311. if back_file<>' ' then do
  1312.   foo=tile_image(mmb,back_file,back_scale,xmess,ymess)
  1313.   if kill_backfile=1 & foo>0 then foo=sysfiledelete(back_file) /* kill temporary backg file */
  1314. end
  1315.  
  1316. return 1
  1317.  
  1318.  
  1319.  
  1320. /***************/
  1321. /* get the mask file */
  1322. get_mask:
  1323.  
  1324. if mask_file=0 then mask_file=''
  1325. if mask_file='' then return 0
  1326.  
  1327. /* pull off the www? */
  1328. kill_maskfile=0
  1329. if is_cgi=0 & abbrev(translate(mask_file),'HTTP://')=1 then do /* try to get url? */
  1330.   mask_file=get_remote_file(mask_file,max_urlsize,verbose,'.GMP')
  1331.   if mask_file='' then return 0
  1332. end
  1333.  
  1334. mask_file=strip(translate(mask_file,'\','/'),,'\')
  1335. tmpname=mask_file
  1336. mask_file=stream(gif_dir_root||mask_file,'c','query exists')
  1337. if mask_file="" & pos(".gif",tmpname)=0 then
  1338.    mask_file=stream(gif_dir_root||tmpname||'.gif','c','query exists')
  1339.  
  1340. if mask_image=' ' then return 0
  1341.  
  1342. maskim=rxgdimagecreate(xmess,ymess)
  1343. if maskim=0 | maskim=1 then do
  1344.     call gpmprintf(' GIF_text: unable to create mask image ')
  1345.     return 0
  1346. end /* do */
  1347.  
  1348. /* now we write a mask image */
  1349. foo=tile_image(maskim,mask_file,mask_scale,xmess,ymess)
  1350. if kill_maskfile=1 & foo>0 then foo=sysfiledelete(mask_file) 
  1351.  
  1352. /* convert to 0/1 mask */
  1353. do ny=0 to ymess-1           /* for each row of message image */
  1354.    foo=rxgdimagegetrowpixels(maskim,ny,maskpxels)
  1355.    do nx=1 to xmess
  1356.        apix=1           /* assume its not masked */
  1357.        if mask_reverse>0 then do  /* high pixels are masked " */
  1358.           if maskpxels.nx>mask_threshold then apix=0
  1359.        end
  1360.        else do               /* low pixels are masked */                   
  1361.          if maskpxels.nx<=mask_threshold then apix=0
  1362.        end
  1363.        maskPXELS.NX=APIX
  1364.    end
  1365.    drop maskpxels.0
  1366.    styled  = RxgdImageSetStyle(maskim, maskpxels, xmess)         /* write transformed row back to */
  1367.    rc = RxgdImageLine(maskim, 0,ny,xmess-1,ny,styled)        /*  the message image */
  1368. end
  1369.  
  1370. foo=rxgdimagecolordeallocate(maskim,0)
  1371. oy1=rxgdimagecolorallocate(maskim,0,0,0)
  1372. foo=rxgdimagecolordeallocate(maskim,1)
  1373. oy2=rxgdimagecolorallocate(maskim,155,155,155)
  1374.  
  1375.  
  1376. return 1
  1377.  
  1378.  
  1379.  
  1380.  
  1381. /***********/
  1382. check_ndims:
  1383. /* check on default font info */
  1384. font_ind.!ndims=0
  1385. if font_ind.!defgifs<>' ' then do
  1386.    do wiww=1 to words(font_ind.!defgifs)
  1387.  
  1388.       adefgif=strip(word(font_ind.!defgifs,wiww))
  1389.       bdefgif=gif_dir||adefgif
  1390.       dim= RxgdImageCreateFromGIF(bdefgif)
  1391.       if dim=1 | dim=0 then do
  1392.            CALL gpmprintf(' GIF_TEXT: missing alphabyte specific default:'adefgif)
  1393.            iterate
  1394.       end
  1395.       ndims=ndims+1
  1396.       att=transparent ; if att<0 then att=0
  1397.       dim.ndims=dim
  1398.       dim.ndims.!name=adefgif
  1399.       if ndims=1 then do
  1400.          dim_r=rxgdimagered(dim,att)
  1401.          dim_g=rxgdimagegreen(dim,att)
  1402.          dim_b=rxgdimageblue(dim,att)
  1403.       end
  1404.  
  1405.   end  /* Do */
  1406.   font_ind.!ndims=ndims
  1407. end  /* Do */
  1408. return 1
  1409.  
  1410. /******************/
  1411. /* copy an image to a variable (copy of what would be in .gif file */
  1412. img_to_var:procedure expose tempfile is_cgi
  1413. parse arg im,afile,keepit
  1414. if afile=""  then afile=tempfile
  1415. foo1=rxgdimagegif(im,afile)
  1416. oof=charin(afile,1,chars(afile))
  1417. if oof="" then signal errdone           /* empty -- must be aproblem */
  1418. foo=stream(afile,'c','close')
  1419. if keepit<>1 then foo=sysfiledelete(afile)
  1420. return oof
  1421.  
  1422.  
  1423. /*********************/
  1424. /* get a remote gif file */
  1425. get_remote_file:procedure expose gif_dir_root verbose crlf
  1426.  
  1427. parse arg aurl,mxs,vv,anext,checkfor
  1428.  
  1429. if checkfor='' then checkfor='IMAGE/GIF'
  1430. goo=get_url(aurl,mxs,vv)
  1431.  
  1432. if goo=0 then do 
  1433.       call gpmprintf('GIF_TEXT: Can not get remote  file: 'aurl)
  1434.       return ''
  1435. end /* do */
  1436. parse var goo alin (crlf) goo
  1437. parse var alin . astat . ; astat=strip(astat)
  1438. if abbrev(strip(astat),'2')<>1 then do
  1439.    call gpmprintf('GIF_Text: URL not available (code='astat)
  1440.    return ' '
  1441. end /* do */
  1442. do forever
  1443.    parse var goo alin (crlf) goo
  1444.    if alin='' then leave         /* now we should have the beginining of the image */
  1445.    parse upper var alin ahead aheadv
  1446.    if checkfor=0 then iterate
  1447.    if strip(ahead)<>'CONTENT-TYPE:' then iterate
  1448.    if strip(aheadv)<>checkfor then do
  1449.       call gpmprintf('GIF_Text: URL bad content-type :'aheadv)
  1450.       return ' '
  1451.    end /* do */
  1452. end
  1453.  
  1454. a_file=dospid()||'$'||dostid()||anext  /* save image to file */
  1455. afoo=stream(gif_dir_root||a_file,'c','query exists') /* zap eariler versions ? */
  1456. if afoo<>'' then do             /* exists, try to delete */
  1457.    foo3=sysfiledelete(gif_dir_root||a_file)
  1458.    if foo3<>0 then do                            /* could not delete, use temp file name */
  1459.         a_file=left(dospid()||'$'||dostid(),8,'?')||anext
  1460.         a_file=systempfilename(a_file)
  1461.    end
  1462.    if a_file='' then do         /* could not make temp file name */
  1463.          call gpmprintf('GIF_Text: could not make temporary file: ' foo)
  1464.          return ''
  1465.    end
  1466. end
  1467.  
  1468. foo=charout(gif_dir_root||a_file,goo,1)
  1469.  
  1470. if foo<>0 then do
  1471.   call gpmprintf('GIF_Text: could not write 'gif_dir_root||a_file)
  1472.   return ''
  1473. end
  1474. foo=stream(gif_dir_root||a_file,'c','close')
  1475. if verbose>2 then call gpmprintf('GIF_TEXT: saving remote image to 'a_file)
  1476.  
  1477. return a_file
  1478.  
  1479.  
  1480.  
  1481. /* ---------------------------------------------*/
  1482. /* get a url from some site, return first
  1483. maxchar characters (if maxchar missing, get 10million (the whole thing?) */
  1484. /* ---------------------------------------------*/
  1485. get_url:
  1486. parse arg aurl,maxchar,verbose,headers
  1487.  
  1488. if maxchar="" then maxchar=10000000
  1489. got=""
  1490.  
  1491. if abbrev(translate(aurl),'HTTP://')=1 then do
  1492.    aurl=substr(aurl,8)
  1493. end
  1494. parse var aurl server '/' request
  1495.  
  1496. if VERBOSE>0 then call gpmprintf( "GIF_Text: calling http url : " server ", " request)
  1497.  
  1498. /* Load RxSock */
  1499. if \RxFuncQuery("SockLoadFuncs") then nop
  1500. else do
  1501.        call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
  1502.        call SockLoadFuncs
  1503. end
  1504.  
  1505. crlf    ='0d0a'x                        /* constants */
  1506. family  ='AF_INET'
  1507.  httpport=80
  1508.  
  1509. rc=1
  1510. if verify(server,'1234567890.')>0 then 
  1511.        rc=sockgethostbyname(server, "serv.0")  /* get dotaddress of server */
  1512. else
  1513.       serv.0addr=strip(server)
  1514.  
  1515. if rc=0 then do
  1516.         ss=sref_error('Unable to resolve "'server'"',verbose)
  1517.         return 0
  1518. end
  1519.  dotserver=serv.0addr                    /* .. */
  1520.  gosaddr.0family=family                  /* set up address */
  1521.   gosaddr.0port  =httpport
  1522.  gosaddr.0addr  =dotserver
  1523.  
  1524.     gosock = SockSocket(family, "SOCK_STREAM", "IPPROTO_TCP")
  1525.  
  1526.     /* Set up request [HTTP 1.0, with HOST: header] */
  1527.     message="GET /"request' HTTP/1.0 'crlf
  1528.     if length(headers)>2 then do
  1529.        if right(headers,2)=crlf then headers=left(headers,length(headers)-2)
  1530.     end
  1531.     if headers<>'' then message=message||headers||crlf
  1532.     message=message||'Host: 'server||crlf
  1533.     message=message||crlf
  1534.  
  1535.     got=''
  1536.     rc = SockConnect(gosock,"gosaddr.0")
  1537.     if rc<0 then do
  1538.         ss=sref_error(' Unable to connect to "'server'"',verbose)
  1539.         return 0
  1540.     end
  1541.     rc = SockSend(gosock, message)
  1542.  
  1543. /* Now wait for the response */
  1544.  
  1545.    do r=1 by 1
  1546.      rc = SockRecv(gosock, "response", 1000)
  1547.      got=got||response
  1548.      if rc<=0 then leave
  1549.      tmplen=length(got)
  1550.      if tmplen> maxchar then leave
  1551.   end r
  1552.  
  1553.   rc = SockClose(gosock)
  1554.  
  1555. return got
  1556.  
  1557.  
  1558.  
  1559. /************************/
  1560. /* fill gif image mmb with imb, using tiles or stretching */
  1561. tile_image:procedure expose verbose
  1562. parse arg mmb,back_file,back_scale,xmess,ymess
  1563.  
  1564. imb = RxgdImageCreateFromGIF(back_file)
  1565. IF (imb = 1 | imb=0) THEN do
  1566.    IF VERBOSE>0 then call gpmprintf("GIF_TEXT bad GIF backfile: " back_file', 'imb)
  1567.    return 0
  1568. end
  1569.  
  1570. srcw=RxgdImageSX(imb)
  1571. srch=RxgdImageSY(imb)
  1572.  
  1573. if back_scale>0 then do     /* scale image to fit into box */
  1574.           srcw=RxgdImageSX(imb)
  1575.           srch=RxgdImageSY(imb)
  1576.           foo=rxgdimagecopyresized(mmb,imb,0,0,0,0,xmess,ymess,srcw,srch)
  1577.           return 0
  1578. end  /* Do */
  1579.  
  1580.  h1=trunc(xmess/2)+1  ; w1=trunc(ymess/2)+1
  1581.  select 
  1582.      when srcw>xmess & srch > ymess  then do   /* image smaller then backg */
  1583.               x0=trunc((srcw-xmess)/2) ; y0=trunc((srch-ymess)/2)
  1584.               fpp=rxgdimagecopy(mmb,imb,0,0,x0,y0,xmess,ymess)
  1585.      end
  1586.  
  1587.      when srcw<=xmess & srch<=ymess then do
  1588.               xstart=0
  1589.               do forever                /* go across (do a column) */
  1590.                  jjjx=min(srcw,(xmess-xstart))  /* width of this column */
  1591.                  ystart=0
  1592.                  do forever                /* go down (do a row) */
  1593.                    jjjy=min(srch,(ymess-ystart))
  1594.                    fpp=rxgdimagecopy(mmb,imb,xstart,ystart,0,0,jjjx,jjjy)
  1595.                    ystart=ystart+srch
  1596.                    if ystart>=ymess then leave
  1597.                  end
  1598.                  xstart=xstart+srcw
  1599.                  if xstart>=xmess then leave
  1600.               end
  1601.      end /* do */
  1602.  
  1603.      when srcw>xmess  then do  /* back wider then image */
  1604.               ystart=0
  1605.               fpp=rxgdimagecopy(mmb,imb,0,0,0,0,xmess,srch)
  1606.               do forever
  1607.                  ystart=ystart+srch
  1608.                  jjj=min(srch,(ymess-ystart))
  1609.                  if jjj<1 then leave
  1610.                  fpp=rxgdimagecopy(mmb,imb,0,ystart,0,0,xmess,jjj)
  1611.               end
  1612.  
  1613.     end
  1614.  
  1615.     when  srch>ymess then do   /* backg higher then image */
  1616.               xstart=0
  1617.               fpp=rxgdimagecopy(mmb,imb,0,0,0,0,srcw,ymess)
  1618.               do forever
  1619.                  xstart=xstart+srcw
  1620.                  jjj=min(srcw,(xmess-xstart))
  1621.                  if jjj<1 then leave
  1622.                  fpp=rxgdimagecopy(mmb,imb,xstart,0,0,0,jjj,ymess)
  1623.               end
  1624.     end /* do */
  1625.  
  1626.    otherwise nop
  1627. end
  1628.  
  1629. oy=rxgdimagecolorstotal(mmb) 
  1630. if verbose>1 then do
  1631.    call gpmprintf(' GIF_TEXT: # of colors in  ('bacK_file') = ' oy)
  1632. end
  1633.  
  1634. foo=rxgdimagedestroy(imb)
  1635. return oy
  1636.  
  1637.  
  1638.  
  1639. /**************************************************/
  1640. /* set/cleanup DEFAULT parametrs */
  1641. fix_defaults:
  1642. parse arg nocheck
  1643.  
  1644. nsent=0
  1645. kill_slidefile=0
  1646.  
  1647. if back2_file<>0 & back2_file<>'' then
  1648.     back_file=strip(back2_file)          /* usedto allow type="TEXT" override in mkgiftxt*/
  1649.  
  1650. if fontdir2<>'' & fontdir2<>0 then fontdir=fontdir2
  1651.  
  1652. if mask_threshold=''  | datatype(mask_threshold)<>'NUM' then mask_threshold=0
  1653.  
  1654. crlf='0d0a'x
  1655.  
  1656. red_text=100 ;green_text=100 ; blue_text=100
  1657. red_back=255 ; green_back=205 ; blue_back=155
  1658.  
  1659. def_transparent=check_byte(def_transparent,-1)
  1660. def_text_size=check_byte(def_text_size,15)
  1661. if fontname=0 then fontname=' '
  1662. if fontindex=0 then fontindex=' '
  1663. if back_file=0 then back_File=' '
  1664.  
  1665. gif_dir=gif_dir_root||strip(fontdir,,'\')||'\'
  1666.  
  1667. /* check the cache? */
  1668. if nocheck<>1 then do
  1669.   if do_cache=1 then
  1670.     if pos('$D',translate(amessage))+pos('$T',translate(amessage))>0 then do_cache=0
  1671.   if cache_size=0 then do_cache=0
  1672.  
  1673.   /* use a cached file? */
  1674.   foo=do_from_cache(cache_file)
  1675.  
  1676.   if foo=1 then do   
  1677.      send_pieces=0
  1678.      return 2
  1679.   end
  1680. end
  1681.  
  1682. ttffile=ttf_font
  1683. if ttf_font_size>0  & abbrev(strip(Translate(ttf_font)),'HTTP://')=0 then do
  1684.   arg=ttf_dir_root||ttf_font
  1685.   ttffile=stream(arg,'c','query exists')
  1686.   if ttffile='' & pos('.',ttfile)=0 then do
  1687.      arg=ttf_dir_root||ttf_font||'.ttf'
  1688.      ttffile=stream(arg,'c','query exists')
  1689.    end
  1690. end
  1691. else do
  1692.   oof=translate(fontdir,'  ','\/')
  1693.   if fontname=' ' then fontname=strip(word(oof,words(oof)))
  1694.   if fontindex=' ' then fontindex=fontname||'.IND'
  1695.   fontindex=gif_dir||fontindex
  1696.   dim=0 ; ndims=0;font_ind.!defgifs=' '
  1697.   dim_r=0;  dim_g=0 ; dim_b=0
  1698. end
  1699.  
  1700.  
  1701. return 1
  1702.  
  1703.  
  1704.  
  1705. /***************************/
  1706. /* set options, using font_index and request stuff */
  1707. fix_options:
  1708. /* get font index, and possibly  text and back colors and default-font info */
  1709.  
  1710. inind=READ_FONT_INDEX(fontindex)  /* read in font index, and back and text color_index*/
  1711. if textcolor="" then textcolor=font_ind.!textcolor
  1712. if backcolor="" then backcolor=font_ind.!backcolor
  1713.  
  1714. vvs=get_from_hex(textcolor)
  1715. if vvs<>' ' then do
  1716.       parse var vvs red_text green_text blue_text
  1717. end  
  1718.  
  1719. vvs=get_from_hex(backcolor)
  1720.  
  1721. if vvs<>' ' then do
  1722.       parse var vvs red_back green_back blue_back
  1723. end  /* Do */
  1724.  
  1725. if ttffile=''  then do
  1726.  
  1727. /* many_complete from options ? */
  1728.    if many_type>0 then font_ind.!manytype=many_type
  1729.  
  1730. /* if no x_scales or y_scales in request, use .IND file (if exists) */
  1731.    if x_scales<>"" then font_ind.!x_user_scale=x_scales
  1732.    if y_scales<>"" then font_ind.!y_user_scale=y_scales
  1733.    x_SCALES=FIX_SCALE(FONT_IND.!X_USER_SCALE)
  1734.    Y_SCALES=FIX_SCALE(FONT_IND.!Y_USER_SCALE)
  1735.  
  1736.    if y_valign="" then y_valign=font_ind.!y_valign
  1737. end
  1738.  
  1739. y_valign=translate(y_valign)
  1740. select
  1741.   when abbrev(y_valign,'B')=1 then y_valign='B'
  1742.   when abbrev(y_valign,'T')=1 then y_valign='T'
  1743.   when abbrev(y_valign,'M')+abbrev(y_valign,'C')>0 then y_valign='M'
  1744.   otherwise y_valign='T'
  1745. end
  1746.  
  1747. if ttffile='' then do
  1748.   if slide_vert="" then slide_vert=font_ind.!slide_vert
  1749. end
  1750.  
  1751. /* slide_vert= Tile, Fit, None */
  1752. slide_vert=left(strip(translate(slide_vert)),1)
  1753. if pos(slide_vert,'TFN')=0 then slide_vert='N'  /* use 1 slide is default */
  1754.  
  1755. if slide_horiz="" then slide_horiz=font_ind.!slide_horiz
  1756. slide_horiz=left(strip(translate(slide_horiz)),1)
  1757. /* slide_horiz types: Tile. Resize */
  1758.  
  1759. if slide2<>'' then slide=slide2
  1760.  
  1761. if slide="" & ttffile='' then slide=font_ind.!slide
  1762.  
  1763. if slide<>'' & abbrev(strip(translate(slide)),'HTTP://')=0 then do
  1764.   if slide2<>'' then slide=gif_dir_root||slide2
  1765.    stmp=slide
  1766.    slide=stream(slide,'c','query exists')
  1767.    if  slide=' ' & pos('.',stmp)=0 then do  /* try adding .gif to end */
  1768.        slide=stream(stmp||'.gif','c','query exists')
  1769.    end  /* Do */
  1770. end  /* Do */
  1771.  
  1772. if slide_thresh="" & ttffile='' then slide_thresh=font_ind.!slide_thresh
  1773. slide_thresh=translate(strip(slide_thresh))
  1774. slide_thresh_type=left(slide_thresh,1)
  1775. slide_thresh_val=substr(slide_thresh,2)
  1776. slide_thresh_val=strip(translate(slide_thresh_val,' ','+:'))  /* might be list of values */
  1777.  
  1778. if slide_size=""  & ttffile='' then  slide_size=font_ind.!slide_size
  1779. if slide_size<>0 then do
  1780.   if slide_green="" then  slide_green=font_ind.!slide_gre en
  1781.   if slide_red="" then  slide_red=font_ind.!slide_red
  1782.   if slide_blue="" then  slide_blue=font_ind.!slide_blue
  1783.   slide_green=fix_scale(slide_green)
  1784.   slide_red=fix_scale(slide_red)
  1785.   slide_blue=fix_scale(slide_blue)
  1786. end
  1787.  
  1788. if slide_prob="" & ttffile='' then slide_prob=font_ind.!slide_prob
  1789. slide_prob=fix_scale(slide_prob)
  1790.  
  1791. if slide_coord="" & ttffile='' then slide_coord=fonT_ind.!slide_coord
  1792. slide_coord=fix_scale(slide_coord)  
  1793. parse var slide_coord tx ty
  1794. if datatype(tx)='NUM' & datatype(ty)='NUM' then do
  1795.         slide_xcoord=tx
  1796.         slide_ycoord=ty
  1797. end /* do */
  1798. if pos(slide_thresh_type,'PCB')=0  then do
  1799.      slide=''
  1800.      call gpmprintf(' Error1 specifying slide_thresh:'slide_thresh)
  1801. end  /* Do */
  1802. do ll=1 to words(slide_thresh_val)
  1803.   if datatype(strip(word(slide_thresh_val,ll)))<>'NUM' then do
  1804.      slide=''                                                        
  1805.      call gpmprintf(' Error2 specifying slide_thresh:'slide_thresh)   
  1806.   end
  1807. end
  1808.  
  1809. if verbose >1 & slide<>' ' then  do
  1810.   call gpmprintf(" GIF_TEXT: Using color slide " slide)
  1811. end
  1812. else do
  1813.   if verbose >1 & slide_size>0  then call gpmprintf(" GIF_TEXT: Using generated color slide, #colors=" slide_size)
  1814. end
  1815.  
  1816. /* what's the "transparent" color table entry */
  1817. if transparent='' then    /* not specified in request */
  1818.     transparent=font_ind.!transparent
  1819. if transparent>255 | transparent <-1 then transparent=def_transparent /* is it copecetic? */
  1820.  
  1821. return 1
  1822.  
  1823.  
  1824. /**************************************/
  1825. /* fix up message */
  1826. /* convert $x into time, date, etc. */
  1827. fix_message:
  1828. user_fonts=''
  1829. speclist.0=0
  1830. speclist.!current=0
  1831. goof='00'x
  1832. aa=translate(amessage,goof,'0d0a09'x)
  1833. aaa=''
  1834. do until aa=""
  1835.    parse var aa a1 (goof) aa
  1836.    aaa=aaa||a1
  1837. end /* do */
  1838. amessage=aaa
  1839. if literal<>1  & pos('$',amessage)<>0 then do
  1840. /* parse amessage, converting $x into appropriate stuff. Note that $$ (or $$$..)
  1841.    is interpreted at $ (or $$...) */
  1842.   newmess=""
  1843.   m2=amessage
  1844.   do until amessage=""
  1845.        parse var amessage m1 '$' m2
  1846.        newmess=newmess||m1
  1847.        if m2="" then leave
  1848.        if abbrev(m2,'$')=1 then do  /* strip out $ and display */
  1849.           amessage=strip(m2,'l','$')
  1850.           idls=length(m2)-length(amessage)
  1851.           newmess=newmess||copies('$',idls)
  1852.           iterate
  1853.        end  
  1854.        akey=translate(left(m2,1))
  1855.        select
  1856.           when  akey='T' then newmess=newmess||get_time(time_fmt)
  1857.           when  akey='D' then newmess=newmess||get_date(date_fmt)
  1858.           when  akey='S' then newmess=newmess||'SERVERNAME'
  1859.           when akey='#' then do
  1860.             parse var m2 ains ';' m2
  1861.             ains=strip(ains,,'#')    
  1862.             ains=translate(strip(ains))
  1863.             if right(ains,1)='X' then do
  1864.               ains=strip(ains,'t','X')
  1865.               ains=x2d(ains)
  1866.             end
  1867.             if datatype(ains)='NUM' then do
  1868.                 newmess=newmess||d2c(ains)
  1869.             end
  1870.             amessage=m2
  1871.             iterate                            
  1872.           end /* do */
  1873.           when pos(akey,'1234567890')>0 then do
  1874.              rval=akey
  1875.              akey2=translate(substr(m2,2,1))
  1876.              if pos(akey2,'1234567890')>0 then do
  1877.                  rval=(rval*10)+akey2
  1878.              end
  1879.              newmess=newmess||d2c(4) /* 4 signals "special character" (referenced in speclist) */
  1880.              isss=speclist.0+1
  1881.              speclist.isss=rval
  1882.              speclist.0=isss
  1883.              amessage=substr(m2,length(rval)+1)
  1884.              iterate
  1885.           end
  1886.           when akey='B' then  newmess=newmess||d2c(3) /* 3 is "filled box " */
  1887.           when akey='N' then  newmess=newmess||d2c(10)  /* line break */
  1888.           when akey='F' then do
  1889.                parse var amessage . '(' newfont ')' amessage
  1890.                user_fonts=user_fonts||' 'newfont
  1891.                newmess=newmess||d2c(6)          /* 6 signals "font switch */
  1892.                iterate
  1893.           end /* do */
  1894.           otherwise nop
  1895.        end
  1896.        amessage=substr(m2,2)
  1897.   end /* do */
  1898.   amessage=newmess
  1899. end  /* interpret $x */
  1900. return 1
  1901.  
  1902. /***********************************/
  1903. /* map a 0.. 1 to 0..255 */
  1904. map255:procedure
  1905. parse arg a1
  1906. return trunc(max(min(a1*255,255),0))
  1907.  
  1908. /***********************************/
  1909. /* change this pixel ? */
  1910. do_change:procedure expose messct. is_cgi
  1911. parse arg apix,atype,aval0,jjx,xlen,slide_prob,useaval,jjy
  1912. if useaval=1 then
  1913.   aval=aval0
  1914. else
  1915.   aval=get_user_scale(jjx,xlen,aval0) /* pixel specific threshold */
  1916.  
  1917. aprob=get_user_scale(jjx,xlen,slide_prob)   /* probability of using scale: 1- always use,0-use original value*/
  1918. if aprob<1 then do
  1919.    arf=random()/999
  1920.    if arf>aprob then return 0           /* retain with current value */
  1921. end /* do */
  1922.  
  1923. if atype='P' then do
  1924.    if apix >= aval then return 1
  1925.    return 0
  1926. end  /* Do */
  1927. r=messct.!r.apix
  1928. b=messct.!b.apix
  1929. g=messct.!g.apix
  1930. if atype='C' then do            /* if brightest color is over threshold */
  1931.     if max(r,b,g)>=aval then return 1
  1932.     return 0
  1933. end  /* Do */
  1934. if atype='B' then do            /* if average brightness over threshold */
  1935.      if (r+b+g)/3 >= aval then return 1
  1936.      return 0
  1937. end  /* Do */
  1938. return 0                /* shoud never get here */
  1939.  
  1940.  
  1941. /***************/
  1942. /* process from a cached file 
  1943.   return 1 if "used a cache file"; 0 if not. 
  1944.   Also, set do_cache=0 if a problem arises */
  1945.  
  1946. do_from_cache:procedure expose gif_dir_root verbose do_cache cache_duration is_cgi gfile 
  1947. parse arg cache_file
  1948. if do_cache=0 then return 0
  1949.  
  1950. if do_cache>0 then do
  1951.    do_cache=1
  1952.    cache_file=gif_dir_root||cache_file
  1953.    gfile=cache_file
  1954.  
  1955.    eek=sysfiletree(cache_file,afile,'FT')
  1956.    if afile.0>0 then do         /* match -- check duration */
  1957.         parse var afile.1 dd .
  1958.         mkdate=space(translate(left(afile.1,8),' ','/'),0)
  1959.         nowdate=space(translate(date('o'),' ','/'),0)
  1960.         if abs(nowdate-mkdate) <= cache_duration then do
  1961.           if verbose>1 then call gpmprintf(' GIF_TEXT: using cached image file: ' cache_file)
  1962.           return 1
  1963.        end
  1964.        if verbose>1  then call gpmprintf('GIF_TEXT: Rewriting cached image file: ' cache_file)
  1965.        return 0
  1966.    end  /* Do */
  1967.    else do              /* no match -- is there room? */
  1968.       foo=sysfiletree(gif_dir_root||'*.*','eek','FO')
  1969.       if eek.0 > cache_size then do 
  1970.          do_cache=0     /* suppress cache! */
  1971.          if verbose>1 then call gpmprintf(' GIF_TEXT: cache_size exceeded, can not cache image file: ' cache_file)
  1972.       end  /* Do */
  1973.       else do
  1974.           if verbose>1 then call gpmprintf(' GIF_TEXT: creating cached image file: ' cache_file)
  1975.       end /* do */
  1976.    end
  1977. end
  1978. return 0
  1979.  
  1980.  
  1981.  
  1982. /***********************************/
  1983. /* get the slide file stuff 
  1984. ATYPE has 3 values:
  1985.   T= repeat slide
  1986.   F= fit (internally repeat)
  1987. */
  1988. grab_slide:procedure expose slide. verbose slidect.   is_cgi sqs.
  1989. parse upper arg sim,atype,mx,ajy,my,stype,sxc,syc
  1990. if sim<>0 then do
  1991.   foo=rxgdimagecolorstotal(sim)
  1992.   jx=rxgdimagesx(sim)
  1993.   jy=rxgdimagesy(sim)
  1994. end
  1995. else do
  1996.    jy=1
  1997.    jx=slide.0
  1998. end /* do */
  1999. jy0=jy
  2000. /* which row to read from ? */
  2001. if jy>1 & ( stype="F" | stype="T" ) then do  /* multi row style -- use my ajy row */
  2002.     select
  2003.      when ajy=0 then jy=0
  2004.      when ajy=my then jy=jy-1
  2005.      when jy>my | stype='F' then do
  2006.        tt=ajy/my
  2007.        jy=trunc(tt*(jy-1))
  2008.      end
  2009.      when stype='T' then do
  2010.         jy=trunc(ajy//(jy-1))
  2011.      end  /* Do */
  2012.      otherwise jy=1
  2013.    end
  2014. end  /* Do */
  2015. else do
  2016.    if jy>1 then 
  2017.        jy=trunc(1+(jy/3))
  2018.    else
  2019.      jy=0
  2020. end
  2021.  
  2022. /* if sxc and syc specified, then measrue distance from there (rather then just using
  2023.     column #. This means computing max distance from sxc,syc */
  2024. if datatype(sxc)='NUM' & datatype(syc)='NUM' then do    /* use distance, not colunm */
  2025.     ixc=1+((mx-1)*sxc);   ixc= max(min(ixc,mx),1)
  2026.     iyc=1+((my-1)*syc) ;  iyc= max(min(iyc,my),1)
  2027.     d1=figdist(ixc,iyc,1,1)
  2028.     d2=figdist(ixc,iyc,mx,1)
  2029.     d3=figdist(ixc,iyc,mx,my)
  2030.     d4=figdist(ixc,iyc,1,my)
  2031.     mx=trunc(max(d1,d2,d3,d4))   /* new "max distance from slide */
  2032.     if verbose>1 then call gpmprintf(' GIF_TEXT: Max distance from slide_coord='mx)
  2033. end
  2034.  
  2035. if verbose>1 & ajy//25=1 then 
  2036.    call gpmprintf(" GIF_TEXT: Getting color slide from row:" jy ' of ' jy0)
  2037.  
  2038. drop aslide.
  2039. if sim<>0 then do               /* using slide form file */
  2040.   foo=rxgdimagegetrowpixels(sim,jy,aslide)
  2041. end
  2042. else do                         /* using user set slide */
  2043.   do mm=0 to slide.0
  2044.      aslide.mm=slide.mm        
  2045.   end /* do */
  2046. end
  2047.  
  2048. /* we now have base slide (from file or from use set); now expand/shrink to fit mx */
  2049. slide.0=mx
  2050. /* if slide > mx, then pick from slide */
  2051. if jx>mx & atype<>'T' then do
  2052.    slide.1=aslide.1 
  2053.    slide.mx=aslide.jx 
  2054.  
  2055.    do ll=2 to mx-1
  2056.        tt=(ll-1)/(mx-1)
  2057.        itt=1+trunc(tt*(jx-1))
  2058.        slide.ll=aslide.itt 
  2059.    end /* do */
  2060.    return 1
  2061. end  /* Do */
  2062.  
  2063. /* slide < mx, need to expand it */
  2064. if atype='T' then do            /* tile it, both cases (jx> or < mx)  */
  2065.     ii=0
  2066.     do mm=1 to mx
  2067.        ii=ii+1
  2068.        if ii>jx then ii=1
  2069.        slide.mm=aslide.ii 
  2070.     end /* do */
  2071.     return 1
  2072. end  /* Do */
  2073.  
  2074. /* fit (internal repeat */
  2075.    slide.1=aslide.1 
  2076.    slide.mx=aslide.jx 
  2077.    do ll=2 to mx-1
  2078.        tt=(ll-1)/(mx-1)
  2079.        itt=1+trunc(tt*(jx-1))
  2080.        slide.ll=aslide.itt 
  2081.    end /* do */
  2082.    return 1
  2083.  
  2084. /***********/
  2085. /* squared distance */
  2086. figdist:procedure expose sqs. figdist_type
  2087. parse arg ax,ay,cx,cy
  2088. dx=ax-cx ; dy=ay-cy 
  2089.  
  2090. /* which "distance" type to use */
  2091.  
  2092. if figdist_type=4 then return max(abs(dx),abs(dy))  /* longest axis */
  2093.  
  2094. if figdist_type=2 then  return (abs(dx)+abs(dy))  /* right angle grid steps */
  2095.  
  2096. if figdist_type=3 then do               /* modified right angle */
  2097.    a1=max(abs(dx),abs(dy))
  2098.    a2=min(abs(dx),abs(dy))/2
  2099.    return (a1+(a2/2))
  2100. end /* do */
  2101.  
  2102. /* else, use euclidean */
  2103.  
  2104.  
  2105. AAS=( (dx*dx)+(dy*dy))
  2106.  
  2107. IF sqs.!got<>0 THEN DO      /* YUCK, USE A NUMERIC SEARCH */
  2108.     AAS2=SQRT2(AAS)
  2109. end /* do */
  2110. ELSE DO
  2111.    AAS2=SQRT(AAS)
  2112. END
  2113. RETURN AAS2
  2114.  
  2115. /********************/
  2116. /*  a square root finder */
  2117. sqrt2:procedure
  2118. parse arg aval
  2119.  
  2120. if aval<=1 then return aval  
  2121.  
  2122. /* do a binary search */
  2123.  
  2124. i1=1 ;i11=1;
  2125. i3=100 ; i33=10000
  2126. do until i33>aval | i3=10000000
  2127.   i3=i3*5
  2128.   i33=i3*i3
  2129. end /* do */
  2130. i2=i3/2 ; i22=i2*i2
  2131.  
  2132. do forever
  2133. if aval=i22 then return i2  /* an exact match */
  2134. oldi2=i2
  2135. if aval <i22 then do
  2136.    i3=i2; i33=i22
  2137.    i2=i1+((i3-i1)/2) ; i22=i2*i2
  2138. end
  2139. else do
  2140.    i1=i2 ; i11=i22 ;
  2141.    i2=i1+((i3-i1)/2) ; i22=i2*i2
  2142. end /* do */
  2143. if abs(oldi2-i2)<0.01 then return i2
  2144. end
  2145.  
  2146.  
  2147. /***********************************/
  2148. /* add slide's color table to messim */
  2149. add_slide_ct:procedure expose slidect. verbose is_cgi
  2150. parse arg mim
  2151. ist=rxgdimagegettransparent(mim)
  2152. usepre=0
  2153. do jj=0 to slidect.0-1
  2154.    r=slidect.!r.jj ; g=slidect.!g.jj ; b=slidect.!b.jj
  2155.    oo=rxgdimagecolorexact(mim,r,g,b)  /* check if color already exists */
  2156.    if oo=-1 | oo=ist then do             /*no exact match, or match transparent  */
  2157.       aa=rxgdimagecolorallocate(mim,r,g,b)  /* add this color */
  2158.       if aa>-1  then do          /* success */
  2159.            slidect.!alt.jj=aa
  2160.       end  /* Do */
  2161.       else do           /* no more colors, use closest */
  2162.          slidect.!alt.jj=rxgdimagecolorclosest(mim,r,g,b)
  2163.          usepre=usepre+1
  2164.       end
  2165.    end  /* Do */
  2166.    else do
  2167.        slidect.!alt.jj=oo              /* use prexisting color */
  2168.    end
  2169. end /* do */
  2170. if usepre>0 & verbose>1  then call gpmprintf(' GIF_TEXT: too many colors, had to share for 'usepre)
  2171.  
  2172. return 1
  2173.  
  2174.  
  2175.  
  2176.  
  2177. /***********************************/
  2178.  
  2179. /* determine a user scale, given ith of Ilen position, and 
  2180.    list of "user_scales". We assume user_scales is a space delimited list
  2181.   of numbers, with 1="use current size", >1 means larger, <1 means smaller */
  2182.  
  2183. get_user_scale:procedure expose is_cgi
  2184. parse arg ith,ilen,user_scales
  2185. if user_scales="" then return 1
  2186.  
  2187. igoo=words(user_scales)
  2188.  
  2189. if ith=1 then return word(user_scales,1)
  2190.  
  2191. if ith=ilen then return word(user_scales,igoo)
  2192.  
  2193. /* middle characters*/
  2194. frac=(ith-1)/(ilen-1)    /* where in scale list is it */
  2195. spot=1+ ((igoo-1)*frac)
  2196. ifrac=trunc(spot)
  2197. afrac=spot-ifrac
  2198.  
  2199. if afrac=0 then return word(user_scales,ifrac)
  2200.  
  2201. ii=ifrac+1
  2202. a1=word(user_scales,ii)
  2203. a2=word(user_scales,ifrac)
  2204.  
  2205. diff=a1-a2
  2206. return (a2+(diff*afrac))
  2207.  
  2208.  
  2209. /*****************/
  2210. create_ttf_gif:procedure expose red_text green_text blue_text ,
  2211.                          red_back green_back blue_back backcolor 
  2212.  
  2213. parse arg message,ttfont,psize
  2214.  
  2215. rc = rxttf_image(message,ttfont,psize, data)
  2216. /* Check for an error */
  2217. if rc<>0 then do
  2218.     say "Error in rxttf_image: "rc
  2219.     exit
  2220. end /* do */
  2221.  
  2222. /* create the gif */
  2223. MCOLS=data.!cols ; MROWS=data.!rows
  2224. im=rxgdimagecreate(MCOLS,MROWS)
  2225. transparent=0
  2226. call rxgdimagecolortransparent im,transparent
  2227.  
  2228. oy=rxgdimagecolorallocate(im,red_back,green_back,blue_back)
  2229. text_color=rxgdimagecolorallocate(im,red_text,green_text,blue_text)
  2230.  
  2231. do ir=0 to data.!rows-1
  2232.   aline=translate(data.ir,'01','0001'x)
  2233.   do ic=1 to MCOLS
  2234.       pxels.ic=substr(aline,ic,1)
  2235.   end /* do */
  2236.   styled  = RxgdImageSetStyle(im, pxels, data.!cols)         /* write transformed row back to */
  2237.   rc = RxgdImageLine(im, 0,ir,MCOLS-1,ir,styled)        /*  the message image */
  2238. end /* do */
  2239.  
  2240. return im
  2241.  
  2242.  
  2243.  
  2244. /***********************************/
  2245. /* get the gif name, using several naming tricks */
  2246. get_gifname:procedure expose font_ind. is_cgi
  2247.  
  2248. parse arg achar,gif_dir,fontname
  2249.  
  2250. if length(achar)>1 then achar=translate(achar)
  2251. /* check index first */
  2252. do iu=1 to font_ind.0
  2253.    if font_ind.iu=achar then do 
  2254.         cl=gif_dir||font_ind.iu.!file
  2255.         if stream(cl,'c','query exists')<>' ' then  return cl
  2256.         leave
  2257.    end  /* Do */
  2258. end /* do */
  2259. if length(achar)>1 then return ' '  /* special character not found */
  2260.  
  2261.  
  2262. /* is it a valid file name (i.e.; don't look for *.gif*/
  2263. if pos(translate(achar),'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$%#&@!~-&^')=0 then RETURN ' '
  2264.  
  2265. /* it is lowerr case: look for xlc.gif? */
  2266.  
  2267. if translate(achar)<>achar then do
  2268.    cl=gif_dir||achar||'lc.gif'
  2269.    if stream(cl,'c','query exists')<>' ' then  return cl
  2270.    cl=gif_dir||fontname||achar||'lc.gif'
  2271.    if stream(cl,'c','query exists')<>' ' then  return cl
  2272.    cl=gif_dir||fontname||'-'||achar||'lc.gif'
  2273.    if stream(cl,'c','query exists')<>' ' then  return cl
  2274.  
  2275. end  /* Do */
  2276.  
  2277. /* try generic name: look for x.gif? */
  2278. cl=gif_dir||achar||'.gif'
  2279. if stream(cl,'c','query exists')<>' ' then  return cl
  2280. cl=gif_dir||fontname||achar||'.gif'
  2281. if stream(cl,'c','query exists')<>' ' then  return cl
  2282. cl=gif_dir||fontname||'-'||achar||'.gif'
  2283. if stream(cl,'c','query exists')<>' ' then  return cl
  2284. cl=gif_dir||achar||fontname||'.gif'
  2285. if stream(cl,'c','query exists')<>' ' then  return cl
  2286.  
  2287. return ' '
  2288.  
  2289.  
  2290.  
  2291. /******/
  2292. /* check for valid 0-255 value, set to def if not */
  2293. check_byte:procedure
  2294. parse arg aval,adef
  2295. if adef=' ' then adef=0
  2296. if datatype(aval)<>'NUM' then return adef
  2297. if aval<0 | aval>255  then return adef
  2298. return aval
  2299.  
  2300.  
  2301.  
  2302. /*******/
  2303. /* read a font index file into font_ind. */
  2304. read_font_index:procedure expose font_ind.  gif_dir  def_transparent def_textcolor def_backcolor is_cgi
  2305. parse arg afile
  2306.  
  2307. defgifs=' '; xoffset=0 ; yoffset=0 ; inrow=16 ; hchar=47  ; wchar=35 ;isbw=1
  2308. charset=' !"'||"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
  2309. leftoffset=0;rightoffset=0;topoffset=0;bottomoffset=0
  2310. transparent="" ; manytype=1
  2311. x_user_scales='' ; y_user_scales="" ;y_valign=' ' ;slide='' ;  slide_horiz=''
  2312. slide_thresh='P1' ; slide_vert=''
  2313. slide_size=""  ; textcolor="" ; backcolor="" ; slide_prob=''
  2314.  
  2315. font_ind.0=0
  2316. font_ind.!defgifs=defgifs
  2317. font_ind.!xoffset=xoffset
  2318. font_ind.!yoffset=yoffset
  2319. font_ind.!topoffset=topoffset
  2320. font_ind.!bottomoffset=bottomoffset
  2321. font_ind.!rightoffset=rightoffset
  2322. font_ind.!leftoffset=leftoffset
  2323. font_ind.!inrow=inrow
  2324. font_ind.!hchar=hchar
  2325. font_ind.!wchar=wchar
  2326. font_ind.!isbw=isbw
  2327. font_ind.!charset=charset
  2328. font_ind.!manytype=1
  2329. font_ind.!x_user_scales=''
  2330. font_ind.!y_user_scales=''
  2331. font_ind.!y_valign=''
  2332. font_ind.!slide=''
  2333. font_ind.!slide_horiz=''
  2334. font_ind.!slide_vert=''
  2335. font_ind.!slide_thresh=''
  2336. font_ind.!transparent=def_transparent
  2337. font_ind.!textcolor=def_textcolor
  2338. font_ind.!backcolor=def_backcolor
  2339. font_ind.!slide_size=0
  2340. font_ind.!slide_coord=''
  2341. font_ind.!slide_blue=''
  2342. font_ind.!slide_red=''
  2343. font_ind.!slide_green=''
  2344. font_ind.!slide_prob=""
  2345.  
  2346. if afile=' ' then return 0
  2347. ii=0
  2348. if stream(afile,'c','query exists')=' ' then return 0
  2349. do until lines(afile)=0
  2350.   ii=ii+1
  2351.   tmp.ii=linein(afile)
  2352. end
  2353. tmp.0=ii
  2354. foo=stream(afile,'c','close')
  2355.  
  2356. iin=0
  2357. do mm=1 to tmp.0
  2358.    aline=strip(tmp.mm)
  2359.    if aline=' ' then iterate
  2360.    if abbrev(aline,'**')=1 then iterate  /* comment */
  2361.    athing=' '
  2362.    if pos('=',aline)<>0 then do
  2363.        parse var aline athing '=' stuff ; athing=strip(translate(athing))
  2364.    end  /* Do */
  2365.    select
  2366.      when abbrev(athing,'DEFAUL')+ABBREV(ATHING,'COMPLET')>0 then  defgifs=defgifs||' '||strip(stuff)
  2367.      when athing='DEF_OFFSET' then do
  2368.              stuff=translate(stuff,' ',',')
  2369.              parse var stuff a1 a2
  2370.              if datatype(a1)='NUM'  then xoffset=a1
  2371.              if datatype(a2)='NUM'  then yoffset=a2
  2372.      end
  2373.      when abbrev(athing,'DEF_CHAR_OF')+abbrev(athing,'DEFCHAROF')>0 then do
  2374.              stuff=translate(stuff,' ',',')            
  2375.              parse var stuff a1 a2 a3 a4                    
  2376.              if datatype(a1)='NUM'  then leftoffset=a1    
  2377.              if datatype(a2)='NUM'  then topoffset=a2    
  2378.              if datatype(a3)='NUM'  then rightoffset=a3    
  2379.              if datatype(a4)='NUM'  then bottomoffset=a4    
  2380.      end  /* Do */
  2381.      when abbrev(athing,'DEF_TR')+abbrev(athing,'TRAN')>0 then do
  2382.            if datatype(stuff)='NUM'  then transparent=stuff
  2383.      end
  2384.  
  2385.      when abbrev(athing,'DEF_TEXTC')+abbrev(athing,'TEXT')>0 then do
  2386.         if verify(stuff,'0123456789ABCDEFabcdef#')=0 then  textcolor=stuff
  2387.      end
  2388.  
  2389.      when abbrev(athing,'DEF_BACKC')+abbrev(athing,'BACK')>0 then do
  2390.         if verify(stuff,'0123456789ABCDEFabcdef#')=0 then  backcolor=stuff
  2391.      end
  2392.  
  2393.      when athing='DEF_CHARSIZE' then do
  2394.              stuff=translate(stuff,' ',',')
  2395.              parse var stuff a1 a2
  2396.              if datatype(a1)='NUM'  then wchar=a1
  2397.              if datatype(a2)='NUM'  then hchar=a2
  2398.      end  /* Do */
  2399.      when athing='DEF_CHARS' then charset=stuff
  2400.      when athing='DEF_BW' then isbw=pos(strip(translate(stuff)),'Y YES 1')
  2401.      when abbrev(athing,"MANY_D")+abbrev(athing,'MANYD')+ ,
  2402.           abbrev(athing,"MANY_C")+abbrev(athing,'MANYC')>0 then do
  2403.        manytype=wordpos(translate(stuff),'CYCLE FIT END RANDOM ')
  2404.        if manytype=0 then manytype=1
  2405.      end
  2406.      when athing='DEF_INROW' then
  2407.               if datatype(strip(stuff))='NUM' then inrow=strip(stuff)
  2408.      when athing='CHAR' then do
  2409.       parse var stuff aval afile
  2410.       if datatype(aval)<>'NUM' then iterate /* error- ignoe */
  2411.       if aval<0  | aval>99 then iterate /* out of range, ignore */
  2412.       aval=strip(aval,'l','0')
  2413.       font_ind.!chars.aval=strip(afile)
  2414.       iterate
  2415.      end
  2416.      when abbrev(athing,"X_SC")+abbrev(athing,'XSC')>0 then
  2417.         x_user_scales=stuff
  2418.      when abbrev(athing,"Y_SC")+abbrev(athing,'YSC')>0 then
  2419.         y_user_scales=stuff
  2420.      when abbrev(athing,'VAL')+abbrev(athing,'Y_VAL')>0 then
  2421.         y_valign=stuff
  2422.      when abbrev(athing,'SLIDE_H')>0 then
  2423.         slide_horiz=packur2(stuff)
  2424.      when abbrev(athing,'SLIDE_V')>0 then
  2425.         slide_vert=packur2(stuff)
  2426.      when abbrev(athing,'SLIDE_T')>0 then
  2427.         slide_thresh=packur2(stuff)
  2428.      when abbrev(athing,'SLIDE_F')>0 | athing='SLIDE' then do
  2429.         slide=packur2(stuff)
  2430.         if pos(':',slide)+pos('\',slide)=0 then
  2431.            slide=gif_dir||slide
  2432.      end
  2433.      when abbrev(athing,'SLIDE_R')>0 then
  2434.         slide_red=packur2(stuff)
  2435.      when abbrev(athing,'SLIDE_G')>0 then
  2436.         slide_green=packur2(stuff)
  2437.      when abbrev(athing,'SLIDE_B')>0 then
  2438.         slide_blue=packur2(stuff)
  2439.      when abbrev(athing,'SLIDE_C')>0 then
  2440.         slide_coord=packur2(stuff)
  2441.      when abbrev(athing,'SLIDE_P')>0 then
  2442.         slide_prob=packur2(stuff)
  2443.      when abbrev(athing,'SLIDE_S')>0 then do
  2444.          tt=packur2(stuff)
  2445.          if datatype(tt)='NUM' then slide_size=tt
  2446.      end  /* Do */
  2447.      when abbrev(aline,'##')>0 then do  /* it's an ascii value to file map */
  2448.         parse var aline '##' iichar afile
  2449.         iichar=strip(iichar)
  2450.         if right(iichar,1)='x' | right(iichar,1)='h' then do
  2451.             iichar=left(iichar,length(iichar)-1)
  2452.             iichar=x2d(iichar)
  2453.         end /* do */
  2454.         if datatype(iichar)='NUM' then do
  2455.            iin=iin+1
  2456.            font_ind.iin=d2c(iichar)   ; font_ind.iin.!file=strip(afile)
  2457.         end
  2458.      end /* do */
  2459.      otherwise do               /* it's a charater to file map */
  2460.         parse var tmp.mm achar afile
  2461.         if length(achar)>1 then achar=translate(achar)
  2462.         iin=iin+1
  2463.         font_ind.iin=strip(achar)   ; font_ind.iin.!file=strip(afile)
  2464.      end
  2465.    end
  2466. end /* do */
  2467.  
  2468.  
  2469.  
  2470. if isbw>0 then isbw=1
  2471. font_ind.!defgifs=defgifs
  2472. font_ind.!xoffset=xoffset
  2473. font_ind.!yoffset=yoffset
  2474.  
  2475. font_ind.!topoffset=topoffset
  2476. font_ind.!bottomoffset=bottomoffset
  2477. font_ind.!rightoffset=rightoffset
  2478. font_ind.!leftoffset=leftoffset
  2479.  
  2480. font_ind.!inrow=inrow
  2481. font_ind.!hchar=hchar
  2482. font_ind.!wchar=wchar
  2483. font_ind.!isbw=isbw
  2484. font_ind.!charset=charset
  2485. font_ind.!transparent=transparent 
  2486. font_ind.!manytype=manytype
  2487. font_ind.!x_user_scale=x_user_scales
  2488. font_ind.!y_user_scale=y_user_scales
  2489. font_ind.!y_valign=y_valign
  2490. font_ind.!slide=slide
  2491. font_ind.!slide_horiz=slide_horiz
  2492. font_ind.!slide_thresh=slide_thresh
  2493. font_ind.!slide_vert=slide_vert
  2494. font_ind.!textcolor=textcolor
  2495. font_ind.!backcolor=backcolor
  2496.  
  2497. font_ind.!slide_size=slide_size
  2498. font_ind.!slide_red=slide_red
  2499. font_ind.!slide_green=slide_green
  2500. font_ind.!slide_blue=slide_blue
  2501. font_ind.!slide_coord=slide_coord
  2502. font_ind.!slide_prob=slide_prob
  2503.  
  2504. font_ind.0=iin
  2505.  
  2506. return iin
  2507.  
  2508. /**********/
  2509. /* fIX A user scale entry */
  2510. fix_scale:procedure
  2511. parse arg ascale
  2512. if ascale=0 then return 1
  2513. ascale=translate(ascale,' ','+')
  2514. tt=''
  2515. do mm=1 to words(ascale)
  2516.    av=strip(word(ascale,mm))
  2517.    if datatype(av)<>'NUM' then  iterate
  2518.    tt=tt' 'av
  2519. end  /* Do */
  2520.  
  2521. return tt
  2522.  
  2523.  
  2524.  
  2525. /**************************/
  2526. /* convert ff21b3 "hex" color code to decimal r g b values
  2527.   If bad value, return ' /' */
  2528. get_from_hex:procedure
  2529. parse arg hval
  2530.  
  2531. hval=strip(strip(hval),,'"')
  2532. hval=strip(hval,,'#')
  2533. select 
  2534.   when length(hval)<>6 then return ' '
  2535.   when verify(translate(hval),'0123456789ABCDEF')>0 then return ' '
  2536.   otherwise do
  2537.     a1=left(hval,2)
  2538.     a2=substr(hval,3,2)
  2539.     a3=substr(hval,5,2)
  2540.     r=x2d(a1)
  2541.     g=x2d(a2)
  2542.     b=x2d(a3)
  2543.   end
  2544. end /* do */
  2545. return r ' ' g ' ' b
  2546.  
  2547.  
  2548. /********************/
  2549. /* return time, using REXX time_fmt. Also, special code: 1 - C without am or pm */
  2550. get_time:procedure
  2551. parse arg tfmt
  2552.  
  2553. if pos(tfmt,'CHLMNS1')=0 then tfmt='N'
  2554. if tfmt='1' then do
  2555.   aa=time('C')
  2556.   a2=translate(right(aa,2))
  2557.   oof=2
  2558.   if a2="AM" then oof=1         /* reserved special character: 1=am, 2=pm */
  2559.   return left(aa,length(aa)-2)||d2c(oof)
  2560. end
  2561. return time(tfmt)
  2562.  
  2563. /********************/
  2564. /* return time, using REXX time_fmt */
  2565. get_date:procedure
  2566. parse arg tfmt
  2567.  
  2568. if pos(tfmt,'BDELMNOSUW')=0 then tfmt='N'
  2569.  
  2570. return date(tfmt)
  2571.  
  2572.  
  2573. /************************************************/
  2574. /* procedure from TEST-CGI.CMD by  Frankie Fan <kfan@netcom.com>  7/11/94 */
  2575. DecodeKeyVal: procedure
  2576.   parse arg Code
  2577.   Text=''
  2578.   Code=translate(Code, ' ', '+')
  2579.   rest='%'
  2580.   do while (rest\='')
  2581.      Parse var Code T '%' rest
  2582.      Text=Text || T
  2583.      if (rest\='' ) then
  2584.       do
  2585.         ch = left( rest,2)
  2586.         if verify(ch,'01234567890ABCDEF')=0 then
  2587.            c=X2C(ch)
  2588.         else
  2589.            c=ch
  2590.         Text=Text || c
  2591.         Code=substr( rest, 3)
  2592.       end
  2593.   end
  2594.   return Text
  2595.  
  2596. /*********/
  2597. packur2:procedure expose is_cgi
  2598. parse arg a1b0
  2599.  
  2600. if is_cgi=0 then
  2601.    return packur(translate(a1b0,' ','+'))
  2602. else
  2603.    return decodekeyval(translate(a1b0,' ','+'))
  2604.  
  2605. /************/
  2606. wow1:
  2607. call gpmprintf(" GIF_TEXT error at line "sigl' 'rc)
  2608.       if is_cgi=0 then do
  2609.          'NODATA'
  2610.          exit '400 0'
  2611.       end
  2612.       else do
  2613.            exit 
  2614.       end /* do */
  2615.  
  2616.  
  2617. /***********************/
  2618. /* see if an alphabyte specific default is available */
  2619. get_default_char:procedure expose font_ind. verbose dim. red_back green_back blue_back ,
  2620.                         red_text green_text blue_text is_cgi
  2621. parse arg achar,ithchar,mlen,manymax
  2622.  
  2623. if font_ind.!ndims=0 then return 1
  2624. ikk=1
  2625. nfonts=font_ind.!ndims
  2626. if manymax>0 & manymax<nfonts then nfonts=manymax
  2627. if nfonts>1 then do
  2628.   select
  2629.      when font_ind.!manytype=1 then do  /* cycle */
  2630.        ikk=ithchar//nfonts
  2631.        if ikk=0 then ikk=nfonts
  2632.      end
  2633.      when font_ind.!manytype=3 then do   /* end */
  2634.         ikk=min(nfonts,ithchar)
  2635.      end  /* Do */
  2636.      when font_ind.!manytype=4 then do  /* random */
  2637.         ikk=random(1,nfonts)
  2638.      end
  2639.      otherwise    do      /* fit */
  2640.         ikk=1+trunc(nfonts*ithchar/(mlen+0.1))
  2641.      end
  2642.   end
  2643. end
  2644. ic=pos(achar,font_ind.!charset)
  2645. if ic=0 then do
  2646.   achar=translate(achar)
  2647.   ic=pos(achar,font_ind.!charset)
  2648. end
  2649. if ic=0 then return 1
  2650.  
  2651. /* for each character in the charset ... */
  2652. /* determine x offset: */
  2653.    irow=1+((ic-0.1)%font_ind.!inrow)
  2654.    icol=ic-((irow-1)*font_ind.!inrow)
  2655.  
  2656. /* upper left is 0,0 */
  2657.    xat=font_ind.!xoffset + ((icol-1)*font_ind.!wchar)+font_ind.!leftoffset
  2658.    yat=font_ind.!yoffset+ ((irow-1)*font_ind.!hchar)+font_ind.!topoffset
  2659.    jx=font_ind.!wchar-(font_ind.!leftoffset+font_ind.!rightoffset)
  2660.    jy=font_ind.!hchar-(font_ind.!bottomoffset+font_ind.!topoffset)
  2661.    cim=rxgdimagecreate(jx,jy)
  2662.    if font_ind.!isbw=0 then do  /* use colors as is, but include back text colors */
  2663.       oy1=rxgdimagecolorallocate(cim,red_back,green_back,blue_back)
  2664.       oy2=rxgdimagecolorallocate(cim,red_text,green_text,blue_text)
  2665.    end
  2666.  
  2667.    tdim=dim.ikk         /* use the ikk (of possible many_complete) complete font */
  2668.    foo=rxgdimagecopy(cim,tdim,0,0,xat,yat,jx,jy)
  2669.    if font_ind.!isbw=1 then do   /* convert b/w to back/text colors */
  2670.        ww=rxgdimagegettransparent(cim)
  2671.       foo=rxgdimagecolordeallocate(cim,0)
  2672.       oy1=rxgdimagecolorallocate(cim,red_back,green_back,blue_back)
  2673.       foo=rxgdimagecolordeallocate(cim,1)
  2674.       oy2=rxgdimagecolorallocate(cim,red_text,green_text,blue_text)
  2675.    end
  2676.  
  2677.    return cim
  2678.  
  2679.  
  2680. /*********************************/
  2681. /* return r g b of aim at ctable ival */
  2682. three_color:procedure
  2683. parse arg aim,ctable
  2684. r=rxgdimagered(aim,ctable)
  2685. g=rxgdimagegreen(aim,ctable)
  2686. b=rxgdimageblue(aim,ctable)
  2687. return r g b
  2688.  
  2689. /*********************************/
  2690. /* stand alone mode -- build the "list " */
  2691. ask_values:procedure expose gfile2 gif_dir_root cy_ye normal bold re_wh reverse 
  2692.  
  2693. SIGNAL OFF  ERROR ; SIGNAL OFF SYNTAX
  2694. SIGNAL ON ERROR NAME ASKV 
  2695.  SIGNAL ON SYNTAX NAME ASKV 
  2696.  
  2697. ansion=checkansi()
  2698. if ansion=1 then do
  2699.   aesc='1B'x
  2700.   cy_ye=aesc||'[37;46;m'
  2701.   normal=aesc||'[0;m'
  2702.   bold=aesc||'[1;m'
  2703.   re_wh=aesc||'[31;47;m'
  2704.   reverse=aesc||'[7;m'
  2705. end
  2706. else do
  2707.   say " Warning: Could not detect ANSI....  output will look ugly ! "
  2708.   cy_ye="" ; normal="" ; bold="" ;re_wh="" ;
  2709.   reverse=""
  2710. end  /* Do */
  2711.  
  2712. cls
  2713. say  " " ; say
  2714.  
  2715. call lineout, bold cy_ye
  2716. call lineout, " GIF_TEXT (ver 1.3a): a text-to-gif utility -- command line mode "
  2717. call lineout, normal
  2718.  
  2719.  
  2720. say " Although designed primarily as a WWW script, you can use GIF_TEXT "
  2721. say " to create .GIF files in a stand-alone mode."
  2722. say
  2723. say "      "||cy_ye||"GIF_TEXT does not have graphics display capability    " normal
  2724. say "      "||cy_ye||" ... but you can invoke your browser (or other graphics " normal
  2725. say "      "||cy_ye||"     graphics) to view .GIF files generated by GIF_text.." normal
  2726. say "  "
  2727.  
  2728. if yesno(" Are you ready to continue ")=1 then
  2729.  nop
  2730. else do
  2731.  say " See you later?.. "
  2732.  exit
  2733. end
  2734.  
  2735. /* try reading in prior answers file */
  2736. priora=""
  2737. if stream('GIF_TEXT.ANS','c','query exists')<>"" then do
  2738. say 
  2739.    say bold ' ... reading prior options from GIF_TEXT.ANS'  normal
  2740.    priora=charin('GIF_TEXT.ANS',1,chars('GIF_TEXT.ANS'))
  2741.    foo=stream('GIF_TEXT.ANS','c','close')
  2742. end /* do */
  2743. def.!font="?"; def.!backgrnd="?";def.!colorslide='?'
  2744. def.!width=0 ; def.!height=0
  2745. def.!moreopts='?'
  2746. def.!message='hello'
  2747. def.!outgfile='foo.gif'
  2748. asep='|^&^|'
  2749.  
  2750. do until priora=""
  2751.    parse var priora a1 '|^&^|' priora
  2752.    parse var a1 a1a '=' a1b
  2753.    a2='!'||strip(translate(a1a))
  2754.    def.a2=a1b
  2755. end /* do */
  2756.  
  2757. say
  2758.  
  2759. if stream('GIF_TEXT.DOC','c','query exists')<>'' then do
  2760.      ii=yesno(normal"      "bold"Would you like to view GIF_TEXT.DOC ?"normal,,'N')
  2761.      if ii=1 then
  2762.           '@START  "The GIF_text Manual" /C /F /WIN E GIF_TEXT.DOC'
  2763.     ELSE
  2764.         say" On the other hand, you can always learn by making misteaks .... "
  2765. end
  2766. ELSE DO
  2767.    say " We recommend reading the documentation (GIF_TEXT.DOC) before "
  2768.    say " running this program. "
  2769.  end /* do */
  2770.  
  2771. say
  2772. whatfont:
  2773. call charout , "What "reverse "alphabyte font "normal" do you want to use (?=list,ENTER="def.!font"):"
  2774. pull font
  2775. if font=""  then font=def.!font
  2776.  
  2777. if font="?" then do
  2778.    say 
  2779.     say reverse ' List of alphabytes & fonts ' normal
  2780.     do while queued()>0
  2781.         pull .
  2782.     end /* do */
  2783.     oog=sysfiletree(gif_dir_root'*.*',qlist,'DO')
  2784.     foo=show_dir_queue(1)
  2785.     signal whatfont
  2786. end  /* Do */
  2787. if pos('\',whatfont)+pos(':',font)<>1  then do
  2788.      yoob=gif_dir_root||font
  2789.      wow=sysfiletree(yoob'\*.*',geeks)
  2790.      if geeks.0=0  then do
  2791.              say bold " ** Could not find directory for: " normal font
  2792.              signal whatfont
  2793.      end /* do */
  2794. end /* do */
  2795.  
  2796.  
  2797. say
  2798. getbACK:
  2799. call charout , bold"Background file (0=None, ?=list, Enter="def.!backgrnd"):" normal
  2800. pull backgrnd
  2801. if backgrnd='' then backgrnd=def.!backgrnd
  2802. if backgrnd="?" then do
  2803.     say 
  2804.     say reverse ' List of background files in: ' normal bold gif_dir_root'BACKS' normal
  2805.     do while queued()>0
  2806.         pull .
  2807.     end /* do */
  2808.     '@DIR /b  '||gif_dir_root||'BACKS\*.gif | rxqueue'
  2809.     foo=show_dir_queue('.GIF')
  2810.     signal getback
  2811. end
  2812. if pos('\',backgrnd)+pos(':',backgrnd)=0  & backgrnd<>0 then do
  2813.   backgrnd='BACKS\'||backgrnd
  2814.   if stream(gif_dir_root||backgrnd||'.gif','c','query exists')='' then do
  2815.       say " Could not find background file: " backgrnd
  2816.       signal getback
  2817.   end /* do */
  2818. end
  2819.  
  2820. say
  2821. getslide:
  2822. colorslide=0
  2823. call charout , bold"Color slide (0=None, ?=list, ENTER="def.!colorslide"):" normal
  2824. pull colorslide
  2825. if colorslide=''  then colorslide=def.!colorslide
  2826. if colorslide="?" then do
  2827.     say 
  2828.     say reverse ' List of color slides files in: ' normal bold gif_dir_root'SLIDES' normal
  2829.     do while queued()>0
  2830.         pull .
  2831.     end /* do */
  2832.     '@DIR /b  '||gif_dir_root||'SLIDES\*.gif | rxqueue'
  2833.     foo=show_dir_queue('.GIF')
  2834.     signal getslide
  2835. end
  2836. if pos('\',colorslide)+pos(':',colorslide)=0  & colorslide<>0 then do
  2837.   colorslide='slides\'||colorslide
  2838.   if stream(gif_dir_root||colorslide||'.gif','c','query exists')='' then do
  2839.       say " Could not find color slide file: " colorslide
  2840.       signal getslide
  2841.   end /* do */
  2842. end
  2843.  
  2844.  
  2845. say
  2846. getht:
  2847. call charout , bold"Height (in pixels), 0=automatic, ENTER="def.!height": "normal
  2848. pull height
  2849. if height="" then height=def.!height
  2850. if datatype(height)<>'NUM' then signal getht
  2851.  
  2852. getwt:
  2853. call charout , bold "Width (in pixels), 0=automatic ENTER="def.!width": "normal
  2854. pull width
  2855. if width="" then width=def.!width
  2856. if datatype(width)<>'NUM' then signal getwt
  2857.  
  2858.  
  2859. amess:
  2860. Say
  2861. Say bold "Enter your message " normal" ($d=date, $t=time, $n=newline, $f(fontname)=font switch "
  2862. say bold "   (ENTER=" normal reverse Def.!message normal bold ")" normal
  2863. call charout ,bold "The message:"normal
  2864. parse pull adesc
  2865. if adesc='' then adesc=def.!Message
  2866. adesc=a_replacestrg(adesc,'&','%26;','ALL')
  2867. message=translate(adesc,'+',' ')
  2868.  
  2869. get_opts:
  2870. say
  2871. say "Additional options (0=none,? for help, * xx = add xx to prior options "
  2872. say" ENTER=prior options=" bold def.!moreopts  normal
  2873. call charout, bold " ? " normal
  2874. pull moreopts
  2875. if moreopts='' then moreopts=def.!Moreopts
  2876.  
  2877. moreopts=a_replacestrg(moreopts,'*',def.!Moreopts,'ALL')
  2878. if strip(moreopts)=0 then moreopts=''
  2879. if moreopts<>'?' then say " Using options: " moreopts
  2880.  
  2881. if moreopts='?' then do
  2882.  call show_other_opts
  2883.  signal get_opts
  2884. end
  2885. moreopts=translate(moreopts,'&',' ')
  2886.  
  2887. /* now make a list */
  2888.  
  2889. list="font="||font||'&text='||message||'&height='||height||'&width='||width
  2890. list=list||'&back='||backgrnd||'&slide='||colorslide
  2891. if moreopts<>'' then list=list||'&'||moreopts
  2892.  
  2893. getgfile2:
  2894. Say
  2895. call charout,bold"Enter output file name (ENTER="def.!outgfile"):"normal
  2896. pull gfile2
  2897. if gfile2="" then gfile2=def.!outgfile
  2898. if gfile2="" then signal getgfile2
  2899. gfile0=stream(gfile2,'c','query exists')
  2900. if gfile0<>"" then do
  2901.     call charout,Gfile0 ' exists. Overwrite (Y/N)'
  2902.     pull anans
  2903.     if abbrev(strip(anans),'Y')<>1 then signal getgfile2
  2904. end /* do */
  2905. outgfile=gfile2
  2906.  
  2907. say
  2908. say " saving answers to GIF_TEXT.ANS "
  2909.  
  2910.  
  2911.  
  2912. aa='WIDTH='width||asep||'HEIGHT='height||asep||'FONT='font||asep
  2913. aa=aa||'BACKGRND='backgrnd||asep||'COLORSLIDE='colorslide||asep
  2914. aa=aa||'OUTGFILE='outgfile||asep||'MOREOPTS='Moreopts||asep
  2915. aa=aa||'MESSAGE='message||asep
  2916. foo=charout('GIF_TEXT.ANS',aa,1)
  2917. foo=stream('GIF_TEXT.ANS','c','close')
  2918.  
  2919. say " creating the image ..... "
  2920. return list  /* gfile2 is exposed */
  2921.  
  2922.  
  2923. ASKV:
  2924. SAY "Sorry, you made a goof.  Try again " sigl
  2925. exit
  2926.  
  2927.  
  2928. /*********/
  2929. show_other_opts:
  2930. say 
  2931. say '                      'cy_ye 'More commonly used options. 'normal 
  2932. say bold' TIME_FMT,DATE_FMT'normal':Time&date format. timefmt=p (LNHSCM1), datefmt=p (NDEMBOSUW)' 
  2933. say bold' BACK_SCALE:'normal' background display. back_scale=0/1 ; 1=scale, 0=tile '
  2934. say bold' X_F, Y_F:'normal' Frame size (left & right, top  & bottom), in pixels. x_f=n y_f=n'
  2935. say bold' X_OF, Y_OF:'normal' Extra X, and Y, offset (to right,to bottom). x_of=n y_of=n '
  2936. say bold' X_SCA,Y_SCA:'normal'Width&height scales: X_SCA=v+v  Y_SCA=v+v..(v<1:shrink, >1:enlarge'
  2937. say bold'      Y_VAL:'normal' Type of vertical alignment: Y_VAL=p ; p=TMB '
  2938. say bold'     LINE_J:'normal' Horizontal justifications (multi-line messages only)'
  2939. say ' These SLIDE_x options are only used when a color slide is specified'
  2940. say bold'    SLIDE_T:'normal' Threshold rules & parameter for color slides: slide_t=pnnn, p=PBC'
  2941. say bold'    SLIDE_V:'normal' Vertical mapping rule for color slides : T(ile),F(it),N(one)'
  2942. say bold'    SLIDE_H:'normal' Horizontal mapping rule for color slides (T(ile),F(it)'
  2943. say bold'    SLIDE_C:'normal' Center coordinates for color slide: slide_c=v+v'
  2944. say bold'   SLIDE_SI:'normal' Size of "user specified color slide" (# colors): slide_si=n'
  2945. say bold'   SLIDE_RE:'normal' Red color parameters for created slide: slide_red=v+v+.."'
  2946. say bold'   SLIDE_GR:'normal' Green color parameters for created slide: slide_gr=v+v+.. "'
  2947. say bold'   SLIDE_BL:'normal' Blue color parameters for created slide: slide_bl=v+v+..'
  2948. say bold'   SLIDE_PR:'normal' Probability parameters for using slide value: slide_pr=v+v+..'
  2949. say  reverse'Example:'normal ' time_fmt=N  Y_SCA=0.5+1.2+2 x_F=2 y_f=2'
  2950. say  reverse'Notes:'normal" p=parameter, n=0..9, nnn=0..255, v=0.0...1.0; v+v+.. = list of v's "              
  2951.  
  2952. return 1
  2953.  
  2954.  
  2955. /*********/
  2956. /* show stuff in queue as a list */
  2957. show_dir_queue:procedure expose qlist.
  2958. parse arg lookfor
  2959.     ibs=0 ;mxlen=0
  2960.     if lookfor<>1 then
  2961.        nq=queued()
  2962.      else
  2963.         nq=qlist.0
  2964.     do ii=1 to nq
  2965.        if lookfor=1 then do
  2966.           aa=qlist.ii
  2967.           ii2=lastpos('\',aa) ; anam=substr(aa,ii2+1)
  2968.        end /* do */
  2969.        else do
  2970.           pull aa
  2971.           if pos(lookfor,aa)=0 then iterate
  2972.           parse var aa anam (lookfor) .
  2973.           if strip(anam)='.' | strip(anam)='..' then iterate
  2974.        end
  2975.        ibs=ibs+1
  2976.        blist.ibs=anam
  2977.        mxlen=max(length(anam),mxlen)
  2978.     end /* do */
  2979. arf=""
  2980. do il=1 to ibs
  2981.    anam=blist.il
  2982.    arf=arf||left(anam,mxlen+2)
  2983.    if length(arf)+mxlen+2>75  then do
  2984.         say arf
  2985.         arf=""
  2986.    end /* do */
  2987. end /* do */
  2988. if length(arf)>1 then say arf
  2989. say
  2990. return 1
  2991.  
  2992.  
  2993.  
  2994.  
  2995.  
  2996.  
  2997.  /* ------------------------------------------------------------------ */
  2998.  /* function: Check if ANSI is activated                               */
  2999.  /*                                                                    */
  3000.  /* call:     CheckAnsi                                                */
  3001.  /*                                                                    */
  3002.  /* where:    -                                                        */
  3003.  /*                                                                    */
  3004.  /* returns:  1 - ANSI support detected                                */
  3005.  /*           0 - no ANSI support available                            */
  3006.  /*          -1 - error detecting ansi                                 */
  3007.  /*                                                                    */
  3008.  /* note:     Tested with the German and the US version of OS/2 3.0    */
  3009.  /*                                                                    */
  3010.  /*                                                                    */
  3011.  CheckAnsi: PROCEDURE
  3012.    thisRC = -1
  3013.  
  3014.    trace off
  3015.                          /* install a local error handler              */
  3016.    SIGNAL ON ERROR Name InitAnsiEnd
  3017.  
  3018.    "@ANSI 2>NUL | rxqueue 2>NUL"
  3019.  
  3020.    thisRC = 0
  3021.  
  3022.    do while queued() <> 0
  3023.      queueLine = lineIN( "QUEUE:" )
  3024.      if pos( " on.", queueLine ) <> 0 | ,                       /* USA */
  3025.         pos( " (ON).", queueLine ) <> 0 then                    /* GER */
  3026.        thisRC = 1
  3027.    end /* do while queued() <> 0 */
  3028.  
  3029.  InitAnsiEnd:
  3030.  signal off error
  3031.  RETURN thisRC
  3032.  
  3033.  
  3034.  
  3035.  
  3036.  
  3037.  
  3038. a_replacestrg:
  3039.  
  3040. exactmatch=0
  3041. backward=0 ; doall=0
  3042.  
  3043. parse arg astring ,  target   , putme , type , exactmatch
  3044.  
  3045. type = translate(type)
  3046. if type="BACKWARD" then backward="YES"
  3047. if type="ALL" then doall="YES"
  3048.  
  3049. iat=1
  3050. joelen=length(target)
  3051. joelen2=length(putme)
  3052.  
  3053. doagain:                /* here if doall=yes */
  3054.  if exactmatch="YES" then do
  3055.     if   backward="YES" then
  3056.         joe= lastpos(target,astring)
  3057.     else
  3058.         joe= pos(target,astring,iat)
  3059.  end
  3060.  else do
  3061.    if   backward="YES" then
  3062.         joe= lastpos(translate(target),translate(astring))
  3063.     else
  3064.         joe= pos(translate(target),translate(astring),iat)
  3065.  end
  3066.  if joe=0 then
  3067.          return astring
  3068.  
  3069.  astring=delstr(astring,joe,joelen)
  3070.  if putme<>' ' then
  3071.     astring=insert(putme,astring,joe-1)
  3072.  
  3073.  if doall="YES" then do
  3074.      iat=joe+joelen2
  3075.      signal doagain
  3076.  end
  3077. /* else, all done */
  3078.  return astring
  3079.  
  3080.  
  3081.  
  3082.  
  3083. /* -------------------- */
  3084. /* get a yes or no , return 1 if yes */
  3085. yesno:procedure expose normal reverse bold
  3086. parse arg fooa , allopt,altans
  3087. if altans<>" " & words(altans)>1 then do
  3088.    w1=strip(word(altans,1))
  3089.    w2=strip(word(altans,2))
  3090.    a1=left(w1,1) ; a2=left(w2,1)
  3091.    a1a=substr(w1,2) ; a2a=substr(w2,2)
  3092. end
  3093. else do
  3094.     a1='Y' ; a1a='es'
  3095.     a2='N' ; a2a='o'
  3096. end  /* Do */
  3097. ayn='  '||bold||a1||normal||a1a||'\'||bold||a2||normal||a2a
  3098. if allopt=1 then  ayn=ayn||'\'||bold||'A'||normal||'ll'
  3099.  
  3100. do forever
  3101.  foo1=normal||reverse||fooa||normal||ayn
  3102.  call charout,  foo1 normal ':'
  3103.  pull anans
  3104.  if abbrev(anans,a1)=1 then return 1
  3105.  if abbrev(anans,a2)=1 then return 0
  3106.  if allopt=1 & abbrev(anans,'A')=1 then return 2
  3107. end
  3108.  
  3109. nocon:
  3110. if rc=-7 then return 0
  3111. exit 0
  3112.  
  3113. gpmprintf:procedure expose is_cgi
  3114. parse arg a1
  3115.  
  3116. if is_cgi=2 then do
  3117.   say a1
  3118.   return 1
  3119. end
  3120.  
  3121. if rxfuncquery('pmprintf')=0 then
  3122.     call pmprintf(a1)
  3123. return 0
  3124.  
  3125.  
  3126.