home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / graph.seq < prev    next >
Text File  |  1990-07-25  |  8KB  |  231 lines
  1. \\ LINE-DRAWING ALGORITHM  by  JOHNNY GRAVES     modified by Tom Zimmer
  2.  
  3.  
  4.     Simple graphics support.
  5.  
  6.     This algorithm, LINE, is written in high-level FORTH, and thus is
  7.     slower relatively slow. It has the advantage, however, that it
  8.     works properly in the EGA, VGA640, and VEGA modes.
  9.  
  10.     Issue GRAPH-INIT before trying to use PLOT or POINT. Then select a
  11.     graphics mode from the list (for example 320x200x16). After this is
  12.     done, you can set the COLOR of plotting, and start plotting points.
  13.  
  14.     For hercules graphics, execute GRAPH-INIT, then HERCULES to enter
  15.     graphics mode. Set COLOR to 1 and start plotting.
  16.  
  17.     The VALUE's HDOTS, VDOTS and #COLORS are initialize for the maximum
  18.     horizontal resolution, vertical resolution and colors of the graphics
  19.     mode selected.
  20.  
  21.     Requires HERC.SEG.
  22.  
  23. {
  24.  
  25.  
  26. FORTH DECIMAL
  27.  
  28.  
  29. CODE VIDEO ( DX CX BX AX -- DX AX )     \ perform a VIDEO interrupt call.
  30.                 POP AX  POP BX  POP CX  POP DX
  31.                 PUSH SI         PUSH BP
  32.                 INT $10
  33.                 POP BP          POP SI
  34.                 2push           END-CODE
  35.  
  36.  
  37. : VMODE!        ( n1 -- )               \ use to set video modes. n1 is the
  38.                                         \ desired mode number. For example
  39.                                         \ 6 VMODE! will select 640x200
  40.                                         \ black & white graphics.
  41.                 >R 0 0 0 R> VIDEO 2DROP ;
  42.  
  43.  
  44. 0 VALUE VMODE-SAVE
  45.  
  46.  
  47. DEFER PLOT      ( col row -- ) \ Plot point at pixel 'col row'.
  48. DEFER POINT     ( col row -- color ) \ Get pixel color at 'col row'.
  49. DEFER TEXT-MODE ( -- ) \ return to text mode.
  50.  
  51.  
  52. : CTEXT         ( -- )
  53.                 VMODE-SAVE VMODE! ;
  54.  
  55.  
  56. CODE CGA.PALETTE ( bh bl -- ) \ bh=palette #, bl=background color
  57.                 POP BX
  58.                 POP AX
  59.                 MOV BH, AL
  60.                 MOV AH, # $0B
  61.                 PUSH BP     PUSH SI
  62.                 INT $10
  63.                 POP SI      POP BP
  64.                 NEXT        END-CODE
  65.  
  66.  
  67. CODE CPLOT      ( col row -- )
  68.                 POP DX
  69.                 POP CX
  70.                 MOV AL, COLOR
  71.                 MOV AH, # $0C
  72.                 SUB BX, BX
  73.                 PUSH BP         MOV DI, SI
  74.                 INT $10
  75.                 MOV SI, DI      POP BP
  76.                 NEXT            END-CODE
  77.  
  78.  
  79. : CPOINT    ( col row -- color )    \ get the color of a point on CGA
  80.                                     \ graphics screen.
  81.             SWAP 0 $0D00 VIDEO NIP ;
  82.  
  83.  
  84. : GRAPH-INIT  ( -- F1 ) \ init graphics plot word returns TRUE if COLOR
  85.                         \ and  FALSE if HERCULES
  86.             ?VMODE DUP =: VMODE-SAVE 7 = DUP
  87.             IF      ['] HPLOT IS PLOT       ['] HPOINT IS POINT
  88.                     ['] HTEXT IS TEXT-MODE
  89.             ELSE    ['] CPLOT IS PLOT       ['] CPOINT IS POINT
  90.                     ['] CTEXT IS TEXT-MODE
  91.             THEN    0= ;
  92.  
  93. : CMODE!    ( mode horiz vert colors seg len -- )
  94.             =: VID.SIZE  =: VID.SEG
  95.             =: #COLORS =: VDOTS =: HDOTS VMODE!  ;
  96.  
  97.  
  98. \ Graph mode           Mode Hor Ver Clrs Seg   Size
  99.   : 320x200x4   ( -- )  $04 320 200   4 $B800 $4000 CMODE! ;  \ CGA
  100.   : 320x200x4M  ( -- )  $05 320 200   4 $B800 $4000 CMODE! ;  \ CGA COMPOSITE
  101.   : 640x200x2   ( -- )  $06 640 200   2 $B800 $4000 CMODE! ;  \ CGA
  102.   : 320x200x16  ( -- )  $0D 320 200  16 $A000 $9600 CMODE! ;  \ EGA,VGA
  103.   : 640x200x16  ( -- )  $0E 640 200  16 $A000 $9600 CMODE! ;  \ EGA,VGA
  104.   : 640x350x2   ( -- )  $0F 640 350   2 $A000 $9600 CMODE! ;  \ EGA,VGA MONO
  105.   : 640x350x16  ( -- )  $10 640 350  16 $A000 $9600 CMODE! ;  \ EGA,VGA
  106.   : 640x480x2   ( -- )  $11 640 480   2 $A000 $9600 CMODE! ;  \ EGA,VGA
  107.   : 640x480x16  ( -- )  $12 640 480  16 $A000 $9600 CMODE! ;  \ VGA
  108.   : 320x200x256 ( -- )  $13 320 200 256 $A000 $FA00 CMODE! ;  \ VGA
  109.   : 800x600x16  ( -- )  $16 800 600  16 $A000 $FA00 CMODE! ;  \ VEGA
  110.  
  111.  
  112. \ Line drawing, high level
  113.  
  114.  
  115. VARIABLE X1     VARIABLE X2
  116. VARIABLE Y1     VARIABLE Y2
  117. VARIABLE ERR
  118. VARIABLE DELX   VARIABLE DELY
  119. VARIABLE HALFX  VARIABLE HALFY
  120. VARIABLE CHEC
  121.  
  122. : LINEINIT      ( -- )
  123.         X1 @  X2 @ - ABS DUP DELX !  2/
  124.         HALFX !  Y1 @ Y2 @ - ABS DUP DELY ! 2/ HALFY !   0 ERR !
  125.         DELY @ DELX @ > CHEC ! ;
  126.  
  127. : X1=X2 (  -- f )    X1 @ X2 @ = ;
  128. : Y1=Y2 (  -- f )    Y1 @ Y2 @ = ;
  129.  
  130. ( LINE ALGORITHM )
  131.  
  132. : DO-1  X1 @ Y1 @ PLOT X1 INCR DELY @ ERR +!
  133.         HALFX @ ERR @ < IF DELX @ NEGATE ERR +! Y1 INCR THEN ;
  134.  
  135. : DO-2  X1 @ Y1 @ PLOT X1 INCR DELY @ ERR +!
  136.         HALFX @ ERR @ < IF DELX @ NEGATE ERR +! Y1 DECR THEN ;
  137.  
  138. : DO-3  X1 @ Y1 @ PLOT X1 DECR DELY @ ERR +!
  139.         HALFX @ ERR @ < IF DELX @ NEGATE ERR +! Y1 INCR THEN ;
  140.  
  141. : DO-4  X1 @ Y1 @ PLOT X1 DECR DELY @ ERR +!
  142.         HALFX @ ERR @ < IF DELX @ NEGATE ERR +! Y1 DECR THEN ;
  143.  
  144. : DO-1' X1 @ Y1 @ PLOT Y1 INCR DELX @ ERR +!
  145.         HALFY @ ERR @ < IF DELY @ NEGATE ERR +! X1 INCR THEN ;
  146.  
  147. : DO-2' X1 @ Y1 @ PLOT Y1 DECR DELX @ ERR +!
  148.         HALFY @ ERR @ < IF DELY @ NEGATE ERR +! X1 INCR THEN ;
  149.  
  150. : DO-3' X1 @ Y1 @ PLOT Y1 INCR DELX @ ERR +!
  151.         HALFY @ ERR @ < IF DELY @ NEGATE ERR +! X1 DECR THEN ;
  152.  
  153. : DO-4' X1 @ Y1 @ PLOT Y1 DECR DELX @ ERR +!
  154.         HALFY @ ERR @ < IF DELY @ NEGATE ERR +! X1 DECR THEN ;
  155.  
  156. : 1/1'   CHEC @ IF      BEGIN DO-1' Y1=Y2 UNTIL
  157.                 ELSE    BEGIN DO-1  X1=X2 UNTIL  THEN ;
  158.  
  159. : 2/2'   CHEC @ IF      BEGIN DO-2' Y1=Y2 UNTIL
  160.                 ELSE    BEGIN DO-2  X1=X2 UNTIL  THEN ;
  161.  
  162. : 3/3'   CHEC @ IF      BEGIN DO-3' Y1=Y2 UNTIL
  163.                 ELSE    BEGIN DO-3  X1=X2 UNTIL  THEN ;
  164.  
  165. : 4/4'   CHEC @ IF      BEGIN DO-4' Y1=Y2 UNTIL
  166.                 ELSE    BEGIN DO-4  X1=X2 UNTIL  THEN ;
  167.  
  168.  
  169. : 2S-OR-3S      X1 @ X2 @ < IF  2/2'  ELSE  3/3'  THEN ;
  170. : 1S-OR-4S      X1 @ X2 @ < IF  1/1'  ELSE  4/4'  THEN ;
  171.  
  172. : LINE?         X1 @ X2 @ <  Y1 @ Y2 @ <  XOR
  173.                 IF      2S-OR-3S
  174.                 ELSE    1S-OR-4S  THEN ;
  175.  
  176.  
  177. : DO-I  BEGIN X1 @ Y1 @ PLOT X1 INCR X1=X2 UNTIL ;
  178. : DO-II BEGIN X1 @ Y1 @ PLOT X1 DECR X1=X2 UNTIL ;
  179. : DO-J  BEGIN X1 @ Y1 @ PLOT Y1 INCR Y1=Y2 UNTIL ;
  180. : DO-JJ BEGIN X1 @ Y1 @ PLOT Y1 DECR Y1=Y2 UNTIL ;
  181.  
  182. : IORII?   X1 @ X2 @ < IF DO-I ELSE DO-II THEN ;
  183. : JORJJ?   Y1 @ Y2 @ < IF DO-J ELSE DO-JJ THEN ;
  184.  
  185. : HOR-OR-VER?   X1 @ X2 @ = IF JORJJ? ELSE IORII? THEN ;
  186.  
  187. : LINETO        ( x y -- )              \ draw a line to x,y from previous
  188.                                         \ LINETO, LINE or LINEFROM.
  189.                 Y2 ! X2 ! LINEINIT
  190.                 X1 @ X2 @ = Y1 @ Y2 @ = XOR
  191.                 IF  HOR-OR-VER?  ELSE  LINE?  THEN
  192.                 X1 @ Y1 @ PLOT ;
  193.  
  194. : LINEFROM      ( x y -- )              \ set origin of next LINETO.
  195.                 Y1 ! X1 ! ;
  196.  
  197. : LINE          ( X1 Y1 X2 Y2 -- )
  198.                 2SWAP LINEFROM LINETO ;
  199.  
  200. \ LINE ALGORITHM                                      23Jun88mds
  201.  
  202. comment:
  203.  
  204.         LINE ALGORITHM   USER'S GUIDE
  205. key in the endpoints of the segment you wish to draw followed by the
  206. command : LINE.
  207.  
  208.         example : entering, 1 2 3 4 LINE,
  209.  
  210. a segment with endpoints [1,2] and [3,4] {unscaled} will be drawn. if
  211. you wish to continue drawing from [3,4], simply key in the next
  212. endpoint followed by the command, LINETO.
  213.  
  214.         example : to draw two segments from [1,2] to [3,4] to [7,8],
  215.                 key in ; 1 2 3 4 LINE, followed by; 7 8 LINETO.
  216.  
  217. The primed ['] procedures draw non-horizontal, non-vertical segments
  218. whose slopes are greater than one, and the corresponding unprimed
  219. procedures draw non-horizontal, non-vertical lines whose slopes are
  220. less than one. the "i" and "j" procedures take care of horizontal and
  221. vertical lines, respectively. The commands: 1/1', 2/2', 3/3', 4/4',
  222. 2s-or-3s, 1s-or-4s, line?, iorii?, jorjj?, hor-or-ver? simply
  223. determine which algorithm is to be used. Finally, unless otherwise
  224. noted in the body of the program, commands in the program neither
  225. expect or leave anything on the stack.
  226.  
  227. comment;
  228.  
  229.  
  230.  
  231.