:***************************************************************************
:
:Name: 4Cal.BTM  v1.3 (4DOS 3.01 required)      Timestamp: 07-17-90 02:22pm
:      Copyright (c) 1990, Dick Botbyl          CIS 71571,151
:
:Description: Shows calendar on screen
:
:***************************************************************************
setlocal ^ unalias * ^ unset *
:START
  set mon_num=%@substr[%_DATE,0,2]
  set _day=%@substr[%_DATE,3,2]
  set _short_yr=%@substr[%_DATE,6,2]
  set _long_yr=%@eval[%_short_yr+1900]
  set _BClr=cya on blu
  setdos /s32:32
                                         :Put up the calendar form
  screen 0 0
  drawbox 5 24 22 59 1 bla on bla fill bla
  drawbox  4 22 21 57 1 %_BClr fill blu
  drawbox  7 22 19 57 1 %_BClr fill blu
  scrput  4 36 bri yel on blu Calendar
  scrput  6 22 %_BClr ³ Mon  Tue  Wed  Thu  Fri  Sat Sun ³
  scrput 20 22 %_BClr ³ Arrow keys change months   [Esc] ³

:BEGIN_TO                                :WHICH CALENDAR TYPE NEEDED
  IFF %_short_yr LT 72 THEN
     SET _short_yr=%@eval[%_short_yr +28]
     GOTO BEGIN_TO
     echo pause_one^pause
  ENDIFF
  IFF %_short_yr GT 99 THEN
     SET _short_yr=%@eval[%_short_yr -28]
     GOTO BEGIN_TO
     echo pause_two^pause
  ENDIFF
  IF %_short_yr EQ 72 SET mon_type=13
  IF %_short_yr EQ 73 SET mon_type= 1
  IF %_short_yr EQ 74 SET mon_type= 2
  IF %_short_yr EQ 75 SET mon_type= 3
  IF %_short_yr EQ 76 SET mon_type=11
  IF %_short_yr EQ 77 SET mon_type= 7
  IF %_short_yr EQ 78 SET mon_type= 8
  IF %_short_yr EQ 79 SET mon_type= 1
  IF %_short_yr EQ 80 SET mon_type= 9
  IF %_short_yr EQ 81 SET mon_type= 4
  IF %_short_yr EQ 82 SET mon_type= 5
  IF %_short_yr EQ 83 SET mon_type= 6
  IF %_short_yr EQ 84 SET mon_type=14
  IF %_short_yr EQ 85 SET mon_type= 2
  IF %_short_yr EQ 86 SET mon_type= 3
  IF %_short_yr EQ 87 SET mon_type= 4
  IF %_short_yr EQ 88 SET mon_type=12
  IF %_short_yr EQ 89 SET mon_type= 7
  IF %_short_yr EQ 90 SET mon_type= 1
  IF %_short_yr EQ 91 SET mon_type= 2
  IF %_short_yr EQ 92 SET mon_type=10
  IF %_short_yr EQ 93 SET mon_type= 5
  IF %_short_yr EQ 94 SET mon_type= 6
  IF %_short_yr EQ 95 SET mon_type= 7
  IF %_short_yr EQ 96 SET mon_type= 8
  IF %_short_yr EQ 97 SET mon_type= 3
  IF %_short_yr EQ 98 SET mon_type= 4
  IF %_short_yr EQ 99 SET mon_type= 5
                                          :WHAT MONTH AND HOW MANY DAYS
  SET _num_days= 31
  IFF %mon_num EQ 01 THEN
    SET _mon_str=January
    SET _start_day= 1
  ENDIFF
  IFF %mon_num EQ 02 THEN
    SET _start_day= 4
    SET _num_days= 28
    SET _mon_str=February
  ENDIFF
  IFF %mon_num EQ 03 THEN
    SET _mon_str=March
    SET _start_day= 4
  ENDIFF
  IFF %mon_num EQ 04 THEN
    SET _num_days= 30
    SET _mon_str=April
    SET _start_day= 7
  ENDIFF
  IFF %mon_num EQ 05 THEN
    SET _mon_str=May
    SET _start_day= 2
  ENDIFF
  IFF %mon_num EQ 06 THEN
    SET _num_days= 30
    SET _mon_str=June
    SET _start_day= 5
  ENDIFF
  IFF %mon_num EQ 07 THEN
    SET _mon_str=July
    SET _start_day= 7
  ENDIFF
  IFF %mon_num EQ 08 THEN
    SET _mon_str=August
    SET _start_day= 3
  ENDIFF
  IFF %mon_num EQ 09 THEN
    SET _num_days= 30
    SET _mon_str=September
    SET _start_day= 6
  ENDIFF
  IFF %mon_num EQ 10 THEN
    SET _mon_str=October
    SET _start_day= 1
  ENDIFF
  IFF %mon_num EQ 11 THEN
    SET _num_days= 30
    SET _mon_str=November
    SET _start_day= 4
  ENDIFF
  IFF %mon_num EQ 12 THEN
    SET _mon_str=December
    SET _start_day= 6
  ENDIFF
  set _e_val=%@eval[(%_num_days-22)*5]
  IF %_num_days GT 29 set _f_val=%@eval[(%_num_days-29)*5+1]
  set _xcal=`³    ³    ³    ³    ³    ³    ³    ³`
  set _zcal=`³    ³    ³                        ³`
  set _acal=`³    ³    ³    ³    ³    ³    ³  1 ³  2 ³  3 ³  4 ³  5 ³  6 ³  7 ³`
  set _bcal=`³  2 ³  3 ³  4 ³  5 ³  6 ³  7 ³  8 ³  9 ³ 10 ³ 11 ³ 12 ³ 13 ³ 14 ³`
  set _ccal=`³  9 ³ 10 ³ 11 ³ 12 ³ 13 ³ 14 ³ 15 ³ 16 ³ 17 ³ 18 ³ 19 ³ 20 ³ 21 ³`
  set _dcal=`³ 16 ³ 17 ³ 18 ³ 19 ³ 20 ³ 21 ³ 22 ³ 23 ³ 24 ³ 25 ³ 26 ³ 27 ³ 28 ³`
  set _ecal=`³ 23 ³ 24 ³ 25 ³ 26 ³ 27 ³ 28 ³ 29 ³ 30 ³ 31 ³`
  set _fcal=`³ 30 ³ 31 ³`
  set _ecal=%@substr[%_ecal,0,%_e_val]
  set _fcal=%@substr[%_fcal,0,%_f_val]
                                                :WHERE TO PUT FIRST DAY
  IFF %mon_type GT 7 THEN
    IF %mon_num GT 2 SET _start_day=%@eval[%_start_day + 1]
  ENDIFF
  IF %mon_type GT 7 SET mon_type=%@eval[%mon_type -7]
  SET _start_day=%@eval[%_start_day+%mon_type]
  SET _start_day=%@eval[%_start_day- 1]
  IF %_start_day GT 7 *SET _start_day=%@eval[%_start_day - 7]
  SET strt_ln= 8
  SET start_day_out=%@eval[35-(%_start_day*5)]
  IF %start_day_out GT 34 SET start_day_out=0

:PUT_WEEKS
  scrput  8 22 %_BClr %@substr[%_acal,%start_day_out,37]
  scrput 10 22 %_BClr %@substr[%_bcal,%start_day_out,37]
  scrput 12 22 %_BClr %@substr[%_ccal,%start_day_out,37]
  scrput 14 22 %_BClr %@substr[%_dcal,%start_day_out,37]
  scrput 16 22 %_BClr %_xcal
  scrput 18 22 %_BClr %_zcal
  scrput 16 22 %_BClr %@substr[%_ecal,%start_day_out,37]
  IFF %start_day_out LT 3 THEN
     IF %_num_days GT 29 scrput 18 22 %_BClr %@substr[%_fcal,%start_day_out,%_f_val]
  ENDIFF
  SET start_day_out=%@eval[(%_start_day*5)+14+5*%_day]

:PUT_DAY                                       :PUT TODAY ON CALENDAR
    IFF %start_day_out GT 58 THEN
      SET start_day_out= %@eval[%start_day_out - 35]
      SET strt_ln= %@eval[%strt_ln +2]
      GOTO PUT_DAY
    ENDIFF
    IFF %_day LT 10 THEN
      SET _day=%@substr[%_DATE,4,1]
      SET start_day_out= %@eval[%start_day_out + 1]
    ENDIFF
    scrput %strt_ln %start_day_out bri gre on blu %_day

:PUTLINES
  drawbox 7 27 19 32 1 %_BClr
  drawbox 7 37 17 42 1 %_BClr
  drawbox 7 47 17 52 1 %_BClr
  scrput 17 22 %_BClr ÃÄÄÄÄÅÄÄÄÄÅÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄ´
  drawbox 18 36 18 56 0 %_BClr
  scrput 18 37 bri gre on blu %_mon_str
  scrput 18 48 bri gre on blu %_long_yr
  drawbox  9 22 11 57 1 %_BClr
  drawbox 11 22 13 57 1 %_BClr
  drawbox 13 22 15 57 1 %_BClr
  drawbox 15 22 17 57 1 %_BClr
  drawbox 19 23 19 56 1 %_BClr

:SWITCH                                          :LOOK AT DIFFERENT MONTH
  inkey %%Key_code
     IF %Key_code EQ @71 GOTO START
     IF %Key_code EQ @77 SET mon_num=%@eval[%mon_num+1]
     IFF %mon_num GT 12 THEN
        SET mon_num=1
        SET _long_yr=%@eval[%_long_yr+1]
     ENDIFF
     IF %Key_code EQ @75 SET mon_num=%@eval[%mon_num-1]
     IFF %mon_num LT 1 THEN
        SET mon_num=12
        SET _long_yr=%@eval[%_long_yr-1]
     ENDIFF
     IF %Key_code EQ @72 SET _long_yr=%@eval[%_long_yr+1]
     IF %Key_code EQ @80 SET _long_yr=%@eval[%_long_yr-1]
     IF %Key_code EQ @73 SET _long_yr=%@eval[%_long_yr+5]
     IF %Key_code EQ @81 SET _long_yr=%@eval[%_long_yr-5]
     IF "%Key_code" EQ "" GOTO FINI
     IF %mon_num LT 10 *SET mon_num=0%mon_num
     SET _short_yr=%@eval[%_long_yr-1900]
  UNSET Key_code mon_type start_day_out  _start_day
  screen 1 0
  GOTO BEGIN_TO

:FINI
 setdos /s6:7
 screen 0 0
 drawbox 0 0 1 79 0 bla on bla