Phoenix CD 2.0/Phoenix_CD.cdr/01e/miscfunc.zip/ASC3FUNC.PRG

Text File | 1988-04-12 | 19KB | 389 lines

*************************************************************************
*************************************************************************
*
* Copyright Steve Titterud 1987
*           2157 Glenridge Ave.S.
*           St. Paul, MN 55119
*           (612)-739-7229
*           Permission for non-commercial use granted.
*
** ASC3FUNC.PRG - QS function file which has a variety of functions for
**                conversion and deconversion of positive decimal integers into
**                numbers expressed in a user-specified number base, and
**                furthermore, stored as ASCII characters, where 3 digits'
**                position are each filled with a character whose ASCII value
**                less 1 actually stands for the decimal number in that digit
**                position.
**
** This allows storage of numbers up to 16,581,374 in 3 bytes, in a character
** form.  If dates are first converted to Julian date numbers, then these
** can be converted for storage as well.  Either Julian dates and numbers,
** then, can be stored in 3 bytes on disk, and used directly with no conversion
** in index expressions.  The descend() function may be used to reverse the
** index order painlessly.
**
** This is the type of thing that ought to be written in C or assembler,
** however, I don't know assembler, and until I can use Turbo C with QS,
** I guess I'll stick with these when needed.
**
** Ordinarily, the user will use the number base 255, since it affords the
** most economical storage available, but the user may also select a different
** number base which may uniquely suit his application.
**
** No provisions are made to manipulate negative nor fractional numbers
** in the selected number base; however, the user can readily modify the
** source to add these capabilities.
**
** This manner of storage offers both benefits and drawbacks.  On the one hand,
** numbers may be accurately stored in this manner more economically - using
** less disk space, for example.  Numbers stored in this fashion need no
** conversion to string form in order to be used in an index key, concatenated
** with other strings.  Julian dates (or dates derived from any base date) may
** be represented in this way, and date order may be painlessly reversed using
** the descend() function.  Moreover, the indexing operations will be faster,
** and the indexes themselves smaller, than if the numbers these functions
** transform were used instead of being converted to this form.
**
** In addition, a date-time value may be derived, with accuracy to the second,
** using a value of only 6 bytes (Julian dates).  Furthermore, these values may
** be used as a universal source of unique ID values for all files
** in a system, subject to its reliance on the accuracy of the system's clock
** and calendar, of course, and also based upon the principle that the
** essential requirement of an ID is that it be unique, and that no further
** meaning nor content is necessary nor desirable in an ID.  As long as the
** computer system has an accurate clock/calendar, this date-time stamp could
** serve as a perpetual generator of unique 6 byte ID values.
**
** Actually, the time value in these 6 byte date-time variables could be
** maintained to an accuracy of .01 second, IF a system time could deliver a
** reading of time to that accuracy.  This is based upon the idea that you
** could store the number of .01 sec in any time value in 3 bytes of the 6 byte
** variable.  If an even more accurate time could be provided by a separate
** assembler routine, then a comparable 7 byte variable could store
** date-time values accurate to .0001 sec !!  But the functions here rely upon
** accuracy to the second, and in most applications, this will prove adequate.
**
** On the other hand, the functions do consume some extra processor time in
** conversion to and deconversion from the decimal numbers which they represent.
** Moreover, the user may find them unreadable unless converted, so it is
** expected that all of these values need conversion prior to viewing by the
** user.
**
** The functions store a numeric value in any digit position as the value
** of that digit +1.  The reason for this is to avoid chr(0), the 'null',
** which will not be correctly written to a field in a datafile.  Thus the
** offset of +1.  Before these stored values are used in arithmetic operations
** the offset is first removed.
**
** The convention used in the functions for denoting the names of the variables
** representing the digit positions:
**
**          digit0 = digit * numbase^0  (always 1)
**          digit1 = digit * numbase^1
**          digit2 = digit * numbase^2
**
** The functions also enforce upper and lower bounds to the numbers they
** process and also to those they return.  Any number passed to the functions
** for processing, or calculated as a return value, which is less than the
** minimum or greater than the maximum listed below is forced up to the
** minimum or forced down to the maximum:
**
**                minimum    maximum         base 255 maximum
**                ───────    ─────────────   ─────────────────
**
**     (3 digits)    0       numbase^3 - 1       16,581,374
**
** If the user desires, he may create error values for return in this case,
** or possibly modify the code in another way to suit his use.
**
**
** The functions rely upon prior global initialization of the
** following variables:
**
**
**
**               numbase - number base for counting; usually would be
**                         255 for maximum effect, but could be any other
**                         number base desired for a specific circumstance;
**                         must be able to effectively deal with the size
**                         of numbers passed to it, of course
**              basedate - the date from which all dates are offset for
**                         storing and comparing of values; could be the
**                         Julian basedate corresponding to the number 0
**                         for 3-byte storage;
**               daysecs - the number of seconds in a day, 24*60*60
**              hoursecs - the number of seconds in an hour, 60*60
**               minsecs - the number of seconds in a minute, 60
**
** In addition, naturally the date-time stamp functions require an accurate
** date() and time() from the system.  If the date-time stamp is used for
** purposes of generating IDs, the last ID generated or used in a session
** should be saved for comparison with a new date-time stamp upon startup
** of the next session.  If the new one is not greater than the old one,
** there is probably a problem with the system clock, and it may have started
** in the previous session.  In this case, the user might alter a variable
** which turns off the generation of new IDs from date-time stamps, and
** instead uses a successive incrementing of the last-used value until a
** session is started when the new date-time stamp IS greater than the
** last one used in a previous session.
**
** FUNCTIONS AVAILABLE: (ASCIInum always assumes a constant numbase)
**
**
**             num3asc(decimal number)
**                     - creates 3 digit ASCIInum from decimal number
**             asc3num(3 digit ASCIInum)
**                     - creates decimal number from 3 digit ASCIInum
**             inc3asc(3 digit ASCIInum,decimal number,type return value)
**                     - adds decimal number to 3 digit ASCIInum, returns either
**                       decimal number or 3 digit ASCIInum
**             dec3asc(3 digit ASCIInum,decimal number,type return value)
**                     - subtracts decimal number from 3 digit ASCIInum, returns
**                       either decimal number or 3 digit ASCIInum
**             add3asc(3 digit ASCIInum,3 digit ASCIInum,type return value)
**                     - adds two 3 digit ASCIInums, returns either decimal number
**                       or 3 digit ASCIInum
**             sub3asc(3 digit ASCIInum,3 digit ASCIInum,type return value)
**                     - finds difference between two 3 digit ASCIInums,
**                       returns either decimal number or 3 digit ASCIInum
**             dt3jasc(date, type of return value)
**                     - calculates date as offset from base date, returns
**                       either decimal number or 3 digit ASCIInum
**             jasc3dt(number)
**                     - accepts date either as decimal number offset from base date,
**                       or as 3 digit ASCIInum representing same, returns
**                       date variable in ordinary date format
**            sub3jasc(date,date)
**                     - accepts 2 dates either as decimal number offset from base date
**                       or as 3 digit ASCIInums, returns difference in days
**                       as decimal number
**             dttmasc(date,time)
**                     - accepts date() and time() values, computes date as
**                       offset from base date, then represents as 3 digit
**                       ASCIInum; computes time as decimal number of seconds since
**                       midnight, then represents as 3 digit ASCIInum; and
**                       finally, concatenates the two results to form a
**                       6 byte date-time variable; use this function to
**                       generate unique IDs based upon system clock
**             ascdttm(6 digit ASCIInum)
**                     - accepts 6 digit ASCIInum representation of date-time,
**                       converts back to date() and time(), returns as
**                       concatenated string
**            dttmdiff(6 digit ASCIInum,6 digit ASCIInum,type of return value)
**                     - accepts 2 6 digit ASCIInum date-time variables,
**                       computes their difference, and returns that difference
**                       either as 6 digit ASCII number or as string
**
*************************************************************************
************************************************************************
FUNCTION num3asc
PARAMETERS numnum
PRIVATE ascnum,digit2,digit2mod,digit1,digit1mod,digit0
** accepts decimal number, returns 3-byte ASCIInum in base numbase
** enforce upper, lower bounds to numnum
numnum=iif(numnum>(numbase^3-1),(numbase^3-1),iif(numnum<0,0,numnum))
digit2=int(numnum/(numbase^2))
digit2mod=mod(numnum,(numbase^2))
digit1=int(digit2mod/numbase)
digit1mod=mod(digit2mod,numbase)
digit0=digit1mod
ascnum=chr(digit2+1)+chr(digit1+1)+chr(digit0+1)
RETURN ascnum
************************************************************************
FUNCTION asc3num
PARAMETERS ascnum
PRIVATE numnum,digit2,digit1,digit0
** accepts 3-byte ASCIInum in base numbase, returns decimal number
digit2=(asc(right(ascnum,3))-1)
digit1=(asc(right(ascnum,2))-1)
digit0=(asc(right(ascnum,1))-1)
numnum=(digit2*(numbase^2))+(digit1*numbase)+digit0
RETURN numnum
************************************************************************
FUNCTION inc3asc
PARAMETERS ascvarval,howmuch,returnasc
PRIVATE returnval,startval,sumval
** increments value of 3-byte ASCIInum in base numbase by decimal number howmuch
** sums > (numbase^3-1) forced to (numbase^3-1); negative howmuch forced to 0
** returnasc variable provides return of ASCIInum if .T., else decimal number
howmuch=iif(howmuch<0,0,howmuch)
startval=asc3num(ascvarval)
sumval=startval+howmuch
returnval=iif(returnasc,num3asc(sumval),iif(sumval>(numbase^3-1),(numbase^3-1),sumval))
RETURN returnval
************************************************************************
FUNCTION dec3asc
PARAMETERS ascvarval,howmuch,returnasc
PRIVATE returnval,startval,sumval
** decrements value of 3-byte ASCIInum in base numbase by decimal number howmuch
** negative howmuch forced to 0; negative result forced to 0
** returnasc variable provides return of ASCIInum if .T., else decimal number
howmuch=iif(howmuch<0,0,howmuch)
startval=asc3num(ascvarval)
sumval=startval-howmuch
sumval=iif(sumval<0,0,sumval)
returnval=iif(returnasc,num3asc(sumval),sumval)
RETURN returnval
************************************************************************
FUNCTION add3asc
PARAMETERS ascvarval,addvarval,returnasc
PRIVATE adder1,adder2,sumadder,returnval
** adds two 3-byte ASCIInums in base numbase
** sums > (numbase^3-1) forced to (numbase^3-1)
** returnasc variable provides return of ASCIInum if .T., else decimal number
adder1=asc3num(ascvarval)
adder2=asc3num(addvarval)
sumadder=adder1+adder2
returnval=iif(returnasc,num3asc(sumadder),iif(sumadder>(numbase^3-1),(numbase^3-1),sumadder))
RETURN returnval
************************************************************************
FUNCTION sub3asc
PARAMETERS ascvarval,addvarval,returnasc
PRIVATE adder1,adder2,sumadder,returnval
** subtracts 3-byte ASCIInums in base numbase, returns difference
** negative values forced to 0; negative result forced to 0
** returnasc variable provides return of ASCIInum if .T., else decimal number
adder1=asc3num(ascvarval)
adder2=asc3num(addvarval)
sumadder=adder1-adder2
** what type of return value requested?
returnval=iif(returnasc,num3asc(sumadder),iif(sumadder<0,0,sumadder))
RETURN returnval
************************************************************************
FUNCTION dt3jasc
PARAMETERS dt,returnasc
PRIVATE mdate,ascdt
** 3-byte version
** accepts date value, returns offset from basedate
** returnasc variable provides return of ASCIInum if .T., else decimal number
mdate=dt-basedate
returnval=iif(returnasc,num3asc(mdate),mdate)
RETURN returnval
************************************************************************
FUNCTION jasc3dt
PARAMETERS dtnum
PRIVATE dayint,dtdate
** accepts date offset from basedate, either as 3-byte ASCIInum form of
** offset, or as decimal number, returns date
if type('dtnum')="C"  && it's squeezed in ASCIInum
   dayint=asc3num(dtnum)
else  && it's a decimal number offset from basedate
   dayint=dtnum
endif
dtdate=basedate+dayint
RETURN dtdate
************************************************************************
FUNCTION sub3jasc
PARAMETERS dt1,dt2
PRIVATE dtdiff,jdt1,jdt2
** accepts 2 dates either as 3-byte ASCIInum values or decimal numbers
** computes difference in days, forcing negative result to 0
if dt1>=dt2
   dtdiff=0
else
   if type('dt1')="C"  && it's squeezed in ASCIInum
      jdt1=asc3num(dt1)
      jdt2=asc3num(dt2)
      dtdiff=jdt2-jdt1
   else  && it's a julian date
      dtdiff=dt2-dt1
   endif
endif
RETURN dtdiff
************************************************************************
FUNCTION dttmasc
PARAMETERS dt,tm
PRIVATE mdate,timestr,dayint,dayfract,dttm
** accepts date and time, returns two concatenated 3-byte ASCIInums
** in base numbase which represents a date/time stamp
** where date part is decimal number of days offset from basedate,
** and time part is decimal number of seconds offset from midnight of that day
mdate=dt
timestr=tm
dayint=mdate-basedate
dayfract=(val(substr(timestr,1,2))*hoursecs)+(val(substr(timestr,4,2))*minsecs)+(val(substr(timestr,7,2)))
** now, convert to strings, concatenate
dttm=num3asc(dayint)+num3asc(dayfract)
RETURN dttm
************************************************************************
FUNCTION ascdttm
PARAMETERS dttmasc
PRIVATE dayasc,dayint,thisdate,timeasc,dayfract,hours,carry,mins,secs,thistime,dttmstr
** takes 6-byte ASCIInum representation of date/time and regenerates
** the date and time values from which it was derived, returns as string
** in format [date - time]
** first, date derived from offset to basedate:
dayasc=left(dttmasc,3)
dayint=asc3num(dayasc)
thisdate=basedate+dayint
** next, time derived from # of seconds in each unit of time:
timeasc=right(dttmasc,3)
dayfract=asc3num(timeasc)  && decimal number of seconds
hours=int(dayfract/hoursecs)
carry=mod(dayfract,hoursecs)
mins=int(carry/minsecs)
carry=mod(carry,minsecs)
secs=carry
thistime=str(hours,2)+":"+str(mins,2)+":"+str(secs,2)
do while at(" ",thistime)>0
   thistime=stuff(thistime,at(" ",thistime),1,"0")
enddo
dttmstr=dtoc(thisdate)+" - "+thistime
RETURN dttmstr
**********************************************************************
FUNCTION dttmdiff
PARAMETERS dttm1,dttm2,returnasc
PRIVATE day1asc,day1int,time1asc,day1fract,day2asc,day2int,time2asc,day2fract
PRIVATE daysdiffstr,timediffstr,timesdiff,daysdiff,hoursdiff,minsdiff,secsdiff
** takes two 6-byte ASCIInum date/time values and returns their difference
** either as a string or as a 6-byte ASCIInum value
** this function presumes dttm2 >= dttm1
** DAY1...
** first, date derived from offset to basedate:
if dttm2>dttm1
   day1asc=left(dttm1,3)
   day1int=asc3num(day1asc)
   ** next, time derived from # of seconds in each unit of time:
   time1asc=right(dttm1,3)
   day1fract=asc3num(time1asc)
   ** DAY2...
   day2asc=left(dttm2,3)
   day2int=asc3num(day2asc)
   ** next, time derived from # of seconds in each unit of time:
   time2asc=right(dttm2,3)
   day2fract=asc3num(time2asc)
   ** now, calculate difference
   if day1fract>day2fract  && only case if day2int>day1int
      timesdiff=(day2fract+daysecs)-day1fract  && borrow a day, in seconds, from days
      daysdiff=day2int-day1int-1  && take off borrowed day
   else
      timesdiff=day2fract-day1fract
      daysdiff=day2int-day1int
   endif
   ** values obtained; what kind of return value requested?
   if returnasc  && convert to ASCIInum in same format as dttm variables
      returnval=num3asc(daysdiff)+num3asc(timesdiff)
   else  && return as string: #days - time string
      ** calculate each unit of time, pass on any remainders
      hoursdiff=int(timesdiff/hoursecs)
      timesdiff=mod(timesdiff,hoursecs)
      minsdiff=int(timesdiff/minsecs)
      secsdiff=mod(timesdiff,minsecs)
      ** now, calculate string representation of difference:
      daysdiffst=str(daysdiff,8)+" - "
      timediffst=str(hoursdiff,2)+":"+str(minsdiff,2)+":"+str(secsdiff,2)
      do while at(" ",timediffst)>0
         timediffst=stuff(timediffst,at(" ",timediffst),1,"0")
      enddo
      returnval=daysdiffst+timediffst
   endif
else
   if returnasc
      returnval=replicate(chr(1),6)
   else
      returnval=space(8)+" - "+"00:00:00"
   endif
endif
RETURN returnval
************************************************************************