home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / splos2 / linesega.sp < prev    next >
Encoding:
Text File  |  1990-05-15  |  4.6 KB  |  162 lines
  1. BEGIN
  2.  
  3. { linesega.sp  05-15-90  Requires EGA or better (uses Screen 9) TEM
  4.    Derived from:
  5.    Linesega.bas program converted to Super BASIC by Dennis Baer
  6.    requires Super BASIC translator, file SPL.ZIP on 516 579 7507.
  7.    walking lines program - from BYTE magazine
  8.    converted to IBM by Grant Irani - Fallston, MD
  9.    additional conversion by Will Fastie:  22 Dec 81  }
  10.  
  11.    STRING K;
  12.    INTEGER ARRAY LINES(150, 4);
  13.    INTEGER PALET,BACKTINT,MIXCOLORS,BACKGRND,CHGCNT,TRUE,FALSE,DDD;
  14.    INTEGER X1, Y1, DX1, DY1, X2, Y2, DX2, DY2,
  15.            TINT, { Used to hold color number in LINE stmts }
  16.            IX, { index into lines }
  17.            CNT, { number of lines }
  18.            DELAY; {  Moderate speed initially (on 10 mx 80286) }
  19.  
  20. { Random Number Function }
  21.  
  22.   INTEGER LIMIT, RAND_VALUE;
  23.  
  24.   PROCEDURE RAND (LIMIT);
  25.   BEGIN
  26.    RAND_VALUE := INT(RND(1) * LIMIT) + 1;
  27.   END
  28.  
  29.  PROCEDURE CHG_FOREGROUND;
  30.   BEGIN
  31.    MIXCOLORS := FALSE;
  32.    TINT := TINT + 1;
  33.    IF TINT > 15 THEN TINT := 1;
  34.    RETURN;
  35.   END
  36.  
  37. PROCEDURE CHG_BACKGROUND;
  38.  BEGIN
  39.   PALET := PALET + 1;
  40.   COLOR BACKTINT, PALET;
  41.   RETURN;
  42.  END
  43.  
  44.   ONERRGOTO ERR_HANDLER;
  45.   RANDOMIZE VAL(RIGHT$(TIME$, 2));
  46.   FALSE := 0; TRUE := -1;
  47.  
  48.  
  49.     COLOR 14, 1;
  50.     HOME;
  51.     LOCATE 6, 24; OUTPUT(STRING$(35, 196) );
  52.     LOCATE 7, 25; OUTPUT('Walking Lines Continuous Display.');
  53.     LOCATE 8, 24; OUTPUT(STRING$(35, 196));
  54.    LOCATE 10, 25; OUTPUT('Press B to change backround.');
  55.    LOCATE 12, 25; OUTPUT('Press F to change line color.');
  56.    LOCATE 14, 25; OUTPUT('Press M to MIX line colors.');
  57.    LOCATE 16, 25; OUTPUT('Press minus key for SLOWER.');
  58.    LOCATE 18, 25; OUTPUT('Press plus key for FASTER.');
  59.    LOCATE 20, 25; OUTPUT('Now press a key to begin...');
  60.  
  61. KEY1:
  62.    IF INKEY$ = '' THEN GO TO KEY1;  { Loop until key is pressed }
  63.  
  64.  
  65.  BACKTINT := 0; PALET := 0;
  66.  MIXCOLORS := FALSE;       { Chg color of each line if true }
  67.  SCREEN 1, 0;
  68.  COLOR BACKTINT, PALET;
  69.  
  70.  
  71.  RAND(320); X1 := RAND_VALUE - 1;
  72.  RAND(200); Y1 := RAND_VALUE - 1;
  73.  RAND(11); DX1 := RAND_VALUE - 6;
  74.  RAND(11); DY1 := RAND_VALUE - 6;
  75.  RAND(320); X2 := RAND_VALUE - 1;
  76.  RAND(200); Y2 := RAND_VALUE - 1;
  77.  RAND(11); DX2 := RAND_VALUE - 6;
  78.  RAND(11); DY2 := RAND_VALUE - 6;
  79.  
  80.  TINT := 1; { Used to hold color number in LINE stmts }
  81.  IX := 0; { index into lines }
  82.  CNT := 0; { number of lines }
  83.  DELAY := 500; { Moderate speed initially (on 10 mx 80286) }
  84.  SCREEN 9; { 640 by 350 and 64 Colors }
  85.  
  86. { --------------   M A I N L I N E    --------------------------- }
  87.  
  88. BEGIN_MAIN:
  89.  
  90.     IF MIXCOLORS = TRUE THEN TINT := TINT + 1;
  91.     IF TINT > 15 THEN TINT := 0;
  92.  
  93.     K := INKEY$;
  94.  
  95.          IF K = '' THEN GO TO KEY2; { No key pressed}
  96.          IF K = CHR$(27) THEN BEGIN HOME; STOP; END { Esc key exits }
  97.          IF K = 'f' OR K = 'F' THEN CALL CHG_FOREGROUND;
  98.          IF K = 'b' OR K = 'B' THEN CALL CHG_BACKGROUND;
  99.          IF K = '+' THEN DELAY := (DELAY / 3) + 1;  { Wants FASTER }
  100.          IF K = '-' THEN DELAY := DELAY * 2; { Wants SLOWER }
  101.          IF K = 'm' OR K = 'M' THEN MIXCOLORS := TRUE;
  102.          IF DELAY < 1 THEN DELAY := 1;
  103.          IF DELAY > 30000 THEN DELAY := 32000;
  104. KEY2:
  105.  
  106.  
  107.     FOR DDD := 1 STEP 1 UNTIL DELAY DO BEGIN { Do nothing } END
  108.  
  109.     LINE (X1, Y1)-(X2, Y2), TINT; IX := (IX + 1) MOD 150;
  110.  
  111.  CNT := CNT + 1;
  112.  IF CNT > 150 THEN CNT := 150;
  113.  IF CNT = 150 THEN
  114.  BEGIN
  115.    LINE (LINES(IX, 0), LINES(IX, 1))-(LINES(IX, 2), LINES(IX, 3)),BACKGRND;
  116.  END
  117.  
  118.     LINES(IX, 0) := X1;
  119.     LINES(IX, 1) := Y1;
  120.     LINES(IX, 2) := X2;
  121.     LINES(IX, 3) := Y2;
  122.  
  123.     CHGCNT := CHGCNT - 1;
  124.  
  125.   X1 := X1 + DX1; IF X1 < 0 OR X1 > 639 THEN DX1 := -DX1; X1 := X1 + DX1;
  126.   Y1 := Y1 + DY1; IF Y1 < 0 OR Y1 > 399 THEN DY1 := -DY1; Y1 := Y1 + DY1; 
  127.   X2 := X2 + DX2; IF X2 < 0 OR X2 > 639 THEN DX2 := -DX2; X2 := X2 + DX2;
  128.   Y2 := Y2 + DY2; IF Y2 < 0 OR Y2 > 399 THEN DY2 := -DY2; Y2 := Y2 + DY2;
  129.  
  130.   IF CHGCNT > 0 THEN GOTO BEGIN_MAIN;
  131.   RAND(320); X1 := RAND_VALUE - 1;
  132.   RAND(200); Y1 := RAND_VALUE - 1;
  133.   RAND(320); X2 := RAND_VALUE - 1;
  134.   RAND(200); Y2 := RAND_VALUE - 1;
  135.   RAND(11); DX1 := RAND_VALUE - 6;
  136.   RAND(11); DY1 := RAND_VALUE - 6;
  137.   RAND(11); DX2 := RAND_VALUE - 6;
  138.   RAND(11); DY2 := RAND_VALUE - 6;
  139.   RAND(250); CHGCNT := RAND_VALUE;
  140.   GO TO BEGIN_MAIN;
  141.  
  142.  
  143.  
  144. ERR_HANDLER:
  145.     HOME;
  146.     LOCATE 3, 3;
  147.  IF ERR = 5 THEN
  148.  BEGIN
  149.       OUTPUT('LINESEGA requires at least '@);
  150.       OUTPUT('an EGA display monitor.'); STOP;
  151.  END
  152.  
  153.  ELSE
  154.  BEGIN
  155.       OUTPUT('Untrapped error '@ ERR @ 'Error in line' @ ERL);
  156.       OUTPUT(' in LINESEGA.  Sorry.'); STOP;
  157.  END
  158.  
  159. END
  160.  
  161.  
  162.