'\$error all on defext a-z screen 12 call invertcolors n&=100 s=1## m&=2 tmax&=50 h=.05## randomize timer dim x(n&), dxdt(n&), y(m&,n&), c(m&,n&) for i&=1 to n& 'random initial conditions x(i&)=rnd next i& open"initcond.100" for input as #1 for i&=1 to 100: input#1,x(i&): next i& close #1 q\$="C" while q\$<>chr\$(27) if q\$="B" then 'make bmp file call scn2bmp("fig6.bmp") q\$="C" end if if q\$="C" then 'clear screen cls line(0,0)-(639,479),,b line(639/2,0)-(639/2,479),,,&h4444 yo=y(m&,n&/2) co=co+yo*yo for j&=m& to 0 step -1 for i&=0 to n& step 2 c(j&,i&)=c(j&,i&)+y(j&,i&)*yo next i& for i&=0 to n& step 2 if co=0 then iterate x0=639*i&/n& x1=639*(i&+2)/n& i1&=(i&-2+n&) mod n& yold=479-479*abs(c(j&,i1&)/co) y0=479-479*abs(c(j&,i&)/co) i1&=(i&+2) mod n& y1=479-479*abs(c(j&,i1&)/co) i1&=(i&+4) mod n& y2=479-479*abs(c(j&,i1&)/co) for xp=x0 to x1 p=(xp-x0)/(x1-x0) yp=interpolate4(yold,y0,y1,y2,p) if xp=0 then pset(xp,yp) else line-(xp,yp) next xp next i& next j& for i&=0 to n& step 2 for j&=m& to 1 step -1 y(j&,i&)=y(j&-1,i&) next j& y(0,i&)=x(i&)-1##/(1##+2##*s) next i& t&=0 q\$=ucase\$(inkey\$) end if for j&=1 to 1##/h RK4 x(), dxdt(), n&, h, x() next j& x(0)=x(n&) incr t& if t&>=tmax& then q\$="C" wend end SUB invertcolors () 'Sets the RGB palette to iverted gray scale in 16-color VGA screen modes FOR pal& = 0 TO 15 PALETTE pal&, pal& c& = 63-INT(4.2 * pal&) OUT &h3C8, pal& OUT &h3C9, c& OUT &h3C9, c& OUT &h3C9, c& NEXT pal& END SUB SUB scn2bmp (filename\$) 'Captures the screen to a file filename\$ in bitmaped (BMP) format 'Palette correct in EGA and VGA color modes 7 - 12 only WINDOW SCREEN (0, 0)-(1, 1) 'Get width and height of screen w& = 1 + PMAP(1, 0) h& = 1 + PMAP(1, 1) WINDOW x1& = 0: y1& = 0: x2& = w&-1: y2& = h&-1 'Corners of image x2& = x1& + 16 * CEIL((x2& - x1&) \ 16 + .01) - 1 SOUND 1000, .3 SOUND 750, .3 sw& = 1 + x2& - x1& 'Width of image in pixels sh& = 1 + y2& - y1& 'Height of image in pixels sf& = sw& * sh& \ 2 'Bytes in image f& = FREEFILE OPEN filename\$ FOR OUTPUT AS f& PRINT #f&, MKWRD\$(&H4D42); 'ASCII "BM" PRINT #f&, MKL\$(sf& + 118); 'Size of file in bytes PRINT #f&, MKDWD\$(0); 'Must be zero PRINT #f&, MKWRD\$(&h76)+MKWRD\$(0)+MKWRD\$(&H28)+MKWRD\$(0); PRINT #f&, MKL\$(sw&); 'Screen width PRINT #f&, MKL\$(sh&); 'Screen height PRINT #f&, MKWRD\$(1)+MKWRD\$(4)+MKDWD\$(0); PRINT #f&, MKL\$(sf&); 'Size of image in bytes PRINT #f&, MKDWD\$(0)+MKDWD\$(0)+MKDWD\$(0)+MKDWD\$(0); FOR i& = 0 TO 15 'Palette RGB values (0 - 15) out &h3C7,i& red?=4.047619*inp(&h3c9) grn?=4.047619*inp(&h3c9) blu?=4.047619*inp(&h3c9) PRINT #f&, MKBYT\$(blu?);MKBYT\$(grn?);MKBYT\$(red?);MKBYT\$(0); NEXT i& a\$ = SPACE\$(sw& \ 2) FOR y& = y2& TO y1& STEP -1 x& = x1& WHILE x& < x2& a? = POINT(x&, y&) SHIFT LEFT a?, 4 INCR x& a? = a? OR POINT(x&, y&) INCR x& MID\$(a\$, (x& - x1&) \ 2, 1) = MKBYT\$(a?) WEND PRINT #f&, a\$; NEXT y& CLOSE f& SOUND 800, .3 SOUND 600, .3 END SUB SUB DERIVS (x(), dxdt(), n&) 'Returns the time derivatives dxdt(i&) of x(i&) SHARED s FOR i&=1 TO n& i1&=1+(i&-3+n&) MOD n& i3&=1+i& MOD n& dxdt(i&)=x(i&)*(1##-s*x(i1&)-x(i&)-s*x(i3&)) NEXT i& END SUB SUB RK4 (X(), DXDT(), N&, H, XNEW()) 'Fourth-order Runge-Kutta integrator DIM XT(N&), DXT(N&), DXM(N&) HH = H * .5## H6 = H / 6## CALL DERIVS(X(), DXDT(), N&) FOR I& = 1 TO N& XT(I&) = X(I&) + HH * DXDT(I&) NEXT I& CALL DERIVS(XT(), DXT(), N&) FOR I& = 1 TO N& XT(I&) = X(I&) + HH * DXT(I&) NEXT I& CALL DERIVS(XT(), DXM(), N&) FOR I& = 1 TO N& XT(I&) = X(I&) + H * DXM(I&) DXM(I&) = DXT(I&) + DXM(I&) NEXT I& CALL DERIVS(XT(), DXT(), N&) FOR I& = 1 TO N& XNEW(I&) = X(I&) + H6 * (DXDT(I&) + DXT(I&) + 2## * DXM(I&)) NEXT I& ERASE DXM, DXT, XT END SUB FUNCTION interpolate4 (yold, yo, y1, y2, p) 'Returns y(xo+p) between yo and y1 for equally spaced x 'where p = (x-xo)/(x1-xo) 'Lagrange Four Point Interpolation Formula sum = -p*(p-1)*(p-2)*yold/6 sum = sum + (p*p-1)*(p-2)*yo/2 sum = sum - p*(p+1)*(p-2)*y1/2 interpolate4 = sum + p*(p*p-1)*y2/6 END FUNCTION