SDLBasicConverions
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)
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.
--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
--/* 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()
--/* 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()
--/* 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()
|
Not Categorized, Please Help
|
