home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFB.ZIP / FFUTILS.ARC / SMITH.ARC / GRAPHICS.SEQ < prev    next >
Encoding:
Text File  |  1987-11-23  |  7.5 KB  |  259 lines
  1. \ GRAPHICS.SEQ  A graphics package by Davies, Smith, and Smiley.
  2.  
  3. comment:
  4. Here are some graphics primitives, from the following package.
  5. +--------------------------------------------------------------+
  6. |               FLOATING-POINT  TURTLE  GRAPHICS               |
  7. |     Behold !  On the following screens will be revealed the  |
  8. |   wonders of Lines and Turtle Graphics.  Let the lights dim  |
  9. |   and Wagner's "Ride of the Valkyries" play softly in the    |
  10. |   background.  Prepare, for you are about to perceive        |
  11. |                                                              |
  12. |             T H E   M A G I C   O F   F O R T H   !          |
  13. |                                                              |
  14. |                                                              |
  15. |                         R. L. Davies                         |
  16. |                         E. Tim Smith                         |
  17. |                   (or the other way around)                  |
  18. |                    and  Mark Smiley                          |
  19. |                                                              |
  20. +--------------------------------------------------------------+
  21. comment;
  22.  
  23. POSTFIX         \  We will use the post version of the assembler here.
  24.  
  25. \  XINTCALL and INTCALL   by E.T. Smith
  26.  
  27. CODE <XINTCALL> DX POP CX POP BX POP AX POP BP PUSH SI PUSH
  28.                 0 INT SI POP BP POP PUSHF 1PUSH END-CODE
  29.  
  30. : XINTCALL  [ ' <XINTCALL> 7 +  ( 7 + for direct   code )
  31.                                 ( 9 + for indirect code ) ] LITERAL C!
  32.             [ ' <XINTCALL> ] LITERAL EXECUTE ;
  33.  
  34. : INTCALL   XINTCALL NIP ;
  35.  
  36. : FINTCALL  XINTCALL DROP ;
  37.  
  38. \ Line Drawing --------------- by Tim Smith --------------------
  39. \ Graphics Comments --------- by R. L. Davies ---------------
  40.  
  41. : MODE   ( n -- )     0  0  0  16  INTCALL  DROP  ;
  42.  
  43. VARIABLE  COLOR             1  COLOR  !
  44. VARIABLE  ASPECT           10  ASPECT  !
  45. VARIABLE  OLDX
  46. VARIABLE  OLDY
  47. VARIABLE  NEWX
  48. VARIABLE  NEWY
  49.  
  50. VARIABLE  XSCALE
  51. 100  CONSTANT  YSCALE
  52.  
  53.  
  54. comment:
  55.  
  56. MODE   is used to set the screen mode.  2 is Text, 4 is Medium
  57.        Graphics, and 6 is High Graphics.
  58. COLOR   holds the present pencolor.
  59. ASPECT  holds the screen aspect factor for scrunch.
  60. OLDX    holds the old X position (as though you couldn't guess).
  61. OLDY    holds the old Y position.
  62. NEWX    holds the new X position.
  63. NEWY    holds the new Y position.
  64.  
  65. XSCALE  holds the screen resolution X-scale, depending on mode.
  66. YSCALE  is the constant for screen resolution for the Y-axis.
  67. comment;
  68.  
  69.    VOCABULARY GRAPH   GRAPH ALSO DEFINITIONS
  70.  
  71. VARIABLE  X1
  72. VARIABLE  X2
  73. VARIABLE  Y1
  74. VARIABLE  Y2
  75.  
  76. CREATE  LTBL    8  ALLOT
  77.  
  78. LABEL  (PIXEL)
  79.      3328 # AX MOV    16 INT    127 # AX AND     AX  AX OR
  80.      AX NOT           RET       END-CODE
  81.  
  82.  
  83. comment:
  84.  
  85. GRAPH  is a vocabulary that will hold most of the words which,
  86.        though useful in other words, are actually trivial.
  87. X1   holds the old X coordinate for the Assembly procedures.
  88. X2   holds the new X coordinate.
  89. Y1   holds the old Y coordinate.
  90. Y2   holds the new Y coordinate.
  91.  
  92. LTBL  holds a series of values used in the line procedure.
  93.  
  94. (PIXEL)  is a procedure which finds the color at a position
  95.          and returns FALSE if background and TRUE if a color
  96.          (1, 2, or 3).
  97. comment;
  98.  
  99. LABEL  (PSET)
  100.    BX PUSH  CX PUSH  DX PUSH  AX PUSH  SI PUSH  DI PUSH  BP PUSH
  101.    COLOR #) AX MOV            12 # AH MOV       16 INT
  102.    BP POP   DI POP   SI POP   AX POP   DX POP   CX POP   BX POP
  103.    RET  END-CODE
  104.  
  105. LABEL  STEEP
  106.    LTBL 2 + #) AX MOV        AX SHR           AX  LTBL 4 + #) MOV
  107.    X1 #) CX MOV          Y1 #) DX MOV         0 # BX MOV
  108.    LTBL 2 + #) AX MOV    AX  LTBL 6 + #) MOV  HERE
  109.    (PSET) #) CALL        SI  DX ADD           LTBL #) BX ADD
  110.    LTBL 4 + #) BX CMP    HERE 8 + JLE         LTBL 2 + #) BX SUB
  111.    DI  CX ADD            LTBL 6 + #) DEC      JGE     RET END-CODE
  112.  
  113. comment:
  114. (PSET)  is the procedure that actually plots a point in the
  115.         present COLOR.
  116.  
  117. STEEP  is the procedure that draws lines with slopes greater
  118.        than one.
  119. comment;
  120.  
  121.  
  122. LABEL  EASY
  123.      LTBL #) AX MOV          AX SHR              AX  LTBL 4 + #) MOV
  124.      X1 #) CX MOV        Y1 #) DX MOV        0 # BX MOV
  125.      LTBL #) AX MOV      AX  LTBL 6 + #) MOV HERE
  126.      (PSET) #) CALL      DI  CX ADD          LTBL 2 + #) BX ADD
  127.      LTBL 4 + #) BX CMP  HERE 8 +   JLE      LTBL #) BX SUB
  128.      SI  DX ADD          LTBL 6 + #) DEC     JGE     RET END-CODE
  129.  
  130. LABEL  CSTEEP     STEEP #) CALL   RET END-CODE
  131.  
  132. LABEL  STORE-X
  133.      AX  LTBL #) MOV     LTBL #) AX MOV     LTBL 2 + #) AX CMP
  134.      CSTEEP JL           EASY #) CALL       RET  END-CODE
  135.  
  136.  
  137.  
  138. comment:
  139.  
  140. EASY  is the procedure that draws lines with slopes less than
  141.       or equal to zero.
  142.  
  143. CSTEEP  is a short procedure that calls the STEEP procedure.
  144.  
  145. STORE-X  --  Guess.
  146.  
  147. comment;
  148.  
  149.  
  150. LABEL  STORE-Y
  151.      AX  LTBL 2 + #) MOV     X2 #) AX MOV      X1 #) AX SUB
  152.      1 # DI MOV              STORE-X JGE       -1 # DI MOV
  153.      AX NEG                  STORE-X #) JMP     END-CODE
  154.  
  155. LABEL  (LINE)
  156.   OLDX #) AX MOV    XSCALE #) AX ADD    AX X1 #) MOV
  157.   NEWX #) AX MOV    XSCALE #) AX ADD    AX X2 #) MOV
  158.   OLDY #) AX MOV    AX NEG          100 # AX ADD    AX  Y1 #) MOV
  159.   NEWY #) AX MOV    AX NEG          100 # AX ADD    AX  Y2 #) MOV
  160.   Y2 #) AX MOV      Y1 #) AX SUB    1 # SI MOV      STORE-Y JGE
  161.   -1 # SI MOV       AX NEG          STORE-Y #) JMP      END-CODE
  162.  
  163.  
  164.  
  165. comment:
  166.  
  167. STORE-Y  --  Guess again.
  168.  
  169. (LINE)  is the procedure that, first, modifys the coordinates
  170.       so that they are plotted with (0,0) at the center of the
  171.       screen.  Second, delta-Y is calculated and the
  172.       Y-increment is set.
  173.  
  174.  
  175. comment;
  176.  
  177.  
  178. FORTH DEFINITIONS
  179.  
  180. CODE  LINE   ( -- )
  181.      SI PUSH    BP PUSH    (LINE) #) CALL    BP POP    SI POP
  182.      NEXT       END-CODE
  183.  
  184. CODE  PIXEL     ( x y -- f )
  185.      (PIXEL) #) CALL    1PUSH     END-CODE
  186.  
  187. : SEGMENT   ( x y nx ny -- )
  188.      NEWY !  NEWX !  OLDY !  OLDX !  LINE  ;
  189.  
  190.  
  191. comment:
  192.  
  193. The following definitions are linked to the Forth Vocabulary.
  194.  
  195. LINE  is the Forth link to the line-drawing procedures.
  196.  
  197. \ LINE  is a slow line routine that takes scrunch into
  198.         account.  Define LINE above as ((LINE)) to use.
  199.  
  200. PIXEL  takes in a position and returns TRUE if the dot is
  201.        on or FALSE if the dot is off.
  202.  
  203. SEGMENT  takes an old position and a new position and draws
  204.          a line in the current COLOR.  Any old positions are
  205.          changed to the position given as the old position.
  206. comment;
  207.  
  208. \  (CLS) Clear a graphics screen, by Mark Smiley
  209.  
  210. forth assembler also GRAPH also definitions
  211.  
  212. HEX
  213.  
  214. LABEL    (CLSG)
  215.              CX   PUSH      AX   PUSH
  216.      2000 #  CX   MOV
  217.         0 #  AX   MOV
  218.        AX    DI   MOV
  219.       CLD
  220.       REP    STOSW
  221.              AX   POP       CX   POP
  222.              RET     END-CODE
  223.  
  224. DECIMAL
  225.  
  226.  
  227. comment:
  228.  
  229. Clears the screen without re-setting the system into graphics
  230.   mode (via MODE).  So it doesn't put the cursor back into the
  231.   upper left-hand corner.
  232.  save registers
  233.  
  234. set flag so REP decrements CX  (until CX=0)
  235. AX  STOS  is the same as STOSW in ordinary assembler (AX sets
  236.          STOS to work on "words" [cells] rather than on bytes).
  237. restore registers
  238.  
  239. comment;
  240.  
  241.  
  242. \ CLSG clears high or med res. graphics screen
  243.  
  244. FORTH  DEFINITIONS
  245. HEX
  246.  
  247.  CODE   CLSG
  248.       AX   PUSH
  249.         B800 #   AX   MOV
  250.           AX     ES   MOV       \  B800  ES  MOV    won't work
  251.         (CLSG) #)     CALL
  252.        AX   POP
  253.      NEXT             END-CODE
  254.  
  255. DECIMAL
  256.  
  257. only forth also definitions
  258.  
  259.