Wiki Diff SDLBasicConverions, revision #2 to tip
==Conversions from SDLBasic graphic demos
During one of many aimless interweb trawlings, I came upon the following website\\
\\
[[http://shawweb.myzen.co.uk/stephen/sdlbasic.htm]]\\
\\
which produced some very interesting graphic results from very simple algorithms (go to the site to see more examples)
{{http://shawweb.myzen.co.uk/stephen/sdllines.jpg}}{{http://shawweb.myzen.co.uk/stephen/bifurcation.png}}
{{http://shawweb.myzen.co.uk/stephen/sdlcircles.jpg}}{{http://shawweb.myzen.co.uk/stephen/banthorpe.png}}
The allegro kit lends itself very readily to these converions, below are the wrangled programs, with the originals, full credit to Stephen Shaw for allowing me to share these, and to the original authors within the programs themselves. There are many other examples to explore, which I'll leave to you to wrangle yourself.
Experiment with where to put the blit function, to see how the speed of the display is affected.
<eucode>
--copied directly from sdlbasic - http://shawweb.myzen.co.uk/stephen/sdlbasic.htm
--/*
' high resolution graphics using
' sdlBasic (Windows, Unix etc etc) -requires SDL.
bifurcating lines
' after brooks, harding etc
setdisplay(800,800,16,2)
cls
' ORBITDGM PROGRAM
FOR C=-2 TO 0.01 STEP .0005
X=0
M=500*(C+2)
FOR I=0 TO 200
X=X*X+C
IF I>50 THEN
N=(800/4)*(2-X)
dot(M,N)
END IF
END FOR
END FOR
prints("Any key to end")
WAITKEY
END
--*/
include euallegro.ew
atom buffer
object ret
--------------------------------------------------------------
--module initialisations
--------------------------------------------------------------
ret = allegro_init()
--ret = install_timer()
ret = install_keyboard()
set_color_depth(32)
--ret = set_gfx_mode(GFX_AUTODETECT_FULLSCREEN, 1024,768, 0, 0)
ret = set_gfx_mode(GFX_AUTODETECT_WINDOWED, 1024, 768, 0, 0)
if ret = -1 then
--switch to a safe mode instead
ret = set_gfx_mode(GFX_SAFE, 640, 480, 0, 0)
end if
atom C
atom X, M, N
object k
buffer = create_bitmap(1024, 768)
clear_bitmap(buffer)
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
------------------------------------------------------------
procedure dot(integer m, integer n)
------------------------------------------------------------
putpixel(buffer, m,n, makecol(255,255,255))
end procedure
--for C = -2 to 0.01 by 0.0005 do
--phix does not support floating point loops
C = -2
while C <= 0.01 do
X=0
M=500*(C+2)
for I=0 to 200 do
X=X*X+C
if I>50 then
N=(768/4)*(2-X)
dot(floor(M), floor(N))
end if
end for
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
C += 0.0005
end while
--need to halt the program to see the beauty!
while 1 do
clear_keybuf()
k = readkey()
if k > 0 then
exit
end if
end while
</eucode>
<eucode>
--/*
Bifurcs02 - copied from sdlbasic - http://shawweb.myzen.co.uk/stephen/sdlbasic.htm
There is more than one way to calculate bifurcating lines....
' image using sdlBasic (Windows, Unix etc etc)
' from ti*mes 31 BIFURCATION PLOT GENERATOR
' (an idea from Clifford Pickover
' "Computers Pattern Chaos and Beauty" (1990))
' S Shaw, 2014
SetDisplay(800,800,16,2)
randomizebifurcating lines 2
cls
fprints("ESC to end, R for random next")
MN=5 : MX=83
' FULL-ISH PIC WOULD BE 0 TO 125
' CHAOS RULES FROM 59 UP
BETA=5
' LOW beta VALUE 3 MAKES CHAOS FARTHER AWAY
' HIGHER VALUE INCREASES CHAOS
RS=270
' RS is PLOT RESOLUTION
X0=1.95
' START VALUE FOR Xt [t=0]
N=250
' ITERATION COUNT USE HIGHER FOR MORE CHAOS
RSC=2.8*RS/ (MX-MN) : CS=80
WHILE INKEY<>k_esc
FOR LA=MN TO MX STEP (MX-MN)/RS
X=X0
FOR I=1 TO N+10
X=LA*X*(1+X)^(-BETA)
IF I>10 THEN
dot ((LA-MN)*RSC+21 , X*CS+91)
end if
NEXT
NEXT
WAITKEY
IF INKEY=82 OR INKEY=114 THEN
MN=RND(150) : MX=MN+RND(100)+2 : BETA=3+RND(3)
X0=RND(3)+0.01 : RSC=2.8*RS/ (MX-MN) : CLS
fprints("ESC to end, R for random next")
END IF
--*/
include euallegro.ew
atom buffer
object ret
--------------------------------------------------------------
--module initialisations
--------------------------------------------------------------
ret = allegro_init()
--ret = install_timer()
ret = install_keyboard()
set_color_depth(32)
--ret = set_gfx_mode(GFX_AUTODETECT_FULLSCREEN, 1024,768, 0, 0)
ret = set_gfx_mode(GFX_AUTODETECT_WINDOWED, 1024, 768, 0, 0)
if ret = -1 then
--switch to a safe mode instead
ret = set_gfx_mode(GFX_SAFE, 640, 480, 0, 0)
end if
buffer = create_bitmap(1024, 768)
clear_bitmap(buffer)
------------------------------------------------------------
procedure dot(atom m, atom n)
------------------------------------------------------------
putpixel(buffer, floor(m), floor(n), makecol(255,255,255))
end procedure
integer run_count = 0
atom MN=5, MX=83
-- FULL-ISH PIC WOULD BE 0 TO 125
-- CHAOS RULES FROM 59 UP
atom BETA=5
-- LOW beta VALUE 3 MAKES CHAOS FARTHER AWAY
-- HIGHER VALUE INCREASES CHAOS
atom RS=270
-- RS is PLOT RESOLUTION
atom X0=1.95
-- START VALUE FOR Xt [t=0]
atom N=250
-- ITERATION COUNT USE HIGHER FOR MORE CHAOS
atom RSC=2.8*RS/ (MX-MN), CS=80
----------------------------------------------------
procedure do_furc()
----------------------------------------------------
atom LA, X
textout(buffer, font, "ESC to end, R for random next", 1, 1, makecol(255,255,255))
LA = MN
while LA <= MX do
X = X0
for i = 1 to N+10 do
X = LA * X * power((1+X), (-BETA))
if i > 10 then
dot ((LA-MN)*RSC+21 , X*CS+91)
end if
end for
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
LA += (MX-MN)/RS
end while
end procedure
---------------------------------------------------
procedure main()
---------------------------------------------------
object k
if run_count = 0 then
do_furc()
end if
--while 1 do
-- clear_keybuf()
-- k = readkey()
-- printf(1, "%d, %d, %d\n", {k[1], k[2], 'd'})
--end while
while 1 do
clear_keybuf()
k = readkey()
if k[1] = 27 then
exit
end if
if k[1] = 'r' or k[1] = 'R' then
MN=rand(150)
MX=MN+rand(100)+2
BETA=3+rand(3)
X0=rand(3)+0.01
RSC=2.8*RS/ (MX-MN)
clear_bitmap(buffer)
do_furc()
end if
end while
end procedure
main()
</eucode>
<eucode>
--/*
Connett circles-
' high resolution graphics using sdlBasic
' (Windows, Unix etc etc)
' from Wallpaper by Peter Moon of Stockton on Tees,
' Fractal Report issue 10, August 1990
' also see "wallpaper on your screen"
' Louis D Magguilli, Algorithm 4.2 (June 1993)
' CIRCLES from JE Connett, PWH Moon, S Shaw, 1990
SetDisplay(1000,900,16,2)
randomizeoverlaid circles
SIDE=15
WHILE INKEY<>k_esc
cls
FOR I=1 TO 1000
FOR J=1 TO 900
X=I*SIDE/600
Y=J*SIDE/600
C=INT(X*X+Y*Y)
D=C/2
IF D-INT(D)<0.11 THEN
DOT(I+1,J+1)
END IF
END FOR
END FOR
prints ("ESC to end, r for random new one, s to zoom back to start, any other to zoom out ")
fprints ("Side=") : fprints(SIDE)
SIDE=SIDE*1.15
WAITKEY
IF INKEY=82 OR INKEY=114 THEN
SIDE=RND(160)
END IF
IF INKEY=83 OR INKEY=115 THEN
SIDE=15
END IF
WEND
END
ESCape key to exit, any other key to zoom. Where do the circles come from? There is no use of sin, cos or tan etc.
--*/
include euallegro.ew
atom buffer
object ret
--------------------------------------------------------------
--module initialisations
--------------------------------------------------------------
ret = allegro_init()
--ret = install_timer()
ret = install_keyboard()
set_color_depth(32)
--ret = set_gfx_mode(GFX_AUTODETECT_FULLSCREEN, 1024,768, 0, 0)
ret = set_gfx_mode(GFX_AUTODETECT_WINDOWED, 1024, 768, 0, 0)
if ret = -1 then
--switch to a safe mode instead
ret = set_gfx_mode(GFX_SAFE, 640, 480, 0, 0)
end if
buffer = create_bitmap(1024, 768)
clear_bitmap(buffer)
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
------------------------------------------------------------
procedure dot(atom m, atom n)
------------------------------------------------------------
putpixel(buffer, floor(m), floor(n), makecol(200,200,200))
end procedure
------------------------------------------------------------
atom SIDE = 10
procedure do_circ()
------------------------------------------------------------
atom X, Y, C, D
for I = 1 to 1024 do
for J = 1 to 768 do
X=I*SIDE/600
Y=J*SIDE/600
C=floor(X*X+Y*Y)
D=C/2
if D-floor(D)<0.11 then
dot(I+1,J+1)
end if
end for
end for
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
end procedure
------------------------------------------------------------
procedure main()
------------------------------------------------------------
object k
do_circ()
--create random images
clear_keybuf()
while 1 do
if keypressed() then
exit
end if
-- k = readkey()
-- if k[1] = 27 then
-- exit
-- end if
clear_bitmap(buffer)
SIDE = SIDE * 1.01
do_circ()
end while
end procedure
main()
</eucode>
<eucode>
--/*
I came across this one a long long time ago- my notes originate from 1982.
Alas I cannot recall the origin of the plot but the full name of the creator
is Malcolm Banthorpe who used an Acorn computer and was a VT editor for the
BBC also did visual work for the BBC (Blakes 7 etc). I like the way this
3d image is plotted.
' banthorpe 3d graphic for sdlbasic
' (Windows, Unix etc etc)
' S Shaw, 2015
SetDisplay(800,600,16,2)
clsbanthorpe plot
M1=720
V=620
X1=M1/2
X2=X1^2
Y1=V/2
Y2=V/4
FOR X5=0 TO X1
X4=X5^2
M=-Y1
A=SQR(X2-X4)
FOR I1=-A TO A STEP 5
' the step figure defines the density
R1=SQR(X4+I1^2)/X1
F=(R1-1)*SIN(R1*12)
' the above line is the function plotted
R=INT(I1/4+F*Y2)
' the divisor 4 in the line above
' is the degree of tilt of the figure
IF R>M THEN
M=R
R=Y1-R
C=X1-X5+60
DOT(C,R)
C=X1+X5+60
DOT(C,R)
END IF
NEXT
NEXT
WAITKEY
END
--*/
include euallegro.ew
atom buffer
object ret
--------------------------------------------------------------
--module initialisations
--------------------------------------------------------------
ret = allegro_init()
--ret = install_timer()
ret = install_keyboard()
set_color_depth(32)
--ret = set_gfx_mode(GFX_AUTODETECT_FULLSCREEN, 1024,768, 0, 0)
ret = set_gfx_mode(GFX_AUTODETECT_WINDOWED, 1024, 768, 0, 0)
if ret = -1 then
--switch to a safe mode instead
ret = set_gfx_mode(GFX_SAFE, 640, 480, 0, 0)
end if
buffer = create_bitmap(1024, 768)
clear_bitmap(buffer)
------------------------------------------------------------
procedure dot(atom m, atom n)
------------------------------------------------------------
putpixel(buffer, floor(m), floor(n), makecol(255,255,255))
end procedure
--------------------------------------------------------------
procedure main()
--------------------------------------------------------------
atom M1=720
atom V=620
atom X1=M1/2
atom X2=power(X1, 2)
atom Y1=V/2
atom Y2=V/4
atom X4, M, A, R1, F, R, C, I1
atom TILT = 4
for X5=0 to X1 do
X4=power(X5,2)
M=-Y1
A=sqrt(X2-X4)
I1 = -A
while I1 <= A do --Phix doesn't do floating point for loops!
--for I1 = -A to A by 5 do
--the step figure defines the density
R1=sqrt(X4+ power(I1,2))/X1
F=(R1-1)*sin(R1*12)
-- the above line is the function plotted
R=floor(I1 / TILT + F*Y2) + 30
if R>M then
M=R
R=Y1-R
C=X1-X5+10
C = C * 0.85 --scale to fit screen
dot(C,R)
C=X1+X5+10
C = C * 0.85 --scale to fit screen
dot(C,R)
end if
I1 += 5 --the step figure defines the density
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H) --watch the plot
end while
--blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H) --just look after all the plottings done
end for
--press any key to exit
clear_keybuf()
while 1 do
if keypressed() then
exit
end if
end while
end procedure
main()
</eucode>
*[[http://openeuphoria.org/wiki/view/allegro.wc|Euallegro home]]
During one of many aimless interweb trawlings, I came upon the following website\\
\\
[[http://shawweb.myzen.co.uk/stephen/sdlbasic.htm]]\\
\\
which produced some very interesting graphic results from very simple algorithms (go to the site to see more examples)
The allegro kit lends itself very readily to these converions, below are the wrangled programs, with the originals, full credit to Stephen Shaw for allowing me to share these, and to the original authors within the programs themselves. There are many other examples to explore, which I'll leave to you to wrangle yourself.
Experiment with where to put the blit function, to see how the speed of the display is affected.
<eucode>
--copied directly from sdlbasic - http://shawweb.myzen.co.uk/stephen/sdlbasic.htm
--/*
' high resolution graphics using
' sdlBasic (Windows, Unix etc etc) -requires SDL.
bifurcating lines
' after brooks, harding etc
setdisplay(800,800,16,2)
cls
' ORBITDGM PROGRAM
FOR C=-2 TO 0.01 STEP .0005
X=0
M=500*(C+2)
FOR I=0 TO 200
X=X*X+C
IF I>50 THEN
N=(800/4)*(2-X)
dot(M,N)
END IF
END FOR
END FOR
prints("Any key to end")
WAITKEY
END
--*/
include euallegro.ew
atom buffer
object ret
--------------------------------------------------------------
--module initialisations
--------------------------------------------------------------
ret = allegro_init()
--ret = install_timer()
ret = install_keyboard()
set_color_depth(32)
--ret = set_gfx_mode(GFX_AUTODETECT_FULLSCREEN, 1024,768, 0, 0)
ret = set_gfx_mode(GFX_AUTODETECT_WINDOWED, 1024, 768, 0, 0)
if ret = -1 then
--switch to a safe mode instead
ret = set_gfx_mode(GFX_SAFE, 640, 480, 0, 0)
end if
atom C
atom X, M, N
object k
buffer = create_bitmap(1024, 768)
clear_bitmap(buffer)
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
------------------------------------------------------------
procedure dot(integer m, integer n)
------------------------------------------------------------
putpixel(buffer, m,n, makecol(255,255,255))
end procedure
--for C = -2 to 0.01 by 0.0005 do
--phix does not support floating point loops
C = -2
while C <= 0.01 do
X=0
M=500*(C+2)
for I=0 to 200 do
X=X*X+C
if I>50 then
N=(768/4)*(2-X)
dot(floor(M), floor(N))
end if
end for
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
C += 0.0005
end while
--need to halt the program to see the beauty!
while 1 do
clear_keybuf()
k = readkey()
if k > 0 then
exit
end if
end while
</eucode>
<eucode>
--/*
Bifurcs02 - copied from sdlbasic - http://shawweb.myzen.co.uk/stephen/sdlbasic.htm
There is more than one way to calculate bifurcating lines....
' image using sdlBasic (Windows, Unix etc etc)
' from ti*mes 31 BIFURCATION PLOT GENERATOR
' (an idea from Clifford Pickover
' "Computers Pattern Chaos and Beauty" (1990))
' S Shaw, 2014
SetDisplay(800,800,16,2)
randomizebifurcating lines 2
cls
fprints("ESC to end, R for random next")
MN=5 : MX=83
' FULL-ISH PIC WOULD BE 0 TO 125
' CHAOS RULES FROM 59 UP
BETA=5
' LOW beta VALUE 3 MAKES CHAOS FARTHER AWAY
' HIGHER VALUE INCREASES CHAOS
RS=270
' RS is PLOT RESOLUTION
X0=1.95
' START VALUE FOR Xt [t=0]
N=250
' ITERATION COUNT USE HIGHER FOR MORE CHAOS
RSC=2.8*RS/ (MX-MN) : CS=80
WHILE INKEY<>k_esc
FOR LA=MN TO MX STEP (MX-MN)/RS
X=X0
FOR I=1 TO N+10
X=LA*X*(1+X)^(-BETA)
IF I>10 THEN
dot ((LA-MN)*RSC+21 , X*CS+91)
end if
NEXT
NEXT
WAITKEY
IF INKEY=82 OR INKEY=114 THEN
MN=RND(150) : MX=MN+RND(100)+2 : BETA=3+RND(3)
X0=RND(3)+0.01 : RSC=2.8*RS/ (MX-MN) : CLS
fprints("ESC to end, R for random next")
END IF
--*/
include euallegro.ew
atom buffer
object ret
--------------------------------------------------------------
--module initialisations
--------------------------------------------------------------
ret = allegro_init()
--ret = install_timer()
ret = install_keyboard()
set_color_depth(32)
--ret = set_gfx_mode(GFX_AUTODETECT_FULLSCREEN, 1024,768, 0, 0)
ret = set_gfx_mode(GFX_AUTODETECT_WINDOWED, 1024, 768, 0, 0)
if ret = -1 then
--switch to a safe mode instead
ret = set_gfx_mode(GFX_SAFE, 640, 480, 0, 0)
end if
buffer = create_bitmap(1024, 768)
clear_bitmap(buffer)
------------------------------------------------------------
procedure dot(atom m, atom n)
------------------------------------------------------------
putpixel(buffer, floor(m), floor(n), makecol(255,255,255))
end procedure
integer run_count = 0
atom MN=5, MX=83
-- FULL-ISH PIC WOULD BE 0 TO 125
-- CHAOS RULES FROM 59 UP
atom BETA=5
-- LOW beta VALUE 3 MAKES CHAOS FARTHER AWAY
-- HIGHER VALUE INCREASES CHAOS
atom RS=270
-- RS is PLOT RESOLUTION
atom X0=1.95
-- START VALUE FOR Xt [t=0]
atom N=250
-- ITERATION COUNT USE HIGHER FOR MORE CHAOS
atom RSC=2.8*RS/ (MX-MN), CS=80
----------------------------------------------------
procedure do_furc()
----------------------------------------------------
atom LA, X
textout(buffer, font, "ESC to end, R for random next", 1, 1, makecol(255,255,255))
LA = MN
while LA <= MX do
X = X0
for i = 1 to N+10 do
X = LA * X * power((1+X), (-BETA))
if i > 10 then
dot ((LA-MN)*RSC+21 , X*CS+91)
end if
end for
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
LA += (MX-MN)/RS
end while
end procedure
---------------------------------------------------
procedure main()
---------------------------------------------------
object k
if run_count = 0 then
do_furc()
end if
--while 1 do
-- clear_keybuf()
-- k = readkey()
-- printf(1, "%d, %d, %d\n", {k[1], k[2], 'd'})
--end while
while 1 do
clear_keybuf()
k = readkey()
if k[1] = 27 then
exit
end if
if k[1] = 'r' or k[1] = 'R' then
MN=rand(150)
MX=MN+rand(100)+2
BETA=3+rand(3)
X0=rand(3)+0.01
RSC=2.8*RS/ (MX-MN)
clear_bitmap(buffer)
do_furc()
end if
end while
end procedure
main()
</eucode>
<eucode>
--/*
Connett circles-
' high resolution graphics using sdlBasic
' (Windows, Unix etc etc)
' from Wallpaper by Peter Moon of Stockton on Tees,
' Fractal Report issue 10, August 1990
' also see "wallpaper on your screen"
' Louis D Magguilli, Algorithm 4.2 (June 1993)
' CIRCLES from JE Connett, PWH Moon, S Shaw, 1990
SetDisplay(1000,900,16,2)
randomizeoverlaid circles
SIDE=15
WHILE INKEY<>k_esc
cls
FOR I=1 TO 1000
FOR J=1 TO 900
X=I*SIDE/600
Y=J*SIDE/600
C=INT(X*X+Y*Y)
D=C/2
IF D-INT(D)<0.11 THEN
DOT(I+1,J+1)
END IF
END FOR
END FOR
prints ("ESC to end, r for random new one, s to zoom back to start, any other to zoom out ")
fprints ("Side=") : fprints(SIDE)
SIDE=SIDE*1.15
WAITKEY
IF INKEY=82 OR INKEY=114 THEN
SIDE=RND(160)
END IF
IF INKEY=83 OR INKEY=115 THEN
SIDE=15
END IF
WEND
END
ESCape key to exit, any other key to zoom. Where do the circles come from? There is no use of sin, cos or tan etc.
--*/
include euallegro.ew
atom buffer
object ret
--------------------------------------------------------------
--module initialisations
--------------------------------------------------------------
ret = allegro_init()
--ret = install_timer()
ret = install_keyboard()
set_color_depth(32)
--ret = set_gfx_mode(GFX_AUTODETECT_FULLSCREEN, 1024,768, 0, 0)
ret = set_gfx_mode(GFX_AUTODETECT_WINDOWED, 1024, 768, 0, 0)
if ret = -1 then
--switch to a safe mode instead
ret = set_gfx_mode(GFX_SAFE, 640, 480, 0, 0)
end if
buffer = create_bitmap(1024, 768)
clear_bitmap(buffer)
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
------------------------------------------------------------
procedure dot(atom m, atom n)
------------------------------------------------------------
putpixel(buffer, floor(m), floor(n), makecol(200,200,200))
end procedure
------------------------------------------------------------
atom SIDE = 10
procedure do_circ()
------------------------------------------------------------
atom X, Y, C, D
for I = 1 to 1024 do
for J = 1 to 768 do
X=I*SIDE/600
Y=J*SIDE/600
C=floor(X*X+Y*Y)
D=C/2
if D-floor(D)<0.11 then
dot(I+1,J+1)
end if
end for
end for
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H)
end procedure
------------------------------------------------------------
procedure main()
------------------------------------------------------------
object k
do_circ()
--create random images
clear_keybuf()
while 1 do
if keypressed() then
exit
end if
-- k = readkey()
-- if k[1] = 27 then
-- exit
-- end if
clear_bitmap(buffer)
SIDE = SIDE * 1.01
do_circ()
end while
end procedure
main()
</eucode>
<eucode>
--/*
I came across this one a long long time ago- my notes originate from 1982.
Alas I cannot recall the origin of the plot but the full name of the creator
is Malcolm Banthorpe who used an Acorn computer and was a VT editor for the
BBC also did visual work for the BBC (Blakes 7 etc). I like the way this
3d image is plotted.
' banthorpe 3d graphic for sdlbasic
' (Windows, Unix etc etc)
' S Shaw, 2015
SetDisplay(800,600,16,2)
clsbanthorpe plot
M1=720
V=620
X1=M1/2
X2=X1^2
Y1=V/2
Y2=V/4
FOR X5=0 TO X1
X4=X5^2
M=-Y1
A=SQR(X2-X4)
FOR I1=-A TO A STEP 5
' the step figure defines the density
R1=SQR(X4+I1^2)/X1
F=(R1-1)*SIN(R1*12)
' the above line is the function plotted
R=INT(I1/4+F*Y2)
' the divisor 4 in the line above
' is the degree of tilt of the figure
IF R>M THEN
M=R
R=Y1-R
C=X1-X5+60
DOT(C,R)
C=X1+X5+60
DOT(C,R)
END IF
NEXT
NEXT
WAITKEY
END
--*/
include euallegro.ew
atom buffer
object ret
--------------------------------------------------------------
--module initialisations
--------------------------------------------------------------
ret = allegro_init()
--ret = install_timer()
ret = install_keyboard()
set_color_depth(32)
--ret = set_gfx_mode(GFX_AUTODETECT_FULLSCREEN, 1024,768, 0, 0)
ret = set_gfx_mode(GFX_AUTODETECT_WINDOWED, 1024, 768, 0, 0)
if ret = -1 then
--switch to a safe mode instead
ret = set_gfx_mode(GFX_SAFE, 640, 480, 0, 0)
end if
buffer = create_bitmap(1024, 768)
clear_bitmap(buffer)
------------------------------------------------------------
procedure dot(atom m, atom n)
------------------------------------------------------------
putpixel(buffer, floor(m), floor(n), makecol(255,255,255))
end procedure
--------------------------------------------------------------
procedure main()
--------------------------------------------------------------
atom M1=720
atom V=620
atom X1=M1/2
atom X2=power(X1, 2)
atom Y1=V/2
atom Y2=V/4
atom X4, M, A, R1, F, R, C, I1
atom TILT = 4
for X5=0 to X1 do
X4=power(X5,2)
M=-Y1
A=sqrt(X2-X4)
I1 = -A
while I1 <= A do --Phix doesn't do floating point for loops!
--for I1 = -A to A by 5 do
--the step figure defines the density
R1=sqrt(X4+ power(I1,2))/X1
F=(R1-1)*sin(R1*12)
-- the above line is the function plotted
R=floor(I1 / TILT + F*Y2) + 30
if R>M then
M=R
R=Y1-R
C=X1-X5+10
C = C * 0.85 --scale to fit screen
dot(C,R)
C=X1+X5+10
C = C * 0.85 --scale to fit screen
dot(C,R)
end if
I1 += 5 --the step figure defines the density
blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H) --watch the plot
end while
--blit(buffer, screen, 0, 0, 0, 0, SCREEN_W, SCREEN_H) --just look after all the plottings done
end for
--press any key to exit
clear_keybuf()
while 1 do
if keypressed() then
exit
end if
end while
end procedure
main()
</eucode>
*[[http://openeuphoria.org/wiki/view/allegro.wc|Euallegro home]]
