home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
spl
/
linesega.sp
< prev
next >
Wrap
Text File
|
1990-05-15
|
5KB
|
162 lines
BEGIN
{ linesega.sp 05-15-90 Requires EGA or better (uses Screen 9) TEM
Derived from:
Linesega.bas program converted to Super BASIC by Dennis Baer
requires Super BASIC translator, file SPL.ZIP on 516 579 7507.
walking lines program - from BYTE magazine
converted to IBM by Grant Irani - Fallston, MD
additional conversion by Will Fastie: 22 Dec 81 }
STRING K;
INTEGER ARRAY LINES(150, 4);
INTEGER PALET,BACKTINT,MIXCOLORS,BACKGRND,CHGCNT,TRUE,FALSE,DDD;
INTEGER X1, Y1, DX1, DY1, X2, Y2, DX2, DY2,
TINT, { Used to hold color number in LINE stmts }
IX, { index into lines }
CNT, { number of lines }
DELAY; { Moderate speed initially (on 10 mx 80286) }
{ Random Number Function }
INTEGER LIMIT, RAND_VALUE;
PROCEDURE RAND (LIMIT);
BEGIN
RAND_VALUE := INT(RND(1) * LIMIT) + 1;
END
PROCEDURE CHG_FOREGROUND;
BEGIN
MIXCOLORS := FALSE;
TINT := TINT + 1;
IF TINT > 15 THEN TINT := 1;
RETURN;
END
PROCEDURE CHG_BACKGROUND;
BEGIN
PALET := PALET + 1;
COLOR BACKTINT, PALET;
RETURN;
END
ONERRGOTO ERR_HANDLER;
RANDOMIZE VAL(RIGHT$(TIME$, 2));
FALSE := 0; TRUE := -1;
COLOR 14, 1;
HOME;
LOCATE 6, 24; OUTPUT(STRING$(35, 196) );
LOCATE 7, 25; OUTPUT('Walking Lines Continuous Display.');
LOCATE 8, 24; OUTPUT(STRING$(35, 196));
LOCATE 10, 25; OUTPUT('Press B to change backround.');
LOCATE 12, 25; OUTPUT('Press F to change line color.');
LOCATE 14, 25; OUTPUT('Press M to MIX line colors.');
LOCATE 16, 25; OUTPUT('Press minus key for SLOWER.');
LOCATE 18, 25; OUTPUT('Press plus key for FASTER.');
LOCATE 20, 25; OUTPUT('Now press a key to begin...');
KEY1:
IF INKEY$ = '' THEN GO TO KEY1; { Loop until key is pressed }
BACKTINT := 0; PALET := 0;
MIXCOLORS := FALSE; { Chg color of each line if true }
SCREEN 1, 0;
COLOR BACKTINT, PALET;
RAND(320); X1 := RAND_VALUE - 1;
RAND(200); Y1 := RAND_VALUE - 1;
RAND(11); DX1 := RAND_VALUE - 6;
RAND(11); DY1 := RAND_VALUE - 6;
RAND(320); X2 := RAND_VALUE - 1;
RAND(200); Y2 := RAND_VALUE - 1;
RAND(11); DX2 := RAND_VALUE - 6;
RAND(11); DY2 := RAND_VALUE - 6;
TINT := 1; { Used to hold color number in LINE stmts }
IX := 0; { index into lines }
CNT := 0; { number of lines }
DELAY := 500; { Moderate speed initially (on 10 mx 80286) }
SCREEN 9; { 640 by 350 and 64 Colors }
{ -------------- M A I N L I N E --------------------------- }
BEGIN_MAIN:
IF MIXCOLORS = TRUE THEN TINT := TINT + 1;
IF TINT > 15 THEN TINT := 0;
K := INKEY$;
IF K = '' THEN GO TO KEY2; { No key pressed}
IF K = CHR$(27) THEN BEGIN HOME; STOP; END { Esc key exits }
IF K = 'f' OR K = 'F' THEN CALL CHG_FOREGROUND;
IF K = 'b' OR K = 'B' THEN CALL CHG_BACKGROUND;
IF K = '+' THEN DELAY := (DELAY / 3) + 1; { Wants FASTER }
IF K = '-' THEN DELAY := DELAY * 2; { Wants SLOWER }
IF K = 'm' OR K = 'M' THEN MIXCOLORS := TRUE;
IF DELAY < 1 THEN DELAY := 1;
IF DELAY > 30000 THEN DELAY := 32000;
KEY2:
FOR DDD := 1 STEP 1 UNTIL DELAY DO BEGIN { Do nothing } END
LINE (X1, Y1)-(X2, Y2), TINT; IX := (IX + 1) MOD 150;
CNT := CNT + 1;
IF CNT > 150 THEN CNT := 150;
IF CNT = 150 THEN
BEGIN
LINE (LINES(IX, 0), LINES(IX, 1))-(LINES(IX, 2), LINES(IX, 3)),BACKGRND;
END
LINES(IX, 0) := X1;
LINES(IX, 1) := Y1;
LINES(IX, 2) := X2;
LINES(IX, 3) := Y2;
CHGCNT := CHGCNT - 1;
X1 := X1 + DX1; IF X1 < 0 OR X1 > 639 THEN DX1 := -DX1; X1 := X1 + DX1;
Y1 := Y1 + DY1; IF Y1 < 0 OR Y1 > 399 THEN DY1 := -DY1; Y1 := Y1 + DY1;
X2 := X2 + DX2; IF X2 < 0 OR X2 > 639 THEN DX2 := -DX2; X2 := X2 + DX2;
Y2 := Y2 + DY2; IF Y2 < 0 OR Y2 > 399 THEN DY2 := -DY2; Y2 := Y2 + DY2;
IF CHGCNT > 0 THEN GOTO BEGIN_MAIN;
RAND(320); X1 := RAND_VALUE - 1;
RAND(200); Y1 := RAND_VALUE - 1;
RAND(320); X2 := RAND_VALUE - 1;
RAND(200); Y2 := RAND_VALUE - 1;
RAND(11); DX1 := RAND_VALUE - 6;
RAND(11); DY1 := RAND_VALUE - 6;
RAND(11); DX2 := RAND_VALUE - 6;
RAND(11); DY2 := RAND_VALUE - 6;
RAND(250); CHGCNT := RAND_VALUE;
GO TO BEGIN_MAIN;
ERR_HANDLER:
HOME;
LOCATE 3, 3;
IF ERR = 5 THEN
BEGIN
OUTPUT('LINESEGA requires at least '@);
OUTPUT('an EGA display monitor.'); STOP;
END
ELSE
BEGIN
OUTPUT('Untrapped error '@ ERR @ 'Error in line' @ ERL);
OUTPUT(' in LINESEGA. Sorry.'); STOP;
END
END