home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / propage4.0 / arexx / embossengrave.pdrx < prev    next >
Encoding:
Text File  |  1994-09-07  |  3.4 KB  |  130 lines
  1. /*
  2. Copyright 1992 StarTeck. All rights reserved.
  3.  
  4. This Genie will emboss or engrave selected objects!!!
  5. Highlight object(s) to be embossed, then run Genie, answering prompts.
  6. */
  7. /*
  8. Trace ?results */
  9. call pdm_AutoUpdate(0)
  10. cr = '0a'x
  11. units = pdm_getunits()
  12.  
  13. object = pdm_SelFirstobj()
  14. if object = 0 then exit_msg("Select a group of objects to be copied first")
  15.  
  16. Emb_Eng = pdm_inform(3,'Do you want to emboss or engrave?','EMBOSS','Cancel','ENGRAVE')
  17.    if Emb_Eng = 1 then exit_msg()
  18.  
  19. list = "Accept all defaults"cr"Input offset"cr"Input colors"
  20. response = pdm_selectfromlist("Control Options...",20,3,3,list)
  21. if response = '' then exit_msg()
  22. parse var response input1 (cr) input2
  23.  
  24. select
  25.    when input1 = 'Accept all defaults' then do
  26.       call DefaultColors()
  27.       call DefaultShift()
  28.       end
  29.       
  30.    when input1 = 'Input offset' then do
  31.       call Offset()
  32.       if input2 = 'Input colors' then
  33.          call Colors()
  34.       else
  35.          call DefaultColors()
  36.       end
  37.       
  38.    otherwise
  39.       call Colors()
  40.       call DefaultShift()
  41.    end /* select */
  42.  
  43. if ~(Emb_Eng = 0 ) then  /* Flip colors for embossing or engraving */
  44.    do
  45.       tmp = dc
  46.       dc  = lc
  47.       lc  = tmp
  48.       end
  49.  
  50. shift2x = - (shiftx + shiftx)
  51. shift2y = - (shifty + shifty)
  52.  
  53. firstobject = pdm_selfirstobj()
  54.  
  55. call pdm_CloneObj(,0,0,shiftx,shifty,1,1,0)
  56. call pdm_SetLineColor(,dc)
  57. call pdm_SetFillPattern(,1,dc,,,,,0)
  58. call pdm_GroupObj()
  59. call pdm_objbehind(,firstobject)
  60.  
  61. call pdm_CloneObj(,0,0,shift2x,shift2y,1,1,0)
  62. call pdm_SetLineColor(,lc)
  63. call pdm_SetFillPattern(,1,lc,,,,,0)
  64. call pdm_GroupObj()
  65. call pdm_objbehind(,firstobject)
  66.  
  67.  
  68. /* functions functions functions */
  69.  
  70. DefaultColors:
  71.    dc = "black"
  72.    lc = "white"
  73. return /* end of DefaultColor function */
  74.  
  75.  
  76. DefaultShift:
  77.    shiftx = ".015"
  78.    shifty = ".015"
  79.    if units = 2 then shiftx = shiftx * 2.54
  80.    if units = 2 then shifty = shifty * 2.54
  81.    if units = 3 then shiftx = shiftx * 6
  82.    if units = 3 then shifty = shifty * 6
  83. return /* end of DefaultShift function */
  84.  
  85.  
  86. Offset:
  87.    ox = 0.015
  88.    oy = 0.015
  89.    if units = 2 then ox = ox * 2.54
  90.    if units = 2 then oy = oy * 2.54
  91.    if units = 3 then ox = ox * 6
  92.    if units = 3 then oy = oy * 6
  93.       offsetprompt = 'OFFSET X =:'ox || cr || 'OFFSET Y =:'oy
  94.       shift = pdm_getform(Input offset amount,7,offsetprompt)
  95.       parse var shift shiftx (cr) shifty
  96.       if ~DataType(shiftx,'N') then exit_msg('Offset X must be a number !!!')
  97.       if ~DataType(shifty,'N') then exit_msg('Offset Y must be a number !!!')
  98. return /* end of Offset function */
  99.  
  100.  
  101. Colors:
  102.    colorlist = GetColorList()
  103.    if  ~(colorlist = '') then do
  104.        count = 1
  105.        pos   = index(colorlist, cr)
  106.  
  107.        do while pos > 0
  108.           count = count + 1
  109.           pos   = index(colorlist, cr, pos + 1)
  110.           end
  111.        end
  112.     else
  113.        exit_msg(Color palatte not found)
  114.          
  115.        dc = SelectFromList('Input dark color...',30,count,2,colorlist)
  116.        if dc = '' then exit_msg()
  117.        lc = SelectFromList('Input light color...',30,count,2,colorlist)
  118.        if lc = '' then exit_msg()
  119. return /* end of Colors function */
  120.  
  121.  
  122. exit_msg: procedure expose units
  123. do
  124.         parse arg message
  125.         if message ~= '' then call pdm_Inform(1, message,)
  126.         call pdm_AutoUpdate(1)
  127.         call pdm_ClearStatus()
  128.         call pdm_SetUnits(units)
  129.         exit
  130. end