home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib33b.dsk / TREES.bas < prev    next >
BASIC Source File  |  2023-02-26  |  7KB  |  115 lines
  1. 10  REM  ***********************
  2. 20  REM  *      TREES          *
  3. 30  REM  *  BY JOHN RATCLIFF   *
  4. 40  REM  * COPYRIGHT (C)  1988 *
  5. 50  REM  * BY MICROSPARC, INC. *
  6. 60  REM  * CONCORD, MA.  01742 *
  7. 70  REM  ***********************
  8. 80  IF  PEEK(104) < >64  THEN  POKE 104,64: POKE 16384,0: PRINT "RELOCATING PROGRAM IN UPPER MEMORY....": PRINT  CHR$(4)"RUN TREES"
  9. 90 N = 399: DIM X(N),Y(N),TH(N),TK(N),L(N),TL(N),FL(N)
  10. 100 X(0) =  RND(1) *30 +100:Y(0) = 191:TH(0) = 0:L(0) = 1: ONERR  GOTO 580
  11. 110  GOSUB 1060:V = 1:GB = 0
  12. 120 G$ = "HOW THICK IS THE TREE TRUNK":A = 10:B = 100: GOSUB 520:TK(0) = R
  13. 130 G$ = "HOW MUCH DO THE BRANCHES CURVE":A = 0:B = 100: GOSUB 520:CV = R/50
  14. 140  ON   NOT CV GOTO 150:G$ = "WHAT DISTANCE TO ALTER BRANCH":A = 1:B = 20: GOSUB 520:GB = (21 -R)/20
  15. 150 G$ = "HOW OFTEN NEW BRANCHES SPROUT":A = 5:B = 50: GOSUB 520:NB = R
  16. 160 G$ = "LENGTH TO BEGIN NEW BRANCH":A = 50:B = 250: GOSUB 520:LN = R
  17. 170  GOSUB 600: ON G$ = "N" GOTO 110
  18. 180  GOSUB 470
  19. 190  HOME : PRINT : PRINT "TREE GENERATION PROGRAM DEVELOPED"
  20. 200  PRINT "AND WRITTEN BY JOHN W. RATCLIFF": PRINT 
  21. 210  PRINT "TREE SPECIFICATION IS:": PRINT : GOSUB 710
  22. 220  PRINT : PRINT "1. PRESS RETURN TO BEGIN."
  23. 230  PRINT "2. WHILE THE TREE IS DRAWING PRESS:"
  24. 240  PRINT "   SPACE TO START NEW BRANCH;
  25. 250  PRINT "   RETURN TO TOGGLE THE TEXT WINDOW;": PRINT "   Q TO QUIT PROGRAM."
  26. 260  PRINT : PRINT "   ** NOTE ** LEAVING THE TEXT WINDOW ON";: HTAB 15: PRINT "SLOWS DOWN THE PROGRAM."
  27. 270  GET G$: PRINT G$: HOME : PRINT "INITIALIZING LINKED LIST...."
  28. 280  ONERR  GOTO 420
  29. 290  FOR J = 0 TO N -1:FL(J) = J +1: NEXT :FL = 1:FC = N
  30. 300 BC = 1:BL = 0:J = BL:BE = 1:NN = 1
  31. 310  HOME : HCOLOR= 3: HGR : POKE  -16302,0
  32. 320  VTAB (23): PRINT "PRESS Q TO QUIT: SPACE TO BRANCH": PRINT "RETURN TO TOGGLE TEXT";
  33. 330 X = X(J):Y = Y(J):R = TK(J):T = TH(J): ON TX GOSUB 820: ON  PEEK( -16384) >128 GOSUB 830
  34. 340  ON R <.5 GOTO 420:A =  COS(T):B =  SIN(T)
  35. 350 X2 = X + ABS(R *A):Y2 = Y - ABS(R *B): HPLOT X,Y TO X2,Y2:X(J) = X +B * SGN(A):Y(J) = Y - ABS(A):TK(J) = R -(R/80):L(J) = L(J) +1
  36. 360  ON  RND(1) >GB GOTO 370:TH(J) = TH(J) +1/TK(J) * RND(1) *CV *( -1 +2 *( RND(1) >.5))
  37. 370  ON L(J)/LN =  INT(L(J)/LN) GOTO 410: ON  INT( RND(1) *NB) +1 < >NB  OR   NOT FC GOTO 330
  38. 380 X(FL) = X(J):Y(FL) = Y(J):TK(FL) = (.5 + RND(1)/2) *TK(J):TH(FL) = TH(J) +TK(FL)/TK(J) *(1 -2 * RND(1)):L(FL) = 0
  39. 390 BC = BC +1:FC = FC -1: ON RD GOTO 400:G = FL(J):A = FL(FL):FL(J) = FL:FL(FL) = G:FL = A: GOTO 330
  40. 400 G = FL(BE):A = FL(FL):FL(BE) = FL:FL(FL) = G:BE = FL:FL = A: GOTO 330
  41. 410 J = FL(J): GOTO 330
  42. 420  CALL  -3288:FC = FC +1:BL = FL(J):G = FL:FL = J:FL(J) = G:BC = BC -1:J = BL:NN = NN +1: ON BC >0 GOTO 330
  43. 430  TEXT : HOME : PRINT "ALL BRANCHES WERE PROCESSED":EX = 0
  44. 440  PRINT : PRINT "1. VIEW TREE": PRINT "2. SAVE TREE AND EXIT": PRINT "3. EXIT": IF EX  THEN  PRINT "4. RESUME DRAWING TREE."
  45. 450  VTAB (8): GET G$: ON G$ < >"1"  AND G$ < >"2"  AND G$ < >"3"  AND   NOT (G$ = "4"  AND EX) GOTO 450: IF G$ = "1"  THEN  POKE  -16304,0: POKE  -16302,0: GET G$: TEXT : GOTO 450
  46. 460  ON G$ = "4" GOTO 870: ON G$ = "2" GOSUB 550: HOME : PRINT "FINISHED.": END 
  47. 470  HOME : PRINT "DO YOU WISH THE TREE TO DRAW IN:"
  48. 480  PRINT : PRINT "1. FORWARD ORDER"
  49. 490  PRINT "2. REVERSE ORDER"
  50. 500  GET G$: ON G$ < >"1"  AND G$ < >"2" GOTO 500
  51. 510  PRINT G$:RD = (G$ = "1"): RETURN 
  52. 520  FOR J = V TO 23: HTAB 1: VTAB J: PRINT  SPC( 40);: NEXT : HTAB 1: VTAB V: PRINT G$" ";: INVERSE : PRINT "("A"-"B")?";: NORMAL : PRINT 
  53. 530  INPUT "ENTER VALUE->";R$:R =  VAL(R$): ON R <A  OR R >B  OR  LEFT$(R$,1) <"0"  OR  LEFT$(R$,1) >"9" GOTO 520
  54. 540 V = V +3: RETURN 
  55. 550  ONERR  GOTO 580
  56. 560  HOME : PRINT : PRINT "YOUR TREE WILL BE SAVED IN PICTURE": PRINT "FORMAT AS PIC.TREE": PRINT : PRINT "INSERT DISK TO SAVE ON AND PRESS RETURN."
  57. 570  GET G$: PRINT : PRINT "SAVING...": PRINT  CHR$(4)"BSAVE PIC.TREE,A$2000,L$2000": RETURN 
  58. 580  POKE 216,0: CALL  -3288: GOSUB 760: GOSUB 710: PRINT "PRESS (1) TO TRY AGAIN OR (2) TO EXIT"
  59. 590  CALL  -3288: GET G$: ON G$ < >"1"  AND G$ < >"2" GOTO 590: ON G$ = "1" GOTO 560: RETURN 
  60. 600 G =  FRE(0): RESTORE : HOME : PRINT "TREE SELECTION IS:": PRINT :M$ = "YOU SELECTED A TREE WITH A "
  61. 610 G = TK(0): GOSUB 690:M$ = M$ +F$ +" TREE TRUNK AND ": IF   NOT CV  THEN M$ = M$ +" COMPLETELY STRAIGHT BRANCHES"
  62. 620 G = CV: GOSUB 690: IF CV >0  THEN M$ = M$ +F$ +" BRANCHES"
  63. 630 G = GB: GOSUB 690: IF CV >0  THEN M$ = M$ +" WHICH CHANGE DIRECTION " +F$
  64. 640 G = NB: GOSUB 690:M$ = M$ +". BRANCHES ARE " +F$ +" AND GROW FOR A LENGTH OF " + STR$(LN) +" UNITS BEFORE STARTING A NEW ONE."
  65. 650  GOSUB 710
  66. 660  PRINT : PRINT "IS THIS TREE OKAY (Y/N)?";
  67. 670  GET G$:G =  ASC(G$):G$ =  CHR$(G -32 *(G >95)): ON G$ < >"Y"  AND G$ < >"N" GOTO 670: PRINT G$
  68. 680  RETURN 
  69. 690 F = 0: READ R: FOR J = 1 TO R: READ G$,A,B: IF G > = A  AND G <B  AND   NOT F  THEN F = J:F$ = G$
  70. 700  NEXT : RETURN 
  71. 710 SK = 0:K = 39:EK =  LEN(M$)
  72. 720  IF  MID$ (M$,K,1) < >" "  THEN K = K -1: GOTO 720
  73. 730  PRINT  MID$ (M$,SK +1,K -SK):SK = K:K = K +39: IF K <EK  THEN 720
  74. 740  PRINT  MID$ (M$,SK +1,EK -SK)
  75. 750  RETURN 
  76. 760 ER =  PEEK(222): IF ER = 8  THEN M$ = "AN I/O ERROR OCCURRED.  MAKE CERTAIN THAT YOUR DISK IS INSERTED IN THE DRIVE CORRECTLY AND THE DRIVE DOOR IS CLOSED.": GOTO 800
  77. 770  IF ER = 6  AND  PEEK(48896) = 76  THEN  PRINT  CHR$(4)"PREFIX": INPUT PF$:M$ = "PATH NOT FOUND. PLEASE INSERT A DISK WITH THE PREFIX " +PF$: GOTO 800
  78. 780  IF ER = 9  THEN M$ = "YOUR DISK IS FULL.  PLEASE INSERT A DISK THAT HAS ENOUGH ROOM TO SAVE A PICTURE FILE.": GOTO 800
  79. 790  HOME : TEXT : PRINT "UNEXPECTED ERROR NO. "ER" HAS OCCURRED": PRINT "IN LINE " PEEK(218) +256 * PEEK(219): END 
  80. 800  ONERR  GOTO 580
  81. 810  RETURN 
  82. 820  POKE 36,0: VTAB (21): PRINT "X=" INT(X)" Y=" INT(Y)" ANGLE=" INT((T *180)/3.14159)" THICK=" INT(R +.5)"       ": PRINT "BRANCH#:"NN" FREE:"FC" USED:"BC"   ": RETURN : REM 7,3 SPACES
  83. 830 G =  PEEK( -16384) -128: POKE  -16368,0: IF G < >32  AND G < >81  AND G < >113  THEN TX =   NOT TX: POKE  -16302 +TX,0: GOTO 860: REM  RETURN OR OTHER KEY
  84. 840  IF G = 81  OR G = 113  THEN  TEXT : HOME : PRINT : PRINT "FINISHED DRAWING YOUR TREE.":EX = 1: GOTO 440: REM  Q PRESSED
  85. 850 :FC = FC +1:BL = FL(J):G = FL:FL = J:FL(J) = G:BC = BC -1:J = BL:NN = NN +1: REM  SPACE PRESSED FOR NEW BRANCH
  86. 860  RETURN 
  87. 870  POKE  -16304,0: VTAB 23: PRINT "PRESS Q TO QUIT EARLY": RETURN 
  88. 880  DATA  3
  89. 890  DATA  "THIN",10,39
  90. 900  DATA  "MODERATE",40,60
  91. 910  DATA  "THICK",60,101
  92. 920  DATA  5
  93. 930  DATA  "STRAIGHT",0,0
  94. 940  DATA  "SLIGHTLY CURVING",0,.2
  95. 950  DATA  "MODERATELY CURVING",.2,.5
  96. 960  DATA  "VERY CURVY",.5,1
  97. 970  DATA  "WILDLY CURVING",1,2.1
  98. 980  DATA  3
  99. 990  DATA  "FREQUENTLY",.5,1.1
  100. 1000  DATA  "OFTEN",.2,.5
  101. 1010  DATA  "AFTER FOLLOWING THE SAME COURSE FOR A WHILE",0,.2
  102. 1020  DATA  3
  103. 1030  DATA  "VERY CLOSE TOGETHER",5,15
  104. 1040  DATA  "MODERATELY SPACED",15,30
  105. 1050  DATA  "SPREAD WIDELY APART",30,51
  106. 1060  TEXT : PRINT  CHR$(17);: HOME 
  107. 1070  INVERSE : VTAB 24: PRINT  SPC( 40)
  108. 1080  VTAB 1: HTAB 1: PRINT  SPC( 40)
  109. 1090  FOR X = 2 TO 23
  110. 1100  VTAB X: HTAB 1: PRINT " ";: HTAB 40: PRINT " ";: NEXT X
  111. 1110  NORMAL : VTAB 5
  112. 1120  HTAB 16: PRINT "T R E E S": PRINT 
  113. 1130  HTAB 12: PRINT "BY JOHN W. RATCLIFF": PRINT : HTAB 4: PRINT "COPYRIGHT 1988 BY MICROSPARC INC."
  114. 1140  VTAB 21: HTAB 8: PRINT "PRESS RETURN TO CONTINUE";
  115. 1150  GET G$: PRINT : HOME : RETURN