home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Anwendungen / Kurztests / PostScript / PsIntrp / rmath.a < prev    next >
Text File  |  1987-09-06  |  25KB  |  1,530 lines
  1.  
  2. * link with lmath.o
  3.    xref  lmulu
  4.    xref  ldivu
  5.    xref  ldivs
  6.    xref  lmoddivu
  7.  
  8.    xref  ipop
  9.    xref  popnum
  10.    xref  r.ipush
  11.    xref  mathffpbase
  12.    xref  mathtransbase
  13.    xref  _fontalloc
  14.  
  15.    xref  msg         for 'print' macro
  16.    xref  reinterp
  17.    xref  type_mismatch
  18.  
  19.    xref  xmoveto,xlineto,xclosepath
  20.    xref  ymoveto,ylineto,_closepath
  21.    xref  ggsave,ggrestore
  22.  
  23.    xref  simplex
  24.    xref  strokepathflag
  25.    xref  currfont
  26.  
  27.    section  one
  28.  
  29.    include  "ps.h"
  30.  
  31.  
  32. math  macro
  33.       move.l   A6,-(SP)
  34.       move.l   mathffpbase,A6
  35.       jsr      _LVO\1(A6)
  36.       move.l   (SP)+,A6
  37.       endm
  38.  
  39. ieee  macro
  40.       move.l   A6,-(SP)
  41.       move.l   mathtransbase,A6
  42.       jsr      _LVO\1(A6)
  43.       move.l   (SP)+,A6
  44.       endm
  45.  
  46.  
  47.  
  48.    lref     SPFix,1
  49.    lref     SPFlt,2
  50.    lref     SPCmp,3
  51.    lref     SPTst,4
  52.    lref     SPAbs,5
  53.    lref     SPNeg,6
  54.    lref     SPAdd,7
  55.    lref     SPSub,8
  56.    lref     SPMul,9
  57.    lref     SPDiv,10
  58.  
  59.    lref     fieee,14
  60.    lref     tieee,13
  61.    lref     sqrt,12
  62.    lref     ln,10
  63.    lref     exp,9
  64.    lref     pow,11
  65.    lref     tanh,8
  66.    lref     cosh,7
  67.    lref     sinh,6
  68.    lref     sincos,5
  69.    lref     tan,4
  70.    lref     cos,3
  71.    lref     sin,2
  72.    lref     atan,1
  73.  
  74.    ifne     HiRes
  75. MaxY        equ   399
  76. VFactor     equ   $C8000040
  77.    endc
  78.    ifeq     HiRes
  79. MaxY        equ   199
  80. VFactor     equ   $C800003F
  81.    endc
  82.  
  83.  
  84. GsaveSize   equ   11
  85.  
  86.  
  87. popri
  88.    bsr      ipop
  89.    move.l   D0,D1
  90.    cmp.w    #Real,D2
  91.    bne      1$
  92.    bsr      ipop
  93.    cmp.w    #Real,D2
  94.    beq      7$
  95.    cmp.w    #Integer,D2
  96.    bne      type_mismatch
  97.    move.l   D1,D3
  98.    math     SPFlt
  99.    move.l   D3,D1
  100.    move.w   #Real,D2
  101.    bra      7$
  102.  
  103. 1$ cmp.w    #Integer,D2
  104.    bne      type_mismatch
  105.    bsr      ipop
  106.    cmp.w    #Integer,D2
  107.    beq      8$
  108.    cmp.w    #Real,D2
  109.    bne      type_mismatch
  110.    move.l   D0,D3
  111.    move.l   D1,D0
  112.    math     SPFlt
  113.    move.l   D0,D1
  114.    move.l   D3,D0
  115.  
  116. 7$ moveq    #-1,D3      ret neq with 2 reals
  117. 8$ rts                  ret eq with 2 integers
  118.  
  119. popr
  120.    bsr      ipop
  121.    cmp.w    #Real,D2
  122.    beq      1$
  123.    cmp.w    #Integer,D2
  124.    bne      type_mismatch
  125.    move.l   D1,-(SP)
  126.    math     SPFlt
  127.    move.l   (SP)+,D1
  128.    move.w   #Real,D2
  129. 1$ rts
  130.  
  131.   DEF    eq
  132.    bsr      compare
  133.    beq      is_true
  134.    rts
  135.  
  136.   DEF    ne
  137.    bsr      compare
  138.    bne      is_true
  139.    rts
  140.  
  141.   DEF    ge
  142.    bsr      compare
  143.    bge      is_true
  144.    rts
  145.  
  146.   DEF    gt
  147.    bsr      compare
  148.    bgt      is_true
  149.    rts
  150.  
  151.   DEF    le
  152.    bsr      compare
  153.    ble      is_true
  154.    rts
  155.  
  156.   DEF    lt
  157.    bsr      compare
  158.    blt      is_true
  159.    rts
  160.  
  161.  
  162. compare
  163.    move.l   (SP)+,A0
  164.    pea      is_false
  165.    move.l   A0,-(SP)
  166.    bsr      popri
  167.    beq      1$
  168.    math     SPCmp
  169.    rts
  170. 1$ cmp.l    D1,D0
  171.    rts
  172.  
  173. is_false
  174.    moveq    #0,D0
  175.   RETURN    Boolean
  176.  
  177. is_true
  178.    addq.l   #4,SP
  179.    moveq    #-1,D0
  180.   RETURN    Boolean
  181.  
  182.  
  183.  
  184.   DEF    add
  185.    bsr      popri
  186.    bne      1$
  187.    add.l    D1,D0
  188.    bra      r.ipush
  189. 1$ math     SPAdd
  190.    bra      r.ipush
  191.  
  192.   DEF    sub
  193.    bsr      popri
  194.    bne      1$
  195.    sub.l    D1,D0
  196.    bra      r.ipush
  197. 1$ math     SPSub
  198.    bra      r.ipush
  199.  
  200.   DEF    mul
  201.    bsr      popri
  202.    bne      1$
  203.    jsr      lmulu
  204.    bra      r.ipush
  205. 1$ math     SPMul
  206.    bra      r.ipush
  207.  
  208.   DEF    div
  209.    bsr      popr
  210.    move.l   D0,D1
  211.    bsr      popr
  212.    tst.b    D1
  213.    beq      diverr
  214.    math     SPDiv
  215.    bra      r.ipush
  216.  
  217.   DEF    idiv
  218.    bsr      popnum
  219.    move.l   D0,D1
  220.    bsr      popnum
  221.    tst.l    D1
  222.    beq      diverr
  223.    jsr      ldivs
  224.    bra      r.ipush
  225.  
  226. diverr
  227.    ERR      divzero
  228.  
  229.   DEF    mod
  230.    bsr      popnum
  231.    move.l   D0,D1
  232.    bsr      popnum
  233.    move.l   D0,D3
  234.    tst.l    D0
  235.    bpl      1$
  236.    neg.l    D0
  237. 1$ tst.l    D1
  238.    bpl      2$
  239.    neg.l    D1
  240. 2$ move.l   D1,D2
  241.    move.l   D0,D1
  242.    jsr      lmoddivu
  243.    tst.l    D3
  244.    bpl      3$
  245.    neg.l    D0
  246. 3$ bra      retinteger
  247.  
  248.   DEF    abs
  249.    bsr      ipop
  250.    cmp.w    #Integer,D2
  251.    bne      2$
  252.    tst.l    D0
  253.    bpl      1$
  254.    neg.l    D0
  255. 1$ bra      r.ipush
  256. 2$ cmp.w    #Real,D2
  257.    bne      type_mismatch
  258.    math     SPAbs
  259.    bra      retreal
  260.  
  261.   DEF    neg
  262.    bsr      ipop
  263.    cmp.w    #Integer,D2
  264.    bne      2$
  265.    bra      r.ipush
  266. 2$ cmp.w    #Real,D2
  267.    bne      type_mismatch
  268.    math     SPNeg
  269.    bra      retreal
  270.  
  271.   DEF    floor
  272.    moveq    #-1,D4
  273.    bra      ..clng
  274.   DEF    ceiling
  275.    moveq    #0,D4
  276. ..clng
  277.    bsr      ipop
  278.    cmp.w    #Integer,D2
  279.    beq      r.ipush
  280.    cmp.w    #Real,D2
  281.    bne      type_mismatch
  282.    move.l   D0,D3
  283.    math     SPFix
  284.    move.l   D0,D2
  285.    math     SPFlt
  286.    move.l   D3,D1
  287.    math     SPCmp
  288.    beq      3$
  289.  
  290.    tst.l    D4
  291.    bne      1$
  292.    tst.l    D2
  293.    bmi      3$
  294.    addq.l   #1,D2
  295.    bra      3$
  296. 1$ tst.l    D2
  297.    bpl      3$
  298.    subq.l   #1,D2
  299.  
  300. 3$ move.l   D2,D0
  301.    bra      retinteger
  302.  
  303.   DEF    round
  304.    bsr      ipop
  305.    cmp.w    #Integer,D2
  306.    beq      r.ipush
  307.    cmp.w    #Real,D2
  308.    bne      type_mismatch
  309.    move.l   D0,D3
  310.    and.b    #$7F,D0
  311.    move.l   #PointFive,D1
  312.    math     SPAdd
  313.    math     SPFix
  314.    and.b    #$80,D3
  315.    beq      retinteger
  316.    neg.l    D0
  317.    bra      retinteger
  318.  
  319.   DEF    truncate
  320.    bsr      ipop
  321.    cmp.w    #Integer,D2
  322.    beq      r.ipush
  323.    cmp.w    #Real,D2
  324.    bne      type_mismatch
  325.    math     SPFix
  326.    bra      retinteger
  327.  
  328. retinteger
  329.    RETURN   Integer
  330.  
  331. retreal
  332.    RETURN   Real
  333.  
  334.  
  335.  
  336. ief   macro
  337.    xdef  _\1
  338. _\1
  339.    bsr   popr
  340.    ieee  \1
  341.    bra   retreal
  342.    endm
  343.  
  344.  
  345. iefa  macro
  346.    xdef  _\1
  347. _\1
  348.    bsr   popr
  349.    move.l   #$8EFA353B,D1
  350.    math     SPMul
  351.    ieee  \1
  352.    bra   retreal
  353.    endm
  354.  
  355.    ief     fieee
  356.    ief     tieee
  357.    ief     sqrt
  358.    ief     ln
  359.    ief     exp
  360.    ief     pow
  361.    iefa     tanh
  362.    iefa     cosh
  363.    iefa     sinh
  364. *   ief     sincos
  365.    iefa     tan
  366.    iefa     cos
  367.    iefa     sin
  368.  
  369.  
  370.   DEF    log
  371.    bsr      popr
  372.    ieee     ln
  373.    move.l   #$935D8D42,D1
  374.    math     SPDiv
  375.    bra      retreal
  376.  
  377.  
  378.   DEF    atan
  379.    bsr      popr        x
  380.    move.l   D0,D1
  381.    bsr      popr        y
  382.    moveq    #0,D3
  383.    tst.b    D1
  384.    beq      ..vrt
  385.    bpl      1$
  386.    move.w   #180,D3     +y/-x
  387.    tst.b    D0
  388.    bpl      2$
  389.    move.w   #270,D3     -y/-x
  390.    bra      2$
  391. 1$ tst.b    D0
  392.    bpl      2$
  393.    move.w   #360,D3     -y/+x
  394. 2$
  395.    math     SPDiv
  396.    and.b    #$7F,D0
  397.    ieee     atan
  398.    move.l   #$8EFA353B,D1
  399.    math     SPDiv
  400.    tst.l    D3
  401.    beq      retreal
  402.    or.b     #$80,D0     subtr. from 180,270, or 360
  403.    exg      D0,D3
  404.    math     SPFlt
  405.    move.l   D3,D1
  406.    math     SPAdd
  407.    bra      retreal
  408. ..vrt
  409.    move.l   D0,D1
  410.    move.l   #90,D0
  411.    tst.b    D1
  412.    beq      diverr
  413.    bpl      retinteger
  414.    move.w   #270,D0
  415.    bra      retinteger
  416.  
  417.  
  418.   DEF    gsave
  419.    lea      gsavecnt,A0
  420.    cmp.w    #PstackSize,(A0)
  421.    beq      2$
  422.    move.w   (A0),D0
  423.    addq.w   #1,(A0)
  424.    mulu     #GsaveSize*4,D0
  425.    moveq    #GsaveSize-1,D1
  426.    lea      CTM,A0
  427.    lea      sCTM,A1
  428.    add.l    D0,A1
  429. 1$ move.l   (A0)+,(A1)+
  430.    dbra     D1,1$
  431.    bra      ggsave
  432. 2$ ERR      gsov
  433.  
  434.  
  435.   DEF    grestore
  436.    lea      gsavecnt,A0
  437.    tst.w    (A0)
  438.    beq      2$
  439.    subq.w   #1,(A0)
  440.    move.w   (A0),D0
  441.    mulu     #GsaveSize*4,D0
  442.  
  443.    moveq    #GsaveSize-1,D1
  444.    lea      CTM,A0
  445.    lea      sCTM,A1
  446.    add.l    D0,A1
  447. 1$ move.l   (A1)+,(A0)+
  448.    dbra     D1,1$
  449.    bra      ggrestore
  450. 2$ ERR      gsuv
  451.  
  452.  
  453. matA     equ   0
  454. matB     equ   4
  455. matC     equ   8
  456. matD     equ   12
  457. matTx    equ   16
  458. matTy    equ   20
  459.  
  460. * convert array of 6 numbers at D0 to matrix
  461. arrayto2matrix
  462.    lea      temp2matrix,A1
  463.    bra      ..arrtm
  464. arraytomatrix
  465.    lea      tempmatrix,A1
  466. ..arrtm
  467.    move.l   D0,A0
  468.    cmp.w    #6,(A0)+
  469.    bne      materr
  470.    moveq    #5,D3
  471. 1$
  472.    move.w   (A0)+,D2
  473.    move.l   (A0)+,D0
  474.    cmp.w    #Real,D2
  475.    beq      2$
  476.    cmp.w    #Integer,D2
  477.    bne      materr
  478.    math     SPFlt
  479. 2$
  480.    move.l   D0,(A1)+
  481.    dbra     D3,1$
  482.    rts
  483.  
  484. materr
  485.    ERR      materror
  486.  
  487.  
  488.   DEF    translate
  489.    lea      v_translate,A0
  490. domatrix
  491.    move.l   A4,-(SP)
  492.    move.l   A0,A4
  493.    bsr      ipop
  494.    cmp.w    #Array,D2
  495.    bne      1$
  496.    move.l   D0,-(SP)
  497.    bsr      arraytomatrix
  498.    lea      tempmatrix,A2
  499.    move.l   A2,-(SP)
  500.    jsr      (A4)
  501.    move.l   (SP)+,A2
  502.    move.l   (SP),D0
  503.    bsr      matrixtoarray
  504.    move.l   (SP)+,D0
  505.    move.l   (SP)+,A4
  506.    RETURN   Array
  507. 1$
  508.    bsr      r.ipush
  509.    lea      CTM,A2
  510.    jsr      (A4)
  511.    move.l   (SP)+,A4
  512.    rts
  513.  
  514. matrixtoarray
  515.    move.l   D0,A0
  516.    lea      2(A0),A0    past length
  517.    moveq    #5,D3
  518.    move.w   #Real,D2
  519. 1$ move.w   D2,(A0)+
  520.    move.l   (A2)+,(A0)+
  521.    dbra     D3,1$
  522.    rts
  523.  
  524. v_translate
  525.    bsr      popr
  526.    move.l   D0,D3
  527.    bsr      popr
  528. *   lea      CTM,A2
  529. xtranslate
  530.    move.l   matTx(A2),D1
  531.    math     SPAdd
  532.    move.l   D0,matTx(A2)
  533.    move.l   D3,D0
  534.    move.l   matTy(A2),D1
  535.    math     SPAdd
  536.    move.l   D0,matTy(A2)
  537.    rts
  538.  
  539.   DEF    scale
  540.    lea      v_scale,A0
  541.    bra      domatrix
  542. v_scale
  543.    bsr      popr
  544.    tst.b    D0
  545.    beq      diverr
  546.    move.l   D0,D3
  547.    bsr      popr
  548.    tst.b    D0
  549.    beq      diverr
  550.    move.l   D0,D2
  551. *   lea      CTM,A2
  552.    bsr      xscale
  553.  
  554.    exg      D2,D3
  555.    move.l   currx,D0
  556.    move.l   D2,D1
  557.    math     SPDiv
  558.    move.l   D0,D2
  559.  
  560.    move.l   curry,D0
  561.    move.l   D3,D1
  562.    math     SPDiv
  563.    move.l   D0,D3
  564.  
  565.    bra      xy
  566.  
  567.  
  568. xscale
  569.    move.l   (A2),D1
  570.    bsr      rmul
  571.    move.l   D0,(A2)     sx * a
  572.  
  573.    move.l   matB(A2),D1
  574.    bsr      rmul
  575.    move.l   D0,matB(A2)    sx * b
  576.  
  577.    exg      D3,D2
  578.    move.l   matC(A2),D1
  579.    bsr      rmul
  580.    move.l   D0,matC(A2)    sy * c
  581.  
  582.    move.l   matD(A2),D1
  583.    bsr      rmul
  584.    move.l   D0,matD(A2)   sy * d
  585.  
  586.    rts
  587.  
  588.   DEF    rotate
  589.    lea      v_rotate,A0
  590.    bra      domatrix
  591. v_rotate
  592.    bsr      popr
  593.    move.l   #$8EFA353B,D1
  594.    math     SPMul
  595.    move.l   D0,D3
  596.    ieee     sin
  597.    exg      D0,D3
  598.    ieee     cos
  599.    move.l   D0,D4
  600. * D3 = sin, D4 = cos
  601.  
  602. *   lea      CTM,A2
  603.    bsr      rot1
  604.  
  605.    lea      4(A2),A2
  606. rot1
  607.    move.l   (A2),D0
  608.    move.l   D0,-(SP)
  609.    move.l   D4,D1
  610.    math     SPMul
  611.    move.l   D0,D2    a * cos (b * cos)
  612.  
  613.    move.l   matC(A2),D0
  614.    move.l   D0,-(SP)    c (d)
  615.    move.l   D3,D1
  616.    math     SPMul    c * sin (d * sin)
  617.    move.l   D2,D1
  618.    math     SPAdd
  619.    move.l   D0,(A2)  a * cos + c * sin  (b * cos + d * sin)
  620.  
  621.    move.l   (SP)+,D0    c (d)
  622.    move.l   D4,D1
  623.    math     SPMul
  624.    move.l   D0,D2       c * cos
  625.    move.l   (SP)+,D0    a (b)
  626.    move.l   D3,D1
  627.    math     SPMul       a * sin
  628.    move.l   D2,D1
  629.    exg      D0,D1
  630.    math     SPSub       c * cos - a * sin (d * cos - b * sin)
  631.    move.l   D0,matC(A2)
  632.    rts
  633.  
  634. rmul
  635.    beq      2$
  636.    move.l   D2,D0
  637.    beq      1$
  638.    math     SPMul
  639. 1$ rts
  640. 2$ moveq    #0,D0
  641.    rts
  642.  
  643.   DEF    concatmatrix
  644.   ARG    Array
  645.    move.l   D0,-(SP)    save result matrix to return
  646.    move.l   D0,A0
  647.    cmp.w    #6,(A0)     right size?
  648.    bne      materr
  649.   ARG    Array
  650.    bsr      arrayto2matrix    matrix2
  651.   ARG    Array
  652.    bsr      arraytomatrix     matrix1
  653.  
  654.    lea      tempmatrix,A0
  655.    lea      temp2matrix,A2
  656.    move.l   A2,-(SP)
  657.    bsr      y_concat
  658.    move.l   (SP)+,A2
  659.    move.l   (SP),D0
  660.    bsr      matrixtoarray
  661.    move.l   (SP)+,D0
  662.    RETURN   Array
  663.  
  664.   DEF    concat
  665.   ARG    Array
  666.    bsr   arraytomatrix
  667.    lea   tempmatrix,A0
  668.    lea   CTM,A2
  669.  
  670. * matrix at A2 = matrix at A0 X matrix at A2
  671. y_concat
  672.    movem.l  D4/A3,-(SP)
  673.    move.l   A0,A3
  674.    bsr      halfmul
  675.    lea      4(A2),A2
  676.    bsr      halfmul
  677.    movem.l  (SP)+,D4/A3
  678.    rts
  679.  
  680. * uses D2 = a2 D3 = c2 D4 = multiplicand
  681. halfmul
  682.    move.l   (A2),D2
  683.    move.l   matC(A2),D3
  684.  
  685.    move.l   (A3),D0
  686.    move.l   D2,D1
  687.    math     SPMul
  688.    move.l   D0,D4
  689.  
  690.    move.l   matB(A3),D0
  691.    move.l   D3,D1
  692.    math     SPMul
  693.    move.l   D4,D1
  694.    math     SPAdd
  695.    move.l   D0,(A2)
  696.  
  697.    move.l   matC(A3),D0
  698.    move.l   D2,D1
  699.    math     SPMul
  700.    move.l   D0,D4
  701.  
  702.    move.l   matD(A3),D0
  703.    move.l   D3,D1
  704.    math     SPMul
  705.    move.l   D4,D1
  706.    math     SPAdd
  707.    move.l   D0,matC(A2)
  708.  
  709.    move.l   matTx(A3),D0
  710.    move.l   D2,D1
  711.    math     SPMul
  712.    move.l   D0,D4
  713.  
  714.    move.l   matTy(A3),D0
  715.    move.l   D3,D1
  716.    math     SPMul
  717.    move.l   D4,D1
  718.    math     SPAdd
  719.    move.l   matTx(A2),D1
  720.    math     SPAdd
  721.    move.l   D0,matTx(A2)
  722.  
  723.    rts
  724.  
  725.   DEF    dtransform
  726.    lea      y_dtransform,A0
  727.    bra      domatrix
  728. y_dtransform
  729.    bsr      popr
  730.    move.l   D0,D3
  731.    bsr      popr
  732.    move.l   D0,D2
  733.    bsr      xxy
  734.    move.l   vcurrx,D0
  735.    move.l   matTx(A2),D1
  736.    math     SPSub
  737.    move.w   #Real,D2
  738.    bsr      r.ipush
  739.    move.l   vcurry,D0
  740.    move.l   matTy(A2),D1
  741.    math     SPSub
  742.    bra      r.ipush
  743.  
  744.   DEF    transform
  745.    lea      y_transform,A0
  746.    bra      domatrix
  747. y_transform
  748.    bsr      popr
  749.    move.l   D0,D3
  750.    bsr      popr
  751.    move.l   D0,D2
  752.    bsr      xxy
  753.    move.w   #Real,D2
  754.    move.l   vcurrx,D0
  755.    bsr      r.ipush
  756.    move.l   vcurry,D0
  757.    bra      r.ipush
  758.  
  759.  
  760.   DEF    currentpoint
  761.    move.w   #Real,D2
  762.    move.l   currx,D0
  763.    bsr      r.ipush
  764.    move.l   curry,D0
  765.    bra      r.ipush
  766.  
  767.    xdef     poprxy
  768. poprxy
  769.    bsr      popr
  770.    move.l   curry,D1
  771.    math     SPAdd
  772.    move.l   D0,D3
  773.    bsr      popr
  774.    move.l   currx,D1
  775.    math     SPAdd
  776.    move.l   D0,D2
  777.    bra      xy
  778.  
  779.  
  780.    xdef     popxy
  781. * get coordinate from stack and convert
  782. * to screen address in D0=x and D1=y
  783. * also, in real form, D2=x and D3=y
  784. popxy
  785.    bsr      popr
  786.    move.l   D0,D3
  787.    bsr      popr
  788.    move.l   D0,D2
  789. xy
  790.    movem.l  D2/D3,currx
  791.    lea      CTM,A2
  792. xxy
  793.    move.l   (A2),D1
  794.    bsr      rmul        ax
  795.    move.l   matTx(A2),D1
  796.    math     SPAdd       + tx
  797.    move.l   D0,D4
  798.    exg      D2,D3
  799.    move.l   matC(A2),D1
  800.    bsr      rmul        cy
  801.    move.l   D4,D1
  802.    math     SPAdd       + cy
  803.    move.l   D0,vcurrx
  804.  
  805.    move.l   #PointFive,D1
  806.    math     SPAdd
  807.    math     SPFix
  808.    move.l   D0,-(SP)
  809.  
  810.    exg      D2,D3
  811.    move.l   matB(A2),D1
  812.    bsr      rmul        bx
  813.    move.l   matTy(A2),D1
  814.    math     SPAdd       + ty
  815.    move.l   D0,D4
  816.    exg      D2,D3
  817.    move.l   matD(A2),D1
  818.    bsr      rmul        dy
  819.    move.l   D4,D1
  820.    exg      D2,D3
  821.    math     SPAdd       + dy
  822.    move.l   D0,vcurry
  823.  
  824. * times 200/512 = 25/64 = .390625
  825.    move.l   #VFactor,D1
  826.    math     SPMul
  827.  
  828.    move.l   D0,D3    for antiraster lineto
  829.    move.l   vcurrx,D2
  830.  
  831.    move.l   #PointFive,D1
  832.    math     SPAdd
  833.    math     SPFix
  834.    move.l   #MaxY,D1
  835.    sub.l    D0,D1
  836.  
  837.    move.l   (SP)+,D0
  838.    rts
  839.  
  840.   DEF    currentlinewidth
  841.    move.l   linewidth,D0
  842.    bra      retreal
  843.  
  844.   DEF    setlinewidth
  845.    bsr      popr
  846.    tst.b    D0
  847.    bmi      type_mismatch
  848.    move.l   D0,linewidth
  849.    rts
  850.  
  851. * called by stroke to see if lines currently have width
  852. * should return D0=1 if so, D0=0 if not
  853.    xdef     checklwidth
  854. checklwidth
  855.    move.l   linewidth,D0
  856.    move.l   #PointFive,D1
  857.    math     SPMul
  858.    move.l   D0,D2
  859.    move.l   D2,D3
  860.    bsr      deltaxy
  861.    or.l     D2,D3
  862.    bne      1$
  863.    moveq    #0,D0
  864.    rts
  865. 1$ moveq    #1,D0
  866.    rts
  867.  
  868. deltaxy
  869.    move.l   A2,-(SP)
  870.    lea      CTM,A2
  871. *   move.l   matB(A2),-(SP)
  872. *   move.l   matC(A2),-(SP)
  873.    move.l   matTx(A2),-(SP)
  874.    move.l   matTy(A2),-(SP)
  875. *   clr.l    matB(A2)
  876. *   clr.l    matC(A2)
  877.    clr.l    matTx(A2)
  878.    clr.l    matTy(A2)
  879.    bsr      xxy
  880.    move.l   (SP)+,matTy(A2)
  881.    move.l   (SP)+,matTx(A2)
  882. *   move.l   (SP)+,matC(A2)
  883. *   move.l   (SP)+,matB(A2)
  884.    move.l   (SP)+,A2
  885.  
  886.    move.l   D0,D2
  887.    bpl      1$
  888.    neg.l    D2
  889. 1$
  890.    move.l   D3,D0
  891.    and.b    #$7F,D0
  892.    move.l   #PointFive,D1
  893.    math     SPAdd
  894.    math     SPFix
  895.    move.l   D0,D3
  896.  
  897.    rts
  898.  
  899. * called by stroke routine to calculate
  900. * x and y components of linewidth
  901. * A3 -> source: (int,int) (real,real)
  902. * A4 -> dest:    ditto
  903. * returns D2=dx D3=dy
  904.    xdef     xywidth
  905. xywidth
  906.    move.l   linewidth,D0
  907.    move.l   #PointFive,D1
  908.    math     SPMul
  909.    move.l   D0,-(SP)
  910.  
  911.    move.l   12(A4),D0      y1
  912.    move.l   12(A3),D1      y0
  913.    math     SPSub             y1 - y0
  914.    move.l   #VFactor,D1
  915.    math     SPDiv
  916.    move.l   D0,D2
  917.  
  918.    move.l   8(A4),D0       x1
  919.    move.l   8(A3),D1       x0
  920.    math     SPSub             x1 - x0
  921.  
  922.    tst.b    D0
  923.    bne      1$
  924.    moveq    #0,D3          cos = 0
  925.    move.l   (SP),D0        sin = 1
  926.    bra      2$
  927. 1$
  928.    move.l   D0,D1
  929.    move.l   D2,D0
  930.    math     SPDiv       (y1-y0)/(x1-x0)
  931.    and.b    #$7F,D0
  932.  
  933.    ieee     atan
  934.    move.l   D0,D2
  935.    ieee     cos
  936.    move.l   D0,D3
  937.    move.l   D2,D0
  938.    ieee     sin
  939.  
  940.    move.l   (SP),D1
  941.    math     SPMul
  942. 2$
  943.    move.l   D0,D2
  944.  
  945.    move.l   (SP)+,D1
  946.    move.l   D3,D0
  947.    math     SPMul
  948.    move.l   D0,D3
  949.  
  950.    movem.l  D2/D3,-(SP)
  951.    exg      D2,D3
  952.    bsr      deltaxy
  953.    exg      D2,D3
  954.  
  955.    bsr      22$
  956.    move.l   D2,D0
  957.    move.l   D3,D1
  958.    movem.l  (SP)+,D2/D3
  959.  
  960.    movem.l  D0/D1,-(SP)
  961.    bsr      21$
  962.    movem.l  (SP)+,D0/D1
  963.    rts
  964.  
  965. 21$
  966.    bsr      deltaxy
  967. 22$
  968.  
  969.    move.l   (A4),D0
  970.    cmp.l    (A3),D0
  971.    bne      3$
  972.    moveq    #0,D3
  973.    bra      4$
  974. 3$ bpl      4$
  975.    neg.l    D3
  976. 4$ move.l   4(A4),D0
  977.    cmp.l    4(A3),D0
  978.    bne      5$
  979.    moveq    #0,D2
  980.    bra      6$
  981. 5$ blt      6$
  982.    neg.l    D2
  983. 6$
  984.    rts
  985.  
  986.  
  987.  
  988.    xdef     xadvance
  989. xadvance
  990.    math     SPFlt
  991.    move.l   currx,D1
  992.    math     SPAdd
  993.    move.l   D0,D2
  994.    move.l   curry,D3
  995.    bra      xy
  996.  
  997.   DEF    setflat
  998.    bsr      popr
  999.    and.b    #$7F,D0
  1000.    cmp.b    #$42,D0
  1001.    bcs      type_mismatch
  1002.    move.l   D0,flatness
  1003.    rts
  1004.   DEF    currentflat
  1005.    move.l   flatness,D0
  1006.    RETURN   Real
  1007.  
  1008.  
  1009. ctx0     equ   0
  1010. cty0     equ   4
  1011. ctx1     equ   8
  1012. cty1     equ  12
  1013. ctx2     equ  16
  1014. cty2     equ  20
  1015. ctx3     equ  24
  1016. cty3     equ  28
  1017.  
  1018. ctax     equ   0
  1019. ctbx     equ   8
  1020. ctcx     equ  16
  1021.  
  1022.   DEF    rcurveto
  1023.    moveq    #-1,D0
  1024.    bra      ..crvt
  1025.  
  1026.   DEF    curveto
  1027.    moveq    #0,D0
  1028. ..crvt
  1029.    movem.l  D6/D7/A3/A4,-(SP)
  1030.    move.l   D0,D6
  1031.    lea      ct_xy,A4
  1032.    lea      currx,A3
  1033.    bsr      ctxystow
  1034.    bsr      popxy
  1035.    lea      16(A4),A4
  1036.    bsr      ctxystow
  1037.    bsr      popxy
  1038.    lea      -16(A4),A4
  1039.    bsr      ctxystow
  1040.    bsr      popxy
  1041.    lea      -16(A4),A4
  1042.    bsr      ctxystow
  1043.  
  1044.    lea      ct_xy,A3
  1045.    tst.l    D6
  1046.    beq      11$
  1047.  
  1048.    lea      ctx1(A3),A4
  1049.    moveq    #2,D3
  1050. 10$
  1051.    move.l   (A3),D0
  1052.    move.l   (A4),D1
  1053.    math     SPAdd
  1054.    move.l   D0,(A4)+
  1055.    move.l   cty0(A3),D0
  1056.    move.l   (A4),D1
  1057.    math     SPAdd
  1058.    move.l   D0,(A4)+
  1059.    dbra     D3,10$
  1060.  
  1061. 11$
  1062.    lea      ct_abc,A4
  1063.    bsr      ctabcfigure
  1064.    movem.l  D4/A3/A4,-(SP)
  1065.    lea      4(A3),A3
  1066.    lea      4(A4),A4
  1067.    bsr      ctabcfigure
  1068.    move.l   D4,D3
  1069.    movem.l  (SP)+,D4/A3/A4
  1070. * D3 = y3 - y0; D4 = x3 - x0
  1071.    and.b    #$7F,D4
  1072.    and.b    #$7F,D3
  1073.    move.l   D4,D0
  1074.    move.l   D3,D1
  1075.    math     SPCmp
  1076.    bgt      1$
  1077.    move.l   D3,D4
  1078. 1$
  1079.    move.l   D4,D1
  1080.    move.l   flatness,D0  (make setable)
  1081.    math     SPDiv          dt = 4/dx or 4/dy
  1082.    tst.b    D0
  1083.    beq      100$
  1084.  
  1085.    move.l   D0,D7
  1086.    move.l   D7,D3
  1087.  
  1088.    moveq    #-1,D4
  1089.    move.l   (A3),D0
  1090.    move.l   cty0(A3),D1
  1091.    bsr      ctto
  1092.  
  1093. 2$
  1094.    cmp.b    #$41,D3
  1095.    blt      3$
  1096.    move.l   ctx3(A3),D0
  1097.    move.l   cty3(A3),D1
  1098.    clr.l    D4
  1099.    bsr      ctto
  1100.    bra      100$
  1101. 3$
  1102.    bsr      ctxfigure
  1103.    movem.l  D0/A3/A4,-(SP)
  1104.    lea      4(A3),A3
  1105.    lea      4(A4),A4
  1106.    bsr      ctxfigure
  1107.    move.l   D0,D1
  1108.    movem.l  (SP)+,D0/A3/A4
  1109.  
  1110.    clr.l    D4
  1111.    bsr      ctto
  1112.  
  1113.    move.l   D7,D0
  1114.    move.l   D3,D1
  1115.    math     SPAdd
  1116.    move.l   D0,D3
  1117.    bra      2$
  1118.  
  1119. 100$
  1120.    movem.l  (SP)+,D6/D7/A3/A4
  1121.    rts
  1122.  
  1123. ctto
  1124.    movem.l  D3/A3/A4,-(SP)
  1125.    move.l   D0,D2
  1126.    move.l   D1,D3
  1127.    bsr      xy
  1128.    tst.l    D4
  1129.    bne      1$
  1130.    bsr      ylineto
  1131.    bra      2$
  1132. 1$ bsr      ymoveto
  1133. 2$ movem.l  (SP)+,D3/A3/A4
  1134.    rts
  1135.  
  1136. ctabcfigure
  1137.    move.l   ctx1(A3),D0
  1138.    move.l   ctx0(A3),D1
  1139.    math     SPSub
  1140.    move.l   #ThreePoint,D1
  1141.    move.l   D1,D2
  1142.    math     SPMul
  1143.    move.l   D0,ctcx(A4)
  1144.    move.l   D0,D3
  1145.  
  1146.    move.l   ctx2(A3),D0
  1147.    move.l   ctx1(A3),D1
  1148.    math     SPSub
  1149.    move.l   D2,D1
  1150.    math     SPMul
  1151.    move.l   D3,D1
  1152.    math     SPSub
  1153.    move.l   D0,ctbx(A4)
  1154.    move.l   D0,D2
  1155.  
  1156.    move.l   ctx3(A3),D0
  1157.    move.l   ctx0(A3),D1
  1158.    math     SPSub
  1159.    move.l   D0,D4
  1160.    move.l   D2,D1
  1161.    math     SPSub
  1162.    move.l   D3,D1
  1163.    math     SPSub
  1164.    move.l   D0,ctax(A4)
  1165.  
  1166.    rts
  1167.  
  1168. * D3 = t
  1169. ctxfigure
  1170.    move.l   ctax(A4),D0
  1171.    move.l   D3,D1
  1172.    math     SPMul
  1173.    move.l   ctbx(A4),D1
  1174.    math     SPAdd
  1175.    move.l   D3,D1
  1176.    math     SPMul
  1177.    move.l   ctcx(A4),D1
  1178.    math     SPAdd
  1179.    move.l   D3,D1
  1180.    math     SPMul
  1181.    move.l   (A3),D1
  1182.    math     SPAdd
  1183.    rts
  1184.  
  1185.  
  1186. ctxystow
  1187.    move.l   A3,-(SP)
  1188.    move.l   (A3)+,(A4)+
  1189.    move.l   (A3)+,(A4)+
  1190.    move.l   (SP)+,A3
  1191.    rts
  1192.  
  1193.  
  1194. ct_xy    dcb.l    8,0
  1195. ct_abc   dcb.l    6,0
  1196.  
  1197.  
  1198.   DEF    makefont
  1199.   ARG    Array
  1200.    bsr      _fontalloc
  1201.    move.l   A0,D1
  1202.    move.w   #-1,(A0)+
  1203.    move.w   #Array,(A0)+
  1204.    move.l   D0,(A0)+
  1205.   ARG    FontID
  1206.    move.l   D0,A0
  1207.    tst.w    (A0)
  1208.    bpl      type_mismatch
  1209.    move.l   D1,D0
  1210.    RETURN   FontID
  1211.  
  1212.  
  1213.   DEF    scaleg
  1214.    bsr      popr
  1215.    bsr      _fontalloc
  1216.    move.l   A0,D1
  1217.    move.w   #-1,(A0)+
  1218.    move.w   #Real,(A0)+
  1219.    move.l   D0,(A0)+
  1220.   ARG    FontID
  1221.    move.l   D1,D0
  1222.    RETURN   FontID
  1223.  
  1224.  
  1225. initfctm
  1226.  
  1227. * copy current CTM to fCTM
  1228.    moveq    #5,D1
  1229.    lea      CTM,A0
  1230.    lea      fCTM,A1
  1231.    move.l   A0,A2
  1232. 1$ move.l   (A0)+,(A1)+
  1233.    dbra     D1,1$
  1234.  
  1235. * translate to current position
  1236.    move.l   curry,D3
  1237.    move.l   currx,D2
  1238.    bsr      xxy
  1239.    lea      fCTM,A2
  1240.    move.l   vcurry,matTy(A2)
  1241.    move.l   vcurrx,matTx(A2)
  1242.  
  1243. * zero temp matrix
  1244.    lea      tempmatrix,A0
  1245.    moveq    #5,D1
  1246.    moveq    #0,D0
  1247. 2$ move.l   D0,(A0)+
  1248.    dbra     D1,2$
  1249.  
  1250.    move.l   currfont,A0
  1251.    tst.w    (A0)+
  1252.    bmi      3$
  1253.    move.l   #OnePoint,D0      ??
  1254.    bra      4$
  1255. 3$
  1256.    move.w   (A0)+,D2
  1257.    move.l   (A0),D0
  1258.    cmp.w    #Real,D2
  1259.    bne      5$
  1260. 4$
  1261.    lea      tempmatrix,A0
  1262.    move.l   D0,(A0)
  1263.    move.l   D0,matD(A0)
  1264.    bra      6$
  1265. 5$
  1266.    cmp.w    #Array,D2
  1267.    bne      type_mismatch
  1268.    bsr      arraytomatrix
  1269.  
  1270. 6$
  1271.    lea      tempmatrix,A2
  1272.    move.w   simplex_base,D0
  1273.    ext.l    D0
  1274.    math     SPFlt
  1275.    move.l   matTy(A2),D1
  1276.    math     SPAdd
  1277.    move.l   D0,matTy(A2)
  1278.  
  1279. * scale down by nominal height
  1280.    move.w   simplex_height,D0
  1281.    ext.l    D0
  1282.    math     SPFlt
  1283.    move.l   D0,D1
  1284.    move.l   #OnePoint,D0
  1285.    math     SPDiv
  1286.    move.l   D0,D2
  1287.    move.l   D0,D3
  1288.    bsr      xscale
  1289.  
  1290. * save 'a' for currentpoint update
  1291.    move.l   (A2),simplex_scale
  1292.  
  1293. * concat with copy of CTM
  1294.    lea      tempmatrix,A0
  1295.    lea      fCTM,A2
  1296.    bsr      y_concat
  1297.  
  1298.    lea      fCTM,A2
  1299.  
  1300.    rts
  1301.  
  1302.  
  1303.    xdef  _lengthg
  1304. _lengthg
  1305.    movem.l  D5/D6,-(SP)
  1306.    moveq    #0,D6
  1307.    bra      ..shwg
  1308.  
  1309.   DEF    charpath
  1310.   ARG    Boolean
  1311.    beq      1$
  1312.    move.b   #1,strokepathflag
  1313. 1$
  1314.    movem.l  D5/D6,-(SP)
  1315.    moveq    #-1,D6
  1316.    bra      ..shwg
  1317.  
  1318.   DEF    showg
  1319.    movem.l  D5/D6,-(SP)
  1320.    moveq    #1,D6
  1321. ..shwg
  1322.    bsr      initfctm    henceforth A2 -> fCTM
  1323.  
  1324.   ARG    String
  1325.  
  1326.    move.l   D0,A0
  1327.    moveq    #0,D0
  1328.    move.l   D0,lastx
  1329.    move.l   D0,xoffset
  1330.    move.w   (A0)+,D3
  1331. 1$
  1332.    subq.w   #1,D3
  1333.    bpl      2$
  1334.  
  1335.    move.l   lastx,D0
  1336.    math     SPFlt
  1337.  
  1338.    move.l   simplex_scale,D1
  1339.    math     SPMul
  1340.  
  1341.    move.l   D6,D4
  1342.    movem.l  (SP)+,D5/D6
  1343.  
  1344.    tst.l    D4
  1345.    bne      10$
  1346.    move.w   #Real,D2
  1347.    bsr      r.ipush
  1348.    moveq    #0,D0
  1349.    bra      r.ipush
  1350.  
  1351. 10$
  1352.    move.l   currx,D1
  1353.    math     SPAdd
  1354.    move.l   D0,D2
  1355.    move.l   curry,D3
  1356.    bsr      xy
  1357.    tst.l    D4
  1358.    bpl      xmoveto
  1359.    bra      ymoveto
  1360.  
  1361. 2$
  1362.    moveq    #0,D0
  1363.    move.b   (A0)+,D0
  1364.    movem.l  D3/A0,-(SP)
  1365.    bsr      drawchar
  1366.    movem.l  (SP)+,D3/A0
  1367.    bra      1$
  1368.  
  1369.  
  1370. drawchar
  1371.    cmp.b    #' ',D0
  1372.    bcs      ..dcret
  1373.    cmp.b    #$7F,D0
  1374.    bhi      ..dcret
  1375.  
  1376.    sub.b    #' ',D0
  1377.    add.l    D0,D0
  1378.    lea      simplex,A0
  1379.    move.l   A0,A3
  1380.    add.l    D0,A0
  1381.    add.w    (A0),A3
  1382.  
  1383.  
  1384. * x-offset to center of character
  1385.  
  1386.    move.b   (A3)+,D0    left bound
  1387.    ext.w    D0
  1388.    ext.l    D0
  1389.    neg.l    D0
  1390.    move.l   lastx,D1
  1391.    add.l    D1,D0
  1392.    move.l   D0,xoffset
  1393.    move.l   D0,D2       save to update currx
  1394.  
  1395. * update currx
  1396.    move.b   (A3)+,D0    right bound
  1397.    ext.w    D0
  1398.    ext.l    D0
  1399.    add.l    D2,D0
  1400.    move.l   D0,lastx
  1401.  
  1402.    tst.l    D6
  1403.    beq      ..dcret
  1404.  
  1405.    clr.l    D5          pen is up
  1406.  
  1407. f_endchar   equ   0
  1408. f_penup     equ   1
  1409. f_closepath equ   2
  1410.  
  1411.  
  1412. * start drawing
  1413. nextpoint
  1414.    move.b   (A3)+,D0    x
  1415.    move.b   (A3)+,D3    y
  1416.    cmp.b    #64,D0      special command?
  1417.    bne      dopoint
  1418.    cmp.b    #f_endchar,D3
  1419.    bne      ..dc1
  1420. ..dcret
  1421.    rts
  1422.  
  1423. ..dc1
  1424.    cmp.b    #f_closepath,D3
  1425.    bne      ..dc2
  1426.    tst.l    D6
  1427.    bpl      1$
  1428.    bsr      _closepath
  1429.    bra      2$
  1430. 1$ bsr      xclosepath
  1431. 2$ clr.l    D5          pen up
  1432.    bra      nextpoint
  1433.  
  1434. ..dc2
  1435.    cmp.b    #f_penup,D3
  1436.    bne      nextpoint   unknown
  1437.    clr.l    D5          pen up
  1438.    bra      nextpoint
  1439.  
  1440. dopoint
  1441.    ext.w    D0
  1442.    ext.l    D0
  1443.    move.l   xoffset,D1
  1444.    add.l    D1,D0
  1445.    math     SPFlt
  1446.    move.l   D0,D2
  1447.  
  1448.    move.b   D3,D0
  1449.    ext.w    D0
  1450.    ext.l    D0
  1451.    neg.l    D0
  1452.    math     SPFlt
  1453.    move.l   D0,D3
  1454.    bsr      xxy            get device coordinates
  1455.    tst.l    D5
  1456.    bmi      3$
  1457.  
  1458.    tst.l    D6
  1459.    bpl      1$
  1460.    bsr      ymoveto
  1461.    bra      2$
  1462. 1$ bsr      xmoveto
  1463. 2$ moveq    #-1,D5         now pen is down
  1464.    bra      nextpoint
  1465.  
  1466. 3$ tst.l    D6
  1467.    bpl      4$
  1468.    bsr      ylineto
  1469.    bra      nextpoint
  1470.  
  1471. 4$ bsr      xlineto
  1472.    bra      nextpoint
  1473.  
  1474.  
  1475.  
  1476.    section  three,data
  1477.  
  1478.  
  1479. CTM
  1480.    dc.l     OnePoint
  1481.    dc.l     0
  1482.    dc.l     0
  1483.    dc.l     OnePoint
  1484.    dc.l     0
  1485.    dc.l     0
  1486. currx
  1487.    dc.l     0
  1488. curry
  1489.    dc.l     0
  1490. vcurrx
  1491.    dc.l     0
  1492. vcurry
  1493.    dc.l     0
  1494. linewidth
  1495.    dc.l     0
  1496. flatness
  1497.    dc.l     FourPoint     not saved
  1498.  
  1499.  
  1500.  
  1501. fCTM
  1502.    dc.l     OnePoint
  1503.    dc.l     0
  1504.    dc.l     0
  1505.    dc.l     OnePoint
  1506.    dc.l     0
  1507.    dc.l     0
  1508.  
  1509. lastx          dc.l     0
  1510. xoffset        dc.l     0
  1511.  
  1512. simplex_scale  dc.l     $BA2E8C3C   1/22
  1513. simplex_base   dc.w     9
  1514. simplex_height dc.w     22
  1515.  
  1516. gsavecnt       dc.w     0
  1517.  
  1518.    bstr     gsov,<gsave overflow>
  1519.    bstr     gsuv,<grestore underflow>
  1520.    bstr     divzero,<divide by zero>
  1521.    bstr     materror,<matrix error>
  1522.  
  1523.    section  mroom,bss
  1524.  
  1525. tempmatrix  ds.l  6
  1526. temp2matrix ds.l  6
  1527. sCTM        ds.l  PstackSize*GsaveSize
  1528.  
  1529.    end
  1530.