Jump to content
IGNORED

Math fun


Vorticon

Recommended Posts

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  ;

 

  • Like 6
Link to comment
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

image.thumb.png.6ae52957649e2d0cfc2493c0bd170712.png

image.thumb.png.f43237fb5a2d2669b67f96326570060b.png

 

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

 

image.thumb.png.7765f15eac614b90e8a12db88d487b82.png

 

  • Like 4
  • Thanks 1
Link to comment
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

image.thumb.png.6ae52957649e2d0cfc2493c0bd170712.png

image.thumb.png.f43237fb5a2d2669b67f96326570060b.png

 

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

 

image.thumb.png.7765f15eac614b90e8a12db88d487b82.png

 

I'm having a little trouble understanding that one.

Link to comment
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.

Link to comment
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. 

  • Like 1
Link to comment
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. :) 

 

  • Like 2
  • Haha 1
Link to comment
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
 

 

  • Like 8
Link to comment
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

  • Like 2
Link to comment
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. 

  • Like 3
Link to comment
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
;

 

 

  • Like 6
Link to comment
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!

  • Like 1
Link to comment
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...

  • Like 4
Link to comment
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 ... 😉
 

  • Haha 1
Link to comment
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

 

  • Like 4
  • Thanks 1
Link to comment
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 ... 👍
 

Link to comment
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.

  • Like 5
Link to comment
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

  • Like 3
Link to comment
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...