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

 
Output of file : VIDUDF.PRG contained in archive : PTOFSALE.ZIP

*:*********************************************************************
*:
*: Procedure file: VIDUDF.PRG
*:
*: System: RIALTO CINEMA VIDEO P.O.S. PROGRAM
*: Author: SCOTT BAXTER
*: Copyright (c) 1988, SCOTT BAXTER
*: Last modified: 11/04/88 13:57
*:
*: Procs & Fncts: GETVCR()
*: : OUTVAL()
*: : DUPL()
*: : ISLATE()
*: : SCRL()
*: : RNTNAM()
*: : ST()
*: : RNT()
*: : ARRSAVE()
*: : ENDRNT()
*: : ALERT()
*: : CATVAL()
*: : FLMRATE()
*:
*: Documented: 11/09/88 at 17:28 SNAP! version 3.00
*:*********************************************************************
FUNCTION getvcr
PARA num
CALL curoff
ptype=' '
oldwin=WSELECT()
IF EMPTY(num)
WSET FRAME ON
WSET WINDOW novcr TO 11,17,11,62
WSELECT 9
WUSE novcr
? CHR(7)
@ 0,0 SAY CENTER("DIDN'T WANT A MACHINE AFTER ALL, DID THEY?",45)
SLEEP 4
WSET FRAME OFF
WSELECT oldwin
WCLOSE 9
CALL curon
RETU .T.
ENDI
SEEK num
IF EOF()
WSET FRAME ON
WSET WINDOW errmsg TO 12,20,12,60 DOUBLE
?? CHR(7)
WSELE 9
WUSE errmsg
@ 0,0 SAY CENTER('NO SUCH VCR NUMBER, TRY AGAIN',40)
WSET FRAME OFF
SLEEP 3
WSELECT oldwin
WCLOSE 9
CALL curon
RETU .F.
ELSE
IF .NOT. vcrinout
WSET FRAME ON
WSET WINDOW errmsg TO 12,10,12,70 DOUBLE
WSELE 9
WUSE errmsg
?? CHR(7)
@ 0,0 SAY CENTER("!!!!!BIG ERROR, MACHINE IS SHOWN AS RENTED!!!!!",60)
SLEEP 3
WSET FRAME OFF
WSELECT oldwin
WCLO 9
CALL curon
RETU .F.
ELSE
ptype=LEFT(num,1)
RETU .T.
ENDI
ENDI

FUNCTION outval
PARA lct
SELE 3
GO TOP
LOCA FOR dest=lct
IF .NOT. EOF()
SELE 1
RETU .T.
ELSE
site=SPAC(15)
oldwin=WSELECT()
?? CHR(7)
WSET WIND outerr TO 14,10,14,70 DOUBLE
WSELE 9
WUSE outerr
@ 0,0 SAY CENTER('NO SUCH DESTINATION. LISTING SITES NOW.',70)
SLEEP 2
WSET size TO 3,03,20,22
GO TOP
LIST OFF
SLEEP 6
WSELECT oldwin
WCLO 9
SELE 1
RETU .F.
ENDI
***************************************************************************

FUNCTION dupl
PARAMETERS lib,cop,opt,record_no
**** THIS WORKS ONLY ON TAPES
isdup=.F.
fullnum=lib+cop
SET ORDER TO 2
SEEK fullnum
DO CASE
CASE opt='A' .OR. opt='C'
IF .NOT. EOF()
isdup=.T.
ENDI
CASE opt='M'
IF RECNO()<>record_no .AND. .NOT. EOF()
isdup=.T.
ENDI
ENDC
GO record_no
RETU isdup


FUNCTION islate
PARAMETERS inv,daynum
late=.F.
rentdate=CTOD(LEFT(inv,2)+'/'+SUBSTR(inv,3,2)+'/'+SUBSTR(inv,5,2))
retn=rentdate+daynum
DO CASE
CASE TIME()>'18:30:00' .AND. DATE()=retn
late=.T.
CASE DATE()>retn
late=.T.
ENDC
RETURN late


FUNCTION scrl
* PARAMETERS sdescr,sstring,sreturn,ssendback,ordr && CAN KB OR NOT
PARAMETERS sdescr,sstring,sreturn,ordr
* IN ORDER, TITLE, DISPLAY, KB STRING, KB FLAG, NDX ORDER

getnew=.F.

SET ORDER TO &ordr
GO TOP
IF EOF()
??CHR(7)
SET ESCAPE ON
KEYBOARD ' '
SET ESCAPE OFF
RETURN ''
ENDIF
wordlen=LEN(&sstring)+2
mleftwin= 77-wordlen
mrightwin = mleftwin+wordlen
oldwin=WSELECT()
WSET FRAME ON
WSELE 9
WSET WINDOW helpscrl TO 2,mleftwin,22,mrightwin COLOR G/n,W+/B,G/n
WUSE helpscrl TITLE m->sdescr

SET COLOR TO G/n
FOR kountx = 0 TO 20
@ kountx,1 SAY &sstring
SKIP
IF EOF()
break
ENDIF
NEXT
SET COLOR TO W+/B
GO TOP
@ 0,1 SAY &sstring
mtop = kountx
firstrec = RECNO()
GO BOTT
lastrec= RECNO()
GO TOP
DO WHILE .T.
SET COLOR TO G/n
schoice = 0
DO WHILE m->schoice = 0
schoice = INKEY()
ENDDO
DO CASE
CASE m->schoice>64
SET EXACT OFF
IF (m->schoice>64 .AND. m->schoice<91) .OR. (m->schoice>96 .AND. ;
m->schoice<123)
SEEK UPPER(CHR(m->schoice))
ENDI
IF EOF()
MESSAGE='NO RECORD STARTS WITH THIS LETTER'
DO disp_msg
getnew=.T.
WSET FRAME OFF
WSELE oldwin
WCLO 9
EXIT
ELSE
startrec=RECNO()
CLEA
SET COLOR TO G/n
FOR kountx = 0 TO 20
@ kountx,1 SAY &sstring
SKIP
IF EOF()
break
ENDIF
NEXT
SET COLOR TO W+/B
GO startrec
@ 0,1 SAY &sstring
ENDI
CASE m->schoice = 5
IF RECNO() = firstrec
??CHR(7)
LOOP
ELSE
@ ROW(),1 SAY &sstring
SKIP -1
IF ROW() = 0
DOWNSCROLL 1
SET COLOR TO W+/B
@ 0,1 SAY &sstring
ELSE
SET COLOR TO W+/B
@ ROW()-1,1 SAY &sstring
ENDIF
ENDIF

CASE m->schoice = 24
IF RECNO() = lastrec
??CHR(7)
LOOP
ELSE
@ ROW(),1 SAY &sstring
SKIP 1
IF ROW() = 20
UPSCROLL 1
SET COLOR TO W+/B
@ 20,1 SAY &sstring
ELSE
SET COLOR TO W+/B
@ ROW()+1,1 SAY &sstring
ENDIF
ENDIF

CASE m->schoice = 13
* IF ssendback && ELIMINATED FLAG TO KEEP 4 PARAMETERS
SET ESCAPE ON
SET COLOR TO n/W
mreturn = IIF(LEN(TRIM(sreturn)) = 0,"",&sreturn)
WSET FRAME OFF
WSELE oldwin
WCLO 9
KEYBOARD "&mreturn"
SET ESCAPE OFF
* ELSE
WSET FRAME OFF
* WSELE oldwin
* WCLO 9
* ENDIF
EXIT

CASE m->schoice = -9
WSET FRAME OFF
WSELE oldwin
WCLO 9
getnew=.T.
KEYBOARD CHR(13)
EXIT

CASE m->schoice = 18
IF mtop <20 .OR. RECNO() = firstrec
??CHR(7)
@ ROW(),1 SAY &sstring
GO TOP
SET COLOR TO W+/B
@ 0,1 SAY &sstring
LOOP
ENDIF
@ ROW(),1 SAY &sstring
SKIP -ROW()
FOR kountx = 1 TO 20
SKIP -1
IF BOF()
??CHR(7)
break
ENDIF
DOWNSCROLL 1
@ 0,1 SAY &sstring
NEXT
SET COLOR TO W+/B
@ 0,1 SAY &sstring

CASE m->schoice = 3
@ ROW(),1 SAY &sstring
IF mtop<20 .OR. RECNO() = lastrec
GO BOTT
??CHR(7)
SET COLOR TO W+/B
@ mtop,1 SAY &sstring
LOOP
ENDIF
SKIP (20 -ROW())
FOR kount= 1 TO 20
SKIP
IF EOF()
SKIP -1
??CHR(7)
break
ENDIF
UPSCROLL 1
@ 20,1 SAY &sstring
NEXT
SET COLOR TO W+/B
@ 20,1 SAY &sstring
ENDCASE
ENDDO
RETURN ''


FUNCTION rntnam
PARA trg
IF getnew
RETU .T.
ELSE
IF EMPTY(trg)
MESSAGE='ENTER A NUMBER, PRESS F1 FOR HELP, OR PRESS ESC TO EXIT'
DO disp_msg
RETURN .F.
ELSE
SET ORDER TO 1
IF .NOT. EOF()
SKIP
SKIP -1
ELSE
SKIP -1
ENDI
SEEK trg
IF EOF()
MESSAGE='NOT FOUND. PRESS A KEY THEN PRESS F1 FOR HELP'
DO disp_msg
RETURN .F.
ELSE
RETURN .T.
ENDI
ENDI
ENDI

FUNCTION st
PARA trg
SET EXACT OFF
IF EMPTY(trg)
RETURN .T.
ENDI
DO CASE
CASE LEFT(trg,4)='THE '
trg=SUBSTR(trg,5,LEN(TRIM(trg)))
CASE LEFT(trg,3)='AN '
trg=SUBSTR(trg,4,LEN(TRIM(trg)))
CASE LEFT(trg,2)='A '
trg=SUBSTR(trg,3,LEN(TRIM(trg)))
ENDC
SEEK TRIM(trg)
IF EOF()
MESSAGE='PRESS A KEY THEN PRESS F1 TO BROWSE TAPES'
SAVE TO srcherr
DO disp_msg
RETU .F.
ELSE
RETU .T.
ENDI


FUNCTION rnt
PARAMETERS lnum,cnum
goodrnt=.T.
IF EMPTY(lnum)
RETU .T.
ELSE
trg=lnum+cnum
SEEK trg
IF EOF()
goodrnt=.F.
WSET WINDOW badnum TO 10,12,12,66 DOUBLE
WSET FRAME ON
WSELE 4
WUSE badnum
@ 0,0 SAY 'COULD NOT FIND THE TAPE NUMBER YOU ENTERED. PRESS'
@ 1,0 SAY 'A KEY, THEN RETRY OR LEAVE LIBRARY# BLANK TO ABORT.'
SET CONS OFF
WAIT TO KEY
SET CONS ON
WSET FRAME OFF
WSELE 3
WCLO 4
RETU .F.
ELSE
RETU .T.
ENDI
ENDI

************
*
* Function : Arrsave
* Purpose : Saves a QS - dBXL array to disk
* Syntax : Arrsave(,)

FUNCTION arrsave
PARAMETERS trg,srce
PRIVATE wt_res

trg=trg+'.arr'
SAVE ALL LIKE &srce TO &trg
wt_res = IIF(FILE('&TRG'),.T.,.F.)

RETURN (wt_res)

************


FUNCTION endrnt
KEYBOARD ' '
SET ESCAPE OFF
menuck=.F.
option='ESC'
RETU ''


FUNCTION alert

PRIV i, spkr, offspkr, stop, pitch, time1, time2, axreg, bxreg, cxreg, dxreg
*-- Store the off value.
offspkr = IN(97)
FOR i = 1 TO 3
IF i = 2
OUT 97, offspkr
stop = 9
ELSE
*-- Set the frequency.
pitch = IIF(i=1, 2.65, 2.75)
OUT 66, 151
OUT 66, pitch
*-- Make the sound.
spkr = IN(97)
spkr = (INT(spkr/4))*4 + 3
OUT 97, spkr
stop = 15
ENDIF
axreg = 11264
STORE 0 TO bxreg, cxreg, dxreg
DOSINT 33, axreg, bxreg, cxreg, dxreg
time1 = HTOI(RIGHT(ITOH(dxreg),2))
time2=HTOI(RIGHT(ITOH(dxreg),2))

DO WHILE abs(time2 - time1) < stop
STORE 0 TO bxreg, cxreg, dxreg
DOSINT 33, axreg, bxreg, cxreg, dxreg
time2 = HTOI(RIGHT(ITOH(dxreg),2))
ENDDO
NEXT
*-- Turn the speaker off.
OUT 97, offspkr

RETURN ''


FUNCTION catval
PARAMETERS catstr
SELE cats
SEEK LEFT(catstr,3)
IF EOF()
* IN ORDER, TITLE, DISPLAY, KB STRING, KB FLAG, NDX ORDER
MESSAGE='Wrong initial category.'
DO disp_msg
null_ret=scroll('CODE DESCRIPTION','CODE+SPAC(5)+DESC','CODE','1')
SELE tapes
RETU .F.
ELSE
SELE tapes
RETU .T.
ENDI

FUNCTION flmrate
PARA rat

rat=TRIM(rat)
IF rat<>'G'.AND.rat<>'PG'.AND.rat<>'PG13'.AND.rat<>'R'.AND. rat<>'NR'.AND.;
rat<>'X'
MESSAGE='USE ONLY P,PG,PG13,R,NR, OR X FOR RATINGS'
DO disp_msg
RETU .F.
ELSE
RETU .T.
ENDI

*: EOF: VIDUDF.PRG