/*------------------------------------------------------------------------*\
|                                                                          |
|           DUMPVRW.CMD  - Version 1.0 - Version Date 1995-10-09           |
|                 Copyright (C) 1995 by C F S Nevada, Inc.                 |
|                                                                          |
|             ======> C F S Nevada, Inc. confidential <======              |
|                                                                          |
|                  by Dick Goran  - Voice    702-732-9616                  |
|                                 - FAX      702-732-3847                  |
|                                 - CIS      71154,2002                    |
|                                 - Internet dgoran@cfsrexx.com            |
|                                 - WWW      <http://www.cfsrexx.com>      |
|                                                                          |
| ------------------------------------------------------------------------ |
|  Requires: REXXLIB.DLL  - OS/2 REXX external function library            |
|                           (c) Copyright 1992-95 Quercus Systems          |
\*------------------------------------------------------------------------*/
/*

   This subroutine can be used to create debugging logs containing
   the details of all of the objects contained within a VX-REXX
   window. (.OBN, .OBD, & .OBJ)

   Use is: DUMPVRW( program_name )

   It returns the number of objects processed.

*/

GBL. = ''             /* initialize stem */
GBL.environment     = 'OS2ENVIRONMENT'
parse Arg             GBL.command_line
parse Version         GBL.REXX_version,
                      GBL.REXX_version_level,
                      GBL.REXX_version_day,
                      GBL.REXX_version_month,
                      GBL.REXX_version_year .
parse Source          GBL.operating_system,
                      GBL.calling_environment,
                      GBL.program_path_and_name
GBL.boot_drive      = LEFT( VALUE( 'RUNWORKPLACE',, GBL.environment ), 2 )
GBL.program_version = 1.0           /* version / mod of this program */
GBL.program_name    = STRIP( FILESPEC( 'N', GBL.program_path_and_name ) )
GBL.program_path    = STRIP( FILESPEC( 'D', GBL.program_path_and_name ) ||,
                             FILESPEC( 'P', GBL.program_path_and_name ) )
GBL.width_limit     = 76            /* log line width */
parse var GBL.program_name,
   GBL.program_fn '.',
   GBL.program_fe
call TIME 'E'                       /* set elapsed timer - sssss.uuuuu */

/*------------------------*\
|  Enable trap processing  |
|    if REXXLIB present    |
\*------------------------*/
   SIGNAL ON ERROR
   SIGNAL ON FAILURE
   SIGNAL ON HALT
   SIGNAL ON NOVALUE
   SIGNAL ON SYNTAX

/*---------------*\
|  Register APIs  |
\*---------------*/
/* REXXUTIL */
if RxFuncQuery( 'SysLoadFuncs' ) ª= 0 then
   do
      call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
      if SysLoadFuncs() ª= '' then
         do
            call LOGIC_ERROR
         end
   end

/* REXXLIB - (c) Quercus Systems */
if RxFuncQuery( 'rexxlibregister' ) ª= 0 then
   do
      if GBL.REXX_version = 'REXX/Personal' then
         do
            dll_name = 'QREXXLIB'
         end
      else
         do
            dll_name = 'REXXLIB'
         end
      call RxFuncAdd 'REXXLibRegister', dll_name, 'rexxlibregister'
      if REXXLibRegister() ª= '1' then
         do
            call LOGIC_ERROR
         end
   end

if RxFuncQuery( 'VRLoadFuncs' ) ª= 0 then
   do
      call RXFuncAdd "VRLoadFuncs", "VROBJ", "VRLoadFuncs"
      if VRLoadFuncs() ª= '' then
         do
            call LOGIC_ERROR
         end
   end

/*-----------------------------*\
|  Used by EDIT function below  |
\*-----------------------------*/
GBL.e1 = XRANGE('01'x, '19'x)
GBL.e2 = XRANGE('01'x, '03'x) || '19'x ||,
         XRANGE('04'x, '06'x) || '19'x ||,
         XRANGE('07'x, '09'x) || '19'x ||,
         XRANGE('0A'x, '0C'x) || '19'x ||,
         XRANGE('0D'x, '0F'x) || '19'x ||,
         XRANGE('10'x, '12'x) || '19'x ||,
         XRANGE('13'x, '15'x) || '19'x ||,
         XRANGE('16'x, '18'x)

/* get punctuation characters from INI file  */
GBL.decimal  = STRIP( SysIni( 'USER',,
                              'PM_National',,
                              'sDecimal' ), 'T', '00'x )
GBL.thousand = STRIP( SysIni( 'USER',,
                              'PM_National',,
                              'sThousand' ), 'T', '00'x )

/*-------------------------*\
|  Setup output file names  |
\*-------------------------*/
callers_path_and_name = GBL.command_line
if callers_path_and_name = '' then
   do
      callers_path_and_name = GBL.program_path_and_name
   end
callers_program_name = STRIP( FILESPEC( 'N', callers_path_and_name ) )
callers_program_path = STRIP( FILESPEC( 'D', callers_path_and_name ) ||,
                              FILESPEC( 'P', callers_path_and_name ) )
parse var callers_program_name,
   callers_program_fn '.',
   callers_program_fe

GBL.object_property_file =,
   callers_program_path ||,
   callers_program_fn   || '.OBJ'

GBL.object_dimension_file =,
   callers_program_path ||,
   callers_program_fn   || '.OBD'

GBL.object_name_file =,
   callers_program_path ||,
   callers_program_fn   || '.OBN'

/*-------------------*\
|  Setup output file  |
\*-------------------*/
call SysFileDelete GBL.object_property_file
call SysFileDelete GBL.object_dimension_file
call SysFileDelete GBL.object_name_file

/*----------------------------------*\
|  Create slider progress indicator  |
\*----------------------------------*/
background_color = 'Pink'
foreground_color = 'Black'

primary_window_handle =,
   VRWindow()
if primary_window_handle = '' then
   do
      primary_window_handle = VRGet( 'Screen', 'Self' )
   end
primary_window_width =,
   VRGet( primary_window_handle, 'Width' )

slider_width = TRUNC( primary_window_width * 0.95 )
slider_left  =,
   ( primary_window_width - slider_width ) % 2

p = -1
p=p+2;q=p+1; prop.p = 'Name';              prop.q = 'DUMPVRW Debug_slider'
p=p+2;q=p+1; prop.p = 'BackColor';         prop.q = background_color
p=p+2;q=p+1; prop.p = 'ClipSiblings';      prop.q = '1'
p=p+2;q=p+1; prop.p = 'ForeColor';         prop.q = foreground_color
p=p+2;q=p+1; prop.p = 'Height';            prop.q = '1000'
p=p+2;q=p+1; prop.p = 'HomePosition';      prop.q = 'Left'
p=p+2;q=p+1; prop.p = 'Justification';     prop.q = 'Center'
p=p+2;q=p+1; prop.p = 'Left';              prop.q = slider_left
p=p+2;q=p+1; prop.p = 'Margin';            prop.q = '100'
p=p+2;q=p+1; prop.p = 'Orientation';       prop.q = 'Horizontal'
p=p+2;q=p+1; prop.p = 'Painting';          prop.q = '1'
p=p+2;q=p+1; prop.p = 'Percentile';        prop.q = '0'
p=p+2;q=p+1; prop.p = 'ReadOnly';          prop.q = '1'
p=p+2;q=p+1; prop.p = 'RibbonColor';       prop.q = 'Red'
p=p+2;q=p+1; prop.p = 'RibbonStrip';       prop.q = '1'
p=p+2;q=p+1; prop.p = 'SiblingOrder';      prop.q = '1'
p=p+2;q=p+1; prop.p = 'SliderButtons';     prop.q = 'None'
p=p+2;q=p+1; prop.p = 'SnapToTick';        prop.q = '1'
p=p+2;q=p+1; prop.p = 'TabGroup';          prop.q = '0'
p=p+2;q=p+1; prop.p = 'TabStop';           prop.q = '0'
p=p+2;q=p+1; prop.p = 'TickIndex';         prop.q = '1'
p=p+2;q=p+1; prop.p = 'TickList';          prop.q = ';0;5;10;15;20;25;30;35;40;45;50;55;60;65;70;75;80;85;90;95;100'
p=p+2;q=p+1; prop.p = 'TickPosition';      prop.q = 'Top'
p=p+2;q=p+1; prop.p = 'TickSize';          prop.q = '100'
p=p+2;q=p+1; prop.p = 'Ticks';             prop.q = '21'
p=p+2;q=p+1; prop.p = 'Top';               prop.q = '3200'
p=p+2;q=p+1; prop.p = 'UserData';          prop.q = 'Used to track log file completion'
p=p+2;q=p+1; prop.p = 'Visible';           prop.q = '1'
p=p+2;q=p+1; prop.p = 'Width';             prop.q = slider_width
             prop.0 = q
GBL.debug_slider_handle = VRCreateStem( primary_window_handle, 'Slider', 'prop.' )

/*------------------------------------*\
|  Create & reposition text on slider  |
\*------------------------------------*/
title =,
   'Creating ' || GBL.object_dimension_file || ', .OBJ & .OBN files'
p = -1
p=p+2;q=p+1; prop.p = 'Name';              prop.q = 'DUMPVRW Debug_text'
p=p+2;q=p+1; prop.p = 'Autosize';          prop.q = '1'
p=p+2;q=p+1; prop.p = 'BackColor';         prop.q = background_color
p=p+2;q=p+1; prop.p = 'Caption';           prop.q = title
p=p+2;q=p+1; prop.p = 'ClipSiblings';      prop.q = '1'
p=p+2;q=p+1; prop.p = 'ForeColor';         prop.q = foreground_color
p=p+2;q=p+1; prop.p = 'Height';            prop.q = '446'
p=p+2;q=p+1; prop.p = 'Justification';     prop.q = 'Center'
p=p+2;q=p+1; prop.p = 'SiblingOrder';      prop.q = '1'
p=p+2;q=p+1; prop.p = 'VertJustification'; prop.q = 'Center'
p=p+2;q=p+1; prop.p = 'Visible';           prop.q = '0'
p=p+2;q=p+1; prop.p = 'WordBreak';         prop.q = '0'
             prop.0 = q
GBL.debug_text_handle = VRCreateStem( primary_window_handle, 'DescriptiveText', 'prop.' )

text_height =,
   VRGet( GBL.debug_text_handle, 'Height' )
text_width =,
   VRGet( GBL.debug_text_handle, 'Width' )
text_left =,
   slider_left +,
   ( slider_width - text_width ) % 2
text_top =,
   VRGet( GBL.debug_slider_handle, 'Top'    ) +,
   VRGet( GBL.debug_slider_handle, 'Height' ) -,
   (text_height * 1.25 )

call VRSet GBL.debug_text_handle,,
           'Left',          text_left,,
           'Top',           TRUNC( text_top,0 ),,
           'Visible',       '1'

call VRMethod GBL.debug_slider_handle, 'SetFocus'

/*----------------------------*\
|  Get all objects for window  |
\*----------------------------*/
top_level_window = primary_window_handle        /* Top level window */
first_child      = VRGet( top_level_window, 'FirstChild' )
ObjectHandleTable.1  = VRGet( 'Screen',  'Self' )
ObjectHandleTable.2  = top_level_window
ObjectHandleTable.0  = 2
call ADD_OTHER_OBJECTS first_child

/*---------------------------------*\
|  Total of objects for percentile  |
\*---------------------------------*/
GBL.percentile_numerator = 0
GBL.percentile_total =,
   ObjectHandleTable.0 * 5

/*------------------------------------------------------------------------*\
|                                                                          |
|                             Object name list                             |
|                                                                          |
\*------------------------------------------------------------------------*/
/*------------------------------*\
|  Build array in sibling order  |
\*------------------------------*/
do o = 1 to ObjectHandleTable.0

   call UPDATE_PROGRESS_INDICATOR

   object_handle =,
      ObjectHandleTable.o

   sibling_order = VRGet( object_handle, 'SiblingOrder' )
   parent_handle = VRGet( object_handle, 'Parent' )
   if parent_handle = '' then
      do
         parent_handle = '.'
      end

   SiblingOrderTable.o =,
      LEFT( parent_handle, 9 ),
      RIGHT( sibling_order, 3, '0' ),
      object_handle
end
SiblingOrderTable.0 = ObjectHandleTable.0

call ARRAYSORT 'SiblingOrderTable', 1, SiblingOrderTable.0

heading_0 =,
   'Object names in sibling order - ' DATE( 'U' ) TIME('N')
call LINEOUT GBL.object_name_file,,
   '/*' || COPIES( '-', LENGTH(heading_0) )       || '*\'
call LINEOUT GBL.object_name_file,,
   '| ' ||         heading_0                      || ' |'
call LINEOUT GBL.object_name_file,,
   '\*' || COPIES( '-', LENGTH(heading_0) )       || '*/'
call LINEOUT GBL.object_name_file, ' '

previous_parent_handle = ''
do s = 1 to SiblingOrderTable.0

   call UPDATE_PROGRESS_INDICATOR

   parse value SiblingOrderTable.s with,
      parent_handle,
      sibling_order,
      object_handle

   if parent_handle ª= previous_parent_handle then
      do
         call LINEOUT GBL.object_name_file, ' '
      end

   object_name  = VRGet( object_handle, 'Name' )
   object_class = VRGet( object_handle, 'ClassName' )
   object_name_output_line =,
      RIGHT( sibling_order, 3 ),
      LEFT( object_name,  30 ),
      LEFT( object_class, 16 ),
      'S=' || VRGet( object_name, 'Self'   ) ||,
      COPIES( ' ', 2 )                       ||,
      'P=' || parent_handle                  ||,
      ''
   call LINEOUT GBL.object_name_file, object_name_output_line
   previous_parent_handle = parent_handle

end

call STREAM GBL.object_name_file,      'C', 'CLOSE'


/*------------------------------------------------------------------------*\
|                                                                          |
|                       Process list of all objects                        |
|                                                                          |
\*------------------------------------------------------------------------*/
/*--------------------------------------*\
|  Put objects in order by top / left    |
|                                        |
|  Change array containing just ?HW to:  |
|     RIGHT( top, 9  ),                  |
|     RIGHT( left, 9 ),                  |
|     ?HW                                |
\*--------------------------------------*/
do o = 1 to ObjectHandleTable.0
   call UPDATE_PROGRESS_INDICATOR

   object_handle           = ObjectHandleTable.o
   parent_handle           = VRGet( object_handle, 'Parent' )
   object_class            = VRGet( object_handle, 'ClassName' )
   uppercase_object_class  = TRANSLATE( object_class )
   object_top              = CHECK_VALIDITY_OF_TOP( object_handle )

   select
      when uppercase_object_class = 'SCREEN' then
         do
            top_left =,
               RIGHT( 0, 9 ),
               RIGHT( 0, 9 )
         end
      when object_top = '' then
         do
            sibling_order = VRGET( object_handle, 'SiblingOrder' )
            top_left =,
               X2D( RIGHT( object_handle, 6 ), 9 ),
               RIGHT( 0, 9 )
         end
      otherwise
         do
            top_left =,
               PARENT_COORDINATES( object_handle,,
                                   parent_handle,,
                                   0,,
                                   0 )
         end
   end
   ObjectHandleTable.o =,
      top_left,
      ObjectHandleTable.o
end

call ARRAYSORT 'ObjectHandleTable', 1, ObjectHandleTable.0,,
               1,  9, 'A', 'I',,
               11, 9, 'A', 'I',,
               21, 9, 'A', 'I'

/*---------------------*\
|  Process all objects  |
\*---------------------*/
do o = 1 to ObjectHandleTable.0
   call UPDATE_PROGRESS_INDICATOR

   parse value ObjectHandleTable.o with,
      top,
      left,
      object_handle
   property_number = 0
   object_name            = VRGET( object_handle, 'Name' )
   user_data              = VRGET( object_handle, 'UserData' )
   object_class           = VRGET( object_handle, 'ClassName' )
   uppercase_object_class = TRANSLATE( object_class )

   heading_1       =,
      object_name '(' || object_handle || ') /' object_class

   call LINEOUT GBL.object_property_file,,
      '/*' || COPIES( '-', GBL.width_limit - 4 )       || '*\'
   call LINEOUT GBL.object_property_file,,
      '| ' || CENTER( heading_1, GBL.width_limit - 4 ) || ' |'
   call LINEOUT GBL.object_property_file,,
      '\*' || COPIES( '-', GBL.width_limit - 4 )       || '*/'
   call LINEOUT GBL.object_property_file, 'p = -1'

   call LINEOUT GBL.object_dimension_file,,
      LEFT( object_name, MAX( 36, LENGTH( object_name ) ) ),
      '(' || object_handle || ') /' object_class

   /*------------------------------*\
   |  Get property list for object  |
   \*------------------------------*/
   call VRMethod object_name, 'ListProperties', 'prop.'
   if prop.0 = 0 then
      do
         iterate o
      end
   call ARRAYSORT 'prop', 1, prop.0

   /*--------------------------------------------*\
   |  Create REXX line for each property & value  |
   \*--------------------------------------------*/
   do p = 1 to prop.0
      property_name = prop.p
      property_value = VRGet( object_name, property_name )
      uppercase_property_name = TRANSLATE( property_name )

      output_line_a =,
         'p=p+2;q=p+1; prop.p = ''' || property_name  || ''';'
      output_line_b =,
         'prop.q = ''' || property_value || ''''
      left_width = MAX( LENGTH( output_line_a ), 42 )
      call LINEOUT GBL.object_property_file,,
         LEFT( output_line_a, left_width ) output_line_b

      if WORDPOS( uppercase_property_name, 'HEIGHT LEFT TOP WIDTH' ) > 0 then
         do
            cmd = property_name '=' MAX( property_value, 0 )
            interpret cmd
            if uppercase_property_name = 'WIDTH' then
               do
                  output_line =,
                     COPIES( ' ', 3 )                              ||,
                     'Top    = ' || RIGHT( EDIT(top),          7 ) ||,
                     COPIES( ' ', 6 )                              ||,
                     'Height = ' || RIGHT( EDIT(height),       7 ) ||,
                     COPIES( ' ', 6 )                              ||,
                     'Bottom = ' || RIGHT( EDIT(top + height), 7 ) ||,
                     ''
                  call LINEOUT GBL.object_dimension_file, output_line
                  output_line =,
                     COPIES( ' ', 3 )                              ||,
                     'Left   = ' || RIGHT( EDIT(left),         7 ) ||,
                     COPIES( ' ', 6 )                              ||,
                     'Width  = ' || RIGHT( EDIT(width),        7 ) ||,
                     COPIES( ' ', 6 )                              ||,
                     'Right  = ' || RIGHT( EDIT(left + width), 7 ) ||,
                     ''
                  call LINEOUT GBL.object_dimension_file, output_line
                  call LINEOUT GBL.object_dimension_file, ''
               end
         end
   end

   output_line =,
      '             prop.0 = q'
   call LINEOUT GBL.object_property_file, output_line
   output_line =,
      'internal_name = VRCreateStem( primary_window_handle, ' ||,
      '''' || object_class || ''', ''prop.'' )'
   call LINEOUT GBL.object_property_file, output_line || '0D0A'x

end
call STREAM GBL.object_property_file,  'C', 'CLOSE'
call STREAM GBL.object_dimension_file, 'C', 'CLOSE'

/*-----------------------------------*\
|  Kill slider & remove it from list  |
\*-----------------------------------*/
call VRDestroy GBL.debug_text_handle
call VRDestroy GBL.debug_slider_handle


call EOJ ObjectHandleTable.0


/*------------------------------------------------------------------------*\
|                                                                          |
|                 Handle Syntax error if nop top property                  |
|                                                                          |
\*------------------------------------------------------------------------*/
CHECK_VALIDITY_OF_TOP:

parse ARG,
   validity_handle

SIGNAL ON SYNTAX name NO_TOP_RETURN
validity_top = VRGet( validity_handle, 'Top' )
SIGNAL ON SYNTAX
return validity_top

NO_TOP_RETURN:
SIGNAL ON SYNTAX
return ''


/*------------------------------------------------------------------------*\
|                                                                          |
|                        Add other objects to array                        |
|                                                                          |
\*------------------------------------------------------------------------*/
ADD_OTHER_OBJECTS:
   Procedure expose,
      GBL. ObjectHandleTable.

parse ARG,
   next_object

do while next_object ª= ''
   o = ObjectHandleTable.0 + 1
   ObjectHandleTable.0 = o
   ObjectHandleTable.o = next_object
   first_child = VRGet( next_object, 'FirstChild' )
   if first_child ª= '' then
      do
         call ADD_OTHER_OBJECTS first_child
      end
   next_object = VRGet( next_object, 'Sibling' )
end
return

/*------------------------------------------------------------------------*\
|                                                                          |
|                   Return absolute top &  absolute left                   |
|                                                                          |
\*------------------------------------------------------------------------*/
PARENT_COORDINATES:
   Procedure expose,
      GBL.

parse ARG,
   object_handle,,
   parent,,
   top,,
   left

if GBL.object_handle = '' then
   do
      top  = top  + VRGet( object_handle, 'Top' )
      left = left + VRGet( object_handle, 'Left' )
      GBL.OBJECT_HANDLE = top left
   end

do while parent ª= ''
   parent_top_left = GBL.parent

   object_parent = parent
   parent        = VRGet( object_parent, 'parent' )

   if parent_top_left ª= '' then
      do
         top  = top  +  WORD( parent_top_left, 1 )
         left = left +  WORD( parent_top_left, 2 )
      end
   call PARENT_COORDINATES object_handle,,
                           parent,,
                           top,,
                           left
end

return RIGHT( top, 9 ),
       RIGHT( left, 9 )

/*------------------------------------------------------------------------*\
|                                                                          |
|                             Position slider                              |
|                                                                          |
\*------------------------------------------------------------------------*/
UPDATE_PROGRESS_INDICATOR:
   Procedure expose,
      GBL. ObjectHandleTable.

parse ARG,
   unused

/*------------------------*\
|  Set progress indicator  |
\*------------------------*/
GBL.percentile_numerator = GBL.percentile_numerator + 1
pct = FORMAT( ( GBL.percentile_numerator * 100 ) / GBL.percentile_total, 3, 0 )
call VRSET GBL.debug_slider_handle, 'Percentile', pct

return

/*------------------------------------------------------------------------*\
|                                                                          |
|                       Edit function (moved inline)                       |
|                                                                          |
\*------------------------------------------------------------------------*/
EDIT:
   Procedure expose,
      GBL.

/* return BAD if non-numeric data */
if DATATYPE( ARG(1) ) <> 'NUM' then
   return 'BAD'

/* test and save sign value along with absolute numeric value */
if SIGN( ARG(1) ) <> '-1' then
   sign_character = ''
else
   sign_character = '-'
absolute_value = ABS( ARG(1) )

/* test for and save decimal value indicator */
decimal_position = POS( GBL.decimal, absolute_value )

if decimal_position = 0 then
   source = RIGHT( absolute_value, LENGTH(GBL.e1) - 1 ) || ' '
else
   source = RIGHT( LEFT( absolute_value, decimal_position - 1 ), LENGTH(GBL.e1) - 1 ) || ' '

if decimal_position = 0 then
   edited_number =,
      STRIP( TRANSLATE( TRANSLATE( GBL.e2, source, GBL.e1), GBL.thousand, ' '), 'B', ',')
else
   edited_number =,
      STRIP( TRANSLATE( TRANSLATE( GBL.e2, source, GBL.e1), GBL.thousand, ' '), 'B', ','),
                      || RIGHT( absolute_value,,
                                LENGTH(absolute_value) - decimal_position + 1)
return sign_character || edited_number


!tr! = VALUE('TRACE',,GBL.environment); if !tr! <> '' then do; TRACE(!tr!); nop; end
/*------------------------------------------------------------------------*\
|                                                                          |
|                                End of Job                                |
|                                                                          |
\*------------------------------------------------------------------------*/
EOJ:
   Procedure expose,
      GBL.

if ARG() = 0 then
   eoj_rc = 0
else
   eoj_rc = ARG(1)

elapsed_time = TIME('E')            /* get elapsed time - sssss.uuuuu */
parse value elapsed_time with seconds '.' micro_seconds
if LEFT( micro_seconds, 1, 1 ) >= 5 then
   seconds = seconds + 1
ss = FORMAT( seconds // 60, 2 )
minutes = ( seconds - ss ) / 60
mm = FORMAT( minutes // 60, 2 )
hh = FORMAT( ( minutes - mm ) / 60, 2 )
duration = hh':'mm':'ss

program_name = TRANSLATE( FILESPEC( 'N', GBL.program_path_and_name ) )
/*
say 'EOJ  ' program_name 'at' TIME('N') ||,
    ', duration' TRANSLATE( duration, '0', ' ' )
*/
exit   eoj_rc

/*------------------------------------------------------------------------*\
|                                                                          |
|                              Trap Routines                               |
|                                                                          |
\*------------------------------------------------------------------------*/
ERROR:       call TRAP_PROCESSING SIGL, 'ERROR',       RC
FAILURE:     call TRAP_PROCESSING SIGL, 'FAILURE',     RC
HALT:        call TRAP_PROCESSING SIGL, 'HALT',        ''
LOGIC_ERROR: call TRAP_PROCESSING SIGL, 'LOGIC ERROR', RC
NOVALUE:     call TRAP_PROCESSING SIGL, 'NOVALUE',     ''
SYNTAX:      call TRAP_PROCESSING SIGL, 'SYNTAX',      RC

/* Rev. 95/10/14 */
TRAP_PROCESSING:
   parse Source . . TRAP.path_and_program
   trap.line_nbr = ARG(1)
   if POS( ':', TRAP.path_and_program ) > 0 then
      /* get source line if it is available */
      do t = 1
         trap_source_line.t =  SOURCELINE( trap.line_nbr )
         trap_source_line.0 = t
         trap.line_nbr      = trap.line_nbr + 1
         if RIGHT( trap_source_line.t, 1 ) ª= ',' then
            do
               leave
            end
      end
   else
      /* program is running in macrospace */
      do
         TRAP.path_and_program = STRIP( DIRECTORY(), 'T', '\' ) || '\' ||,
                                 TRAP.path_and_program
         trap_source_line.1 = 'Source line is not available.'
         trap_source_line.0 = 1
      end

   parse value FILESPEC( 'N', TRAP.path_and_program ) with,
      TRAP.fn '.' TRAP.fe
   trap_file_name = FILESPEC( 'D', TRAP.path_and_program ) ||,
                    FILESPEC( 'P', TRAP.path_and_program ) ||,
                    TRAP.fn || '.' || 'DMP'

   /*------------------------------------------*\
   |  check for reason not to create .DMP file  |
   \*------------------------------------------*/
   if ARG(2) = 'HALT' then
      do
         trap_file_name = ''
      end
   if RxFuncQuery( 'VARDUMP' ) <> 0 then
      do
         trap_file_name = ''
      end
   if POS( ':', trap_file_name ) = 0 then
      do
         trap_file_name = ''
      end

   /*------------------------*\
   |  Build trap message box  |
   \*------------------------*/
   dbl.h    = 'CD'x                 /* Í double line - horizontal   */
   dbl.v    = 'BA'x                 /* º double line - vertical     */
   dbl.bl   = 'C8'x                 /* È double line - bottom left  */
   dbl.br   = 'BC'x                 /* ¼ double line - bottom right */
   dbl.tl   = 'C9'x                 /* É double line - top left     */
   dbl.tr   = 'BB'x                 /* » double line - top right    */
   trap.red = '1B'x || '[1;37;41m'  /* bright white on red          */
   trap.dul = '1B'x || '[0m'        /* reset to normal              */

   say ' '
   trap_error_description =,
      'Error line = ' || ARG(1) ||,
      '; ' ||,
      ARG(2) ||,
      ' error.'
   if ARG(3) <> '' then
      trap_error_description = trap_error_description ||,
                               '  Return code = ' || ARG(3)
   trap.width = MAX( 74, LENGTH( trap_error_description ) )
   say trap.red || dbl.tl || COPIES( dbl.h,trap.width + 2 ) || dbl.tr || trap.dul
   say trap.red || dbl.v  || COPIES( ' ',  trap.width + 2 ) || dbl.v  || trap.dul
   say trap.red || dbl.v CENTER( TRAP.fn'.'TRAP.fe,trap.width )    dbl.v  || trap.dul
   say trap.red || dbl.v CENTER( trap_error_description, trap.width ) dbl.v || trap.dul
   if trap_file_name <> '' then
      do
   say trap.red || dbl.v  || COPIES( ' ',  trap.width + 2 ) || dbl.v  || trap.dul
   say trap.red || dbl.v     CENTER( 'See: ' || trap_file_name,,
                                     trap.width )  dbl.v  || trap.dul
      end
   say trap.red || dbl.v  || COPIES( ' ',  trap.width + 2 ) || dbl.v  || trap.dul
   say trap.red || dbl.bl || COPIES( dbl.h,trap.width + 2 ) || dbl.br || trap.dul
   say trap.red || COPIES( ' ', trap.width + 4 ) || trap.dul
   say trap.red || LEFT( 'Source line(s) at time of trap:', trap.width + 4 ) || trap.dul
   do t = 1 to trap_source_line.0
      say trap.red || LEFT( '   ' || trap_source_line.t, trap.width + 4 ) || trap.dul
   end
   say trap.red || COPIES( ' ', trap.width + 4 ) || trap.dul

   /*---------------------------------*\
   |  Create .DMP file if appropriate  |
   \*---------------------------------*/
   if trap_file_name <> '' then
      do
         call SysFileDelete trap_file_name
         /* remove meaningless labels from dump for clarity */
         drop dbl. TRAP. RC RESULT SIGL !tr!
         call VARDUMP trap_file_name  /* write variables to program.DMP file */
      end
   exit 253
