home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: Product
/
Product.zip
/
oncmd.zip
/
DEMOGRAP.PRG
< prev
next >
Wrap
Text File
|
1996-02-13
|
5KB
|
222 lines
* Test all of the funky graphics and interactive functions
win = openwin(0,0,-1,-1, 'OnCmd ScreenSaver - Press any key or mouse click to end or c to Configure.' )
on click clickfun
do_lines = .t.
do_squares = .t.
do_circles = .t.
end_f = .t.
do while end_f
if end_f .and. do_lines
do lineproc
endif
if end_f .and. do_squares
do box1
endif
if end_f .and. do_circles
do box2
endif
enddo
***********************************
proc box1
private mkey
rand(ctot(time()))
for i = 1 to 500
mkey = inkey( -1 )
if lower( chr( mkey ) ) = 'c'
on click
do configure
on click clickfun
if .not. do_squares
exit
endif
elseif mkey <> 0
end_f = .f.
exit
endif
x = abs(mod(rand(),78))
y = abs(mod(rand(),28))
l = abs(mod(rand(),78-x))
w = abs(mod(rand(),28-y))
c = abs(mod(rand(),10))
c1 = '0/' + ltrim(STR(c))
set color to &c1
@ y,x,y+w,x+l clear
next i
set color to n/w
clear
***********************************
proc box2
private mkey
rand(ctot(time()))
for i = 1 to 500
mkey = inkey(-1)
if lower( chr( mkey ) ) = 'c'
on click
configure()
on click clickfun
if .not. do_circles
exit
endif
elseif mkey <> 0
end_f = .f.
exit
endif
x = abs(mod(rand(),400))/10
y = abs(mod(rand(),130))/10
xs = abs(mod(rand(),400-x*10))/10+x
ys = abs(mod(rand(),130-y*10))/10+y
rx = abs(mod(rand(),xs-x))
ry = abs(mod(rand(),ys-y))
c = abs(mod(rand(),9))
col = ltrim(str(c)) + '/n'
set color to &col
coord = mkarray(y,x,ys,xs)
box (coord, 1,rx,ry)
coord = mkarray(24-y,x,26-ys,xs)
box(coord,1,rx,ry)
coord = mkarray(24-y,80-x,26-ys,80-xs)
box(coord,1,rx,ry)
coord = mkarray(y,80-x,ys,80-xs)
box(coord,1,rx,ry)
next i
set color to n/w
clear
return
***********************************
proc lineproc
private mkey
rand(ctot(time()))
n = 100
stepx = .5
stepy = .2
stepxs = .5
stepys = .2
x = abs(mod(rand(),800))/10
y = abs(mod(rand(),260))/10
xs = abs(mod(rand(),800-x*10))/10+x
ys = abs(mod(rand(),260-y*10))/10+y
declare trail[n,4]
count=1
for k = 1 to 1000
mkey = inkey(-1)
if lower( chr( mkey ) ) = 'c'
on click
configure()
on click clickfun
if .not. do_lines
exit
endif
elseif mkey <> 0
end_f = .f.
exit
endif
c = abs(mod(rand(),9))
col = ltrim(str(c)) + '/n'
set color to &col
coord = mkarray(y,x,ys,xs)
line (coord)
if count < n + 1
trail[count][1] = y
trail[count][2] = x
trail[count][3] = ys
trail[count][4] = xs
else
coord = mkarray(trail[1][1],trail[1][2],trail[1][3],trail[1][4])
set color to 'w/w'
line( coord )
for i = 1 to n-1
trail[i][1] = trail[i+1][1]
trail[i][2] = trail[i+1][2]
trail[i][3] = trail[i+1][3]
trail[i][4] = trail[i+1][4]
next i
trail[n][1] = y
trail[n][2] = x
trail[n][3] = ys
trail[n][4] = xs
endif
count = count + 1
x = x + stepx
y = y + stepy
xs = xs + stepxs
ys = ys + stepys
if x > 80 .OR. x < 0
stepx = stepx * -1
endif
if y >28 .OR. y < 0
stepy = stepy * -1
endif
if xs > 80 .OR. xs < 0
stepxs = stepxs * -1
endif
if ys >28 .OR. ys < -1
stepys = stepys * -1
endif
next k
clear
***********************************
func clickfun
quit
***********************************
func configure
private my_win = openwin( 10, 10, 15, 31, 'Configure Screen Saver' )
private my_quit = .f.
private my_reset = .f.
private my_all = .f.
private my_lines = do_lines
private my_squares = do_squares
private my_circles = do_circles
set color to n/p
clear
@ 2,11 get my_lines picture '@*C Lines' color n/p
@ 4,11 get my_squares picture '@*C Squares' color n/p
@ 6,11 get my_circles picture '@*C Ovals' color n/p
@ 9,2 get my_all picture '@*T ~All' color n/p size 2,8
@ 9,11 get my_reset picture '@*T ~Reset' color n/p size 2,8
@ 9,20 get my_quit picture '@*TD ~OK' color n/p size 2,8
set fullread on
private mylf = 0
do while .not. my_quit
read save from mylf
mylf = lastfield()
if my_reset .or. my_all
if my_reset
my_lines = do_lines
my_squares = do_squares
my_circles = do_circles
else
my_lines = .t.
my_squares = .t.
my_circles = .t.
endif
showgets()
my_reset = .f.
my_all = .f.
elseif my_quit
if .not. my_lines .and. .not. my_squares .and. .not. my_circles
msgbox( 'Configure Screen Saver', 'Must indicate at least one of Lines, Squares, and Circles', 7 )
my_quit = .f.
else
do_lines = my_lines
do_squares = my_squares
do_circles = my_circles
endif
endif
enddo
closewin( my_win )
return
***********************************