Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #135646 > unrolled thread

General routine for a polyline or a polygon

Back to article view | Back to comp.lang.forth

Contents

  General routine for a polyline or a polygon Hans Bezemer <the.beez.speaks@gmail.com> - 2026-09-10 12:46 +0200
    Re: General routine for a polyline or a polygon dxf <dxforth@gmail.com> - 2026-09-10 23:33 +1000
      Re: General routine for a polyline or a polygon Hans Bezemer <the.beez.speaks@gmail.com> - 2026-09-10 19:22 +0200
        Re: General routine for a polyline or a polygon Hans Bezemer <the.beez.speaks@gmail.com> - 2026-09-11 13:30 +0200
          Re: General routine for a polyline or a polygon dxf <dxforth@gmail.com> - 2026-09-12 01:04 +1000
            Re: General routine for a polyline or a polygon dxf <dxforth@gmail.com> - 2026-09-12 02:34 +1000
              Re: General routine for a polyline or a polygon Hans Bezemer <the.beez.speaks@gmail.com> - 2026-09-11 19:22 +0200

#135646 — General routine for a polyline or a polygon

Can be used with any LINE command, as long as it draws a line between 
two absolute coordinates. ( x1 y1 x2 y2 --):

: line cr rot >r -rot r> rot 0 .r ." ," . 0 .r ." ," . ;   \ dummy line word

variable 'lineto                                           \ stores 
address of (lineto)

[: drop drop drop drop ;]         constant (cancel)        ( x1 y1 x2 y2 --)
[: 2dup 2>r line 2r> 'lineto @ ;] constant (lineto)        ( x1 y1 x2 y2 
-- x2 y2 xt)
[: 2dup (lineto) ;]               constant (moveto)        ( x y -- x y 
x y xt)
: polygon[ ['] line (moveto) ;                             ( -- xt1 xt2)
: polyline[ (cancel) (moveto) ;                            ( -- xt1 xt2)
: +point rot execute ;                                     ( x1 y1 xt x2 
y2 -- x2 y2 xt)
: ]poly drop 2>r rot 2r> +point ;                          ( xt1 x1 y1 
x2 y2 xt2 --)

(lineto) 'lineto !

This is a sample application:

polygon[                               \ start a polygon
    75 300 +point                       \ now issue all the points
   161 329 +point
   161 419 +point
   215 347 +point
   301 373 +point
   250 300 +point
   301 227 +point
   215 253 +point
   161 181 +point
   161 271 +point
]poly                                  \ close the polygon

All the points should be listed now (filtered output):

75,300 161,329  ok 6
161,329 161,419  ok 6
161,419 215,347  ok 6
215,347 301,373  ok 6
301,373 250,300  ok 6
250,300 301,227  ok 6
301,227 215,253  ok 6
215,253 161,181  ok 6
161,181 161,271  ok 6
75,300 161,271  ok

Hans Bezemer

[toc] | [next] | [standalone]

#135647

On 10/09/2026 8:46 pm, Hans Bezemer wrote:
> Can be used with any LINE command, as long as it draws a line between two absolute coordinates. ( x1 y1 x2 y2 --):

That was a 'star' effort!  Never had the patience for graphics myself to it's good
to see someone else do it.

1 fload xplgraph

6 value color

: line ( x1 y1 x2 y2 --)  2swap moveto color line ;  \ simulate using XPL graphics

\ General routine for a polyline or a polygon.  H. Bezemer
\
\ Can be used with any LINE command, as long as it draws a line between
\ two absolute coordinates. ( x1 y1 x2 y2 --):

\ : line cr rot >r -rot r> rot 0 .r ." ," . 0 .r ." ," . ; \ dummy line word

variable 'lineto \ stores address of (lineto)

:noname drop drop drop drop ; constant (cancel) ( x1 y1 x2 y2 --)
:noname 2dup 2>r line 2r> 'lineto @ ; constant (lineto) ( x1 y1 x2 y2 -- x2 y2 xt)
:noname 2dup (lineto) ; constant (moveto) ( x y -- x y x y xt)
: polygon[ ['] line (moveto) ; ( -- xt1 xt2)
: polyline[ (cancel) (moveto) ; ( -- xt1 xt2)
: +point rot execute ; ( x1 y1 xt x2 y2 -- x2 y2 xt)
: ]poly drop 2>r rot 2r> +point ; ( xt1 x1 y1 x2 y2 xt2 --)

(lineto) 'lineto !

$12 SetVid \ 640x480x16

polygon[ \ start a polygon
75 300 +point \ now issue all the points
161 329 +point
161 419 +point
215 347 +point
301 373 +point
250 300 +point
301 227 +point
215 253 +point
161 181 +point
161 271 +point
]poly \ close the polygon

key drop \ admire

$03 SetVid \ text mode

[toc] | [prev] | [next] | [standalone]

#135650

Ed, I only say this:

variable (color)

: set_pixel (color) @ ;

And I'll think you'll have circles, ellipses, arcs and bezier curves in 
no time flat ;-)

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#135659

On 10-09-2026 19:22, Hans Bezemer wrote:
In my enthusiasm I had completely overlooked that 4tH is 32/64-bit and 
DX-Forth is 16-bit. I tried arc-circles, bezier curves -- I never even 
tried ellipses, because these require double words in 32-bit 4tH to 
begin with, so -- no chance of winning.

But! At least you now got circles as well ;-) (Yeah, I tried!)

Hans Bezemer

---8<---
: circle                               ( x y radius --)
   swap >r swap >r 1 over - swap 0      ( dp x y R: x0 y0)

   begin
     over r@ + over r> r@ swap >r +                color point ( x0 + x, 
y0 + y)
     over r@ swap - over r> r@ swap >r +           color point ( x0 - x, 
y0 + y)
     over r@ + over r> r@ swap >r swap -           color point ( x0 + x, 
y0 - y)
     over r@ swap - over r> r@ swap >r swap -      color point ( x0 - x, 
y0 - y)
     over r> r@ swap >r + over r@ +           swap color point ( x0 + y, 
y0 + x)
     over r> r@ swap >r + over r@ swap -      swap color point ( x0 - y, 
y0 + x)
     over r> r@ swap >r swap - over r@ +      swap color point ( x0 + y, 
y0 - x)
     over r> r@ swap >r swap - over r@ swap - swap color point ( x0 - y, 
y0 - x)
                                        ( dp x y R: x0 y0)
     1+ >r over 0> if 1- r@ over - else r@ then 2* 1+ rot + swap r>
     over over <                        ( dp x y f R: x0 y0)
   until drop drop drop r> drop r> drop
;
---8<---

[toc] | [prev] | [next] | [standalone]

#135662

On 11/09/2026 9:30 pm, Hans Bezemer wrote:
> On 10-09-2026 19:22, Hans Bezemer wrote:
> In my enthusiasm I had completely overlooked that 4tH is 32/64-bit and DX-Forth is 16-bit. I tried arc-circles, bezier curves -- I never even tried ellipses, because these require double words in 32-bit 4tH to begin with, so -- no chance of winning.
> 
> But! At least you now got circles as well ;-) (Yeah, I tried!)

  1 fload xplgraph

  $12 SetVid  \ 640x480x16

  6 value color

  xmax 2/ ymax 2/ 100 circle

  key drop

  $03 SetVid

Too easy ;)

Circle only took 6 mS to draw under DOSBOX.  Tried it with BGI graphics
and it was 8 mS.  The BGI is all machine code so if it were going to be
better, I'd expect to see that reflected.

[toc] | [prev] | [next] | [standalone]

#135665

On 12/09/2026 1:04 am, dxf wrote:
> On 11/09/2026 9:30 pm, Hans Bezemer wrote:
>> On 10-09-2026 19:22, Hans Bezemer wrote:
>> In my enthusiasm I had completely overlooked that 4tH is 32/64-bit and DX-Forth is 16-bit. I tried arc-circles, bezier curves -- I never even tried ellipses, because these require double words in 32-bit 4tH to begin with, so -- no chance of winning.
>>
>> But! At least you now got circles as well ;-) (Yeah, I tried!)
> 
>   1 fload xplgraph
> 
>   $12 SetVid  \ 640x480x16
> 
>   6 value color
> 
>   xmax 2/ ymax 2/ 100 circle
> 
>   key drop
> 
>   $03 SetVid
> 
> Too easy ;)
> 
> Circle only took 6 mS to draw under DOSBOX.  Tried it with BGI graphics
> and it was 8 mS.  The BGI is all machine code so if it were going to be
> better, I'd expect to see that reflected.

The bottleneck was the Borland EGAVGA BGI driver.  Substituting a third-party
SVGA BGI driver, the time dropped to 1 mS.  IIRC things like Circle weren't
typically handled in the driver but emulated in the graphics library.  In the
case of the SVGA BGI circle was handled internally and plainly faster.  Even
so, the performance of forth-based Circle is still very respectable.

[toc] | [prev] | [next] | [standalone]

#135667

On 11-09-2026 18:34, dxf wrote:
>> Circle only took 6 mS to draw under DOSBOX.  Tried it with BGI graphics
>> and it was 8 mS.  The BGI is all machine code so if it were going to be
>> better, I'd expect to see that reflected.
> 
> The bottleneck was the Borland EGAVGA BGI driver.  Substituting a third-party
> SVGA BGI driver, the time dropped to 1 mS.  IIRC things like Circle weren't
> typically handled in the driver but emulated in the graphics library.  In the
> case of the SVGA BGI circle was handled internally and plainly faster.  Even
> so, the performance of forth-based Circle is still very respectable.

I used the Midpoint Circle Algorithm. It's FAST! Instead of using 
expensive floating-point arithmetic or trigonometric functions, it 
relies entirely on fast integer addition and subtraction to calculate 
pixel coordinates.

I've seen the performance of a z80 assembly version on a ZX Spectrum, 
compared to the ROM routine. It takes a minute to run the ROM version -- 
and a second(!) or so for the MCA. So yes, I do have an expensive taste 
when it comes to graphical algorithms! ;-)

Have fun!

Hans Bezemer

https://www.youtube.com/watch?v=sdccAInujFU
Second half is the MCA.

Z80 snapshot: https://github.com/ibancg/zxcircle/blob/master/zxcircle.z80

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.forth

csiph-web