📄 atlast.dxt
字号:
;
\ ************ 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
\ dumpspecial
false maxset !
false minset !
false handleson !
false needToRewind ! \ Only redo the translation if necessary.
false delEndBlock !
\ true trace \ Un-comment for debugging.
;
\ 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
512 string longString
: 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"
;
\ Stack on entering: Stack on leaving:
: cmove ( ... from to n ) ( ... )
0 do ( ... from to )
2dup swap ( ... from to to from )
i + c@ ( ... from to to cfrom+i )
swap i + ( ... from to cfrom+i to+i )
c! ( ... from to )
loop
drop drop ( ... )
;
\ Stack on entering: Stack on leaving:
\ : strncmp ( ... str1 str2 n ) ( ... t/f )
\ \ Temporarily truncate the strings to n characters.
\ dup ( ... str1 str2 n n )
\ 2 pick + dup ( ... str1 str2 n str2+n str2+n )
\ c@ ( ... str1 str2 n str2+n cstr2+n )
\ swap ( ... str1 str2 n cstr2+n str2+n )
\ 0 swap ( ... str1 str2 n cstr2+n 0 str2+n )
\ c! ( ... str1 str2 n cstr2+n )
\ swap dup ( ... str1 str2 cstr2+n n n )
\ 4 pick + dup ( ... str1 str2 cstr2+n n str1+n str1+n )
\ c@ ( ... str1 str2 cstr2+n n str1+n cstr1+n )
\ swap ( ... str1 str2 cstr2+n n cstr1+n str1+n )
\ 0 swap ( ... str1 str2 cstr2+n n cstr1+n 0 str1+n )
\ c! ( ... str1 str2 cstr2+n n cstr1+n )
\ swap ( ... str1 str2 cstr2+n cstr1+n n )
\ 4 pick ( ... str1 str2 cstr2+n cstr1+n n str1 )
\ 4 pick ( ... str1 str2 cstr2+n cstr1+n n str1 str2 )
\ strcmp ( ... str1 str2 cstr2+n cstr1+n n t/f )
\
\ \ Put the strings back the way they were.
\ 3 roll ( ... str1 str2 cstr1+n n t/f cstr2+n )
\ 4 roll ( ... str1 cstr1+n n t/f cstr2+n str2 )
\ 3 pick + ( ... str1 cstr1+n n t/f cstr2+n str2+n )
\ c! ( ... str1 cstr1+n n t/f )
\ 2 roll ( ... str1 n t/f cstr1+n )
\ 3 roll ( ... n t/f cstr1+n str1 )
\ 3 roll + ( ... t/f cstr1+n str1+n )
\ c! ( ... t/f )
\ ;
\ Equivalent to ROLL only used on doubles.
\ The stack trace shown below uses 1 as an example.
\ Doubles are represented as 2 words (eg. z1 z2).
\ Stack on entering: Stack on leaving:
: 2roll ( ... z1 z2 x1 x2 y1 y2 1 ) ( ... z1 z2 y1 y2 x1 x2 )
dup ( ... z1 z2 x1 x2 y1 y2 1 1 )
1+ 2* ( ... z1 z2 x1 x2 y1 y2 1 4 )
roll ( ... z1 z2 x2 y1 y2 1 x1 )
swap ( ... z1 z2 x2 y1 y2 x1 1 )
2* 1+ ( ... z1 z2 x2 y1 y2 x1 3 )
roll ( ... z1 z2 y1 y2 x1 x2 )
;
\ Stack on entering: Stack on leaving:
: 2pick ( ... z1 z2 x1 x2 y1 y2 1 ) ( ... z1 z2 x1 x2 y1 y2 x1 x2 )
dup ( ... z1 z2 x1 x2 y1 y2 1 1 )
1+ 2* ( ... z1 z2 x1 x2 y1 y2 1 4 )
pick ( ... z1 z2 x1 x2 y1 y2 1 x1 )
swap ( ... z1 z2 x1 x2 y1 y2 x1 1 )
2* 1+ ( ... z1 z2 x1 x2 y1 y2 x1 3 )
pick ( ... z1 z2 x1 x2 y1 y2 x1 x2 )
;
\ Add 2 3Dpoints (composed of doubles).
\ Stack on entering: Stack on leaving:
: 2pointadd ( ... x1 y1 z1 x2 y2 z2 ) ( ... x3 y3 z3 )
3 2roll ( ... x1 y1 x2 y2 z2 z1 )
f+ ( ... x1 y1 x2 y2 z3 )
1 2roll ( ... x1 y1 x2 z3 y2 )
3 2roll ( ... x1 x2 z3 y2 y1 )
f+ ( ... x1 x2 z3 y3 )
3 2roll ( ... x2 z3 y3 x1 )
3 2roll ( ... z3 y3 x1 x2 )
f+ ( ... z3 y3 x3 )
1 2roll ( ... z2 x3 y3 )
2 2roll ( ... x3 y3 z3 )
;
\ Multiply all components of a point (composed of doubles) by a double scalar.
\ Stack on entering: Stack on leaving:
: 2scalarMult ( ... x1 y1 z1 n ) ( ... x2 y2 z2 )
2dup ( ... x1 y1 z1 n n )
4 2roll ( ... y1 z1 n n x1 )
f* ( ... y1 z1 n x2 )
2swap 2dup ( ... y1 z1 x2 n n )
4 2roll ( ... z1 x2 n n y1 )
f* ( ... z1 x2 n y2 )
2swap ( ... z1 x2 y2 n )
3 2roll ( ... x2 y2 n z1 )
f* ( ... x2 y2 z2 )
;
\ Divide all components of a point (composed of doubles) by a double scalar.
\ Stack on entering: Stack on leaving:
: 2scalarDiv ( ... x1 y1 z1 n ) ( ... x2 y2 z2 )
2dup ( ... x1 y1 z1 n n )
4 2roll ( ... y1 z1 n n x1 )
2swap ( ... y1 z1 n x1 n )
f/ ( ... y1 z1 n x2 )
2swap 2dup ( ... y1 z1 x2 n n )
4 2roll ( ... z1 x2 n n y1 )
2swap ( ... z1 x2 n y1 n )
f/ ( ... z1 x2 n y2 )
2swap ( ... z1 x2 y2 n )
3 2roll ( ... x2 y2 n z1 )
2swap ( ... x2 y2 z1 n )
f/ ( ... x2 y2 z2 )
;
\ Stack on entering: Stack on leaving:
: 2pointprint ( ... x1 y1 z1 ) ( ... x1 y1 z1 )
2 2roll 2dup ( ... y1 z1 x1 x1 )
." "X=" f. ( ... y1 z1 x1 )
2 2roll 2dup ( ... z1 x1 y1 y1 )
." "Y=" f. ( ... z1 x1 y1 )
2 2roll 2dup ( ... x1 y1 z1 z1 )
." "Z=" f. cr ( ... x1 y1 z1 )
;
\ Is xmax >= x1 >= xmin?
\ Stack on entering: Stack on leaving:
: inside ( ... x1 xmax xmin ) ( ... t/f )
2 2roll 2dup ( ... xmax xmin x1 x1 )
3 2roll ( ... xmin x1 x1 xmax )
f<= if ( ... xmin x1 )
\ x1 is less than or equal to xmax
f<= if ( ... )
\ xmin is less than or equal to x1
true ( ... true )
else
false ( ... false )
then
else ( ... xmin x1 )
2drop 2drop false ( ... false )
then
;
\ Stack on entering: Stack on leaving:
: extentsok ( ... ) ( ... t/f )
maxset @ minset @ and if ( ... )
\ Extents are there.
true ( ... true )
else
\ Extents are missing.
false ( ... false )
then
;
\ Is the 3D point contained withing the drawing extents?
\ Stack on entering: Stack on leaving:
: insideextents ( ... x1 y1 z1 ) ( ... t/f )
extentsok not if ( ... x1 y1 z1 )
\ If the extents are missing or malformed then exit.
2drop 2drop 2drop true exit
then
zmax 2@ zmin 2@ ( ... x1 y1 z1 zmax zmin )
inside if ( ... x1 y1 )
ymax 2@ ymin 2@ ( ... x1 y1 ymax ymin )
inside if ( ... x1 )
xmax 2@ xmin 2@ ( ... x1 xmax xmin )
inside if ( ... )
true ( ... true )
else ( ... )
false ( ... false )
then
else ( ... x1 )
2drop false ( ... false )
then
else ( ... x1 y1 )
2drop 2drop false ( ... false )
then
;
\ Initialize the high and low values for point * scalar multiplication
\ Stack on entering: Stack on leaving:
: initbignumrange ( ... ) ( ... )
bignum bignumhi 2!
1.0 bignum f/ bignumlo 2!
;
\ Find a logarithmic mean between bignumhi and bignumlo
\ Stack on entering: Stack on leaving:
: bignummean ( ... ) ( ... f )
bignumhi 2@ log
bignumlo 2@ log
f+ 2.0 f/
e 2swap pow
;
\ Stack on entering: Stack on leaving:
: goodenough ( ... ) ( ... t/f )
bignumlo 2@ bignumhi 2@ f- fabs bignumerror f<
;
( 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 )
: dxf:header:$acadver \ $ACADVER needs special processing
"AC1009" 1 setgroup \ Substitute R12'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:header:$celtscale
remove dxf:header:$delobj
remove dxf:header:$dispsilh
remove dxf:header:$dimjust
remove dxf:header:$dimsd1
remove dxf:header:$dimsd2
remove dxf:header:$dimtolj
remove dxf:header:$dimtzin
remove dxf:header:$dimaltz
remove dxf:header:$dimalttz
remove dxf:header:$dimfit
remove dxf:header:$dimupt
remove dxf:header:$dimunit
remove dxf:header:$dimdec
remove dxf:header:$dimtdec
remove dxf:header:$dimaltu
remove dxf:header:$dimalttd
remove dxf:header:$dimtxsty
remove dxf:header:$dimaunit
remove dxf:header:$chamferc
remove dxf:header:$chamferd
remove dxf:header:$pickstyle
remove dxf:header:$cmlstyle
remove dxf:header:$cmljust
remove dxf:header:$cmlscale
remove dxf:header:$saveimages
\ comment the following statements out if you need the variabels
remove dxf:header:$dwgcodepage
remove dxf:header:$treedepth
remove dxf:header:$pinsbase
: dxf:header:$extmax
true maxset !
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -