dsforth/ext_gfxhi.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; "high-level" graphics
   3 ;; mostly by Ketmar
   4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   5
   6 $FORTH_VAR (DRAWLINE-DX)  0
   7 $FORTH_VAR (DRAWLINE-DY)  0
   8 $FORTH_VAR (DRAWLINE-SX)  0
   9 $FORTH_VAR (DRAWLINE-SY)  0
  10
  11
  12 $FORTH_WORD DRAWLINE
  13 ;; k8
  14 ;; ( x0 y0 x1 y1 -- )
  15   ROT         ;;( x0 x1 y1 y0 )
  16   2DUP -      ;;( x0 x1 y1 y0 dy )
  17   DUP ISGN (DRAWLINE-SY) !
  18   ABS (DRAWLINE-DY) !  ;;( x0 x1 y1 y0 )
  19   >R DROP      ;;( x0 x1 | y0 )
  20   SWAP DUP >R  ;;( x1 x0 | y0 x0 )
  21   -
  22   DUP ISGN (DRAWLINE-SX) !
  23   ABS (DRAWLINE-DX) !  ;;( -- | y0 x0 )
  24   R> R> 0  ;;( x0 y0 err )
  25
  26   (DRAWLINE-DX) @  (DRAWLINE-DY) @  MAX 1+
  27   0 (DO)
  28 drawline_loop:
  29     ;;( x y err )
  30     >R 2DUP PLOT  ;;( x y | err )
  31     R@ DUP (DRAWLINE-DX) @ NEGATE > 0BRANCH drawline_l0
  32       (DRAWLINE-DY) @ -  ;;( x y err | olderr )
  33       ROT (DRAWLINE-SX) @ + NROT
  34 drawline_l0:
  35     ;;( x y err | olderr )
  36     R> (DRAWLINE-DY) @ < 0BRANCH drawline_l1
  37       (DRAWLINE-DX) @ +
  38       SWAP (DRAWLINE-SY) @ + SWAP
  39 drawline_l1:
  40   (LOOP) drawline_loop
  41   2DROP DROP
  42   ;S
  43 $FORTH_END_WORD DRAWLINE
  44
  45
  46 $FORTH_WORD (CIRCLE-PLOT4D)
  47 ;; k8
  48 ;; ( cx cy x y -- )
  49   ROT +   ;;( cx x sy )
  50   NROT +  ;;( sy sx )
  51   SWAP PLOT
  52   ;S
  53 $FORTH_END_WORD (CIRCLE-PLOT4D)
  54
  55 $FORTH_WORD (CIRCLE-PLOT4)
  56 ;; k8
  57 ;; ( cx cy x y -- )
  58   2OVER 2OVER (CIRCLE-PLOT4D)
  59   OVER 0BRANCH cicle_plot4_skipx
  60     2OVER 2OVER  SWAP NEGATE SWAP  (CIRCLE-PLOT4D)
  61 cicle_plot4_skipx:
  62   DUP 0BRANCH cicle_plot4_skipy
  63     2OVER 2OVER  NEGATE  (CIRCLE-PLOT4D)
  64 cicle_plot4_skipy:
  65   NEGATE SWAP NEGATE SWAP  (CIRCLE-PLOT4D)
  66   ;S
  67 $FORTH_END_WORD (CIRCLE-PLOT4)
  68
  69 $FORTH_WORD (CIRCLE-PLOT8)
  70 ;; k8
  71 ;; ( cx cy x y -- )
  72   2OVER 2OVER (CIRCLE-PLOT4)
  73   SWAP (CIRCLE-PLOT4)
  74   ;S
  75 $FORTH_END_WORD (CIRCLE-PLOT8)
  76
  77
  78 $FORTH_WORD DRAWCIRCLE
  79 ;; k8
  80 ;; ( cx cy radius -- )
  81   DUP 1 < 0BRANCH circle_good_radius
  82     DROP 2DROP ;S
  83 circle_good_radius:
  84   DUP NEGATE >R  ;;( cx cy radius | error )
  85   0              ;;( cx cy x y | error )
  86 circle_loop:
  87     2DUP >  ;;( while x > y )
  88   0BRANCH circle_done
  89     2OVER 2OVER (CIRCLE-PLOT8)
  90     ;;( error += y*2+1 )
  91     DUP 2U* 1+ R> + >R
  92     ;;( y += 1 )
  93     1+
  94     ;;( if error >= 0 then --x; error -= x*2; end )
  95     R@ 0< TBRANCH circle_loop  ;;cicle_error_ok
  96       SWAP 1- SWAP  OVER 2U* R> SWAP - >R
  97 cicle_error_ok:
  98   BRANCH circle_loop
  99 circle_done:
 100   ;; last 4 points
 101   (CIRCLE-PLOT4)
 102   RDROP
 103   ;S
 104 $FORTH_END_WORD DRAWCIRCLE