home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GA / GA028.ZIP / HOPALONG.PAS < prev    next >
Pascal/Delphi Source File  |  1986-08-27  |  6KB  |  208 lines
  1. PROGRAM Hopalong;
  2.  
  3.  
  4. (****************************************************)
  5. (* COPYRIGHT (C) 1986 by Kevin McCarty.             *)
  6. (* All commercial use prohibited.                   *)
  7. (* Permission is granted for copying, distribution, *)
  8. (* adaptation, and incorporation into other works,  *)
  9. (* but for personal or educational use only,        *)
  10. (* and this notice is to be preserved.              *)
  11. (****************************************************)
  12.  
  13.  
  14. (*
  15.     Adapted for Computer Recreations in
  16.     September 1986 Scientific American
  17.  
  18.     Based on ideas of Barry Martin of Aston University
  19.     in Birmingham, England
  20.  
  21.     Version 1.1,  August 27 1986
  22. *)
  23.  
  24. LABEL Resume;
  25.  
  26. Var
  27.     x, y : real;
  28.     xmin, xmax, xspan, xscale, xs,
  29.     ymin, ymax, yspan, yscale, ys : real;
  30.     n, nc, color : integer;
  31.     ch : char;
  32.     AxisColor : integer;
  33.  
  34.  
  35. {$I plot.inc}
  36.  
  37.  
  38. Function Scale(x : real) : real;
  39. { returns largest power of 10 < x/4 }
  40. VAR s : real;
  41. BEGIN
  42.     s := 1.0;
  43.     WHILE s < x DO s := 10.0 * s;
  44.     WHILE s >= 0.5*x DO s := 0.1 * s;
  45.     Scale := s
  46. END;    (* Scale *)
  47.  
  48.  
  49. Procedure Set_Scale;
  50. BEGIN
  51.     Writeln;
  52.     Writeln('Specify Plot Window--');
  53.     Write('(Xmin - Xmax) (',xmin:10:3,' - ',xmax:10:3,'): ');
  54.     Readln(xmin, xmax);
  55.     Write('(Ymin - Ymax) (',ymin:10:3,' - ',ymax:10:3,'): ');
  56.     Readln(ymin, ymax);
  57.     xspan := xmax - xmin;
  58.     yspan := ymax - ymin;
  59.     IF (xspan = 0.0) OR (yspan = 0.0) THEN
  60.         BEGIN
  61.         IF (xspan = 0.0) THEN Writeln('Xmin = Xmax !');
  62.         IF (yspan = 0.0) THEN Writeln('Ymin = Ymax !');
  63.         Writeln('Can''t handle that!');
  64.         Halt;
  65.         END;
  66.     xscale := Scale(Abs(xspan));
  67.     yscale := Scale(Abs(yspan));
  68.     Writeln('X span = ',xspan:10:3,', scale = ',xscale:10:4);
  69.     Writeln('Y span = ',yspan:10:3,', scale = ',yscale:10:4);
  70. END;    (* Set_Scale *)
  71.  
  72.  
  73. Procedure Draw_Axes;
  74. VAR
  75.     i, j, i1, i2 : integer;
  76.  
  77.     Procedure Xtick(at_x, at_y, size : integer);
  78.     {vertical tick}
  79.     BEGIN
  80.         FOR j := -size TO size DO
  81.             Plot (at_x, at_y + j, AxisColor)
  82.     END;    (* Xtick *)
  83.  
  84.     Procedure Ytick(at_x, at_y, size : integer);
  85.     {horizontal tick}
  86.     BEGIN
  87.         FOR j := -size TO size DO
  88.             Plot (at_x + j, at_y, AxisColor)
  89.     END;    (* Ytick *)
  90.  
  91. BEGIN
  92.     IF (xmin <= 0.0) AND (xmax >= 0.0) THEN
  93.         BEGIN { draw vertical axis ticks }
  94.         i1 := Trunc (ymin/yscale);
  95.         i2 := Trunc (ymax/yscale);
  96.         FOR i := i1 TO i2 DO
  97.             BEGIN
  98.             Ytick (Trunc (-maxXdot * xmin / xspan),
  99.                    Trunc (maxYdot * (ymax-i*yscale) / yspan), 2);
  100.             END;
  101.         END;
  102.  
  103.     IF (ymin <= 0.0) AND (ymax >= 0.0) THEN
  104.         BEGIN { draw horizontal axis ticks }
  105.         i1 := Trunc (xmin/xscale);
  106.         i2 := Trunc (xmax/xscale);
  107.         FOR i := i1 TO i2 DO
  108.             BEGIN
  109.             Xtick (Trunc (maxXdot * (i*xscale-xmin) / xspan),
  110.                    Trunc (maxYdot * ymax / yspan), 2);
  111.             END;
  112.         END;
  113. END;    (* Draw_Axes *)
  114.  
  115.  
  116. Procedure Draw_Grid;
  117. { draw a grid of dots showing the scale }
  118. VAR
  119.     i, j, xj, yi, xlo, xhi, ylo, yhi : integer;
  120. BEGIN
  121.     { determine x and y scales }
  122.  
  123.     xlo := Trunc (xmin / xscale);
  124.     xhi := Trunc (xmax / xscale);
  125.     ylo := Trunc (ymin / yscale);
  126.     yhi := Trunc (ymax / yscale);
  127.  
  128.     FOR i := ylo TO yhi DO
  129.         BEGIN
  130.         yi := Trunc ( maxYdot * (ymax - i * yscale) / yspan);
  131.         FOR j := xlo TO xhi DO
  132.             BEGIN
  133.             xj := Trunc (maxXdot * (j * xscale - xmin) / xspan);
  134.             Plot (xj, yi, AxisColor);
  135.             END;
  136.         END;
  137.  
  138.     Draw_Axes;
  139. END;    (* Draw_Grid *)
  140.  
  141. {$I hop.pas}
  142.  
  143. BEGIN   (* MAIN *)
  144.     ClrScr;
  145.     Writeln('      *** WALLPAPER FOR THE MIND ***');
  146.     Writeln('   (see Sept. 1986 Scientific American)');
  147.     Writeln;
  148.     Writeln;
  149.     Writeln(' while plotting---');
  150.     Writeln('   G:              Draw grid dots');
  151.     Writeln('   Blank:          Cycle Colors');
  152.     Writeln('   *:              Graphics Screen Dump');
  153.     Writeln('                   (Make sure printer is ONLINE!)');
  154.     Writeln('   <enter>:        Return to text mode to change parameters');
  155.     Writeln('   any other key:  Exit program');
  156.     Writeln;
  157.     Init_Graphics;
  158.     IF maxcolor > 1 
  159.         THEN AxisColor := Yellow
  160.         ELSE AxisColor := 1;
  161.     Set_Defaults;
  162.  
  163.  
  164.     REPEAT                  { input / plot cycle }
  165.         Set_Coefficients;
  166.         Set_Scale;
  167.         Initialize;
  168.         Graphics_Mode;      { entering graphics mode }
  169.         n := 0;             { iteration counter }
  170.         nc := 0;            { color index }
  171.  
  172. Resume:
  173.         REPEAT
  174.             IF (n = 0) THEN
  175.                 BEGIN { cycle color every so often }
  176.                 nc := (nc mod maxcolor) + 1;
  177.                 IF maxcolor = 15 THEN
  178.                     color := ColorList [nc]
  179.                 ELSE
  180.                     color := nc;
  181.                 END;
  182.             n := (n + 1) mod boredom;
  183.  
  184.             Next_Iteration;
  185.             xs := (x - xmin) / xspan;
  186.             ys := (ymax - y) / yspan;
  187.             IF (Abs(xs) < 1.0) AND (Abs(ys) < 1.0) THEN
  188.                 Plot (Trunc (maxXdot * xs), Trunc (maxYdot * ys), color);
  189.  
  190.         UNTIL KeyPressed;
  191.  
  192.         Read(kbd,ch);
  193.         CASE UpCase(ch) OF
  194.         '*':  BEGIN Screen_Dump;    Goto Resume END;
  195.         'G':  BEGIN Draw_Grid;      Goto Resume END;
  196.         ' ':  BEGIN Cycle_Palette;  Goto Resume END;
  197.         END; (* Case *)
  198.  
  199.         Text_Mode;
  200.         IF (ch <> ^M) THEN
  201.             BEGIN
  202.             Write('Are you bored with this stuff already (Y/N)? ');
  203.             Read(kbd,ch);
  204.             Writeln(ch);
  205.             END;
  206.     UNTIL UpCase(ch) = 'Y';
  207. end.
  208.