home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / pgmutl / elan.zoo / turtle / turtle.eln < prev   
Text File  |  1988-10-13  |  3KB  |  138 lines
  1.  
  2. LET turtle x limit = 100.0;
  3. LET turtle y limit = 100.0;
  4.  
  5. enter turtle graphics:
  6.    INT VAR x base, y base;
  7.    REAL VAR x scale, y scale,
  8.             x range, y range,
  9.             x pos, y pos, dx, dy,
  10.             angle;
  11.    enter graphics mode;
  12.    INT CONST
  13.      size :: min (trunc (real (graphics x limit - 1)/aspect),
  14.                   graphics y limit - 1),
  15.      xmin :: 1 + (graphics x limit -
  16.                   trunc (real (size) * aspect) - 1) DIV 2,
  17.      ymin :: 1 + (graphics y limit - size - 1) DIV 2;
  18.    turtle window (xmin, xmin + size,
  19.                   ymin, ymin + size,
  20.                   turtle x limit, turtle y limit).
  21.  
  22. PROC turtle window (INT CONST xmin, xmax, ymin, ymax,
  23.                     REAL CONST x rng, y rng):
  24.    x range := x rng + 1.0;
  25.    y range := y rng + 1.0;
  26.    x base := max (1, xmin);
  27.    y base := min (graphics y limit, ymax);
  28.    INT CONST x top :: min (graphics x limit, xmax);
  29.    INT CONST y bottom :: max (1, ymin);
  30.    x scale := real (x top - x base + 1) * aspect / x range;
  31.    y scale := real (y base - y bottom + 1) / y range;
  32.    angle := pi / 2.0;
  33.    dx := cos (angle);
  34.    dy := sin (angle);
  35.    x pos := 0.0;
  36.    y pos := 0.0;
  37.    move (x base, y base)
  38. ENDPROC turtle window;
  39.  
  40. leave turtle graphics:
  41.    leave graphics mode.
  42.  
  43. PROC move (REAL CONST l):
  44.    move (x pos + dx * l, y pos + dy * l)
  45. ENDPROC move;
  46.  
  47. PROC draw (REAL CONST l):
  48.    draw (x pos + dx * l, y pos + dy * l)
  49. ENDPROC draw;
  50.  
  51. PROC new coord (REAL CONST x, y):
  52.    x pos := x;
  53.    y pos := y;
  54.    IF x < 0.0
  55.    THEN x pos := 0.0
  56.    ELIF x > x range
  57.    THEN x pos := x range
  58.    FI;
  59.    IF y < 0.0
  60.    THEN y pos := 0.0
  61.    ELIF y > y range
  62.    THEN y pos := y range
  63.    FI
  64. ENDPROC new coord;
  65.  
  66. PROC move (REAL CONST x, y):
  67.    new coord (x, y);
  68.    move (trunc (x pos * x scale) + x base,
  69.          y base - trunc (y pos * y scale))
  70. ENDPROC move;
  71.  
  72. PROC draw (REAL CONST x, y):
  73.    move (trunc (x pos * x scale) + x base,
  74.          y base - trunc (y pos * y scale));
  75.    new coord (x, y);
  76.    draw (trunc (x pos * x scale) + x base,
  77.          y base - trunc (y pos * y scale))
  78. ENDPROC draw;
  79.  
  80. PROC turn (REAL CONST a):
  81.    angle INCR a;
  82.    dx := cos (angle);
  83.    dy := sin (angle)
  84. ENDPROC turn;
  85.  
  86. PROC turn (INT CONST angle):
  87.    turn (pi * real (angle) / 180.0)
  88. ENDPROC turn;
  89.  
  90. PROC turn right:
  91.    angle DECR pi / 2.0;
  92.    REAL CONST h :: dy;
  93.    dy := - dx;
  94.    dx := h
  95. ENDPROC turn right;
  96.  
  97. PROC turn left:
  98.    angle INCR pi / 2.0;
  99.    REAL CONST h :: dy;
  100.    dy := dx;
  101.    dx := - h
  102. ENDPROC turn left;
  103.  
  104. INT PROC ask int (TEXT CONST message):
  105.    INT VAR x; put (message); get (x); x
  106. ENDPROC ask int;
  107.  
  108. REAL PROC ask real (TEXT CONST message):
  109.    REAL VAR x; put (message); get (x); x
  110. ENDPROC ask real;
  111.  
  112. TEXT PROC ask text (TEXT CONST message):
  113.    TEXT VAR t; put (message); get (t); t
  114. ENDPROC ask text;
  115.  
  116. REAL PROC sin (INT CONST a):
  117.   sin (pi * real (a) / 180.0)
  118. ENDPROC sin;
  119.  
  120. REAL PROC cos (INT CONST a):
  121.   cos (pi * real (a) / 180.0)
  122. ENDPROC cos;
  123.  
  124. PROC wait for confirmation (INT CONST x, y):
  125.   move (x, y);
  126.   put ("Hit space!");
  127.   TEXT CONST t :: inchar
  128. ENDPROC wait for confirmation;
  129.  
  130. PROC leave graphics mode:
  131.   page;
  132.   enter text mode
  133. ENDPROC leave graphics mode;
  134.  
  135. 
  136.  
  137.  
  138.