home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / CGRAPH.ZIP / PLOT.MAC < prev    next >
Text File  |  1998-07-30  |  26KB  |  1,424 lines
  1. ;*************************************************************************
  2. ;
  3. ;    GENERAL PURPOSE GRAPHICS PRINTER PLOTTING PACKAGE
  4. ;
  5. ;    Plotting Subroutines/Procedures
  6. ;         compatible with the following high level languages:
  7. ;
  8. ;        . BASIC,
  9. ;        . PASCAL/Z, 
  10. ;        . and JRT PASCAL
  11. ;
  12. ;         which support the following printers
  13. ;
  14. ;        . BASE-2
  15. ;        . IDS-560
  16. ;
  17. ;    Assemble using Microsoft M80.COM assembler.
  18. ;
  19. ;    10 February 1983
  20. ;
  21. ;    Ver: 2.2
  22. ;
  23. ;    Courtesty:    Clermont Computer Consultants
  24. ;            RD 1 Box 316
  25. ;            Cape May Court House, NJ 08210
  26. ;            (609) 263 7511
  27. ;
  28. ;*************************************************************************
  29.  
  30.     .Z80
  31. ;
  32. ;    EQUATES FOR ALL SUBROUTINES
  33. ;
  34. FALSE    EQU    0
  35. TRUE    EQU    NOT FALSE
  36. ;
  37. LIFEBT    EQU    FALSE
  38. ZENITH    EQU    FALSE
  39. CDR    EQU    TRUE         ; assemble for CDR SYSTEMS BIOS
  40. ;
  41. BASE2    EQU    FALSE
  42. IDS560    EQU    TRUE        ; assemble for IDS-560
  43. ;
  44. BASIC    EQU    FALSE
  45. PAS.Z    EQU    FALSE
  46. PAS.J    EQU    TRUE         ; assemble for JRT PASCAL
  47. ;
  48.     IF    LIFEBT
  49. BASE    EQU    4200H
  50.     ENDIF
  51. ;
  52.     IF    NOT LIFEBT
  53. BASE    EQU    0000H
  54.     ENDIF
  55. ;
  56. BDOS    EQU    BASE+5
  57. ;
  58. ; ========================================================================
  59. ;
  60. ;    Change LINES equate to produce a plot area of a given size
  61. ;
  62. ;    LINES = int(#dots/7) + 1
  63. ;
  64. LINES    EQU    59        ; produces 413 x 413 image
  65. ;
  66. ; ========================================================================
  67. ;
  68. DOTS    EQU    LINES*7     ; number of vertical dots in plot
  69. NLINES    EQU    DOTS/8 + 1    ; number of lines in image area
  70. LENGTH    EQU    DOTS        ; number of horizontal dots in plot
  71.  
  72.     IF    BASE2
  73. ;
  74. FILL1    EQU    (576-LENGTH)/2    ; fill for left margin
  75. FILL2    EQU    576-LENGTH-FILL1; 576 dots per line in 96 char/line mode
  76.     ENDIF
  77. ;
  78.     IF    IDS560
  79. ;
  80. FILL1    EQU    126        ; 1.5 inch left margin
  81.     ENDIF
  82. ;
  83. AREA    EQU    NLINES*LENGTH    ; number of bytes for plot area
  84. ;
  85.     IF    LIFEBT
  86. TMEM    EQU    0DF00H        ; lower bound of CP/M (48K ORG 4200H)
  87.     ENDIF
  88. ;
  89.     IF    NOT LIFEBT
  90. TMEM    EQU    0DC00H        ; lower bound of ORG 0 versions
  91.     ENDIF
  92. ;
  93.     IF    BASIC
  94. ;
  95. BOTTOM    EQU    TMEM-AREA-06EAH ; leave room for prog + plot area
  96.                 ; and start at next lowest page boundary
  97. ORIGIN    EQU    (BOTTOM AND 0FF00H)
  98.     ENDIF
  99. ;
  100.     IF2
  101.     IF    PAS.Z
  102. ;
  103.     .PRINTX/    PASCAL/Z version/
  104.     ENDIF
  105. ;
  106.     IF    PAS.J
  107. ;
  108.     .PRINTX/    JRT PASCAL version/
  109.     ENDIF
  110. ;
  111.     IF    BASIC
  112. ;
  113.     .PRINTX/    BASIC version/
  114.     ENDIF
  115. ;
  116.     IF    BASE2
  117. ;
  118.     .PRINTX/    For BASE-2 printer/
  119.     ENDIF
  120. ;
  121.     IF    IDS560
  122. ;
  123.     .PRINTX/    For IDS-560 printer/
  124.     ENDIF
  125. ;
  126.     ENDIF
  127.  
  128.     IF    BASIC
  129. ;*************************************************************************
  130. ;
  131. ;    Subroutine to link the parameters passed from BASIC
  132. ;
  133. DTLNK:
  134. ;
  135.     LD    A,(DE)        ; fetch # bytes
  136.     SLA    B        ; 2*(# parameters)
  137.     CP    B        ; are they =?
  138.     JR    NZ,STERR    ; no, an error in BASIC
  139.     INC    DE        ; point to string address
  140.     EX    DE,HL
  141.     LD    E,(HL)
  142.     INC    HL
  143.     LD    D,(HL)
  144.     EX    DE,HL        ; HL points to first byte in string
  145.     LD    DE,P1
  146. DTLNK1: LD    A,(HL)        ; transfer 2*(# param's) bytes of data
  147.     LD    (DE),A
  148.     INC    HL
  149.     INC    DE
  150.     DJNZ    DTLNK1
  151.     RET
  152. ;
  153.     ENDIF
  154.  
  155.     IF    PAS.J
  156. ;******************************************************************************
  157. ;
  158. ;    PARAMETER LINKAGE ROUTINE FOR JRT PASCAL
  159. ;
  160. ;    All calls to plot functions must be via this parameter linkage
  161. ;    routine.  JRT PASCAL expects each external .INT file to contain
  162. ;    a single unique function or procedure.  All of the plot procedures
  163. ;    must be treated as a single entity with one entry parameter acting
  164. ;    as a pointer to the desired sub-procedure.
  165. ;
  166. JPLOT:
  167. ;    entry code
  168. ;
  169. ;    DEFB    95,06,00    ; int vmcode
  170.     DEFB    92        ; lpn vmcode
  171.     DEFB    00        ; mode vmcode
  172. ;
  173. ;    hl = base
  174. ;    de = current
  175. ;    bc = tos
  176. ;
  177.     LD    BC,6
  178.     ADD    HL,BC        ; HL = IMAGE address
  179.     LD    (IMGPTR),HL    ; store for later use
  180. ;
  181.     EX    DE,HL
  182.     DEC    HL
  183.     DEC    HL        ; point to length
  184.     LD    A,(HL)        ; get length
  185.     CP    0FH        ; see if correct
  186.     JP    NZ,JERR        ; bad procedure call
  187.     DEC    HL        ; do each parameter in reverse order
  188.     LD    D,(HL)
  189.     DEC    HL
  190.     LD    E,(HL)
  191.     LD    (P7),DE        ; DE = parameter 7
  192.     DEC    HL
  193.     LD    D,(HL)
  194.     DEC    HL
  195.     LD    E,(HL)
  196.     LD    (P6),DE        ; DE = parameter 6
  197.     DEC    HL
  198.     LD    D,(HL)
  199.     DEC    HL
  200.     LD    E,(HL)
  201.     LD    (P5),DE        ; DE = parameter 5
  202.     DEC    HL
  203.     LD    D,(HL)
  204.     DEC    HL
  205.     LD    E,(HL)
  206.     LD    (P4),DE        ; DE = parameter 4
  207.     DEC    HL
  208.     LD    D,(HL)
  209.     DEC    HL
  210.     LD    E,(HL)
  211.  
  212.     LD    (P3),DE        ; DE = parameter 3
  213.     DEC    HL
  214.     LD    D,(HL)
  215.     DEC    HL
  216.     LD    E,(HL)
  217.     LD    (P2),DE        ; DE = parameter 2
  218.     DEC    HL
  219.     LD    D,(HL)
  220.     DEC    HL
  221.     LD    E,(HL)
  222.     LD    (P1),DE        ; DE = parameter 1
  223.     DEC    HL
  224.     LD    A,(HL)        ; A = type
  225.     CP    'A'
  226.     JP    Z,AXIS
  227.     CP    'a'
  228.     JP    Z,AXIS        ; vector AXIS procedure
  229.     CP    'L'
  230.     JP    Z,LINE
  231.     CP    'l'
  232.     JP    Z,LINE        ; vector LINE procedure
  233.     CP    'P'
  234.     JP    Z,PLOT
  235.     CP    'p'
  236.     JP    Z,PLOT        ; vector PLOT procedure
  237.     CP    'D'
  238.     JP    Z,POINT
  239.     CP    'd'
  240.     JP    Z,POINT        ; vector POINT procedure
  241.     CP    'I'
  242.     JP    Z,INIT
  243.     CP    'i'
  244.     JP    Z,INIT        ; vector INIT procedure
  245.     CP    'C'
  246.     JP    Z,CIRCLE
  247.     CP    'c'
  248.     JP    Z,CIRCLE    ; vector CIRCLE procedure
  249.     CP    'T'
  250.     JP    Z,XFRPLT
  251.     CP    't'
  252.     JP    Z,XFRPLT    ; vector XFRPLT procedure
  253. JERR:
  254.     JP    STERR + 1    ; bad procedure call
  255. ;                  print error message & return
  256.     ENDIF
  257.  
  258. ;******************************************************************************
  259. ;
  260. ;    Test & failure message subroutines
  261. ;
  262. YTEST:
  263.     LD    DE,DOTS-1    ; y <-- DOTS-1-y
  264.     OR    A
  265.     EX    DE,HL
  266.     SBC    HL,DE
  267. ;
  268. TEST:                ; limits the bounds on x and y to
  269.                 ; be  0 <= HL <= DOTS-1
  270.     XOR    A        ; clear test flag
  271.     LD    B,A
  272.     LD    A,H
  273.     AND    80H        ; is HL negative?
  274.     JR    Z,NNEG        ; no
  275.     LD    HL,0        ; yes, set lower limit of 0
  276.     DEC    B        ; set test flag
  277.     RET
  278. NNEG:    LD    DE,DOTS-1    ; test HL>=DOTS
  279.     OR    A
  280.     EX    DE,HL
  281.     SBC    HL,DE
  282.     JR    NC,UPOK     ; no carry, DE within bounds
  283.     LD    HL,DOTS-1
  284.     DEC    B        ; set test flag
  285.     RET
  286. UPOK:    EX    DE,HL
  287.     RET
  288. ;
  289. ;
  290. STERR:    POP    HL        ; modify stack to eliminate the return
  291.     LD    DE,STERR$    ; from DTLINK
  292. MSG:    LD    C,9        ; print the buffer under CP/M
  293.     JP      BDOS          ; and return to interpreter when done
  294. ;
  295. STERR$: DEFB    13,10,'Improper Number of Parameters',13,10,10,'$'
  296. ;
  297.  
  298. ;******************************************************************************
  299. ;
  300. ;    INIT: image initialization subroutine
  301. ;
  302. INIT:                ; CALL & USR entry point, no parameters
  303.     IF    PAS.Z
  304. ;
  305.     ENTRY    INIT
  306.     ENDIF
  307. ;
  308.     LD    HL,(IMGPTR)    ; HL = first address of IMAGE
  309.     PUSH    HL
  310.     POP    DE
  311.     INC    DE        ; DE = second address of IMAGE
  312.     LD    BC,AREA-1
  313.     LD    (HL),0        ; set all bytes to 00
  314.     LDIR
  315. ;
  316.     IF    PAS.Z
  317. ;
  318.     XOR    A        ; flag valid subroutine call
  319.     ENDIF
  320. ;
  321.     RET
  322. ;
  323.  
  324. ;*************************************************************************
  325. ;
  326. ;    Plot Subroutine: 
  327. ;
  328. PLOT:                ; USR entry point
  329.     IF    PAS.Z
  330. ;
  331.     ENTRY    PLOT
  332.     POP    BC        ; fetch return address
  333.     POP    HL        ; fetch y: integer
  334.     LD    (P2),HL
  335.     POP    HL        ; fetch x: integer
  336.     LD    (P1),HL
  337.     PUSH    BC        ; restore return address
  338.     ENDIF
  339. ;
  340.     IF    BASIC
  341. ;
  342.     LD    B,2        ; transfer data from string buffer
  343.     CALL    DTLNK        ; and test/limit to boundaries
  344.     ENDIF
  345. ;
  346.     LD    HL,(P1)
  347.     CALL    TEST
  348.     BIT    7,B        ; if out-of-bounds
  349.     JP    NZ,SETRET    ; do not plot point
  350.     LD    (STARTX+2),HL
  351.     LD    HL,(P2)
  352.     CALL    YTEST
  353.     BIT    7,B
  354.     JP    NZ,SETRET
  355.     LD    (STARTY+2),HL
  356.     JP    SET1
  357. ;
  358. SET0:    LD    HL,(STARTX+2)    ; entry point for subr call
  359.     CALL    TEST        ; when point may be outside boundaries
  360.     BIT    7,B        ; if out-of-bounds
  361.     RET    NZ        ; do not plot point
  362.     LD    (STARTX+2),HL
  363.     LD    HL,(STARTY+2)
  364.     CALL    TEST        ; if out-of-bounds
  365.     BIT    7,B        ; do not plot point
  366.     RET    NZ
  367.     LD    (STARTY+2),HL
  368. SET1:    LD    B,0        ; entry point for subr call
  369.     LD    HL,(STARTY+2)    ; when point is within boundaries
  370.  
  371. ;    Determine address and bit number of pixel
  372. ;        ADDR = LENGTH*(INT(Y/8) + X
  373. ;        BIT  = 2^(8 - (Y MOD 8))
  374. ;
  375.     LD    DE,8
  376.     OR    A
  377. DIV8:    SBC    HL,DE
  378.     JR    C,DONDIV
  379.     INC    B
  380.     JR    DIV8
  381. DONDIV: ADD    HL,DE
  382.     LD    C,L
  383.     INC    B
  384.     LD    DE,LENGTH
  385.     LD    HL,(IMGPTR)
  386.     OR    A          ; clear carry
  387.     SBC    HL,DE        ; HL = IMAGE - LENGTH
  388. SMULT:    ADD    HL,DE
  389.     DJNZ    SMULT
  390.     LD    DE,(STARTX+2)
  391.     ADD    HL,DE        ; HL = ADDR
  392.     LD    B,C
  393.     INC    B
  394.     LD    DE,TABLE-1
  395. FINDT:    INC    DE
  396.     DJNZ    FINDT
  397.     LD    A,(DE)        ; A has proper bit set
  398.     OR    (HL)
  399.     LD    (HL),A
  400. ;
  401. SETRET:
  402.     IF    PAS.Z
  403. ;
  404.     XOR    A        ; flag valid subroutine call
  405.     ENDIF
  406. ;
  407.     RET
  408. ;
  409. TABLE:    DEFB    80H        ; bit position table
  410.     DEFB    40H
  411.     DEFB    20H
  412.     DEFB    10H
  413.     DEFB    08H
  414.     DEFB    04H
  415.     DEFB    02H
  416.     DEFB    01H
  417. ;
  418.  
  419. ;*************************************************************************
  420.  
  421. ;    Point Subroutine: 
  422. ;
  423. POINT:                ; CALL entry point
  424.     IF    PAS.Z
  425. ;
  426.     ENTRY    POINT
  427.     POP    BC        ; fetch return address
  428.     POP    HL        ; fetch y: integer
  429.     LD    (P2),HL
  430.     POP    HL        ; fetch x: integer
  431.     LD    (P1),HL
  432.     PUSH    BC        ; restore return address
  433.     ENDIF
  434. ;
  435.     IF    BASIC
  436. ;
  437.     LD    B,2
  438.     CALL    DTLNK 
  439.     ENDIF
  440. ;
  441.     LD    HL,(P1)
  442.     CALL    TEST
  443.     LD    (P1),HL
  444.     LD    HL,(P2)
  445.     CALL    YTEST
  446.     LD    (P2),HL
  447.     LD    HL,(P1)
  448.     DEC    HL
  449.     LD    (STARTX+2),HL
  450.     LD    HL,(P2)
  451.     DEC    HL
  452.     LD    (STARTY+2),HL
  453.     CALL    SET0
  454.     LD    HL,(P1)
  455.     LD    (STARTX+2),HL
  456.     CALL    SET0
  457.     LD    HL,(P1)
  458.     INC    HL
  459.     LD    (STARTX+2),HL
  460.     CALL    SET0
  461.     LD    HL,(P2)
  462.     LD    (STARTY+2),HL
  463.     CALL    SET0
  464.     LD    HL,(P2)
  465.     INC    HL
  466.     LD    (STARTY+2),HL
  467.     CALL    SET0
  468.     LD    HL,(P1)
  469.     LD    (STARTX+2),HL
  470.     CALL    SET0
  471.     LD    HL,(P1)
  472.     DEC    HL
  473.  
  474.     LD    (STARTX+2),HL
  475.     CALL    SET0
  476.     LD    HL,(P2)
  477.     LD    (STARTY+2),HL
  478.     CALL    SET0
  479. ;
  480.     IF    PAS.Z
  481. ;
  482.     XOR    A        ; flag valid subroutine call
  483.     ENDIF
  484. ;
  485.     RET
  486. ;
  487.  
  488. ;*************************************************************************
  489. ;
  490. ;    Line Subroutine:
  491. ;
  492. LINE:                ; CALL entry point
  493.     IF    PAS.Z
  494. ;
  495.     ENTRY    LINE
  496.     POP    BC        ; fetch return address
  497.     POP    HL        ; fetch y2: integer
  498.     LD    (P4),HL
  499.     POP    HL        ; fetch x2: integer
  500.     LD    (P3),HL
  501.     POP    HL        ; fetch y1: integer
  502.     LD    (P2),HL
  503.     POP    HL        ; fetch x1: integer
  504.     LD    (P1),HL
  505.     PUSH    BC        ; restore return address
  506.     ENDIF
  507. ;
  508.     IF    BASIC
  509. ;
  510.     LD    B,4        ; 4 parameters in the CALL list
  511.     CALL    DTLNK        ; fetch the values P1, P2, P3, P4
  512.     ENDIF
  513. ;
  514.     LD    HL,(P1)     ; test for boundary conditions & transfer
  515.     CALL    TEST        ; to working storage
  516.     LD    (STARTX+2),HL    ; X1 <-- P1
  517.     LD    HL,(P2)
  518.     CALL    YTEST
  519.     LD    (STARTY+2),HL    ; Y1 <-- P2
  520.     LD    HL,(P3)
  521.     CALL    TEST
  522.     LD    (ENDX+2),HL    ; X2 <-- P3
  523.     LD    HL,(P4)
  524.     CALL    YTEST
  525.     LD    (ENDY+2),HL    ; Y2 <-- P4
  526.     LD    HL,(ENDX+2)    ; test for ENDX = STARTX
  527.     LD    BC,(STARTX+2)
  528.     OR    A        ; 0-->carry
  529.     SBC    HL,BC
  530.     JR    NZ,LINE1    ; ENDS<>STARTX
  531.     LD    HL,(ENDY+2)    ; same for ENDY, STARTY
  532.     OR    A
  533.     LD    BC,(STARTY+2)
  534.     SBC    HL,BC
  535.     JP    Z,SET1        ; co-resident points, just plot single point
  536.  
  537. LINE1:                ; entry point for other subroutine calls
  538.     LD    HL,(ENDX+2)    ; evaluate 32 bit fixed point
  539.     LD    DE,(STARTX+2)    ; numbers: DIRX & DIRY
  540.     OR    A
  541.     SBC    HL,DE
  542.     LD    (DIRX),HL    ; DIRX <- ENDX - STARTX; fractional part
  543.     BIT    7,H        ; extend sign of .DIRX to integer part
  544.     JR    Z,X0
  545.     LD    HL,-1
  546.     JR    X1
  547. ;
  548. X0:    LD    HL,0
  549. X1:    LD    (DIRX+2),HL    ; do same for DIRY
  550.     LD    HL,(ENDY+2)
  551.     LD    DE,(STARTY+2)
  552.     OR    A
  553.     SBC    HL,DE
  554.     LD    (DIRY),HL
  555.     BIT    7,H
  556.     JR    Z,Y0
  557.     LD    HL,-1
  558.     JR    Y1
  559. Y0:    LD    HL,0
  560. Y1:    LD    (DIRY+2),HL
  561.     LD    HL,(DIRX)    ; HL <- .DIRX
  562.     LD    DE,(DIRY)    ; DE <- .DIRY
  563.     LD    A,H
  564.     AND    80H
  565.     LD    B,A        ; B <- sgn(.DIRX)
  566.     LD    A,D
  567.     AND    80H
  568.     LD    C,A        ; C <- sgn(.DIRY)
  569. SHLFT:    SLA    L        ; multiply HL, DE by 2
  570.     RL    H        ; until sign change occurs
  571.     SLA    E        ; on one or the other
  572.     RL    D
  573.     LD    A,H
  574.     AND    80H
  575.     CP    B
  576.     JR    NZ,DSHLFT
  577.     LD    A,D
  578.     AND    80H
  579.     CP    C
  580.     JR    NZ,DSHLFT
  581.     JR    SHLFT
  582. DSHLFT: LD    (DIRX),HL    ; restore .DIRX & .DIRY with one equal
  583.     LD    (DIRY),DE    ; to 1/2 & the other less (magnitudes)
  584.     LD    HL,8000H    ; HL <- 1/2
  585.     LD    (STARTX),HL    ; round up STARTX, STARTY by 1/2
  586.     LD    (STARTY),HL
  587.  
  588. NXTBL:    CALL    SET1
  589.     OR    A
  590.     LD    HL,(ENDX+2)
  591.     LD    DE,(STARTX+2)
  592.     SBC    HL,DE
  593.     JR    Z,NXTBL2    ;STARTX = ENDX
  594. NXTBL1: LD    HL,(STARTX)
  595.     LD    DE,(DIRX)
  596.     ADD    HL,DE        ;.STARTX = .STARTX + .DIRX
  597.     LD    (STARTX),HL
  598.     LD    HL,(STARTX+2)
  599.     LD    DE,(DIRX+2)
  600.     ADC    HL,DE        ;STARTX. = STARTX. + DIRX. + .CY
  601.     LD    (STARTX+2),HL
  602.     LD    HL,(STARTY)
  603.     LD    DE,(DIRY)
  604.     ADD    HL,DE        ;.STARTY = .STARTY + .DIRY
  605.     LD    (STARTY),HL
  606.     LD    HL,(STARTY+2)
  607.     LD    DE,(DIRY+2)
  608.     ADC    HL,DE        ;STARTY. = STARTY. + DIRY. + .CY
  609.     LD    (STARTY+2),HL
  610.     JR    NXTBL
  611. NXTBL2: OR    A
  612.     LD    HL,(ENDY+2)
  613.     LD    DE,(STARTY+2)
  614.     SBC    HL,DE
  615.     JR    NZ,NXTBL1    ;STARTY. <> ENDY.
  616. ;
  617.     IF    PAS.Z
  618. ;
  619.     XOR    A        ; flag valid subroutine call
  620.     ENDIF
  621. ;
  622.     RET
  623. ;
  624.  
  625. ; ************************************************************************
  626. ;
  627. ;    CIRCLE Subroutine:
  628. ;
  629. CIRCLE:
  630.     IF      PAS.Z
  631. ;
  632.     ENTRY     CIRCLE
  633.     POP    BC
  634.         POP    HL            ; R VALUE
  635.     LD    (P3),HL
  636.     POP    HL                    ; Y VALUE
  637.     LD    (P2),HL
  638.     POP    HL            , X VALUE
  639.     LD    (P1),HL
  640.     PUSH    BC
  641.     PUSH    IX
  642.     PUSH    IY
  643.     ENDIF
  644. ;
  645.     IF    BASIC
  646. ;
  647.     LD    B,3
  648.     CALL    DTLNK
  649.     ENDIF
  650. ;
  651.     LD    HL,(P1)
  652.     CALL    TEST
  653.     LD    (P1),HL
  654.     LD    HL,(P2)
  655.     CALL    YTEST
  656.     LD    (P2),HL
  657.     LD    IX,SINTBL
  658.     LD    IY,COSTBL
  659.     LD    B,45
  660. CIRC0:
  661.     PUSH    BC        ; SAVE COUNTER
  662.     LD    D,(IX+1)    ; SIN->(DE)
  663.     LD    E,(IX)
  664.     LD    BC,(P3)        ; R->(BC)
  665.     CALL    MULT
  666.     LD    (RSIN),DE    ; PROD->RSIN
  667.     LD    D,(IY+1)
  668.     LD    E,(IY)
  669.     LD    BC,(P3)
  670.     CALL    MULT
  671.     LD    (RCOS),DE    ; PROD->RCOS
  672.     LD    HL,(P1)        ;X->HL
  673.     ADD    HL,DE
  674.     CALL    CIRC1        ; X+RCOS ,Y+RSIN
  675.     LD    DE,(RSIN)
  676.     ADD    HL,DE
  677.     CALL    CIRC2
  678.  
  679. ; X+RSIN, Y+RCOS
  680.     LD    DE,(RSIN)
  681.     ADD    HL,DE
  682.     CALL    CIRC1
  683.     LD    DE,(RCOS)
  684.     ADD    HL,DE
  685.     CALL    CIRC2
  686. ; X-RSIN, Y+RCOS
  687.     LD    DE,(RSIN)
  688.     OR    A
  689.     SBC    HL,DE
  690.     CALL    CIRC1
  691.     LD    DE,(RCOS)
  692.     ADD    HL,DE
  693.     CALL    CIRC2
  694. ; X-RCOS, Y+RSIN
  695.     LD    DE,(RCOS)
  696.     OR    A
  697.     SBC    HL,DE
  698.     CALL    CIRC1
  699.     LD    DE,(RSIN)
  700.     ADD    HL,DE
  701.     CALL    CIRC2
  702. ; X-RCOS, Y-RSIN
  703.     LD    DE,(RCOS)
  704.     OR    A
  705.     SBC    HL,DE
  706.     CALL    CIRC1
  707.     LD    DE,(RSIN)
  708.     OR    A
  709.     SBC    HL,DE
  710.     CALL    CIRC2
  711. ; X-RSIN, Y-RCOS
  712.     LD    DE,(RSIN)
  713.     OR    A
  714.     SBC    HL,DE
  715.     CALL    CIRC1
  716.     LD    DE,(RCOS)
  717.     OR    A
  718.     SBC    HL,DE
  719.     CALL    CIRC2
  720. ; X+RCOS, Y-RSIN
  721.     LD    DE,(RCOS)
  722.     ADD    HL,DE
  723.     CALL    CIRC1
  724.     LD    DE,(RSIN)
  725.     OR    A
  726.     SBC    HL,DE
  727.     CALL    CIRC2
  728. ; X+RSIN, Y-RCOS
  729.     LD    DE,(RSIN)
  730.     ADD    HL,DE
  731.     CALL    CIRC1
  732.     LD    DE,(RCOS)
  733.     OR    A
  734.     SBC    HL,DE
  735.     CALL    CIRC2
  736.  
  737.     INC    IX
  738.     INC    IX
  739.     INC    IY
  740.     INC    IY
  741.     POP    BC
  742.     DEC    B
  743.     JP    NZ,CIRC0
  744.     LD    HL,(P1)        ; X+R, Y
  745.     LD    DE,(P3)
  746.     ADD    HL,DE
  747.     CALL    CIRC1
  748.     CALL    CIRC2
  749. ; X-R, Y
  750.     LD    DE,(P3)
  751.     OR    A
  752.     SBC    HL,DE
  753.     CALL    CIRC1
  754.     CALL    CIRC2
  755. ; X, Y+R
  756.     CALL    CIRC1
  757.     LD    DE,(P3)
  758.     ADD    HL,DE
  759.     CALL    CIRC2
  760. ;X, Y-R
  761.     CALL    CIRC1
  762.     LD    DE,(P3)
  763.     OR    A
  764.     SBC    HL,DE
  765.     CALL    CIRC2
  766. ;
  767.     IF    PAS.Z
  768. ;
  769.     POP    IY
  770.     POP    IX
  771.     XOR    A
  772.     ENDIF
  773. ;
  774.     RET
  775. ;
  776. CIRC1:    LD    (STARTX+2),HL
  777.     LD    HL,(P2)
  778.     RET
  779. ;
  780. CIRC2:    LD    (STARTY+2),HL
  781.     CALL    SET0
  782.     LD    HL,(P1)
  783.     RET
  784. ;
  785. RSIN:    DEFW    0
  786. RCOS:    DEFW    0
  787.  
  788. ;    MULT: from ELECTRONICS/Feb 24, 1982 Designer's Casebook
  789. ;          article by Jerry L. Goodrich
  790. ;          performs a 2-byte by 2-byte integer multiply
  791. ;          (BC)*(DE)-->(DE),(HL)
  792. ;
  793. MULT:
  794.     LD    A,E        ;load lowest-order byte of multiplier
  795.     PUSH    DE        ;save highes-order byte multiplier
  796.     CALL    BMULT        ;do 1-byte multiply
  797.     EX    (SP),HL        ;save lowest-order bytes product,get multiplier
  798.     PUSH    AF        ;store highes-order byte of first product
  799.     LD    A,H        ;load highest-order byte of multiplier
  800.     CALL    BMULT        ;do second 1-byte multiply
  801.     LD    D,A        ;position highest-order byte of product
  802.     POP    AF        ;get highes-order byte of first product
  803.     ADD    A,H        ;update third byte of product
  804.     LD    E,A        ;and put in E
  805.     JP    NC,NC1        ;don't incr D if no carry
  806.     INC    D        ;incr D if carry
  807. NC1:
  808.     LD    H,L        ;relocate lowest-order bytes of sec. prod.
  809.     LD    L,0
  810.     POP    BC        ;get lowest-order bytes of sec. prod.
  811.     ADD    HL,BC        ;get final product lowest-order 2 bytes
  812.     JR    NC,NC2        ;done if no carry
  813.     INC    DE        ;otherwise update highest-order 2 bytes
  814. NC2:
  815.     BIT    7,H        ;round up if frac part => .5
  816.     RET    Z
  817.     INC    DE
  818.     RET
  819. ;
  820. ;    BMULT performs a 1-byte by 2-byte multiply
  821. ;    (A)*(BC)-->(A),(BC)
  822. ;
  823. BMULT:
  824.     LD    HL,0        ;zero partial product
  825.     LD    DE,7        ;D=0,E=bit counter
  826.     ADD    A,A        ;get first mulitplier bit
  827. LOOP1:
  828.     JP    NC,ZERO        ;zero-skip
  829.     ADD    HL,BC        ;one-add multiplicand
  830.     ADC    A,D        ;add carry to third byte of product
  831. ZERO:
  832.     ADD    HL,HL        ;shift product left
  833.     ADC    A,A
  834.     DEC    E        ;decrement bit counter
  835.     JR    NZ,LOOP1    ;loop until done
  836.     RET    NC        ;done if no carry
  837.     ADD    HL,BC        ;otherwise do last add
  838.     ADC    A,D
  839.     RET            ;and return
  840.  
  841. ;    COSTBL and SINTBL are tables of cosine and sine values
  842. ;    specified as 16-bit fractions.  Each table is 45 units
  843. ;    (degrees) long.
  844. ;
  845. COSTBL:
  846.     DEFW    65526        ;1 DEG
  847.     DEFW    65496        ;2 
  848.     DEFW    65446        ;3
  849.     DEFW    65376        ;4
  850.     DEFW    65287        ;5
  851.     DEFW    65177        ;6
  852.     DEFW    65048        ;7
  853.     DEFW    64898        ;8
  854.     DEFW    64729        ;9
  855.     DEFW    64540        ;10
  856.     DEFW    64332        ;11
  857.     DEFW    64104        ;12
  858.     DEFW    63856        ;13
  859.     DEFW    63589        ;14
  860.     DEFW    63303        ;15
  861.     DEFW    62997        ;16
  862.     DEFW    62672        ;17
  863.     DEFW    62328        ;18
  864.     DEFW    61966        ;19
  865.     DEFW    61584        ;20
  866.     DEFW    61183        ;21
  867.     DEFW    60764        ;22
  868.     DEFW    60326        ;23
  869.     DEFW    59870        ;24
  870.     DEFW    59396        ;25
  871.     DEFW    58903        ;26
  872.     DEFW    58393        ;27
  873.     DEFW    57865        ;28
  874.     DEFW    57319        ;29
  875.     DEFW    56756        ;30
  876.     DEFW    56175        ;31
  877.     DEFW    55578        ;32
  878.     DEFW    54963        ;33
  879.     DEFW    54332        ;34
  880.     DEFW    53684        ;35
  881.     DEFW    53020        ;36
  882.     DEFW    52339        ;37
  883.     DEFW     51643        ;38
  884.     DEFW    50931        ;39
  885.     DEFW    50203        ;40
  886.     DEFW    49461        ;41
  887.     DEFW    48703        ;42
  888.     DEFW    47930        ;43
  889.     DEFW    47143        ;44
  890.     DEFW    46341        ;45
  891.  
  892. SINTBL:
  893.     DEFW    1144        ;1 DEG
  894.     DEFW    2287        ;2 
  895.     DEFW    3430        ;3
  896.     DEFW    4572        ;4
  897.     DEFW    5712        ;5
  898.     DEFW    6850        ;6
  899.     DEFW    7987        ;7
  900.     DEFW    9121        ;8
  901.     DEFW    10252        ;9
  902.     DEFW    11380        ;10
  903.     DEFW    12505        ;11
  904.     DEFW    13626        ;12
  905.     DEFW    14742        ;13
  906.     DEFW    15855        ;14
  907.     DEFW    16962        ;15
  908.     DEFW    18064        ;16
  909.     DEFW    19161        ;17
  910.     DEFW    20252        ;18
  911.     DEFW    21336        ;19
  912.     DEFW    22415        ;20
  913.     DEFW    23486        ;21
  914.     DEFW    24550        ;22
  915.     DEFW    25607        ;23
  916.     DEFW    26656        ;24
  917.     DEFW    27697        ;25
  918.     DEFW    28729        ;26
  919.     DEFW    29753        ;27
  920.     DEFW    30767        ;28
  921.     DEFW    31772        ;29
  922.     DEFW    32768        ;30
  923.     DEFW    33754        ;31
  924.     DEFW    34729        ;32
  925.     DEFW    35693        ;33
  926.     DEFW    36647        ;34
  927.     DEFW    37590        ;35
  928.     DEFW    38521        ;36
  929.     DEFW    39441        ;37
  930.     DEFW    40348        ;38
  931.     DEFW    41243        ;39
  932.     DEFW    42126        ;40
  933.     DEFW    42995        ;41
  934.     DEFW    43852        ;42
  935.     DEFW    44695        ;43
  936.     DEFW    45525        ;44
  937.     DEFW    46341        ;45
  938.  
  939. ;*************************************************************************
  940. ;
  941. ;    Axis Subroutine
  942. ;
  943. AXIS:
  944.     IF    PAS.Z
  945. ;
  946.     ENTRY    AXIS
  947.     POP    BC        ;fetch return address
  948.     LD    HL,0
  949.     ADD    HL,SP
  950.     LD    L,(HL)        ;fetch GRID: boolean
  951.     LD    (P7),HL
  952.     INC    SP
  953.     POP    HL        ;fetch YB: integer
  954.     LD    (P6),HL
  955.     POP    HL        ;fetch XB: integer
  956.     LD    (P5),HL
  957.     POP    HL        ;fetch YA: integer
  958.     LD    (P4),HL
  959.     POP    HL        ;fetch XA: integer
  960.     LD    (P3),HL
  961.     POP    HL        ;fetch Y0: integer
  962.     LD    (P2),HL
  963.     POP    HL        ;fetch X0: integer
  964.     LD    (P1),HL
  965.     PUSH    BC
  966.     ENDIF
  967. ;
  968.     IF    BASIC
  969. ;
  970.     LD    B,7        ; pass seven parameters
  971.     CALL    DTLNK
  972.     ENDIF
  973. ;
  974.     LD    HL,(P1)
  975.     CALL    TEST        ; keep within x,y bounds
  976.     LD    (P1),HL
  977.     LD    (STARTX+2),HL
  978.     LD    (ENDX+2),HL
  979.     LD    HL,0
  980.     LD    (STARTY+2),HL
  981.     LD    HL,DOTS-1
  982.     LD    (ENDY+2),HL
  983.     CALL    LINE1        ; draw Y axis
  984.     LD    HL,(P2)
  985.     CALL    YTEST
  986.     LD    (P2),HL
  987.     LD    (STARTY+2),HL
  988.     LD    (ENDY+2),HL
  989.     LD    HL,0
  990.     LD    (STARTX+2),HL
  991.     LD    HL,DOTS-1
  992.     LD    (ENDX+2),HL
  993.     CALL    LINE1        ; draw X axis
  994.  
  995.     IF    PAS.Z
  996. ;
  997.     PUSH    IX        ; save IX, IY for PAS.Z/Z
  998.     PUSH    IY
  999.     ENDIF
  1000. ;
  1001.     LD    IX,STARTX+2    ; point to Xt, Yt positions
  1002.     LD    IY,STARTY+2
  1003.     LD    HL,(P3)     ; fetch X tick minor
  1004.     LD    (TM),HL
  1005.     LD    A,L
  1006.     OR    H
  1007.     JR    Z,XTMAJ     ; skip if Xt minor=0
  1008.     LD    HL,(P1)
  1009.     LD    (TAXIS),HL
  1010.     LD    HL,(P2)
  1011.     LD    (CAXIS),HL
  1012.     CALL    TICK        ; fill in tick marks
  1013.     CALL    MINOR
  1014. XTMAJ:
  1015.     LD    HL,(P5)     ; fetch X tick major
  1016.     LD    (TM),HL
  1017.     LD    A,L
  1018.     OR    H
  1019.     JR    Z,YTMIN     ; skip if Xt major =0
  1020.     LD    HL,(P1)
  1021.     LD    (TAXIS),HL
  1022.     LD    HL,(P2)
  1023.     LD    (CAXIS),HL
  1024.     CALL    TICK        ; fill in tick marks
  1025.     LD    (XGRID),HL
  1026.     CALL    MAJOR
  1027. YTMIN:
  1028.     LD    IX,STARTY+2    ; same as above, but rotate axis
  1029.     LD    IY,STARTX+2
  1030.     LD    HL,(P4)     ; fetch Y tick minor
  1031.     LD    (TM),HL
  1032.     LD    A,L
  1033.     OR    H
  1034.     JR    Z,YTMAJ     ; skip if Y tick minor=0
  1035.     LD    HL,(P2)
  1036.     LD    (TAXIS),HL
  1037.     LD    HL,(P1)
  1038.     LD    (CAXIS),HL
  1039.     CALL    TICK        ; fill in tick marks
  1040.     CALL    MINOR
  1041. YTMAJ:
  1042.     LD    HL,(P6)     ; fetch Y tick major
  1043.     LD    (TM),HL
  1044.     LD    A,L
  1045.     OR    H
  1046.     RET    Z        ; all done no Y tick major
  1047.     LD    HL,(P2)
  1048.     LD    (TAXIS),HL
  1049.     LD    HL,(P1)
  1050.     LD    (CAXIS),HL
  1051.  
  1052.     CALL    TICK        ; fill in tick marks
  1053.     LD    (YGRID),HL
  1054.     CALL    MAJOR
  1055.     CALL    GRID
  1056.     IF    PAS.Z
  1057. ;
  1058.     POP    IY        ; restore IX, IY
  1059.     POP    IX
  1060.     XOR    A        ; indicate valid external procedure call
  1061.     ENDIF
  1062. ;
  1063.     RET
  1064. ;
  1065. TICK:    LD    HL,DOTS-1    ; find largest value for tick mark
  1066.     LD    DE,(TAXIS)
  1067.     OR    A
  1068.     SBC    HL,DE
  1069.     LD    DE,(TM)
  1070. TICK0:    SBC    HL,DE
  1071.     JR    NC,TICK0
  1072.     ADD    HL,DE
  1073.     LD    DE,DOTS-1
  1074.     EX    DE,HL
  1075.     OR    A
  1076.     SBC    HL,DE        ; HL = highest value for tick mark
  1077.     RET
  1078. ;
  1079. MINOR:    LD    (IX+0),L    ; plot minor tick marks on indicated axis
  1080.     LD    (IX+1),H
  1081.     LD    HL,(CAXIS)
  1082.     DEC    HL
  1083.     LD    (IY+0),L
  1084.     LD    (IY+1),H
  1085.     CALL    SET0
  1086.     LD    HL,(CAXIS)
  1087.     INC    HL
  1088.     LD    (IY+0),L
  1089.     LD    (IY+1),H
  1090.     CALL    SET0
  1091.     LD    L,(IX+0)
  1092.     LD    H,(IX+1)
  1093.     LD    DE,(TM)
  1094.     OR    A
  1095.     SBC    HL,DE
  1096.     JR    NC,MINOR
  1097.     RET
  1098.  
  1099. MAJOR:    LD    (IX+0),L    ; plot major tick marks on indicated axis
  1100.     LD    (IX+1),H
  1101.     LD    HL,(CAXIS)
  1102.     DEC    HL
  1103.     DEC    HL
  1104.     DEC    HL
  1105.     LD    (IY+0),L
  1106.     LD    (IY+1),H
  1107.     CALL    SET0
  1108.     LD    HL,(CAXIS)
  1109.     DEC    HL
  1110.     DEC    HL
  1111.     LD    (IY+0),L
  1112.     LD    (IY+1),H
  1113.     CALL    SET0
  1114.     LD    HL,(CAXIS)
  1115.     DEC    HL
  1116.     LD    (IY+0),L
  1117.     LD    (IY+1),H
  1118.     CALL    SET0
  1119.     LD    HL,(CAXIS)
  1120.     INC    HL
  1121.     LD    (IY+0),L
  1122.     LD    (IY+1),H
  1123.     CALL    SET0
  1124.     LD    HL,(CAXIS)
  1125.     INC    HL
  1126.     INC    HL
  1127.     LD    (IY+0),L
  1128.     LD    (IY+1),H
  1129.     CALL    SET0
  1130.     LD    HL,(CAXIS)
  1131.     INC    HL
  1132.     INC    HL
  1133.     INC    HL
  1134.     LD    (IY+0),L
  1135.     LD    (IY+1),H
  1136.     CALL    SET0
  1137.     LD    L,(IX+0)
  1138.     LD    H,(IX+1)
  1139.     LD    DE,(TM)
  1140.     OR    A
  1141.     SBC    HL,DE
  1142.     JR    NC,MAJOR
  1143.     RET
  1144.  
  1145. GRID:
  1146.     LD    HL,(P7)     ; plot x, y grid marks if required
  1147.     LD    A,H
  1148.     OR    L
  1149.     RET    Z        ; no grid required
  1150.     LD    HL,(P5)
  1151.     LD    A,H
  1152.     OR    L
  1153.     RET    Z        ; impossible x grid
  1154.     LD    HL,(P6)
  1155.     LD    A,H
  1156.     OR    L
  1157.     RET    Z        ; impossible y grid
  1158.     LD    HL,(XGRID)    ; put grid marks at intersections of
  1159. GRID0:    LD    (STARTX+2),HL    ; axis major tick marks
  1160.     LD    HL,(YGRID)
  1161. GRID1:    LD    (STARTY+2),HL
  1162.     CALL    SET1
  1163.     LD    HL,(STARTY+2)
  1164.     LD    DE,(P6)
  1165.     OR    A
  1166.     SBC    HL,DE
  1167.     JR    NC,GRID1
  1168.     LD    HL,(STARTX+2)
  1169.     LD    DE,(P5)
  1170.     OR    A
  1171.     SBC    HL,DE
  1172.     JR    NC,GRID0
  1173.     RET
  1174.  
  1175. ;******************************************************************************
  1176. ;
  1177. ;    CPM INTERFACE DRIVERS
  1178. ;
  1179. PRNTR:
  1180.     CALL    CPMOUT
  1181. ;
  1182.     IF    BASE2
  1183. ;
  1184.     LD    B,32
  1185. DELAY:    DJNZ    DELAY        ; give BASE2 some more time
  1186.     ENDIF
  1187. ;
  1188.     RET
  1189. ;
  1190. CPMOUT:
  1191.     PUSH    AF        ; NOTE: some BIOS implementations
  1192.     PUSH    BC        ; will alter IX & IY
  1193.     PUSH    DE        ; so save all the Z-80 registers
  1194.     PUSH    HL
  1195.     PUSH    IX
  1196.     PUSH    IY
  1197.     LD    E,A
  1198.     LD    C,5
  1199.     CALL    BDOS
  1200.     POP    IY
  1201.     POP    IX
  1202.     POP    HL
  1203.     POP    DE
  1204.     POP    BC
  1205.     POP    AF
  1206.     RET
  1207.  
  1208. ;*************************************************************************
  1209. ;
  1210. ;    XFRPLT: transfer image-to-printer subroutine
  1211. ;
  1212. XFRPLT:                ; CALL & USR entry point, no parameters
  1213.     IF    PAS.Z
  1214. ;
  1215.     ENTRY    XFRPLT
  1216.     PUSH    IX        ; save IX, IY for PAS.Z/Z
  1217.     PUSH    IY
  1218.     ENDIF
  1219. ;
  1220.     IF    BASE2
  1221. ;
  1222.     LD    A,27        ; set up PRNTR for:
  1223.     CALL    PRNTR        ;    96 characters/inch
  1224.     LD    A,50        ;    14 vertical half-dots/inch
  1225.     CALL    PRNTR
  1226.     LD    A,27
  1227.     CALL    PRNTR
  1228.     LD    A,98
  1229.     CALL    PRNTR
  1230.     LD    A,14
  1231.     CALL    PRNTR
  1232.     ENDIF
  1233. ;
  1234.     IF    IDS560
  1235. ;
  1236.     LD    A,03        ; send ETX character
  1237.     CALL    PRNTR
  1238.       ENDIF
  1239. ;
  1240. ;    row:    continous sequence of memory locations of length LENGTH
  1241. ;    line:    continous sequence of graphic characters of length LENGTH
  1242. ;    shift:    number of 16 bit left shifts required to recover graphic
  1243. ;        character from 16 bit word formed from location
  1244. ;            plot+i (IX)->H, and plot+i+LENGTH (IY)->L
  1245. ;
  1246.     LD      IX,(IMGPTR)    ; IX = IMAGE
  1247.     LD    IY,(IMGPTR)
  1248.     LD    DE,LENGTH
  1249.     ADD    IY,DE        ; IY = IMAGE + LENGTH
  1250.     LD    C,LINES     ; transfer this number of print lines
  1251. XFR0:    LD    D,7        ; # shifts in first group
  1252. ;
  1253. XFR1:
  1254.     IF    BASE2
  1255. ;
  1256.     LD    A,27        ; set up for graphics
  1257.     CALL    PRNTR
  1258.     LD    A,99
  1259.     CALL    PRNTR
  1260.     ENDIF
  1261.  
  1262.     PUSH    BC        ; save line counter
  1263.     LD    B,FILL1     ; & fill left margin with blanks
  1264. XFR10:    LD    A,128
  1265.     CALL    PRNTR
  1266.     DJNZ    XFR10
  1267.     LD    BC,LENGTH    ; transfer the graphics characters
  1268. XFR2:    LD    H,(IX+0)
  1269.     LD    L,(IY+0)
  1270.     CALL    ROTL
  1271. ;
  1272.     IF    BASE2
  1273. ;
  1274.     CALL    PRINTER
  1275.     ENDIF
  1276. ;
  1277.     IF    IDS560
  1278. ;
  1279.     PUSH    AF
  1280.     CALL    PRNTR
  1281.     POP    AF
  1282.     CP    03        ; was ETX sent?
  1283.     CALL    Z,PRNTR        ; yes, must be sent twice
  1284.     ENDIF
  1285. ;
  1286.     INC    IX        ; increment image pointers
  1287.     INC    IY
  1288.     DEC    BC        ; decrement character counter
  1289.     LD    A,C
  1290.     OR    B
  1291.     JR    NZ,XFR2     ; do entire line of graphic characters
  1292. ;
  1293.     IF    BASE2
  1294. ;
  1295.     LD    B,FILL2
  1296. XFR20:    LD    A,128        ; fill right margin with blanks
  1297.     CALL    PRNTR
  1298.     DJNZ    XFR20
  1299.     LD    A,10        ; terminate with line feed
  1300.     CALL    PRNTR
  1301.     ENDIF
  1302.  
  1303.     IF    IDS560
  1304. ;
  1305.     LD    A,03        ; send line terminator sequence
  1306.     CALL    PRNTR
  1307.     LD    A,14
  1308.     CALL    PRNTR
  1309.     ENDIF
  1310. ;
  1311.     DEC    D        ; do one less shift on next line
  1312.     LD    A,D        ; test for D=6, special case
  1313.     CP    6
  1314.     JR    NZ,XFR21
  1315.     LD    BC,-LENGTH    ; if D=6 then repeat row for next line
  1316.     ADD    IX,BC
  1317.     ADD    IY,BC
  1318.  
  1319. XFR21:    POP    BC
  1320.     DEC    C        ; decrement line counter
  1321.     JR    Z,XFRDN     ; all lines done, exit from loop
  1322.     LD    A,D        ; shifts 7 --> 0 done?
  1323.     CP    -1
  1324.     JR    NZ,XFR1     ; no, do next shift
  1325.     JR    XFR0        ; yes, next row, line, shifts 7-->0
  1326. XFRDN:
  1327.     IF    BASE2
  1328. ;
  1329.     LD    A,27        ; reset printer to normal
  1330.     CALL    PRNTR
  1331.     LD    A,98
  1332.     CALL    PRNTR
  1333.     LD    A,24
  1334.     CALL    PRNTR
  1335.     ENDIF
  1336. ;
  1337.     IF    IDS560
  1338. ;
  1339.     LD    A,03
  1340.     CALL    PRNTR
  1341.     LD    A,14
  1342.     CALL    PRNTR
  1343.     LD    A,03
  1344.     CALL    PRNTR
  1345.     LD    A,02        ; return to NORMAL mode
  1346.     CALL    PRNTR
  1347.     ENDIF
  1348. ;
  1349.     IF    PAS.Z
  1350. ;
  1351.     POP    IY        ; restore IX, IY for PAS.Z
  1352.     POP    IX
  1353.     ENDIF
  1354. ;
  1355.     RET
  1356. ;
  1357. ROTL:    PUSH    DE        ; save DE, BC
  1358.     PUSH    BC
  1359.     XOR    A        ; test for case 0
  1360.     CP    D
  1361.     JR    Z,ROTL1     ; no shifts for case 0
  1362.     LD    A,D        ; test for case 7
  1363.     CP    7
  1364.     JR    NZ,ROTL0    
  1365.     SRL    H        ; if D=7, then one shift right
  1366.     JR    ROTL1
  1367. ROTL0:    SLA    L
  1368.     RL    H        ; 16 bit rotate D bits to left
  1369.     DEC    D
  1370.     JR    NZ,ROTL0
  1371. ROTL1:    XOR    A        ; reverse bit order for PRNTR
  1372.     LD    B,7
  1373. ROTL2:    SRL    H
  1374.     RLA
  1375.     DJNZ    ROTL2
  1376.     POP    BC        ; restore BC, DE
  1377.     POP    DE
  1378.     RET            ; & return graphic char in Accum
  1379.  
  1380. ;*************************************************************************
  1381. ;
  1382. ;    working storage locations
  1383. ;
  1384. STARTX: DEFW    0        ; X1, 16 bit integer, 16 bit fraction
  1385.     DEFW    0
  1386. STARTY: DEFW    0        ; Y1, same
  1387.     DEFW    0
  1388. ENDX:    DEFW    0        ; X2, same
  1389.     DEFW    0
  1390. ENDY:    DEFW    0        ; Y2, same
  1391.     DEFW    0
  1392. DIRX:    DEFW    0        ; (X2 - X1)/256, same formate as X1
  1393.     DEFW    0
  1394. DIRY:    DEFW    0        ; (Y2 - Y1)/256, same
  1395.     DEFW    0
  1396. ;
  1397. ;    passed parameters storage
  1398. ;
  1399. P1:    DEFW    0        ; memory reserved for passing up to
  1400. P2:    DEFW    0        ; eight parameters from BASIC via
  1401. P3:    DEFW    0        ; CALL subr(P1,P2,P3,P4,P5,P6,P7,P8)
  1402. P4:    DEFW    0
  1403. P5:    DEFW    0
  1404. P6:    DEFW    0
  1405. P7:    DEFW    0
  1406. P8:    DEFW    0
  1407. ;
  1408. TM:    DEFW    0        ; reserved for AXIS routine temp storage
  1409. TAXIS:    DEFW    0
  1410. CAXIS:    DEFW    0
  1411. ;
  1412. XGRID:    DEFW    0
  1413. YGRID:    DEFW    0
  1414. ;
  1415. IMGPTR:    DEFW    IMAGE
  1416. IMAGE    EQU    $
  1417. ;
  1418.     IF    PAS.Z
  1419. ;
  1420.     DEFS    AREA
  1421.     ENDIF
  1422. ;
  1423.     END    
  1424.