home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_5.ZIP / TCOMUTIL.ZIP / TSHAPES.SEQ < prev    next >
Encoding:
Text File  |  1989-12-05  |  3.1 KB  |  90 lines
  1. \\ Circle and Arc drawing for TCOM credit for this and other parts of
  2.    the graphics support in TCOM goes to all of the following people:
  3.  
  4.         Wempe
  5.         Oliver Shank
  6.         Keith Gunn
  7.         John Bumgarner
  8.  
  9. {
  10.  
  11. FORTH DECIMAL TARGET >LIBRARY       \ A Library file
  12.  
  13. ( TRIG APPROXIMATIONS - by J. BUMGARNER              ODS01JUL87)
  14.  
  15. TABLE SINTBL
  16.      0 ,   174 ,   348 ,   522 ,   697 ,   870 ,  1045 ,  1218 ,
  17.   1391 ,  1563 ,  1736 ,  1907 ,  2078 ,  2250 ,  2418 ,  2587 ,
  18.   2755 ,  2923 ,  3089 ,  3255 ,  3419 ,  3583 ,  3745 ,  3907 ,
  19.   4066 ,  4226 ,  4382 ,  4539 ,  4693 ,  4847 ,  4999 ,  5150 ,
  20.   5298 ,  5446 ,  5592 ,  5735 ,  5877 ,  6017 ,  6155 ,  6292 ,
  21.   6427 ,  6559 ,  6690 ,  6819 ,  6946 ,  7070 ,  7193 ,  7314 ,
  22.   7431 ,  7546 ,  7659 ,  7771 ,  7879 ,  7985 ,  8089 ,  8191 ,
  23.   8290 ,  8386 ,  8480 ,  8571 ,  8659 ,  8746 ,  8829 ,  8910 ,
  24.   8986 ,  9062 ,  9134 ,  9204 ,  9271 ,  9336 ,  9397 ,  9455 ,
  25.   9511 ,  9562 ,  9612 ,  9616 ,  9702 ,  9743 ,  9780 ,  9814 ,
  26.   9846 ,  9876 ,  9903 ,  9926 ,  9945 ,  9963 ,  9974 ,  9986 ,
  27.   9993 ,  9997 , 10000 ,
  28. END-TABLE
  29.  
  30. CODE ISIN       ( n1-degrees ---, n2-sine*10K )
  31.                 XOR CX, CX
  32.                 MOV DX, # $168
  33.                 BEGIN   CMP BX, CX
  34.              <  WHILE   ADD BX, DX
  35.                 REPEAT
  36.                 BEGIN   CMP BX, DX
  37.              >= WHILE   SUB BX, DX
  38.                 REPEAT
  39.                 MOV DX, # $B4
  40.                 CMP DX, BX
  41.               < IF      INC CX
  42.                         SUB BX, DX
  43.                 THEN
  44.                 MOV AX, # $5A
  45.                 CMP AX, BX
  46.               < IF      SUB DX, BX
  47.                         MOV BX, DX
  48.                 THEN
  49.                 SHL BX, # 1
  50.                 ADD BX, # SINTBL
  51.                 MOV AX, 0 [BX]
  52.                 CMP CX, # 0
  53.             0<> IF      NEG AX
  54.                 THEN
  55.                 MOV BX, AX
  56.                 RET     END-CODE
  57.  
  58. : ICOS  NEGATE 90 + ISIN ;
  59.  
  60. \ DEGS XI>P YI>P                                OODS01JUL87
  61.  
  62.     9 VALUE    DEGS             \ 9  degrees per segment res/speed tradeoff
  63. 10000 CONSTANT 10K              \ scale factor for SIN and COS functions
  64.  
  65. : XI>P HDOTS 100 */ ;           \ horizontal inches to pixels
  66. : YI>P VDOTS 100 */ ;           \ vertical   inches to pixels
  67.  
  68. \ DOARC  CIRCLE  ARC                            1/ODS04JUL87
  69.  
  70. : DOARC         ( ??????? -- )
  71.                 DO      2 PICK OVER   XI>P I ICOS 10K */ +
  72.                         2 PICK 2 PICK YI>P I ISIN 10K */ +
  73.                         LINETO DEGS
  74.                 +LOOP 2DROP DROP ;
  75.  
  76.                 \ HDOTS 2/ VDOTS 2/ RADIUS -- puts cir. in center
  77.                 \ RADIUS is in inches*10
  78. : CIRCLE        ( x y radius -- )
  79.                 2 PICK OVER XI>P 0 ICOS 10K */ + 2 PICK LINEFROM
  80.                 361 DEGS DOARC ;
  81.  
  82. : ARC           ( x y radius start-ang end-ang -- )
  83.                 >R >R
  84.                 2 PICK OVER XI>P R@ ICOS 10K */ +
  85.                 2 PICK 2 PICK YI>P R@ ISIN 10K */ + LINEFROM
  86.                 R> DEGS + R> 1+ SWAP DOARC ;
  87.  
  88. FORTH TARGET >TARGET
  89.  
  90.