home *** CD-ROM | disk | FTP | other *** search
/ Falcon 030 Power 2 / F030_POWER2.iso / ST_STE / MAGS / ICTARI03.ARJ / ictari.03 / STOS / DAYDATE.ASC < prev    next >
Text File  |  1987-04-22  |  4KB  |  92 lines
  1. 90 rem--->Calendar to name any day. "daydate.bas" in STOS Basic.
  2. 91 rem--->Les.Barclay-my program except the 'clever lines' 1740
  3. 92 rem--->1740-1770 and they make it work.
  4. 93 rem--->Runs in any mode.
  5. 94 rem'*********************************************************
  6. 95 rem
  7. 1000 gosub 1260 : rem------>initiate
  8. 1010 while I$<>"Q" : rem--->Set 1160-1200
  9. 1020 gosub 1440 : rem------>date input
  10. 1030 gosub 1740 : rem------>calculate day
  11. 1040 gosub 1100 : rem------>print result
  12. 1050 wend 
  13. 1060 windel 1 : windel 2 : windel 3 : curs on : cls : show : end 
  14. 1070 rem----------------------------
  15. 1080 rem>>>> PRINT RESULT <<<<
  16. 1090 rem----------------------------
  17. 1100 qwindow 3 : clw : curs off : print : centre L$
  18. 1110 DI$="The"+str$(D)+TH$+" of "+MOTH$+str$(YEAR)
  19. 1120 locate 1,3 : centre DI$
  20. 1130 DI$="is,was or will be a "+DAY$
  21. 1140 locate 1,4 : centre DI$
  22. 1150 qwindow 2 : clw : centre "Quit OR Again ?"
  23. 1160 clear key : I$=""
  24. 1170 repeat 
  25. 1180 I$=upper$(inkey$)
  26. 1190 until I$<>""
  27. 1200 return 
  28. 1210 rem-----------------------------
  29. 1220 rem>>>> INITIATE <<<<
  30. 1230 rem-----------------------------
  31. 1240 if mode=2 then then GR=2 : BL=2;BR=2
  32. 1250 if mode=0 then GR=9 : BL=13 : BR=5
  33. 1260 cls : hide : paper GR : windopen 1,0,0,80/divx,24,1 : clw 
  34. 1270 paper BL : windopen 3,8/divx,13,64/divx,8,8 : clw : under on : title " DAY and DATE requested " : under off 
  35. 1280 paper 1 : pen 0 : windopen 2,8/divx,22,64/divx,3,1 : clw 
  36. 1290 paper BR : pen 1 : windopen 4,8/divx,2,64/divx,10,12 : clw : under on : title " PERPETUAL CALENDAR " : under off 
  37. 1300 locate 1,2 : centre "The Gregorian calendar was    "
  38. 1310 locate 1,3 : centre "introduced by pope Gregory in "
  39. 1320 locate 1,4 : centre "the year 1582 and made law in "
  40. 1330 locate 1,5 : centre "Britain and the colonies in   "
  41. 1340 locate 1,6 : centre "1752. The algorithm used was  "
  42. 1350 locate 1,7 : centre "written in 1886 by Zellar.    "
  43. 1360 rem--->NOTE spaces to make strings equal length
  44. 1370 M$="January  February March    April    May      June     July     August   SeptemberOctober  November December "
  45. 1380 MK$="Tuesday  WednesdayThursday Friday   "
  46. 1390 WKD$="SaturdaySunday  Monday  "
  47. 1400 return 
  48. 1410 rem---------------------------
  49. 1420 rem >>>> DATE INPUT <<<<
  50. 1430 rem---------------------------
  51. 1440 qwindow 2 : clw : repeat 
  52. 1450 input "ENTER YEAR 1752-9999 ";Y : YEAR=Y : rem-->y is DEC line 1510
  53. 1460 until Y>1751 and Y<10000
  54. 1470 rem---> SET LEAP YEAR  century/400 & year/4
  55. 1480 LEAP=0 : CENT=0 : DY=31 : C#=Y
  56. 1490 if int(C#/1000)=C#/1000 then CENT=1 : rem-->find end century
  57. 1500 if int(C#/400)=C#/400 then LEAP=1 : rem----->is it a leap year
  58. 1510 if CENT<>1 and int(C#/4)=C#/4 then LEAP=1 : rem-->? other leaps
  59. 1520 repeat 
  60. 1530 input "month 1-12 ";M
  61. 1540 until M>0 and M<13
  62. 1550 rem--->days in month use month & leap
  63. 1560 DY$="31"
  64. 1570 if M=4 or M=6 or M#=9 or M=11 then DY$="30"
  65. 1580 if M=2 and LEAP=1 then DY$="29"
  66. 1590 if M=2 and LEAP=0 then DY$="28"
  67. 1600 MTH$=mid$(M$,M*9-8,9)
  68. 1610 if LEAP=1 then L$=str$(Y)+" was a leap year." else L$="  "
  69. 1620 repeat 
  70. 1630 print "ENTER day 1 to ";DY$; : input " ";D
  71. 1640 until D>0 and D<val(DY$)+1
  72. 1650 rem--->set ordinals
  73. 1660 TH$="th"
  74. 1670 if D=1 or D=21 or D=31 then TH$="st"
  75. 1680 if D=2 or D=22 then TH$="nd"
  76. 1690 if D=3 or D=23 then TH$="rd"
  77. 1700 return 
  78. 1710 rem-------------------------------
  79. 1720 rem>>>> CALCULATE DAY <<<<
  80. 1730 rem-------------------------------
  81. 1740 if M<3 then M=M+12 : dec Y
  82. 1750 W=D+2*M+2+int((3*M+3)/5)+Y+(Y/4)-int(Y/100)+int(Y/400)
  83. 1760 W=W-7*int(W/7)
  84. 1770 if W>2 then W=W-3 : DAY$=mid$(MK$,1+W*9,9) else DAY$=mid$(WKD$,1+W*8,8)
  85. 1780 rem
  86. 1790 rem--->get spaces off month string
  87. 1800 MOTH$="" : for N=1 to 9
  88. 1810 if mid$(MTH$,N,1)<>" " then MOTH$=left$(MTH$,N)
  89. 1820 if mid$(MTH$,N,1)=" " then N=9 : rem finish loop
  90. 1830 next N
  91. 1840 return 
  92.