Include "equ.h"
 Include "impequ.h"



 SECTION DR2D,CODE,PUBLIC
***************************************************
***						***
***************************************************
dumbentry:
	clr.l	d0
	rts

	dc.l	"IMPO"		; magik number for pic import
	dc.w	201
	dc.l	0

table:	dc.l	0
	dc.l	name,special,check,DR2D


***************************************
***     Is it really IFF DR2D?      ***
***************************************
check:	move.l	table,a0
	move.l	buff1(a0),a1
	move.l	(a1),a1
	cmp.l	#"FORM",(a1)
	bne	never
	cmp.l	#"DR2D",8(a1)
	bne	never
	bra	right

***********************************
***                             ***
***********************************
DR2D:	move.l	sp,savesp
        
	move.l	table,a0                ;open the file
	move.l	f_openr(a0),a0
	jsr	(a0)
	bne	impobj
        
        rts

*********************************
*                               *
*********************************
impobj:	
        ;init variables
        clr.l   cmaptab                 ;zero pointers
        clr.l   cmyktab
        clr.l   cnamtab
        clr.w   numcolors               ;numcolors = 0
        clr.l   flag                    ;set flag to 0
        clr.l   gsp                     ;set group stack counter to 0;
        move.l  #$00e10000,fact1        ;default to inch incase no PPRF chunk
        move.w  #72,fact100
        move.l  #36,exp1
        
        move.l	table,a0                ;open the object
	move.l	o_open(a0),a0
	jsr	(a0)
	beq	abort0

        move.l  table,a0                ;start a group
        move.l  o_begingroup(a0),a0
        jsr     (a0)
                
        bsr     getpicinfo              ;get the object's data
        
        move.l  table,a0                ;end the group
        move.l  o_endgroup(a0),a0
        jsr     (a0)
        
        bsr     freemem                 ;free all the memory m_alloc'ed
                
        move.l	table,a0                ;close the object
	move.l	o_close(a0),a0
	jsr	(a0)

	move.l	table,a0                ;close the file
	move.l	f_closer(a0),a0
	jsr	(a0)
        
        rts                             ;finished - return to PageStream
        

*********************************
*                               *
*********************************
abortobj:
	move.l	table,a0
	move.l	o_abort(a0),a0
	jsr	(a0)

abort0:	move.l	table,a0
	move.l	f_closer(a0),a0
	jmp	(a0)
 
       
*********************************
*                               *
*********************************
getpicinfo:
	bsr	pgetl		; "FORM"
	bsr	pgetl		; length of form
	move.l	d0,length
	bsr	pgetl		; "DR2D"
	sub.l	#4,length

getchunk:
	bsr	pgetl		;get chunk type in temp
	move.l	d0,temp
	bsr	pgetl           ;get chunk length in clength
	move.l	d0,clength
	sub.l	#8,length       ;sub 8 from length of file left
	move.l	temp,d0
        
	lea	chunks-4,a0     ;get address of chunk table
	move.w	numchunks,d1    ;number of chunks in table

gc1:	lea	4(a0),a0        ;get address of next chunk type
	cmp.l	(a0)+,d0        
	dbeq	d1,gc1          ;loop until end of table or a match
        
	move.l	(a0),a0         ;get address of routine to use for this chunk
	jsr	(a0)            ;do it

	tst.l	length          ;is there any data left in the FORM?
	bne	getchunk        ;yes
                
        bclr    #2,flag         ;attr is valid only for this form
        
rrts:	rts                     ;everything is OK


***********************************
***				***
***********************************
attr:   bset    #2,flag                 ;set attr flag to found
        bsr     pget
        move.b  d0,filltype
        bsr     pget
        move.b  d0,jointype             ;only miter and rounded supported
        bsr     pget
        move.b  d0,edgepattern          ;id of dash pattern to use
        bsr     pget    
        move.b  d0,arrowhead            ;id of arrow head to use
        bsr     pgetw
        move.w  d0,fillvalue            ;color or object to fill with
        bsr     pgetw
        move.w  d0,edgecolor            ;color of edge line
        bsr     pgetw                   ;skip layer info
        bsr     getieee7200
        move.l  d0,linewidth            ;width of edge line
        bra     adjlen
        
***********************************
***				***
***********************************
arow:   bsr     pget                    ;arrow flags
        move.b  d0,aflags
        bsr     pget                    ;throw away this byte
        bsr     pgetw
        lea     arrowtable,a1
        move.b  aflags,0(a1,d0.w)       ;store arrow flags in table
        
arow1:  subq.l  #4,clength              ;adjust length for what i read
        subq.l  #4,length
        bra     skip                    ;skip the rest
        
***********************************
***				***
***********************************
bbox:   bset    #0,flag                 ;the next obj has a bounding box

        bsr     getieee7200
        move.l  d0,object+ob_Left
        
        bsr     getieee7200
        move.l  d0,object+ob_Top
        
        bsr     getieee7200
        move.l  d0,object+ob_Right
        
        bsr     getieee7200
        move.l  d0,object+ob_Bottom
        
        bra     adjlen

***********************************
***				***
***********************************
cnam:   tst.w   numcolors               ;has a CMAP or CMYK chunk been found?
        beq     skip                    ;no, so skip the names
        
        tst.l   cnamtab                 ;has a cnamtab been allocated yet?
        bne     cnam1                   ;yes, so don't do it again
        clr.l   d0
        move.w  numcolors,d0
        lsl.l   #2,d0
        clr.l   d1
        clr.l   d2
        move.l  table,a0
        move.l  m_alloc(a0),a0
        jsr     (a0)
        beq     errrts
        move.l  a0,cnamtab
        
        move.l  (a0),a0                 ;clear the cnam table pointers
        move.w  numcolors,d0
cnam0:  clr.l   (a0)+
        dbf     d0,cnam0
        
cnam1:  bsr     pgetw                   ;get the starting color index number
        move.l  d0,start
        bsr     pgetw                   ;get the ending color index number
        move.l  d0,end
        
        move.l  clength,d0              ;get memory to read chunk contents into
        subq.l  #4,d0
        move.l  d0,temp
        clr.l   d1
        clr.l   d2
        move.l  table,a0
        move.l  m_alloc(a0),a0
        jsr     (a0)
        beq     errrts
        move.l  a0,cnamchunk
        move.l  (a0),a1
        
cnam2:  move.l  a1,-(sp)
        bsr     pget                    ;read in chunk contents
        move.l  (sp)+,a1
        move.b  d0,(a1)+
cnam3:  sub.l   #1,temp
        bne     cnam2
        
        bsr     putcnam                 ;put the color names into cnamtab
        
        move.l  cnamchunk,a0            ;free memory needed for cnam chunk
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)
        
        bra     adjlen

***********************************
***				***
***********************************
cmap:   move.l  clength,d0
        move.l  d0,d1
        divu    #3,d1                   ;d0 = number of color defs
        move.w  d1,numcolors
        move.w  d1,tempw1
        add.w   d1,d0                   ;d0 = total length of my cmap struct
        clr.l   d1
        clr.l   d2
        move.l  table,a0
        move.l  m_alloc(a0),a0
        jsr     (a0)
        beq     errrts
        
        bset    #6,flag                 ;bit 6 = CMAP found
        move.l  a0,cmaptab
        move.l  (a0),a0
       
cmap1:  move.l  a0,-(sp)
        bsr     pget
        move.b  d0,red
        bsr     pget
        move.b  d0,green
        bsr     pget
        move.b  d0,blue
        move.l  (sp)+,a0
        move.b  #0,(a0)+                ;pagestream equiv color code
        move.b  red,(a0)+               ;red
        move.b  green,(a0)+             ;green
        move.b  blue,(a0)+              ;blue
        
        subq.w  #1,tempw1
        bne     cmap1

        bra     adjlen

***********************************
***				***
***********************************
cmyk:   move.l  clength,d0
        move.l  d0,d1
        divu    #4,d1                   ;d0 = number of color defs
        move.w  d1,numcolors
        move.w  d1,tempw1
        add.w   d1,d0                   ;d0 = total length of my cmap struct
        clr.l   d1
        clr.l   d2
        move.l  table,a0
        move.l  m_alloc(a0),a0
        jsr     (a0)
        beq     errrts
        
        bset    #6,flag                 ;bit 6 = CMAP found
        move.l  a0,cmyktab
        move.l  (a0),a0
       
cmyk1:  move.l  a0,-(sp)
        bsr     pget
        move.b  d0,cyan
        bsr     pget
        move.b  d0,magenta
        bsr     pget
        move.b  d0,yellow
        bsr     pget
        move.b  d0,black
        
        move.l  (sp)+,a0
        move.b  #0,(a0)+                ;pagestream equiv color code (0=none)
        move.b  cyan,(a0)+              ;cyan
        move.b  magenta,(a0)+           ;magenta
        move.b  yellow,(a0)+            ;yellow
        move.b  black,(a0)+             ;black
        
        subq.w  #1,tempw1
        bne     cmyk1

        bra     adjlen

***********************************
***				***
***********************************
cply:   btst    #4,flag                 ;is this a fill object?
        bne     cply1                   ;yes - so skip
        
        bset    #3,flag                 ;set closed poly flag
        bra     ply                     ;do poly stuff
        
cply1:  bclr    #4,flag                 ;clear the fill flag
        bra     skip        

***********************************
***				***
***********************************
dash:   bsr     pgetw                   ;get id of dash
        move.w  d0,dashid               ;id of 0 means no line at all
        bsr     pgetw
        move.w  d0,numdashes            ;numdashes of 0 means solid line
        
        lea     dashtable,a1
        move.w  dashid,d0
        cmp.w   #0,dashid 
        bne     dash1
        move.b  #0,d1
        bra     dash3
        
dash1:  cmp.w   #0,numdashes
        bne     dash2
        move.b  #1,d1
        bra     dash3
        
dash2:  move.b  #5,d1
dash3:  move.b  d1,0(a1,d0.w)           ;store dash code: 0 = no line
                                        ;1 = solid line, 5 = dashed line
        subq.l  #4,length
        subq.l  #4,clength
        bne     dash4
        rts
        
dash4:  bra     skip

                
***********************************
***				***
***********************************
drhd:
        clr.l   flag2
        bsr     getieee7200
        move.l  d0,xleft
        bsr     getieee7200
        move.l  d0,ytop
        bsr     getieee7200
        move.l  d0,xright
        bsr     getieee7200
        move.l  d0,ybottom
        
        move.l  xleft,d0                ;is xleft<xright?
        cmp.l   xright,d0
        ble     drhd1                   ;yes
        bset    #0,flag2

drhd1:  move.l  ytop,d0                 ;is xtop<xbottom?
        cmp.l   ybottom,d0
        ble     drhd2                   ;yes
        bset    #1,flag2
        
drhd2:  bra     adjlen

        
***********************************
***				***
***********************************
fill:   bset    #4,flag                 ;the next object is a fill object
        bra     skip


***********************************
***				***
***********************************
fons:   bsr     pget
        move.b  d0,fontid
        bsr     pgetw                   ;throw away 2 bytes
        bsr     pget
        move.b  d0,serifflag
        move.l  clength,d3              ;get the font name
        subq.l  #4,d3
        
        lea     buffer,a2
fons1:  bsr     pget
        move.b  d0,(a2)+
        subq.l  #1,d3
        bne     fons1
        clr.b   (a2)
        
        lea     buffer,a0
        move.l  table,a1
        clr.l   d0
        move.l  findfontname(a1),a1
        jsr     (a1)
        bne     fons2                   ;found font!
         
        clr.l   d0
        move.b  serifflag,d0            ;serif flag. 1=SERIF; 0=SANSERIF (?)
        or.l   #$ff000000,d0
        
fons2:  lea     fonttable,a0
        clr.w   d1  
        move.b  fontid,d1
        lsl.w   #2,d1
        move.l  d0,0(a0,d1.w)
        bra     fons3
        
fons3: bra      adjlen
        
***********************************
***				***
***********************************
form:   btst    #4,flag                 ;is this a fill form?
        bne     form1                   ;yes!
        
        move.l  length,-(sp)
        move.l  clength,-(sp)  
        move.l  clength,length
        bsr     pgetl                   ;'DR2D'
        subq.l  #4,length
        
        bsr     getchunk                ;handle nested FORM's
        
        move.l  (sp)+,clength
        move.l  (sp)+,length
        
        btst    #5,flag                 ;did i finish a grup?
        beq     form0                   ;no
        
        move.l  table,a0                ;yes - so end the group
        move.l  o_endgroup(a0),a0
        jsr     (a0)
        
        sub.l   #1,gsp                  ;decrement the group stack counter
        bne     form0                   ;if not zero, I'm still in  a group
        
        bclr    #5,flag                 ;else clear group flag
        
form0:  bra     adjlen

form1:  bclr    #4,flag
        bra     skip
        
***********************************
***				***
***********************************
grup:   bsr     pgetw
        tst.w   d0
        beq     grup1
        
        bset    #5,flag                 ;bit 5 = GRUP chunk
        move.l  table,a0
        move.l  o_begingroup(a0),a0
        jsr     (a0)
        
        add.l   #1,gsp                  ;increment the group stack counter
        
grup1:  bra     adjlen

***********************************
***				***
***********************************
oply:   btst    #4,flag                 ;is this a fill object?
        bne     oply1                   ;yes
        
        bclr    #3,flag                 ;clear closed poly flag
        bra     ply                     ;do poly stuff

oply1:  bclr    #4,flag                 ;clear the fill flag
        bra     skip
        
        
***********************************
***				***
***********************************
pprf:   move.l  clength,d1
        
        lea     buffer,a0
        bra     pprf2
pprf1:  move.l  a0,-(sp)
        move.w  d1,-(sp)
        bsr     pget
        move.w  (sp)+,d1
        move.l  (sp)+,a0
        move.b  d0,(a0)+
pprf2:  dbf     d1,pprf1
      
        lea     buffer,a0               ;is it in inches?
        lea     inch,a1                 ;inches = 7200
pprf3:  cmp.b   (a0)+,(a1)+
        bne     pprf4
        tst.b   (a1)
        bne     pprf3
        move.l  #$00e10000,fact1
        move.w  #72,fact100
        move.l  #36,exp1                ;exponent for 7200 (12) + 24
        bra     adjlen
        
pprf4:  lea     buffer,a0               ;is it in picas?
        lea     pica,a1                 ;pica = 1200
pprf5:  cmp.b   (a0)+,(a1)+
        bne     pprf6
        tst.b   (a1)
        bne     pprf5
        move.l  #$00960000,fact1        
        move.w  #12,fact100
        move.l  #34,exp1                ;exponent for 1200 (10) + 24
        bra     adjlen
        
pprf6:  lea     buffer,a0               ;is it in inches?
        lea     cm,a1                   ;cm = 2835
pprf7:  cmp.b   (a0)+,(a1)+
        bne     pprf8
        tst.b   (a1)
        bne     pprf7
        move.l  #$00b13000,fact1
        move.w  #28,fact100
        move.l  #35,exp1                ;exponent for 2836 (11) + 24
        bra     adjlen
        
pprf8:  move.l  #$00e10000,fact1        ;unknown type so - default to inches
        move.w  #72,fact100
        move.l  #36,exp1
        bra     adjlen  
              
***********************************
***				***
***********************************
stxt:   bsr     setobjdef
        
        bsr     pgetw
        move.w  d0,fontid
        bsr     getieee7200
        move.l  d0,charw
        bsr     getieee7200
        move.l  d0,charh
        bsr     getieee7200
        move.l  d0,basex
        bsr     getieee7200
        move.l  d0,basey
        bsr     getieee
        move.l  d0,rotation
        bsr     pgetw
        move.w  d0,numchars

        move.l  table,a0
        move.l  m_alloc(a0),a0
        clr.l   d1
        clr.l   d2
        clr.l   d0
        move.w  numchars,d0
        jsr     (a0)
        beq     errrts

        move.l  a0,string
        move.l  (a0),a0
        move.w  numchars,d1  
        bra     stxt2
                
stxt1:  move.l  a0,-(sp)
        move.w  d1,-(sp)   
        bsr     pget
        move.w  (sp)+,d1
        move.l  (sp)+,a0
        move.b  d0,(a0)+
stxt2:  dbf     d1,stxt1

        btst    #0,flag         ;does this object have a bounding box?
        bne     stxt3           ;yes!
        
        move.l  basex,d0
        move.l  d0,object+ob_Left
        move.l  charw,d1
        mulu    numchars,d1
        add.l   d1,d0
        sub.l   charw,d0
        move.l  d0,object+ob_Right
        
        move.l  basey,d0
        move.l  d0,object+ob_Bottom
        move.l  charh,d1
        mulu    #5,d1
        divu    #26,d1
        and.l   #$0000ffff,d1
        add.l   d1,d0
        move.l  d0,object+ob_Bottom
        sub.l   charh,d0
        move.l  d0,object+ob_Top
        
stxt3:  move.w  #25,object+ob_LWidth
        move.b  #0,object+ob_LType
        move.b  #ttxt,object+ob_Type
        
        btst    #2,flag                 ;was an ATTR chunk found?
        beq     stxt30                  ;no

        cmp.b   #1,filltype             ;is it filled with a color?
        bne     stxt30                  ;no
                
        move.w  fillvalue,d0
        bsr     addcolor
        move.b  d0,object+ob_FColor
        move.w  edgecolor,d0
        bsr     addcolor
        move.b  d0,object+ob_LColor
        
stxt30: bsr     putobj
        
	lea	column,a0
	move.b	#1,cm_LCalc(a0)
	move.b	#1,cm_QCalc(a0)

	move.l	object+ob_Left,cm_Left(a0)
	move.l	object+ob_Top,cm_Top(a0)
        move.l	#$7fffff,cm_Right(a0)
	move.l	#$7fffff,cm_Bottom(a0)

	clr.w	cm_Flag(a0)
        
        lea     fonttable,a1
        move.w  fontid,d0
        lsl.w   #2,d0
        cmp.b   #$ff,0(a1,d0.w)
        beq     st0
        
        move.l  0(a1,d0.w),d0
        move.l	d0,cm_Font(a0)
        bra     st2
        
st0:    move.l  0(a1,d0.w),d1
        move.l  #1000,d2
        tst.b   d1
        beq     st1
        move.l  #5000,d2
st1:    move.l  d2,cm_Font(a0)
        
st2:	clr.l	cm_Attrb(a0)
	move.l	charw,cm_XPoint(a0)
	move.l	charh,cm_YPoint(a0)
	clr.w	cm_Spacing(a0)
	move.w	#$8000,cm_Lead(a0)
	clr.w	cm_BMod(a0)
	clr.w	cm_PIndent(a0)
	clr.w	cm_LIndent(a0)
	clr.w	cm_RIndent(a0)
	clr.b	cm_Tag(a0)
	clr.b	cm_Justify(a0)		;block left
	;move.b	#9,cm_CFill(a0)
        move.b  #9,cm_CFStyle(a0)       ; fill style?
	move.b	#1,cm_CFColor(a0)
        clr.b   cm_CLStyle(a0)
        clr.w   cm_CLWidth(a0)
        clr.b   cm_CLColor(a0)
        
	clr.l	cm_Tabs(a0)

        move.l  #cm_Sizeof,d0
	move.l	table,a0
	move.l	o_malloc(a0),a0
	jsr	(a0)
	bne	stxt31
        
        move.l  string,a0
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)

        bra     errrts

stxt31: lea     column,a1
        move.w  #cm_Sizeof,d0
        lsr.w   #1,d0
        bra     stxt5
stxt4:	move.w	(a1)+,(a0)+
stxt5:	dbf	d0,stxt4

        clr.l   d0
        move.w  numchars,d0
        subq.w  #1,d0
        move.l  table,a0
        move.l  o_putl(a0),a0
        jsr     (a0)
        
        move.l  table,a0
        move.l  o_malloc(a0),a0
        clr.l   d0
        move.w  numchars,d0
        bclr    #0,d0
        jsr     (a0)
        bne     stxt6
        
        move.l  string,a0
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)

        bra     errrts
        
stxt6:  move.l  string,a1
        move.l  (a1),a1
        clr.l   d0
        move.w  numchars,d0
        subq.w  #1,d0
        bra     stxt8
              
stxt7:  move.b  (a1)+,(a0)+
stxt8:  dbf     d0,stxt7
      
        move.l  string,a0
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)
        
        bra     adjlen

***********************************
***				***
***********************************
skip:	move.l	clength,d0
	add.l	#1,d0
	bclr	#0,d0
	sub.l	d0,length

sk1:	move.l	d0,-(sp)
	bsr	pgetw
	move.l	(sp)+,d0
	sub.l	#2,d0
	bgt	sk1
	rts


***********************************
***				***
***********************************
ply:
        bsr     setobjdef               ;set up default values for the object
        bsr     pgetw
        move.w  d0,count                ;d4 = number of point pairs to read
        
	mulu	#10,d0		        ;max bytes per pair = 10
        btst    #3,flag                 ;is this a close poly?
        bne     ply1                    ;yes!
        add.l   #ply_Sizeof+4,d0        ;4 = newpath+strokepath
        bra     ply2
        
ply1:   add.l	#ply_Sizeof+6,d0	;6 = new+close+(fill or stroke)

ply2:	clr.l	d1                      ;allocate temp memory for object data
	clr.l	d2
	move.l	table,a0
	move.l	m_alloc(a0),a0
	jsr	(a0)
	beq	errrts

	move.l	a0,mptr
	move.l	(a0),a4
	lea	ply_Sizeof(a4),a4
	move.l	a4,pptr

        cmp.w   #2,count                ;is it a line? (2 points) 
        beq     ply3                    ;no
        move.b  #tpoly,object+ob_Type
        bra     ply4
        
ply3:   move.b  #tdln,object+ob_Type
        
ply4:   move.w  count,d0
        move.l  pptr,a0
        move.w  #NEWPATH,(a0)+
        bclr    #1,flag                 ;clear first point flag - not found
        move.w  #ply_Sizeof+2,len       ;set starting length of poly stuff
        move.w  #1,numcom               ;set poly command counter to 1

        btst    #0,flag                 ;is there a bbox for this object
        bne     ply10
        
        move.l  #$7fffffff,object+ob_Left     ;init to very large for checkLR
        move.l  #$7fffffff,object+ob_Top                
        
        move.l  #$80000000,object+ob_Right    ;init to very small for checkTB
        move.l  #$80000000,object+ob_Bottom
        
ply10:  bsr     getieee7200             ;convert fp num in d0 to integer
        bne     ply18                   ;check for INDICATOR
        
        move.l  a0,-(sp)
        bsr     pgetl                   ;get INDICATOR option
        move.l  (sp)+,a0
        subq.w  #1,count
        and.l   #$00000003,d0           ;mask off all but lower 2 bits
        cmp.l   #1,d0                   ;1=CURVETO
        beq     ply15
        cmp.l   #2,d0                   ;2=MOVETO
        beq     ply14
        cmp.l   #3,d0                   ;3=BOTH
        beq     ply13
        
        ;do something if not any of these - should never happen
        
ply13:  move.w  #MOVETO,(a0)+
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkLR                 ;check Left & Right bounds
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkTB                 ;check Top & Bottom bounds
        
        move.w  #CURVETO,(a0)+          ;bezier curve - first control point
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkLR
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkTB    

        bsr     getieee7200             ;second control point
        move.l  d0,(a0)+
        bsr     checkLR
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkTB
        
        bsr     getieee7200             ;third is the end point of the curve
        move.l  d0,(a0)+
        move.l  d0,prevx
        bsr     checkLR
        bsr     getieee7200
        move.l  d0,(a0)+
        move.l  d0,prevy
        bsr     checkTB
        
        subq.w  #4,count                ;always uses four points   
        add.w   #36,len    
        addq.w  #2,numcom  
        bra     ply19     
        
ply14:  move.w  #MOVETO,(a0)+
        bsr     getieee7200
        move.l  d0,(a0)+
        move.l  d0,prevx
        bsr     checkLR                 ;check Left & Right bounds
        bsr     getieee7200
        move.l  d0,(a0)+
        move.l  d0,prevy
        bsr     checkTB                 ;check Top & Bottom bounds
        
        subq.w  #1,count                ;adjust counts
        add.w   #10,len
        addq.w  #1,numcom
        bra     ply19
        
ply15:  btst    #1,flag                 ;is this the first point?
        bne     ply16                   ;no
        
        bset    #1,flag                 ;set first point flag to FOUND
        move.w  #MOVETO,(a0)+
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkLR
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkTB
        addq.w  #1,numcom
        add.w   #10,len
        bra     ply17
        
ply16:  bsr     getieee7200             ;get the first point
        move.l  d0,saveX                ;save it incase...
        cmp.l   prevx,d0                ;is it the same as the last X coord?
        beq     ply165                  ;yes, so check the Y coord
        
        move.w  #LINETO,(a0)+           ;if not, do a LINETO
        move.l  d0,(a0)+
        bsr     checkLR                 ;check Left & Right bounds
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkTB                 ;check Top & Bottom bounds
        
        add.w   #10,len
        addq.w  #1,numcom
        bra     ply17
                       
ply165: bsr     getieee7200             ;get the first point
        move.l  d0,saveY                ;save it incase
        cmp.l   prevy,d0                ;is it the same as the last Y coord?
        beq     ply17                   ;yes, so skip it!
        
        move.w  #LINETO,(a0)+           ;if not, do a LINETO
        move.l  saveX,d0
        move.l  d0,(a0)+
        bsr     checkLR                 ;check Left & Right bounds
        move.l  saveY,d0
        move.l  d0,(a0)+
        bsr     checkTB                 ;check Top & Bottom bounds
        
        add.w   #10,len
        addq.w  #1,numcom
        
ply17:  move.w  #CURVETO,(a0)+          ;bezier curve - first control point
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkLR
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkTB
        
        bsr     getieee7200             ;second control point
        move.l  d0,(a0)+
        bsr     checkLR
        bsr     getieee7200
        move.l  d0,(a0)+
        bsr     checkTB
        
        bsr     getieee7200             ;third is the end point of the curve
        move.l  d0,(a0)+   
        move.l  d0,prevx
        bsr     checkLR
        bsr     getieee7200
        move.l  d0,(a0)+
        move.l  d0,prevy
        bsr     checkTB
        
        subq.w  #4,count                ;always uses four points   
        add.w   #26,len    
        addq.w  #1,numcom  
        bra     ply19     
        
ply18:  btst    #1,flag                 ;is this the first point?
        bne     ply181                  ;no
        
        move.w  #MOVETO,(a0)+
        bset    #1,flag                 ;set first point flag to FOUND
        move.l  d0,(a0)+
        move.l  d0,prevx
        bsr     checkLR
        bsr     getieee7200
        move.l  d0,(a0)+
        move.l  d0,prevy
        bsr     checkTB
        bra     ply182
              
ply181: move.w  #LINETO,(a0)+
        move.l  d0,(a0)+
        move.l  d0,prevx
        bsr     checkLR                 ;check Left & Right bounds
        bsr     getieee7200
        move.l  d0,(a0)+
        move.l  d0,prevy
        bsr     checkTB                 ;check Top & Bottom bounds
        
ply182: subq.w  #1,count
        add.w   #10,len
        addq.w  #1,numcom
        
ply19:  tst.w   count
        bne     ply10

        btst    #2,flag                 ;was an attr chunk found?
        beq     ply200                  ;no
        
        move.l  linewidth,d0
        beq     ply191
        move.w  d0,object+ob_LWidth     ;set object line width
        
        move.w  edgecolor,d0
        bsr     addcolor
        move.b  d0,object+ob_LColor     ;set objects line color

ply191: lea     dashtable,a1
        clr.w   d0
        move.b  edgepattern,d0
        move.b  0(a1,d0.w),object+ob_LType      ;set objects line type
        
ply192: lea     arrowtable,a1
        clr.w   d0
        move.b  arrowhead,d0
        btst    #0,0(a1,d0.w)           ;draw arrow on first point
        beq     ply193
        move.b  #1,object+ob_LBegin        

ply193: btst    #1,0(a1,d0.w)
        beq     ply200
        move.b  #1,object+ob_LEnd       ;draw arrow on last point
        
ply200: btst    #3,flag                 ;is it a close poly?
        beq     ply202                  ;no!
        
        move.w  #CLOSEPATH,(a0)+
        addq.w  #1,numcom
        addq.w  #2,len
        
        cmp.b   #tdln,object+ob_Type    ;is it a line?
        bne     ply201                  ;no
        move.l  -16(a0),object+ob_Top
        move.l  -6(a0),object+ob_Bottom
        bsr     putobj
        bra     ply23                   ;no poly info for a tdln
        
ply201: btst    #2,flag                 ;was an attr chunk found?
        beq     ply202                  ;no
        
        cmp.b   #1,filltype             ;is it filled with a color?
        bne     ply202                  ;no - so skip fill
        
        move.b  #9,object+ob_FType      ;yes - set fill type to #9 (solid)
        move.w  #FILLPATH,(a0)+
        addq.w  #1,numcom
        addq.w  #2,len
        move.w  fillvalue,d0
        bsr     addcolor
        move.b  d0,object+ob_FColor     ;set the objects color
        
        bra     ply203
  
ply202: move.w  #STROKEPATH,(a0)+
        addq.w  #1,numcom
        addq.w  #2,len
        
        cmp.b   #tdln,object+ob_Type    ;is it a line?
        bne     ply203                  ;no

        move.l  -16(a0),object+ob_Top
        move.l  -6(a0),object+ob_Bottom
        
        bsr     putobj
        bra     ply23                   ;no poly info for a tdln
        
ply203: move.l  mptr,a0
        move.l  (a0),a0
        clr.l   d0
        move.w  len,d0
        move.l  d0,ply_Length(a0)
        
        move.l  object+ob_Right,d0
        sub.l   object+ob_Left,d0
        move.l  d0,ply_Width(a0)
        
        move.l  object+ob_Bottom,d0
        sub.l   object+ob_Top,d0
        move.l  d0,ply_Height(a0)
        
        move.w  #100,ply_XScale(a0)
        move.w  #100,ply_YScale(a0)
        move.w  numcom,ply_Count(a0)
        
        lea     ply_Sizeof(a0),a0       ;set a0 to start of poly data
        move.w  numcom,d0               ;set d0 to number of 'commands'
        bsr     adjcoords               ;adjust coords to ob_Left & ob_Top 

        bsr     putobj

	move.l	mptr,a0                 ;allocate memory for actual object
	move.l	(a0),a0
	move.l	(a0),d0
	move.l	table,a0
	move.l	o_malloc(a0),a0
	jsr	(a0)
	beq	errrts
        
	move.l	mptr,a1                 ;copy data into object
	move.l	(a1),a1
	move.l	(a1),d0
	lsr.w	#1,d0
	bra	ply22
ply21:	move.w	(a1)+,(a0)+
ply22:	dbf	d0,ply21


ply23:  move.l  mptr,a0                 ;free temp memory for object data
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)

        bclr    #0,flag                 ;bounding box only for this object

        bra     adjlen
        
***********************************
***				***
***********************************
adjlen:	move.l	clength,d0
	btst	#0,d0
	beq	al1
	bsr	pget
	move.l	clength,d0
	add.l	#1,d0

al1:	sub.l	d0,length
	rts

*********************************
*                               *
*********************************
pgetl:	move.l	table,a0
	move.l	f_getl(a0),a0
	jsr	(a0)
	beq	errrts
	rts

*********************************
*                               *
*********************************
pgetw:	move.l	table,a0
	move.l	f_getw(a0),a0
	jsr	(a0)
	beq	errrts
        and.l   #$0000ffff,d0           ;clean up d0
        rts

*********************************
*                               *
*********************************
pget:	move.l	table,a0
	move.l	f_get(a0),a0
	jsr	(a0)
	beq	errrts
        and.l   #$000000ff,d0           ;clean up d0
	rts

***********************************
***				***
***********************************
Mulu3232:
	move.l	table,a0
	move.l	mulu3232(a0),a0
	jmp	(a0)


***********************************
***				***
***********************************
Divu1648:
	move.l	table,a0
	move.l	divu1648(a0),a0
	jmp	(a0)


************************************************************
***   convert ieee floating point number to an integer   ***
************************************************************
getieee7200:
        move.l  a0,-(sp)
        bsr     pgetl
        clr.l   d1
        tst.l   d0                      ;is it all zero
        beq     ftoi3                   ;yes
        
        cmp.l   #$ffffffff,d0
        beq     ftoi4
        
        clr.b   sign
        move.l  d0,d2
        btst    #31,d2                  ;is the sign bit on?
        beq     ftoi0                   ;nope
        
        move.b  #1,sign
          
ftoi0:  move.l  d0,d2           
        and.l   #$7f800000,d2           ;get exponent into d2
        move.l  #23,d1
        lsr.l   d1,d2
        sub.b   #127,d2
        ext.w   d2
        ext.l   d2
        move.l  d2,-(sp)                ;save for later
        
        and.l   #$007fffff,d0           ;get mantissa into d1
        or.l    #$00800000,d0
        
        move.l  fact1,d1                ;inch, pica, or cm conversion factor
        bsr     Mulu3232

        move.l  #23,d2                  ;normalize product
ftoi1:  lsr.l   #1,d1                   ;it will all be in d0 (lower 24 bits)
        roxr.l  #1,d0
        dbf     d2,ftoi1
        
        move.l  (sp)+,d2                ;get exponent back into d2
        add.l   exp1,d2                 ;add exponent for fact1
        
        move.l  #45,d3
        sub.l   d2,d3                   ;subtract 45-d2 = number of lsr's -1

ftoi2:  lsr.l   #1,d0
        dbf     d3,ftoi2
        
        tst.b   sign
        beq     ftoi3
        
        not.l   d0
        addq    #1,d0
        
        
ftoi3:  moveq.l #1,d1                   ;set cc to not zero for return

ftoi4:  move.l  (sp)+,a0
        rts
        
************************************************************
***   convert ieee floating point number to an integer   ***
************************************************************
getieee:
        move.l  a0,-(sp)
        bsr     pgetl
        clr.l   d1
      
        tst.l   d0                      ;is it all zero
        beq     gtie3                   ;yes
      
        cmp.l   #$ffffffff,d0           ;check for the INDICATOR
        beq     gtie4
        
        clr.b   sign  
        move.l  d0,d2
        btst    #31,d2
        beq     gtie0
        move.b  #1,sign
        
gtie0:  and.l   #$7f800000,d2           ;get exponent into d2
        move.l  #23,d1
        lsr.l   d1,d2
        sub.b   #127,d2
        ext.w   d2
        ext.l   d2
        
        and.l   #$007fffff,d0           ;get mantissa into d1
        or.l    #$00800000,d0
        
        move.l  #22,d1                  ;d2 = number of lsr's
        sub.l   d2,d1
        
gtie1:  lsr.l   #1,d0                   ;convert to an integer
        dbf     d1,gtie1
        
        tst.b   sign
        beq     gtie3
        not.l   d0
        addq    #1,d0
        
gtie3:  moveq.l #1,d1                   ;set cc to not zero for return

gtie4:  move.l  (sp)+,a0
        rts
        
        
***************************
***                     ***
***************************
putobj:	bsr     adjobj                  ;adjust object to the page
        move.l	table,a1
	move.l	o_obj(a1),a1
	lea	object,a0
	jsr	(a1)
        beq     errrts
                
        rts
        
***************************
***                     ***
***************************
checkLR:
        btst    #0,flag                 ;is there a bounding box?
        bne     cklr2                   ;yes!
        
        cmp.l   object+ob_Left,d0
        bge     cklr1
        move.l  d0,object+ob_Left
cklr1:  cmp.l   object+ob_Right,d0
        ble     cklr2
        move.l  d0,object+ob_Right          
cklr2:  rts
        
***************************
***                     ***
***************************
checkTB:
        btst    #0,flag                 ;is there a boundoing box?
        bne     cktb2                   ;yes!
        
        cmp.l   object+ob_Top,d0
        bge     cktb1
        move.l  d0,object+ob_Top
cktb1:  cmp.l   object+ob_Bottom,d0
        ble     cktb2
        move.l  d0,object+ob_Bottom
cktb2:  rts
        
***************************
***                     ***
***************************
setobjdef:
        clr.b   object+ob_Flag
        clr.w   object+ob_Slant
        clr.w   object+ob_Twist
        
        move.b  #1,object+ob_LColor     ;black line
        move.w  #50,object+ob_LWidth    ;line width (1 point)
        move.b  #1,object+ob_LType      ;line type = solid
        
        move.b  #1,object+ob_FColor     ;solid black fill
        move.b  #0,object+ob_FType      ;fill type 0 = none
        
        clr.b   object+ob_LBegin
        clr.b   object+ob_LEnd
        clr.w   object+ob_HStandOff   
        clr.w   object+ob_VStandOff
        
        rts

***************************
***                     ***
***************************
adjcoords:                              ;a0 = start address
        move.l  object+ob_Left,d1       ;d0 = number of 'commands'
        move.l  object+ob_Top,d2
        move.l  d0,saved0
        move.l  a0,savea0
        bra     adjc3
        
adjc1:  move.w  (a0)+,d3
        cmp.w   #STROKEPATH,d3          ;skip STROKEPATH
        beq     adjc3
        
        cmp.w   #FILLPATH,d3            ;skip FILLPATH
        beq     adjc3    
        
        cmp.w   #NEWPATH,d3             ;skip NEWPATH
        beq     adjc3
        
        cmp.w   #CLOSEPATH,d3           ;skip CLOSEPATH
        beq     adjc3
        
        cmp.w   #CURVETO,d3
        beq     adjc2
        
        sub.l   d1,(a0)+                ;LINETO & MOVETO have 1 point
        sub.l   d2,(a0)+
        bra     adjc3
        
adjc2:  sub.l   d1,(a0)+                ;CURVETO has 3 points
        sub.l   d2,(a0)+
        sub.l   d1,(a0)+
        sub.l   d2,(a0)+
        sub.l   d1,(a0)+
        sub.l   d2,(a0)+
        
adjc3:  dbf     d0,adjc1

        btst    #0,flag2
        beq     adjc10

        move.l  saved0,d0
        move.l  savea0,a0
        move.l  object+ob_Right,d1
        sub.l   object+ob_Left,d1
        bra     adjc6

adjc4:  move.w  (a0)+,d3                ;get the command
        
        cmp.w   #STROKEPATH,d3          ;skip STROKEPATH
        beq     adjc6
        
        cmp.w   #FILLPATH,d3            ;skip FILLPATH
        beq     adjc6   
        
        cmp.w   #NEWPATH,d3             ;skip NEWPATH
        beq     adjc6
        
        cmp.w   #CLOSEPATH,d3           ;skip CLOSEPATH
        beq     adjc6
        
        cmp.w   #CURVETO,d3
        beq     adjc5
        
        move.l  d1,d2                    ;adjust the X coord
        sub.l   (a0),d2
        move.l  d2,(a0)+
        add.l   #4,a0                    ;skip over the Y coord
        
        bra     adjc6
        
adjc5:  move.l  d1,d2                    ;adjust the X coord
        sub.l   (a0),d2
        move.l  d2,(a0)+
        add.l   #4,a0                    ;skip over the Y coord

        move.l  d1,d2                    ;adjust the X coord
        sub.l   (a0),d2
        move.l  d2,(a0)+
        add.l   #4,a0                    ;skip over the Y coord

        move.l  d1,d2                    ;adjust the X coord
        sub.l   (a0),d2
        move.l  d2,(a0)+
        add.l   #4,a0                    ;skip over the Y coord        
        
adjc6:  dbf     d0,adjc4
        
adjc10: btst    #1,flag2
        beq     adjc20
        
        move.l  saved0,d0
        move.l  savea0,a0
        
        move.l  object+ob_Bottom,d1
        sub.l   object+ob_Top,d1
        bra     adjc19

adjc11: move.w  (a0)+,d3                ;get the command
        
        cmp.w   #STROKEPATH,d3          ;skip STROKEPATH
        beq     adjc19
        
        cmp.w   #FILLPATH,d3            ;skip FILLPATH
        beq     adjc19   
        
        cmp.w   #NEWPATH,d3             ;skip NEWPATH
        beq     adjc19
        
        cmp.w   #CLOSEPATH,d3           ;skip CLOSEPATH
        beq     adjc19
        
        cmp.w   #CURVETO,d3
        beq     adjc12
        
        ;add.l   #4,a0                    ;skip over the X coord
        ;move.l  d1,d2                    ;adjust the Y coord
        ;sub.l   (a0),d2
        ;move.l  d2,(a0)+
        
        add.l   #4,a0
        move.l  (a0),d2
        neg.l   d2
        add.l   d1,d2
        move.l  d2,(a0)+
        bra     adjc19
        
adjc12: add.l   #4,a0                    ;skip over the X coord
        ;move.l  d1,d2                    ;adjust the Y coord
        ;sub.l   (a0),d2
        ;move.l  d2,(a0)+
        move.l  (a0),d2
        neg.l   d2
        add.l   d1,d2
        move.l  d2,(a0)+
        
        add.l   #4,a0                    ;skip over the X coord
        ;move.l  d1,d2                    ;adjust the Y coord
        ;sub.l   (a0),d2
        ;move.l  d2,(a0)+
        move.l  (a0),d2
        neg.l   d2
        add.l   d1,d2
        move.l  d2,(a0)+
        
        add.l   #4,a0                    ;skip over the X coord
        ;move.l  d1,d2                    ;adjust the Y coord
        ;sub.l   (a0),d2
        ;move.l  d2,(a0)+
        move.l  (a0),d2
        neg.l   d2
        add.l   d1,d2
        move.l  d2,(a0)+
        
adjc19: dbf     d0,adjc11        
        
adjc20: rts


***********************************
***				***
***********************************
adjobj:
        btst    #0,flag2
        beq     adjo1
        
        move.l  object+ob_Right,d1
        move.l  object+ob_Left,object+ob_Right
        move.l  d1,object+ob_Left
        
        move.l  xleft,d1
        sub.l   xright,d1
        move.l  object+ob_Left,d2
        neg.l   d2
        add.l   d1,d2
        move.l  d2,object+ob_Left
        
        move.l  object+ob_Right,d2
        neg.l   d2
        add.l   d1,d2
        move.l  d2,object+ob_Right
                
adjo1:  btst    #1,flag2
        beq     adjo2
        
        move.l  object+ob_Top,d1
        move.l  object+ob_Bottom,object+ob_Top
        move.l  d1,object+ob_Bottom
        
        move.l  ytop,d1
        sub.l   ybottom,d1
        move.l  object+ob_Top,d2
        neg.l   d2
        add.l   d1,d2
        move.l  d2,object+ob_Top
        
        move.l  object+ob_Bottom,d2
        neg.l   d2
        add.l   d1,d2
        move.l  d2,object+ob_Bottom
        
adjo2:  rts
        
***********************************
***				***
***********************************
addcolor:
        movem.l a0/a1,-(sp)
        move.l  d0,d1
        move.l  d0,curcolor             ;save for getcolorname
        clr.l   d0                      ;init pgs color to zero
        
        tst.l   cmyktab                 ;is there a cmyk definition ?
        beq     addc0                   ;no, so check for a rgb def
        and.l   #$0000ffff,d1
        clr.l   d4
        mulu    #5,d1
        move.w  d1,d4
        move.l  cmyktab,a0
        move.l  (a0),a0
        move.b  0(a0,d4.w),d0
        tst.b   d0                      ;has this color been added already?
        bne     addc6                   ;yes, so get out d0=pgs color #
        
        move.w  d4,-(sp)                ;save color code for later
        
        clr.l   d0
        clr.l   d1
        clr.l   d2
        clr.l   d3
        move.b  1(a0,d4.w),d0           ;cyan
        move.b  2(a0,d4.w),d1           ;magenta
        move.b  3(a0,d4.w),d2           ;yellow
        move.b  4(a0,d4.w),d3           ;black
        move.b  d0,cyan
        move.b  d1,magenta
        move.b  d2,yellow
        move.b  d3,black
        
        mulu    #10000,d0               ;scale 0-255 cmyk to 0-10000 cmyk
        divu    #255,d0
        mulu    #10000,d1
        divu    #255,d1
        mulu    #10000,d2
        divu    #255,d2
        mulu    #10000,d3
        divu    #255,d3
        
        bra     addc4                   ;add the color from the cmyk defs
        
addc0:  tst.l   cmaptab                 ;is there a rgb cmap definition?
        beq     addc6                   ;no, so use default color
        and.l   #$0000ffff,d1
        clr.l   d4
        lsl.w   #2,d1
        move.w  d1,d4
        move.l  cmaptab,a0
        move.l  (a0),a0
        move.b  0(a0,d4.w),d0          
        tst.b   d0                      ;has this color been added already?
        bne     addc6                   ;yes, so get out d0=pgs color #
        
        move.w  d4,-(sp)                ;save color code for later
        
        clr.l   d0
        clr.l   d1
        clr.l   d2
        clr.l   d3
        move.b  1(a0,d4.w),d0           ;red
        move.b  2(a0,d4.w),d1           ;green
        move.b  3(a0,d4.w),d2           ;blue
        move.b  d0,red
        move.b  d1,green
        move.b  d2,blue
        
        mulu    #10000,d0               ;scale 0-255 rgb to 0-10000 rgb
        divu    #255,d0
        mulu    #10000,d1
        divu    #255,d1
        mulu    #10000,d2
        divu    #255,d2
        
addc03: move.w  d0,d3                   ;find largest rgb value (in d3)
        cmp.w   d3,d1
        bls     addc1
        move.w  d1,d3
addc1:  cmp.w   d3,d2
        bls     addc2
        move.w  d2,d3
addc2:  tst.w   d3                      ;is the largest value 0?
        bne     addc3
        clr.w   d0
        clr.w   d1
        clr.w   d2
        move.w  #10000,d3
        bra     addc4
        
addc3:  mulu    #10000,d0
        divu    d3,d0
        mulu    #10000,d1
        divu    d3,d1
        mulu    #10000,d2
        divu    d3,d2
        
addc32: neg.w   d0
        add.w   #10000,d0

        neg.w   d1
        add.w   #10000,d1

        neg.w   d2
        add.w   #10000,d2

        neg.w   d3
        add.w   #10000,d3

addc4:  move.w  d0,color+cl_Cyan
        move.w  d1,color+cl_Magenta
        move.w  d2,color+cl_Yellow
        move.w  d3,color+cl_Black
        clr.w   color+cl_Type
        clr.w   color+cl_Map

        bsr     getcolorname

        move.l  colorname,a0            ;copy the color name into cl_Name
        
        lea     color+cl_Name,a1
        move.w  #21,d0
addc5:  move.b  (a0)+,(a1)+
        dbf     d0,addc5
        clr.b   (a1)+                   ;null terminate it
      
        lea     color,a0                ;add the color to the global color tab
        move.l  table,a1
        move.l  newcolor(a1),a1
        jsr     (a1)
        move.l  d0,saved0
        
        lea     color,a0                ;add the color to the doc color tab
        move.l  table,a1
        move.l  findcolorname(a1),a1
        jsr     (a1)
        cmp.w   #$ffff,d0
        bne     addc51
        
        move.l  saved0,d0
        
addc51: move.w  (sp)+,d1
        tst.l   cmyktab                 ;is there a cmyk definition?
        beq     addc52                  ;no
        move.l  cmyktab,a0
        bra     addc53
addc52: move.l  cmaptab,a0              ;use the rgb definition
addc53: move.l  (a0),a0
        move.b  d0,0(a0,d1.w)           ;store the pgscolor in the colortab

addc6:  movem.l (sp)+,a0/a1
        rts

***********************************
***				***
***********************************
getcolorname:
        tst.l   cnamtab                 ;is there a cnam chunk to use?
        beq     gcn10                   ;no
        move.l  cnamtab,a0
        move.l  (a0),a0
        move.l  curcolor,d0
        lsl.l   #2,d0
        add.l   d0,a0
        move.l  (a0),a0                 ;get mem handle for color name pointer
        move.l  (a0),colorname          ;set it up and rts
        bra     gcn30
        
gcn10:  tst.l   cmyktab                 ;is there a cmyk definition?
        beq     gcn20                   ;no
        move.b  cyan,d0                  ;set up colorname for rgb definition
        bsr     hex2ascii
        move.b  d0,defcolorname+4
        move.b  d1,defcolorname+5
        move.b  magenta,d0
        bsr     hex2ascii
        move.b  d0,defcolorname+6
        move.b  d1,defcolorname+7
        move.b  yellow,d0
        bsr     hex2ascii
        move.b  d0,defcolorname+8
        move.b  d1,defcolorname+9
        move.b  black,d0
        bsr     hex2ascii
        move.b  d0,defcolorname+10
        move.b  d1,defcolorname+11
        clr.b   defcolorname+12
        lea     defcolorname,a0         ;set the colorname to the default name
        move.l  a0,colorname
        bra     gcn30
        
gcn20:  tst.l   cmaptab                 ;is there a rgb definition?
        beq     gcn30                   ;no
        move.b  red,d0                  ;set up colorname for rgb definition
        bsr     hex2ascii
        move.b  d0,defcolorname+4
        move.b  d1,defcolorname+5
        move.b  green,d0
        bsr     hex2ascii
        move.b  d0,defcolorname+6
        move.b  d1,defcolorname+7
        move.b  blue,d0
        bsr     hex2ascii
        move.b  d0,defcolorname+8
        move.b  d1,defcolorname+9
        clr.b   defcolorname+10
        lea     defcolorname,a0         ;set the colorname to the default name
        move.l  a0,colorname
        
gcn30:  rts
        
***********************************
***				***
***********************************
hex2ascii:
        move.b  d0,d1
        and.b   #$f0,d0                 ;d0 = upper nibble
        lsr.b   #4,d0
        and.b   #$0f,d1                 ;d1 = lower nibble
        
        cmp.b   #$0a,d0                 ;is d0 greater or equal to 10
        bcc     h2a1                    ;yes
        or.b    #$30,d0                 ;if not make it into the ascii of 0-9
        bra     h2a2
h2a1:   add.b   #55,d0                  ;make it ascii A-F

h2a2:   cmp.b   #$0a,d1
        bcc     h2a3
        or.b    #$30,d1
        bra     h2a4
h2a3:   add.b   #55,d1

h2a4:   rts

***********************************
***				***
***********************************
putcnam:
        move.l  end,d0                  ;d0 = number of names to deal with
        sub.l   start,d0
        
        move.l  cnamtab,a0              ;find the starting index pointer - a0
        move.l  (a0),a0
        move.l  start,d1
        lsl.l   #2,d1
        add.l   d1,a0
        
        move.l  cnamchunk,a1            ;get the pointer to the chunk data in a1
        move.l  (a1),a1
        
pcn0:   clr.l   d1                      ;get the length of the string into d1
        move.l  a1,a2
pcn1:   tst.b   (a2)+
        beq     pcn2
        addq    #1,d1
        bra     pcn1

pcn2:   bsr     getmem                  ;allocate d1 +1 bytes - return in a2
        move.l  a2,(a0)+                ;store in table & move to next slot
        
        move.l  (a2),a2                 ;strcpy into the table space
pcn3:   move.b  (a1)+,(a2)+
        dbf     d1,pcn3
        
        dbf     d0,pcn0
        rts
        
***********************************
***				***
***********************************
getmem:
        movem.l d0-d1/a0-a1,-(sp)
        move.l  d1,d0
        addq    #1,d0
        clr.l   d1
        clr.l   d2
        move.l  table,a0
        move.l  m_alloc(a0),a0
        jsr     (a0)
        beq     errrts
        move.l  a0,a2
        movem.l (sp)+,d0-d1/a0-a1
        rts
        
***********************************
***				***
***********************************
errrts:
        bsr     freemem
        move.l	savesp,sp
        jmp     abortobj
        
***********************************
***				***
***********************************
freemem:
        tst.l   cmaptab                 ;is there a cmaptab to delete?
        beq     fm1                     ;no
        move.l  cmaptab,a0
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)
        
fm1:    tst.l   cmyktab                 ;is there a cmyktab to delete?
        beq     fm2                     ;no
        move.l  cmyktab,a0
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)
        
fm2:    tst.l   cnamtab                 ;is there a cnamtab to delete?
        beq     fm3                     ;no
        
        ;free pointers in table
        move.w  numcolors,tempw1
        move.l  cnamtab,a2
        move.l  (a2),a2
        
fm20:   move.l  (a2)+,d0                ;get the next pointer to free
        beq     fm21                    ;is it zero? yes,so go to the next one
        move.l  d0,a0
        move.l  a2,-(sp)
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)
        move.l  (sp)+,a2
fm21:   sub.w   #1,tempw1
        bne     fm20
        
        move.l  cnamtab,a0              ;free the table of pointers itself
        move.l  table,a1
        move.l  m_delete(a1),a1
        jsr     (a1)

fm3:    rts

*******************************************************************
***	called when the import routine choosen finds something	***
***	wrong with the file loaded.				***
*******************************************************************
never:	clr.w	d0
	rts

maybe:	move.w	#1,d0
	rts

right:	move.w	#2,d0
	rts


*************************************************************
*************************************************************
 SECTION DR2D,DATA,PUBLIC

chunks: dc.l    "ATTR",attr
        dc.l    "AROW",arow
        dc.l    "BBOX",bbox
        dc.l    "CMAP",cmap
        dc.l    "CMYK",cmyk
        dc.l    "CNAM",cnam
        dc.l    "CPLY",cply
        dc.l    "DASH",dash
        dc.l    "DRHD",drhd
        dc.l    "FILL",fill
        dc.l    "FONS",fons
        dc.l	"FORM",form
        dc.l    "GRUP",grup
        dc.l    "OPLY",oply
        dc.l    "PPRF",pprf
        dc.l    "STXT",stxt
        dc.l    0,skip
                
numchunks:      
        dc.w    16

special:
	dc.w	1
	dc.l	spcl1

version:        dc.b    0,"$VER: "
name:	        dc.b	"IFF DR2D v2.1.5",0

spcl1:	dc.b	"Object",0

inch:   dc.b    "Units=Inch",0
pica:   dc.b    "Units=Pica",0
cm:     dc.b    "Units=Cm",0

defcolorname:   dc.b    "DR2D",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

serifflag:      dc.b    0


******************************************************************
******************************************************************
 SECTION DR2D,BSS,PUBLIC
 
savesp:		ds.l	1
length:		ds.l	1
clength:	ds.l	1
temp:		ds.l	1
object:		ds.w	ob_SizeOf/2
column:         ds.w    cm_Sizeof/2
color:          ds.w    cl_Sizeof/2

count:          ds.w    1
len:            ds.w    1
flag:           ds.l    1   
flag2:          ds.l    1
mptr:           ds.l    1
pptr:           ds.l    1
numcom:         ds.w    1
fillvalue:      ds.w    1
filltype:       ds.b    1
jointype:       ds.b    1
edgepattern:    ds.b    1
arrowhead:      ds.b    1
linewidth:      ds.l    1
edgecolor:      ds.w    1
numchars:       ds.w    1
charw:          ds.l    1
charh:          ds.l    1
basex:          ds.l    1
basey:          ds.l    1
rotation:       ds.l    1
string:         ds.l    1
numchars2:      ds.w    1
aflags:         ds.w    1
dashid:         ds.w    1
numdashes:      ds.w    1
dashtable:      ds.b    256
arrowtable:     ds.b    256
buffer:         ds.b    512
fact1:          ds.l    1
exp1:           ds.l    1
fact100:        ds.w    1
numobjs:        ds.w    1
gsp:            ds.l    1
numcolors:      ds.w    1
tempw1:         ds.w    1
start:          ds.l    1
end:            ds.l    1
red:            ds.b    1
green:          ds.b    1
blue:           ds.b    1
cyan:           ds.b    1
magenta:        ds.b    1
yellow:         ds.b    1
black:          ds.b    1
white:          ds.b    1
cmaptab:        ds.l    1
cmyktab:        ds.l    1
cnamtab:        ds.l    1
sign:           ds.w    1
fontid:         ds.w    1
prevx:          ds.l    1
prevy:          ds.l    1
saveX:          ds.l    1
saveY:          ds.l    1
saved0:         ds.l    1
savea0:         ds.l    1
xleft:          ds.l    1
ytop:           ds.l    1
xright:         ds.l    1
ybottom:        ds.l    1
colorname:      ds.l    1
cnamchunk:      ds.l    1
curcolor:       ds.l    1
fonttable:      ds.l    256

;***************************** Changes **************************
;
; version 2.1.5
;
;       - added a version string, so 'version dr2d.import' will return
;         the version number of the module.
;
;       - added font support - if the font specified in the FONS chunk is 
;         available to PageStream it will use it, if not it will use a serif
;         or san-serif font (CSTimes or CSTriumvirate) depending on the flag 
;         in the FONS chunk.
;
;       - added support for the new CMYK chunk. The module will use the CMYK
;         definition if present, if not it will use the rgb (CMAP) definition
;         for the color values.
;
;       - added support for the new CNAM chunk. The module will use the name
;         from the CNAM chunk if present, otherwise it will construct a name
;         from the CMYK definition if present, if not, it will construct the 
;         name from the rgb (CMAP) definition.
;
;       - fixed a bug that would cause PgS to crash when the object was pasted.
;         this occured because a CPLY was identified as a line at the start of
;         the object processing code (it had 2 points) and not at the end - 
;         because it was suppose to be filled.
;
;
; version 2.1.4 (uploaded 4/20/91 ?)
;
;       - fixed bug when placing text objects (stxt chunks). Before it would
;         use the baseline as the top of the object, now it uses it as the
;         baseline and calculates the top and bottom of the object using the
;         baseline as a reference.
;
;
; version 2.1.3  (shipped with PgS2.1 12/7/90)
;
;       - now handles different coordinate systems (different zero origin)
;
;
; version 2.1.2
;
;       - fixed color bug that occured when trying to add predefined
;         color with a different name (ie. Black = DR2D000000)
;
;                
; version 2.1.1   (uploaded 11/16/90)
;
;       - fixed bug when first point of the curve is not the same as the
;         prev point.
;
;
; version 2.1.0 (needs PgS 2.1.0)
;
;       - added support for group objects
;
;       - added suport for color
;
;       - fixed negative floating point number bug
;
;       - fixed line width - now no longer divides dr2d line width by 100
;
;       - fixed text import bug
;
;       - now detects serif and sanserif text objects
;
;       - fixed bug in poly stuff - changed tdln dection method
;
;
; version 2.0.1
;                               
;       - added supported for CURVETO and MOVETO in same case (0x00000003)
;       
;       - fix bug that caused divide by zero error when an old dr2d file
;         was imported. this was caused by a lack of pprf chunk. this in
;         turn would never set up the conversion factors so they would
;         be zero - hence the divide by zero error!. this has been fixed.
;
;
; version 2.0.0
;       
;       - first release