Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : CLIPGR12.ZIP
Filename : CLIPDEMO.PRG

* Program..: CLIPDEMO.PRG DEMO PROGRAM FOR GRAPHICS FUNCTIONS
* Author...: MAURICE J. HALMOS
* Date.....: 10/6/88
* Notice...: Copyright (c) 1988, MAURICE J. HALMOS, All Rights Reserved
* Notes....: Video-Comp Electronics
* Revised..: 2/1/89
*
************************** INITIALIZE DATA ********************
parameter mnum && used to override default
declare data1[10], data2[10], cos[6], sin[6] && graphics mode
set cursor off

for i=1 to 10
data1[i]=(i-3)^2*3+1 &&initialize demo data
data2[i]=80-(i-7)^3/3
next

cos[1]=1 && more demo data
cos[2]=0.94
cos[3]=0.5
cos[4]=-0.5
cos[5]=-0.94
cos[6]=0.5
sin[1]=0
sin[2]=0.34
sin[3]=0.866
sin[4]=0.866
sin[5]=-0.34
sin[6]=-0.866

version="Ver: 1.2"
messg1="Welcome to"
messg2="CLIP-GRAPHICS"
messg3="This is a demo program"
messg4="to show some of the features of the"
messg5="CLIPGRAF library"
messg6="You Can Create Bar Graphs"
messg7="Also Line Graphs"
messg8="And of course PIE Charts"
messg9="You may select various line types"
messg10="You can define your own fill pattern"
messg11="This video mode does not"
messg12="support multi-video-pages"
messg13="This is the second page"
messg14="Press any key to flip pages"
messg15="Part of the first screen was saved "
messg151="to a CLIPPER variable."
messg16="The imgage is now drawn back"
messg17="Pixels may be SET, RESET, AND, OR, XOR"
messg18="The image may be saved to disk"
messg19="Mouse Demonstration: Move mouse around"
messg20="Click the box"
messg210="Original image was saved to disk"
messg21="Now drawing is being loaded from disk"

mnum=iif(pcount()>0,iif(val(mnum)>3,val(mnum),18),18)
if (.not. g_init(mnum)) && INITIALIZE VIDEO
@10,10 say "Graphics Interface Failed !!!"
@12,10 say "Press any key to EXIT..."
wait
return
endif

mode=g_mode() && GET VIDEO MODE
if mode <=3 .or. mode=7 && IF ONLY TEXT MODES
g_close()
@10,10 say "No Graphics Adaptor Detected !!!"
@12,10 say "Press any key to EXIT..."
wait
return
endif

if mode=6 .and. pcount()=0 && choose low res CGA
g_init(4) && with 4 colors
endif
mode=g_mode()
ncolor=g_ncolors() &&find # of colors

xmax=g_xmax() && get dimensions
ymax=g_ymax() && of graphics screen
aratio=xmax/ymax
pi=3.14159

* ***************** START PROGRAM *********************
g_clear()
do firstscr
* save images into CLIPPER variable pict1
x1=2.5/7*xmax
x2=4.5/7*xmax
y1=ymax/5
y2=2.5/5*ymax
pict1=g_imget(x1,y1,x2,y2)
* save image to a file. Need to make sure that enough disk
* space is available.
g_say(1,1,"Please wait while saving screen")
x1=xmax/4
x2=3/4*xmax
y1=ymax/4
y2=3/4*ymax
savres=g_imsave(x1,y1,x2,y2,"clippic.pic")
g_say(2,1,"Hit to continue")
g_clear()
do secondscr
g_clear()
do thirdscr
g_clear()
do lines
g_clear()
do boxes
do pages && Second page is available if you set the
g_wait() && display to a lower setting than the maximum
g_clear() && Try this by calling CLIPDEMO num, where num
do images && is the video setting (i.e. if VGA 13,14)
g_wait()
g_clear()
do imload
g_wait()
g_clear()
do mouse
g_close()
do lastscr
set cursor on
return
* ***************** END PROGRAM **************************



* ****************** PROCEDURES & FUNCTIONS ****************
procedure firstscr
for i=1 to 20 && DRAW HALF ELLIPSES
g_setclr((i % ncolor)+1)
x1=xmax*(1/4-i/80)
y1=ymax*(1/4-i/80)
x2=xmax*(3/4+i/80)
y2=ymax*(3/4+i/80)*2
g_ellip(i % 1,x1,y1,x2,y2)
next
g_say(11,1+xmax/16-len(messg1)/2,messg1) && GIVE INITIAL MESSAGE
g_say(12,1+xmax/16-len(messg2)/2,messg2)
g_say(13,1+xmax/16-len(version)/2,version)
g_say(20,1+xmax/16-len(messg3)/2,messg3)
g_say(21,1+xmax/16-len(messg4)/2,messg4)
g_say(22,1+xmax/16-len(messg5)/2,messg5)
g_say(24,1,"Press any key ... ")
g_wait()
if ncolor>=4 && IF MORE THAN 4 COLORS
for i=4 to 0 step -1 && CHANGE BACKGROUND A FEW
g_setbkc(i) && TIMES
g_wait()
next
endif
return

procedure secondscr && BAR CHART PROCEDURE
interval=int((xmax-10)/10)
width=int(interval/2)
g_setclr(1)
g_rect(0,10,10,xmax-10,ymax-10) && DRAW OUTER WINDOW
x1=10
y2=ymax-10
g_setline(8) && DRAW GRID WITH DOTTED
for i=1 to 5 && LINE STYLE
g_moveto(10+i*(xmax-20)/5,10)
g_lineto(10+i*(xmax-20)/5,ymax-10)
g_moveto(10,10+i*(ymax-20)/5)
g_lineto(xmax-10,10+i*(ymax-20)/5)
next
for i=2 to 10 && DRAW THE BARS
g_setclr(2)
x1=x1+interval
y1=ymax-data1[i]*ymax/200-10
x2=x1+width
g_rect(1,x1,y1,x2,y2)
next
x1=10
g_say(3,xmax/16-len(messg6)/2,messg6)
g_wait()
g_setclr(3)
g_moveto(10,ymax-data2[1]*ymax/200-10)
g_setline(15)
for i=2 to 10 && DRAW THE LINE
x1=x1+interval
y1=ymax-data2[i]*ymax/200
g_lineto(x1,y1)
next
g_say(4,xmax/16-len(messg7)/2,messg7)
g_wait()
return

procedure thirdscr && PIE CHART PROCEDURE
rad=ymax/4
x1=xmax/2-rad*aratio
x2=xmax/2+rad*aratio
y1=ymax/2-rad
y2=ymax/2+rad && CALCULATE COORDINATES
for n=1 to 5 && FOR THE PIE SLICES
xe=xmax/2+rad*cos[n+1]*aratio
ye=ymax/2+rad*sin[n+1]
xb=xmax/2+rad*cos[n]*aratio
yb=ymax/2+rad*sin[n]
g_setclr((n % ncolor)+1) && ROTATE COLORS
mask=256-(n-1)*32
g_setfmsk(mask,mask,mask,mask,mask,mask,mask,mask) && SET THE MASK
g_pie(1,x1,y1,x2,y2,xe,ye,xb,yb) && DRAW THE PIE SLICE
next
g_setclr(1)
g_rect(0,20,20,xmax-20,ymax-20)
g_say(5,xmax/16-len(messg8)/2,messg8)
g_wait()
return

procedure lines && DRAW LINES IN DIFFERENT
g_setclr(3) && LINE STYLES
g_say(3,xmax/16-len(messg9)/2,messg9)
for i=0 to 18
g_settxtc((i % ncolor)+1) && ROTATE TEXT COLOR
g_setclr((i % ncolor)+1) && ROTATE LINE COLOR
g_say(5+i,2,"Line type: "+str(i,3)) && (EXCLUDING THE 0=BLACK)
g_setline(i)
g_moveto(8*16,ymax*(i+4)/25)
g_lineto(xmax*7/8,ymax*(i+4)/25)
next
g_settxtc(2)
g_wait()
return

procedur boxes && DRAW BOXES WITH DIFFERENT
g_say(3,xmax/16-len(messg10)/2,messg10) && FILL STYLES
x0=0.05*xmax
y0=0.2*ymax
dx=0.2*xmax
dy=0.3*ymax
ex=0.05*xmax
ey=0.1*ymax && FOUR SETS OF 2 BOXES
for ind=0 to 3 && SET FILL BYTES
f1=(85*(ind+1)) % 256
f2=(170*(ind+1)) % 256
f3=(73*(ind+1)) % 256
f4=(146*(ind+1)) % 256
x1=x0+ind*(dx+ex) && CALCULATE POSITION
y1=y0
x2=x0+dx+ind*(dx+ex)
y2=y0+dy
g_setfmsk(f1,f2,f1,f2,f1,f2,f1,f2) && SET FILL MASK
g_setclr(2*ind+1) && SET COLOR
g_rect(1,x1,y1,x2,y2) && DRAW BOXES
g_setfmsk(f3,f4,f3,f4,f3,f4,f3,f4)
g_setclr(2*ind+2)
g_rect(1,x1,y1+ey+dy,x2,y2+ey+dy)
next
g_setclr(3)
g_wait()
return

procedure pages && FLIP VIDEO PAGES PROC

if (g_setapage(1)<0) && IF SECOND PAGE IS NOT
g_clear(0) && AVAILABLE, EXIT
g_say(12,5,messg11)
g_say(13,5,messg12)
g_say(14,5,"Press any key to continue...")
else
ix=10 && DRAW RECTANGLES AND
for i=1 to 30 && ELLIPSES USING TWO
g_setline(i) && VIEWPORTS
g_viewport(0,0,xmax/2,ymax)
g_rect(0,1,1,2*ix,ix)
g_setclr((i % ncolor)+1) && ROTATE COLORS SKIPPING BLACK
g_viewport(xmax/2,0,xmax,ymax)
g_ellip(0,1,1,2*ix-5,ix-5)
ix=ix+10
next
g_say(18,10,messg13)
g_say(20,10,messg14)
g_setvpage(1) && SHOW THE SECOND PAGE
g_wait()
for i=1 to 1000
g_setvpage(1)
g_setvpage(0) && FLIP BETWEEN PAGES
next
endif
g_viewport(0,0,xmax,ymax)
g_setapage(0)
g_say(20,5,"Press any key...")
return

procedure images && Procedure showing how to save
&& images to CLIPPER variables
g_say(1,xmax/16-len(messg15)/2,messg15)
g_say(2,xmax/16-len(messg151)/2,messg151)
g_say(3,xmax/16-len(messg16)/2,messg16)
x1=2.5/7*xmax
y1=ymax/5
dy=ymax/5
dx=xmax/6
g_draw(x1,y1,pict1,4) && Place image at coord.
g_wait()
g_settxtc(3)
g_say(23,2,messg17) && The image pixels are being
g_wait() && ORed, ANDed, RESET, XORed, and
g_draw(x1-2*dx,y1+dy-10,pict1,0) && SET
g_wait()
g_draw(x1-dx,y1+dy,pict1,1)
g_wait()
g_draw(x1,y1+dy+10,pict1,2)
g_wait()
g_draw(x1+dx,y1+dy+20,pict1,4)
g_wait()
g_draw(x1+2*dx,y1+dy+30,pict1,3)
g_wait()
g_settxtc(1)
g_say(24,2,messg18)
g_settxtc(15)
return

procedure imload
if savres > 1 && Check if any bytes were saved
g_say(1,xmax/16-len(messg210)/2,messg210)
g_say(2,xmax/16-len(messg21)/2,messg21)
res=g_imload(xmax/4,ymax/4,"clippic.pic")
if res<0 && check if error occurred
g_say(1,1,"Error opening file. Press ") && while opening file
endif
else
g_say(1,1,"Image was not saved. Press ")
endif
return

procedure mouse
g_mouse(0) && Reset to read
if (g_msread(1) = 0) && Mouse not present ?
g_say(10,4,"No mouse detected for mouse demo")
g_say(11,4,"Press any key to continue...")
return
endif
mw=8 && Cursor width
mh=8 && Cursor height
ret=13
h=0
v=0
pressed= .f.
clear
x1=xmax*2/5
x2=xmax*3/5
y1=ymax*2/5
y2=ymax*3/5
g_setline(15)
f=255
g_setfmsk(f,f,f,f,f,f,f,f)
g_mouse(1) && Show the icon
g_clear() && in CGA modes one must clear the
g_rect(0,0,0,xmax-1,ymax-1) && screen
g_say(2,xmax/16-len(messg19)/2,messg19)
g_say(10,xmax/16-len(messg20)/2,messg20)
g_say(4,4,"Press to end")
g_rect(0,x1,y1,x2,y2)
clr=1
max_clr=g_ncolors() && check maximum colors
do while inkey() !=ret
str=m_read(@pressed, @h, @v) && CLIPPER UDF (@ end of prg)
g_say(24,2, "pressed ")
g_say(24, 10, pressed ) && Display mouse position
g_say(24, 14, "hor:")
g_say(24,19, str(h,3))
g_say(24,25, "vert:")
g_say(24,31,str(v,3))
if h>(x1*640/xmax).and.h<(x2*640/xmax).and.v>y1.and.v g_setclr(clr)
g_rect(1,x1,y1,x2,y2) && Rotate colors every click
clr=(clr+1)%max_clr
endif
enddo

g_init(-1) && set the screen to default mode
set cursor off
g_mouse(1) && Show mouse in the text mode
g_say(1,xmax/16-len(messg19)/2,messg19)
g_say(3,4,"The mouse may be used in TEXT MODE")
g_say(4,4,"Press to end")
do while inkey() !=ret
str=m_read(@pressed, @h, @v) && CLIPPER UDF (@ end of prg)
g_say(24,0, "pressed ")
g_say(24, 9, pressed )
g_say(24, 13, "hor: ")
g_say(24,18, str(h/mw,3))
g_say(24,24, "vert: ")
g_say(24,30,str(v/mh,3))
enddo
g_init(mode)
g_mouse(2) && hide icon
return


procedure lastscr && LAST SCREEN REMINDER

text
Remember:
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º CLIP-GRAPHICS º
º by VideoSoft º
º Serial #1000300 º
º Version 1.2 º
º Copyright (c) Video-Comp Electr. 1988, 1989 º
º º
º This is a shareware program. As such, it may be freely copied º

º and distributed for evaluation. º
º If you would like to use it, you must purchase a license. One º
º license per used copy is required. º
º Licenses cost $20. Include your name and address along with the º
º serial number above. º
º º
º Send to: º
º VideoSoft/Video-Comp Electr. º
º Maurice J. Halmos º
º 825 Washington Ave. #15 PRESS ANY KEY... º
º Santa Monica, CA 90403 º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ

This screen will not appear the first time you use CLIPGRAF if you
register.
endtext
g_wait()
return

function m_read
PARAM pressed, hor, ver
g_mouse(3,0,0,0)
pressed=iif((g_msread(2)>0),"Y","N")
hor=g_msread(3)
ver=g_msread(4)
return .t.