home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / vpascal.zip / TURTLE < prev    next >
Text File  |  1985-08-08  |  2KB  |  106 lines
  1. PROGRAM TURTLE;
  2.  
  3. CONST
  4.   ON = TRUE;
  5.   OFF = FALSE;
  6.   ENDKEY = 79;
  7.   UPARROW = 72;
  8.   DNARROW = 80;
  9.   LTARROW = 75;
  10.   RTARROW = 77;
  11.  
  12. VAR
  13.   X:INTEGER;
  14.   Y:INTEGER;
  15.   ANGLE : INTEGER;
  16.   PENCOLOR : INTEGER;
  17.   KEY : INTEGER;
  18.   XSTART:INTEGER;
  19.   YSTART:INTEGER;
  20.   XEND:INTEGER;
  21.   YEND:INTEGER;
  22.  
  23.  
  24. PROCEDURE DELAY;
  25. VAR N:INTEGER;
  26. BEGIN
  27.   FOR N := 1 TO 10 DO;
  28. END;
  29.  
  30.  
  31. PROCEDURE FINDMOVE(ANGLE:INTEGER;
  32.                    VAR DX,
  33.                        DY:INTEGER);
  34. VAR
  35.   N : INTEGER;
  36. BEGIN
  37.   N := ANGLE / 10;
  38.   CASE N OF
  39.    0: BEGIN DX := 0; DY := -100;   END;
  40.    9: BEGIN DX := 100;   DY := 0; END;
  41.    18:BEGIN DX := 0; DY := 100;  END;
  42.    27:BEGIN DX := -100;   DY := 0; END;
  43.   END;
  44. END;
  45.  
  46. PROCEDURE FORWARD(DISTANCE:INTEGER);
  47. VAR
  48.   DX:INTEGER;
  49.   DY:INTEGER;
  50. BEGIN
  51.   FINDMOVE(ANGLE,DX,DY);
  52.   DX := DX*DISTANCE/100;
  53.   DY := DY*DISTANCE/100;
  54.   DRAW(X, Y, X+DX, Y+DY, PENCOLOR);
  55.   X := X + DX;
  56.   Y := Y + DY;
  57. END;
  58.  
  59. PROCEDURE TURTLE(ON:BOOLEAN);
  60. VAR
  61. SAVEPC : INTEGER;
  62. BEGIN
  63.   SAVEPC := PENCOLOR;
  64.   PENCOLOR := PENCOLOR + 128;
  65.   IF ON THEN
  66.     BEGIN
  67.       XSTART := X;
  68.       YSTART := Y;
  69.       FORWARD(5);
  70.       XEND := X;
  71.       YEND := Y;
  72.       X := XSTART;
  73.       Y := YSTART;
  74.     END ELSE
  75.     BEGIN       {erase turtle}
  76.       DRAW(XSTART,YSTART,XEND,YEND,PENCOLOR);
  77.     END;
  78.   PENCOLOR := SAVEPC;
  79. END;
  80.  
  81.  
  82. BEGIN {main program}
  83.   SETMODE(4);
  84.   PENCOLOR := 3;
  85.   X := 160;
  86.   Y := 100;
  87.   ANGLE := 0;
  88.   REPEAT
  89.     REPEAT
  90.       TURTLE(ON);
  91.       DELAY;
  92.       TURTLE(OFF);
  93.       DELAY;
  94.     UNTIL KEYPRESSED; {you can't step past this line, so  }
  95.     KEY := ORD(INKEY);{ Insert a stop on this line}
  96.     IF KEY MOD 256 = 0 THEN KEY := KEY/256 ELSE KEY := 0;
  97.     IF KEY IN [UPARROW,DNARROW,LTARROW,RTARROW] THEN        {arrow keys}
  98.      CASE KEY OF
  99.        UPARROW: FORWARD(10);
  100.        DNARROW: FORWARD(-10);
  101.        LTARROW: IF ANGLE = 0 THEN ANGLE := 270 ELSE ANGLE := ANGLE - 90;
  102.        RTARROW: IF ANGLE = 270 THEN ANGLE := 0 ELSE ANGLE := ANGLE + 90;
  103.       END;
  104.   UNTIL KEY = ENDKEY;
  105. END.
  106.