/*
Copyright 1992 StarTeck. All rights reserved.

This Genie will emboss or engrave selected objects!!!
Highlight object(s) to be embossed, then run Genie, answering prompts.
*/
/*
Trace ?results */
call pdm_AutoUpdate(0)
cr = '0a'x
units = pdm_getunits()

object = pdm_SelFirstobj()
if object = 0 then exit_msg("Select a group of objects to be copied first")

Emb_Eng = pdm_inform(3,'Do you want to emboss or engrave?','EMBOSS','Cancel','ENGRAVE')
   if Emb_Eng = 1 then exit_msg()

list = "Accept all defaults"cr"Input offset"cr"Input colors"
response = pdm_selectfromlist("Control Options...",20,3,3,list)
if response = '' then exit_msg()
parse var response input1 (cr) input2

select
   when input1 = 'Accept all defaults' then do
      call DefaultColors()
      call DefaultShift()
      end
      
   when input1 = 'Input offset' then do
      call Offset()
      if input2 = 'Input colors' then
         call Colors()
      else
         call DefaultColors()
      end
      
   otherwise
      call Colors()
      call DefaultShift()
   end /* select */

if ~(Emb_Eng = 0 ) then  /* Flip colors for embossing or engraving */
   do
      tmp = dc
      dc  = lc
      lc  = tmp
      end

shift2x = - (shiftx + shiftx)
shift2y = - (shifty + shifty)

firstobject = pdm_selfirstobj()

call pdm_CloneObj(,0,0,shiftx,shifty,1,1,0)
call pdm_SetLineColor(,dc)
call pdm_SetFillPattern(,1,dc,,,,,0)
call pdm_GroupObj()
call pdm_objbehind(,firstobject)

call pdm_CloneObj(,0,0,shift2x,shift2y,1,1,0)
call pdm_SetLineColor(,lc)
call pdm_SetFillPattern(,1,lc,,,,,0)
call pdm_GroupObj()
call pdm_objbehind(,firstobject)


/* functions functions functions */

DefaultColors:
   dc = "black"
   lc = "white"
return /* end of DefaultColor function */


DefaultShift:
   shiftx = ".015"
   shifty = ".015"
   if units = 2 then shiftx = shiftx * 2.54
   if units = 2 then shifty = shifty * 2.54
   if units = 3 then shiftx = shiftx * 6
   if units = 3 then shifty = shifty * 6
return /* end of DefaultShift function */


Offset:
   ox = 0.015
   oy = 0.015
   if units = 2 then ox = ox * 2.54
   if units = 2 then oy = oy * 2.54
   if units = 3 then ox = ox * 6
   if units = 3 then oy = oy * 6
      offsetprompt = 'OFFSET X =:'ox || cr || 'OFFSET Y =:'oy
      shift = pdm_getform(Input offset amount,7,offsetprompt)
      parse var shift shiftx (cr) shifty
      if ~DataType(shiftx,'N') then exit_msg('Offset X must be a number !!!')
      if ~DataType(shifty,'N') then exit_msg('Offset Y must be a number !!!')
return /* end of Offset function */


Colors:
   colorlist = GetColorList()
   if  ~(colorlist = '') then do
       count = 1
       pos   = index(colorlist, cr)

       do while pos > 0
          count = count + 1
          pos   = index(colorlist, cr, pos + 1)
          end
       end
    else
       exit_msg(Color palatte not found)
         
       dc = SelectFromList('Input dark color...',30,count,2,colorlist)
       if dc = '' then exit_msg()
       lc = SelectFromList('Input light color...',30,count,2,colorlist)
       if lc = '' then exit_msg()
return /* end of Colors function */


exit_msg: procedure expose units
do
        parse arg message
        if message ~= '' then call pdm_Inform(1, message,)
        call pdm_AutoUpdate(1)
        call pdm_ClearStatus()
        call pdm_SetUnits(units)
        exit
end                                                                                                                                                    