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