home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / BASIC / ANIBAS / ANI.BAS next >
BASIC Source File  |  1993-12-01  |  21KB  |  651 lines
  1. '$DYNAMIC
  2. DEFINT A-Z
  3. DECLARE SUB Alert ()
  4. DECLARE SUB Plot12 ()
  5. DECLARE SUB Plot9 ()
  6. DECLARE SUB Calculate ()
  7. DECLARE SUB DefaultChoices ()
  8. DECLARE SUB Influences ()
  9. DECLARE SUB Plot ()
  10. DECLARE SUB Menu ()
  11. DECLARE SUB TestScreens ()
  12. DECLARE SUB TitleScreen ()
  13. DECLARE SUB Mcenter (LineNumber, Message$)
  14. DECLARE SUB Parameters ()
  15. DECLARE SUB SetUpScreen ()
  16.  
  17. CONST True = -1, False = NOT True
  18. CONST Gravity = 0, Tornado = 1, LGravity = 2
  19. CONST None = 0, Normal = 1, Special = 2, Shades = 3
  20. CONST Animated = 0, SingleFrame = 1
  21. CONST Pi = 1.570796
  22.  
  23. DIM SHARED Enter$, Escape$, UpArrow$, DownArrow$, LeftArrow$, RightArrow$
  24. Enter$ = CHR$(13)
  25. Escape$ = CHR$(27)
  26. UpArrow$ = CHR$(0) + CHR$(72)
  27. DownArrow$ = CHR$(0) + CHR$(80)
  28. LeftArrow$ = CHR$(0) + CHR$(75)
  29. RightArrow$ = CHR$(0) + CHR$(77)
  30.  
  31.  
  32.  
  33. REDIM SHARED Points9x(7, 70, 50), Points9y(7, 70, 50)
  34. REDIM SHARED Points12x(130, 100), Points12y(130, 100)
  35. DIM SHARED Infx(10), Infy(10), Infd(10), Direction(10) AS SINGLE, Typ(10)
  36. DIM SHARED Xstep, Ystep, MaxAng AS SINGLE, NumInf
  37. DIM SHARED MaxX, MaxY, ScreenMode
  38. DIM SHARED Screen9, Screen12
  39. DIM SHARED NumOpts, Options$(6), NumChoices(6), Choices$(6, 18)
  40. DIM SHARED Choice(6)
  41. DIM SHARED Ma, Mb
  42.  
  43.  
  44. READ NumOpts
  45. FOR A = 1 TO NumOpts
  46.     READ Options$(A), NumChoices(A)
  47.     FOR B = 1 TO NumChoices(A)
  48.         READ Choices$(A, B)
  49.     NEXT
  50. NEXT
  51. TimeDelay = 2000
  52. DefaultChoices
  53.  
  54. TestScreens
  55. IF NOT Screen9 AND NOT Screen12 THEN
  56.     PRINT "Sorry, EGA or VGA required!"
  57.     END
  58. END IF
  59. TitleScreen
  60. Menu
  61. CLS
  62. COLOR 15
  63. PRINT "Zeek thanks you very much for choosing his program."
  64. COLOR 7
  65. END
  66.  
  67. BadScreenMode:
  68.     BadScreen = False
  69. RESUME NEXT
  70.  
  71. DATA 6
  72. DATA "X Step",4,"5","10","15","20"
  73. DATA "Y Step",3,"5","10","20"
  74. DATA "Maximum Angle of Rotation", 18,"10","20","30","40","50","60","70","80","90","100","110","120","130","140","150","160","170","180"
  75. DATA "Type of Display",2,"Animated","High Resolution"
  76. DATA "Type of Filling",4,"None(Fastest)","Normal(Fast)","Special(Slow)","Shades(Fast)"
  77. DATA "Type of Gravity",2,"Normal(Slow)","Linear(Fast)"
  78.  
  79. REM $STATIC
  80. SUB Alert
  81.     PLAY "t240l15mbo4fp8fp8fp8"
  82. END SUB
  83.  
  84. SUB Calculate
  85.  
  86.     Xstep = Choice(1) * 5
  87.    
  88.     SELECT CASE Choice(2)
  89.     CASE 1
  90.         Ystep = 5
  91.     CASE 2
  92.         Ystep = 10
  93.     CASE 3
  94.         Ystep = 20
  95.     END SELECT
  96.     MaxAng = (Choice(3) * 10) / 90 * Pi
  97.    
  98.     IF Choice(4) = 1 THEN
  99.         MaxScreen = 7: MaxX = 319: MaxY = 199
  100.     ELSE
  101.         MaxScreen = 0: MaxX = 639: MaxY = 479
  102.         FOR A = 0 TO NumInf
  103.             Infx(A) = Infx(A) * 2
  104.             Infy(A) = Infy(A) * 2.4
  105.             Infd(A) = Infd(A) * 2
  106.         NEXT
  107.     END IF
  108.  
  109.  
  110.  
  111.     SetUpScreen
  112.     Mcenter 25, "Press ESC to Abort"
  113.     COLOR 14 + 16
  114.     Mcenter 3, "Please Wait:Calculating..."
  115.     COLOR 15
  116.     MRows = INT(MaxX / Xstep + 3)
  117.     FOR Sc = 0 TO MaxScreen
  118.         OffsetX = Sc * ((Xstep - (Xstep / 7)) / 7)
  119.         OffsetY = Sc * ((Ystep - (Ystep / 7)) / 7)
  120.  
  121.         A = 0: B = 0
  122.         FOR Xw = -Xstep TO MaxX + 1 STEP Xstep
  123.             FOR Yw = -Ystep TO MaxY + Ystep STEP Ystep
  124.                 Xoffset = 0: Yoffset = 0: X = Xw + OffsetX: Y = Yw + OffsetY
  125.           
  126.                 FOR An = 0 TO NumInf - 1
  127.                     Xd! = X - Infx(An)
  128.                     Yd! = Y - Infy(An)
  129.                     Distance! = SQR(Xd! * Xd! + Yd! * Yd!)
  130.                     IF Distance! < Infd(An) THEN
  131.                         IF Typ(An) = Gravity THEN
  132.                             IF Choice(6) = 1 THEN
  133.                                 Dx = Infx(An) - X
  134.                                 Xoffset = Xoffset + (Direction(An) * (Dx - Dx * SIN(Pi * Distance! / Infd(An))))
  135.                                 Dy = Infy(An) - Y
  136.                                 Yoffset = Yoffset + (Direction(An) * (Dy - Dy * SIN(Pi * Distance! / Infd(An))))
  137.                             ELSE
  138.                                 Df! = (Infd(An) - Distance!) / Infd(An)
  139.                                 Xoffset = Xoffset + Direction(An) * (Infx(An) - X) * Df!
  140.                                 Yoffset = Yoffset + Direction(An) * (Infy(An) - Y) * Df!
  141.                             END IF
  142.                         ELSE
  143.                            
  144.                            
  145.                             Ag! = Direction(An) * MaxAng * (1 - COS(Pi * (Infd(An) - Distance!) / Infd(An)))
  146.                             Xoffset = Xoffset + Xd! * COS(Ag!) - Yd! * SIN(Ag!) + Infx(An) - X
  147.                             Yoffset = Yoffset + Xd! * SIN(Ag!) + Yd! * COS(Ag!) + Infy(An) - Y
  148.                         END IF
  149.                     END IF
  150.                 NEXT
  151.  
  152.                 IF Choice(4) = 1 THEN
  153.                     Points9x(Sc, A, B) = X + Xoffset
  154.                     Points9y(Sc, A, B) = Y + Yoffset
  155.                 ELSE
  156.                     Points12x(A, B) = X + Xoffset
  157.                     Points12y(A, B) = Y + Yoffset
  158.                 END IF
  159.                 B = B + 1
  160.             NEXT
  161.             A$ = INKEY$
  162.             IF A$ = Escape$ THEN EXIT SUB
  163.            
  164.             Mb = B
  165.             B = 0: A = A + 1
  166.             A$ = "Screen " + MID$(STR$(Sc + 1), 2) + " of " + MID$(STR$(MaxScreen + 1), 2) + " is " + MID$(STR$(INT(A / MRows * 100 + .5)), 2) + "% complete.  "
  167.             LOCATE 12, 1: PRINT SPACE$(80)
  168.             Mcenter 12, A$
  169.         NEXT
  170.         Ma = A
  171.     NEXT
  172.     Plot
  173.  
  174. END SUB
  175.  
  176. SUB DefaultChoices
  177.     Choice(1) = 2
  178.     Choice(2) = 2
  179.     Choice(3) = 9
  180.     Choice(4) = 1
  181.     Choice(5) = 2
  182.     Choice(6) = 1
  183. END SUB
  184.  
  185. SUB Influences
  186.     SetUpScreen
  187.     Mcenter 3, "Keys Used for Chosing Influences"
  188.     Mcenter 25, "Press any key to continue..."
  189.     COLOR 15
  190.     Mcenter 6, "Use Arrow Keys to Choose the Center of the Influence, then:"
  191.     Mcenter 8, "Press U for Upward Influence"
  192.     Mcenter 10, "Press D for Downward Influence"
  193.     Mcenter 12, "Press L for Left Tornado"
  194.     Mcenter 14, "Press R for Right Tornado"
  195.     Mcenter 16, "After the Type is Selected, Use the Arrow Keys to"
  196.     Mcenter 18, "Adjust the Size of the Blip and Then Press the Spacebar"
  197.     Mcenter 20, "Press Enter When All of the Influences Have Been Selected, or"
  198.     Mcenter 22, "Press ESC At Any Time for the Main Menu"
  199.     A$ = INPUT$(1)
  200.     IF A$ = Escape$ THEN EXIT SUB
  201.     SCREEN 7, , 0, 0
  202.     NumInf = 0
  203.     Xloc = 160
  204.     Yloc = 100
  205.     DO
  206.         DO
  207.             PCOPY 0, 1
  208.             DRAW "C14BM" + STR$(Xloc) + "," + STR$(Yloc) + ";bu1nu3bd2nd3bu1bl1nl3br2r3C15"
  209.             DO
  210.                 GOSUB GetKey
  211.                 IF A$ = " " THEN
  212.                     Alert
  213.                 END IF
  214.             LOOP WHILE A$ = " "
  215.             PCOPY 1, 0
  216.             IF A$ = Enter$ OR A$ = Escape$ THEN EXIT SUB
  217.         LOOP UNTIL INSTR("UDLR", A$) <> 0
  218.         Infx(NumInf) = Xloc
  219.         Infy(NumInf) = Yloc
  220.         IF A$ = "U" OR A$ = "D" THEN
  221.             Typ(NumInf) = Gravity
  222.             IF A$ = "D" THEN
  223.                 Direction(NumInf) = 1
  224.             ELSE
  225.                 Direction(NumInf) = -1
  226.             END IF
  227.         ELSE
  228.             Typ(NumInf) = Tornado
  229.             IF A$ = "L" THEN
  230.                 Direction(NumInf) = 1
  231.             ELSE
  232.                 Direction(NumInf) = -1
  233.             END IF
  234.         END IF
  235.         DO
  236.             PCOPY 0, 1
  237.             DRAW "BM" + STR$(Xloc) + "," + STR$(Yloc) + ";bu1nu3bd2nd3bu1bl1nl3br2r3"
  238.             Distance = SQR(ABS(Infx(NumInf) - Xloc) ^ 2 + ABS(Infy(NumInf) - Yloc) ^ 2)
  239.             CIRCLE (Infx(NumInf), Infy(NumInf)), Distance
  240.             DO
  241.                 GOSUB GetKey
  242.                 IF A$ = Enter$ THEN A$ = " "
  243.                 IF INSTR("UDLR", A$) <> 0 THEN
  244.                     Alert
  245.                 END IF
  246.             LOOP WHILE INSTR("UDLR", A$) <> 0
  247.             PCOPY 1, 0
  248.         LOOP UNTIL A$ = " " OR A$ = Escape$
  249.         IF A$ <> Escape$ THEN
  250.             Infd(NumInf) = Distance
  251.             CIRCLE (Infx(NumInf), Infy(NumInf)), Distance
  252.             PCOPY 0, 1
  253.             NumInf = NumInf + 1
  254.             IF NumInf = 11 THEN EXIT SUB
  255.         END IF
  256.         
  257.     LOOP
  258.  
  259.  
  260.  
  261.  
  262.  
  263. GetKey:
  264.     DO
  265.         DO
  266.             A$ = INKEY$
  267.         LOOP UNTIL A$ <> ""
  268.         A$ = UCASE$(A$)
  269.         Bad = False
  270.         SELECT CASE A$
  271.         CASE LeftArrow$
  272.             Xloc = Xloc - 5
  273.             IF Xloc < 0 THEN Xloc = 319
  274.         CASE RightArrow$
  275.             Xloc = Xloc + 5
  276.             IF Xloc > 319 THEN Xloc = 0
  277.         CASE DownArrow$
  278.             Yloc = Yloc + 5
  279.             IF Yloc > 199 THEN Yloc = 0
  280.         CASE UpArrow$
  281.             Yloc = Yloc - 5
  282.             IF Yloc < 0 THEN Yloc = 199
  283.         CASE " ", "U", "D", "L", "R", Enter$, Escape$
  284.         CASE ELSE
  285.             Alert
  286.             Bad = True
  287.         END SELECT
  288.     LOOP WHILE Bad
  289. RETURN
  290. END SUB
  291.  
  292. SUB Mcenter (LineNumber, Message$)
  293.     LOCATE LineNumber, INT((80 - LEN(Message$)) / 2)
  294.     PRINT Message$;
  295. END SUB
  296.  
  297. SUB Menu
  298.     DO
  299.         SetUpScreen
  300.         Mcenter 3, "Main Menu"
  301.         Mcenter 25, "Please select an option, or press ESC to quit."
  302.         COLOR 15
  303.         Yloc = 10
  304.         Mcenter Yloc, "1. Adjust Parameters"
  305.         Mcenter Yloc + 2, "2. Select Influences"
  306.         Mcenter Yloc + 4, "3. Calculate and Plot Screen(s)"
  307.         DO
  308.             DO
  309.                 A$ = INKEY$
  310.             LOOP UNTIL A$ <> ""
  311.             SELECT CASE A$
  312.             CASE "1"
  313.                 Parameters
  314.                 EXIT DO
  315.             CASE "2"
  316.                 Influences
  317.                 EXIT DO
  318.             CASE "3"
  319.                 Calculate
  320.                 EXIT DO
  321.             CASE Escape$
  322.                 EXIT SUB
  323.             CASE ELSE
  324.                 Alert
  325.             END SELECT
  326.         LOOP
  327.     LOOP
  328.  
  329.  
  330. END SUB
  331.  
  332. SUB Parameters STATIC
  333.     DIM StartTime AS SINGLE
  334.     SetUpScreen
  335.     Mcenter 3, "Parameter Adjust Menu"
  336.     Mcenter 23, "Use Arrow Keys and Space Bar to Change Choices"
  337.     Mcenter 24, "Press D for the Default Choices"
  338.     Mcenter 25, "Press ESC to Return to the Main Menu"
  339.     Xloc = 8
  340.     Yloc = 6
  341.     FOR A = 1 TO NumOpts
  342.         LOCATE Yloc + (A - 1) * 2, Xloc
  343.         PRINT Options$(A);
  344.         PRINT STRING$(50 - POS(0), "."); "["; SPACE$(17); "]"
  345.     NEXT
  346.     COLOR 15
  347.     IF FirstTime = 0 THEN
  348.         CurrentChoice = 1
  349.         FirstTime = 1
  350.     END IF
  351.     DO
  352.         GOSUB UpdateChoices
  353.         CurrentLine = Yloc + (CurrentChoice - 1) * 2
  354.         DO
  355.             LOCATE CurrentLine, 51 + ((17 - LEN(Choices$(CurrentChoice, Choice(CurrentChoice)))) / 2)
  356.             PRINT Choices$(CurrentChoice, Choice(CurrentChoice));
  357.            
  358.             GOSUB ShortPause
  359.             IF A$ = "" THEN
  360.                 LOCATE CurrentLine, 51
  361.                 PRINT SPACE$(17)
  362.                 GOSUB ShortPause
  363.             END IF
  364.         LOOP UNTIL A$ <> ""
  365.         A$ = UCASE$(A$)
  366.         SELECT CASE A$
  367.         CASE "D"
  368.             DefaultChoices
  369.         CASE Escape$, Enter$
  370.             EXIT SUB
  371.         CASE UpArrow$
  372.             CurrentChoice = CurrentChoice - 1
  373.             IF CurrentChoice < 1 THEN CurrentChoice = NumOpts
  374.         CASE DownArrow$
  375.             CurrentChoice = CurrentChoice + 1
  376.             IF CurrentChoice > NumOpts THEN CurrentChoice = 1
  377.         CASE " "
  378.             Choice(CurrentChoice) = Choice(CurrentChoice) + 1
  379.             IF Choice(CurrentChoice) > NumChoices(CurrentChoice) THEN
  380.                 Choice(CurrentChoice) = 1
  381.             END IF
  382.             IF CurrentChoice = 5 AND Choice(5) = 4 AND Choice(4) = 2 THEN
  383.                 Choice(2) = 1
  384.             END IF
  385.             IF CurrentChoice = 4 THEN
  386.                 NumInf = 0
  387.             END IF
  388.         CASE ELSE
  389.             Alert
  390.         END SELECT
  391.         IF NOT Screen12 THEN
  392.             IF Choice(4) = 2 THEN
  393.                 Choice(4) = 1
  394.             END IF
  395.         END IF
  396.         IF Choice(4) = 1 AND Choice(5) = 4 THEN
  397.             Choice(5) = 1
  398.         END IF
  399.  
  400.     LOOP
  401.  
  402.  
  403.  
  404.     END
  405.         
  406. UpdateChoices:
  407.     FOR A = 1 TO NumOpts
  408.         LOCATE Yloc + (A - 1) * 2, 51: PRINT SPACE$(17);
  409.         LOCATE Yloc + (A - 1) * 2, 51 + ((17 - LEN(Choices$(A, Choice(A)))) / 2)
  410.         PRINT Choices$(A, Choice(A));
  411.     NEXT
  412. RETURN
  413. ShortPause:
  414.     StartTime = TIMER
  415.     DO
  416.         A$ = INKEY$
  417.     LOOP UNTIL TIMER - StartTime > .2 OR A$ <> ""
  418. RETURN
  419. END SUB
  420.  
  421. SUB Plot
  422.     IF Choice(4) = 1 THEN
  423.         Plot9
  424.     ELSE
  425.         Plot12
  426.     END IF
  427.  
  428. END SUB
  429.  
  430. SUB Plot12
  431.     SetUpScreen
  432.     SCREEN 12, , 0, 0
  433.     IF Choice(5) = 4 THEN
  434.         C1 = 0: Direction = 1
  435.         FOR A = 0 TO 15
  436.             PALETTE A, A * 4.2
  437.         NEXT
  438.     END IF
  439.     FOR B = 0 TO Mb - 1
  440.         FOR A = 0 TO Ma - 2
  441.             LINE (Points12x(A, B), Points12y(A, B))-(Points12x(A + 1, B), Points12y(A + 1, B)), 14
  442.         NEXT
  443.     NEXT
  444.     FOR A = 0 TO Ma - 1
  445.         FOR B = 0 TO Mb - 2
  446.             LINE (Points12x(A, B), Points12y(A, B))-(Points12x(A, B + 1), Points12y(A, B + 1)), 14
  447.         NEXT
  448.     NEXT
  449.     C = 0
  450.     IF Choice(5) <> 1 THEN
  451.         FOR A = 0 TO Ma - 2
  452.             FOR B = 0 TO Mb - 2
  453.                 IF Choice(5) = 4 THEN
  454.                     Xc = INT(.5 + (Points12x(A, B) + Points12x(A + 1, B) + Points12x(A + 1, B + 1) + Points12x(A, B + 1)) / 4)
  455.                     Yc = INT(.5 + (Points12y(A, B) + Points12y(A + 1, B) + Points12y(A + 1, B + 1) + Points12y(A, B + 1)) / 4)
  456.                     IF Xc < 0 THEN Xc = 0 ELSE IF Xc > 639 THEN Xc = 630
  457.                     IF Yc < 0 THEN Yc = 0 ELSE IF Yc > 479 THEN Yc = 479
  458.                     PAINT (Xc, Yc), C1, 14
  459.                     C1 = C1 + Direction: IF C1 < 0 OR C1 > 15 THEN Direction = -Direction: C1 = C1 + Direction
  460.                 END IF
  461.                 IF Choice(5) = 2 AND C THEN
  462.                     Xc = INT(.5 + (Points12x(A, B) + Points12x(A + 1, B) + Points12x(A + 1, B + 1) + Points12x(A, B + 1)) / 4)
  463.                     Yc = INT(.5 + (Points12y(A, B) + Points12y(A + 1, B) + Points12y(A + 1, B + 1) + Points12y(A, B + 1)) / 4)
  464.                     IF Xc < 0 THEN Xc = 0 ELSE IF Xc > 639 THEN Xc = 630
  465.                     IF Yc < 0 THEN Yc = 0 ELSE IF Yc > 479 THEN Yc = 479
  466.                     PAINT (Xc, Yc), 14, 14
  467.                 END IF
  468.                 IF Choice(5) = 3 AND C THEN
  469.                     Fdx = Points12x(A + 1, B) - Points12x(A, B)
  470.                     Fdy = Points12y(A + 1, B) - Points12y(A, B)
  471.                     Sdx = Points12x(A + 1, B + 1) - Points12x(A, B + 1)
  472.                     Sdy = Points12y(A + 1, B + 1) - Points12y(A, B + 1)
  473.                     P = SQR(CLNG(Fdx) * CLNG(Fdx) + CLNG(Fdy) * CLNG(Fdy))
  474.                     P1 = SQR(CLNG(Sdx) * CLNG(Sdx) + CLNG(Sdy) * CLNG(Sdy))
  475.                     IF P1 > P THEN P = P1
  476.                     IF P <> 0 THEN
  477.                         FOR Al! = 0 TO 1 STEP 1 / P
  478.                             Xs = Points12x(A, B) + Fdx * Al!
  479.                             Ys = Points12y(A, B) + Fdy * Al!
  480.                             Xe = Points12x(A, B + 1) + Sdx * Al!
  481.                             Ye = Points12y(A, B + 1) + Sdy * Al!
  482.                             Xd = Xe - Xs
  483.                             Yd = Ye - Ys
  484.                             Da = SQR(Xd * Xd + Yd * Yd)
  485.                             IF Da <> 0 THEN
  486.                                 FOR Al1! = 0 TO 1 STEP 1 / Da
  487.                                     LINE (Xs + Xd * Al1!, Ys + Yd * Al1!)-STEP(1, 1), 14, BF
  488.                                 NEXT
  489.                             END IF
  490.                         NEXT
  491.                     END IF
  492.                 END IF
  493.                 C = NOT C
  494.             NEXT
  495.         NEXT
  496.     END IF
  497.     IF Choice(5) = 4 THEN
  498.         C1 = 0: Direction = 1
  499.         FOR A = 0 TO Ma - 2
  500.             FOR B = 0 TO Mb - 2
  501.                 LINE (Points12x(A, B), Points12y(A, B))-(Points12x(A + 1, B), Points12y(A + 1, B)), C1
  502.                 LINE -(Points12x(A + 1, B + 1), Points12y(A + 1, B + 1)), C1
  503.                 LINE -(Points12x(A, B + 1), Points12y(A, B + 1)), C1
  504.                 LINE -(Points12x(A, B), Points12y(A, B)), C1
  505.                 C1 = C1 + Direction: IF C1 < 0 OR C1 > 15 THEN Direction = -Direction: C1 = C1 + Direction
  506.             NEXT
  507.         NEXT
  508.     END IF
  509.    
  510.     DO
  511.         A$ = INKEY$
  512.     LOOP UNTIL A$ <> ""
  513.  
  514.  
  515.  
  516. END SUB
  517.  
  518. SUB Plot9
  519.     SHARED TimeDelay
  520.     SetUpScreen
  521.     Alert
  522.     Mcenter 3, "Animated Viewing Instructions"
  523.     Mcenter 25, "Press any key to continue..."
  524.     COLOR 15
  525.     Mcenter 10, "While Viewing, Use the Following Keys:"
  526.     Mcenter 12, "Left Arrow - Slow Down Display"
  527.     Mcenter 14, "Right Arrow - Speed Up Display"
  528.     Mcenter 16, "ESC - Quit To Main Menu At Any Time"
  529.     A$ = INPUT$(1)
  530.     FOR Sc = 0 TO 7
  531.         SCREEN 7, , Sc, Sc
  532.         FOR B = 0 TO Mb - 1
  533.             FOR A = 0 TO Ma - 2
  534.                 LINE (Points9x(Sc, A, B), Points9y(Sc, A, B))-(Points9x(Sc, A + 1, B), Points9y(Sc, A + 1, B)), 14
  535.             NEXT
  536.         NEXT
  537.         FOR A = 0 TO Ma - 1
  538.             FOR B = 0 TO Mb - 2
  539.                 LINE (Points9x(Sc, A, B), Points9y(Sc, A, B))-(Points9x(Sc, A, B + 1), Points9y(Sc, A, B + 1)), 14
  540.             NEXT
  541.         NEXT
  542.         C = 0
  543.         IF Choice(5) = 2 OR Choice(5) = 3 THEN
  544.             FOR A = 0 TO Ma - 2
  545.                 FOR B = 0 TO Mb - 2
  546.                     IF Choice(5) = 2 AND C THEN
  547.                         Xc = INT(.5 + (Points9x(Sc, A, B) + Points9x(Sc, A + 1, B) + Points9x(Sc, A + 1, B + 1) + Points9x(Sc, A, B + 1)) / 4)
  548.                         Yc = INT(.5 + (Points9y(Sc, A, B) + Points9y(Sc, A + 1, B) + Points9y(Sc, A + 1, B + 1) + Points9y(Sc, A, B + 1)) / 4)
  549.                         IF Xc < 0 THEN Xc = 0 ELSE IF Xc > 319 THEN Xc = 319
  550.                         IF Yc < 0 THEN Yc = 0 ELSE IF Yc > 199 THEN Yc = 199
  551.                         PAINT (Xc, Yc), 14, 14
  552.                     END IF
  553.                     IF Choice(5) = 3 AND C THEN
  554.                         Fdx = Points9x(Sc, A + 1, B) - Points9x(Sc, A, B)
  555.                         Fdy = Points9y(Sc, A + 1, B) - Points9y(Sc, A, B)
  556.                         Sdx = Points9x(Sc, A + 1, B + 1) - Points9x(Sc, A, B + 1)
  557.                         Sdy = Points9y(Sc, A + 1, B + 1) - Points9y(Sc, A, B + 1)
  558.                         P = SQR(CLNG(Fdx) * CLNG(Fdx) + CLNG(Fdy) * CLNG(Fdy))
  559.                         P1 = SQR(CLNG(Sdx) * CLNG(Sdx) + CLNG(Sdy) * CLNG(Sdy))
  560.                         IF P1 > P THEN P = P1
  561.                         IF P <> 0 THEN
  562.                             FOR Al! = 0 TO 1 STEP 1 / P
  563.                                 Xs = Points9x(Sc, A, B) + Fdx * Al!
  564.                                 Ys = Points9y(Sc, A, B) + Fdy * Al!
  565.                                 Xe = Points9x(Sc, A, B + 1) + Sdx * Al!
  566.                                 Ye = Points9y(Sc, A, B + 1) + Sdy * Al!
  567.                                 Xd = Xe - Xs
  568.                                 Yd = Ye - Ys
  569.                                 Da = SQR(Xd * Xd + Yd * Yd)
  570.                                 IF Da <> 0 THEN
  571.                                     FOR Al1! = 0 TO 1 STEP 1 / Da
  572.                                         LINE (Xs + Xd * Al1!, Ys + Yd * Al1!)-STEP(1, 1), 14, BF
  573.                                     NEXT
  574.                                 END IF
  575.                             NEXT
  576.                         END IF
  577.                     END IF
  578.                     C = NOT C
  579.                     A$ = INKEY$
  580.                     IF A$ = Escape$ THEN EXIT SUB
  581.                 NEXT
  582.             NEXT
  583.         END IF
  584.     NEXT
  585.     Sc = 0
  586.     DO
  587.         SCREEN 7, , Sc, Sc: Sc = (Sc + 1) MOD 8
  588.         FOR A = 1 TO TimeDelay
  589.         NEXT
  590.         A$ = INKEY$
  591.         IF A$ <> "" THEN
  592.             SELECT CASE A$
  593.             CASE LeftArrow$
  594.                 TimeDelay = TimeDelay - 100
  595.             CASE RightArrow$
  596.                 TimeDelay = TimeDelay + 100
  597.             CASE Escape$
  598.                 EXIT SUB
  599.             CASE ELSE
  600.             END SELECT
  601.         END IF
  602.     LOOP
  603.     Plot
  604.  
  605.  
  606.  
  607. END SUB
  608.  
  609. SUB SetUpScreen
  610.     SCREEN 0
  611.     WIDTH 80, 25
  612.     CLS
  613.     COLOR 14
  614.     Mcenter 1, "Warp Field Animator"
  615.     Mcenter 2, "By Rich Geldreich"
  616. END SUB
  617.  
  618. SUB TestScreens
  619.     SHARED BadScreen
  620.     ON ERROR GOTO BadScreenMode
  621.     BadScreen = False
  622.     Screen9 = True
  623.     FOR A = 0 TO 7
  624.         SCREEN 9, , A, 0
  625.         IF BadScreen THEN
  626.             Screen9 = False
  627.         END IF
  628.     NEXT
  629.     BadScreen = False
  630.     Screen12 = True
  631.     SCREEN 12, , 0, 0
  632.     IF BadScreen THEN
  633.         Screen12 = False
  634.     END IF
  635.     ON ERROR GOTO 0
  636. END SUB
  637.  
  638. SUB TitleScreen
  639.     SCREEN 0
  640.     WIDTH 80, 25
  641.     COLOR 14
  642.     CLS
  643.     Mcenter 11, "Warp Field Animator"
  644.     Mcenter 12, "Version 1.0"
  645.     Mcenter 13, "By Rich Geldreich December 3, 1991"
  646.     Mcenter 14, "Another One of Zeek's Creations!"
  647.     Mcenter 25, "Press any key to continue..."
  648.     A$ = INPUT$(1)
  649. END SUB
  650.  
  651.