'===========================================================================
' Subject: TEXT MODE CALENDAR SHELL           Date: 03-24-98 (12:47)       
'  Author: Tony L. Damigo                     Code: PB                     
'  Origin: kvdojo@lightspeed.net            Packet: DATETIME.ABC
'===========================================================================
CLS
DEFINT A-Z
SCREEN 0,0,0
SHARED JUST.SHOW  ' Needed

' ************************************************************************
' --------------------------- Readme / Disclaimer ------------------------
' ************************************************************************
'     Lanuage:  POWERBASIC 3.1
'
'     Author :  TONY L DAMIGO              E-MAIL:  kvdojo@lightspeed.net
'               Lake Isabella Ca.          PHONE :  760-379-1751
'
'     This program is given as PUBLIC DOMAINE software. Do with it what you
'     please. However, ! USE AT YOUR OWN RISK ! I will not be responsible
'     for damages to your system ( bla, bla, the standard disclaimer)
'     If you use it..you could memtion my name :-)
'     If you have suggstions or modification, please share them.
'
'
'             ******* What Is It / How Does It Works *******
'
'     This is a .SHELL. for a Calendar program. It takes the information
'     that you provide, and converts it into one of two calendar types.
'     It is a RAW program, but is has many posibilities.
'
'     You will need to provide the variables below:
'     .MAXDAYS. are the maximum days allowed in the month
'     .WEEKDAY. that the 1st falls on: 0=Sun, 1=Mon, 2=Tue, 3=Wed, etc.."
'     .DAY.     is the current/desired day of the month"
'
'      Be cautious when assigning WinRow & WinCol. See the Note inside the
'      function for details:
'
'      Call the function and assign the result to Cal.Num, or whatever....
'      That's it! The Calendar function does the rest.
'
'      Example:
'      Cal.Num = MAKECALENDAR(WinRor, WinCol, MaxDays, WeekDay, Day, Box)
'
' ----------------------------------------------------------------------

GOSUB DISPLAY.DEMO	' This calls the DEMO SCREEN



' ***********************************************************************
'--------------------- THE ACTUAL CALENDAR FUNCTION ---------------------
' ***********************************************************************

FUNCTION MAKECALENDAR(WINROW, WINCOL, MAXDAYS, WEEKDAY, DAY, BOX)
'   NOTE
'   With Box turned on:
'   WinRow must not be larger than 5 -- WinCol must not be larger than 12
'   Larger numbers can crash the program or not give the room needed for
'   a calendar with the WEEKDAY being equal to 6.
'
'   With Box turned off:
'   You have more flexibility. If you crash...decrease WinCol or WinRow.
' -------------------------------------------------

  REDIM DAYS(44) AS SHARED STRING
  REDIM CALPOS(MAXDAYS,2)
  SHARED JUST.SHOW

 IF BOX THEN
   SPACER=2 : RGAP  =1 : CGAP  =2
 ELSE
  SPACER=1  : RGAP  =1 : CGAP  =3
 END IF

' 1,2,3-10
' 2,1,3-5

  LASTPTR=DAY
  PTR=DAY
  ROW=(1+WINROW)

' -------------------------------------------------
' Set the day of the month then fill the arrays with the
' days, and fill 6 DAYS() arrays at front & back with blanks
' -------------------------------------------------

  FOR X = 1 TO 43
    IF X <=6 OR X >(MAXDAYS+6) THEN
      DAYS(X)="  "
    ELSE
      DAYS(X)=MID$(STR$(X-6),2)
      IF (X-6)<10 THEN DAYS(X)=(" "+DAYS(X))
    END IF
  NEXT X

' -------------------------------------------------
' Fill locations into CALPOS() for the wrap-around
' function and KEY-Press routine
' -------------------------------------------------

  COLOR 7,0
  FOR X = (7-WEEKDAY) TO (43-(7-WEEKDAY))+1
    IF COL=7 THEN
      COL = 1
      INCR ROW
    ELSE
      INCR COL
    END IF
    LOCATE (ROW*RGAP*SPACER),((COL+WINCOL)*CGAP*SPACER)-1  : PRINT DAYS(X);
    IF X>6 AND (X-6) <= MAXDAYS THEN
       CALPOS(X-6,1)=FIX(ROW*RGAP*SPACER)
       CALPOS(X-6,2)=FIX(((COL+WINCOL)*CGAP*SPACER)-1)
    END IF
  NEXT X

  IF BOX THEN
     GOSUB SHOWBOX
  ELSE
     GOSUB SHOWHILITES
  END IF

  DO
    IF NOT JUST.SHOW THEN	' Allows the calendar to show then exit
      DO : LOOP UNTIL INSTAT
      K$=INKEY$
    ELSE
      K$=CHR$(13)
    END IF

    SELECT CASE K$
      CASE =CHR$(27)
        FUNCTION=0
        EXIT FUNCTION
      CASE =CHR$(13)
        FUNCTION=PTR
        EXIT FUNCTION
      CASE =CHR$(0,75)
        DECR PTR
        IF PTR < 1 THEN PTR=MAXDAYS
      CASE chr$(0,77)
        INCR PTR
        IF PTR > MAXDAYS THEN PTR=1
      CASE =CHR$(0,72) 'DN
        DECR PTR,7
        IF PTR < 1 THEN
          PTR=(MAXDAYS-1)+(PTR-MAXDAYS MOD 7)
          INCR PTR,7
          IF PTR > MAXDAYS THEN DECR PTR, 7
        END IF
      CASE chr$(0,80) 'DN
       INCR PTR,7
       IF PTR > MAXDAYS THEN PTR=(PTR MOD 7)+1
       IF PTR = 0 THEN PTR=7
      CASE ELSE
    END SELECT

    IF BOX THEN
       GOSUB SHOWBOX
    ELSE
       GOSUB SHOWHILITES
    END IF

  LOOP

SHOWHILITES:
  ' Highlight the day of the month
  COLOR 7,0
     LOCATE CALPOS(LASTPTR,1),CALPOS(LASTPTR,2)
     PRINT DAYS(LASTPTR+6);

   COLOR 15,7
     LOCATE CALPOS(PTR,1),CALPOS(PTR,2),0
     PRINT DAYS(PTR+6);
   COLOR 7,0
     LASTPTR=PTR
RETURN

SHOWBOX:
 COLOR 0,0
 LOCATE CALPOS(LASTPTR,1)-1,CALPOS(LASTPTR,2)-1
 PRINT CHR$(218,196,196,191);
 LOCATE CALPOS(LASTPTR,1),CALPOS(LASTPTR,2)-1
 PRINT CHR$(179)+DAYS(LASTPTR+6)+CHR$(179);
 LOCATE CALPOS(LASTPTR,1)+1,CALPOS(LASTPTR,2)-1
 PRINT CHR$(192,196,196,217);

 COLOR 7,0
 LOCATE CALPOS(LASTPTR,1),CALPOS(LASTPTR,2)
 PRINT DAYS(LASTPTR+6);

 COLOR 15,7
 LOCATE CALPOS(PTR,1)-1,CALPOS(PTR,2)-1
 PRINT CHR$(218,196,196,191);
 LOCATE CALPOS(PTR,1),CALPOS(PTR,2)-1
 PRINT CHR$(179)+DAYS(PTR+6)+CHR$(179);
 LOCATE CALPOS(PTR,1)+1,CALPOS(PTR,2)-1
 PRINT CHR$(192,196,196,217);
 COLOR 7,0
 LASTPTR=PTR
RETURN
END FUNCTION



' ************************************************************************
' ------------------------- Demo Screen Mombo-Jumbo ----------------------
' ************************************************************************

DISPLAY.DEMO:

PRINT "This is a .SHELL. for a Calendar program. It takes the information that you"
PRINT "provide, and converts it into one of two calendar types."
PRINT
COLOR 15,0
PRINT "        Press ENTER to toggle between calendars / ESC to end the demo."
PRINT "        Navigate using the LEFT, RIGHT, UP, and DOWN arrow keys"


DAY1=22					' Assign days to display
DAY2=4

JUST.SHOW=(-1)
  NUL=MAKECALENDAR(13,3,28,2,DAY1,0)	' Show Calenders without
  NUL=MAKECALENDAR(5,10,31,6,DAY2,1)	' allowing user interaction
JUST.SHOW=(1)				' Set Calendars for interaction


TAG=1
DO
 SELECT CASE TAG
 CASE 1
   COLOR 1,0
   LOCATE 11,10
   PRINT "    << OVER HERE >>                                       "
   Selected = MAKECALENDAR(13,3,28,2,DAY1,0)
   LOCATE 25,10
   TAG=2
 CASE 2
   COLOR 1,0
   LOCATE 11,10
   PRINT "                                       << OVER HERE >>    "
   Selected = MAKECALENDAR(5,10,31,6,DAY2,1)
   LOCATE 25,43
   TAG=1
 CASE ELSE
 END SELECT

 IF Selected THEN
   PRINT "You selected day number";Selected;"  ";
   IF TAG=1 THEN DAY2=SELECTED ELSE DAY1=SELECTED

 ELSE
   LOCATE 25,1
   PRINT "You pressed Escape! This DEMO is terminated"+STRING$(35,32);
   BEEP
   END
 END IF
LOOP