
\   Rules for translating AutoCAD Release 11 DXF files to Release 10

\   Version 1.5  --  May 28, 1992

.( "Release 12 -> 10 DXF translator, Version 1.5 (5/28/92)\n"

\ ************ START DEBUG-ONLY STUFF ***************

\   Initialization routine

: dxf:start
\   -1 dumpinput !                    \ Un-comment to dump input items
\   -1 dumpoutput !                   \ Un-comment to dump output items
\    6 outprec !                      \ Un-comment to force ASCII output
\   -1 mbchar !               \ Un-comment to force multibyte char interp
;

\   Manual translation program (equivalent to the standard loop, so it's
\                               commented out).

\ : dxf:translate
\     begin
\         readitem while
\         writeitem drop
\     repeat
\ ;

\   Print point on stack

80 string edbuf
: point.                              \ x y z --
    2rot
    "(%g," edbuf fstrform edbuf type
    2swap
    "%g" edbuf fstrform edbuf type
    2dup missing_z 2@ f= if
        ")"
    else
        ",%g)" edbuf fstrform edbuf
    then
    type
;

\ ************* END DEBUG-ONLY STUFF **************

\   Defining words to make common translation operations easier
\   and more expressive to specify.

\   REMOVE DXF:bilge:rat  --  Causes all instances of item RAT in section
\                             BILGE to be removed.  (An explicit section
\                             name is expected; "*" is not valid here)

: remove
    create
    does>
        drop
        1 delitem !
;

\  DROP_Z DXF:header:$zilch  --  The Z co-ordinate will be deleted from
\                                header variable ZILCH.

: drop_z
    create
    does>
        drop
        10 group 2drop missing_z 2@ 10 setgroup
;

\   bitmask MASKFIELD DXF:*:*:<field>  --  AND a field with a bitmask

: maskfield
    create
    ,                                 \ Compile bitmask
    does>
    over                              \ Duplicate group index
    group                             \ Extract value of group
    swap                              \ Move bitmask address to the top
    @                                 \ Get value of bitmask
    and                               \ Mask the value of the field
    swap                              \ Get group code on top
    setgroup                          \ Update group in item
\   stdout printitem
;

\   DITCHGROUP DXF:*:<type>:<group>

: ditchgroup
    create
    does>
    drop                              \ Get rid of word's address
    delgroup                          \ Delete this group from item
;

\   ERRAT  --  End an error message by editing the location in the
\              file that the error occurred.

: errat
    ." " at "
    itempos
    inbinary @ if
        "byte 0x%lX"
    else
        1+ "line %ld"
    then
    edbuf strform edbuf type
    ." " of input file.\n"
;

\   TEXTVADJ DXF:*:<type>:<group>  --  Translate new-format separate
\                                      horizontal and vertical text
\                                      alignment modes.    

: textvadj
    create
    does>
    drop                              \ Get rid of word's address
    dup                               \ Copy vertical alignment group code
    72 group? if
        72 group                      \ Get horizontal alignment
    else
        0                             \ No horizontal alignment, assume Left
    then
    ( Settings for horizontal alignment of 3, 4, and 5 override
      any value present in the vertical alignment field [73 group for
      Text, 74 group for Attdef/Attrib].  It isn't clear how this could
      come to pass except through entmod or DXF, but if we find one, just
      ditch the redundant 73/74 group without complaining.  )
    dup dup 2 > swap 6 < and if
        drop                          \ Drop horizontal alignment
        drop                          \ Drop copy of vertical group code
\       ." "Dropped vert. text alignment, overridden by horiz. alignment.\n"
    else
        ( We translate the new "MCenter" alignment into the old "Middle"
          alignment.  This is usually, but not always, appropriate.  )
        1 = over group 2 = and if
            drop                      \ Drop copy of vertical group code
\           ." "Translated MCenter text alignment.\n"
            4 72 setgroup
        else
            group 0<> if              \ If vertical alignment not Baseline
                72 group? if
                    72 delgroup       \ Discard horizontal alignment group
                then
                11 group? if
                    11 delgroup       \ Drop alignment point
                then
                ." "Text alignment lost--changed to baseline/left\n  for "
                0 group type ." " entity with "
                0 group "ATTRIB" strcmp 0= if
                    ." "value: \"" 1
                else
                    0 group "ATTDEF" strcmp 0= if
                        ." "tag: \"" 2
                    else
                        ." "text: \"" 1
                    then
                then
                group type ." "\"" errat
            then
        then
    then
    delgroup                          \ Discard vertical alignment group
;

(   Process command line options and set special operating modes   )

: modeset
    "d" option if                     \ If -D option is set, turn on trace
        1 dxftrace !
    then
;

\   End of defining words.  Let the fun begin!

modeset                               \ Process command line options


(   Header variables to delete or modify   )

remove dxf:header:$dimclrd            \ Dimension line colour
remove dxf:header:$dimclre            \ Dimension extension line colour
remove dxf:header:$dimclrt            \ Dimension text colour
remove dxf:header:$dimgap             \ Dimension block gap
remove dxf:header:$dimstyle           \ Current dimension style
remove dxf:header:$dimtfac            \ Dimension text vertical position
remove dxf:header:$dwgcodepage        \ Drawing code page
remove dxf:header:$maxactvp           \ Maximum active viewports
remove dxf:header:$pelevation         \ Paper elevation
remove dxf:header:$pextmax            \ Paper maximum extents
remove dxf:header:$pextmin            \ Paper minimum extents
remove dxf:header:$pinsbase           \ Paper insertion base
remove dxf:header:$plimcheck          \ Paper limit checking
remove dxf:header:$plimmax            \ Paper maximum limits
remove dxf:header:$plimmin            \ Paper minimum limits
remove dxf:header:$plinegen           \ Polyline linetype generation
remove dxf:header:$psltscale          \ Paper linetype scaling
remove dxf:header:$pucsname           \ Paper UCS name
remove dxf:header:$pucsorg            \ Paper UCS origin
remove dxf:header:$pucsxdir           \ Paper UCS X direction
remove dxf:header:$pucsydir           \ Paper UCS Y direction
remove dxf:header:$shadedge           \ SHADE command edge rendering mode
remove dxf:header:$shadedif           \ Shading diffuse illumination factor
remove dxf:header:$tilemode           \ Tiled viewports mode
remove dxf:header:$treedepth          \ Oct-tree depth limit
remove dxf:header:$unitmode           \ Drawing unit mode bits
remove dxf:header:$visretain          \ Layer/viewport visibility retention

drop_z dxf:header:$extmax             \ Flatten maximum extents
drop_z dxf:header:$extmin             \ Flatten minimum extents

: dxf:header:$acadver                 \ $ACADVER needs special processing
    "AC1006" 1 setgroup               \ Substitute R10's version code
;

: dxf:header:$dimscale                \ $DIMSCALE needs special processing
    40 group 0.0 f= if                \ If it's zero (for paper space)...
        1.0 40 setgroup               \ ...substitute 1.0
    then
;


(   Symbol tables to delete or modify   )

remove dxf:tables:appid               \ Registered application table
remove dxf:tables:dimstyle            \ Dimension style table

: dxf:tables:layer                    \ For the LAYER table...
    0 group "LAYER" strcmp 0=         \ For each LAYER (but not TABLE/ENDTAB)
    70 group? and if                  \ If there's a 70 (flags) group...
        70 group 48 and if            \ ...and its 16 or 32 bits are set...
            1 delitem !               \ ...drop this dependent layer
        else
            70 group 1 and            \ else zero any new flag bits...
            70 setgroup               \ ...and update the 70 group
        then
    then
;


(   Entities to delete   )

remove dxf:blocks:viewport            \ Viewport entities in blocks
remove dxf:entities:viewport          \ Viewport entities


(   Block definition transformations   )

: dxf:blocks:block                    \ In block definition...
    70 group? if
        70 group 3 and 70 setgroup    \ ... clear Xref & dependent bits
    then
    1 delgroup                        \ Remove Xref path group...
    3 delgroup                        \ ...and new block name group
;


(   Dimension entity transformations   )

ditchgroup dxf:*:dimension:3          \ Drop dimension style
ditchgroup dxf:*:dimension:52         \ Drop obliquing angle
ditchgroup dxf:*:dimension:53         \ Drop text rotation angle
ditchgroup dxf:*:dimension:54         \ Drop bogus extra angle if present


(   Delete extended entity data   )

ditchgroup dxf:*:*:1000-1100          \ Drop all Xdata fields


(   Translate vertical text alignment   )

textvadj dxf:*:text:73
textvadj dxf:*:attdef:74
textvadj dxf:*:attrib:74


(   Delete paper space entities and the space indicator   )

: dxf:*:*:67
    group 0= if
        67 delgroup                   \ Model space entity: drop 67 group
    else
        1 delitem !                   \ Paper space entity: drop the entity
    then
;


\   Translate polyface meshes into equivalent 3DFACEs

variable pfacing                      \ Polyface processing underway
variable pfaced                       \ Polyface temporary file is open
file pfacefile                        \ Polyface temporary file
variable rinvis                       \ Invisibility bits for 3DFACE
variable rogroup                      \ Output vertex point group code
variable rxgroup                      \ Vertex index group code
variable rvcount                      \ Number of vertices in file
24 constant rvlen                     \ Length of vertex item in temp file
3 1 8 array vertex                    \ Vertex array for I/O

(  Polyline header.  If the 70 group is flagged as introducing a polyface,
   delete it, set the flag to indicate we're translating a polyface, and
   open the temporary file we use to hold vertices.  )

: dxf:*:polyline:70
    group 64 and if
        1 delitem !
        1 pfacing !
        0 rvcount !
        pfaced @ 0= if
            "$pface.$ac" 15 pfacefile fopen pfaced !
            pfaced @ not if
                ." "Cannot open polyface temporary file.\n"
            then
        then
    then
;

(  Sequence end.  If we're in a polyface, delete it and mark
   translation of the polyface complete.  We leave the temporary
   file open so subsequent polyfaces can reuse it.  This eliminates
   the overhead of opening and closing the file for every entity we
   translate.  The file is closed and deleted at DXF:END time.  )

: dxf:*:seqend
    drop
    pfacing @ if
        1 delitem !
        0 pfacing !
    then
    1 specialdone !
;

(  Replace a vertex index group [GCODE] with a point-coordinate group
   [VCODE], setting invisibility bit [IBIT] if the vertex index was
   negative.  )

: pfacejam                            \ vcode ibit gcode --
    rot 
    rogroup !
    dup rxgroup !
    dup group? if
        group
        dup 0< if
            swap rinvis @ or rinvis !
        else
            swap drop
        then
        abs 1-
        rvlen *
        0 pfacefile fseek
        pfacefile rvlen 0 vertex fread rvlen = if
            rxgroup @ delgroup
            rogroup @ addgroup
            0 vertex 2@
            1 vertex 2@
            2 vertex 2@
            rogroup @ setgroup
        else
            ." "Vertex read error.\n"
        then
    else
        drop
    then
;

(  Process vertex.  If we're in a polyface, the vertex is translated
   into a POINT, LINE, or 3DFACE entity depending upon the number of
   vertices it contains.  Since the entity property fields are left
   unchanged, the replacement entity will correctly inherit the modes
   specified in the VERTEX entity.  )

: dxf:*:vertex:70
    drop
    pfacing @ if
        70 group 64 and if
            1 delitem !
            pfaced @ if
                10 group
                2 vertex 2!
                1 vertex 2!
                0 vertex 2!
                rvcount @ rvlen * 0 pfacefile fseek
                1 rvcount +!
                rvlen 0 vertex pfacefile fwrite
                rvlen <> if
                    ." "Vertex write error.\n"
                then
            then
        else
            70 group 128 and if
                72 group? if
                    73 group? if
                        0 rinvis !
                        "3DFACE" 0 setgroup
                        10 delgroup
                        10 1 71 pfacejam
                        11 2 72 pfacejam
                        12 4 73 pfacejam
                        74 group? if
                            13 8 74 pfacejam
                        else
                            ( Face has 3 vertices.  Represent this in the
                              3DFACE by setting the third and fourth vertices
                              the same and replicating the invisibility bit
                              for the closing edge. )
                            13 addgroup
                            12 group
                            13 setgroup
                            rinvis @ 4 and if
                                rinvis @ 8 or rinvis !
                            then
                        then
                        rinvis @ 70 setgroup
                    else
                        ( Generate line for 2 vertex face )
                        "LINE" 0 setgroup
                        10 delgroup
                        70 delgroup
                        10 0 71 pfacejam
                        11 0 72 pfacejam
                    then
                else
                    ( Generate point for 1 vertex face )
                    "POINT" 0 setgroup
                    70 delgroup
                    10 delgroup
                    10 0 71 pfacejam
                then
            then
        then
    else
        70 group 0x7F and 70 setgroup \ Clear polyface bit
    then
;


\   Termination processing

: dxf:end
    pfaced @ if
        pfacefile fclose              \ Close the file
        "$pface.$ac" fdelete drop     \ Delete polyface temporary file
        0 pfaced !
    then
    "m" option if                     \ If -M option is set, print memory stats
        memstat
    then
    "End translation.\n" type
    depth if
        .s cr
    then
;

