IGNORED

# Math fun

## Recommended Posts

Algorithm to draw a circle What else have you got?

• 4
##### Share on other sites

• 3
##### Share on other sites

Can I play?  You could use 30 sprites at 12 degree spacing... ```\ CIRClE of sprites   Aug 2023  Brian Fox

\ NEEDS DUMP   FROM DSK1.TOOLS
NEEDS SIN    FROM DSK1.TRIG
NEEDS SPRITE FROM DSK1.DIRSPRIT

DECIMAL
14 CONSTANT magenta     15 CONSTANT gray
92 CONSTANT Xbias      122 CONSTANT Ybias     130 CONSTANT Scale
128 CONSTANT BALL

S" 3C7EFFFFFFFF7E3C" BALL CALLCHAR

: SIN() ( n -- x) 12 * SIN  Scale / Xbias + ;
: COS() ( n -- y) 12 * COS  Scale / Ybias + ;
: CIRCLE  30 0 DO   BALL magenta  I COS()  I SIN()  I SPRITE   LOOP ;

: RUN   PAGE CIRCLE  KEY DROP  DELALL  ;
```

• 6
##### Share on other sites

• 3
• 1
##### Share on other sites

... and now a weird one ... based on the distance from the center

```call clear
R=10
D=5
PX = 15
PY = 12
R2 = R * R

for y=1 to 24
for x=1 to 32
if abs((Px-X)*(Px-X)+(Py-Y)*(Py-Y)-R2)<D then c=42 else c=32
call hchar(y,x,c)
next x
next y

call waitkey```

When you change to "120 D=32" you get:

• 4
• 1
##### Share on other sites

3 hours ago, Reciprocating Bill said:

Ooooh! Very cool! Source code please?

• 3
##### Share on other sites

5 hours ago, SteveB said:

Interesting way of doing this. Is it faster than my version?

• 2
##### Share on other sites

1 hour ago, SteveB said:

... and now a weird one ... based on the distance from the center

```call clear
R=10
D=5
PX = 15
PY = 12
R2 = R * R

for y=1 to 24
for x=1 to 32
if abs((Px-X)*(Px-X)+(Py-Y)*(Py-Y)-R2)<D then c=42 else c=32
call hchar(y,x,c)
next x
next y

call waitkey```

When you change to "120 D=32" you get:

I'm having a little trouble understanding that one.

##### Share on other sites

4 hours ago, TheBF said:

Can I play?  You could use 30 sprites at 12 degree spacing... ```\ CIRClE of sprites   Aug 2023  Brian Fox

\ NEEDS DUMP   FROM DSK1.TOOLS
NEEDS SIN    FROM DSK1.TRIG
NEEDS SPRITE FROM DSK1.DIRSPRIT

DECIMAL
14 CONSTANT magenta     15 CONSTANT gray
92 CONSTANT Xbias      122 CONSTANT Ybias     130 CONSTANT Scale
128 CONSTANT BALL

S" 3C7EFFFFFFFF7E3C" BALL CALLCHAR

: SIN() ( n -- x) 12 * SIN  Scale / Xbias + ;
: COS() ( n -- y) 12 * COS  Scale / Ybias + ;
: CIRCLE  30 0 DO   BALL magenta  I COS()  I SIN()  I SPRITE   LOOP ;

: RUN   PAGE CIRCLE  KEY DROP  DELALL  ;
```

After reading the first post and seeing that we only ever had 2x "*'s" on the same line, sprites is exactly what came to mind. But you did it in Forth instead of XB.

How about something else now?: examples of programs to display the golden mean.

##### Share on other sites

• 3
• 2
##### Share on other sites

Alternatively you could paste your block file in a post here and we could get at it that way.

(I have wanted to see this code since the first day you posted it back when) Oops:  It's on real iron so that might be tricky.

• 1
##### Share on other sites

39 minutes ago, jrhodes said:

After reading the first post and seeing that we only ever had 2x "*'s" on the same line, sprites is exactly what came to mind. But you did it in Forth instead of XB.

How about something else now?: examples of programs to display the golden mean.

Whenever I said "Great minds think alike"  to my mother she would say "Or fools seldom differ".  We can choose whatever fits. Never did a Golden mean program. Now I have to go read stuff. • 2
• 1
##### Share on other sites

```100 f=33::n=f::call clear
110 x=cos(i)*80+90::y=sin(i)*80+90::gosub 120::i=i+0.05::goto 110
120 c=int(x/8)::l=int(y/8)::call gchar(l+1,c+1,g)::if g>=f then 140
130 g=n::n=n+1::call char(g,"")::call hchar(l+1,c+1,g)
140 call charpat(g,p\$)::cx=int(x)-8*c::cy=int(y)-8*l::p=int(cx/4)+cy*2::h=cx-int(cx/4)*4
150 p\$=seg\$(p\$,1,p)&seg\$("8421",h+1,1)&seg\$(p\$,p+2,15)::call char(g,p\$)::return
run
```

• 8
##### Share on other sites

19 hours ago, Vorticon said:

I'm having a little trouble understanding that one.

I am testing the distance of each "pixel" from the center of the circle P(Px,Py).

The distance would actually be R = sqr((Px-X)^2+(Py-Y)^2) . If this value is the radius R, I would draw the asterisk.

The square root is an expensive operation I actually don't need, I just square the equation:

R^2 = (Px-X)^2 + (Py-Y)^2

Since the circle hardly hit exactly on the top left edge of character, I introduce a "tolerance" Delta 😧

abs( (Px-X)^2+(Py-Y)^2) - R^2 ) < D

`abs((Px-X)*(Px-X)+(Py-Y)*(Py-Y)-R2)<D`

I hope this is comprehensible, I never had to explain mathematics in english, so please apologize if translated a mathematics term incorrectly to english.

Steve

• 2
##### Share on other sites

12 hours ago, sometimes99er said:
```100 f=33::n=f::call clear
110 x=cos(i)*80+90::y=sin(i)*80+90::gosub 120::i=i+0.05::goto 110
120 c=int(x/8)::l=int(y/8)::call gchar(l+1,c+1,g)::if g>=f then 140
130 g=n::n=n+1::call char(g,"")::call hchar(l+1,c+1,g)
140 call charpat(g,p\$)::cx=int(x)-8*c::cy=int(y)-8*l::p=int(cx/4)+cy*2::h=cx-int(cx/4)*4
150 p\$=seg\$(p\$,1,p)&seg\$("8421",h+1,1)&seg\$(p\$,p+2,15)::call char(g,p\$)::return
run
```

That kind blows my mind. Well done.

• 3
##### Share on other sites

I forgot that I have a new Graphics2 mode library so I had to give that a go.

It's not really fast but it plots.

```\ Circle in bitmap mode for Camel99 Forth

NEEDS DUMP   FROM DSK1.TOOLS
NEEDS VALUE  FROM DSK1.VALUES
NEEDS MARKER FROM DSK1.MARKER
NEEDS PLOT   FROM DSK1.GRAPHICS2
NEEDS SIN    FROM DSK1.TRIG

DECIMAL
96 VALUE Xbias
127 VALUE Ybias
130 VALUE Scale

0 VALUE  XCNTR
0 VALUE  YCNTR

: ENUM  ( 0 <text> -- n) DUP CONSTANT  1+ ;

0 ( set 1st color)
ENUM TRANS    ENUM BLACK    ENUM GREEN    ENUM LIME
ENUM BLUE     ENUM SKY      ENUM RED      ENUM CYAN
ENUM RUST     ENUM ORANGE   ENUM YELLOW   ENUM LEMON
ENUM OLIVE    ENUM MAGENTA  ENUM GRAY     ENUM WHITE
DROP

: PAINT ( color )  4 LSHIFT  INK ! ;

: SIN() ( n -- x) SIN  Scale / Ybias +  ;
: COS() ( n -- y) COS  Scale / Xbias +  ;

: DIAMETER ( n -- n') 20000 SWAP /  TO Scale  ;
: CENTER  ( 0 0 -- ) 2/ TO YCNTR   2/ TO XCNTR ;

: CIRCLE  ( x y diameter -- )
DIAMETER   CENTER
360 0 DO  I SIN() XCNTR +  I COS() YCNTR +  PLOT  LOOP  ;

DECIMAL
: RUN
GRAPHICS2
RED PAINT     -70  0  10 CIRCLE
MAGENTA PAINT -60  0  40 CIRCLE
LIME PAINT    -50  0  80 CIRCLE
YELLOW PAINT   30  0 190 CIRCLE

BEGIN KEY? UNTIL
TEXT
;
```

• 6
##### Share on other sites

Now I got tempted to try this in Pascal. Turtlegraphics is convenient for a circle, since you can repeat the sequence draw a line X long then turn 360/Y degrees and repeat that Y times, and then you have a circle.

• 2
##### Share on other sites

19 hours ago, SteveB said:

I am testing the distance of each "pixel" from the center of the circle P(Px,Py).

The distance would actually be R = sqr((Px-X)^2+(Py-Y)^2) . If this value is the radius R, I would draw the asterisk.

The square root is an expensive operation I actually don't need, I just square the equation:

R^2 = (Px-X)^2 + (Py-Y)^2

Since the circle hardly hit exactly on the top left edge of character, I introduce a "tolerance" Delta 😧

abs( (Px-X)^2+(Py-Y)^2) - R^2 ) < D

`abs((Px-X)*(Px-X)+(Py-Y)*(Py-Y)-R2)<D`

I hope this is comprehensible, I never had to explain mathematics in english, so please apologize if translated a mathematics term incorrectly to english.

Steve

Ah ha! Very nice!

• 1
##### Share on other sites

On 8/9/2023 at 3:46 AM, sometimes99er said:
```100 f=33::n=f::call clear
110 x=cos(i)*80+90::y=sin(i)*80+90::gosub 120::i=i+0.05::goto 110
120 c=int(x/8)::l=int(y/8)::call gchar(l+1,c+1,g)::if g>=f then 140
130 g=n::n=n+1::call char(g,"")::call hchar(l+1,c+1,g)
140 call charpat(g,p\$)::cx=int(x)-8*c::cy=int(y)-8*l::p=int(cx/4)+cy*2::h=cx-int(cx/4)*4
150 p\$=seg\$(p\$,1,p)&seg\$("8421",h+1,1)&seg\$(p\$,p+2,15)::call char(g,p\$)::return
run
```

What devious mind came up with this algorithm???? It took me almost an hour to understand how it works while tracing it on paper. Outstanding!

I had done pseudo hires with character redefinition in the past (archimede's hat), but nothing as elegant as this...

• 4
##### Share on other sites

38 minutes ago, Vorticon said:

What devious mind came up with this algorithm???? It took me almost an hour to understand how it works while tracing it on paper. Outstanding!

I had done pseudo hires with character redefinition in the past (archimede's hat), but nothing as elegant as this...

I got more ideas, but only played around for fun ... someday ... 😉

• 1
##### Share on other sites

CALL POKEV might be slightly more elegant ... 🍺(Mini Memory) ... Didn't even look at RXB ...

##### Share on other sites

Bresenham's circle algorithm. Only integer math.

```10 CALL CLEAR::CALL CHAR(42,"FFFFFFFFFFFFFFFF")
20 XC=15::YC=12::R=11
30 X=0::Y=R
40 D=5-4*R
50 DA=(-2*R+5)*4::DB=12
60 IF Y<X THEN 170
70 CALL HCHAR(YC+Y,XC+X,42)
80 CALL HCHAR(YC+Y,XC-X,42)
90 CALL HCHAR(YC-Y,XC+X,42)
100 CALL HCHAR(YC-Y,XC-X,42)
110 CALL HCHAR(YC+X,XC+Y,42)
120 CALL HCHAR(YC+X,XC-Y,42)
130 CALL HCHAR(YC-X,XC+Y,42)
140 CALL HCHAR(YC-X,XC-Y,42)
150 IF D>0 THEN X=X+1::Y=Y-1::D=D+DA::DA=DA+16::DB=DB+4::GOTO 60
160 X=X+1::D=D+DB::DA=DA+8::DB=DB+8::GOTO 60
170 GOTO 170```

• 4
• 1
##### Share on other sites

11 minutes ago, Asmusr said:

Bresenham's circle algorithm. Only integer math.

```10 CALL CLEAR::CALL CHAR(42,"FFFFFFFFFFFFFFFF")
20 XC=15::YC=12::R=11
30 X=0::Y=R
40 D=5-4*R
50 DA=(-2*R+5)*4::DB=12
60 IF Y<X THEN 170
70 CALL HCHAR(YC+Y,XC+X,42)
80 CALL HCHAR(YC+Y,XC-X,42)
90 CALL HCHAR(YC-Y,XC+X,42)
100 CALL HCHAR(YC-Y,XC-X,42)
110 CALL HCHAR(YC+X,XC+Y,42)
120 CALL HCHAR(YC+X,XC-Y,42)
130 CALL HCHAR(YC-X,XC+Y,42)
140 CALL HCHAR(YC-X,XC-Y,42)
150 IF D>0 THEN X=X+1::Y=Y-1::D=D+DA::DA=DA+16::DB=DB+4::GOTO 60
160 X=X+1::D=D+DB::DA=DA+8::DB=DB+8::GOTO 60
170 GOTO 170```

Quick and dirty ... and why not ... 👍

##### Share on other sites

22 hours ago, sometimes99er said:

Quick and dirty ... and why not ... 👍

It's definitely quick, but whether it's dirty is more of an individual taste. 🙂 The algorithm only calculates the points for the 45 degrees from the top of the circle moving clockwise until it meets the diagonal where x=y . The remaining 7/8s of the circle are plotted by flipping and mirroring the points in that first section (any algorithm could do the same). The algorithm ensures that each point on the circle is plotted exactly once. As you can see from the code in lines 150-160, for each step it either moves left (starting from the top) or left and down based on the value of D. There are many sources on the net explaining how that works. AFAIK, it's the algorithm to choose if you want to draw a circle fast.

• 5
##### Share on other sites

Hi

I wrote an article for the TI*MES magazine, vol.2 no. 20. June 2023,that is relevant to this discussion. The article discussed using Extended Basic - compiled, of course - to plot graphics, and supplied code for plotting pixels, lines and circles etc. In case you do not know it... The TI*MES magazine is a magazine, issued twice per year, from the TIUGUK user group.

The code supplied here is a partial extract of that article. It demonstrates the basic task of redefining character patterns continuously - like it is done in LOGO II. I have also included the code for drawing circles and how to do clipping.

sub setclip(ymin,xmin,ymax,xmax,clip())

if ymin<1 or ymin=0 then ymin=1 else if ymin>192 then ymin=192

if xmin<1 or xmin=0 then xmin=1 else if xmin>256 then xmin=256

if ymax>192 or ymax=0 then ymax=192 else if ymax<1 then ymax=1

if xmax>256 or xmax=0 then xmax=256 else if xmax<1 then xmax=1

if xmin>xmax then tmp=xmax :: xmax=xmin :: xmin=tmp

if ymin>ymax then tmp=ymax :: ymax=ymin :: ymin=tmp

clip(1)=ymin :: clip(2)=xmin :: clip(3)=ymax :: clip(4)=xmax

subend

sub plotpix(x,y,ch,clip())

if x<clip(1) or y<clip(2) or x>clip(3) or y>clip(4) then subexit

hx\$="0123456789ABCDEF"

fx=int((x-1)/8)+1 :: fy=24-int((y-1)/8)

px=x-8*fx+8 :: py=1-y+8*(25-fy)

hex=px-int(px/4)*4 :: hex=hex-(hex=0)*4 :: hex=2^(4-hex)

call gchar(fy,fx,chc) :: call charpat(chc,ch\$)

if chc=32 then chc=ch :: ch=ch+1 :: call char(chc,"0")

c=2*(py-1)+2+(px<5) :: tmp\$=seg\$(ch\$,c,1) :: tmp=(pos(hx\$,tmp\$,1)-1) or hex

nch\$=seg\$(ch\$,1,c-1)&seg\$(hx\$,tmp+1,1)&seg\$(ch\$,c+1,16-c)

call char(chc,nch\$) :: call hchar(fy,fx,chc)

subend

Drawing circles or parts of circles normally depend on the use of trig functions like SIN and COS. They are available in Extended Basic, but they are not supported by the compiler, because it only works with integers. Drawing entire circles can still be done easily with the equation x^2 + y^2 = r^2. But drawing parts of a circle is hard without the trig functions. This routine therefore always draws an entire circle. I should add that the manual for the compiler has an example of how to add your own SIN tables to a program. So, it can be done.

sub circle(x2,y2,r,ch,clip(),cx,cy)

cx=x2 :: cy=y2

d=int(r*7/10)

for dy=-d to d

dx=int(sqr(abs(r^2-dy^2)))

call plotpix(x2+dx,y2+dy,ch,clip())

call plotpix(x2-dx,y2+dy,ch,clip())

next dy

for dx=-d to d

dy=int(sqr(abs(r^2-dx^2)))

call plotpix(x2+dx,y2+dy,ch,clip())

call plotpix(x2+dx,y2-dy,ch,clip())

next dx

subend

Notice that the center of the circle may lie outside the clipped area (usually the screen area). Only those parts of the circle, that are inside the clipped area, will be drawn. One benefit if this is, that you can draw, say, a half-circle by redefining the clipping area, so the other part is chopped off. Here is an example:

SETCLIP(100,0,0,0,ch,clip()) :: CIRCLE(100,100,50,ch,clip(),cx,cy)

This code will draw a circle with its center at 100,100 and a radius of 50. But since only pixels larger than XMIN, which is 100, are drawn, we get a half-circle.

Of course, being Extended Basic - even compiled - it cannot compete speed wise with solutions in Forth or Assembler. But you do get pseudo HIRES graphics in the bargain - until you run out of ink, that is!

regards

Jesper

• 3

## Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible. ×   Pasted as rich text.   Paste as plain text instead

Only 75 emoji are allowed.