'=========================================================================== ' Subject: DOT MORPHED FRACTAL FERN Date: 08-09-98 (03:32) ' Author: Daniel Davies Code: QB, QBasic, PDS ' Origin: ia53@rapid.co.uk Packet: GRAPHICS.ABC '=========================================================================== 'IFS dotmorph 'By Daniel Davies 'E-Mail Me at ia53@rapid.co.uk 'or visit my web site at www.users.rapid.net.uk/ia53/ 'if you use any of this please give me some credit. DECLARE FUNCTION GetPixel% (x%, y%, Page%) DECLARE SUB xcls (Page%) DECLARE SUB showpage (Page%) DECLARE SUB Set320x240mode () DECLARE SUB putpixel (x%, y%, Culler%, Page%) DECLARE SUB fade () TYPE vertex '3d point co-ordinate x AS SINGLE y AS SINGLE z AS SINGLE END TYPE TYPE pixel '2d point co-ordinate x AS SINGLE y AS SINGLE END TYPE COMMON SHARED sine() COMMON SHARED cosine() CONST pi = 3.141593 DIM SHARED sine(0 TO 360) DIM SHARED cosine(0 TO 360) FOR t% = 0 TO 360 sine(t%) = SIN(t% * (pi / 180)) cosine(t%) = COS(t% * (pi / 180)) NEXT t% DIM BitMask%(7) FOR Bit% = 0 TO 7: BitMask%(Bit%) = 2 ^ Bit%: NEXT text$ = LTRIM$(RTRIM$(COMMAND$)) IF LEN(text$) = 0 THEN points% = 4000 ELSE points% = VAL(text$) frames% = 50 DIM SHARED R(255) AS INTEGER, G(255) AS INTEGER, B(255) AS INTEGER DIM SHARED r2(255) AS SINGLE, g2(255) AS SINGLE, b2(255) AS SINGLE DIM SHARED rinc(255) AS SINGLE, ginc(255) AS SINGLE, binc(255) AS SINGLE DIM SHARED start(points%) AS pixel 'start of animation DIM SHARED dots(points%) AS pixel DIM SHARED objectv(points%) AS pixel 'VISIBLE FRAME DIM SHARED increment(points%) AS pixel 'AMOUNT TO ALTER VISIBLE FRAME 'BY EACH FRAME RANDOMIZE TIMER FOR z& = 1 TO points% R = RND IF (R <= .18) THEN a = .352: B = .355: C = -.355: D = .352: E = .354: F = .5 ELSEIF R > .18 AND R <= .46 THEN a = .353: B = -.354: C = .354: D = .353: E = .288: F = .153 ELSEIF R > .46 AND R <= .74 THEN a = .5: B = 0: C = 0: D = .5: E = .25: F = .462 ELSEIF R > .74 AND R <= .95 THEN a = .502: B = -.002: C = .002: D = .588: E = .25: F = .105 ELSE a = .004: B = 0: C = 0: D = .578: E = .501: F = .06 END IF NEWX = (a * x) + (B * y) + E NEWY = (C * x) + (D * y) + F x = NEWX y = NEWY dots(z&).x = (x * 300) MOD 320 dots(z&).y = (200 - (y * 200)) * 1.2 NEXT z& 'GENERATE THE INITAL RANDOM DOTS, AND THE FERN IT MORPHS TO FOR z& = 1 TO points% R = RND IF (R <= .01) THEN a = 0: B = 0: C = 0: D = .16: E = 0: F = 0 ELSEIF R > .01 AND R <= .86 THEN a = .85: B = .04: C = -.04: D = .85: E = 0: F = 1.6 ELSEIF R > .86 AND R <= .93 THEN a = .2: B = -.26: C = .23: D = .22: E = 0: F = 1.6 ELSE a = -.15: B = .28: C = .26: D = .24: E = 0: F = .44 END IF NEWX = (a * x) + (B * y) + E NEWY = (C * x) + (D * y) + F x = NEWX y = NEWY start(z&).x = (x + 4) * 32 start(z&).y = (200 - (y * 20)) * 1.2 objectv(z&).x = dots(z&).x objectv(z&).y = dots(z&).y increment(z&).x = (dots(z&).x - start(z&).x) / frames% increment(z&).y = (dots(z&).y - start(z&).y) / frames% NEXT z& vp% = 0 ap% = 1 SCREEN 13 Set320x240mode FOR SETPAL% = 1 TO 32 OUT 968, SETPAL% OUT 969, (32 + SETPAL%) / 3 OUT 969, (32 + SETPAL%) / 2 OUT 969, 31 + SETPAL% OUT 968, SETPAL% + 32 OUT 969, (64 - SETPAL%) / 3 OUT 969, (64 - SETPAL%) / 2 OUT 969, 64 - SETPAL% NEXT SETPAL% WAIT &H3DA, 8 showpage vp% 'do the dotmorph FOR a% = 1 TO frames% FOR B% = 1 TO points% putpixel INT(objectv(B%).x), INT(objectv(B%).y), (B% MOD 63) + 1, ap% objectv(B%).x = objectv(B%).x - increment(B%).x objectv(B%).y = objectv(B%).y - increment(B%).y NEXT B% SWAP ap%, vp% WAIT &H3DA, 8 showpage vp% xcls ap% IF INKEY$ <> "" THEN GOTO ENDing: NEXT a% DO RANDOMIZE TIMER st# = TIMER 'calculate the dragon x = 0 y = 0 FOR z& = 1 TO points% R = RND IF (R <= .212527) THEN a = .088272: B = .520988: C = -.463889#: D = -.377778 E = .78536: F = 8.095795 ELSE a = .824074: B = .281482: C = -.212346: D = .864198 E = -1.88229#: F = -.110607 END IF NEWX = (a * x) + (B * y) + E NEWY = (C * x) + (D * y) + F x = NEWX y = NEWY vx = ((x + 4) * 23) + 75 vy = (180 - (y * 18)) * 1.2 objectv(z&).x = start(z&).x objectv(z&).y = start(z&).y increment(z&).x = (vx - start(z&).x) / frames% increment(z&).y = (vy - start(z&).y) / frames% start(z&).x = vx start(z&).y = vy NEXT z& DO: LOOP UNTIL TIMER - st# >= .5 FOR a% = 1 TO frames% FOR B% = 1 TO points% putpixel INT(objectv(B%).x), INT(objectv(B%).y), (B% MOD 63) + 1, ap% objectv(B%).x = objectv(B%).x + increment(B%).x objectv(B%).y = objectv(B%).y + increment(B%).y NEXT B% SWAP ap%, vp% WAIT &H3DA, 8 showpage vp% xcls ap% IF INKEY$ <> "" THEN GOTO ENDing: IF INKEY$ <> "" THEN GOTO ENDing: NEXT a% st# = TIMER FOR z& = 1 TO points% increment(z&).x = (dots(z&).x - start(z&).x) / frames% increment(z&).y = (dots(z&).y - start(z&).y) / frames% objectv(z&).x = start(z&).x objectv(z&).y = start(z&).y NEXT z& DO: LOOP UNTIL TIMER - st# >= .5 FOR a% = 1 TO frames% FOR B% = 1 TO points% putpixel INT(objectv(B%).x), INT(objectv(B%).y), (B% MOD 63) + 1, ap% objectv(B%).x = objectv(B%).x + increment(B%).x objectv(B%).y = objectv(B%).y + increment(B%).y NEXT B% SWAP ap%, vp% WAIT &H3DA, 8 showpage vp% xcls ap% IF INKEY$ <> "" THEN GOTO ENDing: IF INKEY$ <> "" THEN GOTO ENDing: NEXT a% st# = TIMER FOR z& = 1 TO points% R = RND IF (R <= .01) THEN a = 0: B = 0: C = 0: D = .16: E = 0: F = 0 ELSEIF R > .01 AND R <= .86 THEN a = .85: B = .04: C = -.04: D = .85: E = 0: F = 1.6 ELSEIF R > .86 AND R <= .93 THEN a = .2: B = -.26: C = .23: D = .22: E = 0: F = 1.6 ELSE a = -.15: B = .28: C = .26: D = .24: E = 0: F = .44 END IF NEWX = (a * x) + (B * y) + E NEWY = (C * x) + (D * y) + F x = NEWX y = NEWY vx = (x + 4) * 32 vy = (200 - (y * 20)) * 1.2 objectv(z&).x = dots(z&).x objectv(z&).y = dots(z&).y increment(z&).x = (vx - dots(z&).x) / frames% increment(z&).y = (vy - dots(z&).y) / frames% start(z&).x = vx start(z&).y = vy NEXT z& DO: LOOP UNTIL TIMER - st# >= .5 FOR a% = 1 TO frames% FOR B% = 1 TO points% putpixel INT(objectv(B%).x), INT(objectv(B%).y), (B% MOD 32) + 1, ap% objectv(B%).x = objectv(B%).x + increment(B%).x objectv(B%).y = objectv(B%).y + increment(B%).y NEXT B% SWAP ap%, vp% WAIT &H3DA, 8 showpage vp% xcls ap% IF INKEY$ <> "" THEN GOTO ENDing: NEXT a% LOOP ENDing: fade SCREEN 13 SCREEN 0 WIDTH 80 PRINT " 旼컴컴컴컴컴컴컴컴컴컴컴컴커" PRINT " 쿌RCLIGHTS FRACTAL DOTMORPH�" PRINT " 읕컴컴컴컴컴컴컴컴컴컴컴컴켸" PRINT "" PRINT "E-MAIL :- ia53@rapid.co.uk" PRINT "WWW :- www.users.rapid.net.uk/ia53" PRINT SUB fade stages% = 48 'this is how many stages the fade goes through OUT 968, 0 FOR count% = 0 TO 255 'read in palette values R% = INP(969): G% = INP(969): B% = INP(969) R(count%) = R%: G(count%) = G%: B(count%) = B% r2(count%) = R%: g2(count%) = G%: b2(count%) = B% rinc(count%) = R% / stages% ginc(count%) = G% / stages% binc(count%) = B% / stages% NEXT count% FOR count% = 0 TO stages% - 1 FOR tmp% = 0 TO 255 r2(tmp%) = r2(tmp%) - rinc(tmp%) g2(tmp%) = g2(tmp%) - ginc(tmp%) b2(tmp%) = b2(tmp%) - binc(tmp%) R(tmp%) = r2(tmp%) G(tmp%) = g2(tmp%) B(tmp%) = b2(tmp%) NEXT tmp% OUT 968, 0: FOR SETPAL% = 0 TO 255 OUT 969, R(SETPAL%): OUT 969, G(SETPAL%): OUT 969, B(SETPAL%) NEXT SETPAL%: WAIT &H3DA, 8 NEXT count% END SUB FUNCTION GetPixel% (x%, y%, Page%) SELECT CASE Page% CASE 0: VidSegment% = &HA000 CASE 1: VidSegment% = &HA4F0 CASE 2: VidSegment% = &HA9E0 CASE ELSE: ERROR 5 END SELECT OUT &H3CE, 4: OUT &H3CF, x% AND 3 DEF SEG = VidSegment% GetPixel% = PEEK((y% * 80) + (x% \ 4)) END FUNCTION SUB putpixel (x%, y%, Culler%, Page%) SHARED BitMask%() SELECT CASE Page% CASE 0: VidSegment% = &HA000 CASE 1: VidSegment% = &HA4F0 CASE 2: VidSegment% = &HA9E0 CASE ELSE: ERROR 5 END SELECT OUT &H3C4, 2: OUT &H3C5, BitMask%(x% AND 3) DEF SEG = VidSegment% POKE (y% * 80) + (x% \ 4), Culler% END SUB SUB Set320x240mode 'begin with standard 320x200x256 mode SCREEN 13 'disable "chain4" mode OUT &H3C4, &H4: OUT &H3C5, &H6 'enable writes to all four planes OUT &H3C4, &H2: OUT &H3C5, &HF 'clear video memory CLS 'synchronous reset while switching clocks OUT &H3C4, 0: OUT &H3C5, &H1 'select 25 Mhz dot clock and 60 hz scanning rate OUT &H3C2, &HE3 'restart the sequencer OUT &H3C4, 0: OUT &H3C5, &H3 'to reprogram the CRT controller, 'remove write protect from the registers OUT &H3D4, &H11: OUT &H3D5, INP(&H3D5) AND &H7F OUT &H3D4, &H6: OUT &H3D5, &HD 'total vertical pixels OUT &H3D4, &H7: OUT &H3D5, &H3E 'overflow OUT &H3D4, &H9: OUT &H3D5, &H41 'turn off double double-scan OUT &H3D4, &H10: OUT &H3D5, &HEA 'vertical sync start OUT &H3D4, &H11: OUT &H3D5, &HAC 'vertical sync end, reprotect registers OUT &H3D4, &H12: OUT &H3D5, &HDF 'vertical pixels displayed OUT &H3D4, &H14: OUT &H3D5, 0 'turn off dword mode OUT &H3D4, &H15: OUT &H3D5, &HE7 'vertical blank start OUT &H3D4, &H16: OUT &H3D5, &H6 'vertical blank end OUT &H3D4, &H17: OUT &H3D5, &HE3 'turn on byte mode END SUB SUB showpage (Page%) SELECT CASE Page% CASE 0: OUT &H3D4, &HC: OUT &H3D5, 0 CASE 1: OUT &H3D4, &HC: OUT &H3D5, &H4F CASE 2: OUT &H3D4, &HC: OUT &H3D5, &H9E CASE ELSE: ERROR 5 'illegal function call END SELECT END SUB SUB xcls (Page%) SELECT CASE Page% CASE 0: VidSegment% = &HA000 CASE 1: VidSegment% = &HA4F0 CASE 2: VidSegment% = &HA9E0 CASE ELSE: ERROR 5 END SELECT OUT &H3C4, &H2: OUT &H3C5, &HF DEF SEG = VidSegment% FOR Address% = 0 TO 19199: POKE Address%, 0: NEXT END SUB