home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib42b.dsk / FRACTAL.MAGIC.bas < prev    next >
Encoding:
BASIC Source File  |  1990-01-01  |  5.3 KB  |  83 lines
  1. 10  REM ************************
  2. 20  REM * FRACTAL MAGIC        *
  3. 30  REM * BY JOSEPH J. STROUT  *
  4. 40  REM * COPYRIGHT (C) 1992   *
  5. 50  REM * MINDCRAFT PUBL. CORP.*
  6. 60  REM * LINCOLN, MA 01773    *
  7. 70  REM ************************
  8. 80  POKE 768,1: POKE 769,0: POKE 770,4: POKE 771,0: POKE 772,4: POKE 773,0:L = 768: POKE 232,L - INT(L/256) *256: POKE 233, INT(L/256)
  9. 90  DEF  FN RT(X) = X +64 *(X <0) -64 *(X >64)
  10. 100 MN = 2:MX = 50: DIM S(MX),R(MX),C(MX),G(MX)
  11. 110  HGR : HCOLOR= 3
  12. 120  TEXT : PRINT  CHR$(21): HOME : PRINT : INVERSE : POKE 33,20: POKE 32,15: VTAB 1: PRINT : PRINT "=========": PRINT " FRACTAL ": PRINT "  MAGIC  ": PRINT "========="
  13. 130  TEXT : NORMAL : VTAB 6: READ NF: IF NF >8  THEN  PRINT "ONLY 8 FRACTALS ARE ALLOWED": END 
  14. 140  PRINT  TAB( 12)"by Joseph J. Strout": PRINT "Copyright (C) 1992, MindCraft Publishing": PRINT : FOR J = 1 TO NF: READ NM$(J)
  15. 150  DATA  5,"SIERPINSKI'S GASKET","BINARY TREE","SNOWFLAKES"
  16. 160  DATA  "TENTACLE","FERN LEAF"
  17. 170  PRINT  TAB( 10)J". "NM$(J): NEXT : PRINT : PRINT  TAB( 10)"Q. QUIT": VTAB 22: PRINT " SELECT: ";
  18. 180  GET A$: IF A$ = "Q"  OR A$ =  CHR$(113)  THEN  PRINT "QUIT": PRINT : END 
  19. 190  IF A$ <"1"  OR A$ > STR$(NF)  THEN 180
  20. 200 A =  VAL(A$): PRINT A$: CALL  -3086: HGR : HCOLOR= 3: VTAB 21: PRINT  TAB( 20 - LEN(NM$(A))/2)NM$(A): VTAB 22: PRINT "          ": REM  10 SPACES
  21. 210  ON A GOTO 230,320,410,530,620,720,820,830
  22. 220  POKE 49168,0: VTAB 24: PRINT  TAB( 11)"( PRESS ANY KEY )";: WAIT 49152,128: GET A$: RESTORE : GOTO 120
  23. 230  REM **** GASKET ****
  24. 240 MN = 3:MX = 7:L = 0: READ X1(L),Y1(L),X2(L),Y2(L),X3(L),Y3(L): DATA 140,2,20,157,260,157: REM  MAIN TRIANGLE VERTICES
  25. 250  GOSUB 260: GOTO 220: REM  MAIN SUBROUTINE STARTS HERE:
  26. 260  IF X3(L) -X2(L) <MN  OR L = MX  THEN 310
  27. 270  HPLOT X1(L),Y1(L) TO X2(L),Y2(L) TO X3(L),Y3(L) TO X1(L),Y1(L): REM  DRAW 1 TRIANGLE
  28. 280 N = L +1:X1(N) = X1(L):Y1(N) = Y1(L):X2(N) = (X1(L) +X2(L))/2:Y2(N) = (Y1(L) +Y2(L))/2:X3(N) = (X1(L) +X3(L))/2:Y3(N) = (Y1(L) +Y3(L))/2:L = N: GOSUB 260: REM DRAW TOP TRIANGLE
  29. 290 N = L +1:X2(N) = X2(L):Y2(N) = Y2(L):X1(N) = (X1(L) +X2(L))/2:Y1(N) = (Y1(L) +Y2(L))/2:X3(N) = (X2(L) +X3(L))/2:Y3(N) = (Y2(L) +Y3(L))/2:L = N: GOSUB 260: REM DRAW LOWER-LEFT
  30. 300 N = L +1:X3(N) = X3(L):Y3(N) = Y3(L):X1(N) = (X1(L) +X3(L))/2:Y1(N) = (Y1(L) +Y3(L))/2:X2(N) = (X2(L) +X3(L))/2:Y2(N) = (Y2(L) +Y3(L))/2:L = N: GOSUB 260: REM DRAW LOWER-RIGHT
  31. 310 L = L -1: RETURN 
  32. 320  REM **** BINARY TREE ****
  33. 330 MN = 1:MX = 17:L = 0:S(L) = 64:R(L) = 0: SCALE= 1: XDRAW 1 AT 140,178
  34. 340  GOSUB 350: GOTO 220: REM  MAIN SUBROUTINE STARTS HERE:
  35. 350  IF S(L) <MN  OR L = MX  THEN 400
  36. 360  SCALE= S(L): ROT= R(L): DRAW 1: REM  DRAW 1 LINE
  37. 370 N = L +1:R(N) =  FN RT(R(L) +8):S(N) = S(L) *5/8:L = N: GOSUB 350: REM  DRAW RIGHT BRANCH
  38. 380 N = L +1:R(N) =  FN RT(R(L) -8):S(N) = S(L) *5/8:L = N: GOSUB 350: REM  DRAW LEFT BRANCH
  39. 390  ROT=  FN RT(R(L) +32): SCALE= S(L): DRAW 1: REM  RETURN CURSOR TO STARTING POINT
  40. 400 L = L -1: RETURN 
  41. 410  REM **** SNOWFLAKES ****
  42. 420 MN = 2:MX = 9: VTAB 22: PRINT  TAB( 9)"PRESS ANY KEY TO STOP":C = 6
  43. 430 BA =  INT(28 * RND(1) +2):BF =  RND(1)/2 +.25:MF =  RND(1)/2 +.25:MA =  RND(1) *5.3:X =  INT(280 * RND(1)):Y =  INT(118 * RND(1) +16):C = 7 -(C = 7)
  44. 440  HCOLOR= C: FOR J = MA TO 64 +MA  STEP 10.666667:L = 0:S(L) = 16:R(L) = J: SCALE= 1: XDRAW 1 AT X,Y: GOSUB 460: IF  PEEK(49152) <128  THEN  NEXT J: GOTO 430
  45. 450  GOTO 220: REM  MAIN ROUTINE STARTS HERE:
  46. 460  IF S(L) <MN  OR L = MX  OR FLAG = 1  THEN 520
  47. 470 FLAG = ( PEEK(49152) > = 128): SCALE= S(L): ROT= R(L): DRAW 1
  48. 480 N = L +1:R(N) = R(L):S(L +1) = S(L) *MF:L = N: GOSUB 460
  49. 490 N = L +1:R(N) =  FN RT(R(L) +BA):S(N) = S(L) *BF:L = N: GOSUB 460
  50. 500 N = L +1:R(N) =  FN RT(R(L) -BA):S(N) = S(L) *BF:L = N: GOSUB 460
  51. 510  ROT=  FN RT(R(L) +32): SCALE= S(L): DRAW 1
  52. 520 L = L -1: RETURN 
  53. 530  REM **** TENTACLE ****
  54. 540 MN = 1:MX = 35:L = 0:S(L) = 24:R(L) = 0: SCALE= 1: XDRAW 1 AT 80,115
  55. 550 G(L) = 1: GOTO 560: REM  MAIN ROUTINE:
  56. 560  IF S(L) <MN  OR L = MX  THEN 610
  57. 570  SCALE= S(L): ROT= R(L): DRAW 1: REM  DRAW 1 LINE
  58. 580 N = L +1:G(N) = 2:R(N) =  FN RT(R(L) +4):S(N) = S(L) -1:L = N: GOTO 560
  59. 590 N = L +1:G(N) = 3:R(N) =  FN RT(R(L) -8):S(N) = S(L) *5/8:L = N: GOTO 560
  60. 600  ROT=  FN RT(R(L) +32): SCALE= S(L): DRAW 1
  61. 610 L = L -1: ON G(L +1) GOTO 220,590,600
  62. 620  REM **** FERN LEAF ****
  63. 630 MN = 1:MX = 40:L = 0:S(L) = 16:R(L) = 20:C(L) = 0.5: SCALE= 12: ROT= R(L): DRAW 1 AT 10,75
  64. 640 G(L) = 1: GOTO 650: REM  MAIN ROUTINE:
  65. 650 K =   NOT K: IF S(L) <MN  OR L = MX  THEN 710
  66. 660  SCALE= S(L): ROT= R(L): DRAW 1: REM  DRAW 1 LINE
  67. 670 N = L +1:G(N) = 2:R(N) =  FN RT(R(L) -C(L)):S(N) = S(L) -.5:C(N) = C(L):L = N: GOTO 650
  68. 680  ROT=  FN RT(R(L) +32): SCALE= S(L): DRAW 1: REM  RETURN CURSOR TO BASE
  69. 690 N = L +1:G(N) = 3:S(N) = S(L)/2: IF K  THEN R(N) =  FN RT(R(N) -8):C(N) =  -0.5:L = N: GOTO 650
  70. 700 R(N) =  FN RT(R(N) +6):C(N) = 0.5:L = N: GOTO 650
  71. 710 L = L -1: ON G(L +1) GOTO 220,680,710
  72. 720  REM FRACTAL #6 -- CREATE YOUR OWN!
  73. 730  REM  SET UP VARIABLES
  74. 740  REM   MAIN ROUTINE: 750-810
  75. 750  REM   CHECK SIZE AND LEVEL; EXIT IF NEEDED
  76. 760  REM   DRAW 1 LINE OR FIGURE
  77. 770  REM   G(N)=2: FIGURE VARIABLES; GOTO 1030
  78. 780  REM   G(N)=3: REPEAT FOR SECOND BRANCH (OR WHATEVER)
  79. 790  REM   G(N)=4: ONLY FOR A THIRD BRANCH OR FIGURE
  80. 800  REM   IF USING DRAW (NOT HPLOT), RETURN CURSOR TO STARTING POINT
  81. 810 L = L -1: ON G(L +1) GOTO 220,780,790,800: STOP 
  82. 820  REM FRACTAL #7
  83. 830  REM FRACTAL #8