home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol134 / profile.src < prev    next >
Encoding:
Text File  |  1984-04-29  |  6.7 KB  |  355 lines
  1. * PROCEDURE profile(VAR x,y   : INT_ARRAY;
  2. *                   VAR n     : INTEGER;
  3. *                       dc    : byte;
  4. *                       maxn  : INTEGER;
  5. *                   VAR penup : BOOLEAN);
  6.  
  7. * A PASCAL/Z EXTERNAL ROUTINE TO FILL ARRAYS X AND Y USING A HOUSTON HIPAD
  8. * DIGITIZER FOR INPUT.ASSUMES THAT THE HIPAD IS IN STREAM MODE AND SETUP 
  9. * FOR PARALLEL BINARY METRIC TRANSMISSION.
  10. * POINT COLLECTING STARTS WHEN THE PEN GOES DOWN.(i.e.CONTROL BYTE = 0F4H)
  11. * A POINT IS REJECTED IF (ABS(dx) + ABS(dy)) IS LESS THAN dc UNITS FROM THE
  12. * PRECEDING POINT (ONE UNIT = 0.1mm).
  13. * THE PROCEDURE ENDS IF :
  14. *                     1 : THE PEN COMES UP ,
  15. *                     2 : MAXN POINTS HAVE BEEN READ,
  16. *                OR   3 : MORE THAN min# POINTS HAVE BEEN READ AND A POINT
  17. *                         IS ACQUIRED CLOSER THAN closed TO THE FIRST POINT.
  18. * THUS THE ARRAYS WILL HOLD COORDINATES OF POINTS ON THE PERIMETER OF A
  19. * CLOSED PROFILE.
  20.  
  21. vbytes    EQU 12      # OF BYTES ON STACK
  22. xhi       EQU 19
  23. xlo    EQU 18    OFFSETS TO (IX) FOR ADDRESS OF POINTERS
  24. yhi    EQU 17
  25. ylo    EQU 16    TO TRANSMITTED VARIABLES.
  26. nhi    EQU 15
  27. nlo    EQU 14
  28. dc    EQU 12
  29. maxnhi    EQU 11
  30. maxnlo    EQU 10
  31. penup    EQU  9
  32.  
  33. min#    EQU 30
  34. closed    EQU 5    ( 1 = 0.1mm )
  35. FALSE    EQU 0
  36. TRUE    EQU NOT FALSE
  37.  
  38. STAT_RDY EQU 0F7H  STATUS PORT DATA AVAILABLE CODE
  39. STAT_PRT EQU 00AH  ADDRESS OF STATUS PORT
  40. DATA_PRT EQU 008H     "    "   DATA    "
  41.  
  42.     NAME    profile
  43.     ENTRY    profile
  44.  
  45. PASS:    MACRO    ARG        ; STORES THE 16BIT NO. IN DE
  46.                 ; IN A LOCATION WHOSE BASE
  47.                 ; ADDRESS IS CALCULATED FROM ARG.
  48.                 ; & WHOSE OFFSET = 2 x IY
  49.     PUSH    H
  50.     MOV    H,ARG(IX)    ; GET BASE ADDRESS OF
  51.     MOV    L,ARG-1(IX)    ; ARRAY => HL
  52.     CALL    passxy
  53.     POP    H
  54.     ENDMAC
  55.  
  56. invert:        MACRO    arg
  57.         PUSH    P
  58.         MOV    A,arg
  59.         NEG
  60.         MOV    arg,A
  61.         POP    P
  62.         ENDMAC
  63.  
  64. profile:
  65.     ENTR D,2,0
  66.     JMP START
  67. old_x:    DS 2
  68. old_y:    DS 2
  69. x1:    DS 2
  70. y1:    DS 2
  71. start:
  72.     PUSH Y         : SAVE IY FOR PASCAL/Z
  73.     MOV B,maxnhi(IX) : GET VALUE OF
  74.     MOV C,maxnlo(IX) : MAXN => BC.
  75.     LXI H,0
  76.     STC
  77.     CMC
  78.     DSBC B         : MAXN = or > 1 ?
  79.     JC START2     : IF YES THEN START
  80.     PUSH B
  81.     POP Y
  82.     CALL PASS_N     : ELSE MAXN --> N
  83.     JMP done     : and RETURN.
  84. START2:
  85.     MOV H,penup(ix)    : initialise penup to FALSE
  86.     MOV L,penup-1(ix)
  87.     MVI M,FALSE
  88.     CALL W8_4_PEN    : PEN DOWN YET?
  89.     CALL FIRST_PR
  90. LOOP:
  91.     JMP ANYMORE    : DOES N := MAXN YET ?
  92. PROCEED:
  93.     JMP PEN_UP_YET
  94. STILL_DOWN:
  95.     JMP NEXT_PR
  96. done:
  97.     CALL PASS_N
  98.     POP Y        : RESTORE ORIGINAL Y FOR PASCAL/Z
  99.     EXIT D,VBYTES
  100.  
  101. *********************  SUBROUTINES  ********************************
  102.  
  103. W8_4_PEN:        * READS DATA PORT UNTIL CONTROL BYTE = F4
  104.             * i.e. UNTIL THE PEN IS DOWN.
  105.     CALL STAT_CHK    ;WAIT TILL DATA AVAILABLE
  106.     IN DATA_PRT    ;GET IT
  107.     CPI 0F4H    ;PEN DOWN ?
  108.     JNZ W8_4_PEN    ;NO : KEEP WAITING.
  109.     RET        ;YES!
  110.  
  111. FIRST_PR:            * GETS THE INITIAL X,Y PAIR
  112.     CALL X_IN          DISCARD THE FIRST
  113.     CALL Y_IN          POINT AS IT CAN
  114.     CALL W8_4_PEN          BE GARBAGE.
  115.     CALL X_IN          X[1] => DE
  116.     CALL Y_IN          Y[1] => HL
  117.     PUSH H              SAVE Y[1]
  118.     MOV B,xhi(IX)    ;
  119.     MOV C,xlo(IX)
  120.     MOV A,D
  121.     STA OLD_X        ;SAVE IT TO COMPARE WITH NEXT X
  122.     STA x1
  123.     STAX B            ;& ALSO SEND IT TO PASCAL/Z LAND.
  124.     DCX B
  125.     MOV A,E
  126.     STA OLD_X+1
  127.     STA x1+1
  128.     STAX B
  129.     MOV B,yhi(IX)
  130.     MOV C,ylo(IX)
  131.     POP H            Y[1] => HL
  132.     MOV A,H
  133.     STA old_y        ;SAVE IT TO COMPARE WITH NEXT y
  134.     STA y1
  135.     STAX B            ;& ALSO SEND IT TO PASCAL/Z LAND.
  136.     DCX B
  137.     MOV A,L
  138.     STA old_y+1
  139.     STA y1+1
  140.     STAX B
  141.     LXI Y,1        : COUNTER FOR POINTS READ.
  142.     RET
  143.  
  144. ANYMORE:        * N = MAXN ? (i.e. IS BUFFER FULL ?)
  145.     PUSH    H    
  146.     MOV    H,maxnhi(IX)
  147.     MOV    L,maxnlo(IX)
  148.     PUSH    D
  149.     PUSH    Y        ;GET COUNT FROM Y
  150.     POP    D        ;TO DE + COMPARE
  151.     STC
  152.     CMC
  153.     DSBC    D        ;TO MAXN.
  154.     POP    D
  155.     POP    H
  156.     JZ    done
  157.     JMP    proceed
  158.  
  159. PEN_UP_YET:        * READ DATA PORT : IS CONTROL BYTE = F3 ?
  160.     CALL STAT_CHK    ;WAIT FOR DATA
  161.     IN DATA_PRT    ;GET A BYTE
  162.     CPI 0F4H    ;CONTROL BYTE = F4?(PEN STILL DOWN)
  163.     JZ STILL_DOWN
  164.     MOV H,penup(ix)    : set penup TRUE
  165.     MOV L,penup-1(ix)
  166.     MVI M,TRUE
  167.     JMP done      ;and EXIT IF PEN NOT DOWN
  168.  
  169. NEXT_PR:        * GETS ALL POINTS AFTER (X[1],Y[1])
  170.     CALL X_IN        : GET  NEW X => DE
  171.     PUSH D            : & SAVE IT
  172.     LXI H,OLD_X
  173.     MOV B,M
  174.     INX H
  175.     MOV C,M            : GET  OLD_X => BC
  176.     XCHG            : MOVE NEW X => HL
  177.     CALL    absdiff        : abs(dx) => A
  178.     PUSH    p        : save abs(dx) for later
  179.         LXI    H,old_y        :
  180.     MOV    B,M        : get last y value
  181.     INX    H        : into BC
  182.     MOV    C,M        :
  183.     CALL    y_in        : new y => HL
  184.     PUSH    H
  185.     POP    D        : copy y to DE
  186.     CALL    absdiff        : abs(dy) => A
  187.     POP    B        : abs(dx) => B
  188.     ADD    B        : (abs(dx) + abs(dy)) => A
  189.     CC    overflow
  190.     MOV    C,dc(IX)
  191.     SUB    C        : > dc ?
  192.     JNC    point_ok
  193.     POP    D        : if not : too close ! so fix stack
  194.     JMP    loop
  195. point_ok:
  196.     INX    Y        : N := N + 1
  197.     MOV    A,D        : IF SO  : y => old_y
  198.     STA    old_y
  199.     MOV    A,E
  200.     STA    old_y+1
  201.     pass    yhi        : and y => y[i]
  202.     XCHG            : y => HL
  203.  
  204.     POP    D        : RESTORE X
  205.     MOV    A,D
  206.     STA    old_x        : SAVE IT TO COMPARE WITH NEXT X
  207.     MOV    A,E
  208.     STA    old_x+1
  209.     pass    xhi        : x => x[i]
  210. * n.b. we now have y in HL,X in DE & n in IY: have we >= min# points?
  211.     PUSH    H        : save y
  212.     PUSH    IY
  213.     POP    B        : n => BC
  214.     LXI    H,min#
  215.     STC
  216.     CMC
  217.     DSBC    B
  218.     POP    H
  219.     JNC    loop        : no! so keep going.
  220. * yes! so see if circle can be closed : i.e.are we close enough to (x1,y1) ?
  221.     LDA    y1
  222.     MOV    B,A
  223.     LDA    y1+1
  224.     MOV    C,A        :  y[1] => BC
  225.     CALL    absdiff        : abs(y[1] - y[i]) => A
  226.     PUSH    p        :   "  "       "   => stack
  227.     XCHG            : x[i] => HL
  228.     LDA    x1
  229.     MOV    B,A
  230.     LDA    x1+1
  231.     MOV    C,A        : x[1] => BC
  232.     CALL    absdiff        : abs(X[1] - Y[i]) => A
  233.     POP    B        : abs(y[1] - y[i]) => B
  234.     ADD    B        : abs(distance from (x[1],y[1])) => A
  235.     CC    overflow
  236.     MOV    C,A        : into C.
  237.     MVI    A,closed    : close enough to end?
  238.     SUB    C
  239.     JNC    done        : yes!
  240.     JMP    loop        : no!
  241.  
  242. absdiff:            * arg1 in HL,arg2 in BC : abs(diff) => A
  243.     BIT    7,H
  244.     JNZ    hlneg
  245.     BIT    7,B
  246.     JNZ    subtract
  247. bothpos:
  248.     PUSH    H
  249.     STC
  250.     CMC
  251.     DSBC    B
  252.     JC    bcbigger
  253.     POP    B
  254.     JMP    subdone
  255. bcbigger:
  256.     POP    H
  257.     CALL    switch
  258. subtract:
  259.     STC
  260.     CMC
  261.     DSBC    B
  262.     JMP    subdone
  263. hlneg:
  264.     BIT    7,B
  265.     JNZ    negate
  266.     CALL    switch
  267.     JMP    subtract
  268. negate:
  269.     invert    H
  270.     invert    L
  271.     invert    B
  272.     invert    C
  273.     JMP    bothpos
  274. switch:
  275.     PUSH    H
  276.     PUSH    B
  277.     POP    H
  278.     POP    B
  279.     RET
  280. subdone:
  281.     MOV    A,H
  282.     ORA    A
  283.     JNZ    overflow
  284.     MOV    A,L
  285.     RET
  286.  
  287. overflow:
  288.     MVI    A,07FH          * largest +ve 8bit #
  289.     RET
  290.  
  291. STAT_CHK:            * CHECKS STATUS PORT 
  292.     IN    STAT_PRT    ;DATA IN? 
  293.     CPI    STAT_RDY 
  294.     RZ        ;IF SO:GO GET IT.
  295.     JMP    STAT_CHK     ;ELSE TRY AGAIN.
  296.  
  297. X_IN:                * GET X VALUE FROM HIPAD INTO DE
  298.     CALL    STAT_CHK    ;WAIT FOR DATA
  299.     IN    DATA_PRT    ;GET 1ST BYTE (X7..X13)
  300.     MOV    D,A        ;INTO D
  301.     PUSH    D
  302.     CALL    STAT_CHK
  303.     POP    D
  304.     IN    DATA_PRT    ;2ND BYTE (X0..X6)
  305.     MOV    E,A        ;INTO E
  306.     SLAR    E        ;---|
  307.     SLAR    D        ;   |JUSTIFY
  308.     SRAR    D        ;   | RIGHT 
  309.     SRAR    D        ;   | IN DE
  310.     RRAR    E        ;---|
  311.     RET
  312.  
  313. Y_IN:            * GET Y VALUE FROM HIPAD INTO HL
  314.     XCHG
  315.     CALL    X_IN
  316.     XCHG
  317.     RET
  318.  
  319. PASS_N:                ; PUT CONTENTS OF IY INTO N.
  320.     PUSH    IY
  321.     POP    H        ; IY => HL.
  322.     MOV    D,nhi(IX)    : ADDRESS OF N
  323.     MOV    E,nlo(IX)    : => DE.
  324.     MOV    A,H
  325.     STAX    D
  326.     DCX    D
  327.     MOV    A,L
  328.     STAX    D
  329.     RET
  330.  
  331. passxy:            * base address in HL ,value in DE ,N in IY.
  332.     PUSH    D
  333.     PUSH    B
  334.     PUSH    Y
  335.     DCX    Y    ;
  336.     DADY    Y    ; OFFSET = 2 * (Y - 1)
  337.     PUSH    Y
  338.     POP    B    ; OFFSET --> BC
  339.     stc
  340.     cmc
  341.     DSBC    B    ; ADDRESS OF ARRAY[N] = HL-OFFSET
  342.     XCHG        ; ADDRESS => DE : value => HL
  343.     MOV    A,H
  344.     STAX    D
  345.     DCX    D
  346.     MOV    A,L
  347.     STAX    D
  348.     POP    Y
  349.     POP    B
  350.     POP    D
  351.     RET
  352.  
  353.         END profile
  354.  
  355.