Math fun

+Vorticon · August 8

Algorithm to draw a circle What else have you got?

SteveB · August 8

Yours is nicer ....

+TheBF · August 8

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  ;

Reciprocating Bill · August 8

SteveB · August 8

... 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:

+Vorticon · August 8

3 hours ago, Reciprocating Bill said:

Circle Illusion.mov

Ooooh! Very cool! Source code please?

+Vorticon · August 8

5 hours ago, SteveB said:

Yours is nicer ....

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

+Vorticon · August 8

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.

jrhodes · August 8

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.

Reciprocating Bill · August 9

38 minutes ago, Vorticon said:

Ooooh! Very cool! Source code please?

It's written in FBForth, and running on real iron, so it's tricky to get a listing. As a workaround I've pasted the four screens of which the program is composed here - not sure what the result will be...

+TheBF · August 9

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.

+TheBF · August 9

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.

sometimes99er · August 9

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

SteveB · August 9

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

+TheBF · August 9

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.

+TheBF · August 9

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
;

apersson850 · August 10

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.

+Vorticon · August 10

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!

+Vorticon · August 10

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...

sometimes99er · August 10

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 ... 😉

sometimes99er · August 10

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

Asmusr · August 10

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

sometimes99er · August 10

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 ... 👍

Asmusr · August 11

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.

jschultzpedersen · August 11

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

Math fun

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members