DEFINT A-Z

DIM sayv(52)                        'save area for background behind bar
backup# = 16#                       '# of days to backup for start of display
intday# = .196875#                  'relative x adjustment for intellectual
emoday# = .23203125#                'relative x adjustment for emotional
phyday# = .282472826086956#         'relative x adjustment for physical
absday# = 6.53125#                  'relative x adjustment for actual day

DIM MonthLength(12)
MonthLength(1) = 31
MonthLength(2) = 29
MonthLength(3) = 31
MonthLength(4) = 30
MonthLength(5) = 31
MonthLength(6) = 30
MonthLength(7) = 31
MonthLength(8) = 31
MonthLength(9) = 30
MonthLength(10) = 31
MonthLength(11) = 30
MonthLength(12) = 31

DIM MonthName$(12)
MonthName$(1) = "JAN"
MonthName$(2) = "FEB"
MonthName$(3) = "MAR"
MonthName$(4) = "APR"
MonthName$(5) = "MAY"
MonthName$(6) = "JUN"
MonthName$(7) = "JUL"
MonthName$(8) = "AUG"
MonthName$(9) = "SEP"
MonthName$(10) = "OCT"
MonthName$(11) = "NOV"
MonthName$(12) = "DEC"

DIM DaysPrior(12)
DaysPrior(1) = 0
DaysPrior(2) = 31
DaysPrior(3) = 59
DaysPrior(4) = 90
DaysPrior(5) = 120
DaysPrior(6) = 151
DaysPrior(7) = 181
DaysPrior(8) = 212
DaysPrior(9) = 243
DaysPrior(10) = 273
DaysPrior(11) = 304
DaysPrior(12) = 334

ErrMsg$(1) = "Date must be 11 characters: DD MMM YYYY."
ErrMsg$(2) = "Not a valid month abbreviation."
ErrMsg$(3) = "Day out of range for this month."
ErrMsg$(4) = "Year must be a number."
ErrMsg$(5) = "No February 29 in this year!"

SCREEN 1, 0
COLOR 0, 1

datecalc:
work$ = ""
DO WHILE Escape <> 1
    VIEW (0, 0)-(319, 59): CLS          'this stuff clears the screen
    VIEW (0, 61)-(319, 199): CLS
    VIEW
    LINE (0, 60)-(319, 60), 1
    VIEW
    LOCATE 1, 10: PRINT "The Biorhythm Program";
    LOCATE 25, 11: PRINT "(Press Esc to quit.)";
    LOCATE 11, 4: PRINT "Please enter dates as follows:";
    LOCATE 13, 4: PRINT "         DD MMM YYYY";
    LOCATE 15, 4: PRINT "Example: 01 FEB 1953";
    LOCATE 17, 4: PRINT "Note: All days must be two digits.";
    LOCATE 20, 1: PRINT "Enter your birth date: ";
    GOSUB GetDate
    IF Escape = 1 THEN exit do      'NOTE: MUST BE EXIT LOOP FOR TURBO BASIC
    birth$ = work$
    LOCATE 21, 1: PRINT "Enter the biorhythm date: ";
    GOSUB GetDate
    IF Escape = 1 THEN exit do      'NOTE: MUST BE EXIT LOOP FOR TURBO BASIC
    current$ = work$
    work$ = birth$
    GOSUB ConvertDate
    birth# = work#
    work$ = current$
    GOSUB ConvertDate
    current# = work#
    IF current# < birth# THEN
        a$ = "No pre-birth biorhythms available."
        ex = (40 - LEN(a$)) / 2
        if ex<1 then ex=1
        LOCATE 22, ex: PRINT a$;
        a$ = "Press any key to try again."
        ex = (41 - LEN(a$)) / 2
        if ex<1 then ex=1
        LOCATE 23, ex: PRINT a$;
        BEEP
        a$ = ""
        WHILE a$ = "": a$ = INKEY$: WEND
        VIEW (0, 168)-(319, 191): CLS : VIEW
    ELSE
        diff# = current# - birth#               'here's the number of days
        phy# = diff# MOD 23
        emo# = diff# MOD 28
        intl# = diff# MOD 33
        VIEW (0, 61)-(319, 191): CLS : VIEW
        GOSUB Biograph
    END IF
LOOP

SCREEN 0, 0, 0, 0: CLS
END


Biograph:

intl# = (intl# - backup#) * intday#
emo# = (emo# - backup#) * emoday#
phy# = (phy# - backup#) * phyday#

LINE (0, 60)-(319, 60), 1
FOR x# = 0 TO 6.3 STEP .01                      'intellectual
        PSET (50 + 33 * x#, 60 - 50 * SIN(x# + intl#)), 3
NEXT
FOR x# = 0 TO 7.425 STEP .01                    'emotional
        PSET (50 + 28 * x#, 60 - 50 * SIN(x# + emo#)), 2
NEXT
FOR x# = 0 TO 9.0391 STEP .01                   'physical
        PSET (50 + 23 * x#, 60 - 50 * SIN(x# + phy#)), 1
NEXT

x# = backup# * absday#
GET (50 + x#, 10)-(50 + x#, 110), sayv
LINE (50 + x#, 10)-(50 + x#, 110)
LOCATE 21, 13: PRINT "Physical: "
LOCATE 22, 13: PRINT "Emotional: "
LOCATE 23, 13: PRINT "Intellectual: "

a$ = ""
DO WHILE a$ <> CHR$(27)
        work$ = MonthName$(month) + STR$(day) + "," + STR$(year)
        LOCATE 16, 1
        PRINT "The vertical line marks your biorhythms";
        LOCATE 17, 1
        PRINT "for " + work$ + ". Use the arrow keys to ";
        LOCATE 18, 1
        PRINT "move the pointer to another day. Your";
        LOCATE 19, 1
        PRINT "place in the cycles is shown below.";

'   in your copy of the biorhythm program, these lines print
'   in colors to match the corresponding curve. That printing
'   is done using a proprietary assembler routine which we
'   cannot include in At Ease. Therefore, you will see all
'   text printed in white if you compile and run this source
'   code. Sorry about that!

        ex = 28
        IF 50 * SIN(x# / 23 + phy#) < -3 THEN
          a$ = "-        "
        ELSEIF 50 * SIN(x# / 23 + phy#) > 3 THEN
          a$ = "+        "
        ELSE
          a$ = "Critical!"
        END IF
        LOCATE 21, ex: PRINT a$;
        IF 50 * SIN(x# / 28 + emo#) < -3 THEN
          a$ = "-        "
        ELSEIF 50 * SIN(x# / 28 + emo#) > 3 THEN
          a$ = "+        "
        ELSE
          a$ = "Critical!"
        END IF
        LOCATE 22, ex: PRINT a$;
        a$ = "Intellectual: "
        IF 50 * SIN(x# / 33 + intl#) < -3 THEN
          a$ = "-        "
        ELSEIF 50 * SIN(x# / 33 + intl#) > 3 THEN
          a$ = "+        "
        ELSE
          a$ = "Critical!"
        END IF
        LOCATE 23, ex: PRINT a$;
        a$ = ""
        WHILE a$ = "": a$ = INKEY$: WEND
        SELECT CASE a$

        CASE CHR$(0) + CHR$(75)                   'left arrow
          IF x# > 2 THEN
            PUT (50 + x#, 10), sayv, PSET
            x# = x# - absday#
            x = x#
            IF x# < 2 THEN x# = 0
            day = day - 1
            IF day < 1 THEN
              month = month - 1
              IF month < 1 THEN
                month = 12
                year = year - 1
              END IF
              day = MonthLength(month)
            END IF
            GET (50 + x#, 10)-(50 + x#, 110), sayv
            LINE (50 + x#, 10)-(50 + x#, 110)
          END IF

        CASE CHR$(0) + CHR$(77)                   'right arrow
          IF x# < 208 THEN
            PUT (50 + x#, 10), sayv, PSET
            x# = x# + absday#
            x = x#
            IF x# > 208 THEN x# = 208
            day = day + 1
            leap = year MOD 4
            IF month = 2 AND day > 28 AND leap <> 0 THEN day = 30
            IF day > MonthLength(month) THEN
              month = month + 1
              IF month > 12 THEN
                month = 1
                year = year + 1
              END IF
              day = 1
            END IF
            GET (50 + x#, 10)-(50 + x#, 110), sayv
            LINE (50 + x#, 10)-(50 + x#, 110)
          END IF

        CASE ELSE
          a = a
        END SELECT

LOOP
RETURN

GetDate:
curline = CSRLIN
curpos = POS(0)
et = 1
work$ = "..........."
DO WHILE et <> 0 AND Escape <> 1
   et = 0
   Max = 11
   default$ = work$
   CALL inpsub(0, 0, Max, work$, default$)
   IF Escape = 1 THEN goto EndInputLoop
   VIEW (0, 183)-(319, 191): CLS : VIEW
   IF LEN(work$) <> 11 THEN
     et = 1
     GOSUB ErrorRoutine
     GOTO EndInputLoop
   END IF
   month$ = MID$(work$, 4, 3)
   month = 0
   FOR i = 1 TO 12
       IF month$ = MonthName$(i) THEN month = i
   NEXT
   IF month = 0 THEN
     et = 2
     GOSUB ErrorRoutine
     GOTO EndInputLoop
   END IF
   day$ = LEFT$(work$, 2)
   day = VAL(day$)
   IF day < 1 OR day > MonthLength(month) THEN
     et = 3
     GOSUB ErrorRoutine
     GOTO EndInputLoop
   END IF
   year$ = MID$(work$, 8, 4)
   year = VAL(year$)
   IF year < 1 THEN
     et = 4
     GOSUB ErrorRoutine
     GOTO EndInputLoop
   END IF
   leap = year MOD 4
   IF leap <> 0 AND month = 2 AND day > 28 THEN
     et = 5
     GOSUB ErrorRoutine
     GOTO EndInputLoop
   END IF
EndInputLoop:
LOOP
RETURN

ConvertDate:
month$ = MID$(work$, 4, 3)
FOR i = 1 TO 12
   IF month$ = MonthName$(i) THEN month = i
NEXT
day$ = LEFT$(work$, 2)
day = VAL(day$)
year$ = MID$(work$, 8, 4)
year = VAL(year$)
t1# = year * 365!
t2# = year \ 4
t3# = DaysPrior(month)
work# = t1# + t2# + t3# + day
leap = year MOD 4
IF leap = 0 AND month < 3 THEN work# = work# - 1!
RETURN

ErrorRoutine:
ex = (41 - LEN(ErrMsg$(et))) / 2
if ex<1 then ex=1
LOCATE 24, ex: PRINT ErrMsg$(et);
BEEP
LOCATE curline, curpos, 1
RETURN

SUB inpsub (row, col, Max, x$, default$)

SHARED Escape

Escape = 0
IF col = 0 THEN col = POS(0)
IF row = 0 THEN row = CSRLIN
HoldCol = col
HoldRow = row
LOCATE row, col
PRINT default$;
p = 1

GetKey:
IF p > Max THEN
  p = p - 1
  col = col - 1
END IF
LOCATE HoldRow, col, 1       ' Re-position the cursor

VIEW (0, HoldRow * 8)-(319, HoldRow * 8 + 1): CLS : VIEW
LINE ((col - 1) * 8, HoldRow * 8)-(col * 8 - 2, HoldRow * 8), 3

k$ = ""
WHILE k$ <> "": k$ = INKEY$: WEND       'purge keyboard buffer
k$ = ""
WHILE k$ = "": k$ = INKEY$: WEND

SELECT CASE k$             ' Determine which key pressed & act accordingly

  CASE CHR$(13)                             'enter
    EXIT SUB

  CASE CHR$(27)                             'Esc
    Escape = 1
    EXIT SUB

  CASE CHR$(0) + CHR$(83)                   'Del
    x$ = LEFT$(x$, p - 1) + MID$(x$, p + 1)
    GOSUB ReDisplay

  CASE CHR$(0) + CHR$(82)                   'Ins
    InsMode = (InsMode = 0)

  CASE CHR$(0) + CHR$(71)                   'Home
    p = 1
    col = HoldCol

  CASE CHR$(0) + CHR$(79)                   'End
    p = LEN(x$)
    col = HoldCol + p - 1
    IF p < Max THEN
      p = p + 1
      col = col + 1
    END IF

  CASE CHR$(0) + CHR$(75)                   'Left arrow
    IF p > 1 THEN
      p = p - 1
      col = col - 1
    ELSE
      BEEP
    END IF

  CASE CHR$(0) + CHR$(77)                   'Right arrow
    IF p < Max THEN
      IF p > LEN(x$) + 1 THEN x$ = x$ + " "
      p = p + 1
      col = col + 1
    ELSE
      BEEP
    END IF

  CASE CHR$(0) + CHR$(117)                  'Ctrl-End
    col = HoldCol
    p = 1
    x$ = ""
    GOSUB ReDisplay

  CASE CHR$(8)                              'Backspace
    IF p > 1 THEN
      x$ = LEFT$(x$, p - 2) + MID$(x$, p)
      p = p - 1
      col = col - 1
      GOSUB ReDisplay
    ELSE
      BEEP
    END IF

  CASE " " TO "~"                           'ASCII key
    k$ = UCASE$(k$)
    IF InsMode THEN
      IF LEN(x$) < Max THEN
        x$ = LEFT$(x$, p - 1) + k$ + MID$(x$, p)
        p = p + 1
        col = col + 1
        GOSUB ReDisplay
      ELSE
        BEEP
      END IF
    ELSE
      IF p < Max + 1 THEN
        x$ = LEFT$(x$, p - 1) + k$ + MID$(x$, p + 1)
        LOCATE HoldRow, col
        PRINT k$;
        col = col + 1
        p = p + 1
      ELSE
        BEEP
      END IF
    END IF

  CASE ELSE
    BEEP

END SELECT
GOTO GetKey

ReDisplay:
  LOCATE HoldRow, HoldCol
  PRINT LEFT$(x$ + string$(Max,"."), Max);
  RETURN

END SUB